diff options
Diffstat (limited to 'itcl/iwidgets/generic/scopedobject.itcl')
| -rw-r--r-- | itcl/iwidgets/generic/scopedobject.itcl | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/itcl/iwidgets/generic/scopedobject.itcl b/itcl/iwidgets/generic/scopedobject.itcl new file mode 100644 index 00000000000..e18a0bbb4a1 --- /dev/null +++ b/itcl/iwidgets/generic/scopedobject.itcl @@ -0,0 +1,181 @@ +# +# 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 { +} + |