Overview
| SHA1 Hash: | be32ebcb41cfeabaf07dcc60ebbb2166fff76483 |
|---|---|
| Date: | 2007-09-08 05:35:02 |
| User: | aku |
| Comment: | Redid the logging system aka user feedback completely. Verbosity levels, influenced by the new -v switch. Indentations in the output removed, parsing by tools easier, still human readable. Adapted all users of the previous feedback code to use the new system. |
| Timelines: | ancestors | descendants | both | trunk |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- branch=trunk inherited from [a28c83647d]
- sym-trunk inherited from [a28c83647d]
Changes
[hide diffs]Modified tools/import-cvs.tcl from [f419734d96] to [80c1f4022f].
@@ -42,63 +42,64 @@
# Requirements
package require Tcl 8.4
package require cvs ; # Frontend, reading from source repository
package require fossil ; # Backend, writing to destination repository.
+package require tools::log
+
+::tools::log::system import
# -----------------------------------------------------------------------------
proc main {} {
- global argv tot nto cvs fossil ntrunk stopat
-
- commandline
-
- fossil::feedback Write ; # Setup progress feedback from the libraries
- cvs::feedback Write
+ global argv tot nto cvs fossil ntrunk stopat nmax ntfmt nmfmt
+
+ commandline
cvs::at $cvs ; # Define location of CVS repository
cvs::scan ; # Gather revision data from the archives
cvs::csets ; # Group changes into sets
cvs::rtree ; # Build revision tree (trunk only right now).
set tot 0.0
set nto 0
- Write info {Importing ...}
- Write info { Setting up cvs workspace and temporary fossil repository}
+ ::tools::log::write 0 import {Begin conversion}
+ ::tools::log::write 0 import {Setting up workspaces}
cvs::workspace ; # cd's to workspace
fossil::new ; # Uses cwd as workspace to connect to.
- set ntrunk [cvs::ntrunk]
+ set ntrunk [cvs::ntrunk] ; set ntfmt %[string length $ntrunk]s
+ set nmax [cvs::ncsets] ; set nmfmt %[string length $nmax]s
+
cvs::foreach_cset cset [cvs::root] {
import $cset
if {$stopat == $cset} exit
}
cvs::wsclear
- Write info " ========= [string repeat = 61]"
- Write info " Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
- Write info " Within [format %.2f $tot] seconds (avg [format %.2f [expr {$tot/$nto}]] seconds/changeset)"
-
- Write info { Moving to final destination}
+ ::tools::log::write 0 import "========= [string repeat = 61]"
+ ::tools::log::write 0 import "Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
+ ::tools::log::write 0 import "Within [format %.2f $tot] seconds (avg [format %.2f [expr {$tot/$nto}]] seconds/changeset)"
fossil::destination $fossil
- Write info Ok.
+ ::tools::log::write 0 import Ok.
return
}
# -----------------------------------------------------------------------------
proc commandline {} {
- global argv cvs fossil nosign log debugcommit stopat
+ global argv cvs fossil nosign debugcommit stopat
set nosign 0
set debugcommit 0
set stopat {}
+ set verbosity 0
while {[string match "-*" [set opt [lindex $argv 0]]]} {
if {$opt eq "--nosign"} {
set nosign 1
set argv [lrange $argv 1 end]
@@ -110,10 +111,16 @@
continue
}
if {$opt eq "--stopat"} {
set stopat [lindex $argv 1]
set argv [lrange $argv 2 end]
+ continue
+ }
+ if {$opt eq "-v"} {
+ incr verbosity
+ ::tools::log::verbosity $verbosity
+ set argv [lrange $argv 1 end]
continue
}
usage
}
if {[llength $argv] != 2} usage
@@ -127,12 +134,10 @@
usage "CVS directory missing, not readable, or not a directory."
} elseif {[file exists $fossil]} {
usage "Fossil destination repository exists already."
}
- set log [open ${fossil}.log w]
-
fossil::debugcommit $debugcommit
return
}
proc usage {{text {}}} {
@@ -142,19 +147,18 @@
puts stderr " $text"
exit
}
proc import {cset} {
- global tot nto nosign ntrunk stopat
- Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
- Write info " At $nto/$ntrunk ([format %.2f [expr {$nto*100.0/$ntrunk}]]%)"
+ global tot nto nosign ntrunk stopat ntfmt nmfmt
+ ::tools::log::write 0 import "ChangeSet [format $nmfmt $cset] @ [format $ntfmt $nto]/$ntrunk ([format %6.2f [expr {$nto*100.0/$ntrunk}]]%)"
if {$stopat == $cset} {
fossil::commit 1 cvs2fossil $nosign \
[cvs::wssetup $cset] \
::cvs::wsignore
- Write info " %% STOP"
+ ::tools::log::write 1 import {%% STOP}
return
}
set usec [lindex [time {
foreach {uuid ad rm ch} [fossil::commit 0 cvs2fossil $nosign \
@@ -165,45 +169,23 @@
set sec [expr {$usec/1e6}]
set tot [expr {$tot + $sec}]
incr nto
- Write info " == $uuid +${ad}-${rm}*${ch}"
- Write info " in $sec seconds"
+ ::tools::log::write 2 import "== $uuid +${ad}-${rm}*${ch}"
+ ::tools::log::write 2 import "st in [format %.2f $sec] sec"
set avg [expr {$tot/$nto}]
set max [expr {$ntrunk * $avg}]
set rem [expr {$max - $tot}]
- Write info " st avg [format %.2f $avg]"
- Write info " st run [format %7.2f $tot] sec [format %6.2f [expr {$tot/60}]] min [format %5.2f [expr {$tot/3600}]] hr"
- Write info " st end [format %7.2f $max] sec [format %6.2f [expr {$max/60}]] min [format %5.2f [expr {$max/3600}]] hr"
- Write info " st rem [format %7.2f $rem] sec [format %6.2f [expr {$rem/60}]] min [format %5.2f [expr {$rem/3600}]] hr"
- return
-}
-
-# -----------------------------------------------------------------------------
-
-array set fl {
- debug {DEBUG }
- info { }
- warning {Warning}
- error {ERROR }
-}
-
-proc Write {l t} {
- global fl log
-
- if {[string index $t 0] eq "\r"} {
- puts -nonewline stdout "\r$fl($l) [string range $t 0 end-1]"
- } else {
- puts stdout "$fl($l) $t"
- puts $log "$fl($l) $t"
- }
- flush stdout
+ ::tools::log::write 3 import "st avg [format %.2f $avg] sec"
+ ::tools::log::write 3 import "st run [format %7.2f $tot] sec [format %6.2f [expr {$tot/60}]] min [format %5.2f [expr {$tot/3600}]] hr"
+ ::tools::log::write 3 import "st end [format %7.2f $max] sec [format %6.2f [expr {$max/60}]] min [format %5.2f [expr {$max/3600}]] hr"
+ ::tools::log::write 3 import "st rem [format %7.2f $rem] sec [format %6.2f [expr {$rem/60}]] min [format %5.2f [expr {$rem/3600}]] hr"
return
}
# -----------------------------------------------------------------------------
main
exit
Modified tools/lib/cvs.tcl from [e89af18f22] to [8597d1c1ae].
@@ -3,37 +3,34 @@
# -----------------------------------------------------------------------------
# Requirements
package require Tcl 8.4
-package require fileutil ; # Tcllib (cat)
-package require rcsparser ; # Handling the RCS archive files.
+package require fileutil ; # Tcllib (traverse directory hierarchy)
+package require rcsparser ; # Handling the RCS archive files.
+package require tools::log ; # User feedback
package require struct::tree
-namespace eval ::cvs {}
+namespace eval ::cvs {
+ tools::log::system cvs
+ namespace import ::tools::log::write
+}
# -----------------------------------------------------------------------------
# API
# Define repository directory.
proc ::cvs::at {path} {
variable base [file normalize $path]
+ write 0 cvs "Base: $base"
return
}
namespace eval ::cvs {
# Toplevel repository directory
variable base {}
-}
-
-# Define logging callback command
-
-proc ::cvs::feedback {logcmd} {
- variable lc $logcmd
- ::rcsparser::feedback $logcmd
- return
}
# Scan repository, collect archives, parse them, and collect revision
# information (file, revision -> date, author, commit message)
@@ -41,21 +38,21 @@
variable base
variable npaths
variable rpaths
variable timeline
- Log info "Scanning CVS tree $base"
+ write 0 cvs {Scanning directory hierarchy}
set n 0
foreach rcs [fileutil::findByPattern $base -glob *,v] {
set rcs [fileutil::stripPath $base $rcs]
# Now rcs is relative to base
- Log info " Parsing archive $rcs"
+ write 1 cvs "Archive $rcs"
if {[string match CVSROOT* $rcs]} {
- Log info " => Ignoring admin file"
+ write 2 cvs {Ignored. Administrative file}
continue
}
# Derive the regular path from the rcs path. Meaning: Chop of
# the ",v" suffix, and remove a possible "Attic".
@@ -64,11 +61,12 @@
set f [file join [file dirname [file dirname $f]] [file tail $f]]
if {[file exists $base/$f,v]} {
# We have a regular archive and an Attic archive
# refering to the same user visible file. Ignore the
# file in the Attic.
- Log info " => Ignoring attic for regular archive"
+
+ write 2 cvs "Ignored. Attic superceded by regular archive"
# TODO/CHECK. My method of co'ing exact file revisions
# per the info in the collected csets has the flaw
# that I may have to know exactly when what archive
# file to use, see above. It might be better to use
@@ -85,12 +83,10 @@
}
# Get the meta data we need (revisions, timeline, messages).
set meta [::rcsparser::process $base/$rcs]
- Log info " => $f"
-
set npaths($rcs) $f
set rpaths($f) $rcs
array set p $meta
@@ -103,11 +99,11 @@
# seems to exist only! on its branch. The branches
# information is set on the revision (extend rcsparser!),
# symbols has a tag, refering to a branch, possibly magic.
if {($rev eq "1.1") && ($op eq "R")} {
- Log info " => Dead first"
+ write 2 cvs {Dead root revision}
}
lappend timeline($ts) [list $op $ts $a $rev $f $cm]
}
@@ -115,11 +111,11 @@
#parray p
incr n
}
- Log info "Processed $n [expr {($n == 1) ? "file" : "files"}]"
+ write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]"
return
}
namespace eval ::cvs {
# Path mappings. npaths: rcs file -> user file
@@ -143,11 +139,11 @@
array unset csets * ; array set csets {}
array unset cmap * ; array set cmap {}
set ncs 0
- Log info "Processing timeline"
+ write 0 cvs "Processing timeline"
set n 0
CSClear
foreach ts [lsort -dict [array names timeline]] {
@@ -167,13 +163,14 @@
CSAdd $entry
incr n
}
}
- Log info "Processed $n [expr {($n == 1) ? "entry" : "entries"}]"
+ write 0 cvs "Processed $n [expr {($n == 1) ? "entry" : "entries"}]"
+
set n [array size csets]
- Log info "Found $n [expr {($n == 1) ? "changeset" : "changesets"}]"
+ write 0 cvs "Found $n [expr {($n == 1) ? "changeset" : "changesets"}]"
return
}
namespace eval ::cvs {
@@ -192,11 +189,11 @@
proc ::cvs::rtree {} {
variable csets
variable rtree {}
variable ntrunk 0
- Log info "Extracting the trunk"
+ write 0 cvs "Extracting the trunk"
set rtree [struct::tree ::cvs::RT]
$rtree rename root 0 ; # Root is first changeset, always.
set trunk 0
set ntrunk 1 ; # Root is on the trunk.
@@ -218,12 +215,12 @@
$rtree insert $trunk end $c
set trunk $c
incr ntrunk
}
- Log info "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]"
- Log info "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]"
+ write 0 cvs "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]"
+ write 0 cvs "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]"
return
}
namespace eval ::cvs {
# Tree holding trunk and branch information (struct::tree).
@@ -237,11 +234,11 @@
variable cwd [pwd]
variable workspace [fileutil::tempfile importF_cvs_ws_]
file delete $workspace
file mkdir $workspace
- Log info " Workspace: $workspace"
+ write 0 cvs "Workspace: $workspace"
cd $workspace ; # Checkouts go here.
return $workspace
}
@@ -266,19 +263,19 @@
# pwd = workspace
foreach {u cm s e rd fs} $csets($c) break
- Log info " @ $s"
+ write 1 cvs "@ $s"
foreach l [split [string trim $cm] \n] {
- Log info " | $l"
+ write 1 cvs "| $l"
}
foreach {f or} $fs {
foreach {op r} $or break
- Log info " -- $op $f $r"
+ write 2 cvs "$op $f $r"
if {$op eq "R"} {
# Remove file from workspace. Prune empty directories.
#
# NOTE: A dead-first file (rev 1.1 dead) will never have
@@ -312,11 +309,11 @@
# a consequence the fossil repository will not
# contain the full history of the named file. By
# ignoring the problem we however get as much as
# is possible.
- Log info " EE Corrupted archive file. Inaccessible revision."
+ write 0 cvs "EE Corrupted archive file. Inaccessible revision."
continue
}
return -code error $msg
}
}
@@ -345,11 +342,11 @@
set code [catch {uplevel 1 $script} res]
# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
switch -- $code {
0 {}
- 1 { return -errorcode $::errorcode -code error $res }
+ 1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
2 {}
3 { return }
4 {}
default {
return -code $code $result
@@ -372,10 +369,15 @@
}
proc ::cvs::ntrunk {} {
variable ntrunk
return $ntrunk
+}
+
+proc ::cvs::ncsets {} {
+ variable ncs
+ return $ncs
}
proc ::cvs::uuid {c uuid} {
variable rtree
$rtree set $c uuid $uuid
@@ -470,28 +472,12 @@
foreach {f or} $f {
foreach {o r} $or break
puts "$b $o $f $r"
}
return
-}
-
-# -----------------------------------------------------------------------------
-# Internal helper commands
-
-proc ::cvs::Log {level text} {
- variable lc
- uplevel #0 [linsert $lc end $level $text]
- return
-}
-
-proc ::cvs::Nop {args} {}
-
-namespace eval ::cvs {
- # Logging callback. No logging by default.
- variable lc ::cvs::Nop
}
# -----------------------------------------------------------------------------
# Ready
package provide cvs 1.0
return
Modified tools/lib/fossil.tcl from [4c39a15ec8] to [c547c7c383].
@@ -3,12 +3,16 @@
# -----------------------------------------------------------------------------
# Requirements
package require Tcl 8.4
-
-namespace eval ::fossil {}
+package require tools::log ; # User feedback
+
+namespace eval ::fossil {
+ tools::log::system fossil
+ namespace import ::tools::log::write
+}
# -----------------------------------------------------------------------------
# API
# Define repository file, and connect to workspace in CWD.
@@ -19,20 +23,13 @@
# pwd = workspace
exec $fossil new $fr ; # create and
exec $fossil open $fr ; # connect
- Log info " Fossil: $fr"
-
- return $fr
-}
-
-# Define logging callback command
-
-proc ::fossil::feedback {logcmd} {
- variable lc $logcmd
- return
+ write 0 fossil "Repository: $fr"
+
+ return $fr
}
# Move generated fossil repository to final destination
proc ::fossil::destination {path} {
@@ -85,24 +82,24 @@
if {[IGNORE $ignore $path]} continue
if {![file exists $path]} {
exec $fossil rm $path
incr removed
- Log info " ** - $path"
+ write 2 fossil "- $path"
} else {
incr changed
- Log info " ** * $path"
+ write 2 fossil "* $path"
}
}
# Now look for unregistered added files.
foreach path [split [exec $fossil extra] \n] {
if {[IGNORE $ignore $path]} continue
exec $fossil add $path
incr added
- Log info " ** + $path"
+ write 2 fossil "+ $path"
}
# Now commit, using the provided meta data, and capture the uuid
# of the new baseline.
@@ -136,11 +133,11 @@
# 'Nothing changed' can happen for changesets containing only
# dead-first revisions of one or more files. For fossil we
# re-use the last baseline. TODO: Mark them as branchpoint,
# and for what file.
- Log info " UNCHANGED, keeping last"
+ write 1 fossil "UNCHANGED, keeping last"
return [list $lastuuid 0 0 0]
}
set line [string trim $line]
@@ -153,25 +150,12 @@
# -----------------------------------------------------------------------------
# Internal helper commands
proc ::fossil::IGNORE {ignore path} {
return [uplevel #0 [linsert $ignore end $path]]
-}
-
-proc ::fossil::Log {level text} {
- variable lc
- uplevel #0 [linsert $lc end $level $text]
- return
-}
-
-proc ::fossil::Nop {args} {}
-
-namespace eval ::fossil {
- # Logging callback. No logging by default.
- variable lc ::fossil::Nop
}
# -----------------------------------------------------------------------------
# Ready
package provide fossil 1.0
return
Added tools/lib/log.tcl version [5fe2d143d0]
@@ -1,1 +1,147 @@
+# -----------------------------------------------------------------------------
+# Tool packages. Logging (aka User feedback).
+
+# -----------------------------------------------------------------------------
+# Requirements
+
+package require Tcl 8.4
+namespace eval ::tools::log {}
+
+# -----------------------------------------------------------------------------
+# API
+
+# Feedback generation.
+#
+# tools::log::write verbosity system text - Write message to the log.
+# tools::log::progress verbosity system n max - Drive a progress display.
+
+# Administrative operations.
+#
+# tools::log::verbosity level - Set the verbosity level of the application.
+# tools::log::verbosity? - Query the verbosity level of the application.
+# tools::log::setCmd cmdprefix - Set callback for output
+# tools::log::system name - Register a system (enables tabular log formatting).
+
+# Callback API ( Executed at the global level).
+#
+# cmdprefix 'write' system text
+# cmdprefix 'progress' system n max
+
+# Standard callbacks defined by the package itself write to stdout.
+
+# -----------------------------------------------------------------------------
+# API Implementation - Feedback generation.
+
+# 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.
+
+proc ::tools::log::write {verbosity system text} {
+ variable loglevel
+ variable logcmd
+ variable sysfmt
+ if {$verbosity > $loglevel} return
+ uplevel #0 [linsert $logcmd end write [format $sysfmt $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.
+
+proc ::tools::log::progress {verbosity system n max} {
+ variable loglevel
+ variable logcmd
+ variable sysfmt
+ if {$verbosity > $loglevel} return
+ uplevel #0 [linsert $logcmd end progress [format $sysfmt $system] $n $max]
+ return
+}
+
+# -----------------------------------------------------------------------------
+# API Implementation - Administrative operations.
+
+# Set verbosity to the chosen 'level'. Only messages with a level less
+# or equal to this one will be shown.
+
+proc ::tools::log::verbosity {level} {
+ variable loglevel
+ if {$level < 1} {set level 0}
+ set loglevel $level
+ return
+}
+
+# Query the currently set verbosity.
+
+proc ::tools::log::verbosity? {} {
+ variable loglevel
+ return $loglevel
+}
+
+# Set the log callback handling the actual output of messages going
+# through the package.
+
+proc ::tools::log::setCmd {cmdprefix} {
+ variable logcmd $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.
+
+proc ::tools::log::system {name} {
+ variable sysfmt
+ variable syslen
+
+ set nlen [string length $name]
+ if {$nlen < $syslen} return
+
+ set syslen $nlen
+ set sysfmt %-${syslen}s
+ return
+}
+
+# -----------------------------------------------------------------------------
+# Internal operations - Standard output operation
+
+# Dispatch to the handlers of the possible operations.
+
+proc ::tools::log::OUT {op args} {
+ eval [linsert $args 0 ::tools::log::OUT/$op]
+ return
+}
+
+# Write handler. Each message is a line.
+
+proc ::tools::log::OUT/write {system text} {
+ puts "$system $text"
+ return
+}
+
+# Progress handler. Using \r to return to the beginning of the current
+# line without advancing.
+
+proc ::tools::log::OUT/progress {system n max} {
+ puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
+ flush stdout
+ return
+}
+
+# -----------------------------------------------------------------------------
+
+namespace eval ::tools::log {
+ variable loglevel 0 ; # Allow only uninteruptible messages.
+ variable logcmd ::tools::log::OUT ; # Standard output to stdout.
+ variable sysfmt %s ; # Non-tabular formatting.
+ variable syslen 0 ; # Ditto.
+
+ namespace export write progress
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+package provide tools::log 1.0
+return
Modified tools/lib/pkgIndex.tcl from [bb6c58a2d8] to [a7c8370641].
@@ -1,4 +1,5 @@
if {![package vsatisfies [package require Tcl] 8.4]} return
package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
package ifneeded cvs 1.0 [list source [file join $dir cvs.tcl]]
package ifneeded fossil 1.0 [list source [file join $dir fossil.tcl]]
+package ifneeded tools::log 1.0 [list source [file join $dir log.tcl]]
Modified tools/lib/rcsparser.tcl from [ec0acbb634] to [ba9e03a5e7].
@@ -1,25 +1,53 @@
-
# -----------------------------------------------------------------------------
-# Parse RCS files (,v) - ignore the deltas - we need only the commit messages
-# Recursive Descent Parser
+# Tool packages. Parsing RCS files.
+#
+# Some of the information in RCS files is skipped over, most
+# importantly the actual delta texts. The users of this parser need
+# only the meta-data about when revisions were added, the tree
+# (branching) structure, commit messages.
+#
+# The parser is based on Recursive Descent.
# -----------------------------------------------------------------------------
# Requirements
package require Tcl 8.4
-package require fileutil ; # Tcllib (cat)
-
-namespace eval ::rcsparser {}
+package require fileutil ; # Tcllib (cat)
+package require tools::log ; # User feedback
+
+namespace eval ::rcsparser {
+ tools::log::system rcs
+ namespace import ::tools::log::progress
+}
# -----------------------------------------------------------------------------
# API
-proc ::rcsparser::feedback {logcmd} {
- variable lc $logcmd
- return
-}
+# rcsparser::process file
+#
+# Parses the rcs file and returns a dictionary containing the meta
+# data. The following keys are used
+#
+# Key Meaning
+# --- -------
+# 'head' head revision
+# 'branch' ?
+# 'symbol' dict (symbol -> revision)
+# 'lock' dict (symbol -> revision)
+# 'comment' file comment
+# 'expand' ?
+# 'date' dict (revision -> date)
+# 'author' dict (revision -> author)
+# 'state' dict (revision -> state)
+# 'parent' dict (revision -> parent revision)
+# 'commit' dict (revision -> commit message)
+#
+# The state 'dead' has special meaning, the user should know that.
+
+# -----------------------------------------------------------------------------
+# API Implementation
proc ::rcsparser::process {path} {
set data [fileutil::cat -encoding binary $path]
array set res {}
set res(size) [file size $path]
@@ -29,36 +57,22 @@
Admin
Deltas
Description
DeltaTexts
- Feedback \r
-
# Remove parser state
catch {unset res(id)}
catch {unset res(lastval)}
unset res(size)
unset res(nsize)
unset res(done)
- # res: 'head' -> head revision
- # 'branch' -> ?
- # 'symbol' -> (sym -> revision)
- # 'lock' -> (sym -> revision)
- # 'comment' -> file comment
- # 'expand' -> ?
- # 'date' -> (revision -> date)
- # 'author' -> (revision -> author)
- # 'state' -> (revision -> state)
- # 'parent' -> (revision -> parent revision)
- # 'commit' -> (revision -> commit message)
-
return [array get res]
}
# -----------------------------------------------------------------------------
-# Internal helper commands
+# Internal - Recursive Descent functions implementing the syntax.
proc ::rcsparser::Admin {} {
upvar 1 data data res res
Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
return
@@ -190,10 +204,11 @@
Literal text ; String 1
return
}
# -----------------------------------------------------------------------------
+# Internal - Lexicographical commands and data aquisition preparation
proc ::rcsparser::Ident {} {
upvar 1 data data res res
#puts I@?<[string range $data 0 10]...>
@@ -257,10 +272,13 @@
Get $val
Next
return
}
+# -----------------------------------------------------------------------------
+# Internal - Data aquisition
+
proc ::rcsparser::Def {key} {
upvar 1 data data res res
set res($key) $res(lastval)
unset res(lastval)
return
@@ -294,28 +312,14 @@
upvar 1 match match data data res res
foreach {s e} $match break ; incr e
set data [string range $data $e end]
set res(done) [expr {$res(size) - [string length $data]}]
- Feedback "\r [format "%$res(nsize)s" $res(done)]/$res(size) "
+ progress 2 rcs $res(done) $res(size)
return
}
-
-# -----------------------------------------------------------------------------
-
-namespace eval ::rcsparser {
- variable lc ::rcs::Nop
-}
-
-proc ::rcsparser::Feedback {text} {
- variable lc
- uplevel #0 [linsert $lc end info $text]
- return
-}
-
-proc ::rcsparser::Nop {args} {}
# -----------------------------------------------------------------------------
# Ready
package provide rcsparser 1.0
return