Tk Library Source Code

Artifact 8ac5c517107b236058a7d975fc6b4c418bd1c5e9:

Attachment "logger.diffs" to ticket [2381524fff] added by hemanglavana 2008-12-16 21:19:14.

---

Index: logger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.tcl,v
retrieving revision 1.30
diff -u -p -w -r1.30 logger.tcl
--- logger.tcl	8 Feb 2007 22:09:54 -0000	1.30
+++ logger.tcl	16 Dec 2008 14:02:39 -0000
@@ -396,7 +396,13 @@ proc ::logger::init {service} {
             set cmd [lindex $args 0]
             if {[string equal "[namespace current]::${lv}cmd" $cmd]} {return} 
             if {[llength [::info commands $cmd]]} {
-                proc ${lv}cmd {args} "uplevel 1 \[list $cmd \[lindex \$args end\]\]"
+                proc ${lv}cmd {args} "
+    if {\[llength \$args \] == 1} {
+        set msg \[lindex \$args end\]
+    } else {
+        set msg \$args
+    }
+    uplevel 1 \[list $cmd \$msg \]"
             } else {
                 return -code error "Invalid cmd '$cmd' - does not exist"
             }
@@ -404,8 +410,13 @@ proc ::logger::init {service} {
         }
         2  {
             foreach {arg body} $args {break}
-            proc ${lv}cmd {args} "_setservicename \$args; 
-                                      set val \[${lv}customcmd \[lindex \$args end\]\] ; 
+            proc ${lv}cmd {args} "_setservicename args; 
+                                      if {\[llength \$args \] == 1} {
+                                          set msg \[lindex \$args end\]
+                                      } else {
+                                          set msg \$args
+                                      }
+                                      set val \[${lv}customcmd \$msg \] ; 
                                       _restoreservice; set val"
             proc ${lv}customcmd $arg $body
             set lvlcmds($lv) [namespace current]::${lv}customcmd
@@ -497,14 +508,26 @@ proc ::logger::init {service} {
         return $service
     }
     
-    proc _setservicename {arg} {
+    proc _setservicename {argname} {
         variable service
         variable oldname
+        upvar 1 $argname arg
         if {[llength $arg] <= 1} {
             return
         } else {
+            set count -1
+            set newname ""
+            while {![string compare [lindex $arg [expr {$count+1}]] "-_logger::service"]} {
+                incr count 2
+                set newname [lindex $arg $count]
+            }
+            if {![string compare $newname ""]} {
+                return
+            }
             set oldname $service
-            set service [lindex $arg end-1]
+            set service $newname
+            # Pop off "-_logger::service <service>" from argument list
+            set arg [lreplace $arg 0 $count]
         }
     }
         
@@ -603,15 +626,21 @@ proc ::logger::init {service} {
             # OPTIMIZE: do not allow multiple aliases in the hierarchy
             #           they can always be replaced by more efficient
             #           direct aliases to the target procs.
-            interp alias {} [namespace current]::${lvl}cmd {} ${parent}::${lvl}cmd $service
+            interp alias {} [namespace current]::${lvl}cmd \
+                         {} ${parent}::${lvl}cmd -_logger::service $service
         }
         # inherit the starting loglevel of the parent service
         setlevel [${parent}::currentloglevel]
 
     } else {
         foreach lvl [concat [::logger::levels] "trace"] {
-            proc ${lvl}cmd {args} "_setservicename \$args ; 
-                                   set val \[stdoutcmd $lvl \[lindex \$args end\]\] ; 
+            proc ${lvl}cmd {args} "_setservicename args ; 
+                                   if {\[llength \$args \] == 1} {
+                                       set msg \[lindex \$args end\]
+                                   } else {
+                                       set msg \$args
+                                   }
+                                   set val \[stdoutcmd $lvl \$msg \] ; 
                                    _restoreservice; set val"
             set lvlcmds($lvl) [namespace current]::${lvl}cmd
         }
Index: logger.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.test,v
retrieving revision 1.29
diff -u -p -w -r1.29 logger.test
--- logger.test	8 Feb 2007 22:09:54 -0000	1.29
+++ logger.test	16 Dec 2008 14:02:39 -0000
@@ -139,6 +139,13 @@ test logger-3.2 {log} {
     set ::INFO
 } {Danger Will Robinson!}
 
+test logger-3.3 {log} {
+    set log [logger::init global]
+    ${log}::logproc warn txt {set ::INFO $txt}
+    ${log}::warn Danger Will Robinson!
+    ${log}::delete
+    set ::INFO
+} {Danger Will Robinson!}
 
 test logger-3.4 {log} {
     set log1 [logger::init global]