blob: 8a274c777771b6d818946586142e818b2c770d0d (
plain)
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
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
# -----------------------------------------------------------------------------
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
#--------------------------------------------------------------------------------
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 \"[code $this _traceCommand]\"
eval configure $args
if {$enterscopecommand != {}} {
eval $enterscopecommand
}
}
#--------------------------------------------------------------------------------
# DESTRUCTOR
#--------------------------------------------------------------------------------
body iwidgets::Scopedobject::destructor {} {
uplevel $_level trace vdelete _localVar($this) u \"[code $this _traceCommand]\"
if {$exitscopecommand != {}} {
eval $exitscopecommand
}
}
#--------------------------------------------------------------------------------#
#
# METHOD: _traceCommand
#
# PURPOSE:
# Callback used to destroy instances when their locally created variable
# goes out of scope.
#
body iwidgets::Scopedobject::_traceCommand {varName varValue op} {
delete object $this
}
#------------------------------------------------------------------------------
#
# OPTION: -enterscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when a object enters scope.
#
configbody iwidgets::Scopedobject::enterscopecommand {
}
#------------------------------------------------------------------------------
#
# OPTION: -exitscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when an object exits scope.
#
configbody iwidgets::Scopedobject::exitscopecommand {
}
|
