diff options
Diffstat (limited to 'generic/tclOOScript.h')
| -rw-r--r-- | generic/tclOOScript.h | 92 |
1 files changed, 3 insertions, 89 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index 7538d48..98fa20e 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -258,99 +258,13 @@ 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 {stdInstaller 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\tset realprop [string cat \"-\" $prop]\n" -"\t\t\t\tunset -nocomplain getter setter\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 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 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" -"\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 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" -"\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 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" -"\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\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 1 [list $stdInstaller $prop $addReader $addWriter]\n" -"\t\t\t\t} on error {msg opt} {\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 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 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 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 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 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::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\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::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\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" |