#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# -----------------------------------------------------------------------------

# Import the trunk of a CVS repository wholesale into a fossil repository.

# Limitations implicitly mentioned:
# - No incremental import.
# - No import of branches.

# WIBNI features (beyond eliminating the limitations):
# - Restrict import to specific directory subtrees (SF projects use
#   one repository for several independent modules. Examples: tcllib
#   -> tcllib, tklib, tclapps, etc.). The restriction would allow import
#   of only a specific module.
# - Related to the previous, strip elements from the base path to keep
#   it short.
# - Export to CVS, trunk, possibly branches. I.e. extend the system to be
#   a full bridge. Either Fossil or CVS could be the master repository.

# HACKS. I.e. I do not know if the 'fixes' I use are the correct way
#        of handling the encountered situations.
#
# - File F has archives F,v and Attic/F,v. Currently I will ignore the
#   file in the Attic.
#   Examples: sqlite/os_unix.h
#
# - A specific revision of a file F cannot be checked out (reported
#   error is 'invalid change text'). This indicates a corrupt RCS
#   file, one or more delta are bad. We report but ignore the problem
#   in a best-effort attempt at getting as much history as possible.
#   Examples: tcllib/tklib/modules/tkpiechart/pie.tcl

# -----------------------------------------------------------------------------
# Make private packages accessible.

lappend auto_path [file join [file dirname [info script]] lib]

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::tools::log          ; # User Feedback
package require vc::fossil::import::cvs ; # Importer Control
package require vc::cvs::ws             ; # CVS frontend

namespace eval ::import {
    namespace import ::vc::fossil::import::cvs::*
}

# -----------------------------------------------------------------------------

proc main {} {
    commandline -> cvs  fossil
    import::run   $cvs $fossil
    return
}

# -----------------------------------------------------------------------------

proc commandline {__ cv fv} {
    global argv
    upvar 1 $cv cvs $fv fossil

    set verbosity 0

    clinit
    while {[string match "-*" [set opt [this]]]} {
	switch -exact -- $opt {
	    --breakat     { next ; import::configure -breakat   [this] }
	    --cache-rcs   { next ; import::configure -cache-rcs [this] }
	    --nosign      {        import::configure -nosign         1 }
	    --project     { next ; import::configure -project   [this] }
	    --saveto      { next ; import::configure -saveto    [file normalize [this]] }
	    -v            { incr verbosity ; ::vc::tools::log::verbosity $verbosity }
	    -h            -
	    default       usage
	}
	next
    }

    remainder
    if {[llength $argv] != 2} usage
    foreach {cvs fossil} $argv break

    if {![::vc::cvs::ws::check $cvs msg]} {
	usage $msg
    } elseif {[file exists $fossil]} {
	usage "Fossil destination repository exists already."
    }

    return
}

proc this {} {
    global argv
    upvar 1 at at
    return [lindex $argv $at]
}

proc next {} {
    upvar 1 at at
    incr at
    return
}

proc remainder {} {
    upvar 1 at at
    global argv
    set argv [lrange $argv $at end]
    return
}

proc clinit {} {
    upvar 1 at at
    set at 0
    return
}

proc usage {{text {}}} {
    global argv0
    puts stderr "Usage: $argv0 ?-v? ?--nosign? ?--breakat id? ?--saveto path? cvs-repository fossil-repository"
    if {$text eq ""} {
	puts stderr "       --nosign:    Do not sign the imported changesets."
	puts stderr "       --breakat:   Stop just before committing the identified changeset."
	puts stderr "       --cache-rcs: Boolean. Activate caching of rcs parse results"
	puts stderr "       --project:   Path in the CVS repository to limit the import to."
	puts stderr "       --saveto:    Save commit command to the specified file."
	puts stderr "       -v:          Increase log verbosity. Can be used multiple times."
    } else {
	puts stderr "       $text"
    }
    exit
}

# -----------------------------------------------------------------------------

main
exit

# -----------------------------------------------------------------------------
# Repository management (CVS)

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require fileutil              ; # Tcllib (traverse directory hierarchy)
package require vc::rcs::parser       ; # Handling the RCS archive files.
package require vc::tools::log        ; # User feedback
package require vc::tools::trouble    ; # Error handling
package require vc::cvs::cmd          ; # Access to cvs application.
package require vc::cvs::ws::files    ; # Scan CVS repository for relevant files.
package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
package require vc::cvs::ws::csets    ; # Manage the changesets found in the timeline
package require vc::cvs::ws::branch   ; # Branch database
package require vc::cvs::ws::sig      ; # Changeset file/rev signatures

namespace eval ::vc::cvs::ws {
    vc::tools::log::system cvs
    namespace import ::vc::tools::log::write
    namespace import ::vc::rcs::parser::process
    namespace import ::vc::cvs::cmd::dova

    namespace eval trouble { namespace import ::vc::tools::trouble::* }
}

# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::configure key value    - Configure the subsystem.
# vc::cvs::ws::check     src mv       - Check if src is a CVS repository directory.
# vc::cvs::ws::begin     src          - Start new workspace and return the top-
#                                       most directory co'd files are put into.
# vc::cvs::ws::ncsets                 - Retrieve total number of csets
# vc::cvs::ws::nimportable            - Retrieve number of importable csets
# vc::cvs::ws::foreach   csvar script - Run the script for each changeset, the
#                                       id of the current changeset stored in
#                                       the variable named by csvar.
# vc::cvs::ws::done                   - Close workspace and delete it.
# vc::cvs::ws::isadmin path           - Check if path is an admin file of CVS
# vc::cvs::ws::checkout id            - Have workspace contain the changeset id.
# vc::cvs::ws::get      id            - Retrieve data of a changeset.
#
# Configuration keys:
#
# -project path - Sub directory under 'src' to limit the import to.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::configure {key value} {
    variable project

    switch -exact -- $key {
	-project { set project $value }
	default {
	    return -code error "Unknown switch $key, expected \
                                   -project"
	}
    }
    return
}

proc ::vc::cvs::ws::check {src mv} {
    variable project
    upvar 1 $mv msg
    if {
	![fileutil::test $src         erd msg "CVS Repository"] ||
	![fileutil::test $src/CVSROOT erd msg "CVS Admin directory"] ||
	(($project ne "") &&
	 ![fileutil::test $src/$project erd msg "Project directory"])
    } {
	return 0
    }
    return 1
}

proc ::vc::cvs::ws::begin {src} {
    if {![check $src msg]} { return -code error $msg }

    DefBase $src
    MakeTimeline [ScanArchives [files::find [RootPath]]]
    MakeChangesets
    ProcessBranches

    return [MakeWorkspace]
}

proc ::vc::cvs::ws::done {} {
    variable            workspace
    file delete -force $workspace
    return
}

proc ::vc::cvs::ws::foreach {cv script} {
    variable importable
    upvar 1 $cv c

    ::foreach c [lsort -integer -increasing $importable] {
	set code [catch {uplevel 1 $script} res]

	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
	switch -- $code {
	    0 {}
	    1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
	    2 {}
	    3 { return }
	    4 {}
	    default { return -code $code $result }
	}
    }
    return
}

proc ::vc::cvs::ws::ncsets {args} {
    return [csets::num]
}

proc ::vc::cvs::ws::nimportable {args} {
    variable importable
    return [llength $importable]
}

proc ::vc::cvs::ws::isadmin {path} {
    # Check if path is a CVS admin file.
    if {[string match CVS/*   $path]} {return 1}
    if {[string match */CVS/* $path]} {return 1}
    return 0
}

proc ::vc::cvs::ws::parentOf {id} { csets::parentOf $id }

proc ::vc::cvs::ws::checkout {id} {
    variable workspace
    cd      $workspace

    # TODO: Hide the direct access to the data structures behind
    # TODO: accessors for date, cmsg, removed, added, changed, and
    # TODO: author
    array set cs [csets::get $id]

    write 1 cvs "@  $cs(date)"
    ::foreach l [split [string trim $cs(cmsg)] \n] {
	write 1 cvs "|  $l"
    }

    ::foreach {f r} $cs(removed) { write 2 cvs "R  $f $r" ; Remove   $f $r }
    ::foreach {f r} $cs(added)   { write 2 cvs "A  $f $r" ; Checkout $f $r }
    ::foreach {f r} $cs(changed) { write 2 cvs "M  $f $r" ; Checkout $f $r }

    # Provide metadata about the changeset the backend may wish to have
    return [list $cs(author) $cs(date) $cs(cmsg)]
}

# -----------------------------------------------------------------------------
# Internals

proc ::vc::cvs::ws::DefBase {path} {
    variable project
    variable base

    set base $path

    write 0 cvs "Base:    $base"
    if {$project eq ""} {
	write 0 cvs "Project: <ALL>"
    } else {
	write 0 cvs "Project: $project"
    }
    return
}

proc ::vc::cvs::ws::RootPath {} {
    variable project
    variable base

    if {$project eq ""} {
	return $base
    } else {
	return $base/$project
    }
}

proc ::vc::cvs::ws::ScanArchives {files} {
    write 0 cvs "Scanning archives ..."

    set d [RootPath]
    set r {}
    set n 0

    ::foreach {rcs f} $files {
	write 1 cvs "Archive $rcs"
	# Get the meta data we need (revisions, timeline, messages).
	lappend r $f [process $d/$rcs]
	incr    n
    }

    write 0 cvs "Processed [NSIPL $n file]"
    return $r
}

proc ::vc::cvs::ws::MakeTimeline {meta} {
    write 0 cvs "Generating coalesced timeline ..."

    set n 0
    ::foreach {f meta} $meta {
	array set md   $meta
	array set date $md(date)
	array set auth $md(author)
	array set cmsg $md(commit)
	array set stat $md(state)

	::foreach rev [lsort -dict [array names date]] {
	    set operation [Operation $rev $stat($rev)]
	    NoteDeadRoots $f $rev $operation
	    timeline::add $date($rev) $f $rev $operation $auth($rev) $cmsg($rev)
	    incr n
	}

	if {[info exists md(symbol)]} {
	    branch::def $f date $md(symbol)
	}

	unset md
	unset date
	unset auth
	unset cmsg
	unset stat
    }

    write 0 cvs "Timeline has [NSIPL $n entry entries]"
    return
}

proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
    # A dead-first revision is rev 1.1 with op R. For an example see
    # the file memchan/DEPENDENCIES. Such a file 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") && ($operation eq "R")} {
	write 2 cvs "Dead root revision: $f"
    }
    return
}

proc ::vc::cvs::ws::Operation {rev state} {
    if {$state eq "dead"}          {return "R"} ; # Removed
    if {$rev   eq "1.1"}           {return "A"} ; # Added
    if {[string match *.1.1 $rev]} {return "A"} ; # Added on a branch
    return "M"                                  ; # Modified
}

proc ::vc::cvs::ws::MakeChangesets {} {
    write 0 cvs "Generating changesets from timeline"

    csets::init
    timeline::foreach date file revision operation author cmsg {
	csets::add $date $file $revision $operation $author $cmsg
    }
    csets::done

    write 0 cvs "Found [NSIPL [csets::num] changeset]"
    return
}

proc ::vc::cvs::ws::MakeWorkspace {} {
    variable project
    variable workspace [fileutil::tempfile importF_cvs_ws_]

    set w $workspace
    if {$project ne ""} { append w /$project }

    file delete $workspace
    file mkdir  $w

    write 0 cvs "Workspace:  $workspace"
    return $w
}

# Building the revision tree from the changesets.
# Limitation: Currently only trunk csets is handled.
# Limitation: Dead files are not removed, i.e. no 'R' actions right now.

proc ::vc::cvs::ws::ProcessBranches {} {
    variable importable

    write 0 cvs "Organizing the changesets into branches"

    set remainder [ProcessTrunk]
    while {[llength $remainder]} {
	set remainder [ProcessBranch $remainder]
	# return -code break may be signaled to give up with non-empty
	# set of unprocessed changesets.
    }

    # Status information ...
    set nr  [llength $remainder]
    set ni  [llength $importable]
    set fmt %[string length [csets::num]]s

    write 0 cvs "Unprocessed: [format $fmt $nr] [SIPL $nr changeset] (Will be ignored)"
    write 0 cvs "To import:   [format $fmt $ni] [SIPL $ni changeset]"
    return
}

proc ::vc::cvs::ws::ProcessTrunk {} {
    variable importable

    write 0 cvs "Processing the trunk changesets"

    set remainder {}
    set t         0
    set n         [csets::num]
    set parent    {}

    for {set c 0} {$c < $n} {incr c} {
	if {[csets::isTrunk $c]} {
	    csets::setParentOf $c $parent
	    set parent $c
	    incr t
	    lappend importable $c
	} else {
	    lappend remainder $c
	}
    }

    write 0 cvs "Found [NSIPL $t {trunk changeset}], [NSIPL [llength $remainder] {branch changeset}]"
    return $remainder
}

proc ::vc::cvs::ws::ProcessBranch {cslist} {
    write 0 cvs "Processing the remaining [SIPL [llength $cslist] changeset "[llength $cslist] changesets"]"

    set base   [lindex $cslist 0]
    set cslist [lrange $cslist 1 end]

    csets::DUMP $base

    # Which branch does base belong to?
    # - It has to be the base of an unprocessed branch!
    #   Otherwise it would have been on either the trunk
    #   or an already processed branch.
    # Where is its root changeset ?
    # - The root has to come before the base, it has already
    #   been processed => Smaller id, older in time.
    # - Based on the files changed/removed by the base, and their
    #   versions we know the root versions of these files, and we
    #   can determine the changesets they are in => Intersection
    #   plus cap from previous contraint gives us the possible
    #   candidates.

    write 4 cvs "Branch base $base"

    ::foreach {tag rootsig} [branch::find [csets::get $base]] break

    write 4 cvs "Branch tag  $tag"
    write 5 cvs "Root sig    $rootsig"

    set root [sig::find $base $rootsig]

    write 4 cvs "Branch root $root"

    write 0 cvs "Changeset $base, starting branch \"$tag\", rooted at $root"
    csets::setParentOf $base $root

    set remainder {}
    set t         1

    ::foreach c $cslist {
	#csets::DUMP $c
	if {[csets::sameBranch $c $base $tag]} {
	    csets::setParentOf $c $base
	    set base $c
	    incr t
	    lappend importable $c
	} else {
	    lappend remainder $c
	}
    }

    write 0 cvs "Found [NSIPL $t "$tag changeset"], [NSIPL [llength $remainder] changeset] outside"
    return $remainder
}

proc ::vc::cvs::ws::Checkout {f r} {
    variable base
    variable project

    # Added or modified, put the requested version of the file into
    # the workspace.

    if {$project ne ""} {set f $project/$f}
    if {[catch {
	dova -d $base co -r $r $f
    } msg]} {
	if {[string match {*invalid change text*} $msg]} {

	    # The archive of the file is corrupted and the chosen
	    # version not accessible due to that. We report the
	    # problem, but otherwise ignore it. As a consequence the
	    # destination repository will not contain the full history
	    # of the named file. By ignoring the problem we however
	    # get as much as is possible.

	    trouble::add "$f: Corrupted archive file. Inaccessible revision $r."
	    return
	}
	return -code error $msg
    }
    return
}

proc ::vc::cvs::ws::Remove {f r} {
    # Remove file from workspace. Prune empty directories.
    # NOTE: A dead-first file (rev 1.1 dead) will never have existed.

    file delete $f
    Prune [file dirname $f]
    return
}

proc ::vc::cvs::ws::Prune {path} {
    # NOTE: Logically empty directories still physically contain the
    # CVS admin directory, hence the check for == 1, not == 0. There
    # might also be hidden files, we count them as well. Always hidden
    # are . and .. and they do not count as user file.

    if {
	([llength [glob -nocomplain -directory              $path *]] == 1) &&
	([llength [glob -nocomplain -directory -type hidden $path *]] == 2)
    } {
	file delete -force $path
    }
    return
}

proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
    return "$n [SIPL $n $singular $plural]"
}
proc ::vc::cvs::ws::SIPL {n singular {plural {}}} {
    if {$n == 1} {return $singular}
    if {$plural eq ""} {set plural ${singular}s}
    return $plural
}

# -----------------------------------------------------------------------------

namespace eval ::vc::cvs::ws {
    variable base       {} ; # Toplevel repository directory
    variable project    {} ; # Sub directory to limit the import to.
    variable workspace  {} ; # Directory to checkout changesets to.
    variable importable {} ; # List of the csets which can be imported.

    namespace export configure begin done foreach ncsets nimportable checkout
    namespace export parentOf
}

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

package provide vc::cvs::ws 1.0
return

namespace eval ::vc::cvs::ws::branch {}

# Trivial storage of all branch data as a rectangular table.  We can
# think up a better suited storage system later, when we know what
# type of queries are made to this module.

proc ::vc::cvs::ws::branch::def {f dv deflist} {
    upvar 1 $dv date
    variable bra
    foreach {tag rev} $deflist {
	# ignore non-branch tags
	if {[llength [split $rev .]] < 4} continue

	if 0 {
	    if { ($rev ne "1.1.1.1") && ![string match *.0.2 $rev] } {
		# 1.1.1.1 is the base of vendor branches, usually. *.0.y
		# is the base of regular branches where nothing is on the
		# branch yet, only its root is marked. Everything else is
		# noteworthy for now.
		puts $f/$rev/$tag
	    }
	}

	set root [revroot $rev]
	lappend bra [list $date($root) $tag $f $rev]
    }
}

proc ::vc::cvs::ws::branch::revroot {rev} {
    return [join [lrange [split $rev .] 0 end-2] .]
}


    # ! Files in a branch can appear only after their root revision
    #   exists. This can be checked against the time of the cset which
    #   is our base. Branches which have no files yet can be eliminated
    #   from consideration.

    # ! All files noted by the base cset as added/modified have to be
    #   in the branch root. Branches which do not have such a file can
    #   be eliminated from consideration.

    # ! The versions of the added/modified files in the base have
    #   match the versions in the branch root. In the sense that they
    #   have to be equal or sucessors. The later implies identity in the
    #   upper parts (only the last 2 parts are relevant), and equal
    #   length.

    # This gives us the branch, and, due to the time information a
    # signature for the root.

    #? Can search for the root based on this signature fail ?
    #  Yes. Because the signature may contain files which were not
    #  actually yet in the root, despite being able to. And which were
    #  not modified by the base, so the check 2 above still passes.

    # -> Search for the full signature first, then drop the youngest
    # files, search again until match. Check the result against the
    # base, that all needed files are present.

    # However - Can search for the root based on the cset data (needed
    # files). Gives us another set of candidate roots. Intersect!


proc ::vc::cvs::ws::branch::find {csvalue} {
    array set cs $csvalue

    #variable bra
    #puts ___________________________________________
    #puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]

    Signatures     bd [TimeRelevant $cs(date)]
    DropIncomplete bd [concat $cs(added) $cs(changed)]

    #puts ___________________________________________
    #parray bd

    if {[array size bd] < 1} {
	puts "NO BRANCH"
	# Deal how?
	# - Abort
	# - Ignore this changeset and try the next one
	#   (Which has higher probability of not matching as it might
	#    be the successor in the branch to this cset and not a base).
	puts ""
	parray cs
	exit
    } elseif {[array size bd] > 1} {

	# While we might have found several tag they may all refer to
	# the same set of files. If that is so we consider them
	# identical and take one as representative of all.

	set su {}
	foreach {t s} [array get bd] {
	    lappend su [DictSort $s]
	}
	if {[llength [lsort -unique $su]] > 1} {
	    puts "AMBIGOUS. The following branches match:"
	    # Deal how? S.a.
	    puts \t[join [array names bd] \n\t]
	    puts ""
	    parray cs
	    exit
	}
	# Fall through ...
    }

    set tg [lindex [array names bd] 0]
    set rs [RootOf $bd($tg)]

    #puts "BRANCH = $tg"
    #puts "ROOTSG = $rs"

    return [list $tg $rs]
}


proc ::vc::cvs::ws::branch::has {ts needed} {
    #variable bra
    #puts ___________________________________________
    #puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]

    Signatures     bd [TimeRelevant $ts]
    DropIncomplete bd $needed

    #puts ___________________________________________
    #parray bd

    if {[array size bd] < 1} {
	puts "NO BRANCH"
	# Deal how?
	# - Abort
	# - Ignore this changeset and try the next one
	#   (Which has higher probability of not matching as it might
	#    be the successor in the branch to this cset and not a base).
	exit
    } elseif {[array size bd] > 1} {
	puts "AMBIGOUS. Following branches match:"
	# Deal how? S.a.
	puts \t[join [array names bd] \n\t]
	exit
    }

    set tg [lindex [array names bd] 0]

    #puts "BRANCH = $tg"

    return $tg
}



proc ::vc::cvs::ws::branch::RootOf {dict} {
    set res {}
    foreach {f r} $dict {
	lappend res $f [revroot $r]
    }
    return $res
}

proc ::vc::cvs::ws::branch::DictSort {dict} {
    array set a $dict
    set r {}
    foreach k [lsort [array names a]] {
	lappend r $k $a($k)
    }
    return $r
}

proc ::vc::cvs::ws::branch::DropIncomplete {bv needed} {
    upvar 1 $bv bdata

    # Check the needed files against the branch signature. If files
    # are missing or not of a matching version drop the branch from
    # further consideration.

    foreach {tag sig} [array get bdata] {
	array set rev $sig
	foreach {file rv} $needed {
	    if {![info exists rev($file)] || ![successor $rv $rev($file)]} {
		# file in cset is not in the branch or is present, but
		# not proper version (different lengths, not matching
		# in upper 0..end-2 parts, not equal|successor).
		unset bdata($tag)
		break
	    } 
	    continue
	}
	unset rev
    }
    return
}

proc ::vc::cvs::ws::branch::successor {ra rb} {
    # a successor-of b ?

    set la [split $ra .]
    set lb [split $rb .]
    if {
	([llength $la]         != [llength $lb])         ||
	([lrange  $la 0 end-2] ne [lrange  $lb 0 end-2]) ||
	([package vcompare $ra $rb] < 0)
    } {
	return 0
    } else {
	return 1
    }
}

proc ::vc::cvs::ws::branch::rootSuccessor {ra rb} {
    # a root-successor-of b ? (<=> b root version of a ?)

    if {$rb eq [revroot $ra]} {
	return 1
    } else {
	return 0
    }
}

proc ::vc::cvs::ws::branch::Signatures {bv deflist} {
    upvar 1 $bv bdata
    # Sort branch data by symbolic name for the upcoming checks, and
    # generate file revision signatures.

    array set bdata {}
    foreach item $deflist {
	# item = timestamp tag file revision
	foreach {__ tag file rev} $item break
	lappend bdata($tag) $file $rev
    }

    #puts ___________________________________________
    #parray bdata

    return
}

proc ::vc::cvs::ws::branch::TimeRelevant {date} {
    variable bra

    # Retrieve the branch data which definitely comes before (in time)
    # the candidate cset. Only this set is relevant to further checks
    # and filters.

    set res {}
    foreach item $bra {
	# item = timestamp tag file revision
	#        0         1   2    3
	if {[package vcompare [lindex $item 0] $date] > 0} continue
	lappend res $item
    }

    #puts ___________________________________________
    #puts [join [lsort -index 0 [lsort -index 1 $res]] \n]
    return $res
}


namespace eval ::vc::cvs::ws::branch {
    variable bra {}

    namespace export def find successor rootSuccessor revroot has
}

package provide vc::cvs::ws::branch 1.0
return




    # Queries ... 
    # - Get set of files and revs for branch B which can be in it by the time T
    # - Check if a file referenced a/m instruction is in a set of files
    #   and revision, identical or proper sucessor.
    # => Combination
    #    Can branch B match the cset file a/m at time T ?
    # => Full combination
    #    Give me the list of branches which can match the cset file a/m
    #    at time T.

    # Branch DB organization => (Tag -> (Time -> (File -> Rev)))
    # The full combination actually does not need a complex structure.
    # We can simply scan a plain list of branch data.
    # The only alternative is an inverted index.
    # Time -> ((File -> Rev) -> Tag). Difficult to process.
    # Linear scan:
    # - Time after T   => drop
    # - File !in a/m   => drop
    # - Version !match => drop
    # -- Collect tag
    # Then lsort -unique for our result.
    # NO - The file check is inverted - All files have to be in a/m for the base, not a/m in files
    # == - This also breaks the issue for same-branch detection -
    #    future csets in the branch do not have that property.

    puts ___________________________________________
    # Show only branch data which definitely comes before the
    # candidate cset

    array set n [concat $cs(added) $cs(changed)]
    set xx {}
    set bb {}
    ::foreach x $bra {
	::foreach {ts tag f r} $x break
	if {[package vcompare $ts $cs(date)] > 0} continue
	if {![info exists n($f)]} continue
	if {
	    ([llength [split $n($f) .]] != [llength [split $r .]]) ||
	    ([lrange [split $n($f) .] 0 end-2] ne [lrange [split $r .] 0 end-2]) ||
	    ([package vcompare $n($f) $r] < 0)
	} continue
	lappend xx $x
	lappend bb $tag
    }
    puts [join [lsort -index 0 [lsort -index 1 $xx]] \n]
    puts [join [lsort -unique $bb] \n]

exit

# -----------------------------------------------------------------------------
# Access to the external cvs command.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
namespace eval ::vc::cvs::cmd {}

# -----------------------------------------------------------------------------
# API

# vc::cvs::cmd::dova word... - Run a cvs command specified as var args.
# vc::cvs::cmd::do   words   - Run a cvs command specified as a list.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::cmd::dova {args} {do $args}

proc ::vc::cvs::cmd::do {words} {
    variable cmd
    if {![llength $words]} {
	return -code error "Empty cvs command"
    }
    # 8.5: exec $cmd {*}$words
    return [eval [linsert $words 0 exec $cmd]]
}

# -----------------------------------------------------------------------------
# Internals.

namespace eval ::vc::cvs::cmd {
    # Locate external cvs application.
    variable cmd [auto_execok cvs]

    # Bail out if not found.
    if {![llength $::vc::cvs::cmd::cmd]} {
	return -code error "Cvs application not found."
    }

    namespace export do dova
}

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

package provide vc::cvs::cmd 1.0
return

# -----------------------------------------------------------------------------
# Repository management (CVS), Changeset grouping and storage.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::cvs::ws::sig      ; # Changeset file/rev signatures

namespace eval ::vc::cvs::ws::csets::Current {}
namespace eval ::vc::cvs::ws::csets::sig {
    namespace import ::vc::cvs::ws::sig::*
}

# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::csets::init   - Initialize accumulator
# vc::cvs::ws::csets::add    - Add timeline entry to accumulor, may generate new cset
# vc::cvs::ws::csets::done   - Complete cset generation.
#
# vc::cvs::ws::csets::get id - Get data of a cset.
# vc::cvs::ws::csets::num    - Get number of csets.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::csets::init {} {
    variable ncs 0
    Current::Clear
    return
}

proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
    if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
	Save [Current::Complete]
    }
    Current::Add $date $file $revision $operation $author $cmsg
    return
}

proc ::vc::cvs::ws::csets::done {} {
    if {![Current::Empty]} {
	Save [Current::Complete]
    }
    return
}

proc ::vc::cvs::ws::csets::get {id} {
    variable csets
    return  $csets($id)
}


proc ::vc::cvs::ws::csets::DUMP {id} {
    puts /${id}/_________________
    array set cs [get $id]
    parray cs
    return
}

proc ::vc::cvs::ws::csets::num {} {
    variable csets
    return [array size csets]
}

proc ::vc::cvs::ws::csets::isTrunk {id} {
    variable csets
    array set cs $csets($id)
    return [expr {$cs(lastd) == 2}]
}

proc ::vc::cvs::ws::csets::setParentOf {id parent} {
    variable csets
    lappend  csets($id) parent $parent

    array set cs $csets($id)
    sig::def            $id $parent $cs(added) $cs(changed) $cs(removed)
    return
}

proc ::vc::cvs::ws::csets::parentOf {id} {
    variable      csets
    array set cs $csets($id)
    return   $cs(parent)
}

proc ::vc::cvs::ws::csets::sameBranch {id parent tag} {
    variable      csets
    array set cs $csets($id)
    return [sig::next $parent $cs(added) $cs(changed) $cs(removed) $tag $cs(date)]
}

# -----------------------------------------------------------------------------
# Internal helper commands: Changeset inspection and construction.

proc ::vc::cvs::ws::csets::Save {data} {
    variable csets
    variable ncs

    set csets($ncs) $data
    incr ncs
    return
}

proc ::vc::cvs::ws::csets::Current::Clear {} {
    variable    start   {} ; # date the changeset begins
    variable    cmsg    {} ; # commit message of the changeset
    variable    author  {} ; # user creating the changeset
    variable    lastd   {} ; # version depth of last added file.
    variable    removed {} ; # file -> revision of removed files.
    variable    added   {} ; # file -> revision of added files.
    variable    changed {} ; # file -> revision of modified files.
    variable    files
    array unset files *
    array set   files {}   ; # file -> revision
    return
}

proc ::vc::cvs::ws::csets::Current::Empty {} {
    variable start
    return [expr {$start eq ""}]
}

proc ::vc::cvs::ws::csets::Current::New {nfile nrevision nauthor ncmsg} {
    upvar 1 reason reason
    variable cmsg
    variable author
    variable lastd
    variable files

    # User change
    if {$nauthor ne $author} {
	set reason user
	return 1
    }

    # File already in current cset
    if {[info exists files($nfile)]} {
	set reason file
	return 1
    }

    # Current cset trunk/branch different from entry.
    set ndepth [llength [split $nrevision .]]
    if {($lastd == 2) != ($ndepth == 2)} {
	set reason depth/$lastd/$ndepth/($nrevision)/$nfile
	return 1
    }

    # Commit message changed
    if {$ncmsg ne $cmsg} {
	set reason cmsg/<<$ncmsg>>
	return 1
    }

    # The new entry still belongs to the current changeset
    return 0
}

proc ::vc::cvs::ws::csets::Current::Add {ndate nfile nrevision noperation nauthor ncmsg} {
    variable start
    variable cmsg
    variable author
    variable lastd
    variable removed
    variable added
    variable changed
    variable files

    if {$start eq ""} {set start $ndate}
    set cmsg          $ncmsg
    set author        $nauthor
    set lastd         [llength [split $nrevision .]]
    set files($nfile) $nrevision

    if {$noperation eq "R"} {
	lappend removed $nfile $nrevision
    } elseif {$noperation eq "A"} {
	lappend added   $nfile $nrevision
    } else {
	lappend changed $nfile $nrevision
    }
    return
}

proc ::vc::cvs::ws::csets::Current::Complete {} {
    variable start
    variable cmsg
    variable author
    variable lastd
    variable removed
    variable added
    variable changed

    set res [list \
		date    $start \
		author  $author \
		cmsg    [string trim $cmsg] \
		removed $removed \
		added   $added \
		changed $changed \
		lastd   $lastd]
    Clear
    return $res
}

# -----------------------------------------------------------------------------
# Internals

namespace eval ::vc::cvs::ws::csets {

    # Cset storage

    # csets: id -> dict
    # dict: date
    #       author
    #       csmg
    #       removed
    #       added
    #       changed
    #       lastd

    variable  ncs   0  ; # Counter for changesets
    variable  csets
    array set csets {} ; # Changeset data

    # Data of the current changeset built from timeline entries.
    namespace eval Current {
	variable  start   {} ; # date the changeset begins
	variable  cmsg    {} ; # commit message of the changeset
	variable  author  {} ; # user creating the changeset
	variable  lastd   {} ; # version depth of last added file.
	variable  removed {} ; # file -> revision of removed files.
	variable  added   {} ; # file -> revision of added files.
	variable  changed {} ; # file -> revision of modified files.
	variable  files
	array set files {}   ; # file -> revision
    }

    namespace export init add done get num isTrunk setParentOf parentOf sameBranch
}

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

package provide vc::cvs::ws::csets 1.0
return

# -----------------------------------------------------------------------------
# Repository management (CVS), archive files

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
package require vc::tools::log     ; # User feedback

namespace eval ::vc::cvs::ws::files {
    namespace import ::vc::tools::log::write
    namespace import ::vc::tools::log::progress
}

# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::files::find path - Find all RCS archives under the path.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::files::find {path} {

    write 0 cvs "Scanning directory hierarchy $path ..."

    set t [fileutil::traverse %AUTO% $path]
    set n 0
    set r {}

    $t foreach rcs {
	if {![string match *,v $rcs]} continue

	# Now make rcs is relative to the base/project
	set rcs [fileutil::stripPath $path $rcs]

	if {[string match CVSROOT/* $rcs]} {
	    write 2 cvs "Ignoring administrative file: $rcs"
	    continue
	}

	set f [UserFile $rcs isattic]

	if {$isattic && [file exists $path/$f,v]} {
	    # We have a regular archive and an Attic archive refering
	    # to the same user visible file. Ignore the file in the
	    # Attic.

	    write 2 cvs "Ignoring superceded attic:    $rcs"

	    # 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 the info only to gather
	    # when csets begin and end, and then to co complete slices
	    # per exact timestamp (-D) instead of file revisions
	    # (-r). The flaw in that is that csets can occur in the
	    # same second (trf, memchan - check for examples). For
	    # that exact checkout may be needed to recreate exact
	    # sequence of changes. Grr. Six of one ...

	    continue
	}

	lappend r $rcs $f
	incr n
	progress 0 cvs $n {}
    }

    $t destroy
    return $r
}

# -----------------------------------------------------------------------------
# Internals

proc ::vc::cvs::ws::files::UserFile {rcs iav} {
    upvar 1 $iav isattic

    # Derive the regular path from the rcs path. Meaning: Chop of the
    # ",v" suffix, and remove a possible "Attic".

    set f [string range $rcs 0 end-2]

    if {"Attic" eq [lindex [file split $rcs] end-1]} {

	# The construction below ensures that Attic/X maps to X
	# instead of ./X. Otherwise, Y/Attic/X maps to Y/X.

	set fx [file dirname [file dirname $f]]
	set f  [file tail $f]
	if {$fx ne "."} { set f [file join $fx $f] }

	set isattic 1
    } else {
	set isattic 0
    }

    return $f
}

# -----------------------------------------------------------------------------

namespace eval ::vc::cvs::ws::files {
    namespace export find
}

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

package provide vc::cvs::ws::files 1.0
return

package require struct::set
package require vc::cvs::ws::branch

namespace eval ::vc::cvs::ws::sig::branch {
    namespace import ::vc::cvs::ws::branch::*
}

# Save the mapping from changesets to file/rev signatures, and further
# remember all the csets a specific file/rev combination belongs to.

proc ::vc::cvs::ws::sig::def {id parent added changed removed} {
    variable sig
    variable csl

    array set new $sig($parent)
    array set new $added
    array set new $changed
    foreach {f r} $removed {catch {unset new($f)}}
    set sig($id) [DictSort [array get new]]

    foreach {f r} [array get new] {
	lappend csl($f,$r) $id
    }
    return
}

proc ::vc::cvs::ws::sig::next {id added changed removed tag ts} {
    variable sig
    array set rev $sig($id)

    #puts sig::next/$ts
    foreach {f r} [concat $changed $removed] {
	if {![info exists rev($f)]}              {

	    # A file missing in the candidate parent changeset is
	    # _not_ a reason to reject it, at least not immediately.
	    # The code generating the timeline entries has only
	    # partial information and is prone to misclassify files
	    # added to branches as changed instead of added. Thus we
	    # move this file to the list of added things and check it
	    # again as part of that, see below.

	    lappend added $f $r
	    continue
	}
	if {[branch::rootSuccessor $r $rev($f)]} continue
	if {![branch::successor    $r $rev($f)]} {
	    #puts "not-successor($r of $rev($f))"
	    return 0
	}
    }

    if {[llength $added]} {
	# Check that added files belong to the branch too!
	if {$tag ne [branch::has $ts $added]} {
	    #puts "not-added-into-same-branch"
	    return 0
	}
    }
    return 1
}


proc ::vc::cvs::ws::sig::find {id sig} {
    set cslist [Cut $id [Find $sig]]

    if {[llength $cslist] < 1} {
	puts "NO ROOT"
	# Deal how?
	# - Abort
	# - Ignore this changeset and try the next one
	#   (Which has higher probability of not matching as it might
	#    be the successor in the branch to this cset and not a base).
	exit
    } elseif {[llength $cslist] > 1} {
	puts "AMBIGOUS. Following csets match root requirements:"
	# Deal how? S.a.
	puts \t[join $cslist \n\t]
	exit
    }

    set r [lindex $cslist 0]
    #puts "ROOT = $r"
    return $r
}

proc ::vc::cvs::ws::sig::Cut {id cslist} {
    # Changesets have to be before id! This makes for another
    # intersection, programmatic.

    set res {}
    foreach c $cslist {
	if {$c >= $id} continue
	lappend res $c
    }
    return $res
}

proc ::vc::cvs::ws::sig::Find {sig} {
    # Locate all changesets which contain the given signature.

    # First we try to the exact changeset, by intersecting the
    # live-intervals for all file revisions found in the
    # signature. This however may fail, as CVS is able to contain
    # a-causal branch definitions.

    # Example: sqlite, branch "gdbm-branch".

    # File 'db.c', branch 1.6.2, root 1.6, entered on Jan 31, 2001.
    # Then 'dbbegdbm.c',  1.1.2, root 1.1, entered on Oct 19, 2000.

    # More pertinent, revision 1.2 was entered Jan 13, 2001,
    # i.e. existed before Jan 31, before the branchwas actually
    # made. Thus it is unclear why 1.1 is in the branch instead.

    # An alternative complementary question would be how db.c 1.6
    # ended up in a branch tag created before Jan 13, when this
    # revision did not exist yet.

    # So, CVS repositories can be a-causal when it comes to branches,
    # at least in the details. Therefore while try for an exact result
    # first we do not fail if that fails, but use a voting scheme as
    # fallback which answers the question about which changeset is
    # acceptable to the most file revisions in the signature.

    # Note that multiple changesets are ok at this level and are
    # simply returned.

    set res [Intersect $sig]
    puts Exact=($res)

    if {[llength $res]} { return $res }

    set res [Vote $sig]
    puts Vote=($res)

    return $res
}


proc ::vc::cvs::ws::sig::Intersect {sig} {
    variable csl

    set res {}
    set first 1
    foreach {f r} $sig {
	#puts $f/$r?
	# Unknown file not used anywhere
	if {![info exists csl($f,$r)]} {return {}}
	#puts $f/$r\t=\t($csl($f,$r))*($res)/$first

	if {$first} {
	    set res $csl($f,$r)
	    set first 0
	    #puts F($res)
	} else {
	    set res [struct::set intersect $res $csl($f,$r)]
	    #puts R($res)
	    if {![llength $res]} {return {}}
	}
    }
    return $res
}


proc ::vc::cvs::ws::sig::Vote {sig} {
    variable csl

    # I. Accumulate votes.
    array set v {}
    foreach {f r} $sig {
	# Unknown revisions do not vote.
	if {![info exists csl($f,$r)]} continue
	foreach c $csl($f,$r) {
	    if {[info exists v($c)]} {
		incr v($c)
	    } else {
		set v($c) 1
	    }
	}
    }

    # Invert index for easier finding the max, compute the max at the
    # same time.
    array set tally {}
    set max -1
    foreach {c n} [array get v] {
	lappend tally($n) $c
	if {$n > $max} {set max $n}
    }

    #parray tally
    puts Max=$max

    # Return the changesets having the most votes.
    return $tally($max)
}


proc ::vc::cvs::ws::sig::DictSort {dict} {
    array set a $dict
    set r {}
    foreach k [lsort [array names a]] {
	lappend r $k $a($k)
    }
    return $r
}


namespace eval ::vc::cvs::ws::sig {
    variable  sig ; # cset id -> signature
    array set sig {{} {}}
    variable  csl ; # file x rev -> list (cset id)
    array set csl {}

    namespace export def find next
}

package provide vc::cvs::ws::sig 1.0
return

# -----------------------------------------------------------------------------
# Repository management (CVS), timeline of events.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4

namespace eval ::vc::cvs::ws::timeline {}

# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::timeline::add     date file revision operation author commit-msg
# vc::cvs::ws::timeline::foreach date file revision operation author commit-msg script

# Add entries to the timeline, and iterate over the timeline in proper order.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::timeline::add {date file revision operation author cmsg} {
    variable timeline
    lappend  timeline($date) [list $file $revision $operation $author $cmsg]
    return
}

proc ::vc::cvs::ws::timeline::foreach {dv fv rv ov av cv script} {
    upvar 1 $dv date $fv file $rv revision $ov operation $av author $cv cmsg
    variable timeline

    ::foreach date [lsort -dict [array names timeline]] {
	# file revision operation author commitmsg
	# 0    1        2         3      4/end
	# d    e        b         c      a

	set entries [lsort -index 1 \
			 [lsort -index 0 \
			      [lsort -index 3 \
				   [lsort -index 2 \
					[lsort -index end \
					     $timeline($date)]]]]]
	#puts [join $entries \n]

	::foreach entry $entries {
	    lassign $entry file revision operation author cmsg
	    set code [catch {uplevel 1 $script} res]

	    # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
	    switch -- $code {
		0 {}
		1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
		2 {}
		3 { return }
		4 {}
		default {
		    return -code $code $result
		}
	    }
	}
    }
    return
}

# -----------------------------------------------------------------------------
# Internals

proc ::vc::cvs::ws::timeline::lassign {l args} {
    ::foreach v $args {upvar 1 $v $v} 
    ::foreach $args $l break
    return
}

namespace eval ::vc::cvs::ws::timeline {
    # Timeline: map (date -> list (file revision operation author commitmsg))

    variable  timeline
    array set timeline {}

    namespace export add
}

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

package provide vc::cvs::ws::timeline 1.0
return

# -----------------------------------------------------------------------------
# Repository management (FOSSIL)

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::tools::log  ; # User feedback
package require vc::fossil::cmd ; # Access to fossil application.

namespace eval ::vc::fossil::ws {
    vc::tools::log::system fossil
    namespace import ::vc::tools::log::write
    namespace import ::vc::fossil::cmd::do
    namespace import ::vc::fossil::cmd::dova
}

# -----------------------------------------------------------------------------
# API

# vc::fossil::ws::configure key value         - Configure the subsystem.
# vc::fossil::ws::begin     src               - Start new workspace for directory
# vc::fossil::ws::done      dst               - Close workspace and copy to destination.
# vc::fossil::ws::setup     uuid              - Move workspace to an older revision.
# vc::fossil::ws::commit    cset usr time msg - Look for changes and commit as new revision.

# Configuration keys:
#
# -nosign  bool		default 0 (= sign imported changesets)
# -breakat num		default empty, no breakpoint.
#			Otherwise stop before committing the identified changeset.
# -saveto  path		default empty, no saving.
#			Otherwise save the commit command to a file.
# -appname string	Default empty. Text to add to all commit messages.
# -ignore  cmdprefix	Command to check if a file is relevant to the commit or not.
#			Signature: cmdprefix path -> bool; true => ignore.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::fossil::ws::configure {key value} {
    variable nosign
    variable breakat
    variable saveto
    variable appname
    variable ignore

    switch -exact -- $key {
	-appname { set appname $value }
	-breakat { set breakat $value }
	-ignore  { set ignore  $value }
	-nosign {
	    if {![string is boolean -strict $value]} {
		return -code error "Expected boolean, got \"$value\""
	    }
	    set nosign $value
	}
	-saveto  { set saveto $value }
	default {
	    return -code error "Unknown switch $key, expected one of \
                                   -appname, -breakat, -ignore, -nosign, or -saveto"
	}
    }
    return
}

proc ::vc::fossil::ws::begin {origin} {
    variable base [file normalize $origin]
    variable rp   [file normalize [fileutil::tempfile import2_fsl_rp_]]

    cd $origin

    dova new  $rp ; # create and ...
    dova open $rp ; # ... connect

    write 0 fossil "Repository: $rp"
    return
}

proc ::vc::fossil::ws::done {destination} {
    variable rp
    file rename -force $rp $destination
    set rp {}
    return
}

proc ::vc::fossil::ws::setup {uuid} {
    variable lastuuid
    if {$uuid eq $lastuuid} return
    write 1 fossil "=> goto $uuid"
    dova update $uuid
    set lastuuid $uuid
    return
}

proc ::vc::fossil::ws::commit {cset user timestamp message} {
    variable lastuuid
    variable base

    cd $base

    # Commit the current state of the workspace. Scan for new and
    # removed files and issue the appropriate fossil add/rm commands
    # before actually comitting.

    HandleChanges added removed changed

    # Now commit, using the provided meta data, and capture the uuid
    # of the new baseline.

    set cmd [Command $cset [Message $user $timestamp $message]]

    if {[catch {
	do $cmd
    } line]} {
	if {![string match "*nothing has changed*" $line]} {
	    return -code error $line
	}

	# '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.

	write 1 fossil "UNCHANGED, keeping last"

	return [list $lastuuid 0 0 0]
    }

    # Extract the uuid of the new revision.
    regsub -nocase -- {^\s*New_Version:\s*} [string trim $line] {} uuid

    set lastuuid $uuid
    return [list $uuid $added $removed $changed]
}

# -----------------------------------------------------------------------------
# Internal helper commands, and data structures.

proc ::vc::fossil::ws::HandleChanges {av rv cv} {
    upvar 1 $av added $rv removed $cv changed

    set added   0
    set removed 0
    set changed 0

    # Look for modified/removed files first, that way there won't be
    # any ADDED indicators. Nor REMOVED, only EDITED. Removed files
    # show up as EDITED while they are not registered as removed.

    foreach line [split [do changes] \n] {
        regsub {^\s*EDITED\s*} $line {} path
        if {[Ignore $path]} continue

        if {![file exists $path]} {
	    dova rm $path
            incr removed
            write 2 fossil "-  $path"
        } else {
            incr changed
            write 2 fossil "*  $path"
        }
    }

    # Now look for unregistered added files.

    foreach path [split [do extra] \n] {
        if {[Ignore $path]} continue
        dova add $path
        incr added
        write 2 fossil "+  $path"
    }

    return
}

proc ::vc::fossil::ws::Message {user timestamp message} {
    variable appname
    set lines {}
    lappend lines "-- Originally by $user @ $timestamp"
    if {$appname ne ""} {
	lappend lines "-- Imported by $appname"
    }
    lappend lines [string trim $message]
    return [join $lines \n]
}

proc ::vc::fossil::ws::Command {cset message} {
    variable nosign
    variable saveto
    variable breakat

    set cmd [list commit -m $message]

    if {$nosign}           { lappend cmd --nosign }
    if {$saveto ne ""}     { fileutil::writeFile $saveto "$cmd\n" }

    if {$breakat eq $cset} {
	write 0 fossil Stopped.
	exit 0
    }

    return $cmd
}

proc ::vc::fossil::ws::Ignore {path} {
    variable ignore
    if {![llength $ignore]} {return 0}
    return [uplevel #0 [linsert $ignore end $path]]
}

namespace eval ::vc::fossil::ws {
    # Configuration settings.
    variable nosign 0   ; # Sign imported changesets
    variable breakat {} ; # Do not stop
    variable saveto  {} ; # Do not save commit message
    variable appname {} ; # Name of importer application using the package.
    variable ignore  {} ; # No files to ignore.

    variable base     {} ; # Workspace directory
    variable rp       {} ; # Repository the package works on.
    variable lastuuid {} ; # Uuid of last imported changeset.

    namespace export configure begin done setup commit
}

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

package provide vc::fossil::ws 1.0
return

# -----------------------------------------------------------------------------
# Access to the external fossil command.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
namespace eval ::vc::fossil::cmd {}

# -----------------------------------------------------------------------------
# API

# vc::fossil::cmd::dova word... - Run a fossil command specified as var args
# vc::fossil::cmd::do   words   - Run a fossil command specified in a list.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::fossil::cmd::dova {args} {do $args}

proc ::vc::fossil::cmd::do {words} {
    variable cmd
    if {![llength $words]} {
	return -code error "Empty fossil command"
    }
    # 8.5: exec $cmd {*}$words
    return [eval [linsert $words 0 exec $cmd]]
}

# -----------------------------------------------------------------------------
# Internals.

namespace eval ::vc::fossil::cmd {
    # Locate external fossil application.
    variable cmd [auto_execok fossil]

    # Bail out if not found.
    if {![llength $::vc::fossil::cmd::cmd]} {
	return -code error "Fossil application not found."
    }

    namespace export do dova
}

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

package provide vc::fossil::cmd 1.0
return

# -----------------------------------------------------------------------------
# Management of the mapping between cvs changesets and fossil uuids.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::tools::log  ; # User feedback

namespace eval ::vc::fossil::import::map {
    vc::tools::log::system map
    namespace import ::vc::tools::log::write
}

# -----------------------------------------------------------------------------
# API

#     vc::fossil::import::map
#         set cset uuid    - Associate changeset with uuid
#         get cset -> uuid - Retrieve uuid for changeset.

# -----------------------------------------------------------------------------
# API Implementation - Functionality

proc ::vc::fossil::import::map::set {cset uuid} {
    variable map
    ::set map($cset) $uuid
    write 2 map "== $uuid"
    return
}

proc ::vc::fossil::import::map::get {cset} {
    variable map
    return $map($cset)
}

# -----------------------------------------------------------------------------

namespace eval ::vc::fossil::import::map {
    variable  map    ; # Map from csets to uuids
    array set map {} ; #

    namespace export get set
}

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

package provide vc::fossil::import::map 1.0
return

# -----------------------------------------------------------------------------
# Management of statistics for an import run.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::tools::log  ; # User feedback

namespace eval ::vc::fossil::import::stats {
    vc::tools::log::system stats
    namespace import ::vc::tools::log::write
}

# -----------------------------------------------------------------------------
# API

#     vc::fossil::import::stats
#         setup n m  - Initialize module, expect n changesets, of m.
#         done       - Write final statistics.
#         csbegin id - Import of identified changeset begins.
#         csend x    - It took x seconds to import the changeset.
#         

# -----------------------------------------------------------------------------
# API Implementation - Functionality

proc ::vc::fossil::import::stats::setup {n m} {
    variable run_format    %[string length $n]s
    variable max_format    %[string length $m]s
    variable total_csets   $n
    variable total_running 0
    variable total_seconds 0.0
    return
}

proc ::vc::fossil::import::stats::done {} {
    variable total_csets
    variable total_seconds

    write 0 stats "========= [string repeat = 61]"
    write 0 stats "Imported $total_csets [expr {($total_csets == 1) ? "changeset" : "changesets"}]"
    write 0 stats "Within [F $total_seconds] seconds (avg [F [Avg]] seconds/changeset)"
    return
}

proc ::vc::fossil::import::stats::csbegin {cset} {
    variable max_format
    variable run_format
    variable total_running
    variable total_csets

    incr total_running

    write 0 stats "ChangeSet [format $max_format $cset] @ [format $run_format $total_running]/$total_csets ([F6 [expr {$total_running*100.0/$total_csets}]]%)"
    return
}

proc ::vc::fossil::import::stats::csend {seconds} {
    variable total_csets
    variable total_seconds
    variable total_running

    set  total_seconds [expr {$total_seconds + $seconds}]

    set avg [Avg]
    set end [expr {$total_csets * $avg}]
    set rem [expr {$end - $total_seconds}]

    write 2 stats "Imported in        [F7 $seconds] seconds"
    write 3 stats "Average Time/Cset  [F7 $avg] seconds"
    write 3 stats "Current Runtime    [FTime $total_seconds]"
    write 3 stats "Total Runtime  (E) [FTime $end]"
    write 3 stats "Remaining Time (E) [FTime $rem]"
    # (E) for Estimated.

    return
}

# -----------------------------------------------------------------------------
# Internal helper commands.

proc ::vc::fossil::import::stats::FTime {s} {
    set m [expr {$s / 60}]
    set h [expr {$s / 3600}]
    return "[F7 $s] sec [F6 $m] min [F5 $h] hr"
}

proc ::vc::fossil::import::stats::F  {x} { format %.2f  $x }
proc ::vc::fossil::import::stats::F5 {x} { format %5.2f $x }
proc ::vc::fossil::import::stats::F6 {x} { format %6.2f $x }
proc ::vc::fossil::import::stats::F7 {x} { format %7.2f $x }

proc ::vc::fossil::import::stats::Avg {} {
    variable total_seconds
    variable total_running
    return [expr {$total_seconds/$total_running}]
}

# -----------------------------------------------------------------------------

namespace eval ::vc::fossil::import::stats {
    variable total_csets   0 ; # Number of changesets to expect to be imported
    variable total_running 0 ; # Number of changesets which have been imported so far
    variable total_seconds 0 ; # Current runtime in seconds
    variable max_format   %s ; # Format to print changeset id, based on the largest id.
    variable run_format   %s ; # Format to print the number of imported csets.

    namespace export setup done csbegin csend
}

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

package provide vc::fossil::import::stats 1.0
return

# -----------------------------------------------------------------------------
# Tool packages. Main control module for importing from a CVS repository.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::cvs::ws               ; # Frontend, reading from source repository
package require vc::fossil::ws            ; # Backend,  writing to destination repository.
package require vc::tools::log            ; # User feedback.
package require vc::fossil::import::stats ; # Management for the Import Statistics.
package require vc::fossil::import::map   ; # Management of the cset <-> uuid mapping.
package require vc::rcs::parser           ; # Parser configuration

namespace eval ::vc::fossil::import::cvs {
    vc::tools::log::system import
    namespace import ::vc::tools::log::write
    namespace eval cvs    { namespace import ::vc::cvs::ws::* }
    namespace eval fossil { namespace import ::vc::fossil::ws::* }
    namespace eval stats  { namespace import ::vc::fossil::import::stats::* }
    namespace eval map    { namespace import ::vc::fossil::import::map::* }
    namespace eval rcs    { namespace import ::vc::rcs::parser::* }

    fossil::configure -appname cvs2fossil
    fossil::configure -ignore  ::vc::cvs::ws::isadmin
}

# -----------------------------------------------------------------------------
# API

# Configuration
#
#	vc::fossil::import::cvs::configure key value - Set configuration
#
#       Legal keys:     -nosign  <bool>, default false
#                       -breakat <int>,  default :none:
#                       -saveto  <path>, default :none:
#                       -limit   <path>, default :none:
#
# Functionality
#
#	vc::fossil::import::cvs::run src dst         - Perform an import.

# -----------------------------------------------------------------------------
# API Implementation - Functionality

proc ::vc::fossil::import::cvs::configure {key value} {
    # The options are simply passed through to the fossil importer
    # backend.
    switch -exact -- $key {
	-breakat   { fossil::configure -breakat $value }
	-cache-rcs { rcs::configure    -cache   $value }
	-nosign    { fossil::configure -nosign  $value }
	-project   { cvs::configure    -project $value }
	-saveto    { fossil::configure -saveto  $value }
	default {
	    return -code error "Unknown switch $key, expected one of \
                                   -breakat, -cache, -nosign, -project, or -saveto"
	}
    }
    return
}

# Import the CVS repository found at directory 'src' into the new
# fossil repository at 'dst'.

proc ::vc::fossil::import::cvs::run {src dst} {
    map::set {} {}

    set src [file normalize $src]
    set dst [file normalize $dst]

    set ws [cvs::begin $src]
    fossil::begin $ws
    stats::setup [cvs::nimportable] [cvs::ncsets]

    cvs::foreach cset {
	Import1 $cset
    }

    stats::done
    fossil::done $dst
    cvs::done

    write 0 import Ok.
    return
}

# -----------------------------------------------------------------------------
# Internal operations - Import a single changeset.

proc ::vc::fossil::import::cvs::Import1 {cset} {
    stats::csbegin $cset

    set microseconds [lindex [time {ImportCS $cset} 1] 0]
    set seconds      [expr {$microseconds/1e6}]

    stats::csend $seconds
    return
}

proc ::vc::fossil::import::cvs::ImportCS {cset} {
    fossil::setup [map::get [cvs::parentOf $cset]]
    lassign [cvs::checkout  $cset] user  timestamp  message
    lassign [fossil::commit $cset $user $timestamp $message] uuid ad rm ch
    write 2 import "== +${ad}-${rm}*${ch}"
    map::set $cset $uuid
    return
}

proc ::vc::fossil::import::cvs::lassign {l args} {
    foreach v $args {upvar 1 $v $v} 
    foreach $args $l break
    return
}

# -----------------------------------------------------------------------------

namespace eval ::vc::fossil::import::cvs {
    namespace export run configure
}

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

package provide vc::fossil::import::cvs 1.0
return

# -----------------------------------------------------------------------------
# Tool packages. Logging (aka User feedback).

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
namespace eval ::vc::tools::log {}

# -----------------------------------------------------------------------------
# API

# Feedback generation.
#
#	vc::tools::log::write    verbosity system text  - Write message to the log.
#	vc::tools::log::progress verbosity system n max - Drive a progress display.
#
#       Note: max empty => infinite progress display, otherwise a finite display.

# Administrative operations.
#
#	vc::tools::log::verbosity level  - Set the verbosity level of the application.
#	vc::tools::log::verbosity?       - Query the verbosity level of the application.
#	vc::tools::log::setCmd cmdprefix - Set callback for output
#	vc::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 ::vc::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 ::vc::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 ::vc::tools::log::verbosity {level} {
    variable loglevel
    if {$level < 1} {set level 0}
    set loglevel $level
    return
}

# Query the currently set verbosity.

proc ::vc::tools::log::verbosity? {} {
    variable loglevel
    return  $loglevel
}

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

proc ::vc::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 ::vc::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 ::vc::tools::log::OUT {op args} {
    eval [linsert $args 0 ::vc::tools::log::OUT/$op]
    return
}

# Write handler. Each message is a line.

proc ::vc::tools::log::OUT/write {system text} {
    puts "$system $text"
    return
}

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

proc ::vc::tools::log::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
}

# -----------------------------------------------------------------------------

namespace eval ::vc::tools::log {
    variable loglevel 0                     ; # Allow only uninteruptible messages.
    variable logcmd   ::vc::tools::log::OUT ; # Standard output to stdout.
    variable sysfmt %s                      ; # Non-tabular formatting.
    variable syslen 0                       ; # Ditto.

    namespace export write progress
}

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

package provide vc::tools::log 1.0
return

if {![package vsatisfies [package require Tcl] 8.4]} return
package ifneeded vc::rcs::parser           1.0 [list source [file join $dir rcsparser.tcl]]
package ifneeded vc::cvs::cmd              1.0 [list source [file join $dir cvs_cmd.tcl]]
package ifneeded vc::cvs::ws               1.0 [list source [file join $dir cvs.tcl]]
package ifneeded vc::cvs::ws::files        1.0 [list source [file join $dir cvs_files.tcl]]
package ifneeded vc::cvs::ws::timeline     1.0 [list source [file join $dir cvs_timeline.tcl]]
package ifneeded vc::cvs::ws::csets        1.0 [list source [file join $dir cvs_csets.tcl]]
package ifneeded vc::cvs::ws::branch       1.0 [list source [file join $dir cvs_branch.tcl]]
package ifneeded vc::cvs::ws::sig          1.0 [list source [file join $dir cvs_sig.tcl]]
package ifneeded vc::fossil::cmd           1.0 [list source [file join $dir fossil_cmd.tcl]]
package ifneeded vc::fossil::ws            1.0 [list source [file join $dir fossil.tcl]]
package ifneeded vc::fossil::import::cvs   1.0 [list source [file join $dir importcvs.tcl]]
package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
package ifneeded vc::fossil::import::map   1.0 [list source [file join $dir import_map.tcl]]
package ifneeded vc::tools::log            1.0 [list source [file join $dir log.tcl]]
package ifneeded vc::tools::trouble        1.0 [list source [file join $dir trouble.tcl]]

# -----------------------------------------------------------------------------
# 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)
package require vc::tools::log ; # User feedback

namespace eval ::vc::rcs::parser {
    vc::tools::log::system rcs
    namespace import ::vc::tools::log::*
}

# -----------------------------------------------------------------------------
# API

# vc::rcs::parser::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 ::vc::rcs::parser::configure {key value} {
    variable cache
    switch -exact -- $key {
	-cache  {
	    set cache $value
	}
	default {
	    return -code error "Unknown switch $key, expected one of -cache"
	}
    }
    return
}

proc ::vc::rcs::parser::process {path} {
    variable cache

    if {!$cache} {
	return [Process $path]
    }

    set cachefile [Cache $path]
    if {
	[file exists $cachefile] &&
	([file mtime $cachefile] > [file mtime $path])
    } {
	# Use preparsed data if not invalidated by changes to the
	# archive they are derived from.
	write 4 rcs {Load preparsed data block}
	return [fileutil::cat -encoding binary $cachefile]
    }

    set res [Process $path]

    # Save parse result for quick pickup by future runs.
    fileutil::writeFile $cachefile $res

    return $res
}

# -----------------------------------------------------------------------------

proc ::vc::rcs::parser::Process {path} {
    set data [fileutil::cat -encoding binary $path]
    array set res {}
    set res(size) [file size $path]
    set res(done) 0
    set res(nsize) [string length $res(size)]

    Admin
    Deltas
    Description
    DeltaTexts

    # Remove parser state
    catch {unset res(id)}
    catch {unset res(lastval)}
    unset res(size)
    unset res(nsize)
    unset res(done)

    return [array get res]
}

proc ::vc::rcs::parser::Cache {path} {
    return ${path},,preparsed
}

# -----------------------------------------------------------------------------
# Internal - Recursive Descent functions implementing the syntax.

proc ::vc::rcs::parser::Admin {} {
    upvar 1 data data res res
    Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
    return
}

proc ::vc::rcs::parser::Deltas {} {
    upvar 1 data data res res
    while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
    return
}

proc ::vc::rcs::parser::Description {} {
    upvar 1 data data res res
    Literal desc
    String 1
    Def desc
    return
}

proc ::vc::rcs::parser::DeltaTexts {} {
    upvar 1 data data res res
    while {[Num 0]} { IsIdent ; Log ; Text }
    return
}

proc ::vc::rcs::parser::Head {} {
    upvar 1 data data res res
    Literal head ; Num 1 ; Literal \;
    Def head
    return
}

proc ::vc::rcs::parser::Branch {} {
    upvar 1 data data res res
    if {![Literal branch 0]} return ; Num 1 ; Literal \;
    Def branch
    return
}

proc ::vc::rcs::parser::Access {} {
    upvar 1 data data res res
    Literal access ; Literal \;
    return
}

proc ::vc::rcs::parser::Symbols {} {
    upvar 1 data data res res
    Literal symbols
    while {[Ident]} { Num 1 ; Map symbol }
    Literal \;
    return
}

proc ::vc::rcs::parser::Locks {} {
    upvar 1 data data res res
    Literal locks
    while {[Ident]} { Num 1 ; Map lock }
    Literal \;
    return
}

proc ::vc::rcs::parser::Strict {} {
    upvar 1 data data res res
    if {![Literal strict 0]} return ; Literal \;
    return
}

proc ::vc::rcs::parser::Comment {} {
    upvar 1 data data res res
    if {![Literal comment 0]} return ;
    if {![String 0]} return ;
    Literal \;
    Def comment
    return
}

proc ::vc::rcs::parser::Expand {} {
    upvar 1 data data res res
    if {![Literal expand 0]} return ;
    if {![String 0]} return ;
    Literal \;
    Def expand
    return
}

proc ::vc::rcs::parser::Date {} {
    upvar 1 data data res res
    Literal date ; Num 1 ; Literal \;

    foreach {yr mo dy h m s} [split $res(lastval) .] break
    if {$yr < 100} {incr yr 1900}
    set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
    Map date
    return
}

proc ::vc::rcs::parser::Author {} {
    upvar 1 data data res res
    Literal author ; Skip ; Literal \; ; Map author
    return
}

proc ::vc::rcs::parser::State {} {
    upvar 1 data data res res
    Literal state ; Skip ; Literal \; ; Map state
    return
}

proc ::vc::rcs::parser::Branches {} {
    upvar 1 data data res res
    Literal branches ; Skip ; Literal \;
    return
}

proc ::vc::rcs::parser::NextRev {} {
    upvar 1 data data res res
    Literal next ; Skip ; Literal \; ; Map parent
    return
}

proc ::vc::rcs::parser::Log {} {
    upvar 1 data data res res
    Literal log ; String 1 ; Map commit
    return
}

proc ::vc::rcs::parser::Text {} {
    upvar 1 data data res res
    Literal text ; String 1
    return
}

# -----------------------------------------------------------------------------
# Internal - Lexicographical commands and data aquisition preparation

proc ::vc::rcs::parser::Ident {} {
    upvar 1 data data res res

    #puts I@?<[string range $data 0 10]...>

    if {[regexp -indices -- {^\s*;\s*} $data]} {
	return 0
    } elseif {![regexp -indices -- {^\s*([^:]*)\s*:\s*} $data match val]} {
	return 0
    }

    Get $val ; IsIdent
    Next
    return 1
}

proc ::vc::rcs::parser::Literal {name {required 1}} {
    upvar 1 data data res res
    if {![regexp -indices -- "^\\s*$name\\s*" $data match]} {
	if {$required} {
	    return -code error "Expected '$name' @ '[string range $data 0 30]...'"
	}
	return 0
    }

    Next
    return 1
}

proc ::vc::rcs::parser::String {{required 1}} {
    upvar 1 data data res res

    if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} {
	if {$required} {
	    return -code error "Expected string @ '[string range $data 0 30]...'"
	}
	return 0
    }

    Get $val
    Next
    return 1
}

proc ::vc::rcs::parser::Num {required} {
    upvar 1 data data res res
    if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} {
	if {$required} {
	    return -code error "Expected id @ '[string range $data 0 30]...'"
	}
	return 0
    }

    Get $val
    Next
    return 1
}

proc ::vc::rcs::parser::Skip {} {
    upvar 1 data data res res
    regexp -indices -- {^\s*([^;]*)\s*} $data match val
    Get $val
    Next
    return
}

# -----------------------------------------------------------------------------
# Internal - Data aquisition

proc ::vc::rcs::parser::Def {key} {
    upvar 1 data data res res
    set res($key) $res(lastval)
    unset res(lastval)
    return
}

proc ::vc::rcs::parser::Map {key} {
    upvar 1 data data res res
    lappend res($key) $res(id) $res(lastval)
    #puts Map($res(id))=($res(lastval))
    unset res(lastval)
    #unset res(id);#Keep id for additional mappings.
    return
}

proc ::vc::rcs::parser::IsIdent {} {
    upvar 1 data data res res
    set res(id) $res(lastval)
    unset res(lastval)
    return
}

proc ::vc::rcs::parser::Get {val} {
    upvar 1 data data res res
    foreach {s e} $val break
    set res(lastval) [string range $data $s $e]
    #puts G|$res(lastval)
    return
}

proc ::vc::rcs::parser::Next {} {
    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]}]

    progress 2 rcs $res(done) $res(size)
    return
}

# -----------------------------------------------------------------------------

namespace eval ::vc::rcs::parser {
    variable cache 0 ; # No result caching by default.

    namespace export process configure
}

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

package provide vc::rcs::parser 1.0
return

# -----------------------------------------------------------------------------
# Tool packages. Error reporting.

# -----------------------------------------------------------------------------
# Requirements

package require Tcl 8.4
package require vc::tools::log

namespace eval ::vc::tools::trouble {
    ::vc::tools::log::system trouble
    namespace import ::vc::tools::log::write
}

# -----------------------------------------------------------------------------
# API

# vc::tools::trouble::add message - Report error (shown in general
#                                   log), and remember for re-display at exit.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::tools::trouble::add {text} {
    variable messages
    lappend  messages $text
    write trouble 0   $text
    return
}

# -----------------------------------------------------------------------------
# Internals. Hook into the application exit, show the remembered messages, then
# pass through the regular command.

rename ::exit vc::tools::trouble::EXIT
proc   ::exit {{status 0}} {
    variable ::vc::tools::trouble::messages
    foreach m $messages {
	write trouble 0 $m
    }
    ::vc::tools::trouble::EXIT $status
    # Not reached.
    return
}

namespace eval ::vc::tools::trouble {
    # List of the remembered error messages to be shown at exit
    variable messages {}

    namespace export add 
}

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

package provide vc::tools::trouble 1.0
return