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.  
 # 
 # Here is an example of using a boop object:
 #
 # # A simple member function:
 # proc test::example {this arg} {
 #     # local member variable
 #     variable ${this}::x
 #     variable ${this}::z
 #     incr x
 #     puts "I am $this, passed '$arg' and x is '$x' and z(y) is '$z(y)'"
 # }
 # 
 # # "test" is the class name, "myobject" is the local object name
 # boop test myobject
 # 
 # # using the object and member function
 # $myobject example "argument1"
 # $myobject example "argument2"
 #
 # Boop automatically cleans up the object when it goes out of scope.
 #

 ########################################################################
 #
 # AN COMPLETE EXAMPLE
 #
 # First, a source code 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.0b, released 11/20/2003.
 #
 # Boop is a minimal object-oriented interface for Tcl, written entirely
 # in Tcl, and which plays nicely with debuggers.
 #
 # Copyright (C) 2003 John Buckman
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Lesser General Public
 # License as published by the Free Software Foundation; either
 # version 2.1 of the License, or (at your option) any later version.
 #
 # This library is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # Lesser General Public License for more details.
 #
 # You should have received a copy of the GNU Lesser General Public
 # License along with this library; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 
 # USA
 #
 ###########



 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
 }