You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
182 lines
4.9 KiB
Plaintext
182 lines
4.9 KiB
Plaintext
#
|
|
# 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 {
|
|
}
|
|
|