/usr/share/tcltk/iwidgets4.1.0/scripts/scopedobject.itcl is in iwidgets4 4.1.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | #
# 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 {
}
|