# BOOP stands for "basic object oriented programming" -- this is a minimal object oriented # helper that gives you tcl objects, member functions, object-local storage, memory cleanup # all with one tiny ::boop function of less than 100 lines of tcl. # # The aim of BOOP is to provide very simple object oriented programming helper in Tcl, # without doing anything fancy or complicated, that requires a learning curve or causes # other problems. If you want a full OOP Tcl environment, go for "incr Tcl" or "stoop". # # I tried to use stoop, but ran into a number of problems, namely: 1) it clashes badly # with the TclPro debugger, 2) member functions seem to be wrapped in a silent catch{} # statement, making debugging buggy member functions very difficult. Incr Tcl was too huge # for my needs, and I wanted all Tcl-solution, with a minimal learning curve for my coworkers. # I didn't want write OOPy Tcl code that no-one else would understand. # # In short, I wanted a Tcl OOP helper to be as simple, transparent as possible, and not to muck # with built in commands or cause problems with the TclPro debugger or confuse people reading # my OOPy code. # # # HOW TO USE BOOP # # Define functions in a namespace, like so: # # namespace eval test {} # # proc test::example {this arg} { # incr ::($this,z) # puts "I am $this and was passed '$arg' and z is '$::($this,z)'" # } # # # If you want to initialize some member variables, you can do it in an init function, but # this is optional (the namespace's init function is called automatically at object construction time) # and the objectid is passed in "this". You can also optionally create a deinit function: # # proc test::init {this} { # puts "initializing $this" # set ::($this,z) 0 # } # # proc test::deinit {this} { # puts "deinitializing $this" # } # # Note how variables for the object are stored in the ::($this,varname) global array. If you need # to store arrays in your object, use "array get/set" to convert to/from a list. # # Next, create your object with the ::boop command, passing the namespace name, like so: # # set myobject boop test # # If your namespace has a namespace::init function it is called automatically by BOOP at this point. # # Then, just use the proc name (w/o the namespace name) as the 1st parameter, using the # objectid as the proc name, like so: # # $myobject example "argument1" # $myobject example "argument2" # # BOOP will automatically call your namespace::functionname with the objectid as the first parameter, so # be sure that all your member functions take "this" as their first parameter. # # Finally, be a good citizen and clean up your object with the "delete" member function, # which will first call your namespace::deinit function (if one exists) and then will # clean up the object, any variables in the global unnamed array with ($objectid*) in the # name, and the namespace. Call delete like so: # # $myobject delete # # # All in all, a complete example looks like this (bear in mind that init and deinit are optional): # # namespace eval test {} # # proc test::init {this} { # puts "initializing $this" # set ::($this,z) 0 # } # # proc test::deinit {this} { # puts "deinitializing $this" # } # # proc test::example {this arg} { # incr ::($this,z) # puts "I am $this and was passed '$arg' and z is '$::($this,z)'" # } # # set myobject boop test # $myobject example "argument1" # $myobject example "argument2" # $myobject delete # # Running this code with yield this screen output: # # initializing ::test_1 # I am ::test_1 and was passed 'argument1' and z is '1' # I am ::test_1 and was passed 'argument2' and z is '2' # deinitializing ::test_1 # # # This Boop version alpha .1, released 1/29/2003, copyright 2003 John Buckman. # # This source code is released under the GNU general public license. #
proc ::boop {class} {
# make a number variable for this
if {![info exists ${class}::boop_number]} {
namespace eval ${class} { variable boop_number 0 }
}
# keep track of the number of the object, so we don't duplicate
variable ${class}::boop_number
# increment the number of the object
incr ${class}::boop_number
# make a namespace for this object, so that member functions can store
# variables in the namespace if they want to (need to make examples of this for docs)
set namespacename "::${class}_$boop_number"
namespace eval $namespacename {}
# make a command based on this name of the object, and a delete member function
set helper " \proc $namespacename {args} { \n\
set function \[lindex \$args 0\] \n\
set args \[lreplace \$args 0 0\] \n\
set newfunction \[concat ::${class}::\${function} ${namespacename} \$args\] \n\
return \[eval \$newfunction\]} \n\
# delete member function for the object proc ${class}::delete {this} { \n \
\
# call the deinit function if it exists \n \
set deinitfunction ::${class}::deinit \n \
if {\[info procs \$deinitfunction\] != \"\"} { \n \
eval \[list \$deinitfunction \$this\] \n \
} \n \
\
# clear the un-named array of all names that start with this object name
array unset {::} \"\${this}*\"
\
# delete the name space, in case it was used for anything
namespace delete ::\$this \n \
\
# remove the object command
rename \$this {} \n \} \
"
eval $helper
set initfunction ${class}::init
if {[info procs $initfunction] != ""} {
eval [list $initfunction $namespacename]
}
# return the object id
return $namespacename}