summaryrefslogtreecommitdiffstats
path: root/generic/tclOOScript.h
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOScript.h')
-rw-r--r--generic/tclOOScript.h204
1 files changed, 4 insertions, 200 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index a763092..98fa20e 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -258,214 +258,18 @@ static const char *tclOOSetupScript =
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"
-"\t::namespace eval configuresupport {\n"
-"\t\tnamespace path ::tcl\n"
-"\t\tproc PropertyImpl {readslot writeslot args} {\n"
-"\t\t\tfor {set i 0} {$i < [llength $args]} {incr i} {\n"
-"\t\t\t\tset prop [lindex $args $i]\n"
-"\t\t\t\tif {[string match \"-*\" $prop]} {\n"
-"\t\t\t\t\treturn -code error -level 2 \\\n"
-"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n"
-"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not begin with -\"\n"
-"\t\t\t\t}\n"
-"\t\t\t\tif {$prop ne [list $prop]} {\n"
-"\t\t\t\t\treturn -code error -level 2 \\\n"
-"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n"
-"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must be a simple word\"\n"
-"\t\t\t\t}\n"
-"\t\t\t\tif {[string first \"::\" $prop] != -1} {\n"
-"\t\t\t\t\treturn -code error -level 2 \\\n"
-"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n"
-"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain namespace separators\"\n"
-"\t\t\t\t}\n"
-"\t\t\t\tif {[string match {*[()]*} $prop]} {\n"
-"\t\t\t\t\treturn -code error -level 2 \\\n"
-"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n"
-"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain parentheses\"\n"
-"\t\t\t\t}\n"
-"\t\t\t\tset realprop [string cat \"-\" $prop]\n"
-"\t\t\t\tset getter [format {::set [my varname %s]} $prop]\n"
-"\t\t\t\tset setter [format {::set [my varname %s] $value} $prop]\n"
-"\t\t\t\tset kind readwrite\n"
-"\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\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\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"
-"\t\t\t\t\t\t\tset getter $arg\n"
-"\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\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"
-"\t\t\t\t\t\t\tset setter $arg\n"
-"\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\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"
-"\t\t\t\t\t\t\tset kind [prefix match -message \"kind\" -error [list \\\n"
-"\t\t\t\t\t\t\t\t\t-level 2 \\\n"
-"\t\t\t\t\t\t\t\t\t-errorcode [list TCL LOOKUP INDEX kind $arg]] {\n"
-"\t\t\t\t\t\t\t\treadable readwrite writable\n"
-"\t\t\t\t\t\t\t} $arg]\n"
-"\t\t\t\t\t\t}\n"
-"\t\t\t\t\t}\n"
-"\t\t\t\t}\n"
-"\t\t\t\tset reader <ReadProp$realprop>\n"
-"\t\t\t\tset writer <WriteProp$realprop>\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 2 [list method $reader -unexport {} $getter]\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 2 [list method $writer -unexport {value} $setter]\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 2 [list method $reader -unexport {} $getter]\n"
-"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
-"\t\t\t\t\t}\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\t\t::oo::configuresupport::readableproperties \\\n"
-"\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n"
-"\t\t\t}\n"
+"\tnamespace eval configuresupport {\n"
+"\t\t::namespace eval configurableclass {\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\t\t::oo::configuresupport::objreadableproperties \\\n"
-"\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n"
-"\t\t\t}\n"
+"\t\t::namespace eval configurableobject {\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"
"\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 {TCL OO 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 {TCL OO 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 {TCL OO 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 {TCL OO 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 {TCL OO 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 {TCL OO 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"