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.
ebb94f75cb 2007-09-17       aku: #
ebb94f75cb 2007-09-17       aku: #       Note: max empty => infinite progress display, otherwise a finite 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} {
ebb94f75cb 2007-09-17       aku:     if {$max eq {}} {
ebb94f75cb 2007-09-17       aku: 	puts -nonewline "$system $n\r"
ebb94f75cb 2007-09-17       aku:     } else {
ebb94f75cb 2007-09-17       aku: 	puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
ebb94f75cb 2007-09-17       aku:     }
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