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
|
}
# Get procs in global namespace
proc ::_Debug::Procs {pat} {
return [uplevel \#0 [list info procs $pat]]
}
proc debugMenu {m} {
$m add cascade -label "Debug" -menu $m.debug -underline 0
menu $m.debug
if {$::tcl_platform(platform) eq "windows"} {
$m.debug add checkbutton -label "Console" -variable consolestate \
-onvalue show -offvalue hide -command {console $consolestate} \
-underline 0
$m.debug add separator
}
$m.debug add command -label "Edit" -command ::_Debug::ProcEditor \
-underline 0
#::_Debug::DumpStuff
return $m.debug
}
proc ::_Debug::ProcEditorUpdate {a k} {
# Only update on keys generating characters
if {$a eq "" || ![string is graph $a]} return
set p [Procs $::_Debug::ProcEditor(proc)]
if {$p eq "" && $::_Debug::ProcEditor(proc) ne ""} {
# Try prefix matching
set p [Procs $::_Debug::ProcEditor(proc)*]
# Include namespaces if starting with ::
if {[string match "::*" $::_Debug::ProcEditor(proc)]} {
|
|
|
|
|
|
|
|
|
|
|
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
|
}
# Get procs in global namespace
proc ::_Debug::Procs {pat} {
return [uplevel \#0 [list info procs $pat]]
}
proc debugMenu {mW} {
$mW add cascade -label "Debug" -menu $mW.debug -underline 0
menu $mW.debug
if {$::tcl_platform(platform) eq "windows"} {
$mW.debug add checkbutton -label "Console" -variable consolestate \
-onvalue show -offvalue hide -command {console $consolestate} \
-underline 0
$mW.debug add separator
}
$mW.debug add command -label "Edit" -command ::_Debug::ProcEditor \
-underline 0
#::_Debug::DumpStuff
return $mW.debug
}
proc ::_Debug::ProcEditorUpdate {aVal kVal} {
# Only update on keys generating characters
if {$aVal eq "" || ![string is graph $aVal]} return
set p [Procs $::_Debug::ProcEditor(proc)]
if {$p eq "" && $::_Debug::ProcEditor(proc) ne ""} {
# Try prefix matching
set p [Procs $::_Debug::ProcEditor(proc)*]
# Include namespaces if starting with ::
if {[string match "::*" $::_Debug::ProcEditor(proc)]} {
|
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
$top.t insert end $da
}
#-----------------------------------------------------------------------------
# Tree view and filter
#-----------------------------------------------------------------------------
proc ::_Debug::ProcEditorFilter {a k} {
# Only update on keys generating characters
if {$a eq "" || ![string is graph $a]} return
set f $::_Debug::ProcEditor(filter)
set tree $::_Debug::ProcEditor(treeW)
#foreach item [$tree]
}
proc ::_Debug::TreeCreatePath {tree path} {
if {[$tree exists $path]} return
|
|
|
|
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
$top.t insert end $da
}
#-----------------------------------------------------------------------------
# Tree view and filter
#-----------------------------------------------------------------------------
proc ::_Debug::ProcEditorFilter {aVal kVal} {
# Only update on keys generating characters
if {$aVal eq "" || ![string is graph $aVal]} return
set f $::_Debug::ProcEditor(filter)
set tree $::_Debug::ProcEditor(treeW)
#foreach item [$tree]
}
proc ::_Debug::TreeCreatePath {tree path} {
if {[$tree exists $path]} return
|
255
256
257
258
259
260
261
262
263
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
|
}
# Which ones are procs?
foreach cmd [info procs ${preNs}::*] {
set allcmds($cmd) "proc"
set thisround($cmd) 0
}
# Which ones are imports?
if {![catch {namespace eval $ns {namespace import}} imports]} {
foreach cmd $imports {
set allcmds(${preNs}::$cmd) "import"
set thisround(${preNs}::$cmd) 0
}
}
# Look through and command that is not something identified
foreach cmd [array names thisround] {
if {!$thisround($cmd)} continue
# Is it an ensemble?
if {[namespace ensemble exists $cmd]} {
set allcmds($cmd) ensemble
foreach {key val} [namespace ensemble configure $cmd] {
#lappend allcmds($cmd) $key $val
if {$key eq "-map"} {
#puts "$cmd $val"
lappend allcmds($cmd) {*}$val
}
# Recognise a snit class
if {$key eq "-unknown" && [string match ::snit::* $val]} {
lset allcmds($cmd) 0 snit
}
}
}
# Is it oo::class?
if {![catch {info class methods $cmd -private} methods]} {
set allcmds($cmd) "oo::class $methods"
}
}
# info class
# info object
# How to recognise methods?
|
|
|
|
|
255
256
257
258
259
260
261
262
263
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
|
}
# Which ones are procs?
foreach cmd [info procs ${preNs}::*] {
set allcmds($cmd) "proc"
set thisround($cmd) 0
}
# Which ones are imports?
if { ! [catch {namespace eval $ns {namespace import}} imports]} {
foreach cmd $imports {
set allcmds(${preNs}::$cmd) "import"
set thisround(${preNs}::$cmd) 0
}
}
# Look through and command that is not something identified
foreach cmd [array names thisround] {
if { ! $thisround($cmd)} continue
# Is it an ensemble?
if {[namespace ensemble exists $cmd]} {
set allcmds($cmd) ensemble
foreach {key val} [namespace ensemble configure $cmd] {
#lappend allcmds($cmd) $key $val
if {$key eq "-map"} {
#puts "$cmd $val"
lappend allcmds($cmd) {*}$val
}
# Recognise a snit class
if {$key eq "-unknown" && [string match ::snit::* $val]} {
lset allcmds($cmd) 0 snit
}
}
}
# Is it oo::class?
if { ! [catch {info class methods $cmd -private} methods]} {
set allcmds($cmd) "oo::class $methods"
}
}
# info class
# info object
# How to recognise methods?
|