aboutsummaryrefslogtreecommitdiff
path: root/oo.tcl
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2016-03-24 20:50:23 +1000
committerSteve Bennett <steveb@workware.net.au>2016-03-27 11:01:48 +1000
commit45c9e90f3956ae5b8e561be046153bcb6ffc0985 (patch)
tree05994e1aed852670a235fd7bce0d22c5d81ef235 /oo.tcl
parentbd25a29a3766bcf9327c8c8d032d0bb773ca4e6a (diff)
downloadjimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.zip
jimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.tar.gz
jimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.tar.bz2
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>
Diffstat (limited to 'oo.tcl')
-rw-r--r--oo.tcl26
1 files changed, 17 insertions, 9 deletions
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
}