Artifact b0cf40fdc1ff3261f498d4b97730bbada21ce528

File tools/cvs2fossil/lib/log.tcl part of check-in [4e7dd05fc6] - Added an option "--batch" with which the user can disable the feedback display standard to interactive use. by aku on 2007-11-17 04:39:27.

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 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.

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

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] $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} {
	puts "$system $text"
	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
}

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

package provide vc::tools::log 1.0
return