diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2024-07-19 08:52:07 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2024-07-19 08:52:07 (GMT) |
| commit | 5cb0d0d08cecd336d707cefe07834baf85d6887f (patch) | |
| tree | cfc92d2da9b33df1e939ca1e5648de0750cc76fd /tools/tclOOScript.tcl | |
| parent | 47f3f735713593f0bb95d3197fb3053cad00a3ba (diff) | |
| download | tcl-5cb0d0d08cecd336d707cefe07834baf85d6887f.zip tcl-5cb0d0d08cecd336d707cefe07834baf85d6887f.tar.gz tcl-5cb0d0d08cecd336d707cefe07834baf85d6887f.tar.bz2 | |
Slightly simpler script
Diffstat (limited to 'tools/tclOOScript.tcl')
| -rw-r--r-- | tools/tclOOScript.tcl | 44 |
1 files changed, 22 insertions, 22 deletions
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 |