Sarnold thinks that classes should look - as possible as they can - like namespaces, because it is the current encapsulation model. It may be extreme, but some developers may want to convert quickly a namespace in a Class or Megawidget - while the opposite cannot be as simple. I would like to see:
namespace class foo {
common counter
variable names
proc __init__ {args} {
common counter
incr counter
variable names
array set names $args
}
# it has to look like a normal Tcl proc, so it has an arglist
proc __destroy__ {} {
common counter
incr counter -1
}
proc display {} {
variable names
puts "My name is $names(first) $names(last)"
}
proc count {} {
common counter
return $counter
}
}
foo new name first Richard last Heinz
name destroy
set name [foo %AUTO% first Richard last Heinz]
name display
set name::names(first) George
name display
# generates an error, because it is an instance method
#foo display
$name destroyWhere common would behave like variable, with a static qualifier. I submit that a sequence of variable bar may be replaced by instance command that wraps all variable calls related to (instance) variables.
namespace class foo {
variable a
variable name
variable tool
variable logfile
proc __init__ ...
proc __destroy__ ...
proc display {{intologfile no}} {
instance ; # no need to invoke 'variable' again
if {$intologfile} {
puts $logfile "a=$a name=$name tool=$tool"
} else {
puts "a=$a name=$name tool=$tool"
}
}
...
}And a proc is a class method, until it invokes variable or instance commands, or uses an instance namespace qualifier. During instanciation, all namespace qualifiers equal to ::foo should be replaced by the instance's namespace qualifier, so that we can still use -textvariable Tk option.
namespace class foo {
variable label
proc __init__ {w} {
label $w.lbl -textvariable ::foo::label
pack $w.lbl
}
...
}The class name may instantiate objects by two methods:
foo new <instancename> <constructor_args> foo %AUTO% <constructor_args>
Any proc (without use of instance variables) could be called this way :
foo <myproc> <args>
The two special procs,
__init__ __destroy__
should throw an error when they are explicitly called.
Below is an attempt to achieve this goal - keep namespaces simple and just add a replication mechanism.
basique.tcl
namespace eval ::basique {
namespace export class
variable classes
array set classes {}
proc class {name code} {
if {[string range $name 0 1] ne "::"} {
set name ::$name
}
variable classes
if {[info exists classes($name)]} {
cdelete $name
}
set common_prelude [string map [list %NAME% $name] {
# does nothing
proc variable {var args} {
lappend ::basique::classes(%NAME%,instvars) $var
}
# provide common variable statement
proc common {var args} {
if {[llength $args] > 1} {
error "common varname ?default?"
}
if {[llength $args] == 0} {
uplevel ::variable $var
return
}
uplevel ::variable $var [lindex $args 0]
return
}
proc alias {name args} {
if {[llength $name] != 1} {
error "cannot create such a composite alias"
}
proc $name {args} [string map [list ARGS $args] {
eval [linsert $args 0 ARGS]
}]
}
proc component {var {option -common} {value no}} {
if {$option ne "-common"} {
error "component var ?-common boolean?"
}
if {!$value} {
variable $var
return
}
proc $var {subcmd args} [string map [list VAR $var] {
common VAR
eval [linsert $args 0 $VAR $subcmd]
}]
}
}]
namespace eval $name $common_prelude\n$code
set classes($name) $code
CreateClass $name
}
proc cdelete {name} {
variable classes
foreach key [array names classes $name*] {
unset classes($key)
}
catch {namespace delete $name}
catch {rename $name ""}
}
# crée la commande qui instanciera les objets
proc CreateClass {name} {
variable classes
# le constructeur réel (le constructeur public est __init__)
proc $name {args} [string map [list %NAME% $name] {
if {![llength $args]} {
set args {%AUTO%}
}
if {[lindex $args 0] eq "%AUTO%"} {
set args [linsert $args 0 new]
}
switch -- [lindex $args 0] {
new {
set instance [lindex $args 1]
if {$instance eq "%AUTO%"} {
set instance [::basique::autoname %NAME%]
}
set args [lrange $args 2 end]
}
default {
namespace eval %NAME% $args
return
}
}
if {[string range $instance 0 1] ne "::"} {
set instance ::$instance
}
# creates the prelude
set instance_prelude [string map [list %OBJ% $instance] {
proc common {var args} {
if {[llength $args]>1} {
error "common var ?default?"
}
if {[llength $args]==0} {
uplevel [list upvar %NAME%::$var $var]
}
}
proc destroy {} {
__destroy__
catch {namespace delete %OBJ%}
catch {rename %OBJ% ""}
return
}
proc . {varname} {
return %OBJ%::$varname
}
proc -> {varname} {
variable $varname
set $varname
}
proc component {var {option -common} {value no}} {
if {$option ne "-common"} {
error "component var ?-common boolean?"
}
if {$value} {
set type common
} else {
set type variable
uplevel variable $var
}
proc $var {subcmd args} [string map [list TYPE $type VAR $var] {
TYPE VAR
eval [linsert $args 0 $VAR $subcmd]
}]
}
proc alias {name args} {
if {[llength $name] != 1} {
error "cannot create such a composite alias"
}
proc $name {args} [string map [list ARGS $args] {
eval [linsert $args 0 ARGS]
}]
}
}]
# insert 'instance' where you want quickly to get instance variables
# (instead, you would have to type lots of 'variable' statements)
append instance_prelude "proc instance \{\} \{\nuplevel \{\n"
foreach var $::basique::classes(%NAME%,instvars) {
append instance_prelude "variable $var\n"
}
append instance_prelude "\}\n\}\n"
# %NAME% is preprocessed into ::myclass
# then ::myclass body's namespace is mapped into the instance namespace
set body [string map [list [string trim %NAME% :]:: \
[string trim $instance :]::] $::basique::classes(%NAME%)]
namespace eval $instance $instance_prelude
namespace eval $instance $body
# export public procs
#set procs [::basique::lfilter proc [info procs ${instance}::*] {[string first ${instance}:: $proc] == 0}]
set procs [info procs ${instance}::*]
set procs [::basique::lfilter x [string map [list ${instance}:: ""] $procs] {
[lsearch {__init__ __destroy__ common instance} $x] < 0
}]
namespace eval $instance [linsert $procs 0 namespace export]
# builds the instance
#puts before
uplevel [linsert $args 0 ${instance}::__init__]
#puts after
if {[::basique::WeHaveNamespaceEnsemble]} {
namespace eval $instance {namespace ensemble create}
} else {
proc $instance {command args} [string map [list %OBJ% $instance] {
uplevel [linsert $args 0 %OBJ%::$command]
}]
}
return $instance
}]
}
proc lfilter {var list condition} {
upvar $var x
set out ""
foreach x $list {
if {[uplevel expr $condition]} {
lappend out $x
}
}
return $out
}
proc autoname {name} {
variable classes
if {![info exists classes($name)]} {
error "class $name not found"
}
if {![info exists classes($name,counter)]} {
set classes($name,counter) 0
}
while {[llength [info procs ${name}__$classes($name,counter)]]} {
incr classes($name,counter)
}
return ${name}__$classes($name,counter)
}
proc WeHaveNamespaceEnsemble {} {
return [package vsatisfies [package require Tcl] 8.5]
}
}Example
basique::class foo {
variable name
proc __init__ {vname} {
instance
set name $vname
}
proc __destroy__ {} {
instance
puts "Goodbye $name !"
}
}
foo new a Arnold
set [a . name] Meyer
puts [a -> name]
a destroy