be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Tool packages. Logging (aka User feedback). be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Requirements be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: package require Tcl 8.4 86a7f249c1 2007-09-09 aku: namespace eval ::vc::tools::log {} be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # API be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Feedback generation. be32ebcb41 2007-09-08 aku: # 86a7f249c1 2007-09-09 aku: # vc::tools::log::write verbosity system text - Write message to the log. 86a7f249c1 2007-09-09 aku: # vc::tools::log::progress verbosity system n max - Drive a progress display. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Administrative operations. be32ebcb41 2007-09-08 aku: # 86a7f249c1 2007-09-09 aku: # vc::tools::log::verbosity level - Set the verbosity level of the application. 86a7f249c1 2007-09-09 aku: # vc::tools::log::verbosity? - Query the verbosity level of the application. 86a7f249c1 2007-09-09 aku: # vc::tools::log::setCmd cmdprefix - Set callback for output 86a7f249c1 2007-09-09 aku: # vc::tools::log::system name - Register a system (enables tabular log formatting). be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Callback API ( Executed at the global level). be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # cmdprefix 'write' system text be32ebcb41 2007-09-08 aku: # cmdprefix 'progress' system n max be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Standard callbacks defined by the package itself write to stdout. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # API Implementation - Feedback generation. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Write the message 'text' to log, for the named 'system'. The message be32ebcb41 2007-09-08 aku: # is written if and only if the message verbosity is less or equal the be32ebcb41 2007-09-08 aku: # chosen verbosity. A message of verbosity 0 cannot be blocked. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::write {verbosity system text} { be32ebcb41 2007-09-08 aku: variable loglevel be32ebcb41 2007-09-08 aku: variable logcmd be32ebcb41 2007-09-08 aku: variable sysfmt be32ebcb41 2007-09-08 aku: if {$verbosity > $loglevel} return be32ebcb41 2007-09-08 aku: uplevel #0 [linsert $logcmd end write [format $sysfmt $system] $text] be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Similar to write, especially in the handling of the verbosity, to be32ebcb41 2007-09-08 aku: # drive progress displays. It signals that for some long running be32ebcb41 2007-09-08 aku: # operation we are at tick 'n' of at most 'max' ticks. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::progress {verbosity system n max} { be32ebcb41 2007-09-08 aku: variable loglevel be32ebcb41 2007-09-08 aku: variable logcmd be32ebcb41 2007-09-08 aku: variable sysfmt be32ebcb41 2007-09-08 aku: if {$verbosity > $loglevel} return be32ebcb41 2007-09-08 aku: uplevel #0 [linsert $logcmd end progress [format $sysfmt $system] $n $max] be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # API Implementation - Administrative operations. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Set verbosity to the chosen 'level'. Only messages with a level less be32ebcb41 2007-09-08 aku: # or equal to this one will be shown. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::verbosity {level} { be32ebcb41 2007-09-08 aku: variable loglevel be32ebcb41 2007-09-08 aku: if {$level < 1} {set level 0} be32ebcb41 2007-09-08 aku: set loglevel $level be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Query the currently set verbosity. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::verbosity? {} { be32ebcb41 2007-09-08 aku: variable loglevel be32ebcb41 2007-09-08 aku: return $loglevel be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Set the log callback handling the actual output of messages going be32ebcb41 2007-09-08 aku: # through the package. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::setCmd {cmdprefix} { be32ebcb41 2007-09-08 aku: variable logcmd $cmdprefix be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Register a system name, to enable tabular formatting. This is done be32ebcb41 2007-09-08 aku: # by setting up a format specifier with a proper width. This is be32ebcb41 2007-09-08 aku: # handled in the generation command, before the output callback is be32ebcb41 2007-09-08 aku: # invoked. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::system {name} { be32ebcb41 2007-09-08 aku: variable sysfmt be32ebcb41 2007-09-08 aku: variable syslen be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: set nlen [string length $name] be32ebcb41 2007-09-08 aku: if {$nlen < $syslen} return be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: set syslen $nlen be32ebcb41 2007-09-08 aku: set sysfmt %-${syslen}s be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal operations - Standard output operation be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Dispatch to the handlers of the possible operations. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::OUT {op args} { 86a7f249c1 2007-09-09 aku: eval [linsert $args 0 ::vc::tools::log::OUT/$op] be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # Write handler. Each message is a line. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::OUT/write {system text} { be32ebcb41 2007-09-08 aku: puts "$system $text" be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: # Progress handler. Uses \r to return to the beginning of the current be32ebcb41 2007-09-08 aku: # line without advancing. be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: proc ::vc::tools::log::OUT/progress {system n max} { be32ebcb41 2007-09-08 aku: puts -nonewline "$system [format %[string length $max]s $n]/$max\r" be32ebcb41 2007-09-08 aku: flush stdout be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: namespace eval ::vc::tools::log { 86a7f249c1 2007-09-09 aku: variable loglevel 0 ; # Allow only uninteruptible messages. 86a7f249c1 2007-09-09 aku: variable logcmd ::vc::tools::log::OUT ; # Standard output to stdout. 86a7f249c1 2007-09-09 aku: variable sysfmt %s ; # Non-tabular formatting. 86a7f249c1 2007-09-09 aku: variable syslen 0 ; # Ditto. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: namespace export write progress be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Ready be32ebcb41 2007-09-08 aku: 86a7f249c1 2007-09-09 aku: package provide vc::tools::log 1.0 be32ebcb41 2007-09-08 aku: return
File Annotation