# Debug - a debug narrative logger.
   #
   # Debugging areas of interest are represented by 'tokens' which have 
   # independantly settable levels of interest (an integer, higher is more detailed)
   #
   # Debug narrative is provided as a tcl script whose value is [subst]ed in the 
   # caller's scope if and only if the current level of interest matches or exceeds
   # the Debug call's level of detail.  This is useful, as one can place arbitrarily
   # complex narrative in code without unnecessarily evaluating it.
   #
   # TODO: potentially different streams for different areas of interest.
   # (currently only stderr is used.  there is some complexity in efficient
   # cross-threaded streams.)
   
   package provide Debug 2.0
   
   namespace eval Debug {
       variable detail
       variable level 0
       variable fds
   
       proc noop {args} {}
   
       proc debug {tag message {level 1}} {
   	variable detail
   	if {$detail($tag) >= $level} {
   	    variable fds
   	    set fd $fds($tag)
   
   	    set code [catch {
   		uplevel 1 ::subst -nobackslashes [list $message]
   	    } result eo]
   	    if {$code} {
   		set x [info level -1]
   		puts -nonewline $fd @@[string map {\n \\n \r \\r} "(DebugError from $tag [if {[string length $x] < 1000} {set x} else {set x "[string range $x 0 200]...[string range $x end-200 end]"}] ($eo)):"]
   	    } else {
   		if {[string length $result] > 4096} {
   		    set result "[string range $result 0 4096]...(truncated) ... [string range $result end-4096 end]"
   		}
   		puts $fd "$tag @@[string map {\n \\n} $result]"
   	    }
   	} else {
   	    #puts stderr "$tag @@@ $detail($tag) >= $level"
   	}
       }
   
       # names - return names of debug tags
       proc names {} {
   	variable detail
   	return [lsort [array names detail]]
       }
   
       proc 2array {} {
   	variable detail
   	set result {}
   	foreach n [lsort [array names detail]] {
   	    if {[interp alias {} Debug.$n] ne "::Debug::noop"} {
   		lappend result $n $detail($n)
   	    } else {
   		lappend result $n -$detail($n)
   	    }
   	}
   	return $result
       }
   
       # level - set level and fd for tag
       proc level {tag {level ""} {fd stderr}} {
   	variable detail
   	if {$level ne ""} {
   	    set detail($tag) $level
   	}
   
   	if {![info exists detail($tag)]} {
   	    set detail($tag) 1
   	}
   
   	variable fds
   	set fds($tag) $fd
   
   	return $detail($tag)
       }
   
       # turn on debugging for tag
       proc on {tag {level ""} {fd stderr}} {
   	level $tag $level $fd
   	interp alias {} Debug.$tag {} ::Debug::debug $tag
       }
   
       # turn off debugging for tag
       proc off {tag {level ""} {fd stderr}} {
   	level $tag $level $fd
   	interp alias {} Debug.$tag {} ::Debug::noop
       }
   
       namespace export -clear *
       namespace ensemble create -subcommands {}
   }

----
!!!!!!
%| enter categories here |%
!!!!!!