diff options
| -rw-r--r-- | generic/tclOOScript.h | 44 | ||||
| -rw-r--r-- | tools/tclOOScript.tcl | 44 |
2 files changed, 44 insertions, 44 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index 374c11d..7538d48 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -269,11 +269,11 @@ static const char *tclOOSetupScript = "\t\t\t\twhile {[set next [lindex $args [expr {$i + 1}]]\n" "\t\t\t\t\t\tstring match \"-*\" $next]} {\n" "\t\t\t\t\tset arg [lindex $args [incr i 2]]\n" -"\t\t\t\t\tswitch [prefix match -error [list -level 2 -errorcode \\\n" +"\t\t\t\t\tswitch [prefix match -error [list -level 1 -errorcode \\\n" "\t\t\t\t\t\t\t[list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {\n" "\t\t\t\t\t\t-get {\n" "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n" -"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n" +"\t\t\t\t\t\t\t\treturn -code error -level 1 \\\n" "\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n" "\t\t\t\t\t\t\t\t\t\"missing body to go with -get option\"\n" "\t\t\t\t\t\t\t}\n" @@ -281,7 +281,7 @@ static const char *tclOOSetupScript = "\t\t\t\t\t\t}\n" "\t\t\t\t\t\t-set {\n" "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n" -"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n" +"\t\t\t\t\t\t\t\treturn -code error -level 1 \\\n" "\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n" "\t\t\t\t\t\t\t\t\t\"missing body to go with -set option\"\n" "\t\t\t\t\t\t\t}\n" @@ -289,7 +289,7 @@ static const char *tclOOSetupScript = "\t\t\t\t\t\t}\n" "\t\t\t\t\t\t-kind {\n" "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n" -"\t\t\t\t\t\t\t\treturn -code error -level 2\\\n" +"\t\t\t\t\t\t\t\treturn -code error -level 1 \\\n" "\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n" "\t\t\t\t\t\t\t\t\t\"missing kind value to go with -kind option\"\n" "\t\t\t\t\t\t\t}\n" @@ -306,51 +306,51 @@ static const char *tclOOSetupScript = "\t\t\t\tset addReader [expr {$kind ne \"writable\" && ![info exist getter]}]\n" "\t\t\t\tset addWriter [expr {$kind ne \"readable\" && ![info exist setter]}]\n" "\t\t\t\ttry {\n" -"\t\t\t\t\tuplevel 2 [list $stdInstaller $prop $addReader $addWriter]\n" +"\t\t\t\t\tuplevel 1 [list $stdInstaller $prop $addReader $addWriter]\n" "\t\t\t\t} on error {msg opt} {\n" -"\t\t\t\t\treturn -code error -level 2 \\\n" +"\t\t\t\t\treturn -code error -level 1 \\\n" "\t\t\t\t\t\t\t-errorcode [dict get $opt -errorcode] $msg\n" "\t\t\t\t}\n" "\t\t\t\tswitch $kind {\n" "\t\t\t\t\treadable {\n" -"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list $writeslot -remove $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $readslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $writeslot -remove $realprop]\n" "\t\t\t\t\t}\n" "\t\t\t\t\twritable {\n" -"\t\t\t\t\t\tuplevel 2 [list $readslot -remove $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $readslot -remove $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $writeslot -append $realprop]\n" "\t\t\t\t\t}\n" "\t\t\t\t\treadwrite {\n" -"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $readslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 1 [list $writeslot -append $realprop]\n" "\t\t\t\t\t}\n" "\t\t\t\t}\n" "\t\t\t\tif {[info exist getter]} {\n" -"\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n" +"\t\t\t\t\tuplevel 1 [list method $reader -unexport {} $getter]\n" "\t\t\t\t}\n" "\t\t\t\tif {[info exist setter]} {\n" -"\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n" +"\t\t\t\t\tuplevel 1 [list method $writer -unexport {value} $setter]\n" "\t\t\t\t}\n" "\t\t\t}\n" "\t\t}\n" "\t\tnamespace eval configurableclass {\n" -"\t\t\t::proc property args {\n" -"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n" +"\t\t\t::interp alias \\\n" +"\t\t\t\t\t{} ::oo::configuresupport::configurableclass::property {} \\\n" +"\t\t\t\t\t::oo::configuresupport::PropertyImpl \\\n" "\t\t\t\t\t::oo::configuresupport::StdClassProperties \\\n" "\t\t\t\t\t::oo::configuresupport::readableproperties \\\n" -"\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n" -"\t\t\t}\n" +"\t\t\t\t\t::oo::configuresupport::writableproperties\n" "\t\t\t::proc properties args {::tailcall property {*}$args}\n" "\t\t\t::namespace path ::oo::define\n" "\t\t\t::namespace export property\n" "\t\t}\n" "\t\tnamespace eval configurableobject {\n" -"\t\t\t::proc property args {\n" -"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n" +"\t\t\t::interp alias \\\n" +"\t\t\t\t\t{} ::oo::configuresupport::configurableobject::property {} \\\n" +"\t\t\t\t\t::oo::configuresupport::PropertyImpl \\\n" "\t\t\t\t\t::oo::configuresupport::StdObjectProperties \\\n" "\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n" -"\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n" -"\t\t\t}\n" +"\t\t\t\t\t::oo::configuresupport::objwritableproperties\n" "\t\t\t::proc properties args {::tailcall property {*}$args}\n" "\t\t\t::namespace path ::oo::objdefine\n" "\t\t\t::namespace export property\n" diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 3e80981..95ffbde 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -505,11 +505,11 @@ while {[set next [lindex $args [expr {$i + 1}]] string match "-*" $next]} { set arg [lindex $args [incr i 2]] - switch [prefix match -error [list -level 2 -errorcode \ + switch [prefix match -error [list -level 1 -errorcode \ [list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] { -get { if {$i >= [llength $args]} { - return -code error -level 2 \ + return -code error -level 1 \ -errorcode {TCL WRONGARGS} \ "missing body to go with -get option" } @@ -517,7 +517,7 @@ } -set { if {$i >= [llength $args]} { - return -code error -level 2 \ + return -code error -level 1 \ -errorcode {TCL WRONGARGS} \ "missing body to go with -set option" } @@ -525,7 +525,7 @@ } -kind { if {$i >= [llength $args]} { - return -code error -level 2\ + return -code error -level 1 \ -errorcode {TCL WRONGARGS} \ "missing kind value to go with -kind option" } @@ -544,30 +544,30 @@ set addReader [expr {$kind ne "writable" && ![info exist getter]}] set addWriter [expr {$kind ne "readable" && ![info exist setter]}] try { - uplevel 2 [list $stdInstaller $prop $addReader $addWriter] + uplevel 1 [list $stdInstaller $prop $addReader $addWriter] } on error {msg opt} { - return -code error -level 2 \ + return -code error -level 1 \ -errorcode [dict get $opt -errorcode] $msg } switch $kind { readable { - uplevel 2 [list $readslot -append $realprop] - uplevel 2 [list $writeslot -remove $realprop] + uplevel 1 [list $readslot -append $realprop] + uplevel 1 [list $writeslot -remove $realprop] } writable { - uplevel 2 [list $readslot -remove $realprop] - uplevel 2 [list $writeslot -append $realprop] + uplevel 1 [list $readslot -remove $realprop] + uplevel 1 [list $writeslot -append $realprop] } readwrite { - uplevel 2 [list $readslot -append $realprop] - uplevel 2 [list $writeslot -append $realprop] + uplevel 1 [list $readslot -append $realprop] + uplevel 1 [list $writeslot -append $realprop] } } if {[info exist getter]} { - uplevel 2 [list method $reader -unexport {} $getter] + uplevel 1 [list method $reader -unexport {} $getter] } if {[info exist setter]} { - uplevel 2 [list method $writer -unexport {value} $setter] + uplevel 1 [list method $writer -unexport {value} $setter] } } } @@ -583,12 +583,12 @@ # ------------------------------------------------------------------ namespace eval configurableclass { - ::proc property args { - ::oo::configuresupport::PropertyImpl \ + ::interp alias \ + {} ::oo::configuresupport::configurableclass::property {} \ + ::oo::configuresupport::PropertyImpl \ ::oo::configuresupport::StdClassProperties \ ::oo::configuresupport::readableproperties \ - ::oo::configuresupport::writableproperties {*}$args - } + ::oo::configuresupport::writableproperties # Plural alias just in case; deliberately NOT documented! ::proc properties args {::tailcall property {*}$args} ::namespace path ::oo::define @@ -596,12 +596,12 @@ } namespace eval configurableobject { - ::proc property args { - ::oo::configuresupport::PropertyImpl \ + ::interp alias \ + {} ::oo::configuresupport::configurableobject::property {} \ + ::oo::configuresupport::PropertyImpl \ ::oo::configuresupport::StdObjectProperties \ ::oo::configuresupport::objreadableproperties \ - ::oo::configuresupport::objwritableproperties {*}$args - } + ::oo::configuresupport::objwritableproperties # Plural alias just in case; deliberately NOT documented! ::proc properties args {::tailcall property {*}$args} ::namespace path ::oo::objdefine |