137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
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
|
-
-
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
|
set item $::_Debug::ProcEditor(current)
set d $allcmds($item)
set type [dict get $d type]
set parent [dict get $d parent]
set name [dict get $d name]
if {$type eq "proc"} {
uplevel \#0 [list proc $item \
$::_Debug::ProcEditor(args) $body]
set todo [list proc $item \
$::_Debug::ProcEditor(args) $body]
set ::_Debug::redefines($item) $todo
uplevel \#0 $todo
} elseif {$type eq "method"} {
uplevel \#0 [list oo::define $parent method $name \
set todo [list oo::define $parent method $name \
$::_Debug::ProcEditor(args) $body]
set ::_Debug::redefines($parent..$name) $todo
uplevel \#0 $todo
}
}
proc ::_Debug::ProcEditorCopy {} {
clipboard clear
foreach item [array names ::_Debug::redefines] {
clipboard append $::_Debug::redefines($item)\n
}
}
# Tracing of commands
proc ::_Debug::ProcEditorTrace {level} {
variable allcmds
set item $::_Debug::ProcEditor(current)
|
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
|
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
|
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
|
ttk::toplevel $top -padx 3 -pady 3
wm title $top "Proc Editor"
ttk::frame $top.ftree
set ::_Debug::ProcEditor(filter) ""
set ::_Debug::ProcEditor(filterx) ""
ttk::entry $top.ftree.ef -textvariable ::_Debug::ProcEditor(filter)
addBalloon $top.ftree.ef "Filter"
bind $top.ftree.ef <KeyRelease> {::_Debug::ProcEditorFilter %A %K}
set tree $top.ftree.tree
set ::_Debug::ProcEditor(treeW) $tree
ttk::treeview $tree -height 20 -selectmode browse -show "tree" \
-yscrollcommand "$top.ftree.sby set"
ttk::scrollbar $top.ftree.sby -orient vertical -command "$tree yview"
$tree tag configure highlight -background pink
$tree column "#0" -minwidth 50 -width 200
pack $top.ftree.ef -side "top" -fill x -padx 3 -pady 3
pack $top.ftree.sby -side right -fill y -pady 3 -padx {0 3}
pack $tree -fill both -expand 1 -pady 3 -padx {3 0}
TreePopulate $tree
bind $tree <<TreeviewSelect>> ::_Debug::ProcEditorSelected
ttk::label $top.l1a -text "Parent" -anchor w
ttk::label $top.l1b -textvariable ::_Debug::ProcEditor(parent) -anchor w
ttk::label $top.l2a -text "Proc/Method" -anchor w
ttk::label $top.l2b -textvariable ::_Debug::ProcEditor(proc) -anchor w
ttk::label $top.l3a -text "Args" -anchor w
ttk::label $top.l3b -textvariable ::_Debug::ProcEditor(args) -anchor w
ttk::button $top.bc -text "Copy" -command ::_Debug::ProcEditorCopy
addBalloon $top.bc "Put all redefines on clipboard"
set ::_Debug::ProcEditor(bodyW) [text $top.t -yscrollcommand "$top.sby set" \
-width 90]
ttk::scrollbar $top.sby -orient vertical -command "$top.t yview"
ttk::frame $top.fb
ttk::button $top.b1 -text "Redefine" -command ::_Debug::ProcEditorRedefine
addBalloon $top.b1 "Redefine for this session"
ttk::button $top.b2 -text "Disas" -command ::_Debug::ProcEditorDisas
addBalloon $top.b2 "Show byte code"
ttk::button $top.b3 -text "Trace" -command "::_Debug::ProcEditorTrace 1"
addBalloon $top.b3 "Enable execution trace"
ttk::button $top.b4 -text "Tr Step" -command "::_Debug::ProcEditorTrace 2"
addBalloon $top.b4 "Enable detailed execution trace"
ttk::button $top.b5 -text "Tr Off" -command "::_Debug::ProcEditorTrace 0"
addBalloon $top.b5 "Disable execution trace"
set ::_Debug::ProcEditor(traceWs) [list $top.b3 $top.b4 $top.b5]
grid $top.b1 $top.b2 $top.b3 $top.b4 $top.b5 -in $top.fb
grid columnconfigure $top.fb all -weight 1 -uniform a
grid $top.ftree $top.l1a $top.l1b - -padx 3 -pady 3 -sticky news
grid ^ $top.l2a $top.l2b - -padx 3 -pady 3 -sticky we
grid ^ $top.l3a $top.l3b - -padx 3 -pady 3 -sticky we
grid ^ $top.t - $top.sby -padx 3 -pady 3 -sticky news
grid ^ $top.fb - - -padx 3 -pady 3 -sticky we
grid $top.ftree $top.l1a $top.l1b - $top.bc - -padx 3 -pady 3 -sticky news
grid ^ $top.l2a $top.l2b - - - -padx 3 -pady 3 -sticky we
grid ^ $top.l3a $top.l3b - - - -padx 3 -pady 3 -sticky we
grid ^ $top.t - - - $top.sby -padx 3 -pady 3 -sticky news
grid ^ $top.fb - - - - -padx 3 -pady 3 -sticky we
grid columnconfigure $top 2 -weight 1
grid rowconfigure $top $top.t -weight 1
}
#-----------------------------------------------------------------------------
# Procedure/method information collection
|