Plug implementation in... and fix the silly bugs

1 files changed, 18 insertions, 27 deletions

diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 1903b49..c6a60a6 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -260,32 +260,11 @@ static const char *tclOOSetupScript =
 "\t}\n"
 "\t::namespace eval configuresupport {\n"
 "\t\tnamespace path ::tcl\n"
-"\t\tproc PropertyImpl {readslot writeslot args} {\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\tif {[string match \"-*\" $prop]} {\n"
-"\t\t\t\t\treturn -code error -level 2 \\\n"
-"\t\t\t\t\t\t-errorcode {TCLOO 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 {TCLOO 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 {TCLOO 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 {TCLOO 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\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"
@@ -324,29 +303,40 @@ static const char *tclOOSetupScript =
 "\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 2 [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\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 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\tif {[info exist getter]} {\n"
+"\t\t\t\t\tuplevel 2 [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}\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::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"
@@ -357,6 +347,7 @@ static const char *tclOOSetupScript =
 "\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::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"