errx
The idea of errx came to me as I was enerved by debugging puts. It resembles a bit of the BSD errx/warnx pair, although it combines both functionalities into one function. Furthermore it offers something like a debuggers bt , i.e. backtrace.
It is not yet finished, but I use it daily already, although the more fancy things (like the bt) are not yet fully finished or even nonexistant.
Martin Weber [L1 ]
Make it simple, paste it here - code on a wiki page, with the ensuing discussions, is more attractive and pedagogical than a URL to download a tar.gz bundle... (RS ;-)
In fact I had exactly that in mind - errx itself is lean, but I am using it in a bundle with some other stuff - bgerror, and some other utility stuff which I've packed into ::Error ... gonna present errx here and offer the rest for download :)
And here we go. This is the factored out errx which I already use. I have cut out about anything which is not yet finished.
# When this is sourced, set errchann and debugging if not set
# to sane values.
if {![info exists ::errchann]} { set ::errchann stderr }
if {![info exists ::debugging]} { set ::debugging 0 }
proc errx { txt {flags {info debug}} } {
global argv0 debugging errchann errorInfo lastargs
if {![string length $errchann]} { return }
if {![info exists debugging]} { set debugging 0 }
# if !debugging immediate return when flags contain debug
if {([set dbgpos [lsearch $flags debug]] != -1) && !$debugging} { return } else { set flags [lreplace $flags $dbgpos $dbgpos] }
upvar _DEBUG _debug
if {![info exists _debug]} { set _debug 0 }
if {([set dbgpos [lsearch $flags DEBUG]] != -1) && !$_debug} { return } else { set flags [lreplace $flags $dbgpos $dbgpos] }
if {[info level]==1} { ;# caller is global!
set caller "*global*"
set verbose ""
} else {
set caller [lindex [info level -1] 0]
set verbose "$argv0:\[<$caller>\] Called as: [info level -1]"
}
if {[set flp [lsearch $flags time]]!= -1} {
set intro "$argv0@([clock format [clock seconds]]):\[<$caller>\]"
set flags [lreplace $flags $flp $flp]
} else {
set intro "$argv0:\[<$caller>\]"
}
switch -- $flags {
sparse { puts $errchann "$txt" }
"" -
debug { ;# this shouldn't happen, but can if two debug flags are given.
puts $errchann "$intro:<DEBUG> $txt"
}
info { puts $errchann "$intro:<INFO> $txt" }
warning { puts $errchann "$intro:<WARNING> $txt"}
error { puts $errchann "$intro:<ERROR!> $txt\n$verbose" ; exit 1 }
critical { puts $errchann "$intro: ** CRITICAL ERROR ! **"
if {[info exists errorInfo]} { puts $errchann " -- $errorInfo" }
if {[info exists errorCode]} { puts $errchann " -- $errorCode" }
for {set lv [expr [info level] -1 ]} { $lv } { incr lv -1 } {
puts $errchann "================================================================================"
puts $errchann " Level $lv, [info level $lv]."
puts $errchann " Local variables:"
uplevel #$lv { foreach v [info locals] { upvar #[info level] $v _v; puts $::errchann "$v=$_v\t" } }
puts $errchann "\n"
}
}
default { errx "Invalid flags given to errx ($flags)!" error }
}
return
}