#
# 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):
#
# source "boop.tcl"
#
# 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 myobject test]
# $myobject example "argument1"
# $myobject example "argument2"
# }
#
# 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.
#
#
###########
#
# This is Boop version alpha .3, released 1/30/2003.
# Copyright 2003 John Buckman <[email protected]>.
#
# 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 {}
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
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 \[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
}
Someone said: That's a lot of backslashing going on. Couldn't subst clean this up a bit?
John replies: good idea, next pass will use subst.
This latest version does away with the 'delete' command, using 'trace' to implement an automatic destructor when the object goes out of scope. That gets rid of potential memory leaks if an error occurs.