| # |
| # 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 { |
| } |
| |