neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

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