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
|
# Some routines to get information about globals, procs, and other things
# $Id: infodebug.tcl,v 1.1 1999/04/11 21:10:29 davidw Exp $
set dtcl_scriptname ""
set dtcl_globals [ list ]
set dtcl_procs [ list ]
proc info_trace { nm1 nm2 op } {
if { $op == "w" } {
set act "written to"
} else {
set act "unset"
}
puts "# \"$nm1\" \"$nm2\" has been $act"
}
proc info_head { scriptname } {
global dtcl_globals dtcl_scriptname
set dtcl_globals [ info globals ]
set dtcl_scriptname "$scriptname"
}
proc info_tail { } {
global dtcl_globals dtcl_scriptname
set newglobals [ info globals ]
puts "#################### global variables created in $dtcl_scriptname"
foreach g $newglobals {
if { [ lsearch -exact $dtcl_globals $g ] == -1 } {
global $g
trace variable $g "wu" info_trace
if { [ array exists $g ] == 1 } {
puts [ format "# array set %s { %s }" $g [ array get $g ] ]
} else {
puts [ format "# set %s %s" $g [ subst $$g ] ]
}
}
}
puts "#################### end global variables"
}
|
