? dwlog.tcl
? dwlog.test
? foo.n
? goober
? latest.diff
? logger.n
? prova.tcl
Index: logger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.tcl,v
retrieving revision 1.4
diff -u -r1.4 logger.tcl
--- logger.tcl	20 May 2003 09:35:05 -0000	1.4
+++ logger.tcl	15 Dec 2003 23:21:50 -0000
@@ -9,7 +9,7 @@
 # lets you have trees of services, that inherit from one another.
 # This is accomplished through the use of Tcl namespaces.
 
-package provide logger 0.1
+package provide logger 0.2
 package require Tcl 8.2
 
 namespace eval ::logger {
@@ -41,8 +41,8 @@
 proc ::logger::walk { start code } {
     set children [namespace children $start]
     foreach c $children {
-	namespace eval $c $code
 	logger::walk $c $code
+	namespace eval $c $code
     }
 }
 
@@ -65,12 +65,16 @@
 	# going.  They can turn it off themselves.
 	variable enabled "debug"
 
+	# Callback to use when the service in question is shut down.
+	set delcallback {}
+
 	# We use this to disable a service completely.  In Tcl 8.4
 	# or greater, by using this, disabled log calls are a
 	# no-op!
 
 	proc no-op args {}
 
+
 	proc stdoutcmd {level text} {
 	    variable service
 	    puts "\[[clock format [clock seconds]]\] \[$service\] \[$level\] \'$text\'"
@@ -172,11 +176,12 @@
 	    logger::walk [namespace current] [list disable $lv]
 	}
 
+
 	# logproc --
 	#
-	#	Command used to create a procedure that is what is
-	#	executed to perform the logging.  This could write to
-	#	disk, out to the network, or something else.
+	#	Command used to create a procedure that is executed to
+	#	perform the logging.  This could write to disk, out to
+	#	the network, or something else.
 	#
 	# Arguments:
 	#	lv - the level to log, which must be one of $levels.
@@ -191,7 +196,6 @@
 	# Results:
 	#	None.
 
-
 	proc logproc {lv arg body} {
 	    variable levels
 	    set lvnum [lsearch -exact $levels $lv]
@@ -201,11 +205,36 @@
 	    proc ${lv}cmd $arg $body
 	}
 
+
+	# delproc --
+	#
+	#	Set a callback for when the logger instance is
+	#	deleted.
+	#
+	# Arguments:
+	#	cmd - the Tcl command to call.
+	#
+	# Side Effects:
+	#	None.
+	#
+	# Results:
+	#	None.
+
+	proc delproc {cmd} {
+	    variable delcallback
+	    set delcallback $cmd
+	}
+
+
 	# delete --
 	#
 	#	Delete the namespace and its children.
 
 	proc delete {} {
+	    variable delcallback
+
+	    logger::walk [namespace current] delete
+	    catch { $delcallback [namespace current] }
 	    namespace delete [namespace current]
 	}
 
Index: logger.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.test,v
retrieving revision 1.2
diff -u -r1.2 logger.test
--- logger.test	20 May 2003 09:35:05 -0000	1.2
+++ logger.test	15 Dec 2003 23:21:50 -0000
@@ -14,7 +14,7 @@
 }
 
 set auto_path "[file dirname [info script]] $auto_path"
-package require logger
+package require logger 0.2
 
 test logger-1.0 {init basic} {
     set log [logger::init global]
@@ -43,6 +43,21 @@
     set err
 } {can't read "::logger::tree::global::enabled": no such variable}
 
+test logger-2.1 {delete + callback} {
+    set ::results {}
+    proc dellog {ns} {
+	 lappend ::results "$ns"
+    }
+    set log1 [logger::init global]
+    set log2 [logger::init global::subsystem]
+    ${log1}::delproc dellog
+    ${log2}::delproc dellog
+    ${log1}::delete
+    #    catch {set ${log}::enabled} err
+    #set err
+    set ::results
+} {::logger::tree::global::subsystem ::logger::tree::global}
+
 test logger-3.0 {log} {
     set log [logger::init global]
     ${log}::error "Danger Will Robinson!"
@@ -152,7 +167,9 @@
 test logger-5.0 {setlevel command} {
     set ::INFO ""
     set log1 [logger::init global]
+    catch {
     ${log1}::setlevel warn
+    } err
     ${log1}::logproc error txt {
 	lappend ::INFO "Error Message"
     }
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/pkgIndex.tcl,v
retrieving revision 1.6
diff -u -r1.6 pkgIndex.tcl
--- pkgIndex.tcl	11 Apr 2003 19:55:26 -0000	1.6
+++ pkgIndex.tcl	15 Dec 2003 23:21:50 -0000
@@ -11,4 +11,4 @@
 if {![package vsatisfies [package provide Tcl] 8]} {return}
 package ifneeded log 1.0.2 [list source [file join $dir log.tcl]]
 if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded logger 0.1 [list source [file join $dir logger.tcl]]
+package ifneeded logger 0.2 [list source [file join $dir logger.tcl]]
