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 destroy
Where 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 __classinit__ ... proc __classdestroy__ ... 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 special procs,
__init__ __destroy__ __classinit__ __classdestroy__
should throw an error when they are explicitly called.
There are shortcuts to achieve direct variable setting : instead of
set a [foo %AUTO% Lennon] set ${a}::name John puts [set ${a}::name]
you just can do
set [a . name] John puts [a -> name]
Then, commons are accessed out of the class definition by
set foo::counter 0
for a class named foo. Remember that the common namespace is mapped (by string map) into the instance's namespace at instanciation. Below is an attempt to achieve this goal - keep namespaces simple and just add a replication mechanism.
New features (2006-04-24)
component varname ?-common boolean ?-initscript script? ?-destroyscript script??
declares a common/instance variable that acts like a subcommand.
alias <name> <command> ?arg ...?
is like interp alias, but with basique objects.
<instance> body <procname> <arglist> <script>
is a shortcut to redefine a proc body in an instance.
basique::class foo { component log -common yes -initscript {set log [Logger]} -destroyscript {$log destroy} alias debug log DEBUG ... }
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 args} { foreach {opt val} $args { switch -- $opt { -common {set common $val} -initscript {::basique::initscript %NAME% $val $var $common} -destroyscript {::basique::destroyscript %NAME% $val $var $common} default { error "option should be one of : -common -initscript -destroyscript" } } } if {![info exists common] || !$common} { return } proc $var {subcmd args} [string map [list VAR $var] { common VAR uplevel [linsert $args 0 $VAR $subcmd] }] } }] namespace eval $name $common_prelude\n$code if {[info exists classes($name,compinit)]} { namespace eval $name $classes($name,compinit) } catch {${name}::__classinit__} set classes($name) $code CreateClass $name } proc initscript {class script var common} { variable classes if {$common} { append classes($class,compinit) "common $var\n $script\n" } else { append classes($class,instcompinit) "variable $var\n $script\n" } } proc destroyscript {class script var common} { variable classes if {$common} { append classes($class,compdestroy) "common $var\n $script\n" } else { append classes($class,instcompdestroy) "variable $var\n $script\n" } } proc cdelete {name} { variable classes unset classes($name) catch {${name}::__classdestroy__} catch {namespace eval $name $classes($name,compdestroy)} foreach sub {instvars compinit instcompinit compdestroy instcompdestroy} { catch {unset classes($name,$sub)} } 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 { return [uplevel namespace eval %NAME% $args] } } 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 body {name arglist body} { proc %OBJ%::$name $arglist $body } proc . {varname} { return %OBJ%::$varname } proc -> {varname} { variable $varname set $varname } proc component {var args} { foreach {opt val} $args { switch -- $opt { -common {set common $val} -initscript - -destroyscript {} default { error "option should be one of : -common -initscript -destroyscript" } } } if {![info exists common] || !$common} { set type variable uplevel variable $var } else { set type common } proc $var {subcmd args} [string map [list TYPE $type VAR $var] { TYPE VAR uplevel [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] { uplevel [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 # builds the instance #puts before if {[info exists ::basique::classes(%NAME%,instcompinit)]} { # initscript at instance level namespace eval %NAME% $::basique::classes(%NAME%,instcompinit) } uplevel [linsert $args 0 ${instance}::__init__] #puts after proc $instance {command args} [string map [list %OBJ% $instance] { if {$command eq "destroy"} { %OBJ%::__destroy__ if {[info exists ::basique::classes(%NAME%,instcompdestroy)]} { # destroyscript at instance level namespace eval %NAME% $::basique::classes(%NAME%,instcompdestroy) } catch {namespace delete %OBJ%} catch {rename %OBJ% ""} return } switch -- $command { __init__ - __destroy__ - __classinit__ - __classdestroy__ - common - instance { error "protected command" } default { return [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) } }
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
Now let's build a singleton handler :
basique::class singleton { common instances proc __classdestroy__ {} { common instances foreach key [array names instances] { $instances($key) destroy } } proc __init__ {} { error "cannot instanciate singleton class" } proc __destroy__ {} { } proc getInstance {class args} { common instances if {![info exists instances($class)]} { set instances($class) [eval [linsert $args 0 $class]] } return $instances($class) } } set inst "" foreach i {1 2 3} { lappend inst [singleton getInstance foo John] } puts "singletons : $inst"