? 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
 }
