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
|
::Version::setSubversionId {$Id$}
namespace eval ::debug {
proc help {} {
foreach proc [info commands ::debug::*] {
::debug::output $proc
}
}
proc printenvs {} {
global env
foreach env_var [array names env] { ::debug::output "$env_var = $env($env_var)"}
}
proc imgstats {} {
::debug::output "loaded pixmaps: [llength [array names ::skin::loaded_pixmaps]]"
::debug::output "pixmap names: [llength [array names ::skin::pixmaps_names]]"
::debug::output "image names: [llength [image names]]"
}
proc sysinfo {} {
global tcl_platform tk_patchLevel tcl_patchLevel
::debug::output "aMSN version: $::version from $::date"
::debug::output "TCL TK version: $tcl_patchLevel $tk_patchLevel"
::debug::output "Tcl platform: [array get tcl_platform]"
}
proc memuse { {about ""} } {
if {$about == ""} {
::debug::output "Nr of TCL commands: [llength [info commands]]"
::debug::output " -> nr invoked : [llength [info cmdcount]]"
# ::debug::output "Nr of variables : [llength [info vars]]"
::debug::output "Nr of global vars : [llength [info globals]]"
::debug::output "Packages loaded with"
::debug::output " 'load' : [llength [info loaded]]"
::debug::output " 'package require': [llength [package names]]"
::debug::output "Nr of images : [llength [image names]]"
}
#here we could have stats about 1 namespace for example
}
proc varsize { {namespace ""}} {
if {$namespace != ""} {
set namespaces [list $namespace]
} else {
set namespaces [namespace children ::]
}
foreach namespace $namespaces {
::debug::output "Namespace $namespace\n----------"
foreach var [info vars "${namespace}::*"] {
::debug::output "$var : "
catch { ::debug::output "\t[string length [set $var]]\n"}
catch { ::debug::output "\t[string length [array get $var]]"}
}
}
}
proc writeOn {} {
global HOME2
variable debugfile
global wchannel
set debugfile [file join $HOME2 debug.log]
#open the file for writing at the end of it
set wchannel [open $debugfile a+]
}
proc writeOff {} {
global wchannel
flush $wchannel
close $wchannel
set wchannel stdout
}
proc printStackTrace { } {
::debug::output "Stacktrace:"
for { set i [info level] } { $i > 0 } { incr i -1} {
::debug::output "Level $i : [info level $i]"
::debug::output "Called from within : "
}
::debug::output ""
}
proc printStackTrace2 { } {
for { set i [info level] } { $i > 0 } { incr i -1} {
puts "Level $i : [info level $i]"
puts "Called from within : "
}
puts ""
}
#Aid procs
proc output {data} {
global wchannel
variable force
set force 1
#if we're writing to the file, also write to stdout
#.. better not :D
#if {$wchannel != "stdout"} {
# puts $data
#}
puts $wchannel $data
catch {if {$force == 1} {
catch {flush $wchannel}
} }
}
}
|