Fossil SCM

Third attempt at getting a cvs importer which can handle branches. Using cvs2svn code and design notes as a guide.

aku 2007-10-02 03:05 trunk

Commit 2a98ac44bd535270ce50afb7f20ec3955bff6d83

Parent 7a64b9e738eea1f…

23 files changed +32 +19 +7 +50 +23 +12 -141 -465 -323 -49 -248 -113 -221 -87 -231 -49 -50 -116 -127 -153 -16 -303 -57

+ tools/cvs2fossil/cvs2fossil + tools/cvs2fossil/doc/LICENSE + tools/cvs2fossil/doc/README + tools/cvs2fossil/lib/c2f_option.tcl + tools/cvs2fossil/lib/cvs2fossil.tcl + tools/cvs2fossil/lib/pkgIndex.tcl - tools/import-cvs.tcl - tools/lib/cvs.tcl - tools/lib/cvs_branch.tcl - tools/lib/cvs_cmd.tcl - tools/lib/cvs_csets.tcl - tools/lib/cvs_files.tcl - tools/lib/cvs_sig.tcl - tools/lib/cvs_timeline.tcl - tools/lib/fossil.tcl - tools/lib/fossil_cmd.tcl - tools/lib/import_map.tcl - tools/lib/import_statistics.tcl - tools/lib/importcvs.tcl - tools/lib/log.tcl - tools/lib/pkgIndex.tcl - tools/lib/rcsparser.tcl - tools/lib/trouble.tcl

A tools/cvs2fossil/cvs2fossil

+32

		--- a/tools/cvs2fossil/cvs2fossil
		+++ b/tools/cvs2fossil/cvs2fossil
		@@ -0,0 +1,32 @@
	1	+#!/bin/sh
	2	+## -- tcl -- \
	3	+exec tclsh "$0" ${1+"$@"}
	4	+
	5	+# # ## ### ##### ######## ############# #####################
	6	+## Copyright (c) 2007 Andreas Kupries.
	7	+#
	8	+# This software is licensed as described in the file LICENSE, which
	9	+# you should have received as part of this distribution.
	10	+#
	11	+# This software consists of voluntary contributions made by many
	12	+# individuals. For exact contribution history, see the revision
	13	+# history and logs, available at http://fossil-scm.hwaci.com/fossil
	14	+# # ## ### ##### ######## ############# #####################
	15	+
	16	+## Command line application wrapped around the import packages.
	17	+
	18	+# # ## ### ##### ######## ############# #####################
	19	+## Requirements, extended package management for local packages.
	20	+
	21	+lappend auto_path [file join [file dirname [info script]] lib]
	22	+
	23	+package require Tcl 8.4 ; # Required runtime.
	24	+package require vc::fossil::import::cvs ; # Main functionality.
	25	+
	26	+# # ## ### ##### ######## ############# #####################
	27	+## Execution
	28	+
	29	+vc::fossil::import::cvs run $argv
	30	+exit 0
	31	+
	32	+# # ## ### ##### ######## ############# #####################

	--- a/tools/cvs2fossil/cvs2fossil
	+++ b/tools/cvs2fossil/cvs2fossil
	@@ -0,0 +1,32 @@

	--- a/tools/cvs2fossil/cvs2fossil
	+++ b/tools/cvs2fossil/cvs2fossil
	@@ -0,0 +1,32 @@
1	#!/bin/sh
2	## -- tcl -- \
3	exec tclsh "$0" ${1+"$@"}
4
5	# # ## ### ##### ######## ############# #####################
6	## Copyright (c) 2007 Andreas Kupries.
7	#
8	# This software is licensed as described in the file LICENSE, which
9	# you should have received as part of this distribution.
10	#
11	# This software consists of voluntary contributions made by many
12	# individuals. For exact contribution history, see the revision
13	# history and logs, available at http://fossil-scm.hwaci.com/fossil
14	# # ## ### ##### ######## ############# #####################
15
16	## Command line application wrapped around the import packages.
17
18	# # ## ### ##### ######## ############# #####################
19	## Requirements, extended package management for local packages.
20
21	lappend auto_path [file join [file dirname [info script]] lib]
22
23	package require Tcl 8.4 ; # Required runtime.
24	package require vc::fossil::import::cvs ; # Main functionality.
25
26	# # ## ### ##### ######## ############# #####################
27	## Execution
28
29	vc::fossil::import::cvs run $argv
30	exit 0
31
32	# # ## ### ##### ######## ############# #####################

A tools/cvs2fossil/doc/LICENSE

+19

		--- a/tools/cvs2fossil/doc/LICENSE
		+++ b/tools/cvs2fossil/doc/LICENSE
		@@ -0,0 +1,19 @@
	1	+This code is under the same license as fossil itself.
	2	+
	3	+- - -- --- ----- ---------
	4	+
	5	+This program is free software; you can redistribute it and/or
	6	+modify it under the terms of the GNU General Public
	7	+License version 2 as published by the Free Software Foundation.
	8	+
	9	+This program is distributed in the hope that it will be useful,
	10	+but WITHOUT ANY WARRANTY; without even the implied warranty of
	11	+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	12	+General Public License for more details.
	13	+
	14	+You should have received a copy of the GNU General Public
	15	+License along with this library; if not, write to the
	16	+Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	17	+Boston, MA 02111-1307, USA.
	18	+
	19	+- - -- --- ----- ---------

	--- a/tools/cvs2fossil/doc/LICENSE
	+++ b/tools/cvs2fossil/doc/LICENSE
	@@ -0,0 +1,19 @@

	--- a/tools/cvs2fossil/doc/LICENSE
	+++ b/tools/cvs2fossil/doc/LICENSE
	@@ -0,0 +1,19 @@
1	This code is under the same license as fossil itself.
2
3	- - -- --- ----- ---------
4
5	This program is free software; you can redistribute it and/or
6	modify it under the terms of the GNU General Public
7	License version 2 as published by the Free Software Foundation.
8
9	This program is distributed in the hope that it will be useful,
10	but WITHOUT ANY WARRANTY; without even the implied warranty of
11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12	General Public License for more details.
13
14	You should have received a copy of the GNU General Public
15	License along with this library; if not, write to the
16	Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17	Boston, MA 02111-1307, USA.
18
19	- - -- --- ----- ---------

A tools/cvs2fossil/doc/README

		--- a/tools/cvs2fossil/doc/README
		+++ b/tools/cvs2fossil/doc/README
		@@ -0,0 +1,7 @@
	1	+
	2	+[Acknowledge the work done by the creators of and submitters to the
	3	+cvs2svn project/application. Needed their documentation, notes, and
	4	+code as guide for this implementation.]
	5	+
	6	+[Determine if their license allows me to copy their notes here for
	7	+reference.]

	--- a/tools/cvs2fossil/doc/README
	+++ b/tools/cvs2fossil/doc/README
	@@ -0,0 +1,7 @@

	--- a/tools/cvs2fossil/doc/README
	+++ b/tools/cvs2fossil/doc/README
	@@ -0,0 +1,7 @@
1
2	[Acknowledge the work done by the creators of and submitters to the
3	cvs2svn project/application. Needed their documentation, notes, and
4	code as guide for this implementation.]
5
6	[Determine if their license allows me to copy their notes here for
7	reference.]

A tools/cvs2fossil/lib/c2f_option.tcl

+50

		--- a/tools/cvs2fossil/lib/c2f_option.tcl
		+++ b/tools/cvs2fossil/lib/c2f_option.tcl
		@@ -0,0 +1,50 @@
	1	+##}iscprojectpass # --loopcheck--loopcheck{ integrity loopcheckon--loopcass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
	2	+ # --caches-
	3	+ --help##}iscpr##}iscprojectpa{ PrintVersion ; exit 0 }
	4	+
	5	+ --project-
	6	+ --verbose { log verbose }
	7	+ -q -
	8	+ --quiet { log quiet }
	9	+
	10	+ --cache {
	11	+ #
	12	+ }
	13	+ default { }
	14	+}
	15	+ass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
	16	+ # --project -p-
	17	+ --passes {
	18	+
	19	+ }
	20	+ {
	21	+
	22	+ }
	23	+ --project {
	24	+
	25	+ }
	26	+
	27	+
	28	+ project {
	29	+ :repository addprojU@ZT,35@b3,O:#cvs::repository setbaseN@1AP,E7@ej,J7@wZ,54@1E~,F:::option {
	30	+ b@1K~,4: N@1K~,J@1Jl,6:::pass27@1OE,3MP9Ac;
	31	+opcheck--loopcheck{ integrPrintHelp
	32	+ --help-passes PrintHelpPasses
	33	+ --version PrintVersionexit 0
	34	+ }
	35	+
	36	+ Conversion passes:set n 0
	37	+ foreach {p desc} {
	38	+ CollectAr {Collect archives}
	39	+ CollectRe[format %2
	40	+ass # --loopcheck--loopcheck{ integrity loopcheckon--loopcass and state
	41	+#$text"
	42	+ puts "Usage: $argv0 $text"
	43	+ exit 1kon--loopcass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
	44	+ # --caches-
	45	+ --help##}iscpr##}iscprojectpa{ PrintVersion ; exit 0 }
	46	+
	47	+ --project-
	48	+ --verbose { log verbose }
	49	+ -q -
	50	+##}iscprojectpass # --loopcheck--loopcheck{ integrity loopchec

	--- a/tools/cvs2fossil/lib/c2f_option.tcl
	+++ b/tools/cvs2fossil/lib/c2f_option.tcl
	@@ -0,0 +1,50 @@

	--- a/tools/cvs2fossil/lib/c2f_option.tcl
	+++ b/tools/cvs2fossil/lib/c2f_option.tcl
	@@ -0,0 +1,50 @@
1	##}iscprojectpass # --loopcheck--loopcheck{ integrity loopcheckon--loopcass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
2	# --caches-
3	--help##}iscpr##}iscprojectpa{ PrintVersion ; exit 0 }
4
5	--project-
6	--verbose { log verbose }
7	-q -
8	--quiet { log quiet }
9
10	--cache {
11	#
12	}
13	default { }
14	}
15	ass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
16	# --project -p-
17	--passes {
18
19	}
20	{
21
22	}
23	--project {
24
25	}
26
27
28	project {
29	:repository addprojU@ZT,35@b3,O:#cvs::repository setbaseN@1AP,E7@ej,J7@wZ,54@1E~,F:::option {
30	b@1K~,4: N@1K~,J@1Jl,6:::pass27@1OE,3MP9Ac;
31	opcheck--loopcheck{ integrPrintHelp
32	--help-passes PrintHelpPasses
33	--version PrintVersionexit 0
34	}
35
36	Conversion passes:set n 0
37	foreach {p desc} {
38	CollectAr {Collect archives}
39	CollectRe[format %2
40	ass # --loopcheck--loopcheck{ integrity loopcheckon--loopcass and state
41	#$text"
42	puts "Usage: $argv0 $text"
43	exit 1kon--loopcass # --loopcheck--loopcheck{ integrity loopcheckon--loopc
44	# --caches-
45	--help##}iscpr##}iscprojectpa{ PrintVersion ; exit 0 }
46
47	--project-
48	--verbose { log verbose }
49	-q -
50	##}iscprojectpass # --loopcheck--loopcheck{ integrity loopchec

A tools/cvs2fossil/lib/cvs2fossil.tcl

+23

		--- a/tools/cvs2fossil/lib/cvs2fossil.tcl
		+++ b/tools/cvs2fossil/lib/cvs2fossil.tcl
		@@ -0,0 +1,23 @@
	1	+## -- tcl --
	2	+# # ## ## ; # Icontrols their interaction.
	3	+
	4	+# # ## ### ##### ######## ############# #####################
	5	+## Requirements
	6	+
	7	+package require Tcl 8.4 ; # Required runtime.
	8	+package require snit ; # OO system
	9	+
	10	+# # ## ### ##### ######## ############# #####################
	11	+## Passes. The order in which the various passes are loaded is
	12	+## important. It is the same order in which they will
	13	+## register, and then be run in.
	14	+
	15	+package require vc::fossil::import::cvs::pass::collar ; # Coll'ect Ar'chives.
	16	+package require vc::fossil::import::cvs::pass::collrev ; # Coll'ect Rev'is; # Coll'ect AR'chivesge require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R ## ; # Icontrols the## -- tcl --
	17	+# # ## ## ; # Icontrols their interaction.
	18	+
	19	+# # ## ### ##### ######## ############# #####################
	20	+## Requirements
	21	+
	22	+package require Tcl 8.4 ; # Required runtime.
	23	+pforeach pass [option p

	--- a/tools/cvs2fossil/lib/cvs2fossil.tcl
	+++ b/tools/cvs2fossil/lib/cvs2fossil.tcl
	@@ -0,0 +1,23 @@

	--- a/tools/cvs2fossil/lib/cvs2fossil.tcl
	+++ b/tools/cvs2fossil/lib/cvs2fossil.tcl
	@@ -0,0 +1,23 @@
1	## -- tcl --
2	# # ## ## ; # Icontrols their interaction.
3
4	# # ## ### ##### ######## ############# #####################
5	## Requirements
6
7	package require Tcl 8.4 ; # Required runtime.
8	package require snit ; # OO system
9
10	# # ## ### ##### ######## ############# #####################
11	## Passes. The order in which the various passes are loaded is
12	## important. It is the same order in which they will
13	## register, and then be run in.
14
15	package require vc::fossil::import::cvs::pass::collar ; # Coll'ect Ar'chives.
16	package require vc::fossil::import::cvs::pass::collrev ; # Coll'ect Rev'is; # Coll'ect AR'chivesge require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R require vc::fossil::import::cvs::pass::collrev ; # Coll'ect R ## ; # Icontrols the## -- tcl --
17	# # ## ## ; # Icontrols their interaction.
18
19	# # ## ### ##### ######## ############# #####################
20	## Requirements
21
22	package require Tcl 8.4 ; # Required runtime.
23	pforeach pass [option p

A tools/cvs2fossil/lib/pkgIndex.tcl

+12

		--- a/tools/cvs2fossil/lib/pkgIndex.tcl
		+++ b/tools/cvs2fossil/lib/pkgIndex.tcl
		@@ -0,0 +1,12 @@
	1	+roject
	2	+vs2fossilfileroject
	3	+optionroject
	4	+assroject
	5	+rojectrepositoryrepositorystateroject
	6	+logtools::miscroject
	7	+trouble.tcl]]
	8	+
	9	+optionoptionpassprojectproject
	10	+passsilfileroject
	11	+optionrojroject
	12	+vs2f:collarc@8G,s@AV,A:repository_@IF,1C@Dm,a@DG,7:projectm@D~,5:statei@6V,13@HE,X@DG,7:troublpasslog.tcl]]

	--- a/tools/cvs2fossil/lib/pkgIndex.tcl
	+++ b/tools/cvs2fossil/lib/pkgIndex.tcl
	@@ -0,0 +1,12 @@

	--- a/tools/cvs2fossil/lib/pkgIndex.tcl
	+++ b/tools/cvs2fossil/lib/pkgIndex.tcl
	@@ -0,0 +1,12 @@
1	roject
2	vs2fossilfileroject
3	optionroject
4	assroject
5	rojectrepositoryrepositorystateroject
6	logtools::miscroject
7	trouble.tcl]]
8
9	optionoptionpassprojectproject
10	passsilfileroject
11	optionrojroject
12	vs2f:collarc@8G,s@AV,A:repository_@IF,1C@Dm,a@DG,7:projectm@D~,5:statei@6V,13@HE,X@DG,7:troublpasslog.tcl]]

D tools/import-cvs.tcl

-141

		--- a/tools/import-cvs.tcl
		+++ b/tools/import-cvs.tcl
		@@ -1,141 +0,0 @@
1		-#!/bin/sh
2		-# -- tcl -- \
3		-exec tclsh "$0" ${1+"$@"}
4		-
5		-# -----------------------------------------------------------------------------
6		-
7		-# Import the trunk of a CVS repository wholesale into a fossil repository.
8		-
9		-# Limitations implicitly mentioned:
10		-# - No incremental import.
11		-# - No import of branches.
12		-
13		-# WIBNI features (beyond eliminating the limitations):
14		-# - Restrict import to specific directory subtrees (SF projects use
15		-# one repository for several independent modules. Examples: tcllib
16		-# -> tcllib, tklib, tclapps, etc.). The restriction would allow import
17		-# of only a specific module.
18		-# - Related to the previous, strip elements from the base path to keep
19		-# it short.
20		-# - Export to CVS, trunk, possibly branches. I.e. extend the system to be
21		-# a full bridge. Either Fossil or CVS could be the master repository.
22		-
23		-# HACKS. I.e. I do not know if the 'fixes' I use are the correct way
24		-# of handling the encountered situations.
25		-#
26		-# - File F has archives F,v and Attic/F,v. Currently I will ignore the
27		-# file in the Attic.
28		-# Examples: sqlite/os_unix.h
29		-#
30		-# - A specific revision of a file F cannot be checked out (reported
31		-# error is 'invalid change text'). This indicates a corrupt RCS
32		-# file, one or more delta are bad. We report but ignore the problem
33		-# in a best-effort attempt at getting as much history as possible.
34		-# Examples: tcllib/tklib/modules/tkpiechart/pie.tcl
35		-
36		-# -----------------------------------------------------------------------------
37		-# Make private packages accessible.
38		-
39		-lappend auto_path [file join [file dirname [info script]] lib]
40		-
41		-# -----------------------------------------------------------------------------
42		-# Requirements
43		-
44		-package require Tcl 8.4
45		-package require vc::tools::log ; # User Feedback
46		-package require vc::fossil::import::cvs ; # Importer Control
47		-package require vc::cvs::ws ; # CVS frontend
48		-
49		-namespace eval ::import {
50		- namespace import ::vc::fossil::import::cvs::*
51		-}
52		-
53		-# -----------------------------------------------------------------------------
54		-
55		-proc main {} {
56		- commandline -> cvs fossil
57		- import::run $cvs $fossil
58		- return
59		-}
60		-
61		-# -----------------------------------------------------------------------------
62		-
63		-proc commandline {__ cv fv} {
64		- global argv
65		- upvar 1 $cv cvs $fv fossil
66		-
67		- set verbosity 0
68		-
69		- clinit
70		- while {[string match "-*" [set opt [this]]]} {
71		- switch -exact -- $opt {
72		- --breakat { next ; import::configure -breakat [this] }
73		- --cache-rcs { next ; import::configure -cache-rcs [this] }
74		- --nosign { import::configure -nosign 1 }
75		- --project { next ; import::configure -project [this] }
76		- --saveto { next ; import::configure -saveto [file normalize [this]] }
77		- -v { incr verbosity ; ::vc::tools::log::verbosity $verbosity }
78		- -h -
79		- default usage
80		- }
81		- next
82		- }
83		-
84		- remainder
85		- if {[llength $argv] != 2} usage
86		- foreach {cvs fossil} $argv break
87		-
88		- if {![::vc::cvs::ws::check $cvs msg]} {
89		- usage $msg
90		- } elseif {[file exists $fossil]} {
91		- usage "Fossil destination repository exists already."
92		- }
93		-
94		- return
95		-}
96		-
97		-proc this {} {
98		- global argv
99		- upvar 1 at at
100		- return [lindex $argv $at]
101		-}
102		-
103		-proc next {} {
104		- upvar 1 at at
105		- incr at
106		- return
107		-}
108		-
109		-proc remainder {} {
110		- upvar 1 at at
111		- global argv
112		- set argv [lrange $argv $at end]
113		- return
114		-}
115		-
116		-proc clinit {} {
117		- upvar 1 at at
118		- set at 0
119		- return
120		-}
121		-
122		-proc usage {{text {}}} {
123		- global argv0
124		- puts stderr "Usage: $argv0 ?-v? ?--nosign? ?--breakat id? ?--saveto path? cvs-repository fossil-repository"
125		- if {$text eq ""} {
126		- puts stderr " --nosign: Do not sign the imported changesets."
127		- puts stderr " --breakat: Stop just before committing the identified changeset."
128		- puts stderr " --cache-rcs: Boolean. Activate caching of rcs parse results"
129		- puts stderr " --project: Path in the CVS repository to limit the import to."
130		- puts stderr " --saveto: Save commit command to the specified file."
131		- puts stderr " -v: Increase log verbosity. Can be used multiple times."
132		- } else {
133		- puts stderr " $text"
134		- }
135		- exit
136		-}
137		-
138		-# -----------------------------------------------------------------------------
139		-
140		-main
141		-exit

	--- a/tools/import-cvs.tcl
	+++ b/tools/import-cvs.tcl
	@@ -1,141 +0,0 @@
1	#!/bin/sh
2	# -- tcl -- \
3	exec tclsh "$0" ${1+"$@"}
4
5	# -----------------------------------------------------------------------------
6
7	# Import the trunk of a CVS repository wholesale into a fossil repository.
8
9	# Limitations implicitly mentioned:
10	# - No incremental import.
11	# - No import of branches.
12
13	# WIBNI features (beyond eliminating the limitations):
14	# - Restrict import to specific directory subtrees (SF projects use
15	# one repository for several independent modules. Examples: tcllib
16	# -> tcllib, tklib, tclapps, etc.). The restriction would allow import
17	# of only a specific module.
18	# - Related to the previous, strip elements from the base path to keep
19	# it short.
20	# - Export to CVS, trunk, possibly branches. I.e. extend the system to be
21	# a full bridge. Either Fossil or CVS could be the master repository.
22
23	# HACKS. I.e. I do not know if the 'fixes' I use are the correct way
24	# of handling the encountered situations.
25	#
26	# - File F has archives F,v and Attic/F,v. Currently I will ignore the
27	# file in the Attic.
28	# Examples: sqlite/os_unix.h
29	#
30	# - A specific revision of a file F cannot be checked out (reported
31	# error is 'invalid change text'). This indicates a corrupt RCS
32	# file, one or more delta are bad. We report but ignore the problem
33	# in a best-effort attempt at getting as much history as possible.
34	# Examples: tcllib/tklib/modules/tkpiechart/pie.tcl
35
36	# -----------------------------------------------------------------------------
37	# Make private packages accessible.
38
39	lappend auto_path [file join [file dirname [info script]] lib]
40
41	# -----------------------------------------------------------------------------
42	# Requirements
43
44	package require Tcl 8.4
45	package require vc::tools::log ; # User Feedback
46	package require vc::fossil::import::cvs ; # Importer Control
47	package require vc::cvs::ws ; # CVS frontend
48
49	namespace eval ::import {
50	namespace import ::vc::fossil::import::cvs::*
51	}
52
53	# -----------------------------------------------------------------------------
54
55	proc main {} {
56	commandline -> cvs fossil
57	import::run $cvs $fossil
58	return
59	}
60
61	# -----------------------------------------------------------------------------
62
63	proc commandline {__ cv fv} {
64	global argv
65	upvar 1 $cv cvs $fv fossil
66
67	set verbosity 0
68
69	clinit
70	while {[string match "-*" [set opt [this]]]} {
71	switch -exact -- $opt {
72	--breakat { next ; import::configure -breakat [this] }
73	--cache-rcs { next ; import::configure -cache-rcs [this] }
74	--nosign { import::configure -nosign 1 }
75	--project { next ; import::configure -project [this] }
76	--saveto { next ; import::configure -saveto [file normalize [this]] }
77	-v { incr verbosity ; ::vc::tools::log::verbosity $verbosity }
78	-h -
79	default usage
80	}
81	next
82	}
83
84	remainder
85	if {[llength $argv] != 2} usage
86	foreach {cvs fossil} $argv break
87
88	if {![::vc::cvs::ws::check $cvs msg]} {
89	usage $msg
90	} elseif {[file exists $fossil]} {
91	usage "Fossil destination repository exists already."
92	}
93
94	return
95	}
96
97	proc this {} {
98	global argv
99	upvar 1 at at
100	return [lindex $argv $at]
101	}
102
103	proc next {} {
104	upvar 1 at at
105	incr at
106	return
107	}
108
109	proc remainder {} {
110	upvar 1 at at
111	global argv
112	set argv [lrange $argv $at end]
113	return
114	}
115
116	proc clinit {} {
117	upvar 1 at at
118	set at 0
119	return
120	}
121
122	proc usage {{text {}}} {
123	global argv0
124	puts stderr "Usage: $argv0 ?-v? ?--nosign? ?--breakat id? ?--saveto path? cvs-repository fossil-repository"
125	if {$text eq ""} {
126	puts stderr " --nosign: Do not sign the imported changesets."
127	puts stderr " --breakat: Stop just before committing the identified changeset."
128	puts stderr " --cache-rcs: Boolean. Activate caching of rcs parse results"
129	puts stderr " --project: Path in the CVS repository to limit the import to."
130	puts stderr " --saveto: Save commit command to the specified file."
131	puts stderr " -v: Increase log verbosity. Can be used multiple times."
132	} else {
133	puts stderr " $text"
134	}
135	exit
136	}
137
138	# -----------------------------------------------------------------------------
139
140	main
141	exit

	--- a/tools/import-cvs.tcl
	+++ b/tools/import-cvs.tcl
	@@ -1,141 +0,0 @@

D tools/lib/cvs.tcl

-465

		--- a/tools/lib/cvs.tcl
		+++ b/tools/lib/cvs.tcl
		@@ -1,465 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Repository management (CVS)
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require fileutil ; # Tcllib (traverse directory hierarchy)
9		-package require vc::rcs::parser ; # Handling the RCS archive files.
10		-package require vc::tools::log ; # User feedback
11		-package require vc::tools::trouble ; # Error handling
12		-package require vc::cvs::cmd ; # Access to cvs application.
13		-package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
14		-package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
15		-package require vc::cvs::ws::csets ; # Manage the changesets found in the timeline
16		-package require vc::cvs::ws::branch ; # Branch database
17		-package require vc::cvs::ws::sig ; # Changeset file/rev signatures
18		-
19		-namespace eval ::vc::cvs::ws {
20		- vc::tools::log::system cvs
21		- namespace import ::vc::tools::log::write
22		- namespace import ::vc::rcs::parser::process
23		- namespace import ::vc::cvs::cmd::dova
24		-
25		- namespace eval trouble { namespace import ::vc::tools::trouble::* }
26		-}
27		-
28		-# -----------------------------------------------------------------------------
29		-# API
30		-
31		-# vc::cvs::ws::configure key value - Configure the subsystem.
32		-# vc::cvs::ws::check src mv - Check if src is a CVS repository directory.
33		-# vc::cvs::ws::begin src - Start new workspace and return the top-
34		-# most directory co'd files are put into.
35		-# vc::cvs::ws::ncsets - Retrieve total number of csets
36		-# vc::cvs::ws::nimportable - Retrieve number of importable csets
37		-# vc::cvs::ws::foreach csvar script - Run the script for each changeset, the
38		-# id of the current changeset stored in
39		-# the variable named by csvar.
40		-# vc::cvs::ws::done - Close workspace and delete it.
41		-# vc::cvs::ws::isadmin path - Check if path is an admin file of CVS
42		-# vc::cvs::ws::checkout id - Have workspace contain the changeset id.
43		-# vc::cvs::ws::get id - Retrieve data of a changeset.
44		-#
45		-# Configuration keys:
46		-#
47		-# -project path - Sub directory under 'src' to limit the import to.
48		-
49		-# -----------------------------------------------------------------------------
50		-# API Implementation
51		-
52		-proc ::vc::cvs::ws::configure {key value} {
53		- variable project
54		-
55		- switch -exact -- $key {
56		- -project { set project $value }
57		- default {
58		- return -code error "Unknown switch $key, expected \
59		- -project"
60		- }
61		- }
62		- return
63		-}
64		-
65		-proc ::vc::cvs::ws::check {src mv} {
66		- variable project
67		- upvar 1 $mv msg
68		- if {
69		- ![fileutil::test $src erd msg "CVS Repository"] \|\|
70		- ![fileutil::test $src/CVSROOT erd msg "CVS Admin directory"] \|\|
71		- (($project ne "") &&
72		- ![fileutil::test $src/$project erd msg "Project directory"])
73		- } {
74		- return 0
75		- }
76		- return 1
77		-}
78		-
79		-proc ::vc::cvs::ws::begin {src} {
80		- if {![check $src msg]} { return -code error $msg }
81		-
82		- DefBase $src
83		- MakeTimeline [ScanArchives [files::find [RootPath]]]
84		- MakeChangesets
85		- ProcessBranches
86		-
87		- return [MakeWorkspace]
88		-}
89		-
90		-proc ::vc::cvs::ws::done {} {
91		- variable workspace
92		- file delete -force $workspace
93		- return
94		-}
95		-
96		-proc ::vc::cvs::ws::foreach {cv script} {
97		- variable importable
98		- upvar 1 $cv c
99		-
100		- ::foreach c [lsort -integer -increasing $importable] {
101		- set code [catch {uplevel 1 $script} res]
102		-
103		- # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
104		- switch -- $code {
105		- 0 {}
106		- 1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
107		- 2 {}
108		- 3 { return }
109		- 4 {}
110		- default { return -code $code $result }
111		- }
112		- }
113		- return
114		-}
115		-
116		-proc ::vc::cvs::ws::ncsets {args} {
117		- return [csets::num]
118		-}
119		-
120		-proc ::vc::cvs::ws::nimportable {args} {
121		- variable importable
122		- return [llength $importable]
123		-}
124		-
125		-proc ::vc::cvs::ws::isadmin {path} {
126		- # Check if path is a CVS admin file.
127		- if {[string match CVS/* $path]} {return 1}
128		- if {[string match /CVS/ $path]} {return 1}
129		- return 0
130		-}
131		-
132		-proc ::vc::cvs::ws::parentOf {id} { csets::parentOf $id }
133		-
134		-proc ::vc::cvs::ws::checkout {id} {
135		- variable workspace
136		- cd $workspace
137		-
138		- # TODO: Hide the direct access to the data structures behind
139		- # TODO: accessors for date, cmsg, removed, added, changed, and
140		- # TODO: author
141		- array set cs [csets::get $id]
142		-
143		- write 1 cvs "@ $cs(date)"
144		- ::foreach l [split [string trim $cs(cmsg)] \n] {
145		- write 1 cvs "\| $l"
146		- }
147		-
148		- ::foreach {f r} $cs(removed) { write 2 cvs "R $f $r" ; Remove $f $r }
149		- ::foreach {f r} $cs(added) { write 2 cvs "A $f $r" ; Checkout $f $r }
150		- ::foreach {f r} $cs(changed) { write 2 cvs "M $f $r" ; Checkout $f $r }
151		-
152		- # Provide metadata about the changeset the backend may wish to have
153		- return [list $cs(author) $cs(date) $cs(cmsg)]
154		-}
155		-
156		-# -----------------------------------------------------------------------------
157		-# Internals
158		-
159		-proc ::vc::cvs::ws::DefBase {path} {
160		- variable project
161		- variable base
162		-
163		- set base $path
164		-
165		- write 0 cvs "Base: $base"
166		- if {$project eq ""} {
167		- write 0 cvs "Project: <ALL>"
168		- } else {
169		- write 0 cvs "Project: $project"
170		- }
171		- return
172		-}
173		-
174		-proc ::vc::cvs::ws::RootPath {} {
175		- variable project
176		- variable base
177		-
178		- if {$project eq ""} {
179		- return $base
180		- } else {
181		- return $base/$project
182		- }
183		-}
184		-
185		-proc ::vc::cvs::ws::ScanArchives {files} {
186		- write 0 cvs "Scanning archives ..."
187		-
188		- set d [RootPath]
189		- set r {}
190		- set n 0
191		-
192		- ::foreach {rcs f} $files {
193		- write 1 cvs "Archive $rcs"
194		- # Get the meta data we need (revisions, timeline, messages).
195		- lappend r $f [process $d/$rcs]
196		- incr n
197		- }
198		-
199		- write 0 cvs "Processed [NSIPL $n file]"
200		- return $r
201		-}
202		-
203		-proc ::vc::cvs::ws::MakeTimeline {meta} {
204		- write 0 cvs "Generating coalesced timeline ..."
205		-
206		- set n 0
207		- ::foreach {f meta} $meta {
208		- array set md $meta
209		- array set date $md(date)
210		- array set auth $md(author)
211		- array set cmsg $md(commit)
212		- array set stat $md(state)
213		-
214		- ::foreach rev [lsort -dict [array names date]] {
215		- set operation [Operation $rev $stat($rev)]
216		- NoteDeadRoots $f $rev $operation
217		- timeline::add $date($rev) $f $rev $operation $auth($rev) $cmsg($rev)
218		- incr n
219		- }
220		-
221		- if {[info exists md(symbol)]} {
222		- branch::def $f date $md(symbol)
223		- }
224		-
225		- unset md
226		- unset date
227		- unset auth
228		- unset cmsg
229		- unset stat
230		- }
231		-
232		- write 0 cvs "Timeline has [NSIPL $n entry entries]"
233		- return
234		-}
235		-
236		-proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
237		- # A dead-first revision is rev 1.1 with op R. For an example see
238		- # the file memchan/DEPENDENCIES. Such a file seems to exist only!
239		- # on its branch. The branches information is set on the revision
240		- # (extend rcsparser!), symbols has a tag, refering to a branch,
241		- # possibly magic.
242		-
243		- if {($rev eq "1.1") && ($operation eq "R")} {
244		- write 2 cvs "Dead root revision: $f"
245		- }
246		- return
247		-}
248		-
249		-proc ::vc::cvs::ws::Operation {rev state} {
250		- if {$state eq "dead"} {return "R"} ; # Removed
251		- if {$rev eq "1.1"} {return "A"} ; # Added
252		- if {[string match *.1.1 $rev]} {return "A"} ; # Added on a branch
253		- return "M" ; # Modified
254		-}
255		-
256		-proc ::vc::cvs::ws::MakeChangesets {} {
257		- write 0 cvs "Generating changesets from timeline"
258		-
259		- csets::init
260		- timeline::foreach date file revision operation author cmsg {
261		- csets::add $date $file $revision $operation $author $cmsg
262		- }
263		- csets::done
264		-
265		- write 0 cvs "Found [NSIPL [csets::num] changeset]"
266		- return
267		-}
268		-
269		-proc ::vc::cvs::ws::MakeWorkspace {} {
270		- variable project
271		- variable workspace [fileutil::tempfile importF_cvs_ws_]
272		-
273		- set w $workspace
274		- if {$project ne ""} { append w /$project }
275		-
276		- file delete $workspace
277		- file mkdir $w
278		-
279		- write 0 cvs "Workspace: $workspace"
280		- return $w
281		-}
282		-
283		-# Building the revision tree from the changesets.
284		-# Limitation: Currently only trunk csets is handled.
285		-# Limitation: Dead files are not removed, i.e. no 'R' actions right now.
286		-
287		-proc ::vc::cvs::ws::ProcessBranches {} {
288		- variable importable
289		-
290		- write 0 cvs "Organizing the changesets into branches"
291		-
292		- set remainder [ProcessTrunk]
293		- while {[llength $remainder]} {
294		- set remainder [ProcessBranch $remainder]
295		- # return -code break may be signaled to give up with non-empty
296		- # set of unprocessed changesets.
297		- }
298		-
299		- # Status information ...
300		- set nr [llength $remainder]
301		- set ni [llength $importable]
302		- set fmt %[string length [csets::num]]s
303		-
304		- write 0 cvs "Unprocessed: [format $fmt $nr] [SIPL $nr changeset] (Will be ignored)"
305		- write 0 cvs "To import: [format $fmt $ni] [SIPL $ni changeset]"
306		- return
307		-}
308		-
309		-proc ::vc::cvs::ws::ProcessTrunk {} {
310		- variable importable
311		-
312		- write 0 cvs "Processing the trunk changesets"
313		-
314		- set remainder {}
315		- set t 0
316		- set n [csets::num]
317		- set parent {}
318		-
319		- for {set c 0} {$c < $n} {incr c} {
320		- if {[csets::isTrunk $c]} {
321		- csets::setParentOf $c $parent
322		- set parent $c
323		- incr t
324		- lappend importable $c
325		- } else {
326		- lappend remainder $c
327		- }
328		- }
329		-
330		- write 0 cvs "Found [NSIPL $t {trunk changeset}], [NSIPL [llength $remainder] {branch changeset}]"
331		- return $remainder
332		-}
333		-
334		-proc ::vc::cvs::ws::ProcessBranch {cslist} {
335		- write 0 cvs "Processing the remaining [SIPL [llength $cslist] changeset "[llength $cslist] changesets"]"
336		-
337		- set base [lindex $cslist 0]
338		- set cslist [lrange $cslist 1 end]
339		-
340		- csets::DUMP $base
341		-
342		- # Which branch does base belong to?
343		- # - It has to be the base of an unprocessed branch!
344		- # Otherwise it would have been on either the trunk
345		- # or an already processed branch.
346		- # Where is its root changeset ?
347		- # - The root has to come before the base, it has already
348		- # been processed => Smaller id, older in time.
349		- # - Based on the files changed/removed by the base, and their
350		- # versions we know the root versions of these files, and we
351		- # can determine the changesets they are in => Intersection
352		- # plus cap from previous contraint gives us the possible
353		- # candidates.
354		-
355		- write 4 cvs "Branch base $base"
356		-
357		- ::foreach {tag rootsig} [branch::find [csets::get $base]] break
358		-
359		- write 4 cvs "Branch tag $tag"
360		- write 5 cvs "Root sig $rootsig"
361		-
362		- set root [sig::find $base $rootsig]
363		-
364		- write 4 cvs "Branch root $root"
365		-
366		- write 0 cvs "Changeset $base, starting branch \"$tag\", rooted at $root"
367		- csets::setParentOf $base $root
368		-
369		- set remainder {}
370		- set t 1
371		-
372		- ::foreach c $cslist {
373		- #csets::DUMP $c
374		- if {[csets::sameBranch $c $base $tag]} {
375		- csets::setParentOf $c $base
376		- set base $c
377		- incr t
378		- lappend importable $c
379		- } else {
380		- lappend remainder $c
381		- }
382		- }
383		-
384		- write 0 cvs "Found [NSIPL $t "$tag changeset"], [NSIPL [llength $remainder] changeset] outside"
385		- return $remainder
386		-}
387		-
388		-proc ::vc::cvs::ws::Checkout {f r} {
389		- variable base
390		- variable project
391		-
392		- # Added or modified, put the requested version of the file into
393		- # the workspace.
394		-
395		- if {$project ne ""} {set f $project/$f}
396		- if {[catch {
397		- dova -d $base co -r $r $f
398		- } msg]} {
399		- if {[string match {invalid change text} $msg]} {
400		-
401		- # The archive of the file is corrupted and the chosen
402		- # version not accessible due to that. We report the
403		- # problem, but otherwise ignore it. As a consequence the
404		- # destination repository will not contain the full history
405		- # of the named file. By ignoring the problem we however
406		- # get as much as is possible.
407		-
408		- trouble::add "$f: Corrupted archive file. Inaccessible revision $r."
409		- return
410		- }
411		- return -code error $msg
412		- }
413		- return
414		-}
415		-
416		-proc ::vc::cvs::ws::Remove {f r} {
417		- # Remove file from workspace. Prune empty directories.
418		- # NOTE: A dead-first file (rev 1.1 dead) will never have existed.
419		-
420		- file delete $f
421		- Prune [file dirname $f]
422		- return
423		-}
424		-
425		-proc ::vc::cvs::ws::Prune {path} {
426		- # NOTE: Logically empty directories still physically contain the
427		- # CVS admin directory, hence the check for == 1, not == 0. There
428		- # might also be hidden files, we count them as well. Always hidden
429		- # are . and .. and they do not count as user file.
430		-
431		- if {
432		- ([llength [glob -nocomplain -directory $path *]] == 1) &&
433		- ([llength [glob -nocomplain -directory -type hidden $path *]] == 2)
434		- } {
435		- file delete -force $path
436		- }
437		- return
438		-}
439		-
440		-proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
441		- return "$n [SIPL $n $singular $plural]"
442		-}
443		-proc ::vc::cvs::ws::SIPL {n singular {plural {}}} {
444		- if {$n == 1} {return $singular}
445		- if {$plural eq ""} {set plural ${singular}s}
446		- return $plural
447		-}
448		-
449		-# -----------------------------------------------------------------------------
450		-
451		-namespace eval ::vc::cvs::ws {
452		- variable base {} ; # Toplevel repository directory
453		- variable project {} ; # Sub directory to limit the import to.
454		- variable workspace {} ; # Directory to checkout changesets to.
455		- variable importable {} ; # List of the csets which can be imported.
456		-
457		- namespace export configure begin done foreach ncsets nimportable checkout
458		- namespace export parentOf
459		-}
460		-
461		-# -----------------------------------------------------------------------------
462		-# Ready
463		-
464		-package provide vc::cvs::ws 1.0
465		-return

	--- a/tools/lib/cvs.tcl
	+++ b/tools/lib/cvs.tcl
	@@ -1,465 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Repository management (CVS)
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require fileutil ; # Tcllib (traverse directory hierarchy)
9	package require vc::rcs::parser ; # Handling the RCS archive files.
10	package require vc::tools::log ; # User feedback
11	package require vc::tools::trouble ; # Error handling
12	package require vc::cvs::cmd ; # Access to cvs application.
13	package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
14	package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
15	package require vc::cvs::ws::csets ; # Manage the changesets found in the timeline
16	package require vc::cvs::ws::branch ; # Branch database
17	package require vc::cvs::ws::sig ; # Changeset file/rev signatures
18
19	namespace eval ::vc::cvs::ws {
20	vc::tools::log::system cvs
21	namespace import ::vc::tools::log::write
22	namespace import ::vc::rcs::parser::process
23	namespace import ::vc::cvs::cmd::dova
24
25	namespace eval trouble { namespace import ::vc::tools::trouble::* }
26	}
27
28	# -----------------------------------------------------------------------------
29	# API
30
31	# vc::cvs::ws::configure key value - Configure the subsystem.
32	# vc::cvs::ws::check src mv - Check if src is a CVS repository directory.
33	# vc::cvs::ws::begin src - Start new workspace and return the top-
34	# most directory co'd files are put into.
35	# vc::cvs::ws::ncsets - Retrieve total number of csets
36	# vc::cvs::ws::nimportable - Retrieve number of importable csets
37	# vc::cvs::ws::foreach csvar script - Run the script for each changeset, the
38	# id of the current changeset stored in
39	# the variable named by csvar.
40	# vc::cvs::ws::done - Close workspace and delete it.
41	# vc::cvs::ws::isadmin path - Check if path is an admin file of CVS
42	# vc::cvs::ws::checkout id - Have workspace contain the changeset id.
43	# vc::cvs::ws::get id - Retrieve data of a changeset.
44	#
45	# Configuration keys:
46	#
47	# -project path - Sub directory under 'src' to limit the import to.
48
49	# -----------------------------------------------------------------------------
50	# API Implementation
51
52	proc ::vc::cvs::ws::configure {key value} {
53	variable project
54
55	switch -exact -- $key {
56	-project { set project $value }
57	default {
58	return -code error "Unknown switch $key, expected \
59	-project"
60	}
61	}
62	return
63	}
64
65	proc ::vc::cvs::ws::check {src mv} {
66	variable project
67	upvar 1 $mv msg
68	if {
69	![fileutil::test $src erd msg "CVS Repository"] \|\|
70	![fileutil::test $src/CVSROOT erd msg "CVS Admin directory"] \|\|
71	(($project ne "") &&
72	![fileutil::test $src/$project erd msg "Project directory"])
73	} {
74	return 0
75	}
76	return 1
77	}
78
79	proc ::vc::cvs::ws::begin {src} {
80	if {![check $src msg]} { return -code error $msg }
81
82	DefBase $src
83	MakeTimeline [ScanArchives [files::find [RootPath]]]
84	MakeChangesets
85	ProcessBranches
86
87	return [MakeWorkspace]
88	}
89
90	proc ::vc::cvs::ws::done {} {
91	variable workspace
92	file delete -force $workspace
93	return
94	}
95
96	proc ::vc::cvs::ws::foreach {cv script} {
97	variable importable
98	upvar 1 $cv c
99
100	::foreach c [lsort -integer -increasing $importable] {
101	set code [catch {uplevel 1 $script} res]
102
103	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
104	switch -- $code {
105	0 {}
106	1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
107	2 {}
108	3 { return }
109	4 {}
110	default { return -code $code $result }
111	}
112	}
113	return
114	}
115
116	proc ::vc::cvs::ws::ncsets {args} {
117	return [csets::num]
118	}
119
120	proc ::vc::cvs::ws::nimportable {args} {
121	variable importable
122	return [llength $importable]
123	}
124
125	proc ::vc::cvs::ws::isadmin {path} {
126	# Check if path is a CVS admin file.
127	if {[string match CVS/* $path]} {return 1}
128	if {[string match /CVS/ $path]} {return 1}
129	return 0
130	}
131
132	proc ::vc::cvs::ws::parentOf {id} { csets::parentOf $id }
133
134	proc ::vc::cvs::ws::checkout {id} {
135	variable workspace
136	cd $workspace
137
138	# TODO: Hide the direct access to the data structures behind
139	# TODO: accessors for date, cmsg, removed, added, changed, and
140	# TODO: author
141	array set cs [csets::get $id]
142
143	write 1 cvs "@ $cs(date)"
144	::foreach l [split [string trim $cs(cmsg)] \n] {
145	write 1 cvs "\| $l"
146	}
147
148	::foreach {f r} $cs(removed) { write 2 cvs "R $f $r" ; Remove $f $r }
149	::foreach {f r} $cs(added) { write 2 cvs "A $f $r" ; Checkout $f $r }
150	::foreach {f r} $cs(changed) { write 2 cvs "M $f $r" ; Checkout $f $r }
151
152	# Provide metadata about the changeset the backend may wish to have
153	return [list $cs(author) $cs(date) $cs(cmsg)]
154	}
155
156	# -----------------------------------------------------------------------------
157	# Internals
158
159	proc ::vc::cvs::ws::DefBase {path} {
160	variable project
161	variable base
162
163	set base $path
164
165	write 0 cvs "Base: $base"
166	if {$project eq ""} {
167	write 0 cvs "Project: <ALL>"
168	} else {
169	write 0 cvs "Project: $project"
170	}
171	return
172	}
173
174	proc ::vc::cvs::ws::RootPath {} {
175	variable project
176	variable base
177
178	if {$project eq ""} {
179	return $base
180	} else {
181	return $base/$project
182	}
183	}
184
185	proc ::vc::cvs::ws::ScanArchives {files} {
186	write 0 cvs "Scanning archives ..."
187
188	set d [RootPath]
189	set r {}
190	set n 0
191
192	::foreach {rcs f} $files {
193	write 1 cvs "Archive $rcs"
194	# Get the meta data we need (revisions, timeline, messages).
195	lappend r $f [process $d/$rcs]
196	incr n
197	}
198
199	write 0 cvs "Processed [NSIPL $n file]"
200	return $r
201	}
202
203	proc ::vc::cvs::ws::MakeTimeline {meta} {
204	write 0 cvs "Generating coalesced timeline ..."
205
206	set n 0
207	::foreach {f meta} $meta {
208	array set md $meta
209	array set date $md(date)
210	array set auth $md(author)
211	array set cmsg $md(commit)
212	array set stat $md(state)
213
214	::foreach rev [lsort -dict [array names date]] {
215	set operation [Operation $rev $stat($rev)]
216	NoteDeadRoots $f $rev $operation
217	timeline::add $date($rev) $f $rev $operation $auth($rev) $cmsg($rev)
218	incr n
219	}
220
221	if {[info exists md(symbol)]} {
222	branch::def $f date $md(symbol)
223	}
224
225	unset md
226	unset date
227	unset auth
228	unset cmsg
229	unset stat
230	}
231
232	write 0 cvs "Timeline has [NSIPL $n entry entries]"
233	return
234	}
235
236	proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
237	# A dead-first revision is rev 1.1 with op R. For an example see
238	# the file memchan/DEPENDENCIES. Such a file seems to exist only!
239	# on its branch. The branches information is set on the revision
240	# (extend rcsparser!), symbols has a tag, refering to a branch,
241	# possibly magic.
242
243	if {($rev eq "1.1") && ($operation eq "R")} {
244	write 2 cvs "Dead root revision: $f"
245	}
246	return
247	}
248
249	proc ::vc::cvs::ws::Operation {rev state} {
250	if {$state eq "dead"} {return "R"} ; # Removed
251	if {$rev eq "1.1"} {return "A"} ; # Added
252	if {[string match *.1.1 $rev]} {return "A"} ; # Added on a branch
253	return "M" ; # Modified
254	}
255
256	proc ::vc::cvs::ws::MakeChangesets {} {
257	write 0 cvs "Generating changesets from timeline"
258
259	csets::init
260	timeline::foreach date file revision operation author cmsg {
261	csets::add $date $file $revision $operation $author $cmsg
262	}
263	csets::done
264
265	write 0 cvs "Found [NSIPL [csets::num] changeset]"
266	return
267	}
268
269	proc ::vc::cvs::ws::MakeWorkspace {} {
270	variable project
271	variable workspace [fileutil::tempfile importF_cvs_ws_]
272
273	set w $workspace
274	if {$project ne ""} { append w /$project }
275
276	file delete $workspace
277	file mkdir $w
278
279	write 0 cvs "Workspace: $workspace"
280	return $w
281	}
282
283	# Building the revision tree from the changesets.
284	# Limitation: Currently only trunk csets is handled.
285	# Limitation: Dead files are not removed, i.e. no 'R' actions right now.
286
287	proc ::vc::cvs::ws::ProcessBranches {} {
288	variable importable
289
290	write 0 cvs "Organizing the changesets into branches"
291
292	set remainder [ProcessTrunk]
293	while {[llength $remainder]} {
294	set remainder [ProcessBranch $remainder]
295	# return -code break may be signaled to give up with non-empty
296	# set of unprocessed changesets.
297	}
298
299	# Status information ...
300	set nr [llength $remainder]
301	set ni [llength $importable]
302	set fmt %[string length [csets::num]]s
303
304	write 0 cvs "Unprocessed: [format $fmt $nr] [SIPL $nr changeset] (Will be ignored)"
305	write 0 cvs "To import: [format $fmt $ni] [SIPL $ni changeset]"
306	return
307	}
308
309	proc ::vc::cvs::ws::ProcessTrunk {} {
310	variable importable
311
312	write 0 cvs "Processing the trunk changesets"
313
314	set remainder {}
315	set t 0
316	set n [csets::num]
317	set parent {}
318
319	for {set c 0} {$c < $n} {incr c} {
320	if {[csets::isTrunk $c]} {
321	csets::setParentOf $c $parent
322	set parent $c
323	incr t
324	lappend importable $c
325	} else {
326	lappend remainder $c
327	}
328	}
329
330	write 0 cvs "Found [NSIPL $t {trunk changeset}], [NSIPL [llength $remainder] {branch changeset}]"
331	return $remainder
332	}
333
334	proc ::vc::cvs::ws::ProcessBranch {cslist} {
335	write 0 cvs "Processing the remaining [SIPL [llength $cslist] changeset "[llength $cslist] changesets"]"
336
337	set base [lindex $cslist 0]
338	set cslist [lrange $cslist 1 end]
339
340	csets::DUMP $base
341
342	# Which branch does base belong to?
343	# - It has to be the base of an unprocessed branch!
344	# Otherwise it would have been on either the trunk
345	# or an already processed branch.
346	# Where is its root changeset ?
347	# - The root has to come before the base, it has already
348	# been processed => Smaller id, older in time.
349	# - Based on the files changed/removed by the base, and their
350	# versions we know the root versions of these files, and we
351	# can determine the changesets they are in => Intersection
352	# plus cap from previous contraint gives us the possible
353	# candidates.
354
355	write 4 cvs "Branch base $base"
356
357	::foreach {tag rootsig} [branch::find [csets::get $base]] break
358
359	write 4 cvs "Branch tag $tag"
360	write 5 cvs "Root sig $rootsig"
361
362	set root [sig::find $base $rootsig]
363
364	write 4 cvs "Branch root $root"
365
366	write 0 cvs "Changeset $base, starting branch \"$tag\", rooted at $root"
367	csets::setParentOf $base $root
368
369	set remainder {}
370	set t 1
371
372	::foreach c $cslist {
373	#csets::DUMP $c
374	if {[csets::sameBranch $c $base $tag]} {
375	csets::setParentOf $c $base
376	set base $c
377	incr t
378	lappend importable $c
379	} else {
380	lappend remainder $c
381	}
382	}
383
384	write 0 cvs "Found [NSIPL $t "$tag changeset"], [NSIPL [llength $remainder] changeset] outside"
385	return $remainder
386	}
387
388	proc ::vc::cvs::ws::Checkout {f r} {
389	variable base
390	variable project
391
392	# Added or modified, put the requested version of the file into
393	# the workspace.
394
395	if {$project ne ""} {set f $project/$f}
396	if {[catch {
397	dova -d $base co -r $r $f
398	} msg]} {
399	if {[string match {invalid change text} $msg]} {
400
401	# The archive of the file is corrupted and the chosen
402	# version not accessible due to that. We report the
403	# problem, but otherwise ignore it. As a consequence the
404	# destination repository will not contain the full history
405	# of the named file. By ignoring the problem we however
406	# get as much as is possible.
407
408	trouble::add "$f: Corrupted archive file. Inaccessible revision $r."
409	return
410	}
411	return -code error $msg
412	}
413	return
414	}
415
416	proc ::vc::cvs::ws::Remove {f r} {
417	# Remove file from workspace. Prune empty directories.
418	# NOTE: A dead-first file (rev 1.1 dead) will never have existed.
419
420	file delete $f
421	Prune [file dirname $f]
422	return
423	}
424
425	proc ::vc::cvs::ws::Prune {path} {
426	# NOTE: Logically empty directories still physically contain the
427	# CVS admin directory, hence the check for == 1, not == 0. There
428	# might also be hidden files, we count them as well. Always hidden
429	# are . and .. and they do not count as user file.
430
431	if {
432	([llength [glob -nocomplain -directory $path *]] == 1) &&
433	([llength [glob -nocomplain -directory -type hidden $path *]] == 2)
434	} {
435	file delete -force $path
436	}
437	return
438	}
439
440	proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
441	return "$n [SIPL $n $singular $plural]"
442	}
443	proc ::vc::cvs::ws::SIPL {n singular {plural {}}} {
444	if {$n == 1} {return $singular}
445	if {$plural eq ""} {set plural ${singular}s}
446	return $plural
447	}
448
449	# -----------------------------------------------------------------------------
450
451	namespace eval ::vc::cvs::ws {
452	variable base {} ; # Toplevel repository directory
453	variable project {} ; # Sub directory to limit the import to.
454	variable workspace {} ; # Directory to checkout changesets to.
455	variable importable {} ; # List of the csets which can be imported.
456
457	namespace export configure begin done foreach ncsets nimportable checkout
458	namespace export parentOf
459	}
460
461	# -----------------------------------------------------------------------------
462	# Ready
463
464	package provide vc::cvs::ws 1.0
465	return

	--- a/tools/lib/cvs.tcl
	+++ b/tools/lib/cvs.tcl
	@@ -1,465 +0,0 @@

D tools/lib/cvs_branch.tcl

-323

		--- a/tools/lib/cvs_branch.tcl
		+++ b/tools/lib/cvs_branch.tcl
		@@ -1,323 +0,0 @@
1		-
2		-
3		-namespace eval ::vc::cvs::ws::branch {}
4		-
5		-# Trivial storage of all branch data as a rectangular table. We can
6		-# think up a better suited storage system later, when we know what
7		-# type of queries are made to this module.
8		-
9		-proc ::vc::cvs::ws::branch::def {f dv deflist} {
10		- upvar 1 $dv date
11		- variable bra
12		- foreach {tag rev} $deflist {
13		- # ignore non-branch tags
14		- if {[llength [split $rev .]] < 4} continue
15		-
16		- if 0 {
17		- if { ($rev ne "1.1.1.1") && ![string match *.0.2 $rev] } {
18		- # 1.1.1.1 is the base of vendor branches, usually. *.0.y
19		- # is the base of regular branches where nothing is on the
20		- # branch yet, only its root is marked. Everything else is
21		- # noteworthy for now.
22		- puts $f/$rev/$tag
23		- }
24		- }
25		-
26		- set root [revroot $rev]
27		- lappend bra [list $date($root) $tag $f $rev]
28		- }
29		-}
30		-
31		-proc ::vc::cvs::ws::branch::revroot {rev} {
32		- return [join [lrange [split $rev .] 0 end-2] .]
33		-}
34		-
35		-
36		- # ! Files in a branch can appear only after their root revision
37		- # exists. This can be checked against the time of the cset which
38		- # is our base. Branches which have no files yet can be eliminated
39		- # from consideration.
40		-
41		- # ! All files noted by the base cset as added/modified have to be
42		- # in the branch root. Branches which do not have such a file can
43		- # be eliminated from consideration.
44		-
45		- # ! The versions of the added/modified files in the base have
46		- # match the versions in the branch root. In the sense that they
47		- # have to be equal or sucessors. The later implies identity in the
48		- # upper parts (only the last 2 parts are relevant), and equal
49		- # length.
50		-
51		- # This gives us the branch, and, due to the time information a
52		- # signature for the root.
53		-
54		- #? Can search for the root based on this signature fail ?
55		- # Yes. Because the signature may contain files which were not
56		- # actually yet in the root, despite being able to. And which were
57		- # not modified by the base, so the check 2 above still passes.
58		-
59		- # -> Search for the full signature first, then drop the youngest
60		- # files, search again until match. Check the result against the
61		- # base, that all needed files are present.
62		-
63		- # However - Can search for the root based on the cset data (needed
64		- # files). Gives us another set of candidate roots. Intersect!
65		-
66		-
67		-proc ::vc::cvs::ws::branch::find {csvalue} {
68		- array set cs $csvalue
69		-
70		- #variable bra
71		- #puts ___________________________________________
72		- #puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]
73		-
74		- Signatures bd [TimeRelevant $cs(date)]
75		- DropIncomplete bd [concat $cs(added) $cs(changed)]
76		-
77		- #puts ___________________________________________
78		- #parray bd
79		-
80		- if {[array size bd] < 1} {
81		- puts "NO BRANCH"
82		- # Deal how?
83		- # - Abort
84		- # - Ignore this changeset and try the next one
85		- # (Which has higher probability of not matching as it might
86		- # be the successor in the branch to this cset and not a base).
87		- puts ""
88		- parray cs
89		- exit
90		- } elseif {[array size bd] > 1} {
91		-
92		- # While we might have found several tag they may all refer to
93		- # the same set of files. If that is so we consider them
94		- # identical and take one as representative of all.
95		-
96		- set su {}
97		- foreach {t s} [array get bd] {
98		- lappend su [DictSort $s]
99		- }
100		- if {[llength [lsort -unique $su]] > 1} {
101		- puts "AMBIGOUS. The following branches match:"
102		- # Deal how? S.a.
103		- puts \t[join [array names bd] \n\t]
104		- puts ""
105		- parray cs
106		- exit
107		- }
108		- # Fall through ...
109		- }
110		-
111		- set tg [lindex [array names bd] 0]
112		- set rs [RootOf $bd($tg)]
113		-
114		- #puts "BRANCH = $tg"
115		- #puts "ROOTSG = $rs"
116		-
117		- return [list $tg $rs]
118		-}
119		-
120		-
121		-proc ::vc::cvs::ws::branch::has {ts needed} {
122		- #variable bra
123		- #puts ___________________________________________
124		- #puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]
125		-
126		- Signatures bd [TimeRelevant $ts]
127		- DropIncomplete bd $needed
128		-
129		- #puts ___________________________________________
130		- #parray bd
131		-
132		- if {[array size bd] < 1} {
133		- puts "NO BRANCH"
134		- # Deal how?
135		- # - Abort
136		- # - Ignore this changeset and try the next one
137		- # (Which has higher probability of not matching as it might
138		- # be the successor in the branch to this cset and not a base).
139		- exit
140		- } elseif {[array size bd] > 1} {
141		- puts "AMBIGOUS. Following branches match:"
142		- # Deal how? S.a.
143		- puts \t[join [array names bd] \n\t]
144		- exit
145		- }
146		-
147		- set tg [lindex [array names bd] 0]
148		-
149		- #puts "BRANCH = $tg"
150		-
151		- return $tg
152		-}
153		-
154		-
155		-
156		-proc ::vc::cvs::ws::branch::RootOf {dict} {
157		- set res {}
158		- foreach {f r} $dict {
159		- lappend res $f [revroot $r]
160		- }
161		- return $res
162		-}
163		-
164		-proc ::vc::cvs::ws::branch::DictSort {dict} {
165		- array set a $dict
166		- set r {}
167		- foreach k [lsort [array names a]] {
168		- lappend r $k $a($k)
169		- }
170		- return $r
171		-}
172		-
173		-proc ::vc::cvs::ws::branch::DropIncomplete {bv needed} {
174		- upvar 1 $bv bdata
175		-
176		- # Check the needed files against the branch signature. If files
177		- # are missing or not of a matching version drop the branch from
178		- # further consideration.
179		-
180		- foreach {tag sig} [array get bdata] {
181		- array set rev $sig
182		- foreach {file rv} $needed {
183		- if {![info exists rev($file)] \|\| ![successor $rv $rev($file)]} {
184		- # file in cset is not in the branch or is present, but
185		- # not proper version (different lengths, not matching
186		- # in upper 0..end-2 parts, not equal\|successor).
187		- unset bdata($tag)
188		- break
189		- }
190		- continue
191		- }
192		- unset rev
193		- }
194		- return
195		-}
196		-
197		-proc ::vc::cvs::ws::branch::successor {ra rb} {
198		- # a successor-of b ?
199		-
200		- set la [split $ra .]
201		- set lb [split $rb .]
202		- if {
203		- ([llength $la] != [llength $lb]) \|\|
204		- ([lrange $la 0 end-2] ne [lrange $lb 0 end-2]) \|\|
205		- ([package vcompare $ra $rb] < 0)
206		- } {
207		- return 0
208		- } else {
209		- return 1
210		- }
211		-}
212		-
213		-proc ::vc::cvs::ws::branch::rootSuccessor {ra rb} {
214		- # a root-successor-of b ? (<=> b root version of a ?)
215		-
216		- if {$rb eq [revroot $ra]} {
217		- return 1
218		- } else {
219		- return 0
220		- }
221		-}
222		-
223		-proc ::vc::cvs::ws::branch::Signatures {bv deflist} {
224		- upvar 1 $bv bdata
225		- # Sort branch data by symbolic name for the upcoming checks, and
226		- # generate file revision signatures.
227		-
228		- array set bdata {}
229		- foreach item $deflist {
230		- # item = timestamp tag file revision
231		- foreach {__ tag file rev} $item break
232		- lappend bdata($tag) $file $rev
233		- }
234		-
235		- #puts ___________________________________________
236		- #parray bdata
237		-
238		- return
239		-}
240		-
241		-proc ::vc::cvs::ws::branch::TimeRelevant {date} {
242		- variable bra
243		-
244		- # Retrieve the branch data which definitely comes before (in time)
245		- # the candidate cset. Only this set is relevant to further checks
246		- # and filters.
247		-
248		- set res {}
249		- foreach item $bra {
250		- # item = timestamp tag file revision
251		- # 0 1 2 3
252		- if {[package vcompare [lindex $item 0] $date] > 0} continue
253		- lappend res $item
254		- }
255		-
256		- #puts ___________________________________________
257		- #puts [join [lsort -index 0 [lsort -index 1 $res]] \n]
258		- return $res
259		-}
260		-
261		-
262		-namespace eval ::vc::cvs::ws::branch {
263		- variable bra {}
264		-
265		- namespace export def find successor rootSuccessor revroot has
266		-}
267		-
268		-package provide vc::cvs::ws::branch 1.0
269		-return
270		-
271		-
272		-
273		-
274		- # Queries ...
275		- # - Get set of files and revs for branch B which can be in it by the time T
276		- # - Check if a file referenced a/m instruction is in a set of files
277		- # and revision, identical or proper sucessor.
278		- # => Combination
279		- # Can branch B match the cset file a/m at time T ?
280		- # => Full combination
281		- # Give me the list of branches which can match the cset file a/m
282		- # at time T.
283		-
284		- # Branch DB organization => (Tag -> (Time -> (File -> Rev)))
285		- # The full combination actually does not need a complex structure.
286		- # We can simply scan a plain list of branch data.
287		- # The only alternative is an inverted index.
288		- # Time -> ((File -> Rev) -> Tag). Difficult to process.
289		- # Linear scan:
290		- # - Time after T => drop
291		- # - File !in a/m => drop
292		- # - Version !match => drop
293		- # -- Collect tag
294		- # Then lsort -unique for our result.
295		- # NO - The file check is inverted - All files have to be in a/m for the base, not a/m in files
296		- # == - This also breaks the issue for same-branch detection -
297		- # future csets in the branch do not have that property.
298		-
299		- puts ___________________________________________
300		- # Show only branch data which definitely comes before the
301		- # candidate cset
302		-
303		- array set n [concat $cs(added) $cs(changed)]
304		- set xx {}
305		- set bb {}
306		- ::foreach x $bra {
307		- ::foreach {ts tag f r} $x break
308		- if {[package vcompare $ts $cs(date)] > 0} continue
309		- if {![info exists n($f)]} continue
310		- if {
311		- ([llength [split $n($f) .]] != [llength [split $r .]]) \|\|
312		- ([lrange [split $n($f) .] 0 end-2] ne [lrange [split $r .] 0 end-2]) \|\|
313		- ([package vcompare $n($f) $r] < 0)
314		- } continue
315		- lappend xx $x
316		- lappend bb $tag
317		- }
318		- puts [join [lsort -index 0 [lsort -index 1 $xx]] \n]
319		- puts [join [lsort -unique $bb] \n]
320		-
321		-exit
322		-
323		-

	--- a/tools/lib/cvs_branch.tcl
	+++ b/tools/lib/cvs_branch.tcl
	@@ -1,323 +0,0 @@
1
2
3	namespace eval ::vc::cvs::ws::branch {}
4
5	# Trivial storage of all branch data as a rectangular table. We can
6	# think up a better suited storage system later, when we know what
7	# type of queries are made to this module.
8
9	proc ::vc::cvs::ws::branch::def {f dv deflist} {
10	upvar 1 $dv date
11	variable bra
12	foreach {tag rev} $deflist {
13	# ignore non-branch tags
14	if {[llength [split $rev .]] < 4} continue
15
16	if 0 {
17	if { ($rev ne "1.1.1.1") && ![string match *.0.2 $rev] } {
18	# 1.1.1.1 is the base of vendor branches, usually. *.0.y
19	# is the base of regular branches where nothing is on the
20	# branch yet, only its root is marked. Everything else is
21	# noteworthy for now.
22	puts $f/$rev/$tag
23	}
24	}
25
26	set root [revroot $rev]
27	lappend bra [list $date($root) $tag $f $rev]
28	}
29	}
30
31	proc ::vc::cvs::ws::branch::revroot {rev} {
32	return [join [lrange [split $rev .] 0 end-2] .]
33	}
34
35
36	# ! Files in a branch can appear only after their root revision
37	# exists. This can be checked against the time of the cset which
38	# is our base. Branches which have no files yet can be eliminated
39	# from consideration.
40
41	# ! All files noted by the base cset as added/modified have to be
42	# in the branch root. Branches which do not have such a file can
43	# be eliminated from consideration.
44
45	# ! The versions of the added/modified files in the base have
46	# match the versions in the branch root. In the sense that they
47	# have to be equal or sucessors. The later implies identity in the
48	# upper parts (only the last 2 parts are relevant), and equal
49	# length.
50
51	# This gives us the branch, and, due to the time information a
52	# signature for the root.
53
54	#? Can search for the root based on this signature fail ?
55	# Yes. Because the signature may contain files which were not
56	# actually yet in the root, despite being able to. And which were
57	# not modified by the base, so the check 2 above still passes.
58
59	# -> Search for the full signature first, then drop the youngest
60	# files, search again until match. Check the result against the
61	# base, that all needed files are present.
62
63	# However - Can search for the root based on the cset data (needed
64	# files). Gives us another set of candidate roots. Intersect!
65
66
67	proc ::vc::cvs::ws::branch::find {csvalue} {
68	array set cs $csvalue
69
70	#variable bra
71	#puts ___________________________________________
72	#puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]
73
74	Signatures bd [TimeRelevant $cs(date)]
75	DropIncomplete bd [concat $cs(added) $cs(changed)]
76
77	#puts ___________________________________________
78	#parray bd
79
80	if {[array size bd] < 1} {
81	puts "NO BRANCH"
82	# Deal how?
83	# - Abort
84	# - Ignore this changeset and try the next one
85	# (Which has higher probability of not matching as it might
86	# be the successor in the branch to this cset and not a base).
87	puts ""
88	parray cs
89	exit
90	} elseif {[array size bd] > 1} {
91
92	# While we might have found several tag they may all refer to
93	# the same set of files. If that is so we consider them
94	# identical and take one as representative of all.
95
96	set su {}
97	foreach {t s} [array get bd] {
98	lappend su [DictSort $s]
99	}
100	if {[llength [lsort -unique $su]] > 1} {
101	puts "AMBIGOUS. The following branches match:"
102	# Deal how? S.a.
103	puts \t[join [array names bd] \n\t]
104	puts ""
105	parray cs
106	exit
107	}
108	# Fall through ...
109	}
110
111	set tg [lindex [array names bd] 0]
112	set rs [RootOf $bd($tg)]
113
114	#puts "BRANCH = $tg"
115	#puts "ROOTSG = $rs"
116
117	return [list $tg $rs]
118	}
119
120
121	proc ::vc::cvs::ws::branch::has {ts needed} {
122	#variable bra
123	#puts ___________________________________________
124	#puts [join [lsort -index 0 [lsort -index 1 $bra]] \n]
125
126	Signatures bd [TimeRelevant $ts]
127	DropIncomplete bd $needed
128
129	#puts ___________________________________________
130	#parray bd
131
132	if {[array size bd] < 1} {
133	puts "NO BRANCH"
134	# Deal how?
135	# - Abort
136	# - Ignore this changeset and try the next one
137	# (Which has higher probability of not matching as it might
138	# be the successor in the branch to this cset and not a base).
139	exit
140	} elseif {[array size bd] > 1} {
141	puts "AMBIGOUS. Following branches match:"
142	# Deal how? S.a.
143	puts \t[join [array names bd] \n\t]
144	exit
145	}
146
147	set tg [lindex [array names bd] 0]
148
149	#puts "BRANCH = $tg"
150
151	return $tg
152	}
153
154
155
156	proc ::vc::cvs::ws::branch::RootOf {dict} {
157	set res {}
158	foreach {f r} $dict {
159	lappend res $f [revroot $r]
160	}
161	return $res
162	}
163
164	proc ::vc::cvs::ws::branch::DictSort {dict} {
165	array set a $dict
166	set r {}
167	foreach k [lsort [array names a]] {
168	lappend r $k $a($k)
169	}
170	return $r
171	}
172
173	proc ::vc::cvs::ws::branch::DropIncomplete {bv needed} {
174	upvar 1 $bv bdata
175
176	# Check the needed files against the branch signature. If files
177	# are missing or not of a matching version drop the branch from
178	# further consideration.
179
180	foreach {tag sig} [array get bdata] {
181	array set rev $sig
182	foreach {file rv} $needed {
183	if {![info exists rev($file)] \|\| ![successor $rv $rev($file)]} {
184	# file in cset is not in the branch or is present, but
185	# not proper version (different lengths, not matching
186	# in upper 0..end-2 parts, not equal\|successor).
187	unset bdata($tag)
188	break
189	}
190	continue
191	}
192	unset rev
193	}
194	return
195	}
196
197	proc ::vc::cvs::ws::branch::successor {ra rb} {
198	# a successor-of b ?
199
200	set la [split $ra .]
201	set lb [split $rb .]
202	if {
203	([llength $la] != [llength $lb]) \|\|
204	([lrange $la 0 end-2] ne [lrange $lb 0 end-2]) \|\|
205	([package vcompare $ra $rb] < 0)
206	} {
207	return 0
208	} else {
209	return 1
210	}
211	}
212
213	proc ::vc::cvs::ws::branch::rootSuccessor {ra rb} {
214	# a root-successor-of b ? (<=> b root version of a ?)
215
216	if {$rb eq [revroot $ra]} {
217	return 1
218	} else {
219	return 0
220	}
221	}
222
223	proc ::vc::cvs::ws::branch::Signatures {bv deflist} {
224	upvar 1 $bv bdata
225	# Sort branch data by symbolic name for the upcoming checks, and
226	# generate file revision signatures.
227
228	array set bdata {}
229	foreach item $deflist {
230	# item = timestamp tag file revision
231	foreach {__ tag file rev} $item break
232	lappend bdata($tag) $file $rev
233	}
234
235	#puts ___________________________________________
236	#parray bdata
237
238	return
239	}
240
241	proc ::vc::cvs::ws::branch::TimeRelevant {date} {
242	variable bra
243
244	# Retrieve the branch data which definitely comes before (in time)
245	# the candidate cset. Only this set is relevant to further checks
246	# and filters.
247
248	set res {}
249	foreach item $bra {
250	# item = timestamp tag file revision
251	# 0 1 2 3
252	if {[package vcompare [lindex $item 0] $date] > 0} continue
253	lappend res $item
254	}
255
256	#puts ___________________________________________
257	#puts [join [lsort -index 0 [lsort -index 1 $res]] \n]
258	return $res
259	}
260
261
262	namespace eval ::vc::cvs::ws::branch {
263	variable bra {}
264
265	namespace export def find successor rootSuccessor revroot has
266	}
267
268	package provide vc::cvs::ws::branch 1.0
269	return
270
271
272
273
274	# Queries ...
275	# - Get set of files and revs for branch B which can be in it by the time T
276	# - Check if a file referenced a/m instruction is in a set of files
277	# and revision, identical or proper sucessor.
278	# => Combination
279	# Can branch B match the cset file a/m at time T ?
280	# => Full combination
281	# Give me the list of branches which can match the cset file a/m
282	# at time T.
283
284	# Branch DB organization => (Tag -> (Time -> (File -> Rev)))
285	# The full combination actually does not need a complex structure.
286	# We can simply scan a plain list of branch data.
287	# The only alternative is an inverted index.
288	# Time -> ((File -> Rev) -> Tag). Difficult to process.
289	# Linear scan:
290	# - Time after T => drop
291	# - File !in a/m => drop
292	# - Version !match => drop
293	# -- Collect tag
294	# Then lsort -unique for our result.
295	# NO - The file check is inverted - All files have to be in a/m for the base, not a/m in files
296	# == - This also breaks the issue for same-branch detection -
297	# future csets in the branch do not have that property.
298
299	puts ___________________________________________
300	# Show only branch data which definitely comes before the
301	# candidate cset
302
303	array set n [concat $cs(added) $cs(changed)]
304	set xx {}
305	set bb {}
306	::foreach x $bra {
307	::foreach {ts tag f r} $x break
308	if {[package vcompare $ts $cs(date)] > 0} continue
309	if {![info exists n($f)]} continue
310	if {
311	([llength [split $n($f) .]] != [llength [split $r .]]) \|\|
312	([lrange [split $n($f) .] 0 end-2] ne [lrange [split $r .] 0 end-2]) \|\|
313	([package vcompare $n($f) $r] < 0)
314	} continue
315	lappend xx $x
316	lappend bb $tag
317	}
318	puts [join [lsort -index 0 [lsort -index 1 $xx]] \n]
319	puts [join [lsort -unique $bb] \n]
320
321	exit
322
323

	--- a/tools/lib/cvs_branch.tcl
	+++ b/tools/lib/cvs_branch.tcl
	@@ -1,323 +0,0 @@

D tools/lib/cvs_cmd.tcl

-49

		--- a/tools/lib/cvs_cmd.tcl
		+++ b/tools/lib/cvs_cmd.tcl
		@@ -1,49 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Access to the external cvs command.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-namespace eval ::vc::cvs::cmd {}
9		-
10		-# -----------------------------------------------------------------------------
11		-# API
12		-
13		-# vc::cvs::cmd::dova word... - Run a cvs command specified as var args.
14		-# vc::cvs::cmd::do words - Run a cvs command specified as a list.
15		-
16		-# -----------------------------------------------------------------------------
17		-# API Implementation
18		-
19		-proc ::vc::cvs::cmd::dova {args} {do $args}
20		-
21		-proc ::vc::cvs::cmd::do {words} {
22		- variable cmd
23		- if {![llength $words]} {
24		- return -code error "Empty cvs command"
25		- }
26		- # 8.5: exec $cmd {*}$words
27		- return [eval [linsert $words 0 exec $cmd]]
28		-}
29		-
30		-# -----------------------------------------------------------------------------
31		-# Internals.
32		-
33		-namespace eval ::vc::cvs::cmd {
34		- # Locate external cvs application.
35		- variable cmd [auto_execok cvs]
36		-
37		- # Bail out if not found.
38		- if {![llength $::vc::cvs::cmd::cmd]} {
39		- return -code error "Cvs application not found."
40		- }
41		-
42		- namespace export do dova
43		-}
44		-
45		-# -----------------------------------------------------------------------------
46		-# Ready
47		-
48		-package provide vc::cvs::cmd 1.0
49		-return

	--- a/tools/lib/cvs_cmd.tcl
	+++ b/tools/lib/cvs_cmd.tcl
	@@ -1,49 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Access to the external cvs command.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	namespace eval ::vc::cvs::cmd {}
9
10	# -----------------------------------------------------------------------------
11	# API
12
13	# vc::cvs::cmd::dova word... - Run a cvs command specified as var args.
14	# vc::cvs::cmd::do words - Run a cvs command specified as a list.
15
16	# -----------------------------------------------------------------------------
17	# API Implementation
18
19	proc ::vc::cvs::cmd::dova {args} {do $args}
20
21	proc ::vc::cvs::cmd::do {words} {
22	variable cmd
23	if {![llength $words]} {
24	return -code error "Empty cvs command"
25	}
26	# 8.5: exec $cmd {*}$words
27	return [eval [linsert $words 0 exec $cmd]]
28	}
29
30	# -----------------------------------------------------------------------------
31	# Internals.
32
33	namespace eval ::vc::cvs::cmd {
34	# Locate external cvs application.
35	variable cmd [auto_execok cvs]
36
37	# Bail out if not found.
38	if {![llength $::vc::cvs::cmd::cmd]} {
39	return -code error "Cvs application not found."
40	}
41
42	namespace export do dova
43	}
44
45	# -----------------------------------------------------------------------------
46	# Ready
47
48	package provide vc::cvs::cmd 1.0
49	return

	--- a/tools/lib/cvs_cmd.tcl
	+++ b/tools/lib/cvs_cmd.tcl
	@@ -1,49 +0,0 @@

D tools/lib/cvs_csets.tcl

-248

		--- a/tools/lib/cvs_csets.tcl
		+++ b/tools/lib/cvs_csets.tcl
		@@ -1,248 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Repository management (CVS), Changeset grouping and storage.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::cvs::ws::sig ; # Changeset file/rev signatures
9		-
10		-namespace eval ::vc::cvs::ws::csets::Current {}
11		-namespace eval ::vc::cvs::ws::csets::sig {
12		- namespace import ::vc::cvs::ws::sig::*
13		-}
14		-
15		-# -----------------------------------------------------------------------------
16		-# API
17		-
18		-# vc::cvs::ws::csets::init - Initialize accumulator
19		-# vc::cvs::ws::csets::add - Add timeline entry to accumulor, may generate new cset
20		-# vc::cvs::ws::csets::done - Complete cset generation.
21		-#
22		-# vc::cvs::ws::csets::get id - Get data of a cset.
23		-# vc::cvs::ws::csets::num - Get number of csets.
24		-
25		-# -----------------------------------------------------------------------------
26		-# API Implementation
27		-
28		-proc ::vc::cvs::ws::csets::init {} {
29		- variable ncs 0
30		- Current::Clear
31		- return
32		-}
33		-
34		-proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
35		- if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
36		- Save [Current::Complete]
37		- }
38		- Current::Add $date $file $revision $operation $author $cmsg
39		- return
40		-}
41		-
42		-proc ::vc::cvs::ws::csets::done {} {
43		- if {![Current::Empty]} {
44		- Save [Current::Complete]
45		- }
46		- return
47		-}
48		-
49		-proc ::vc::cvs::ws::csets::get {id} {
50		- variable csets
51		- return $csets($id)
52		-}
53		-
54		-
55		-proc ::vc::cvs::ws::csets::DUMP {id} {
56		- puts /${id}/_________________
57		- array set cs [get $id]
58		- parray cs
59		- return
60		-}
61		-
62		-proc ::vc::cvs::ws::csets::num {} {
63		- variable csets
64		- return [array size csets]
65		-}
66		-
67		-proc ::vc::cvs::ws::csets::isTrunk {id} {
68		- variable csets
69		- array set cs $csets($id)
70		- return [expr {$cs(lastd) == 2}]
71		-}
72		-
73		-proc ::vc::cvs::ws::csets::setParentOf {id parent} {
74		- variable csets
75		- lappend csets($id) parent $parent
76		-
77		- array set cs $csets($id)
78		- sig::def $id $parent $cs(added) $cs(changed) $cs(removed)
79		- return
80		-}
81		-
82		-proc ::vc::cvs::ws::csets::parentOf {id} {
83		- variable csets
84		- array set cs $csets($id)
85		- return $cs(parent)
86		-}
87		-
88		-proc ::vc::cvs::ws::csets::sameBranch {id parent tag} {
89		- variable csets
90		- array set cs $csets($id)
91		- return [sig::next $parent $cs(added) $cs(changed) $cs(removed) $tag $cs(date)]
92		-}
93		-
94		-# -----------------------------------------------------------------------------
95		-# Internal helper commands: Changeset inspection and construction.
96		-
97		-proc ::vc::cvs::ws::csets::Save {data} {
98		- variable csets
99		- variable ncs
100		-
101		- set csets($ncs) $data
102		- incr ncs
103		- return
104		-}
105		-
106		-proc ::vc::cvs::ws::csets::Current::Clear {} {
107		- variable start {} ; # date the changeset begins
108		- variable cmsg {} ; # commit message of the changeset
109		- variable author {} ; # user creating the changeset
110		- variable lastd {} ; # version depth of last added file.
111		- variable removed {} ; # file -> revision of removed files.
112		- variable added {} ; # file -> revision of added files.
113		- variable changed {} ; # file -> revision of modified files.
114		- variable files
115		- array unset files *
116		- array set files {} ; # file -> revision
117		- return
118		-}
119		-
120		-proc ::vc::cvs::ws::csets::Current::Empty {} {
121		- variable start
122		- return [expr {$start eq ""}]
123		-}
124		-
125		-proc ::vc::cvs::ws::csets::Current::New {nfile nrevision nauthor ncmsg} {
126		- upvar 1 reason reason
127		- variable cmsg
128		- variable author
129		- variable lastd
130		- variable files
131		-
132		- # User change
133		- if {$nauthor ne $author} {
134		- set reason user
135		- return 1
136		- }
137		-
138		- # File already in current cset
139		- if {[info exists files($nfile)]} {
140		- set reason file
141		- return 1
142		- }
143		-
144		- # Current cset trunk/branch different from entry.
145		- set ndepth [llength [split $nrevision .]]
146		- if {($lastd == 2) != ($ndepth == 2)} {
147		- set reason depth/$lastd/$ndepth/($nrevision)/$nfile
148		- return 1
149		- }
150		-
151		- # Commit message changed
152		- if {$ncmsg ne $cmsg} {
153		- set reason cmsg/<<$ncmsg>>
154		- return 1
155		- }
156		-
157		- # The new entry still belongs to the current changeset
158		- return 0
159		-}
160		-
161		-proc ::vc::cvs::ws::csets::Current::Add {ndate nfile nrevision noperation nauthor ncmsg} {
162		- variable start
163		- variable cmsg
164		- variable author
165		- variable lastd
166		- variable removed
167		- variable added
168		- variable changed
169		- variable files
170		-
171		- if {$start eq ""} {set start $ndate}
172		- set cmsg $ncmsg
173		- set author $nauthor
174		- set lastd [llength [split $nrevision .]]
175		- set files($nfile) $nrevision
176		-
177		- if {$noperation eq "R"} {
178		- lappend removed $nfile $nrevision
179		- } elseif {$noperation eq "A"} {
180		- lappend added $nfile $nrevision
181		- } else {
182		- lappend changed $nfile $nrevision
183		- }
184		- return
185		-}
186		-
187		-proc ::vc::cvs::ws::csets::Current::Complete {} {
188		- variable start
189		- variable cmsg
190		- variable author
191		- variable lastd
192		- variable removed
193		- variable added
194		- variable changed
195		-
196		- set res [list \
197		- date $start \
198		- author $author \
199		- cmsg [string trim $cmsg] \
200		- removed $removed \
201		- added $added \
202		- changed $changed \
203		- lastd $lastd]
204		- Clear
205		- return $res
206		-}
207		-
208		-# -----------------------------------------------------------------------------
209		-# Internals
210		-
211		-namespace eval ::vc::cvs::ws::csets {
212		-
213		- # Cset storage
214		-
215		- # csets: id -> dict
216		- # dict: date
217		- # author
218		- # csmg
219		- # removed
220		- # added
221		- # changed
222		- # lastd
223		-
224		- variable ncs 0 ; # Counter for changesets
225		- variable csets
226		- array set csets {} ; # Changeset data
227		-
228		- # Data of the current changeset built from timeline entries.
229		- namespace eval Current {
230		- variable start {} ; # date the changeset begins
231		- variable cmsg {} ; # commit message of the changeset
232		- variable author {} ; # user creating the changeset
233		- variable lastd {} ; # version depth of last added file.
234		- variable removed {} ; # file -> revision of removed files.
235		- variable added {} ; # file -> revision of added files.
236		- variable changed {} ; # file -> revision of modified files.
237		- variable files
238		- array set files {} ; # file -> revision
239		- }
240		-
241		- namespace export init add done get num isTrunk setParentOf parentOf sameBranch
242		-}
243		-
244		-# -----------------------------------------------------------------------------
245		-# Ready
246		-
247		-package provide vc::cvs::ws::csets 1.0
248		-return

	--- a/tools/lib/cvs_csets.tcl
	+++ b/tools/lib/cvs_csets.tcl
	@@ -1,248 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Repository management (CVS), Changeset grouping and storage.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::cvs::ws::sig ; # Changeset file/rev signatures
9
10	namespace eval ::vc::cvs::ws::csets::Current {}
11	namespace eval ::vc::cvs::ws::csets::sig {
12	namespace import ::vc::cvs::ws::sig::*
13	}
14
15	# -----------------------------------------------------------------------------
16	# API
17
18	# vc::cvs::ws::csets::init - Initialize accumulator
19	# vc::cvs::ws::csets::add - Add timeline entry to accumulor, may generate new cset
20	# vc::cvs::ws::csets::done - Complete cset generation.
21	#
22	# vc::cvs::ws::csets::get id - Get data of a cset.
23	# vc::cvs::ws::csets::num - Get number of csets.
24
25	# -----------------------------------------------------------------------------
26	# API Implementation
27
28	proc ::vc::cvs::ws::csets::init {} {
29	variable ncs 0
30	Current::Clear
31	return
32	}
33
34	proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
35	if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
36	Save [Current::Complete]
37	}
38	Current::Add $date $file $revision $operation $author $cmsg
39	return
40	}
41
42	proc ::vc::cvs::ws::csets::done {} {
43	if {![Current::Empty]} {
44	Save [Current::Complete]
45	}
46	return
47	}
48
49	proc ::vc::cvs::ws::csets::get {id} {
50	variable csets
51	return $csets($id)
52	}
53
54
55	proc ::vc::cvs::ws::csets::DUMP {id} {
56	puts /${id}/_________________
57	array set cs [get $id]
58	parray cs
59	return
60	}
61
62	proc ::vc::cvs::ws::csets::num {} {
63	variable csets
64	return [array size csets]
65	}
66
67	proc ::vc::cvs::ws::csets::isTrunk {id} {
68	variable csets
69	array set cs $csets($id)
70	return [expr {$cs(lastd) == 2}]
71	}
72
73	proc ::vc::cvs::ws::csets::setParentOf {id parent} {
74	variable csets
75	lappend csets($id) parent $parent
76
77	array set cs $csets($id)
78	sig::def $id $parent $cs(added) $cs(changed) $cs(removed)
79	return
80	}
81
82	proc ::vc::cvs::ws::csets::parentOf {id} {
83	variable csets
84	array set cs $csets($id)
85	return $cs(parent)
86	}
87
88	proc ::vc::cvs::ws::csets::sameBranch {id parent tag} {
89	variable csets
90	array set cs $csets($id)
91	return [sig::next $parent $cs(added) $cs(changed) $cs(removed) $tag $cs(date)]
92	}
93
94	# -----------------------------------------------------------------------------
95	# Internal helper commands: Changeset inspection and construction.
96
97	proc ::vc::cvs::ws::csets::Save {data} {
98	variable csets
99	variable ncs
100
101	set csets($ncs) $data
102	incr ncs
103	return
104	}
105
106	proc ::vc::cvs::ws::csets::Current::Clear {} {
107	variable start {} ; # date the changeset begins
108	variable cmsg {} ; # commit message of the changeset
109	variable author {} ; # user creating the changeset
110	variable lastd {} ; # version depth of last added file.
111	variable removed {} ; # file -> revision of removed files.
112	variable added {} ; # file -> revision of added files.
113	variable changed {} ; # file -> revision of modified files.
114	variable files
115	array unset files *
116	array set files {} ; # file -> revision
117	return
118	}
119
120	proc ::vc::cvs::ws::csets::Current::Empty {} {
121	variable start
122	return [expr {$start eq ""}]
123	}
124
125	proc ::vc::cvs::ws::csets::Current::New {nfile nrevision nauthor ncmsg} {
126	upvar 1 reason reason
127	variable cmsg
128	variable author
129	variable lastd
130	variable files
131
132	# User change
133	if {$nauthor ne $author} {
134	set reason user
135	return 1
136	}
137
138	# File already in current cset
139	if {[info exists files($nfile)]} {
140	set reason file
141	return 1
142	}
143
144	# Current cset trunk/branch different from entry.
145	set ndepth [llength [split $nrevision .]]
146	if {($lastd == 2) != ($ndepth == 2)} {
147	set reason depth/$lastd/$ndepth/($nrevision)/$nfile
148	return 1
149	}
150
151	# Commit message changed
152	if {$ncmsg ne $cmsg} {
153	set reason cmsg/<<$ncmsg>>
154	return 1
155	}
156
157	# The new entry still belongs to the current changeset
158	return 0
159	}
160
161	proc ::vc::cvs::ws::csets::Current::Add {ndate nfile nrevision noperation nauthor ncmsg} {
162	variable start
163	variable cmsg
164	variable author
165	variable lastd
166	variable removed
167	variable added
168	variable changed
169	variable files
170
171	if {$start eq ""} {set start $ndate}
172	set cmsg $ncmsg
173	set author $nauthor
174	set lastd [llength [split $nrevision .]]
175	set files($nfile) $nrevision
176
177	if {$noperation eq "R"} {
178	lappend removed $nfile $nrevision
179	} elseif {$noperation eq "A"} {
180	lappend added $nfile $nrevision
181	} else {
182	lappend changed $nfile $nrevision
183	}
184	return
185	}
186
187	proc ::vc::cvs::ws::csets::Current::Complete {} {
188	variable start
189	variable cmsg
190	variable author
191	variable lastd
192	variable removed
193	variable added
194	variable changed
195
196	set res [list \
197	date $start \
198	author $author \
199	cmsg [string trim $cmsg] \
200	removed $removed \
201	added $added \
202	changed $changed \
203	lastd $lastd]
204	Clear
205	return $res
206	}
207
208	# -----------------------------------------------------------------------------
209	# Internals
210
211	namespace eval ::vc::cvs::ws::csets {
212
213	# Cset storage
214
215	# csets: id -> dict
216	# dict: date
217	# author
218	# csmg
219	# removed
220	# added
221	# changed
222	# lastd
223
224	variable ncs 0 ; # Counter for changesets
225	variable csets
226	array set csets {} ; # Changeset data
227
228	# Data of the current changeset built from timeline entries.
229	namespace eval Current {
230	variable start {} ; # date the changeset begins
231	variable cmsg {} ; # commit message of the changeset
232	variable author {} ; # user creating the changeset
233	variable lastd {} ; # version depth of last added file.
234	variable removed {} ; # file -> revision of removed files.
235	variable added {} ; # file -> revision of added files.
236	variable changed {} ; # file -> revision of modified files.
237	variable files
238	array set files {} ; # file -> revision
239	}
240
241	namespace export init add done get num isTrunk setParentOf parentOf sameBranch
242	}
243
244	# -----------------------------------------------------------------------------
245	# Ready
246
247	package provide vc::cvs::ws::csets 1.0
248	return

	--- a/tools/lib/cvs_csets.tcl
	+++ b/tools/lib/cvs_csets.tcl
	@@ -1,248 +0,0 @@

D tools/lib/cvs_files.tcl

-113

		--- a/tools/lib/cvs_files.tcl
		+++ b/tools/lib/cvs_files.tcl
		@@ -1,113 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Repository management (CVS), archive files
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
9		-package require vc::tools::log ; # User feedback
10		-
11		-namespace eval ::vc::cvs::ws::files {
12		- namespace import ::vc::tools::log::write
13		- namespace import ::vc::tools::log::progress
14		-}
15		-
16		-# -----------------------------------------------------------------------------
17		-# API
18		-
19		-# vc::cvs::ws::files::find path - Find all RCS archives under the path.
20		-
21		-# -----------------------------------------------------------------------------
22		-# API Implementation
23		-
24		-proc ::vc::cvs::ws::files::find {path} {
25		-
26		- write 0 cvs "Scanning directory hierarchy $path ..."
27		-
28		- set t [fileutil::traverse %AUTO% $path]
29		- set n 0
30		- set r {}
31		-
32		- $t foreach rcs {
33		- if {![string match *,v $rcs]} continue
34		-
35		- # Now make rcs is relative to the base/project
36		- set rcs [fileutil::stripPath $path $rcs]
37		-
38		- if {[string match CVSROOT/* $rcs]} {
39		- write 2 cvs "Ignoring administrative file: $rcs"
40		- continue
41		- }
42		-
43		- set f [UserFile $rcs isattic]
44		-
45		- if {$isattic && [file exists $path/$f,v]} {
46		- # We have a regular archive and an Attic archive refering
47		- # to the same user visible file. Ignore the file in the
48		- # Attic.
49		-
50		- write 2 cvs "Ignoring superceded attic: $rcs"
51		-
52		- # TODO/CHECK. My method of co'ing exact file revisions per
53		- # the info in the collected csets has the flaw that I may
54		- # have to know exactly when what archive file to use, see
55		- # above. It might be better to use the info only to gather
56		- # when csets begin and end, and then to co complete slices
57		- # per exact timestamp (-D) instead of file revisions
58		- # (-r). The flaw in that is that csets can occur in the
59		- # same second (trf, memchan - check for examples). For
60		- # that exact checkout may be needed to recreate exact
61		- # sequence of changes. Grr. Six of one ...
62		-
63		- continue
64		- }
65		-
66		- lappend r $rcs $f
67		- incr n
68		- progress 0 cvs $n {}
69		- }
70		-
71		- $t destroy
72		- return $r
73		-}
74		-
75		-# -----------------------------------------------------------------------------
76		-# Internals
77		-
78		-proc ::vc::cvs::ws::files::UserFile {rcs iav} {
79		- upvar 1 $iav isattic
80		-
81		- # Derive the regular path from the rcs path. Meaning: Chop of the
82		- # ",v" suffix, and remove a possible "Attic".
83		-
84		- set f [string range $rcs 0 end-2]
85		-
86		- if {"Attic" eq [lindex [file split $rcs] end-1]} {
87		-
88		- # The construction below ensures that Attic/X maps to X
89		- # instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
90		-
91		- set fx [file dirname [file dirname $f]]
92		- set f [file tail $f]
93		- if {$fx ne "."} { set f [file join $fx $f] }
94		-
95		- set isattic 1
96		- } else {
97		- set isattic 0
98		- }
99		-
100		- return $f
101		-}
102		-
103		-# -----------------------------------------------------------------------------
104		-
105		-namespace eval ::vc::cvs::ws::files {
106		- namespace export find
107		-}
108		-
109		-# -----------------------------------------------------------------------------
110		-# Ready
111		-
112		-package provide vc::cvs::ws::files 1.0
113		-return

	--- a/tools/lib/cvs_files.tcl
	+++ b/tools/lib/cvs_files.tcl
	@@ -1,113 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Repository management (CVS), archive files
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
9	package require vc::tools::log ; # User feedback
10
11	namespace eval ::vc::cvs::ws::files {
12	namespace import ::vc::tools::log::write
13	namespace import ::vc::tools::log::progress
14	}
15
16	# -----------------------------------------------------------------------------
17	# API
18
19	# vc::cvs::ws::files::find path - Find all RCS archives under the path.
20
21	# -----------------------------------------------------------------------------
22	# API Implementation
23
24	proc ::vc::cvs::ws::files::find {path} {
25
26	write 0 cvs "Scanning directory hierarchy $path ..."
27
28	set t [fileutil::traverse %AUTO% $path]
29	set n 0
30	set r {}
31
32	$t foreach rcs {
33	if {![string match *,v $rcs]} continue
34
35	# Now make rcs is relative to the base/project
36	set rcs [fileutil::stripPath $path $rcs]
37
38	if {[string match CVSROOT/* $rcs]} {
39	write 2 cvs "Ignoring administrative file: $rcs"
40	continue
41	}
42
43	set f [UserFile $rcs isattic]
44
45	if {$isattic && [file exists $path/$f,v]} {
46	# We have a regular archive and an Attic archive refering
47	# to the same user visible file. Ignore the file in the
48	# Attic.
49
50	write 2 cvs "Ignoring superceded attic: $rcs"
51
52	# TODO/CHECK. My method of co'ing exact file revisions per
53	# the info in the collected csets has the flaw that I may
54	# have to know exactly when what archive file to use, see
55	# above. It might be better to use the info only to gather
56	# when csets begin and end, and then to co complete slices
57	# per exact timestamp (-D) instead of file revisions
58	# (-r). The flaw in that is that csets can occur in the
59	# same second (trf, memchan - check for examples). For
60	# that exact checkout may be needed to recreate exact
61	# sequence of changes. Grr. Six of one ...
62
63	continue
64	}
65
66	lappend r $rcs $f
67	incr n
68	progress 0 cvs $n {}
69	}
70
71	$t destroy
72	return $r
73	}
74
75	# -----------------------------------------------------------------------------
76	# Internals
77
78	proc ::vc::cvs::ws::files::UserFile {rcs iav} {
79	upvar 1 $iav isattic
80
81	# Derive the regular path from the rcs path. Meaning: Chop of the
82	# ",v" suffix, and remove a possible "Attic".
83
84	set f [string range $rcs 0 end-2]
85
86	if {"Attic" eq [lindex [file split $rcs] end-1]} {
87
88	# The construction below ensures that Attic/X maps to X
89	# instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
90
91	set fx [file dirname [file dirname $f]]
92	set f [file tail $f]
93	if {$fx ne "."} { set f [file join $fx $f] }
94
95	set isattic 1
96	} else {
97	set isattic 0
98	}
99
100	return $f
101	}
102
103	# -----------------------------------------------------------------------------
104
105	namespace eval ::vc::cvs::ws::files {
106	namespace export find
107	}
108
109	# -----------------------------------------------------------------------------
110	# Ready
111
112	package provide vc::cvs::ws::files 1.0
113	return

	--- a/tools/lib/cvs_files.tcl
	+++ b/tools/lib/cvs_files.tcl
	@@ -1,113 +0,0 @@

D tools/lib/cvs_sig.tcl

-221

		--- a/tools/lib/cvs_sig.tcl
		+++ b/tools/lib/cvs_sig.tcl
		@@ -1,221 +0,0 @@
1		-
2		-package require struct::set
3		-package require vc::cvs::ws::branch
4		-
5		-namespace eval ::vc::cvs::ws::sig::branch {
6		- namespace import ::vc::cvs::ws::branch::*
7		-}
8		-
9		-# Save the mapping from changesets to file/rev signatures, and further
10		-# remember all the csets a specific file/rev combination belongs to.
11		-
12		-proc ::vc::cvs::ws::sig::def {id parent added changed removed} {
13		- variable sig
14		- variable csl
15		-
16		- array set new $sig($parent)
17		- array set new $added
18		- array set new $changed
19		- foreach {f r} $removed {catch {unset new($f)}}
20		- set sig($id) [DictSort [array get new]]
21		-
22		- foreach {f r} [array get new] {
23		- lappend csl($f,$r) $id
24		- }
25		- return
26		-}
27		-
28		-proc ::vc::cvs::ws::sig::next {id added changed removed tag ts} {
29		- variable sig
30		- array set rev $sig($id)
31		-
32		- #puts sig::next/$ts
33		- foreach {f r} [concat $changed $removed] {
34		- if {![info exists rev($f)]} {
35		-
36		- # A file missing in the candidate parent changeset is
37		- # _not_ a reason to reject it, at least not immediately.
38		- # The code generating the timeline entries has only
39		- # partial information and is prone to misclassify files
40		- # added to branches as changed instead of added. Thus we
41		- # move this file to the list of added things and check it
42		- # again as part of that, see below.
43		-
44		- lappend added $f $r
45		- continue
46		- }
47		- if {[branch::rootSuccessor $r $rev($f)]} continue
48		- if {![branch::successor $r $rev($f)]} {
49		- #puts "not-successor($r of $rev($f))"
50		- return 0
51		- }
52		- }
53		-
54		- if {[llength $added]} {
55		- # Check that added files belong to the branch too!
56		- if {$tag ne [branch::has $ts $added]} {
57		- #puts "not-added-into-same-branch"
58		- return 0
59		- }
60		- }
61		- return 1
62		-}
63		-
64		-
65		-proc ::vc::cvs::ws::sig::find {id sig} {
66		- set cslist [Cut $id [Find $sig]]
67		-
68		- if {[llength $cslist] < 1} {
69		- puts "NO ROOT"
70		- # Deal how?
71		- # - Abort
72		- # - Ignore this changeset and try the next one
73		- # (Which has higher probability of not matching as it might
74		- # be the successor in the branch to this cset and not a base).
75		- exit
76		- } elseif {[llength $cslist] > 1} {
77		- puts "AMBIGOUS. Following csets match root requirements:"
78		- # Deal how? S.a.
79		- puts \t[join $cslist \n\t]
80		- exit
81		- }
82		-
83		- set r [lindex $cslist 0]
84		- #puts "ROOT = $r"
85		- return $r
86		-}
87		-
88		-proc ::vc::cvs::ws::sig::Cut {id cslist} {
89		- # Changesets have to be before id! This makes for another
90		- # intersection, programmatic.
91		-
92		- set res {}
93		- foreach c $cslist {
94		- if {$c >= $id} continue
95		- lappend res $c
96		- }
97		- return $res
98		-}
99		-
100		-proc ::vc::cvs::ws::sig::Find {sig} {
101		- # Locate all changesets which contain the given signature.
102		-
103		- # First we try to the exact changeset, by intersecting the
104		- # live-intervals for all file revisions found in the
105		- # signature. This however may fail, as CVS is able to contain
106		- # a-causal branch definitions.
107		-
108		- # Example: sqlite, branch "gdbm-branch".
109		-
110		- # File 'db.c', branch 1.6.2, root 1.6, entered on Jan 31, 2001.
111		- # Then 'dbbegdbm.c', 1.1.2, root 1.1, entered on Oct 19, 2000.
112		-
113		- # More pertinent, revision 1.2 was entered Jan 13, 2001,
114		- # i.e. existed before Jan 31, before the branchwas actually
115		- # made. Thus it is unclear why 1.1 is in the branch instead.
116		-
117		- # An alternative complementary question would be how db.c 1.6
118		- # ended up in a branch tag created before Jan 13, when this
119		- # revision did not exist yet.
120		-
121		- # So, CVS repositories can be a-causal when it comes to branches,
122		- # at least in the details. Therefore while try for an exact result
123		- # first we do not fail if that fails, but use a voting scheme as
124		- # fallback which answers the question about which changeset is
125		- # acceptable to the most file revisions in the signature.
126		-
127		- # Note that multiple changesets are ok at this level and are
128		- # simply returned.
129		-
130		- set res [Intersect $sig]
131		- puts Exact=($res)
132		-
133		- if {[llength $res]} { return $res }
134		-
135		- set res [Vote $sig]
136		- puts Vote=($res)
137		-
138		- return $res
139		-}
140		-
141		-
142		-proc ::vc::cvs::ws::sig::Intersect {sig} {
143		- variable csl
144		-
145		- set res {}
146		- set first 1
147		- foreach {f r} $sig {
148		- #puts $f/$r?
149		- # Unknown file not used anywhere
150		- if {![info exists csl($f,$r)]} {return {}}
151		- #puts $f/$r\t=\t($csl($f,$r))*($res)/$first
152		-
153		- if {$first} {
154		- set res $csl($f,$r)
155		- set first 0
156		- #puts F($res)
157		- } else {
158		- set res [struct::set intersect $res $csl($f,$r)]
159		- #puts R($res)
160		- if {![llength $res]} {return {}}
161		- }
162		- }
163		- return $res
164		-}
165		-
166		-
167		-proc ::vc::cvs::ws::sig::Vote {sig} {
168		- variable csl
169		-
170		- # I. Accumulate votes.
171		- array set v {}
172		- foreach {f r} $sig {
173		- # Unknown revisions do not vote.
174		- if {![info exists csl($f,$r)]} continue
175		- foreach c $csl($f,$r) {
176		- if {[info exists v($c)]} {
177		- incr v($c)
178		- } else {
179		- set v($c) 1
180		- }
181		- }
182		- }
183		-
184		- # Invert index for easier finding the max, compute the max at the
185		- # same time.
186		- array set tally {}
187		- set max -1
188		- foreach {c n} [array get v] {
189		- lappend tally($n) $c
190		- if {$n > $max} {set max $n}
191		- }
192		-
193		- #parray tally
194		- puts Max=$max
195		-
196		- # Return the changesets having the most votes.
197		- return $tally($max)
198		-}
199		-
200		-
201		-proc ::vc::cvs::ws::sig::DictSort {dict} {
202		- array set a $dict
203		- set r {}
204		- foreach k [lsort [array names a]] {
205		- lappend r $k $a($k)
206		- }
207		- return $r
208		-}
209		-
210		-
211		-namespace eval ::vc::cvs::ws::sig {
212		- variable sig ; # cset id -> signature
213		- array set sig {{} {}}
214		- variable csl ; # file x rev -> list (cset id)
215		- array set csl {}
216		-
217		- namespace export def find next
218		-}
219		-
220		-package provide vc::cvs::ws::sig 1.0
221		-return

	--- a/tools/lib/cvs_sig.tcl
	+++ b/tools/lib/cvs_sig.tcl
	@@ -1,221 +0,0 @@
1
2	package require struct::set
3	package require vc::cvs::ws::branch
4
5	namespace eval ::vc::cvs::ws::sig::branch {
6	namespace import ::vc::cvs::ws::branch::*
7	}
8
9	# Save the mapping from changesets to file/rev signatures, and further
10	# remember all the csets a specific file/rev combination belongs to.
11
12	proc ::vc::cvs::ws::sig::def {id parent added changed removed} {
13	variable sig
14	variable csl
15
16	array set new $sig($parent)
17	array set new $added
18	array set new $changed
19	foreach {f r} $removed {catch {unset new($f)}}
20	set sig($id) [DictSort [array get new]]
21
22	foreach {f r} [array get new] {
23	lappend csl($f,$r) $id
24	}
25	return
26	}
27
28	proc ::vc::cvs::ws::sig::next {id added changed removed tag ts} {
29	variable sig
30	array set rev $sig($id)
31
32	#puts sig::next/$ts
33	foreach {f r} [concat $changed $removed] {
34	if {![info exists rev($f)]} {
35
36	# A file missing in the candidate parent changeset is
37	# _not_ a reason to reject it, at least not immediately.
38	# The code generating the timeline entries has only
39	# partial information and is prone to misclassify files
40	# added to branches as changed instead of added. Thus we
41	# move this file to the list of added things and check it
42	# again as part of that, see below.
43
44	lappend added $f $r
45	continue
46	}
47	if {[branch::rootSuccessor $r $rev($f)]} continue
48	if {![branch::successor $r $rev($f)]} {
49	#puts "not-successor($r of $rev($f))"
50	return 0
51	}
52	}
53
54	if {[llength $added]} {
55	# Check that added files belong to the branch too!
56	if {$tag ne [branch::has $ts $added]} {
57	#puts "not-added-into-same-branch"
58	return 0
59	}
60	}
61	return 1
62	}
63
64
65	proc ::vc::cvs::ws::sig::find {id sig} {
66	set cslist [Cut $id [Find $sig]]
67
68	if {[llength $cslist] < 1} {
69	puts "NO ROOT"
70	# Deal how?
71	# - Abort
72	# - Ignore this changeset and try the next one
73	# (Which has higher probability of not matching as it might
74	# be the successor in the branch to this cset and not a base).
75	exit
76	} elseif {[llength $cslist] > 1} {
77	puts "AMBIGOUS. Following csets match root requirements:"
78	# Deal how? S.a.
79	puts \t[join $cslist \n\t]
80	exit
81	}
82
83	set r [lindex $cslist 0]
84	#puts "ROOT = $r"
85	return $r
86	}
87
88	proc ::vc::cvs::ws::sig::Cut {id cslist} {
89	# Changesets have to be before id! This makes for another
90	# intersection, programmatic.
91
92	set res {}
93	foreach c $cslist {
94	if {$c >= $id} continue
95	lappend res $c
96	}
97	return $res
98	}
99
100	proc ::vc::cvs::ws::sig::Find {sig} {
101	# Locate all changesets which contain the given signature.
102
103	# First we try to the exact changeset, by intersecting the
104	# live-intervals for all file revisions found in the
105	# signature. This however may fail, as CVS is able to contain
106	# a-causal branch definitions.
107
108	# Example: sqlite, branch "gdbm-branch".
109
110	# File 'db.c', branch 1.6.2, root 1.6, entered on Jan 31, 2001.
111	# Then 'dbbegdbm.c', 1.1.2, root 1.1, entered on Oct 19, 2000.
112
113	# More pertinent, revision 1.2 was entered Jan 13, 2001,
114	# i.e. existed before Jan 31, before the branchwas actually
115	# made. Thus it is unclear why 1.1 is in the branch instead.
116
117	# An alternative complementary question would be how db.c 1.6
118	# ended up in a branch tag created before Jan 13, when this
119	# revision did not exist yet.
120
121	# So, CVS repositories can be a-causal when it comes to branches,
122	# at least in the details. Therefore while try for an exact result
123	# first we do not fail if that fails, but use a voting scheme as
124	# fallback which answers the question about which changeset is
125	# acceptable to the most file revisions in the signature.
126
127	# Note that multiple changesets are ok at this level and are
128	# simply returned.
129
130	set res [Intersect $sig]
131	puts Exact=($res)
132
133	if {[llength $res]} { return $res }
134
135	set res [Vote $sig]
136	puts Vote=($res)
137
138	return $res
139	}
140
141
142	proc ::vc::cvs::ws::sig::Intersect {sig} {
143	variable csl
144
145	set res {}
146	set first 1
147	foreach {f r} $sig {
148	#puts $f/$r?
149	# Unknown file not used anywhere
150	if {![info exists csl($f,$r)]} {return {}}
151	#puts $f/$r\t=\t($csl($f,$r))*($res)/$first
152
153	if {$first} {
154	set res $csl($f,$r)
155	set first 0
156	#puts F($res)
157	} else {
158	set res [struct::set intersect $res $csl($f,$r)]
159	#puts R($res)
160	if {![llength $res]} {return {}}
161	}
162	}
163	return $res
164	}
165
166
167	proc ::vc::cvs::ws::sig::Vote {sig} {
168	variable csl
169
170	# I. Accumulate votes.
171	array set v {}
172	foreach {f r} $sig {
173	# Unknown revisions do not vote.
174	if {![info exists csl($f,$r)]} continue
175	foreach c $csl($f,$r) {
176	if {[info exists v($c)]} {
177	incr v($c)
178	} else {
179	set v($c) 1
180	}
181	}
182	}
183
184	# Invert index for easier finding the max, compute the max at the
185	# same time.
186	array set tally {}
187	set max -1
188	foreach {c n} [array get v] {
189	lappend tally($n) $c
190	if {$n > $max} {set max $n}
191	}
192
193	#parray tally
194	puts Max=$max
195
196	# Return the changesets having the most votes.
197	return $tally($max)
198	}
199
200
201	proc ::vc::cvs::ws::sig::DictSort {dict} {
202	array set a $dict
203	set r {}
204	foreach k [lsort [array names a]] {
205	lappend r $k $a($k)
206	}
207	return $r
208	}
209
210
211	namespace eval ::vc::cvs::ws::sig {
212	variable sig ; # cset id -> signature
213	array set sig {{} {}}
214	variable csl ; # file x rev -> list (cset id)
215	array set csl {}
216
217	namespace export def find next
218	}
219
220	package provide vc::cvs::ws::sig 1.0
221	return

	--- a/tools/lib/cvs_sig.tcl
	+++ b/tools/lib/cvs_sig.tcl
	@@ -1,221 +0,0 @@

D tools/lib/cvs_timeline.tcl

-87

		--- a/tools/lib/cvs_timeline.tcl
		+++ b/tools/lib/cvs_timeline.tcl
		@@ -1,87 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Repository management (CVS), timeline of events.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-
9		-namespace eval ::vc::cvs::ws::timeline {}
10		-
11		-# -----------------------------------------------------------------------------
12		-# API
13		-
14		-# vc::cvs::ws::timeline::add date file revision operation author commit-msg
15		-# vc::cvs::ws::timeline::foreach date file revision operation author commit-msg script
16		-
17		-# Add entries to the timeline, and iterate over the timeline in proper order.
18		-
19		-# -----------------------------------------------------------------------------
20		-# API Implementation
21		-
22		-proc ::vc::cvs::ws::timeline::add {date file revision operation author cmsg} {
23		- variable timeline
24		- lappend timeline($date) [list $file $revision $operation $author $cmsg]
25		- return
26		-}
27		-
28		-proc ::vc::cvs::ws::timeline::foreach {dv fv rv ov av cv script} {
29		- upvar 1 $dv date $fv file $rv revision $ov operation $av author $cv cmsg
30		- variable timeline
31		-
32		- ::foreach date [lsort -dict [array names timeline]] {
33		- # file revision operation author commitmsg
34		- # 0 1 2 3 4/end
35		- # d e b c a
36		-
37		- set entries [lsort -index 1 \
38		- [lsort -index 0 \
39		- [lsort -index 3 \
40		- [lsort -index 2 \
41		- [lsort -index end \
42		- $timeline($date)]]]]]
43		- #puts [join $entries \n]
44		-
45		- ::foreach entry $entries {
46		- lassign $entry file revision operation author cmsg
47		- set code [catch {uplevel 1 $script} res]
48		-
49		- # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
50		- switch -- $code {
51		- 0 {}
52		- 1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
53		- 2 {}
54		- 3 { return }
55		- 4 {}
56		- default {
57		- return -code $code $result
58		- }
59		- }
60		- }
61		- }
62		- return
63		-}
64		-
65		-# -----------------------------------------------------------------------------
66		-# Internals
67		-
68		-proc ::vc::cvs::ws::timeline::lassign {l args} {
69		- ::foreach v $args {upvar 1 $v $v}
70		- ::foreach $args $l break
71		- return
72		-}
73		-
74		-namespace eval ::vc::cvs::ws::timeline {
75		- # Timeline: map (date -> list (file revision operation author commitmsg))
76		-
77		- variable timeline
78		- array set timeline {}
79		-
80		- namespace export add
81		-}
82		-
83		-# -----------------------------------------------------------------------------
84		-# Ready
85		-
86		-package provide vc::cvs::ws::timeline 1.0
87		-return

	--- a/tools/lib/cvs_timeline.tcl
	+++ b/tools/lib/cvs_timeline.tcl
	@@ -1,87 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Repository management (CVS), timeline of events.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8
9	namespace eval ::vc::cvs::ws::timeline {}
10
11	# -----------------------------------------------------------------------------
12	# API
13
14	# vc::cvs::ws::timeline::add date file revision operation author commit-msg
15	# vc::cvs::ws::timeline::foreach date file revision operation author commit-msg script
16
17	# Add entries to the timeline, and iterate over the timeline in proper order.
18
19	# -----------------------------------------------------------------------------
20	# API Implementation
21
22	proc ::vc::cvs::ws::timeline::add {date file revision operation author cmsg} {
23	variable timeline
24	lappend timeline($date) [list $file $revision $operation $author $cmsg]
25	return
26	}
27
28	proc ::vc::cvs::ws::timeline::foreach {dv fv rv ov av cv script} {
29	upvar 1 $dv date $fv file $rv revision $ov operation $av author $cv cmsg
30	variable timeline
31
32	::foreach date [lsort -dict [array names timeline]] {
33	# file revision operation author commitmsg
34	# 0 1 2 3 4/end
35	# d e b c a
36
37	set entries [lsort -index 1 \
38	[lsort -index 0 \
39	[lsort -index 3 \
40	[lsort -index 2 \
41	[lsort -index end \
42	$timeline($date)]]]]]
43	#puts [join $entries \n]
44
45	::foreach entry $entries {
46	lassign $entry file revision operation author cmsg
47	set code [catch {uplevel 1 $script} res]
48
49	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
50	switch -- $code {
51	0 {}
52	1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
53	2 {}
54	3 { return }
55	4 {}
56	default {
57	return -code $code $result
58	}
59	}
60	}
61	}
62	return
63	}
64
65	# -----------------------------------------------------------------------------
66	# Internals
67
68	proc ::vc::cvs::ws::timeline::lassign {l args} {
69	::foreach v $args {upvar 1 $v $v}
70	::foreach $args $l break
71	return
72	}
73
74	namespace eval ::vc::cvs::ws::timeline {
75	# Timeline: map (date -> list (file revision operation author commitmsg))
76
77	variable timeline
78	array set timeline {}
79
80	namespace export add
81	}
82
83	# -----------------------------------------------------------------------------
84	# Ready
85
86	package provide vc::cvs::ws::timeline 1.0
87	return

	--- a/tools/lib/cvs_timeline.tcl
	+++ b/tools/lib/cvs_timeline.tcl
	@@ -1,87 +0,0 @@

D tools/lib/fossil.tcl

-231

		--- a/tools/lib/fossil.tcl
		+++ b/tools/lib/fossil.tcl
		@@ -1,231 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Repository management (FOSSIL)
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::tools::log ; # User feedback
9		-package require vc::fossil::cmd ; # Access to fossil application.
10		-
11		-namespace eval ::vc::fossil::ws {
12		- vc::tools::log::system fossil
13		- namespace import ::vc::tools::log::write
14		- namespace import ::vc::fossil::cmd::do
15		- namespace import ::vc::fossil::cmd::dova
16		-}
17		-
18		-# -----------------------------------------------------------------------------
19		-# API
20		-
21		-# vc::fossil::ws::configure key value - Configure the subsystem.
22		-# vc::fossil::ws::begin src - Start new workspace for directory
23		-# vc::fossil::ws::done dst - Close workspace and copy to destination.
24		-# vc::fossil::ws::setup uuid - Move workspace to an older revision.
25		-# vc::fossil::ws::commit cset usr time msg - Look for changes and commit as new revision.
26		-
27		-# Configuration keys:
28		-#
29		-# -nosign bool default 0 (= sign imported changesets)
30		-# -breakat num default empty, no breakpoint.
31		-# Otherwise stop before committing the identified changeset.
32		-# -saveto path default empty, no saving.
33		-# Otherwise save the commit command to a file.
34		-# -appname string Default empty. Text to add to all commit messages.
35		-# -ignore cmdprefix Command to check if a file is relevant to the commit or not.
36		-# Signature: cmdprefix path -> bool; true => ignore.
37		-
38		-# -----------------------------------------------------------------------------
39		-# API Implementation
40		-
41		-proc ::vc::fossil::ws::configure {key value} {
42		- variable nosign
43		- variable breakat
44		- variable saveto
45		- variable appname
46		- variable ignore
47		-
48		- switch -exact -- $key {
49		- -appname { set appname $value }
50		- -breakat { set breakat $value }
51		- -ignore { set ignore $value }
52		- -nosign {
53		- if {![string is boolean -strict $value]} {
54		- return -code error "Expected boolean, got \"$value\""
55		- }
56		- set nosign $value
57		- }
58		- -saveto { set saveto $value }
59		- default {
60		- return -code error "Unknown switch $key, expected one of \
61		- -appname, -breakat, -ignore, -nosign, or -saveto"
62		- }
63		- }
64		- return
65		-}
66		-
67		-proc ::vc::fossil::ws::begin {origin} {
68		- variable base [file normalize $origin]
69		- variable rp [file normalize [fileutil::tempfile import2_fsl_rp_]]
70		-
71		- cd $origin
72		-
73		- dova new $rp ; # create and ...
74		- dova open $rp ; # ... connect
75		-
76		- write 0 fossil "Repository: $rp"
77		- return
78		-}
79		-
80		-proc ::vc::fossil::ws::done {destination} {
81		- variable rp
82		- file rename -force $rp $destination
83		- set rp {}
84		- return
85		-}
86		-
87		-proc ::vc::fossil::ws::setup {uuid} {
88		- variable lastuuid
89		- if {$uuid eq $lastuuid} return
90		- write 1 fossil "=> goto $uuid"
91		- dova update $uuid
92		- set lastuuid $uuid
93		- return
94		-}
95		-
96		-proc ::vc::fossil::ws::commit {cset user timestamp message} {
97		- variable lastuuid
98		- variable base
99		-
100		- cd $base
101		-
102		- # Commit the current state of the workspace. Scan for new and
103		- # removed files and issue the appropriate fossil add/rm commands
104		- # before actually comitting.
105		-
106		- HandleChanges added removed changed
107		-
108		- # Now commit, using the provided meta data, and capture the uuid
109		- # of the new baseline.
110		-
111		- set cmd [Command $cset [Message $user $timestamp $message]]
112		-
113		- if {[catch {
114		- do $cmd
115		- } line]} {
116		- if {![string match "nothing has changed" $line]} {
117		- return -code error $line
118		- }
119		-
120		- # 'Nothing changed' can happen for changesets containing only
121		- # dead-first revisions of one or more files. For fossil we
122		- # re-use the last baseline. TODO: Mark them as branchpoint,
123		- # and for what file.
124		-
125		- write 1 fossil "UNCHANGED, keeping last"
126		-
127		- return [list $lastuuid 0 0 0]
128		- }
129		-
130		- # Extract the uuid of the new revision.
131		- regsub -nocase -- {^\sNew_Version:\s} [string trim $line] {} uuid
132		-
133		- set lastuuid $uuid
134		- return [list $uuid $added $removed $changed]
135		-}
136		-
137		-# -----------------------------------------------------------------------------
138		-# Internal helper commands, and data structures.
139		-
140		-proc ::vc::fossil::ws::HandleChanges {av rv cv} {
141		- upvar 1 $av added $rv removed $cv changed
142		-
143		- set added 0
144		- set removed 0
145		- set changed 0
146		-
147		- # Look for modified/removed files first, that way there won't be
148		- # any ADDED indicators. Nor REMOVED, only EDITED. Removed files
149		- # show up as EDITED while they are not registered as removed.
150		-
151		- foreach line [split [do changes] \n] {
152		- regsub {^\sEDITED\s} $line {} path
153		- if {[Ignore $path]} continue
154		-
155		- if {![file exists $path]} {
156		- dova rm $path
157		- incr removed
158		- write 2 fossil "- $path"
159		- } else {
160		- incr changed
161		- write 2 fossil "* $path"
162		- }
163		- }
164		-
165		- # Now look for unregistered added files.
166		-
167		- foreach path [split [do extra] \n] {
168		- if {[Ignore $path]} continue
169		- dova add $path
170		- incr added
171		- write 2 fossil "+ $path"
172		- }
173		-
174		- return
175		-}
176		-
177		-proc ::vc::fossil::ws::Message {user timestamp message} {
178		- variable appname
179		- set lines {}
180		- lappend lines "-- Originally by $user @ $timestamp"
181		- if {$appname ne ""} {
182		- lappend lines "-- Imported by $appname"
183		- }
184		- lappend lines [string trim $message]
185		- return [join $lines \n]
186		-}
187		-
188		-proc ::vc::fossil::ws::Command {cset message} {
189		- variable nosign
190		- variable saveto
191		- variable breakat
192		-
193		- set cmd [list commit -m $message]
194		-
195		- if {$nosign} { lappend cmd --nosign }
196		- if {$saveto ne ""} { fileutil::writeFile $saveto "$cmd\n" }
197		-
198		- if {$breakat eq $cset} {
199		- write 0 fossil Stopped.
200		- exit 0
201		- }
202		-
203		- return $cmd
204		-}
205		-
206		-proc ::vc::fossil::ws::Ignore {path} {
207		- variable ignore
208		- if {![llength $ignore]} {return 0}
209		- return [uplevel #0 [linsert $ignore end $path]]
210		-}
211		-
212		-namespace eval ::vc::fossil::ws {
213		- # Configuration settings.
214		- variable nosign 0 ; # Sign imported changesets
215		- variable breakat {} ; # Do not stop
216		- variable saveto {} ; # Do not save commit message
217		- variable appname {} ; # Name of importer application using the package.
218		- variable ignore {} ; # No files to ignore.
219		-
220		- variable base {} ; # Workspace directory
221		- variable rp {} ; # Repository the package works on.
222		- variable lastuuid {} ; # Uuid of last imported changeset.
223		-
224		- namespace export configure begin done setup commit
225		-}
226		-
227		-# -----------------------------------------------------------------------------
228		-# Ready
229		-
230		-package provide vc::fossil::ws 1.0
231		-return

	--- a/tools/lib/fossil.tcl
	+++ b/tools/lib/fossil.tcl
	@@ -1,231 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Repository management (FOSSIL)
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::tools::log ; # User feedback
9	package require vc::fossil::cmd ; # Access to fossil application.
10
11	namespace eval ::vc::fossil::ws {
12	vc::tools::log::system fossil
13	namespace import ::vc::tools::log::write
14	namespace import ::vc::fossil::cmd::do
15	namespace import ::vc::fossil::cmd::dova
16	}
17
18	# -----------------------------------------------------------------------------
19	# API
20
21	# vc::fossil::ws::configure key value - Configure the subsystem.
22	# vc::fossil::ws::begin src - Start new workspace for directory
23	# vc::fossil::ws::done dst - Close workspace and copy to destination.
24	# vc::fossil::ws::setup uuid - Move workspace to an older revision.
25	# vc::fossil::ws::commit cset usr time msg - Look for changes and commit as new revision.
26
27	# Configuration keys:
28	#
29	# -nosign bool default 0 (= sign imported changesets)
30	# -breakat num default empty, no breakpoint.
31	# Otherwise stop before committing the identified changeset.
32	# -saveto path default empty, no saving.
33	# Otherwise save the commit command to a file.
34	# -appname string Default empty. Text to add to all commit messages.
35	# -ignore cmdprefix Command to check if a file is relevant to the commit or not.
36	# Signature: cmdprefix path -> bool; true => ignore.
37
38	# -----------------------------------------------------------------------------
39	# API Implementation
40
41	proc ::vc::fossil::ws::configure {key value} {
42	variable nosign
43	variable breakat
44	variable saveto
45	variable appname
46	variable ignore
47
48	switch -exact -- $key {
49	-appname { set appname $value }
50	-breakat { set breakat $value }
51	-ignore { set ignore $value }
52	-nosign {
53	if {![string is boolean -strict $value]} {
54	return -code error "Expected boolean, got \"$value\""
55	}
56	set nosign $value
57	}
58	-saveto { set saveto $value }
59	default {
60	return -code error "Unknown switch $key, expected one of \
61	-appname, -breakat, -ignore, -nosign, or -saveto"
62	}
63	}
64	return
65	}
66
67	proc ::vc::fossil::ws::begin {origin} {
68	variable base [file normalize $origin]
69	variable rp [file normalize [fileutil::tempfile import2_fsl_rp_]]
70
71	cd $origin
72
73	dova new $rp ; # create and ...
74	dova open $rp ; # ... connect
75
76	write 0 fossil "Repository: $rp"
77	return
78	}
79
80	proc ::vc::fossil::ws::done {destination} {
81	variable rp
82	file rename -force $rp $destination
83	set rp {}
84	return
85	}
86
87	proc ::vc::fossil::ws::setup {uuid} {
88	variable lastuuid
89	if {$uuid eq $lastuuid} return
90	write 1 fossil "=> goto $uuid"
91	dova update $uuid
92	set lastuuid $uuid
93	return
94	}
95
96	proc ::vc::fossil::ws::commit {cset user timestamp message} {
97	variable lastuuid
98	variable base
99
100	cd $base
101
102	# Commit the current state of the workspace. Scan for new and
103	# removed files and issue the appropriate fossil add/rm commands
104	# before actually comitting.
105
106	HandleChanges added removed changed
107
108	# Now commit, using the provided meta data, and capture the uuid
109	# of the new baseline.
110
111	set cmd [Command $cset [Message $user $timestamp $message]]
112
113	if {[catch {
114	do $cmd
115	} line]} {
116	if {![string match "nothing has changed" $line]} {
117	return -code error $line
118	}
119
120	# 'Nothing changed' can happen for changesets containing only
121	# dead-first revisions of one or more files. For fossil we
122	# re-use the last baseline. TODO: Mark them as branchpoint,
123	# and for what file.
124
125	write 1 fossil "UNCHANGED, keeping last"
126
127	return [list $lastuuid 0 0 0]
128	}
129
130	# Extract the uuid of the new revision.
131	regsub -nocase -- {^\sNew_Version:\s} [string trim $line] {} uuid
132
133	set lastuuid $uuid
134	return [list $uuid $added $removed $changed]
135	}
136
137	# -----------------------------------------------------------------------------
138	# Internal helper commands, and data structures.
139
140	proc ::vc::fossil::ws::HandleChanges {av rv cv} {
141	upvar 1 $av added $rv removed $cv changed
142
143	set added 0
144	set removed 0
145	set changed 0
146
147	# Look for modified/removed files first, that way there won't be
148	# any ADDED indicators. Nor REMOVED, only EDITED. Removed files
149	# show up as EDITED while they are not registered as removed.
150
151	foreach line [split [do changes] \n] {
152	regsub {^\sEDITED\s} $line {} path
153	if {[Ignore $path]} continue
154
155	if {![file exists $path]} {
156	dova rm $path
157	incr removed
158	write 2 fossil "- $path"
159	} else {
160	incr changed
161	write 2 fossil "* $path"
162	}
163	}
164
165	# Now look for unregistered added files.
166
167	foreach path [split [do extra] \n] {
168	if {[Ignore $path]} continue
169	dova add $path
170	incr added
171	write 2 fossil "+ $path"
172	}
173
174	return
175	}
176
177	proc ::vc::fossil::ws::Message {user timestamp message} {
178	variable appname
179	set lines {}
180	lappend lines "-- Originally by $user @ $timestamp"
181	if {$appname ne ""} {
182	lappend lines "-- Imported by $appname"
183	}
184	lappend lines [string trim $message]
185	return [join $lines \n]
186	}
187
188	proc ::vc::fossil::ws::Command {cset message} {
189	variable nosign
190	variable saveto
191	variable breakat
192
193	set cmd [list commit -m $message]
194
195	if {$nosign} { lappend cmd --nosign }
196	if {$saveto ne ""} { fileutil::writeFile $saveto "$cmd\n" }
197
198	if {$breakat eq $cset} {
199	write 0 fossil Stopped.
200	exit 0
201	}
202
203	return $cmd
204	}
205
206	proc ::vc::fossil::ws::Ignore {path} {
207	variable ignore
208	if {![llength $ignore]} {return 0}
209	return [uplevel #0 [linsert $ignore end $path]]
210	}
211
212	namespace eval ::vc::fossil::ws {
213	# Configuration settings.
214	variable nosign 0 ; # Sign imported changesets
215	variable breakat {} ; # Do not stop
216	variable saveto {} ; # Do not save commit message
217	variable appname {} ; # Name of importer application using the package.
218	variable ignore {} ; # No files to ignore.
219
220	variable base {} ; # Workspace directory
221	variable rp {} ; # Repository the package works on.
222	variable lastuuid {} ; # Uuid of last imported changeset.
223
224	namespace export configure begin done setup commit
225	}
226
227	# -----------------------------------------------------------------------------
228	# Ready
229
230	package provide vc::fossil::ws 1.0
231	return

	--- a/tools/lib/fossil.tcl
	+++ b/tools/lib/fossil.tcl
	@@ -1,231 +0,0 @@

D tools/lib/fossil_cmd.tcl

-49

		--- a/tools/lib/fossil_cmd.tcl
		+++ b/tools/lib/fossil_cmd.tcl
		@@ -1,49 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Access to the external fossil command.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-namespace eval ::vc::fossil::cmd {}
9		-
10		-# -----------------------------------------------------------------------------
11		-# API
12		-
13		-# vc::fossil::cmd::dova word... - Run a fossil command specified as var args
14		-# vc::fossil::cmd::do words - Run a fossil command specified in a list.
15		-
16		-# -----------------------------------------------------------------------------
17		-# API Implementation
18		-
19		-proc ::vc::fossil::cmd::dova {args} {do $args}
20		-
21		-proc ::vc::fossil::cmd::do {words} {
22		- variable cmd
23		- if {![llength $words]} {
24		- return -code error "Empty fossil command"
25		- }
26		- # 8.5: exec $cmd {*}$words
27		- return [eval [linsert $words 0 exec $cmd]]
28		-}
29		-
30		-# -----------------------------------------------------------------------------
31		-# Internals.
32		-
33		-namespace eval ::vc::fossil::cmd {
34		- # Locate external fossil application.
35		- variable cmd [auto_execok fossil]
36		-
37		- # Bail out if not found.
38		- if {![llength $::vc::fossil::cmd::cmd]} {
39		- return -code error "Fossil application not found."
40		- }
41		-
42		- namespace export do dova
43		-}
44		-
45		-# -----------------------------------------------------------------------------
46		-# Ready
47		-
48		-package provide vc::fossil::cmd 1.0
49		-return

	--- a/tools/lib/fossil_cmd.tcl
	+++ b/tools/lib/fossil_cmd.tcl
	@@ -1,49 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Access to the external fossil command.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	namespace eval ::vc::fossil::cmd {}
9
10	# -----------------------------------------------------------------------------
11	# API
12
13	# vc::fossil::cmd::dova word... - Run a fossil command specified as var args
14	# vc::fossil::cmd::do words - Run a fossil command specified in a list.
15
16	# -----------------------------------------------------------------------------
17	# API Implementation
18
19	proc ::vc::fossil::cmd::dova {args} {do $args}
20
21	proc ::vc::fossil::cmd::do {words} {
22	variable cmd
23	if {![llength $words]} {
24	return -code error "Empty fossil command"
25	}
26	# 8.5: exec $cmd {*}$words
27	return [eval [linsert $words 0 exec $cmd]]
28	}
29
30	# -----------------------------------------------------------------------------
31	# Internals.
32
33	namespace eval ::vc::fossil::cmd {
34	# Locate external fossil application.
35	variable cmd [auto_execok fossil]
36
37	# Bail out if not found.
38	if {![llength $::vc::fossil::cmd::cmd]} {
39	return -code error "Fossil application not found."
40	}
41
42	namespace export do dova
43	}
44
45	# -----------------------------------------------------------------------------
46	# Ready
47
48	package provide vc::fossil::cmd 1.0
49	return

	--- a/tools/lib/fossil_cmd.tcl
	+++ b/tools/lib/fossil_cmd.tcl
	@@ -1,49 +0,0 @@

D tools/lib/import_map.tcl

-50

		--- a/tools/lib/import_map.tcl
		+++ b/tools/lib/import_map.tcl
		@@ -1,50 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Management of the mapping between cvs changesets and fossil uuids.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::tools::log ; # User feedback
9		-
10		-namespace eval ::vc::fossil::import::map {
11		- vc::tools::log::system map
12		- namespace import ::vc::tools::log::write
13		-}
14		-
15		-# -----------------------------------------------------------------------------
16		-# API
17		-
18		-# vc::fossil::import::map
19		-# set cset uuid - Associate changeset with uuid
20		-# get cset -> uuid - Retrieve uuid for changeset.
21		-
22		-# -----------------------------------------------------------------------------
23		-# API Implementation - Functionality
24		-
25		-proc ::vc::fossil::import::map::set {cset uuid} {
26		- variable map
27		- ::set map($cset) $uuid
28		- write 2 map "== $uuid"
29		- return
30		-}
31		-
32		-proc ::vc::fossil::import::map::get {cset} {
33		- variable map
34		- return $map($cset)
35		-}
36		-
37		-# -----------------------------------------------------------------------------
38		-
39		-namespace eval ::vc::fossil::import::map {
40		- variable map ; # Map from csets to uuids
41		- array set map {} ; #
42		-
43		- namespace export get set
44		-}
45		-
46		-# -----------------------------------------------------------------------------
47		-# Ready
48		-
49		-package provide vc::fossil::import::map 1.0
50		-return

	--- a/tools/lib/import_map.tcl
	+++ b/tools/lib/import_map.tcl
	@@ -1,50 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Management of the mapping between cvs changesets and fossil uuids.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::tools::log ; # User feedback
9
10	namespace eval ::vc::fossil::import::map {
11	vc::tools::log::system map
12	namespace import ::vc::tools::log::write
13	}
14
15	# -----------------------------------------------------------------------------
16	# API
17
18	# vc::fossil::import::map
19	# set cset uuid - Associate changeset with uuid
20	# get cset -> uuid - Retrieve uuid for changeset.
21
22	# -----------------------------------------------------------------------------
23	# API Implementation - Functionality
24
25	proc ::vc::fossil::import::map::set {cset uuid} {
26	variable map
27	::set map($cset) $uuid
28	write 2 map "== $uuid"
29	return
30	}
31
32	proc ::vc::fossil::import::map::get {cset} {
33	variable map
34	return $map($cset)
35	}
36
37	# -----------------------------------------------------------------------------
38
39	namespace eval ::vc::fossil::import::map {
40	variable map ; # Map from csets to uuids
41	array set map {} ; #
42
43	namespace export get set
44	}
45
46	# -----------------------------------------------------------------------------
47	# Ready
48
49	package provide vc::fossil::import::map 1.0
50	return

	--- a/tools/lib/import_map.tcl
	+++ b/tools/lib/import_map.tcl
	@@ -1,50 +0,0 @@

D tools/lib/import_statistics.tcl

-116

		--- a/tools/lib/import_statistics.tcl
		+++ b/tools/lib/import_statistics.tcl
		@@ -1,116 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Management of statistics for an import run.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::tools::log ; # User feedback
9		-
10		-namespace eval ::vc::fossil::import::stats {
11		- vc::tools::log::system stats
12		- namespace import ::vc::tools::log::write
13		-}
14		-
15		-# -----------------------------------------------------------------------------
16		-# API
17		-
18		-# vc::fossil::import::stats
19		-# setup n m - Initialize module, expect n changesets, of m.
20		-# done - Write final statistics.
21		-# csbegin id - Import of identified changeset begins.
22		-# csend x - It took x seconds to import the changeset.
23		-#
24		-
25		-# -----------------------------------------------------------------------------
26		-# API Implementation - Functionality
27		-
28		-proc ::vc::fossil::import::stats::setup {n m} {
29		- variable run_format %[string length $n]s
30		- variable max_format %[string length $m]s
31		- variable total_csets $n
32		- variable total_running 0
33		- variable total_seconds 0.0
34		- return
35		-}
36		-
37		-proc ::vc::fossil::import::stats::done {} {
38		- variable total_csets
39		- variable total_seconds
40		-
41		- write 0 stats "========= [string repeat = 61]"
42		- write 0 stats "Imported $total_csets [expr {($total_csets == 1) ? "changeset" : "changesets"}]"
43		- write 0 stats "Within [F $total_seconds] seconds (avg [F [Avg]] seconds/changeset)"
44		- return
45		-}
46		-
47		-proc ::vc::fossil::import::stats::csbegin {cset} {
48		- variable max_format
49		- variable run_format
50		- variable total_running
51		- variable total_csets
52		-
53		- incr total_running
54		-
55		- write 0 stats "ChangeSet [format $max_format $cset] @ [format $run_format $total_running]/$total_csets ([F6 [expr {$total_running*100.0/$total_csets}]]%)"
56		- return
57		-}
58		-
59		-proc ::vc::fossil::import::stats::csend {seconds} {
60		- variable total_csets
61		- variable total_seconds
62		- variable total_running
63		-
64		- set total_seconds [expr {$total_seconds + $seconds}]
65		-
66		- set avg [Avg]
67		- set end [expr {$total_csets * $avg}]
68		- set rem [expr {$end - $total_seconds}]
69		-
70		- write 2 stats "Imported in [F7 $seconds] seconds"
71		- write 3 stats "Average Time/Cset [F7 $avg] seconds"
72		- write 3 stats "Current Runtime [FTime $total_seconds]"
73		- write 3 stats "Total Runtime (E) [FTime $end]"
74		- write 3 stats "Remaining Time (E) [FTime $rem]"
75		- # (E) for Estimated.
76		-
77		- return
78		-}
79		-
80		-# -----------------------------------------------------------------------------
81		-# Internal helper commands.
82		-
83		-proc ::vc::fossil::import::stats::FTime {s} {
84		- set m [expr {$s / 60}]
85		- set h [expr {$s / 3600}]
86		- return "[F7 $s] sec [F6 $m] min [F5 $h] hr"
87		-}
88		-
89		-proc ::vc::fossil::import::stats::F {x} { format %.2f $x }
90		-proc ::vc::fossil::import::stats::F5 {x} { format %5.2f $x }
91		-proc ::vc::fossil::import::stats::F6 {x} { format %6.2f $x }
92		-proc ::vc::fossil::import::stats::F7 {x} { format %7.2f $x }
93		-
94		-proc ::vc::fossil::import::stats::Avg {} {
95		- variable total_seconds
96		- variable total_running
97		- return [expr {$total_seconds/$total_running}]
98		-}
99		-
100		-# -----------------------------------------------------------------------------
101		-
102		-namespace eval ::vc::fossil::import::stats {
103		- variable total_csets 0 ; # Number of changesets to expect to be imported
104		- variable total_running 0 ; # Number of changesets which have been imported so far
105		- variable total_seconds 0 ; # Current runtime in seconds
106		- variable max_format %s ; # Format to print changeset id, based on the largest id.
107		- variable run_format %s ; # Format to print the number of imported csets.
108		-
109		- namespace export setup done csbegin csend
110		-}
111		-
112		-# -----------------------------------------------------------------------------
113		-# Ready
114		-
115		-package provide vc::fossil::import::stats 1.0
116		-return

	--- a/tools/lib/import_statistics.tcl
	+++ b/tools/lib/import_statistics.tcl
	@@ -1,116 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Management of statistics for an import run.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::tools::log ; # User feedback
9
10	namespace eval ::vc::fossil::import::stats {
11	vc::tools::log::system stats
12	namespace import ::vc::tools::log::write
13	}
14
15	# -----------------------------------------------------------------------------
16	# API
17
18	# vc::fossil::import::stats
19	# setup n m - Initialize module, expect n changesets, of m.
20	# done - Write final statistics.
21	# csbegin id - Import of identified changeset begins.
22	# csend x - It took x seconds to import the changeset.
23	#
24
25	# -----------------------------------------------------------------------------
26	# API Implementation - Functionality
27
28	proc ::vc::fossil::import::stats::setup {n m} {
29	variable run_format %[string length $n]s
30	variable max_format %[string length $m]s
31	variable total_csets $n
32	variable total_running 0
33	variable total_seconds 0.0
34	return
35	}
36
37	proc ::vc::fossil::import::stats::done {} {
38	variable total_csets
39	variable total_seconds
40
41	write 0 stats "========= [string repeat = 61]"
42	write 0 stats "Imported $total_csets [expr {($total_csets == 1) ? "changeset" : "changesets"}]"
43	write 0 stats "Within [F $total_seconds] seconds (avg [F [Avg]] seconds/changeset)"
44	return
45	}
46
47	proc ::vc::fossil::import::stats::csbegin {cset} {
48	variable max_format
49	variable run_format
50	variable total_running
51	variable total_csets
52
53	incr total_running
54
55	write 0 stats "ChangeSet [format $max_format $cset] @ [format $run_format $total_running]/$total_csets ([F6 [expr {$total_running*100.0/$total_csets}]]%)"
56	return
57	}
58
59	proc ::vc::fossil::import::stats::csend {seconds} {
60	variable total_csets
61	variable total_seconds
62	variable total_running
63
64	set total_seconds [expr {$total_seconds + $seconds}]
65
66	set avg [Avg]
67	set end [expr {$total_csets * $avg}]
68	set rem [expr {$end - $total_seconds}]
69
70	write 2 stats "Imported in [F7 $seconds] seconds"
71	write 3 stats "Average Time/Cset [F7 $avg] seconds"
72	write 3 stats "Current Runtime [FTime $total_seconds]"
73	write 3 stats "Total Runtime (E) [FTime $end]"
74	write 3 stats "Remaining Time (E) [FTime $rem]"
75	# (E) for Estimated.
76
77	return
78	}
79
80	# -----------------------------------------------------------------------------
81	# Internal helper commands.
82
83	proc ::vc::fossil::import::stats::FTime {s} {
84	set m [expr {$s / 60}]
85	set h [expr {$s / 3600}]
86	return "[F7 $s] sec [F6 $m] min [F5 $h] hr"
87	}
88
89	proc ::vc::fossil::import::stats::F {x} { format %.2f $x }
90	proc ::vc::fossil::import::stats::F5 {x} { format %5.2f $x }
91	proc ::vc::fossil::import::stats::F6 {x} { format %6.2f $x }
92	proc ::vc::fossil::import::stats::F7 {x} { format %7.2f $x }
93
94	proc ::vc::fossil::import::stats::Avg {} {
95	variable total_seconds
96	variable total_running
97	return [expr {$total_seconds/$total_running}]
98	}
99
100	# -----------------------------------------------------------------------------
101
102	namespace eval ::vc::fossil::import::stats {
103	variable total_csets 0 ; # Number of changesets to expect to be imported
104	variable total_running 0 ; # Number of changesets which have been imported so far
105	variable total_seconds 0 ; # Current runtime in seconds
106	variable max_format %s ; # Format to print changeset id, based on the largest id.
107	variable run_format %s ; # Format to print the number of imported csets.
108
109	namespace export setup done csbegin csend
110	}
111
112	# -----------------------------------------------------------------------------
113	# Ready
114
115	package provide vc::fossil::import::stats 1.0
116	return

	--- a/tools/lib/import_statistics.tcl
	+++ b/tools/lib/import_statistics.tcl
	@@ -1,116 +0,0 @@

D tools/lib/importcvs.tcl

-127

		--- a/tools/lib/importcvs.tcl
		+++ b/tools/lib/importcvs.tcl
		@@ -1,127 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Tool packages. Main control module for importing from a CVS repository.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::cvs::ws ; # Frontend, reading from source repository
9		-package require vc::fossil::ws ; # Backend, writing to destination repository.
10		-package require vc::tools::log ; # User feedback.
11		-package require vc::fossil::import::stats ; # Management for the Import Statistics.
12		-package require vc::fossil::import::map ; # Management of the cset <-> uuid mapping.
13		-package require vc::rcs::parser ; # Parser configuration
14		-
15		-namespace eval ::vc::fossil::import::cvs {
16		- vc::tools::log::system import
17		- namespace import ::vc::tools::log::write
18		- namespace eval cvs { namespace import ::vc::cvs::ws::* }
19		- namespace eval fossil { namespace import ::vc::fossil::ws::* }
20		- namespace eval stats { namespace import ::vc::fossil::import::stats::* }
21		- namespace eval map { namespace import ::vc::fossil::import::map::* }
22		- namespace eval rcs { namespace import ::vc::rcs::parser::* }
23		-
24		- fossil::configure -appname cvs2fossil
25		- fossil::configure -ignore ::vc::cvs::ws::isadmin
26		-}
27		-
28		-# -----------------------------------------------------------------------------
29		-# API
30		-
31		-# Configuration
32		-#
33		-# vc::fossil::import::cvs::configure key value - Set configuration
34		-#
35		-# Legal keys: -nosign <bool>, default false
36		-# -breakat <int>, default :none:
37		-# -saveto <path>, default :none:
38		-# -limit <path>, default :none:
39		-#
40		-# Functionality
41		-#
42		-# vc::fossil::import::cvs::run src dst - Perform an import.
43		-
44		-# -----------------------------------------------------------------------------
45		-# API Implementation - Functionality
46		-
47		-proc ::vc::fossil::import::cvs::configure {key value} {
48		- # The options are simply passed through to the fossil importer
49		- # backend.
50		- switch -exact -- $key {
51		- -breakat { fossil::configure -breakat $value }
52		- -cache-rcs { rcs::configure -cache $value }
53		- -nosign { fossil::configure -nosign $value }
54		- -project { cvs::configure -project $value }
55		- -saveto { fossil::configure -saveto $value }
56		- default {
57		- return -code error "Unknown switch $key, expected one of \
58		- -breakat, -cache, -nosign, -project, or -saveto"
59		- }
60		- }
61		- return
62		-}
63		-
64		-# Import the CVS repository found at directory 'src' into the new
65		-# fossil repository at 'dst'.
66		-
67		-proc ::vc::fossil::import::cvs::run {src dst} {
68		- map::set {} {}
69		-
70		- set src [file normalize $src]
71		- set dst [file normalize $dst]
72		-
73		- set ws [cvs::begin $src]
74		- fossil::begin $ws
75		- stats::setup [cvs::nimportable] [cvs::ncsets]
76		-
77		- cvs::foreach cset {
78		- Import1 $cset
79		- }
80		-
81		- stats::done
82		- fossil::done $dst
83		- cvs::done
84		-
85		- write 0 import Ok.
86		- return
87		-}
88		-
89		-# -----------------------------------------------------------------------------
90		-# Internal operations - Import a single changeset.
91		-
92		-proc ::vc::fossil::import::cvs::Import1 {cset} {
93		- stats::csbegin $cset
94		-
95		- set microseconds [lindex [time {ImportCS $cset} 1] 0]
96		- set seconds [expr {$microseconds/1e6}]
97		-
98		- stats::csend $seconds
99		- return
100		-}
101		-
102		-proc ::vc::fossil::import::cvs::ImportCS {cset} {
103		- fossil::setup [map::get [cvs::parentOf $cset]]
104		- lassign [cvs::checkout $cset] user timestamp message
105		- lassign [fossil::commit $cset $user $timestamp $message] uuid ad rm ch
106		- write 2 import "== +${ad}-${rm}*${ch}"
107		- map::set $cset $uuid
108		- return
109		-}
110		-
111		-proc ::vc::fossil::import::cvs::lassign {l args} {
112		- foreach v $args {upvar 1 $v $v}
113		- foreach $args $l break
114		- return
115		-}
116		-
117		-# -----------------------------------------------------------------------------
118		-
119		-namespace eval ::vc::fossil::import::cvs {
120		- namespace export run configure
121		-}
122		-
123		-# -----------------------------------------------------------------------------
124		-# Ready
125		-
126		-package provide vc::fossil::import::cvs 1.0
127		-return

	--- a/tools/lib/importcvs.tcl
	+++ b/tools/lib/importcvs.tcl
	@@ -1,127 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Tool packages. Main control module for importing from a CVS repository.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::cvs::ws ; # Frontend, reading from source repository
9	package require vc::fossil::ws ; # Backend, writing to destination repository.
10	package require vc::tools::log ; # User feedback.
11	package require vc::fossil::import::stats ; # Management for the Import Statistics.
12	package require vc::fossil::import::map ; # Management of the cset <-> uuid mapping.
13	package require vc::rcs::parser ; # Parser configuration
14
15	namespace eval ::vc::fossil::import::cvs {
16	vc::tools::log::system import
17	namespace import ::vc::tools::log::write
18	namespace eval cvs { namespace import ::vc::cvs::ws::* }
19	namespace eval fossil { namespace import ::vc::fossil::ws::* }
20	namespace eval stats { namespace import ::vc::fossil::import::stats::* }
21	namespace eval map { namespace import ::vc::fossil::import::map::* }
22	namespace eval rcs { namespace import ::vc::rcs::parser::* }
23
24	fossil::configure -appname cvs2fossil
25	fossil::configure -ignore ::vc::cvs::ws::isadmin
26	}
27
28	# -----------------------------------------------------------------------------
29	# API
30
31	# Configuration
32	#
33	# vc::fossil::import::cvs::configure key value - Set configuration
34	#
35	# Legal keys: -nosign <bool>, default false
36	# -breakat <int>, default :none:
37	# -saveto <path>, default :none:
38	# -limit <path>, default :none:
39	#
40	# Functionality
41	#
42	# vc::fossil::import::cvs::run src dst - Perform an import.
43
44	# -----------------------------------------------------------------------------
45	# API Implementation - Functionality
46
47	proc ::vc::fossil::import::cvs::configure {key value} {
48	# The options are simply passed through to the fossil importer
49	# backend.
50	switch -exact -- $key {
51	-breakat { fossil::configure -breakat $value }
52	-cache-rcs { rcs::configure -cache $value }
53	-nosign { fossil::configure -nosign $value }
54	-project { cvs::configure -project $value }
55	-saveto { fossil::configure -saveto $value }
56	default {
57	return -code error "Unknown switch $key, expected one of \
58	-breakat, -cache, -nosign, -project, or -saveto"
59	}
60	}
61	return
62	}
63
64	# Import the CVS repository found at directory 'src' into the new
65	# fossil repository at 'dst'.
66
67	proc ::vc::fossil::import::cvs::run {src dst} {
68	map::set {} {}
69
70	set src [file normalize $src]
71	set dst [file normalize $dst]
72
73	set ws [cvs::begin $src]
74	fossil::begin $ws
75	stats::setup [cvs::nimportable] [cvs::ncsets]
76
77	cvs::foreach cset {
78	Import1 $cset
79	}
80
81	stats::done
82	fossil::done $dst
83	cvs::done
84
85	write 0 import Ok.
86	return
87	}
88
89	# -----------------------------------------------------------------------------
90	# Internal operations - Import a single changeset.
91
92	proc ::vc::fossil::import::cvs::Import1 {cset} {
93	stats::csbegin $cset
94
95	set microseconds [lindex [time {ImportCS $cset} 1] 0]
96	set seconds [expr {$microseconds/1e6}]
97
98	stats::csend $seconds
99	return
100	}
101
102	proc ::vc::fossil::import::cvs::ImportCS {cset} {
103	fossil::setup [map::get [cvs::parentOf $cset]]
104	lassign [cvs::checkout $cset] user timestamp message
105	lassign [fossil::commit $cset $user $timestamp $message] uuid ad rm ch
106	write 2 import "== +${ad}-${rm}*${ch}"
107	map::set $cset $uuid
108	return
109	}
110
111	proc ::vc::fossil::import::cvs::lassign {l args} {
112	foreach v $args {upvar 1 $v $v}
113	foreach $args $l break
114	return
115	}
116
117	# -----------------------------------------------------------------------------
118
119	namespace eval ::vc::fossil::import::cvs {
120	namespace export run configure
121	}
122
123	# -----------------------------------------------------------------------------
124	# Ready
125
126	package provide vc::fossil::import::cvs 1.0
127	return

	--- a/tools/lib/importcvs.tcl
	+++ b/tools/lib/importcvs.tcl
	@@ -1,127 +0,0 @@

D tools/lib/log.tcl

-153

		--- a/tools/lib/log.tcl
		+++ b/tools/lib/log.tcl
		@@ -1,153 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Tool packages. Logging (aka User feedback).
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-namespace eval ::vc::tools::log {}
9		-
10		-# -----------------------------------------------------------------------------
11		-# API
12		-
13		-# Feedback generation.
14		-#
15		-# vc::tools::log::write verbosity system text - Write message to the log.
16		-# vc::tools::log::progress verbosity system n max - Drive a progress display.
17		-#
18		-# Note: max empty => infinite progress display, otherwise a finite display.
19		-
20		-# Administrative operations.
21		-#
22		-# vc::tools::log::verbosity level - Set the verbosity level of the application.
23		-# vc::tools::log::verbosity? - Query the verbosity level of the application.
24		-# vc::tools::log::setCmd cmdprefix - Set callback for output
25		-# vc::tools::log::system name - Register a system (enables tabular log formatting).
26		-
27		-# Callback API ( Executed at the global level).
28		-#
29		-# cmdprefix 'write' system text
30		-# cmdprefix 'progress' system n max
31		-
32		-# Standard callbacks defined by the package itself write to stdout.
33		-
34		-# -----------------------------------------------------------------------------
35		-# API Implementation - Feedback generation.
36		-
37		-# Write the message 'text' to log, for the named 'system'. The message
38		-# is written if and only if the message verbosity is less or equal the
39		-# chosen verbosity. A message of verbosity 0 cannot be blocked.
40		-
41		-proc ::vc::tools::log::write {verbosity system text} {
42		- variable loglevel
43		- variable logcmd
44		- variable sysfmt
45		- if {$verbosity > $loglevel} return
46		- uplevel #0 [linsert $logcmd end write [format $sysfmt $system] $text]
47		- return
48		-}
49		-
50		-# Similar to write, especially in the handling of the verbosity, to
51		-# drive progress displays. It signals that for some long running
52		-# operation we are at tick 'n' of at most 'max' ticks.
53		-
54		-proc ::vc::tools::log::progress {verbosity system n max} {
55		- variable loglevel
56		- variable logcmd
57		- variable sysfmt
58		- if {$verbosity > $loglevel} return
59		- uplevel #0 [linsert $logcmd end progress [format $sysfmt $system] $n $max]
60		- return
61		-}
62		-
63		-# -----------------------------------------------------------------------------
64		-# API Implementation - Administrative operations.
65		-
66		-# Set verbosity to the chosen 'level'. Only messages with a level less
67		-# or equal to this one will be shown.
68		-
69		-proc ::vc::tools::log::verbosity {level} {
70		- variable loglevel
71		- if {$level < 1} {set level 0}
72		- set loglevel $level
73		- return
74		-}
75		-
76		-# Query the currently set verbosity.
77		-
78		-proc ::vc::tools::log::verbosity? {} {
79		- variable loglevel
80		- return $loglevel
81		-}
82		-
83		-# Set the log callback handling the actual output of messages going
84		-# through the package.
85		-
86		-proc ::vc::tools::log::setCmd {cmdprefix} {
87		- variable logcmd $cmdprefix
88		- return
89		-}
90		-
91		-# Register a system name, to enable tabular formatting. This is done
92		-# by setting up a format specifier with a proper width. This is
93		-# handled in the generation command, before the output callback is
94		-# invoked.
95		-
96		-proc ::vc::tools::log::system {name} {
97		- variable sysfmt
98		- variable syslen
99		-
100		- set nlen [string length $name]
101		- if {$nlen < $syslen} return
102		-
103		- set syslen $nlen
104		- set sysfmt %-${syslen}s
105		- return
106		-}
107		-
108		-# -----------------------------------------------------------------------------
109		-# Internal operations - Standard output operation
110		-
111		-# Dispatch to the handlers of the possible operations.
112		-
113		-proc ::vc::tools::log::OUT {op args} {
114		- eval [linsert $args 0 ::vc::tools::log::OUT/$op]
115		- return
116		-}
117		-
118		-# Write handler. Each message is a line.
119		-
120		-proc ::vc::tools::log::OUT/write {system text} {
121		- puts "$system $text"
122		- return
123		-}
124		-
125		-# Progress handler. Uses \r to return to the beginning of the current
126		-# line without advancing.
127		-
128		-proc ::vc::tools::log::OUT/progress {system n max} {
129		- if {$max eq {}} {
130		- puts -nonewline "$system $n\r"
131		- } else {
132		- puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
133		- }
134		- flush stdout
135		- return
136		-}
137		-
138		-# -----------------------------------------------------------------------------
139		-
140		-namespace eval ::vc::tools::log {
141		- variable loglevel 0 ; # Allow only uninteruptible messages.
142		- variable logcmd ::vc::tools::log::OUT ; # Standard output to stdout.
143		- variable sysfmt %s ; # Non-tabular formatting.
144		- variable syslen 0 ; # Ditto.
145		-
146		- namespace export write progress
147		-}
148		-
149		-# -----------------------------------------------------------------------------
150		-# Ready
151		-
152		-package provide vc::tools::log 1.0
153		-return

	--- a/tools/lib/log.tcl
	+++ b/tools/lib/log.tcl
	@@ -1,153 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Tool packages. Logging (aka User feedback).
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	namespace eval ::vc::tools::log {}
9
10	# -----------------------------------------------------------------------------
11	# API
12
13	# Feedback generation.
14	#
15	# vc::tools::log::write verbosity system text - Write message to the log.
16	# vc::tools::log::progress verbosity system n max - Drive a progress display.
17	#
18	# Note: max empty => infinite progress display, otherwise a finite display.
19
20	# Administrative operations.
21	#
22	# vc::tools::log::verbosity level - Set the verbosity level of the application.
23	# vc::tools::log::verbosity? - Query the verbosity level of the application.
24	# vc::tools::log::setCmd cmdprefix - Set callback for output
25	# vc::tools::log::system name - Register a system (enables tabular log formatting).
26
27	# Callback API ( Executed at the global level).
28	#
29	# cmdprefix 'write' system text
30	# cmdprefix 'progress' system n max
31
32	# Standard callbacks defined by the package itself write to stdout.
33
34	# -----------------------------------------------------------------------------
35	# API Implementation - Feedback generation.
36
37	# Write the message 'text' to log, for the named 'system'. The message
38	# is written if and only if the message verbosity is less or equal the
39	# chosen verbosity. A message of verbosity 0 cannot be blocked.
40
41	proc ::vc::tools::log::write {verbosity system text} {
42	variable loglevel
43	variable logcmd
44	variable sysfmt
45	if {$verbosity > $loglevel} return
46	uplevel #0 [linsert $logcmd end write [format $sysfmt $system] $text]
47	return
48	}
49
50	# Similar to write, especially in the handling of the verbosity, to
51	# drive progress displays. It signals that for some long running
52	# operation we are at tick 'n' of at most 'max' ticks.
53
54	proc ::vc::tools::log::progress {verbosity system n max} {
55	variable loglevel
56	variable logcmd
57	variable sysfmt
58	if {$verbosity > $loglevel} return
59	uplevel #0 [linsert $logcmd end progress [format $sysfmt $system] $n $max]
60	return
61	}
62
63	# -----------------------------------------------------------------------------
64	# API Implementation - Administrative operations.
65
66	# Set verbosity to the chosen 'level'. Only messages with a level less
67	# or equal to this one will be shown.
68
69	proc ::vc::tools::log::verbosity {level} {
70	variable loglevel
71	if {$level < 1} {set level 0}
72	set loglevel $level
73	return
74	}
75
76	# Query the currently set verbosity.
77
78	proc ::vc::tools::log::verbosity? {} {
79	variable loglevel
80	return $loglevel
81	}
82
83	# Set the log callback handling the actual output of messages going
84	# through the package.
85
86	proc ::vc::tools::log::setCmd {cmdprefix} {
87	variable logcmd $cmdprefix
88	return
89	}
90
91	# Register a system name, to enable tabular formatting. This is done
92	# by setting up a format specifier with a proper width. This is
93	# handled in the generation command, before the output callback is
94	# invoked.
95
96	proc ::vc::tools::log::system {name} {
97	variable sysfmt
98	variable syslen
99
100	set nlen [string length $name]
101	if {$nlen < $syslen} return
102
103	set syslen $nlen
104	set sysfmt %-${syslen}s
105	return
106	}
107
108	# -----------------------------------------------------------------------------
109	# Internal operations - Standard output operation
110
111	# Dispatch to the handlers of the possible operations.
112
113	proc ::vc::tools::log::OUT {op args} {
114	eval [linsert $args 0 ::vc::tools::log::OUT/$op]
115	return
116	}
117
118	# Write handler. Each message is a line.
119
120	proc ::vc::tools::log::OUT/write {system text} {
121	puts "$system $text"
122	return
123	}
124
125	# Progress handler. Uses \r to return to the beginning of the current
126	# line without advancing.
127
128	proc ::vc::tools::log::OUT/progress {system n max} {
129	if {$max eq {}} {
130	puts -nonewline "$system $n\r"
131	} else {
132	puts -nonewline "$system [format %[string length $max]s $n]/$max\r"
133	}
134	flush stdout
135	return
136	}
137
138	# -----------------------------------------------------------------------------
139
140	namespace eval ::vc::tools::log {
141	variable loglevel 0 ; # Allow only uninteruptible messages.
142	variable logcmd ::vc::tools::log::OUT ; # Standard output to stdout.
143	variable sysfmt %s ; # Non-tabular formatting.
144	variable syslen 0 ; # Ditto.
145
146	namespace export write progress
147	}
148
149	# -----------------------------------------------------------------------------
150	# Ready
151
152	package provide vc::tools::log 1.0
153	return

	--- a/tools/lib/log.tcl
	+++ b/tools/lib/log.tcl
	@@ -1,153 +0,0 @@

D tools/lib/pkgIndex.tcl

-16

		--- a/tools/lib/pkgIndex.tcl
		+++ b/tools/lib/pkgIndex.tcl
		@@ -1,16 +0,0 @@
1		-if {![package vsatisfies [package require Tcl] 8.4]} return
2		-package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
3		-package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
4		-package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
5		-package ifneeded vc::cvs::ws::files 1.0 [list source [file join $dir cvs_files.tcl]]
6		-package ifneeded vc::cvs::ws::timeline 1.0 [list source [file join $dir cvs_timeline.tcl]]
7		-package ifneeded vc::cvs::ws::csets 1.0 [list source [file join $dir cvs_csets.tcl]]
8		-package ifneeded vc::cvs::ws::branch 1.0 [list source [file join $dir cvs_branch.tcl]]
9		-package ifneeded vc::cvs::ws::sig 1.0 [list source [file join $dir cvs_sig.tcl]]
10		-package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
11		-package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
12		-package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
13		-package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
14		-package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
15		-package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
16		-package ifneeded vc::tools::trouble 1.0 [list source [file join $dir trouble.tcl]]

	--- a/tools/lib/pkgIndex.tcl
	+++ b/tools/lib/pkgIndex.tcl
	@@ -1,16 +0,0 @@
1	if {![package vsatisfies [package require Tcl] 8.4]} return
2	package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
3	package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
4	package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
5	package ifneeded vc::cvs::ws::files 1.0 [list source [file join $dir cvs_files.tcl]]
6	package ifneeded vc::cvs::ws::timeline 1.0 [list source [file join $dir cvs_timeline.tcl]]
7	package ifneeded vc::cvs::ws::csets 1.0 [list source [file join $dir cvs_csets.tcl]]
8	package ifneeded vc::cvs::ws::branch 1.0 [list source [file join $dir cvs_branch.tcl]]
9	package ifneeded vc::cvs::ws::sig 1.0 [list source [file join $dir cvs_sig.tcl]]
10	package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
11	package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
12	package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
13	package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
14	package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
15	package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
16	package ifneeded vc::tools::trouble 1.0 [list source [file join $dir trouble.tcl]]

	--- a/tools/lib/pkgIndex.tcl
	+++ b/tools/lib/pkgIndex.tcl
	@@ -1,16 +0,0 @@

D tools/lib/rcsparser.tcl

-303

		--- a/tools/lib/rcsparser.tcl
		+++ b/tools/lib/rcsparser.tcl
		@@ -1,303 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Tool packages. Parsing RCS files.
3		-#
4		-# Some of the information in RCS files is skipped over, most
5		-# importantly the actual delta texts. The users of this parser need
6		-# only the meta-data about when revisions were added, the tree
7		-# (branching) structure, commit messages.
8		-#
9		-# The parser is based on Recursive Descent.
10		-
11		-# -----------------------------------------------------------------------------
12		-# Requirements
13		-
14		-package require Tcl 8.4
15		-package require fileutil ; # Tcllib (cat)
16		-package require vc::tools::log ; # User feedback
17		-
18		-namespace eval ::vc::rcs::parser {
19		- vc::tools::log::system rcs
20		- namesp::* return
21		-}
22		-
23		-proc ::vc::rcs::parser::Log {} {
24		- upvar 1 data data res res
25		- LiteraAPI
26		-
27		-# vc::rcs::parser::process file
28		-#
29		-# Parses the rcs file and returns a dictionary containing the meta
30		-# data. The following keys are used
31		-#
32		-# Key Meaning
33		-# --- -------
34		-# 'head' head revision
35		-# 'branch' ?
36		-# 'symbol' dict (symbol -> revision)
37		-# 'lock' dict (symbol -> revision)
38		-# 'comment' file comment
39		-# 'expand' ?
40		-# 'date' dict (revision -> date)
41		-# 'author' dict (revision -> author)
42		-# 'state' dict (revision -> state)
43		-# 'parent' dict (revision -> parent revision)
44		-# 'commit' dict (revision -> commit message)
45		-#
46		-# The state 'dead' has special meaning, the user should know that.
47		-
48		-# -----------------------------------------------------------------------------
49		-# API Implementation
50		-
51		-proc ::vc::rcs::parser::configure {key value} {
52		- variable cache
53		- switch -exact -- $key {
54		- -cache {
55		- set cache $value
56		- }
57		- default {
58		- return -code error "Unknown switch $key, expected one of -cache"
59		- }
60		- }
61		- return
62		-}
63		-
64		-proc ::vc::rcs::parser::process {path} {
65		- variable cache
66		-
67		- if {!$cache} {
68		- return [Process $path]
69		- }
70		-
71		- set cachefile [Cache $path]
72		- if {
73		- [file exists $cachefile] &&
74		- ([file mtime $cachefile] > [file mtime $path])
75		- } {
76		- # Use preparsed data if not invalidated by changes to the
77		- # archive they are derived from.
78		- write 4 rcs {Load preparsed data block}
79		- return [fileutil::cat -encoding binary $cachefile]
80		- }
81		-
82		- set res [Process $path]
83		-
84		- # Save parse result for quick pickup by future runs.
85		- fileutil::writeFile $cachefile $res
86		-
87		- return $res
88		-}
89		-
90		-# -----------------------------------------------------------------------------
91		-
92		-proc ::vc::rcs::parser::Process {path} {
93		- set data [fileutil::cat -encoding binary $path]
94		- array set res {}
95		- set res(size) [file size $path]
96		- set res(done) 0
97		- set res(nsize) [string length $res(size)]
98		-
99		- Admin
100		- Deltas
101		- Description
102		- DeltaTexts
103		-
104		- # Remove parser state
105		- catch {unset res(id)}
106		- catch {unset res(lastval)}
107		- unset res(size)
108		- unset res(nsize)
109		- unset res(done)
110		-
111		- return [array get res]
112		-}
113		-
114		-proc ::vc::rcs::parser::Cache {path} {
115		- return ${path},,preparsed
116		-}
117		-
118		-# -----------------------------------------------------------------------------
119		-# Internal - Recursive Descent functions implementing the syntax.
120		-
121		-proc ::vc::rcs::parser::Admin {} {
122		- upvar 1 data data res res
123		- Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
124		- return
125		-}
126		-
127		-proc ::vc::rcs::parser::Deltas {} {
128		- upvar 1 data data res res
129		- while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
130		- return
131		-}
132		-
133		-proc ::vc::rcs::parser::Description {} {
134		- upvar 1 data data res res
135		- Literal desc
136		- String 1
137		- Def desc
138		- return
139		-}
140		-
141		-proc ::vc::rcs::parser::DeltaTexts {} {
142		- upvar 1 data data res res
143		- while {[Num 0]} { IsIdent ; Log ; Text }
144		- return
145		-}
146		-
147		-proc ::vc::rcs::parser::Head {} {
148		- upvar 1 data data res res
149		- Literal head ; Num 1 ; Literal \;
150		- Def head
151		- return
152		-}
153		-
154		-proc ::vc::rcs::parser::Branch {} {
155		- upvar 1 data data res res
156		- if {![Literal branch 0]} return ; Num 1 ; Literal \;
157		- Def branch
158		- return
159		-}
160		-
161		-proc ::vc::rcs::parser::Access {} {
162		- upvar 1 data data res res
163		- Literal access ; Literal \;
164		- return
165		-}
166		-
167		-proc ::vc::rcs::parser::Symbols {} {
168		- upvar 1 data data res res
169		- Literal symbols
170		- while {[Ident]} { Num 1 ; Map symbol }
171		- Literal \;
172		- return
173		-}
174		-
175		-proc ::vc::rcs::parser::Locks {} {
176		- upvar 1 data data res res
177		- Literal locks
178		- while {[Ident]} { Num 1 ; Map lock }
179		- Literal \;
180		- return
181		-}
182		-
183		-proc ::vc::rcs::parser::Strict {} {
184		- upvar 1 data data res res
185		- if {![Literal strict 0]} return ; Literal \;
186		- return
187		-}
188		-
189		-proc ::vc::rcs::parser::Comment {} {
190		- upvar 1 data data res res
191		- if {![Literal comment 0]} return ;
192		- if {![String 0]} return ;
193		- Literal \;
194		- Def comment
195		- return
196		-}
197		-
198		-proc ::vc::rcs::parser::Expand {} {
199		- upvar 1 data data res res
200		- if {![Literal expand 0]} return ;
201		- if {![String 0]} return ;
202		- Literal \;
203		- Def expand
204		- return
205		-}
206		-
207		-proc ::vc::rcs::parser::Date {} {
208		- upvar 1 data data res res
209		- Literal date ; Num 1 ; Literal \;
210		-
211		- foreach {yr mo dy h m s} [split $res(lastval) .] break
212		- if {$yr < 100} {incr yr 1900}
213		- set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
214		- Map date
215		- return
216		-}
217		-
218		-proc ::vc::rcs::parser::Author {} {
219		- upvar 1 data data res res
220		- Literal author ; Skip ; Literal \; ; Map author
221		- return
222		-}
223		-
224		-proc ::vc::rcs::parser::State {} {
225		- upvar 1 data data res res
226		- Literal state ; Skip ; Literal \; ; Map state
227		- return
228		-}
229		-
230		-proc ::vc::rcs::parser::Branches {} {
231		- upvar 1 data data res res
232		- Literal branches ; Skip ; Literal \;
233		- return
234		-}
235		-
236		-proc ::vc::rcs::parser::NextRev {} {
237		- upvar 1 data data res res
238		- Literal next ; Skip ; Literal \; ; Map parent
239		- return
240		-}
241		-
242		-proc ::vc::rcs::parser::Log {} {
243		- upvar 1 data data res res
244		- Literal log ; String 1 ; Map commit
245		- return
246		-}
247		-
248		-proc ::vc::rcs::parser::Text {} {
249		- upvar 1 data data res res
250		- Literal text ; String 1
251		- return
252		-}
253		-
254		-# -----------------------------------------------------------------------------
255		-# Internal - Lexicographical commands and data aquisition preparation
256		-
257		-proc ::vc::rcs::parser::Ident {} {
258		- upvar 1 data data res res
259		-
260		- #puts I@?<[string range $data 0 10]...>
261		-
262		- if {[regexp -indices -- {^\s;\s} $data]} {
263		- return 0
264		- } elseif {![regexp -indices -- {^\s([^:])\s:\s} $data match val]} {
265		- return 0
266		- }
267		-
268		- Get $val ; IsIdent
269		- Next
270		- return 1
271		-}
272		-
273		-proc ::vc::rcs::parser::Literal {name {required 1}} {
274		- upvar 1 data data res res
275		- if {![regexp -indices -- "^\\s$name\\s" $data match]} {
276		- if {$required} {
277		- return -code error "Expected '$name' @ '[string range $data 0 30]...'"
278		- }
279		- return 0
280		- }
281		-
282		- Next
283		- return 1
284		-}
285		-
286		-proc ::vc::rcs::parser::String {{required 1}} {
287		- upvar 1 data data res res
288		-
289		- if {![regexp -indices -- {^\s@(([^@](@@)))@\s*} $data match val]} {
290		- if {$required} {
291		- return -code error "Expected string @ '[string range $data 0 30]...'"
292		- }
293		- return 0
294		- }
295		-
296		- Get $val
297		- Next
298		- return 1
299		-}
300		-
301		-proc ::vc::rcs::parser::Num {required} {
302		- upvar 1 data data res res
303		- if {![regexp -indices -- {^\s((\d\|\.)+)\s} $data match val]} {

	--- a/tools/lib/rcsparser.tcl
	+++ b/tools/lib/rcsparser.tcl
	@@ -1,303 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Tool packages. Parsing RCS files.
3	#
4	# Some of the information in RCS files is skipped over, most
5	# importantly the actual delta texts. The users of this parser need
6	# only the meta-data about when revisions were added, the tree
7	# (branching) structure, commit messages.
8	#
9	# The parser is based on Recursive Descent.
10
11	# -----------------------------------------------------------------------------
12	# Requirements
13
14	package require Tcl 8.4
15	package require fileutil ; # Tcllib (cat)
16	package require vc::tools::log ; # User feedback
17
18	namespace eval ::vc::rcs::parser {
19	vc::tools::log::system rcs
20	namesp::* return
21	}
22
23	proc ::vc::rcs::parser::Log {} {
24	upvar 1 data data res res
25	LiteraAPI
26
27	# vc::rcs::parser::process file
28	#
29	# Parses the rcs file and returns a dictionary containing the meta
30	# data. The following keys are used
31	#
32	# Key Meaning
33	# --- -------
34	# 'head' head revision
35	# 'branch' ?
36	# 'symbol' dict (symbol -> revision)
37	# 'lock' dict (symbol -> revision)
38	# 'comment' file comment
39	# 'expand' ?
40	# 'date' dict (revision -> date)
41	# 'author' dict (revision -> author)
42	# 'state' dict (revision -> state)
43	# 'parent' dict (revision -> parent revision)
44	# 'commit' dict (revision -> commit message)
45	#
46	# The state 'dead' has special meaning, the user should know that.
47
48	# -----------------------------------------------------------------------------
49	# API Implementation
50
51	proc ::vc::rcs::parser::configure {key value} {
52	variable cache
53	switch -exact -- $key {
54	-cache {
55	set cache $value
56	}
57	default {
58	return -code error "Unknown switch $key, expected one of -cache"
59	}
60	}
61	return
62	}
63
64	proc ::vc::rcs::parser::process {path} {
65	variable cache
66
67	if {!$cache} {
68	return [Process $path]
69	}
70
71	set cachefile [Cache $path]
72	if {
73	[file exists $cachefile] &&
74	([file mtime $cachefile] > [file mtime $path])
75	} {
76	# Use preparsed data if not invalidated by changes to the
77	# archive they are derived from.
78	write 4 rcs {Load preparsed data block}
79	return [fileutil::cat -encoding binary $cachefile]
80	}
81
82	set res [Process $path]
83
84	# Save parse result for quick pickup by future runs.
85	fileutil::writeFile $cachefile $res
86
87	return $res
88	}
89
90	# -----------------------------------------------------------------------------
91
92	proc ::vc::rcs::parser::Process {path} {
93	set data [fileutil::cat -encoding binary $path]
94	array set res {}
95	set res(size) [file size $path]
96	set res(done) 0
97	set res(nsize) [string length $res(size)]
98
99	Admin
100	Deltas
101	Description
102	DeltaTexts
103
104	# Remove parser state
105	catch {unset res(id)}
106	catch {unset res(lastval)}
107	unset res(size)
108	unset res(nsize)
109	unset res(done)
110
111	return [array get res]
112	}
113
114	proc ::vc::rcs::parser::Cache {path} {
115	return ${path},,preparsed
116	}
117
118	# -----------------------------------------------------------------------------
119	# Internal - Recursive Descent functions implementing the syntax.
120
121	proc ::vc::rcs::parser::Admin {} {
122	upvar 1 data data res res
123	Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
124	return
125	}
126
127	proc ::vc::rcs::parser::Deltas {} {
128	upvar 1 data data res res
129	while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
130	return
131	}
132
133	proc ::vc::rcs::parser::Description {} {
134	upvar 1 data data res res
135	Literal desc
136	String 1
137	Def desc
138	return
139	}
140
141	proc ::vc::rcs::parser::DeltaTexts {} {
142	upvar 1 data data res res
143	while {[Num 0]} { IsIdent ; Log ; Text }
144	return
145	}
146
147	proc ::vc::rcs::parser::Head {} {
148	upvar 1 data data res res
149	Literal head ; Num 1 ; Literal \;
150	Def head
151	return
152	}
153
154	proc ::vc::rcs::parser::Branch {} {
155	upvar 1 data data res res
156	if {![Literal branch 0]} return ; Num 1 ; Literal \;
157	Def branch
158	return
159	}
160
161	proc ::vc::rcs::parser::Access {} {
162	upvar 1 data data res res
163	Literal access ; Literal \;
164	return
165	}
166
167	proc ::vc::rcs::parser::Symbols {} {
168	upvar 1 data data res res
169	Literal symbols
170	while {[Ident]} { Num 1 ; Map symbol }
171	Literal \;
172	return
173	}
174
175	proc ::vc::rcs::parser::Locks {} {
176	upvar 1 data data res res
177	Literal locks
178	while {[Ident]} { Num 1 ; Map lock }
179	Literal \;
180	return
181	}
182
183	proc ::vc::rcs::parser::Strict {} {
184	upvar 1 data data res res
185	if {![Literal strict 0]} return ; Literal \;
186	return
187	}
188
189	proc ::vc::rcs::parser::Comment {} {
190	upvar 1 data data res res
191	if {![Literal comment 0]} return ;
192	if {![String 0]} return ;
193	Literal \;
194	Def comment
195	return
196	}
197
198	proc ::vc::rcs::parser::Expand {} {
199	upvar 1 data data res res
200	if {![Literal expand 0]} return ;
201	if {![String 0]} return ;
202	Literal \;
203	Def expand
204	return
205	}
206
207	proc ::vc::rcs::parser::Date {} {
208	upvar 1 data data res res
209	Literal date ; Num 1 ; Literal \;
210
211	foreach {yr mo dy h m s} [split $res(lastval) .] break
212	if {$yr < 100} {incr yr 1900}
213	set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
214	Map date
215	return
216	}
217
218	proc ::vc::rcs::parser::Author {} {
219	upvar 1 data data res res
220	Literal author ; Skip ; Literal \; ; Map author
221	return
222	}
223
224	proc ::vc::rcs::parser::State {} {
225	upvar 1 data data res res
226	Literal state ; Skip ; Literal \; ; Map state
227	return
228	}
229
230	proc ::vc::rcs::parser::Branches {} {
231	upvar 1 data data res res
232	Literal branches ; Skip ; Literal \;
233	return
234	}
235
236	proc ::vc::rcs::parser::NextRev {} {
237	upvar 1 data data res res
238	Literal next ; Skip ; Literal \; ; Map parent
239	return
240	}
241
242	proc ::vc::rcs::parser::Log {} {
243	upvar 1 data data res res
244	Literal log ; String 1 ; Map commit
245	return
246	}
247
248	proc ::vc::rcs::parser::Text {} {
249	upvar 1 data data res res
250	Literal text ; String 1
251	return
252	}
253
254	# -----------------------------------------------------------------------------
255	# Internal - Lexicographical commands and data aquisition preparation
256
257	proc ::vc::rcs::parser::Ident {} {
258	upvar 1 data data res res
259
260	#puts I@?<[string range $data 0 10]...>
261
262	if {[regexp -indices -- {^\s;\s} $data]} {
263	return 0
264	} elseif {![regexp -indices -- {^\s([^:])\s:\s} $data match val]} {
265	return 0
266	}
267
268	Get $val ; IsIdent
269	Next
270	return 1
271	}
272
273	proc ::vc::rcs::parser::Literal {name {required 1}} {
274	upvar 1 data data res res
275	if {![regexp -indices -- "^\\s$name\\s" $data match]} {
276	if {$required} {
277	return -code error "Expected '$name' @ '[string range $data 0 30]...'"
278	}
279	return 0
280	}
281
282	Next
283	return 1
284	}
285
286	proc ::vc::rcs::parser::String {{required 1}} {
287	upvar 1 data data res res
288
289	if {![regexp -indices -- {^\s@(([^@](@@)))@\s*} $data match val]} {
290	if {$required} {
291	return -code error "Expected string @ '[string range $data 0 30]...'"
292	}
293	return 0
294	}
295
296	Get $val
297	Next
298	return 1
299	}
300
301	proc ::vc::rcs::parser::Num {required} {
302	upvar 1 data data res res
303	if {![regexp -indices -- {^\s((\d\|\.)+)\s} $data match val]} {

	--- a/tools/lib/rcsparser.tcl
	+++ b/tools/lib/rcsparser.tcl
	@@ -1,303 +0,0 @@

D tools/lib/trouble.tcl

-57

		--- a/tools/lib/trouble.tcl
		+++ b/tools/lib/trouble.tcl
		@@ -1,57 +0,0 @@
1		-# -----------------------------------------------------------------------------
2		-# Tool packages. Error reporting.
3		-
4		-# -----------------------------------------------------------------------------
5		-# Requirements
6		-
7		-package require Tcl 8.4
8		-package require vc::tools::log
9		-
10		-namespace eval ::vc::tools::trouble {
11		- ::vc::tools::log::system trouble
12		- namespace import ::vc::tools::log::write
13		-}
14		-
15		-# -----------------------------------------------------------------------------
16		-# API
17		-
18		-# vc::tools::trouble::add message - Report error (shown in general
19		-# log), and remember for re-display at exit.
20		-
21		-# -----------------------------------------------------------------------------
22		-# API Implementation
23		-
24		-proc ::vc::tools::trouble::add {text} {
25		- variable messages
26		- lappend messages $text
27		- write trouble 0 $text
28		- return
29		-}
30		-
31		-# -----------------------------------------------------------------------------
32		-# Internals. Hook into the application exit, show the remembered messages, then
33		-# pass through the regular command.
34		-
35		-rename ::exit vc::tools::trouble::EXIT
36		-proc ::exit {{status 0}} {
37		- variable ::vc::tools::trouble::messages
38		- foreach m $messages {
39		- write trouble 0 $m
40		- }
41		- ::vc::tools::trouble::EXIT $status
42		- # Not reached.
43		- return
44		-}
45		-
46		-namespace eval ::vc::tools::trouble {
47		- # List of the remembered error messages to be shown at exit
48		- variable messages {}
49		-
50		- namespace export add
51		-}
52		-
53		-# -----------------------------------------------------------------------------
54		-# Ready
55		-
56		-package provide vc::tools::trouble 1.0
57		-return

	--- a/tools/lib/trouble.tcl
	+++ b/tools/lib/trouble.tcl
	@@ -1,57 +0,0 @@
1	# -----------------------------------------------------------------------------
2	# Tool packages. Error reporting.
3
4	# -----------------------------------------------------------------------------
5	# Requirements
6
7	package require Tcl 8.4
8	package require vc::tools::log
9
10	namespace eval ::vc::tools::trouble {
11	::vc::tools::log::system trouble
12	namespace import ::vc::tools::log::write
13	}
14
15	# -----------------------------------------------------------------------------
16	# API
17
18	# vc::tools::trouble::add message - Report error (shown in general
19	# log), and remember for re-display at exit.
20
21	# -----------------------------------------------------------------------------
22	# API Implementation
23
24	proc ::vc::tools::trouble::add {text} {
25	variable messages
26	lappend messages $text
27	write trouble 0 $text
28	return
29	}
30
31	# -----------------------------------------------------------------------------
32	# Internals. Hook into the application exit, show the remembered messages, then
33	# pass through the regular command.
34
35	rename ::exit vc::tools::trouble::EXIT
36	proc ::exit {{status 0}} {
37	variable ::vc::tools::trouble::messages
38	foreach m $messages {
39	write trouble 0 $m
40	}
41	::vc::tools::trouble::EXIT $status
42	# Not reached.
43	return
44	}
45
46	namespace eval ::vc::tools::trouble {
47	# List of the remembered error messages to be shown at exit
48	variable messages {}
49
50	namespace export add
51	}
52
53	# -----------------------------------------------------------------------------
54	# Ready
55
56	package provide vc::tools::trouble 1.0
57	return

	--- a/tools/lib/trouble.tcl
	+++ b/tools/lib/trouble.tcl
	@@ -1,57 +0,0 @@

Fossil SCM

Keyboard Shortcuts