'''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'' [mailto:Ephaeton@gmx.net]

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