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];
}
# You can use debug_msg in place of 'puts' for debug info in Tcl macros.
# debug on, turns on debugging
# debug off, turns off debugging
# \brief Enables or disables the debug_msg command
#
# \param mode on turns on debugging, off turns off debugging
#
# \see debug_msg
# TODO Set a callstack global variable
proc debug_mode {mode} {
switch $mode {
on {
proc debug_msg {args} {
set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0]
set arglist [lrange $cmdinfo 1 end]
clientput "DEBUG:$args> [namespace origin $cmd] $arglist"
switch [info level] {
0 {
# This happens when debug_msg is used with trace
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 {
@@ -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} {};
publish debug_mode mugger
sicslist setatt debug_mode privilege internal
proc todo_msg {args} {
set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0]
set arglist [lrange $cmdinfo 1 end]
clientput "TODO:$args> [namespace origin $cmd] $arglist"
clientput "TODO <$cmd> $args"
}
proc error_msg {args} {
set cmdinfo [info level -1]
set cmd [lindex $cmdinfo 0]
set arglist [lrange $cmdinfo 1 end]
clientput "ERROR: [namespace origin $cmd] $arglist: $args" error
error "ERROR: [namespace origin $cmd] $arglist: $args"
}