oo: constructor, unknown and bug fixes

- Added support for constructor, runs on new object creation
- Added support for "unknown" method
- Rename some dispatch variables (add double underscore) to avoid collision with user variables

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 47 insertions, 10 deletions

diff --git a/README.oo b/README.oo
index 57a1af1..8dd7a30 100644
--- a/README.oo
+++ b/README.oo
@@ -100,6 +100,18 @@ on a specific object.
 	the instance variables, and evaluate the body in that context.
 	This can be used for one-off evaluation to avoid declaring a method.
 
+RESERVED METHODS
+----------------
+The following methods are special
+
+  constructor::
+    If this method exists, it is invoked (with no arguments) after an object is created
+
+  unknown methodname ...::
+    If an undefined method is invoked, and this method exists, it is called with the methodname
+	and the original arguments
+
+
 CREATING OBJECTS
 ----------------
 An object is created with the 'new' method, or simply by using the classname shortcut.
@@ -120,6 +132,8 @@ For example:
   . $b get balance
   1000
 
+If the 'constructor' method exists, it is invoked just after the object is created
+
 DECLARING METHODS
 -----------------
 In addition to the predefined methods, new methods may be declared, or existing
diff --git a/examples/ootest.tcl b/examples/ootest.tcl
index d3d48c3..731e46a 100644
--- a/examples/ootest.tcl
+++ b/examples/ootest.tcl
@@ -13,6 +13,14 @@ puts "Account vars=[Account vars]"
 puts "Account methods=[Account methods]"
 puts ""
 
+# Create a constructor. This does validation, but it could
+# do other things
+Account method constructor {} {
+	if {$balance < 0} {
+		error "Can't initialise account with a -ve balance"
+	}
+}
+
 # Now flesh out the class with some methods
 # Could use 'Account method' here instead
 Account method deposit {amount} {
@@ -57,10 +65,17 @@ $a describe
 puts ""
 
 # Now create a new subclass
+# Could change the initial balance here too
 class CreditAccount Account {
 	limit -1000
-	balance -20
 }
+
+CreditAccount method constructor {} {
+	# Dummy constructor
+	# If desired, manually invoke the baseclass constructor
+	super constructor
+}
+
 # Override the 'withdraw' method to allow overdrawing
 CreditAccount method withdraw {amount} {
 	if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"}
diff --git a/oo.tcl b/oo.tcl
index b57daf5..a05aa01 100644
--- a/oo.tcl
+++ b/oo.tcl
@@ -41,18 +41,26 @@ proc class {classname {baseclasses {}} classvars} {
 		# This is the object dispatcher for $classname.
 		# Store the classname in both the ref value and tag, for debugging
 		# ref tag (for debugging)
-		proc [ref $classname $classname "$classname finalize"] {method args} {classname instvars} {
+		set obj [ref $classname $classname "$classname finalize"]
+		proc $obj {method args} {classname instvars} {
 			if {![exists -command "$classname $method"]} {
-				return -code error "$classname, unknown method \"$method\": should be [join [$classname methods] ", "]"
+				if {![exists -command "$classname unknown"]} {
+					return -code error "$classname, unknown method \"$method\": should be [join [$classname methods] ", "]"
+				}
+				return ["$classname unknown" $method {*}$args]
 			}
 			"$classname $method" {*}$args
 		}
+		if {[exists -command "$classname constructor"]} {
+			$obj constructor
+		}
+		return $obj
 	}
 	# Finalizer to invoke destructor during garbage collection
 	proc "$classname finalize" {ref classname} { $ref destroy }
 	# Method creator
-	proc "$classname method" {method arglist body} classname {
-		proc "$classname $method" $arglist {body} {
+	proc "$classname method" {method arglist __body} classname {
+		proc "$classname $method" $arglist {__body} {
 			# Make sure this isn't incorrectly called without an object
 			if {![uplevel exists instvars]} {
 				return -code error -level 2 "\"[lindex [info level 0] 0]\" method called with no object"
@@ -60,9 +68,9 @@ proc class {classname {baseclasses {}} classvars} {
 			set self [lindex [info level -1] 0]
 			# Note that we can't use 'dict with' here because
 			# the dict isn't updated until the body completes.
-			foreach _ [$self vars] {upvar 1 instvars($_) $_}
-			unset _
-			eval $body
+			foreach __ [$self vars] {upvar 1 instvars($__) $__}
+			unset __
+			eval $__body
 		}
 	}
 	# Other simple class procs
@@ -77,9 +85,9 @@ proc class {classname {baseclasses {}} classvars} {
 	# Pre-defined some instance methods
 	$classname method destroy {} { rename $self "" }
 	$classname method get {var} { set $var }
-	$classname method eval {{locals {}} code} {
+	$classname method eval {{locals {}} __code} {
 		foreach var $locals { upvar 2 $var $var }
-		eval $code
+		eval $__code
 	}
 	return $classname
 }