d57b7b4a05 2007-10-02 aku: ## -*- tcl -*- d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Copyright (c) 2007 Andreas Kupries. d57b7b4a05 2007-10-02 aku: # d57b7b4a05 2007-10-02 aku: # This software is licensed as described in the file LICENSE, which d57b7b4a05 2007-10-02 aku: # you should have received as part of this distribution. d57b7b4a05 2007-10-02 aku: # d57b7b4a05 2007-10-02 aku: # This software consists of voluntary contributions made by many d57b7b4a05 2007-10-02 aku: # individuals. For exact contribution history, see the revision d57b7b4a05 2007-10-02 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: ## Utility package, basic user feedback d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## Requirements d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: package require Tcl 8.4 ; # Required runtime d57b7b4a05 2007-10-02 aku: package require snit ; # OO system. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# ##################### d57b7b4a05 2007-10-02 aku: ## d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: snit::type ::vc::tools::log { d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Public API, Methods d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Write the message 'text' to log, for the named 'system'. The d57b7b4a05 2007-10-02 aku: # message is written if and only if the message verbosity is less d57b7b4a05 2007-10-02 aku: # or equal the chosen verbosity. A message of verbosity 0 cannot d57b7b4a05 2007-10-02 aku: # be blocked. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod write {verbosity system text} { d57b7b4a05 2007-10-02 aku: if {$verbosity > $myloglevel} return 47d52d1efd 2007-11-28 aku: uplevel #0 [linsert $mylogcmd end write [System $system] \ 47d52d1efd 2007-11-28 aku: [uplevel 1 [list ::subst $text]]] d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Similar to write, especially in the handling of the verbosity, d57b7b4a05 2007-10-02 aku: # to drive progress displays. It signals that for some long d57b7b4a05 2007-10-02 aku: # running operation we are at tick 'n' of at most 'max' ticks. An d57b7b4a05 2007-10-02 aku: # empty 'max' indicates an infinite progress display. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod progress {verbosity system n max} { 4e7dd05fc6 2007-11-17 aku: if {!$myprogress} return d57b7b4a05 2007-10-02 aku: if {$verbosity > $myloglevel} return d57b7b4a05 2007-10-02 aku: uplevel #0 [linsert $mylogcmd end progress [System $system] $n $max] d57b7b4a05 2007-10-02 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: typemethod visible? {verbosity} { 08ebab80cd 2007-11-10 aku: return [expr {$verbosity <= $myloglevel}] d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: # Public API, Administrative methods d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Set verbosity to the chosen 'level'. Only messages with a level d57b7b4a05 2007-10-02 aku: # less or equal to this one will be shown. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod verbosity {level} { d57b7b4a05 2007-10-02 aku: if {$level < 1} {set level 0} d57b7b4a05 2007-10-02 aku: set myloglevel $level d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod verbose {} { d57b7b4a05 2007-10-02 aku: incr myloglevel 4e7dd05fc6 2007-11-17 aku: return 4e7dd05fc6 2007-11-17 aku: } 4e7dd05fc6 2007-11-17 aku: 4e7dd05fc6 2007-11-17 aku: typemethod noprogress {} { 4e7dd05fc6 2007-11-17 aku: set myprogress 0 d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod quiet {} { d57b7b4a05 2007-10-02 aku: if {$myloglevel < 1} return d57b7b4a05 2007-10-02 aku: incr myloglevel -1 d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Query the currently set verbosity. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod verbosity? {} { d57b7b4a05 2007-10-02 aku: return $myloglevel d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Set the log callback handling the actual output of messages going d57b7b4a05 2007-10-02 aku: # through the package. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod command {cmdprefix} { d57b7b4a05 2007-10-02 aku: variable mylogcmd $cmdprefix d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Register a system name, to enable tabular formatting. This is d57b7b4a05 2007-10-02 aku: # done by setting up a format specifier with a proper width. This d57b7b4a05 2007-10-02 aku: # is handled in the generation command, before the output callback d57b7b4a05 2007-10-02 aku: # is invoked. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typemethod register {name} { d57b7b4a05 2007-10-02 aku: set nlen [string length $name] d57b7b4a05 2007-10-02 aku: if {$nlen < $mysyslen} return d57b7b4a05 2007-10-02 aku: set mysyslen $nlen d57b7b4a05 2007-10-02 aku: set mysysfmt %-${mysyslen}s d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Internal, state d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: typevariable myloglevel 2 ; # Some verbosity, not too much d57b7b4a05 2007-10-02 aku: typevariable mylogcmd ::vc::tools::log::OUT ; # Standard output to stdout. 4e7dd05fc6 2007-11-17 aku: typevariable mysysfmt %s ; # Non-tabular formatting. 4e7dd05fc6 2007-11-17 aku: typevariable mysyslen 0 ; # Ditto. 4e7dd05fc6 2007-11-17 aku: typevariable myprogress 1 ; # Progress output is standard. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Internal, helper methods (formatting, dispatch) d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: proc System {s} { 70b0aa899a 2007-10-06 aku: ::variable mysysfmt d57b7b4a05 2007-10-02 aku: return [format $mysysfmt $s] d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Standard output callback, module internal d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Dispatch to the handlers of the possible operations. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: proc OUT {op args} { d57b7b4a05 2007-10-02 aku: eval [linsert $args 0 ::vc::tools::log::OUT/$op] d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Write handler. Each message is a line. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: proc OUT/write {system text} { 81a297a66a 2008-01-30 aku: puts "$system [join [split $text \n] "\n$system "]" d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # Progress handler. Uses \r to return to the beginning of the d57b7b4a05 2007-10-02 aku: # current line without advancing. d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: proc OUT/progress {system n max} { d57b7b4a05 2007-10-02 aku: if {$max eq {}} { d57b7b4a05 2007-10-02 aku: puts -nonewline "$system $n\r" d57b7b4a05 2007-10-02 aku: } else { d57b7b4a05 2007-10-02 aku: puts -nonewline "$system [format %[string length $max]s $n]/$max\r" d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: flush stdout d57b7b4a05 2007-10-02 aku: return d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: ## Configuration d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: pragma -hasinstances no ; # singleton d57b7b4a05 2007-10-02 aku: pragma -hastypeinfo no ; # no introspection d57b7b4a05 2007-10-02 aku: pragma -hastypedestroy no ; # immortal d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # # ## ### ##### ######## ############# d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: namespace eval ::vc::tools { d57b7b4a05 2007-10-02 aku: namespace export log d57b7b4a05 2007-10-02 aku: } d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: # ----------------------------------------------------------------------------- d57b7b4a05 2007-10-02 aku: # Ready d57b7b4a05 2007-10-02 aku: d57b7b4a05 2007-10-02 aku: package provide vc::tools::log 1.0 d57b7b4a05 2007-10-02 aku: return
File Annotation