Now passing tests

1 files changed, 2 insertions, 143 deletions

diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl
index 4591a1b..2843dff 100644
--- a/tools/tclOOScript.tcl
+++ b/tools/tclOOScript.tcl
@@ -612,156 +612,15 @@
 
 	# ------------------------------------------------------------------
 	#
-	# oo::configuresupport::ReadAll --
-	#
-	#	The implementation of [$o configure] with no extra arguments.
-	#
-	# ------------------------------------------------------------------
-
-	proc ReadAll {object my} {
-	    set result {}
-	    foreach prop [info object properties $object -all -readable] {
-		try {
-		    dict set result $prop [$my <ReadProp$prop>]
-		} on error {msg opt} {
-		    dict set opt -level 2
-		    return -options $opt $msg
-		} on return {msg opt} {
-		    dict incr opt -level 2
-		    return -options $opt $msg
-		} on break {} {
-		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-			"property getter for $prop did a break"
-		} on continue {} {
-		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-			"property getter for $prop did a continue"
-		}
-	    }
-	    return $result
-	}
-
-	# ------------------------------------------------------------------
-	#
-	# oo::configuresupport::ReadOne --
-	#
-	#	The implementation of [$o configure -prop] with that single
-	#	extra argument.
-	#
-	# ------------------------------------------------------------------
-
-	proc ReadOne {object my propertyName} {
-	    set props [info object properties $object -all -readable]
-	    try {
-		set prop [prefix match -message "property" $props $propertyName]
-	    } on error {msg} {
-		catch {
-		    set wps [info object properties $object -all -writable]
-		    set wprop [prefix match $wps $propertyName]
-		    set msg "property \"$wprop\" is write only"
-		}
-		return -code error -level 2 -errorcode [list \
-			TCL LOOKUP INDEX property $propertyName] $msg
-	    }
-	    try {
-		set value [$my <ReadProp$prop>]
-	    } on error {msg opt} {
-		dict set opt -level 2
-		return -options $opt $msg
-	    } on return {msg opt} {
-		dict incr opt -level 2
-		return -options $opt $msg
-	    } on break {} {
-		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-		    "property getter for $prop did a break"
-	    } on continue {} {
-		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-		    "property getter for $prop did a continue"
-	    }
-	    return $value
-	}
-
-	# ------------------------------------------------------------------
-	#
-	# oo::configuresupport::WriteMany --
-	#
-	#	The implementation of [$o configure -prop val ?-prop val...?].
-	#
-	# ------------------------------------------------------------------
-
-	proc WriteMany {object my setterMap} {
-	    set props [info object properties $object -all -writable]
-	    foreach {prop value} $setterMap {
-		try {
-		    set prop [prefix match -message "property" $props $prop]
-		} on error {msg} {
-		    catch {
-			set rps [info object properties $object -all -readable]
-			set rprop [prefix match $rps $prop]
-			set msg "property \"$rprop\" is read only"
-		    }
-		    return -code error -level 2 -errorcode [list \
-			    TCL LOOKUP INDEX property $prop] $msg
-		}
-		try {
-		    $my <WriteProp$prop> $value
-		} on error {msg opt} {
-		    dict set opt -level 2
-		    return -options $opt $msg
-		} on return {msg opt} {
-		    dict incr opt -level 2
-		    return -options $opt $msg
-		} on break {} {
-		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-			"property setter for $prop did a break"
-		} on continue {} {
-		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
-			"property setter for $prop did a continue"
-		}
-	    }
-	    return
-	}
-
-	# ------------------------------------------------------------------
-	#
 	# oo::configuresupport::configurable --
 	#
 	#	The class that contains the implementation of the actual
 	#	'configure' method (mixed into actually configurable classes).
-	#	Great care needs to be taken in these methods as they are
-	#	potentially used in classes where the current namespace is set
-	#	up very strangely.
+	#	The 'configure' method is in tclOOBasic.c.
 	#
 	# ------------------------------------------------------------------
 
-	::oo::class create configurable {
-	    private variable my
-	    #
-	    # configure --
-	    #	Method for providing client access to the property mechanism.
-	    #	Has a user-facing API similar to that of [chan configure].
-	    #
-	    method configure -export args {
-		::if {![::info exists my]} {
-		    ::set my [::namespace which my]
-		}
-		::if {[::llength $args] == 0} {
-		    # Read all properties
-		    ::oo::configuresupport::ReadAll [self] $my
-		} elseif {[::llength $args] == 1} {
-		    # Read a single property
-		    ::oo::configuresupport::ReadOne [self] $my \
-			[::lindex $args 0]
-		} elseif {[::llength $args] % 2 == 0} {
-		    # Set properties, one or several
-		    ::oo::configuresupport::WriteMany [self] $my $args
-		} else {
-		    # Invalid call
-		    ::return -code error -errorcode {TCL WRONGARGS} \
-			[::format {wrong # args: should be "%s"} \
-			    "[self] configure ?-option value ...?"]
-		}
-	    }
-
+	::oo::define configurable {
 	    definitionnamespace -instance configurableobject
 	    definitionnamespace -class configurableclass
 	}