linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

debug_msg now works from shallow calls.

Browse Source 
r2133 | ffr | 2007-08-16 17:09:50 +1000 (Thu, 16 Aug 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
2007-08-16 17:09:50 +10:00
committed by Douglas Clowes
parent e7c52b18f1
commit 1a620a08ea
1 changed files with 41 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
site_ansto/instrument/util/extra_utility.tcl
View File

@@ -70,17 +70,44 @@ proc tolower_sicslist {args} {
return [string tolower $result]; return [string tolower $result];
} }
# You can use debug_msg in place of 'puts' for debug info in Tcl macros. # \brief Enables or disables the debug_msg command
# debug on, turns on debugging #
# debug off, turns off debugging # \param mode on turns on debugging, off turns off debugging
#
# \see debug_msg
# TODO Set a callstack global variable
proc debug_mode {mode} { proc debug_mode {mode} {
switch $mode { switch $mode {
on { on {
proc debug_msg {args} { proc debug_msg {args} {
set cmdinfo [info level -1] switch [info level] {
set cmd [lindex $cmdinfo 0] 0 {
set arglist [lrange $cmdinfo 1 end] # This happens when debug_msg is used with trace
clientput "DEBUG:$args> [namespace origin $cmd] $arglist" clientput $args
}
1 {
# This probably only occurs if you debug_msg directly. Why would you do that?
set cmdinfo [info level 0]
set cmd [lindex $cmdinfo 0]
set nscmd [namespace origin $cmd]
clientput "DEBUG, ${nscmd}::$cmdinfo]$args"
}
2 {
set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0]
set nscmd [namespace origin $cmd]
clientput "DEBUG, ${nscmd}::$cmdinfo]$args"
}
3 - default {
set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0]
set nscmd [namespace origin $cmd]
set callerinfo [info level -2]
set caller [lindex $callerinfo 0]
set nscaller [namespace origin $caller]
clientput "DEBUG, ${nscaller}::$callerinfo\n\t${nscmd}::$cmdinfo]$args"
}
}
} }
} }
off { off {
@@ -88,20 +115,23 @@ proc debug_mode {mode} {
} }
} }
} }
## \brief You can use debug_msg in place of 'puts' for debug info in Tcl macros.
#
# Add debug messages on the fly with
# strace add execution <proc> enter debug_msg
proc debug_msg {args} {}; proc debug_msg {args} {};
publish debug_mode mugger publish debug_mode mugger
sicslist setatt debug_mode privilege internal
proc todo_msg {args} { proc todo_msg {args} {
set cmdinfo [info level -1] set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0] set cmd [lindex $cmdinfo 0]
set arglist [lrange $cmdinfo 1 end] clientput "TODO <$cmd> $args"
clientput "TODO:$args> [namespace origin $cmd] $arglist"
} }
proc error_msg {args} { proc error_msg {args} {
set cmdinfo [info level -1] set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0] set cmd [lindex $cmdinfo 0]
set arglist [lrange $cmdinfo 1 end] set arglist [lrange $cmdinfo 1 end]
clientput "ERROR: [namespace origin $cmd] $arglist: $args" error error "ERROR: [namespace origin $cmd] $arglist: $args"
} }