Artifact c2ee0c05740bbe0195ac286a145ce740bad7bb2f

File tools/cvs2fossil/lib/log.tcl part of check-in [7b71f64766] - Integrated memory tracking into the option processor for activation and configuration, and into the log system for use. The latter means that each actual output to the log is an introspection point. by aku on 2008-02-16 06:45:03.

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007-2008 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Utility package, basic user feedback

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4        ; # Required runtime
package require snit           ; # OO system.
package require vc::tools::mem ; # Memory tracking.

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::tools::log {
    # # ## ### ##### ######## #############
    ## Public API, Methods

    # Write the message 'text' to log, for the named 'system'. The
    # message is written if and only if the message verbosity is less
    # or equal the chosen verbosity. A message of verbosity 0 cannot
    # be blocked.

    typemethod write {verbosity system text} {
	if {$verbosity > $myloglevel} return
	uplevel #0 [linsert $mylogcmd end write [System $system] \
	    [uplevel 1 [list ::subst $text]]]
	return
    }

    # Similar to write, especially in the handling of the verbosity,
    # to drive progress displays. It signals that for some long
    # running operation we are at tick 'n' of at most 'max' ticks. An
    # empty 'max' indicates an infinite progress display.

    typemethod progress {verbosity system n max} {
	if {!$myprogress}             return
	if {$verbosity > $myloglevel} return
	uplevel #0 [linsert $mylogcmd end progress [System $system] $n $max]
	return
    }

    typemethod visible? {verbosity} {
	return [expr {$verbosity <= $myloglevel}]
    }

    # # ## ### ##### ######## #############
    # Public API, Administrative methods

    # Set verbosity to the chosen 'level'. Only messages with a level
    # less or equal to this one will be shown.

    typemethod verbosity {level} {
	if {$level < 1} {set level 0}
	set myloglevel $level
	return
    }

    typemethod verbose {} {
	incr myloglevel
	return
    }

    typemethod noprogress {} {
	set myprogress 0
	return
    }

    typemethod quiet {} {
	if {$myloglevel < 1} return
	incr myloglevel -1
	return
    }

    # Query the currently set verbosity.

    typemethod verbosity? {} {
	return  $myloglevel
    }

    # Set the log callback handling the actual output of messages going
    # through the package.

    typemethod command {cmdprefix} {
	variable mylogcmd $cmdprefix
	return
    }

    # Register a system name, to enable tabular formatting. This is
    # done by setting up a format specifier with a proper width. This
    # is handled in the generation command, before the output callback
    # is invoked.

    typemethod register {name} {
	set nlen [string length $name]
	if {$nlen < $mysyslen} return
	set mysyslen $nlen
	set mysysfmt %-${mysyslen}s
	return
    }

    # # ## ### ##### ######## #############
    ## Internal, state

    typevariable myloglevel 2                     ; # Some verbosity, not too much
    typevariable mylogcmd   ::vc::tools::log::OUT ; # Standard output to stdout.
    typevariable mysysfmt   %s                    ; # Non-tabular formatting.
    typevariable mysyslen   0                     ; # Ditto.
    typevariable myprogress 1                     ; # Progress output is standard.

    # # ## ### ##### ######## #############
    ## Internal, helper methods (formatting, dispatch)

    proc System {s} {
	::variable mysysfmt
	return [format $mysysfmt $s]
    }

    # # ## ### ##### ######## #############
    ## Standard output callback, module internal

    # Dispatch to the handlers of the possible operations.

    proc OUT {op args} {
	eval [linsert $args 0 ::vc::tools::log::OUT/$op]
	return
    }

    # Write handler. Each message is a line.

    proc OUT/write {system text} {
	set m [mlog]
	regsub -all {[^	]} $m { } b
	puts "$m$system [join [split $text \n] "\n$b$system "]"
	mlimit
	return
    }

    # Progress handler. Uses \r to return to the beginning of the
    # current line without advancing.

    proc OUT/progress {system n max} {
	if {$max eq {}} {
	    puts -nonewline "$system $n\r"
	} else {
	    puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
	}
	flush stdout
	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
    pragma -hastypedestroy no ; # immortal

    # # ## ### ##### ######## #############
}

namespace eval ::vc::tools {
    namespace export log
    namespace eval log {
	namespace import ::vc::tools::mem::mlog
	namespace import ::vc::tools::mem::mlimit
    }
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::tools::log 1.0
return