package provide boop 1.0 ######################################################################## # # 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 a 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 and 3) no array support. Incr Tcl was too huge # for my needs, and I wanted an 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. ######################################################################## # # AN EXAMPLE # # First, a complete minimal example of using BOOP (FYI, init and deinit # are optional): # # package require boop # # namespace eval test {} # # set test::line_colors { 255 13408767 6684876 10079487 39423 } # # proc test::init {this} { # puts "initializing $this" # namespace eval $this { # variable x 0 # variable z # set z(y) 99 # } # } # # proc test::deinit {this} { # puts "deinitializing $this" # } # # proc test::example {this arg} { # variable ${this}::x # variable ${this}::z # incr x # puts "I am $this, passed '$arg' and x is '$x' and z(y) is '$z(y)'" # } # # proc boop_test {} { # boop test myobject # $myobject example "argument1" # $myobject example "argument2" # } # # boop_test # # Running this code with yield this screen output: # # initializing ::test_1 # I am ::test_1 and was passed 'argument1' and x is '1' and z(y) is '99' # I am ::test_1 and was passed 'argument2' and x is '2' and z(y) is '99' # deinitializing ::test_1 # ######################################################################## # # HOW TO USE BOOP # # First, define functions in a namespace, like so: # # namespace eval test {} # # proc test::example {this arg} { # variable ${this}::x # variable ${this}::z # incr x # puts "I am $this, passed '$arg' and x is '$x' and z(y) is '$z(y)'" # } # # # If you want to initialize some member variables in the namespace for this # object, 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} { # namespace eval $this { # variable x 0 # variable z # set z(y) 99 # } # } # # proc test::deinit {this} { # puts "deinitializing $this" # } # # Note how variables for the object are stored in the namespace for the # dynamically created object, allowing easy memory cleanup. # # If you want static member variables, put them in as namespace variables # outside of any proc, like so: # # set test::line_colors { 255 13408767 6684876 10079487 39423 } # # and then refer to then as namespace variables, like so: # # proc test::showcolors {} { puts $test::line_colors } # # Next, create your object with the ::boop command, passing the namespace # name and the variable name that will hold the object, like so: # # boop test myobject # # 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 namespace # as the first parameter, so be sure that all your member functions take # "this" as their first parameter. # # There is no need to delete your object -- it will clean itself up when its # name goes out of scope. # # # UPVAR note # # If you want to upvar a variable passed to you, use "upvar 2" so as to skip # over the shim function, otherwise you won't get the right variable. You # can get rid of this need for "upvar 2" by changing the boop code to use # "uplevel 1" (as indicated below in the source code comments) but if you do # this the TclPro debugger won't show you the stack frame of the calling # functions, as it doesn't like the uplevel command. If you don't use TclPro, # then this won't matter to you. # # By default, BOOP requires the "upvar 2", so where you used to write: # # proc f {varname} { upvar $varname myvar } # # In BOOP you write: # # proc x::f {this varname} { upvar 2 $varname myvar } # ########### ########### # # This is Boop version 1.0, released 3/11/2003. # Copyright 2003 John Buckman . # # This source code is released under the GNU general public license. # ########### proc ::boop {class objectname} { # 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. set namespacename "::${class}_$boop_number" namespace eval $namespacename {} # place a trace statement on the object var so it can be auto-destroyed. uplevel 1 "set $objectname $namespacename" upvar $objectname myobjectname trace variable myobjectname u ${namespacename}::boop_unset # make a command based on this name of the object, and a delete member function # # note, you can run the function given inside an 'uplevel' command if you like, and if you # do, your function can 'upvar' variables as normal, because then the shim disappears. # However, if you do this, then the TclPro debugger can't show you the any info of the state # of the procs above you, and this is a very useful feature of TclPro. So, if you need # to upvar inside a boop function, use "upvar 2 $x y" to skip over the shim 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\] #return \[uplevel 1 \$newfunction\] } \n\ # delete member function for the object \n \ 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 \ \ # delete the name space, in case it was used for anything \n \ namespace delete ::\$this \n \ \ # remove the object command rename \$this {} \n \ } \n \n \ # destroy object when the variable name that holds it goes out of scope \n \ proc ${namespacename}::boop_unset {name1 name2 op} { \n \ ${namespacename} delete \n \ } \n \ \ " eval $helper set initfunction ${class}::init if {[info procs $initfunction] != ""} { eval [list $initfunction $namespacename] } # return the object id return $namespacename }