From 1a620a08eaa9a12ab2f07060d5fe6710c24b887c Mon Sep 17 00:00:00 2001
From: Ferdi Franceschini <ffr@ansto.gov.au>
Date: Thu, 16 Aug 2007 17:09:50 +1000
Subject: [PATCH] debug_msg now works from shallow calls.

r2133 | ffr | 2007-08-16 17:09:50 +1000 (Thu, 16 Aug 2007) | 2 lines
---
 site_ansto/instrument/util/extra_utility.tcl | 52 +++++++++++++++-----
 1 file changed, 41 insertions(+), 11 deletions(-)

diff --git a/site_ansto/instrument/util/extra_utility.tcl b/site_ansto/instrument/util/extra_utility.tcl
index 822e5efa..0694a93c 100644
--- a/site_ansto/instrument/util/extra_utility.tcl
+++ b/site_ansto/instrument/util/extra_utility.tcl
@@ -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"
 }