diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2024-01-27 22:05:59 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2024-01-27 22:05:59 (GMT) |
| commit | 6469f49c68c8f3006fe38c70f1cc16621207873e (patch) | |
| tree | b8462d4f32002c4c3ed4dc269fd38253595c2bf0 /generic/tclOOScript.h | |
| parent | 1178b99000dfc1c8c537abe0cd1dfeb6b640f595 (diff) | |
| download | tcl-6469f49c68c8f3006fe38c70f1cc16621207873e.zip tcl-6469f49c68c8f3006fe38c70f1cc16621207873e.tar.gz tcl-6469f49c68c8f3006fe38c70f1cc16621207873e.tar.bz2 | |
Now passing tests
Diffstat (limited to 'generic/tclOOScript.h')
| -rw-r--r-- | generic/tclOOScript.h | 103 |
1 files changed, 1 insertions, 102 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index eb6a96e..1903b49 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -364,108 +364,7 @@ static const char *tclOOSetupScript = "\t\t\t::namespace path ::oo::objdefine\n" "\t\t\t::namespace export property\n" "\t\t}\n" -"\t\tproc ReadAll {object my} {\n" -"\t\t\tset result {}\n" -"\t\t\tforeach prop [info object properties $object -all -readable] {\n" -"\t\t\t\ttry {\n" -"\t\t\t\t\tdict set result $prop [$my <ReadProp$prop>]\n" -"\t\t\t\t} on error {msg opt} {\n" -"\t\t\t\t\tdict set opt -level 2\n" -"\t\t\t\t\treturn -options $opt $msg\n" -"\t\t\t\t} on return {msg opt} {\n" -"\t\t\t\t\tdict incr opt -level 2\n" -"\t\t\t\t\treturn -options $opt $msg\n" -"\t\t\t\t} on break {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\t\"property getter for $prop did a break\"\n" -"\t\t\t\t} on continue {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\t\"property getter for $prop did a continue\"\n" -"\t\t\t\t}\n" -"\t\t\t}\n" -"\t\t\treturn $result\n" -"\t\t}\n" -"\t\tproc ReadOne {object my propertyName} {\n" -"\t\t\tset props [info object properties $object -all -readable]\n" -"\t\t\ttry {\n" -"\t\t\t\tset prop [prefix match -message \"property\" $props $propertyName]\n" -"\t\t\t} on error {msg} {\n" -"\t\t\t\tcatch {\n" -"\t\t\t\t\tset wps [info object properties $object -all -writable]\n" -"\t\t\t\t\tset wprop [prefix match $wps $propertyName]\n" -"\t\t\t\t\tset msg \"property \\\"$wprop\\\" is write only\"\n" -"\t\t\t\t}\n" -"\t\t\t\treturn -code error -level 2 -errorcode [list \\\n" -"\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName] $msg\n" -"\t\t\t}\n" -"\t\t\ttry {\n" -"\t\t\t\tset value [$my <ReadProp$prop>]\n" -"\t\t\t} on error {msg opt} {\n" -"\t\t\t\tdict set opt -level 2\n" -"\t\t\t\treturn -options $opt $msg\n" -"\t\t\t} on return {msg opt} {\n" -"\t\t\t\tdict incr opt -level 2\n" -"\t\t\t\treturn -options $opt $msg\n" -"\t\t\t} on break {} {\n" -"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\"property getter for $prop did a break\"\n" -"\t\t\t} on continue {} {\n" -"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\"property getter for $prop did a continue\"\n" -"\t\t\t}\n" -"\t\t\treturn $value\n" -"\t\t}\n" -"\t\tproc WriteMany {object my setterMap} {\n" -"\t\t\tset props [info object properties $object -all -writable]\n" -"\t\t\tforeach {prop value} $setterMap {\n" -"\t\t\t\ttry {\n" -"\t\t\t\t\tset prop [prefix match -message \"property\" $props $prop]\n" -"\t\t\t\t} on error {msg} {\n" -"\t\t\t\t\tcatch {\n" -"\t\t\t\t\t\tset rps [info object properties $object -all -readable]\n" -"\t\t\t\t\t\tset rprop [prefix match $rps $prop]\n" -"\t\t\t\t\t\tset msg \"property \\\"$rprop\\\" is read only\"\n" -"\t\t\t\t\t}\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode [list \\\n" -"\t\t\t\t\t\t\tTCL LOOKUP INDEX property $prop] $msg\n" -"\t\t\t\t}\n" -"\t\t\t\ttry {\n" -"\t\t\t\t\t$my <WriteProp$prop> $value\n" -"\t\t\t\t} on error {msg opt} {\n" -"\t\t\t\t\tdict set opt -level 2\n" -"\t\t\t\t\treturn -options $opt $msg\n" -"\t\t\t\t} on return {msg opt} {\n" -"\t\t\t\t\tdict incr opt -level 2\n" -"\t\t\t\t\treturn -options $opt $msg\n" -"\t\t\t\t} on break {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\t\"property setter for $prop did a break\"\n" -"\t\t\t\t} on continue {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" -"\t\t\t\t\t\t\"property setter for $prop did a continue\"\n" -"\t\t\t\t}\n" -"\t\t\t}\n" -"\t\t\treturn\n" -"\t\t}\n" -"\t\t::oo::class create configurable {\n" -"\t\t\tprivate variable my\n" -"\t\t\tmethod configure -export args {\n" -"\t\t\t\t::if {![::info exists my]} {\n" -"\t\t\t\t\t::set my [::namespace which my]\n" -"\t\t\t\t}\n" -"\t\t\t\t::if {[::llength $args] == 0} {\n" -"\t\t\t\t\t::oo::configuresupport::ReadAll [self] $my\n" -"\t\t\t\t} elseif {[::llength $args] == 1} {\n" -"\t\t\t\t\t::oo::configuresupport::ReadOne [self] $my \\\n" -"\t\t\t\t\t\t[::lindex $args 0]\n" -"\t\t\t\t} elseif {[::llength $args] % 2 == 0} {\n" -"\t\t\t\t\t::oo::configuresupport::WriteMany [self] $my $args\n" -"\t\t\t\t} else {\n" -"\t\t\t\t\t::return -code error -errorcode {TCL WRONGARGS} \\\n" -"\t\t\t\t\t\t[::format {wrong # args: should be \"%s\"} \\\n" -"\t\t\t\t\t\t\t\"[self] configure \?-option value ...\?\"]\n" -"\t\t\t\t}\n" -"\t\t\t}\n" +"\t\t::oo::define configurable {\n" "\t\t\tdefinitionnamespace -instance configurableobject\n" "\t\t\tdefinitionnamespace -class configurableclass\n" "\t\t}\n" |
