share/iwidgets4.0.1/scripts/scopedobject.itcl

#
# Scopedobject
# -----------------------------------------------------------------------------
# Implements a base class for defining Itcl classes which posses
# scoped behavior like Tcl variables.  The objects are only accessible
# within the procedure in which they are instantiated and are deleted
# when the procedure returns.
#
# Option(s):
#
#   -enterscopecommand: Tcl command to invoke when a object enters scope
#                       (i.e. when it is created ...).
#
#   -exitscopecommand: Tcl command to invoke when a object exits scope
#                       (i.e. when it is deleted ...).
#
# Note(s):
#
# Although a Scopedobject instance will automatically destroy itself
# when it goes out of scope, one may explicity delete an instance
# before it destroys itself.
#
# Example(s):
#
#  Creating an instance at local scope in a procedure provides
#  an opportunity for tracing the entry and exiting of that
#  procedure.  Users can register their proc/method tracing handlers
#  with the Scopedobject class via either of the following two ways:
#
#  1.) configure the "-exitscopecommand" on a Scopedobject instance;
#      e.g.
#      #!/usr/local/bin/wish
#
#      proc tracedProc {} {
#        scopedobject #auto \
#            -exitscopecommand {puts "enter tracedProc"} \
#            -exitscopecommand {puts "exit tracedProc"}
#      }
#
#  2.) deriving from the Scopedobject and implementing the exit handling
#      in their derived classes destructor.
#      e.g.
#
#      #!/usr/local/bin/wish
#
#      class Proctrace {
#        inherit Scopedobject
#
#        proc procname {} {
#          return [info level -1]
#        }
#
#        constructor {args} {
#          puts "enter [procname]"
#          eval configure $args
#        }
#
#        destructor {
#          puts "exit [procname]"
#        }
#      }
#
#      proc tracedProc {} {
#        Proctrace #auto
#      }
#
# -----------------------------------------------------------------------------
#   AUTHOR:  John Tucker
#            DSC Communications Corp  
# -----------------------------------------------------------------------------

itcl::class iwidgets::Scopedobject {

  #
  # OPTIONS:
  #
  public {
    variable enterscopecommand {}
    variable exitscopecommand {}
  }

  #
  # PUBLIC:
  #
  constructor {args} {}
  destructor {}

  #
  # PRIVATE:
  #
  private {

    # Implements the Tcl trace command callback which is responsible
    # for destroying a Scopedobject instance when its corresponding
    # Tcl variable goes out of scope.
    #
    method _traceCommand {varName varValue op}

    # Stores the stack level of the invoking procedure in which
    # a Scopedobject instance in created.
    #
    variable _level 0
  }
}

#
# Provide a lowercased access method for the Scopedobject class.
# 
proc ::iwidgets::scopedobject {pathName args} {
    uplevel ::iwidgets::Scopedobject $pathName $args
}

#--------------------------------------------------------------------------------
# CONSTRUCTOR
#--------------------------------------------------------------------------------
itcl::body iwidgets::Scopedobject::constructor {args} {

  # Create a local variable in the procedure which this instance was created,
  # and then register out instance deletion command (i.e. _traceCommand)
  # to be called whenever the local variable is unset.
  #
  # If this is a derived class, then we will need to perform the variable creation
  # and tracing N levels up the stack frame, where:
  #   N = depth of inheritance hierarchy.
  #
  set depth [llength [$this info heritage]]
  set _level "#[uplevel $depth info level]"
  uplevel $_level set _localVar($this) $this
  uplevel $_level trace variable _localVar($this) u \"[itcl::code $this _traceCommand]\"

  eval configure $args

  if {$enterscopecommand != {}} {
    eval $enterscopecommand
  }
}

#--------------------------------------------------------------------------------
# DESTRUCTOR
#--------------------------------------------------------------------------------
itcl::body iwidgets::Scopedobject::destructor {} {

  uplevel $_level trace vdelete _localVar($this) u \"[itcl::code $this _traceCommand]\"

  if {$exitscopecommand != {}} {
    eval $exitscopecommand
  }
}

#--------------------------------------------------------------------------------#
#
# METHOD: _traceCommand
#
# PURPOSE: 
# Callback used to destroy instances when their locally created variable
# goes out of scope.
#
itcl::body iwidgets::Scopedobject::_traceCommand {varName varValue op} {
  delete object $this
}

#------------------------------------------------------------------------------
#
# OPTION: -enterscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when a object enters scope.
#
itcl::configbody iwidgets::Scopedobject::enterscopecommand {
}

#------------------------------------------------------------------------------
#
# OPTION: -exitscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when an object exits scope.
#
itcl::configbody iwidgets::Scopedobject::exitscopecommand {
}