Subversion Repositories or1k

#

# 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

# -----------------------------------------------------------------------------

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

#--------------------------------------------------------------------------------

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 \"[code $this _traceCommand]\"

  eval configure $args

  if {$enterscopecommand != {}} {

    eval $enterscopecommand

  }

}

#--------------------------------------------------------------------------------

# DESTRUCTOR

#--------------------------------------------------------------------------------

body iwidgets::Scopedobject::destructor {} {

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

  if {$exitscopecommand != {}} {

    eval $exitscopecommand

  }

}

#--------------------------------------------------------------------------------#

#

# METHOD: _traceCommand

#

# PURPOSE:

# Callback used to destroy instances when their locally created variable

# goes out of scope.

#

body iwidgets::Scopedobject::_traceCommand {varName varValue op} {

  delete object $this

}

#------------------------------------------------------------------------------

#

# OPTION: -enterscopecommand

#

# PURPOSE:

# Specifies a Tcl command to invoke when a object enters scope.

#

configbody iwidgets::Scopedobject::enterscopecommand {

}

#------------------------------------------------------------------------------

#

# OPTION: -exitscopecommand

#

# PURPOSE:

# Specifies a Tcl command to invoke when an object exits scope.

#

configbody iwidgets::Scopedobject::exitscopecommand {

}