Attachment "latest.diff" to
ticket [616911ffff]
added by
davidw
2002-10-01 14:00:13.
? goober
? latest.diff
Index: log.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/log.tcl,v
retrieving revision 1.4
diff -u -r1.4 log.tcl
--- log.tcl 1 Feb 2002 22:59:08 -0000 1.4
+++ log.tcl 1 Oct 2002 06:55:00 -0000
@@ -29,6 +29,11 @@
info \
debug]
+ # List of services. Initially, we only have 'default'.
+
+ variable services [list \
+ default]
+
# Array mapping from all unique prefixes for log levels to their
# corresponding long form.
@@ -97,7 +102,7 @@
array set cmdMap {}
variable lv
- foreach lv $levels {set cmdMap($lv) ::log::Puts}
+ foreach lv $levels {set cmdMap(default,$lv) ::log::Puts}
unset lv
# Map from log-levels to the channels ::log::Puts shall write
@@ -106,14 +111,14 @@
variable channelMap
array set channelMap {
- emergency stderr
- alert stderr
- critical stderr
- error stderr
- warning stdout
- notice stdout
- info stdout
- debug stdout
+ default,emergency stderr
+ default,alert stderr
+ default,critical stderr
+ default,error stderr
+ default,warning stdout
+ default,notice stdout
+ default,info stdout
+ default,debug stdout
}
# Graphical user interfaces may want to colorize messages based
@@ -159,14 +164,14 @@
variable suppressed
array set suppressed {
- emergency 0
- alert 0
- critical 0
- error 0
- warning 0
- notice 0
- info 0
- debug 0
+ default,emergency 0
+ default,alert 0
+ default,critical 0
+ default,error 0
+ default,warning 0
+ default,notice 0
+ default,info 0
+ default,debug 0
}
# Internal static information. Map from levels to a string of
@@ -174,10 +179,12 @@
# make all level names together with their string of the same
# length.
+ # FIXME - we need to calculate this for new services.
+
variable fill
array set fill {
- emergency "" alert " " critical " " error " "
- warning " " notice " " info " " debug " "
+ default,emergency "" default,alert " " default,critical " " default,error " "
+ default,warning " " default,notice " " default,info " " default,debug " "
}
}
@@ -201,6 +208,27 @@
return [lsort $levels]
}
+
+# log::services --
+#
+# Retrieve the names of all known services.
+#
+# Arguments:
+# None.
+#
+# Side Effects:
+# None.
+#
+# Results:
+# A list containing the names of all known services,
+# alphabetically sorted.
+
+proc ::log::services {} {
+ variable services
+ return [lsort $services]
+}
+
+
# log::lv2longform --
#
# Converts any unique abbreviation of a level name to the full
@@ -272,6 +300,7 @@
# command prefix used to write messages with that level.
#
# Arguments:
+# service Service level to query. Optional.
# level The level to convert into a command prefix.
#
# Side Effects:
@@ -280,10 +309,19 @@
# Results:
# A string containing a command prefix or an error.
-proc ::log::lv2cmd {level} {
+proc ::log::lv2cmd {arg1 {arg2 {}}} {
variable cmdMap
+
+ if { $arg2 == {} } {
+ set service default
+ set level $arg1
+ } else {
+ set service $arg1
+ set level $arg2
+ }
+
set level [lv2longform $level]
- return $cmdMap($level)
+ return $cmdMap($service,$level)
}
# log::lv2channel --
@@ -292,6 +330,7 @@
# channel used by ::log::Puts to write messages with that level.
#
# Arguments:
+# service Service level to query.
# level The level to convert into a channel.
#
# Side Effects:
@@ -300,10 +339,19 @@
# Results:
# A string containing a channel handle or an error.
-proc ::log::lv2channel {level} {
+proc ::log::lv2channel {arg1 {arg2 {}}} {
variable channelMap
+
+ if { $arg2 == {} } {
+ set service default
+ set level $arg1
+ } else {
+ set service $arg1
+ set level $arg2
+ }
+
set level [lv2longform $level]
- return $channelMap($level)
+ return $channelMap($service,$level)
}
# log::lvCompare --
@@ -347,6 +395,7 @@
# too.
#
# Arguments:
+# service Service level to suppress. Optional.
# level The name of the level to suppress or
# unsuppress. Unique abbreviations are allowed
# too.
@@ -361,17 +410,39 @@
# Results:
# None.
-proc ::log::lvSuppress {level {suppress 1}} {
+proc ::log::lvSuppress {arg1 {arg2 {}} {arg3 {}}} {
variable suppressed
- set level [lv2longform $level]
+ variable levels
+ set suppress 1
+ set service default
- switch -exact -- $suppress {
- 0 - 1 {} default {
- return -code error "\"$suppress\" is not a member of \{0, 1\}"
+ if { $arg2 == {} && $arg3 == {} } {
+ set level $arg1
+ } elseif { $arg3 == {} } {
+ if { $arg2 == 0 || $arg2 == 1 } {
+ set level $arg1
+ set suppress $arg2
+ } else {
+ if { [lsearch $levels $arg2] > 0 } {
+ set service $arg1
+ set level $arg2
+ } else {
+ return -code error "\"$arg2\" is not a member of \{0, 1\}"
+ }
+ }
+ } else {
+ set suppress $arg1
+ set level $arg1
+ set suppress $arg3
+ switch -exact -- $suppress {
+ 0 - 1 {} default {
+ return -code error "\"$suppress\" is not a member of \{0, 1\}"
+ }
}
}
- set suppressed($level) $suppress
+ set level [lv2longform $level]
+ set suppressed($service,$level) $suppress
return
}
@@ -382,6 +453,7 @@
# level are allowed here too.
#
# Arguments:
+# service Service level to suppress. Optional.
# level The name of the level to suppress or
# unsuppress. Unique abbreviations are allowed
# too.
@@ -396,24 +468,44 @@
# Results:
# None.
-proc ::log::lvSuppressLE {level {suppress 1}} {
+proc ::log::lvSuppressLE {arg1 {arg2 {}} {arg3 {}}} {
variable suppressed
variable levels
variable priorityMap
+ set suppress 1
+ set service default
- set level [lv2longform $level]
-
- switch -exact -- $suppress {
- 0 - 1 {} default {
- return -code error "\"$suppress\" is not a member of \{0, 1\}"
+ if { $arg2 == {} && $arg3 == {} } {
+ set level $arg1
+ } elseif { $arg3 == {} } {
+ if { $arg2 == 0 || $arg2 == 1 } {
+ set level $arg1
+ set suppress $arg2
+ } else {
+ if { [lsearch $levels $arg2] > 0 } {
+ set service $arg1
+ set level $arg2
+ } else {
+ return -code error "\"$arg2\" is not a member of \{0, 1\}"
+ }
+ }
+ } else {
+ set suppress $arg1
+ set level $arg1
+ set suppress $arg3
+ switch -exact -- $suppress {
+ 0 - 1 {} default {
+ return -code error "\"$suppress\" is not a member of \{0, 1\}"
+ }
}
}
+ set level [lv2longform $level]
set prio [lv2priority $level]
foreach l $levels {
if {$priorityMap($l) <= $prio} {
- set suppressed($l) $suppress
+ set suppressed($service,$l) $suppress
}
}
return
@@ -433,22 +525,32 @@
# Results:
# None.
-proc ::log::lvIsSuppressed {level} {
+proc ::log::lvIsSuppressed {arg1 {arg2 {}}} {
variable suppressed
+
+ if { $arg2 == {} } {
+ set service default
+ set level $arg1
+ } else {
+ set level $arg2
+ set service $arg1
+ }
+
set level [lv2longform $level]
- return $suppressed($level)
+ return $suppressed($service,$level)
}
# log::lvCmd --
#
-# Defines for the specified level with which command to write
-# the messages having this level. Unique abbreviations of level
-# names are allowed. The command is actually a command prefix
-# and this facility will append 2 arguments before calling it,
-# the level of the message and the message itself, in this
-# order.
+
+# Defines the command used to write messages for a given
+# level. Unique abbreviations of level names are allowed. The
+# command is actually a command prefix and this facility will
+# append 2 arguments before calling it, the level of the message
+# and the message itself, in this order.
#
# Arguments:
+# service The service the command prefix is for.
# level The level the command prefix is for.
# cmd The command prefix to use for the specified level.
#
@@ -458,23 +560,35 @@
# Results:
# None.
-proc ::log::lvCmd {level cmd} {
+proc ::log::lvCmd {arg1 arg2 {arg3 {}}} {
variable cmdMap
+
+ if { $arg3 == {} } {
+ set service default
+ set level $arg1
+ set cmd $arg2
+ } else {
+ set service $arg1
+ set level $arg2
+ set cmd $arg3
+ }
+
set level [lv2longform $level]
- set cmdMap($level) $cmd
+ set cmdMap($service,$level) $cmd
return
}
# log::lvCmdForall --
#
-# Defines for all known levels with which command to write the
-# messages having this level. The command is actually a command
-# prefix and this facility will append 2 arguments before
-# calling it, the level of the message and the message itself,
-# in this order.
+#
+# Defines the command to use with all messages having this level
+# (and service). The command is actually a command prefix and
+# this facility will append 2 arguments before calling it, the
+# level of the message and the message itself, in this order.
#
# Arguments:
# cmd The command prefix to use for all levels.
+# service Define the command for all levels of this service.
#
# Side Effects:
# See above.
@@ -482,24 +596,24 @@
# Results:
# None.
-proc ::log::lvCmdForall {cmd} {
+proc ::log::lvCmdForall {cmd {service default}} {
variable cmdMap
variable levels
foreach l $levels {
- set cmdMap($l) $cmd
+ set cmdMap($service,$l) $cmd
}
return
}
# log::lvChannel --
#
-# Defines for the specified level into which channel ::log::Puts
-# (the standard command) shall write the messages having this
-# level. Unique abbreviations of level names are allowed. The
-# command is actually a command prefix and this facility will
-# append 2 arguments before calling it, the level of the message
-# and the message itself, in this order.
+#
+# Defines the channel to use with ::log::Puts with a given level
+# and service. Unique abbreviations of level names are
+# allowed. The command is actually a command prefix and this
+# facility will append 2 arguments before calling it, the level
+# of the message and the message itself, in this order.
#
# Arguments:
# level The level the channel is for.
@@ -511,10 +625,21 @@
# Results:
# None.
-proc ::log::lvChannel {level chan} {
+proc ::log::lvChannel {arg1 arg2 {arg3 {}}} {
variable channelMap
+
+ if { $arg3 == {} } {
+ set service default
+ set level $arg1
+ set chan $arg2
+ } else {
+ set service $arg1
+ set level $arg2
+ set chan $arg3
+ }
+
set level [lv2longform $level]
- set channelMap($level) $chan
+ set channelMap($service,$level) $chan
return
}
@@ -529,6 +654,7 @@
#
# Arguments:
# chan The channel to use for all levels.
+# service The service to define the channel for.
#
# Side Effects:
# See above.
@@ -536,12 +662,12 @@
# Results:
# None.
-proc ::log::lvChannelForall {chan} {
+proc ::log::lvChannelForall {chan {service default}} {
variable channelMap
variable levels
foreach l $levels {
- set channelMap($l) $chan
+ set channelMap($service,$l) $chan
}
return
}
@@ -564,6 +690,7 @@
proc ::log::lvColor {level color} {
variable colorMap
+
set level [lv2longform $level]
set colorMap($level) $color
return
@@ -611,6 +738,7 @@
# code itself.
#
# Arguments:
+# service The service of the message. Optional.
# level The level of the message.
# text The message to log.
#
@@ -620,17 +748,27 @@
# Results:
# None.
-proc ::log::log {level text} {
+proc ::log::log {arg1 arg2 {arg3 {}}} {
variable cmdMap
- if {[lvIsSuppressed $level]} {
+ if { $arg3 == {} } {
+ set service default
+ set level $arg1
+ set text $arg2
+ } else {
+ set service $arg1
+ set level $arg2
+ set text $arg3
+ }
+
+ if {[lvIsSuppressed $service $level]} {
# Ignore messages for suppressed levels.
return
}
set level [lv2longform $level]
- set cmd $cmdMap($level)
+ set cmd $cmdMap($service,$level)
if {$cmd == {}} {
# Ignore messages for levels without a command
return
@@ -638,7 +776,7 @@
# Delegate actual logging to the command
- lappend cmd $level $text
+ lappend cmd $service $level $text
eval $cmd
return
}
@@ -688,7 +826,8 @@
# abbreviations are *not allowed*.
#
# Arguments:
-# level The level of the message.
+# service The service to log. Optional.
+# level The level of the message.
# text The message to log.
#
# Side Effects:
@@ -697,16 +836,26 @@
# Results:
# None.
-proc ::log::Puts {level text} {
+proc ::log::Puts {arg1 arg2 {arg3 {}}} {
variable channelMap
variable fill
- set chan $channelMap($level)
+ if { $arg3 == {} } {
+ set service default
+ set level $arg1
+ set text $arg2
+ } else {
+ set service $arg1
+ set level $arg2
+ set text $arg3
+ }
+
+ set chan $channelMap($service,$level)
if {$chan == {}} {
# Ignore levels without channel.
return
}
- puts $chan "$level$fill($level) $text"
+ puts $chan "$service$fill($service,$level)$level$fill($service,$level) $text"
return
}
Index: log.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/log.test,v
retrieving revision 1.2
diff -u -r1.2 log.test
--- log.test 1 Feb 2002 22:59:08 -0000 1.2
+++ log.test 1 Oct 2002 06:55:00 -0000
@@ -314,7 +315,7 @@
global _log_
set _log_ [list]
-proc logMem {level text} {
+proc logMem {service level text} {
global _log_
lappend _log_ $level $text
}
