Fossil SCM

Further work on the CVS frontend. The main parts for doing the extraction and management of changesets are now in a separate package.

aku 2007-09-17 07:05 trunk
Commit ae54e928c2726d1ddc5110a3b9a349761d507374
Parent 10e3b3ed76e7302…
3 files changed +85 -212 +138 +1
~ tools/lib/cvs.tcl + tools/lib/cvs_csets.tcl ~ tools/lib/pkgIndex.tcl
M tools/lib/cvs.tcl
+85 -212
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -9,10 +9,11 @@
99
 package require vc::rcs::parser ; # Handling the RCS archive files.
1010
 package require vc::tools::log ; # User feedback
1111
 package require vc::cvs::cmd ; # Access to cvs application.
1212
 package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
1313
 package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
14
+package require vc::cvs::ws::csets ; # Manage the changesets found in the timeline
1415
 package require struct::tree
1516
1617
 namespace eval ::vc::cvs::ws {
1718
 vc::tools::log::system cvs
1819
 namespace import ::vc::tools::log::write
@@ -72,13 +73,13 @@
7273
 proc ::vc::cvs::ws::begin {src} {
7374
 if {![check $src msg]} { return -code error $msg }
7475
7576
 DefBase $src
7677
 MakeTimeline [ScanArchives [files::find [RootPath]]]
78
+ MakeChangesets
7779
7880
 # OLD api calls ... TODO rework for more structure ...
79
- csets ; # Group changes into sets
8081
 rtree ; # Build revision tree (trunk only right now).
8182
8283
 return [MakeWorkspace]
8384
 }
8485
@@ -92,11 +93,10 @@
9293
 # OLD api ... TODO inline
9394
 uplevel 1 [list ::vc::cvs::ws::foreach_cset $cv 0 $script]
9495
 }
9596
9697
 proc ::vc::cvs::ws::ncsets {args} {
97
- variable ncs
9898
 variable ntrunk
9999
100100
 if {[llength $args] > 1} {
101101
 return -code error "wrong#args: Expected ?-import?"
102102
 } elseif {[llength $args] == 1} {
@@ -105,11 +105,11 @@
105105
 } else {
106106
 return $ntrunk
107107
 }
108108
 }
109109
110
- return $ncs
110
+ return [csets::num]
111111
 }
112112
113113
 proc ::vc::cvs::ws::isadmin {path} {
114114
 # Check if path is a CVS admin file.
115115
 if {[string match CVS/* $path]} {return 1}
@@ -116,16 +116,30 @@
116116
 if {[string match */CVS/* $path]} {return 1}
117117
 return 0
118118
 }
119119
120120
 proc ::vc::cvs::ws::checkout {id} {
121
- variable workspace ; cd $workspace
122
- wssetup $id ; # OLD api ... TODO inline
121
+ variable workspace
122
+ cd $workspace
123
+
124
+ array set cs [csets::get $id]
125
+
126
+ write 1 cvs "@ $cs(date)"
127
+ ::foreach l [split [string trim $cs(cmsg)] \n] {
128
+ write 1 cvs "| $l"
129
+ }
130
+
131
+ ::foreach {f r} $cs(removed) { write 2 cvs "R $f $r" ; Remove $f $r }
132
+ ::foreach {f r} $cs(added) { write 2 cvs "A $f $r" ; Checkout $f $r }
133
+ ::foreach {f r} $cs(changed) { write 2 cvs "M $f $r" ; Checkout $f $r }
134
+
135
+ # Provide metadata about the changeset the backend may wish to have
136
+ return [list $cs(author) $cs(date) $cs(cmsg)]
123137
 }
124138
125139
 # -----------------------------------------------------------------------------
126
-# Internals - Old API for now.
140
+# Internals
127141
128142
 proc ::vc::cvs::ws::DefBase {path} {
129143
 variable project
130144
 variable base
131145
@@ -149,13 +163,10 @@
149163
 } else {
150164
 return $base/$project
151165
 }
152166
 }
153167
154
-# Scan repository, collect archives, parse them, and collect revision
155
-# information (file, revision -> date, author, commit message)
156
-
157168
 proc ::vc::cvs::ws::ScanArchives {files} {
158169
 write 0 cvs "Scanning archives ..."
159170
160171
 set d [RootPath]
161172
 set r {}
@@ -196,11 +207,11 @@
196207
 unset auth
197208
 unset cmsg
198209
 unset stat
199210
 }
200211
201
- write 0 cvs "Generated [NSIPL $n entry entries]"
212
+ write 0 cvs "Timeline has [NSIPL $n entry entries]"
202213
 return
203214
 }
204215
205216
 proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
206217
 # A dead-first revision is rev 1.1 with op R. For an example see
@@ -218,10 +229,23 @@
218229
 proc ::vc::cvs::ws::Operation {rev state} {
219230
 if {$state eq "dead"} {return "R"} ; # Removed
220231
 if {$rev eq "1.1"} {return "A"} ; # Added
221232
 return "M" ; # Modified
222233
 }
234
+
235
+proc ::vc::cvs::ws::MakeChangesets {} {
236
+ write 0 cvs "Generating changesets from timeline"
237
+
238
+ csets::init
239
+ timeline::foreach date file revision operation author cmsg {
240
+ csets::add $date $file $revision $operation $author $cmsg
241
+ }
242
+ csets::done
243
+
244
+ write 0 cvs "Found [NSIPL [csets::num] changeset]"
245
+ return
246
+}
223247
224248
 proc ::vc::cvs::ws::MakeWorkspace {} {
225249
 variable project
226250
 variable workspace [fileutil::tempfile importF_cvs_ws_]
227251
@@ -233,57 +257,15 @@
233257
234258
 write 0 cvs "Workspace: $workspace"
235259
 return $w
236260
 }
237261
238
-
239
-# Group single changes into changesets
240
-
241
-proc ::vc::cvs::ws::csets {} {
242
- variable timeline
243
- variable csets
244
- variable ncs
245
- variable cmap
246
-
247
- array unset csets * ; array set csets {}
248
- array unset cmap * ; array set cmap {}
249
- set ncs 0
250
-
251
- write 0 cvs "Generating changesets from timeline"
252
-
253
- CSClear
254
- timeline::foreach date file revision operation author cmsg {
255
- # API adaption
256
- set entry [list $operation $date $author $revision $file $cmsg]
257
-
258
- if {![CSNone] && [CSNew $entry]} {
259
- CSSave
260
- CSClear
261
- }
262
- CSAdd $entry
263
- }
264
-
265
- write 0 cvs "Found [NSIPL [array size csets] changeset]"
266
- return
267
-}
268
-
269
-
270
-namespace eval ::vc::cvs::ws {
271
- # Changeset data:
272
- # ncs: Counter-based id generation
273
- # csets: id -> (user commit start end depth (file -> (op rev)))
274
-
275
- variable ncs ; set ncs 0 ; # Counter for changesets
276
- variable csets ; array set csets {} ; # Changeset data
277
-}
278
-
279262
 # Building the revision tree from the changesets.
280263
 # Limitation: Currently only trunk csets is handled.
281264
 # Limitation: Dead files are not removed, i.e. no 'R' actions right now.
282265
283266
 proc ::vc::cvs::ws::rtree {} {
284
- variable csets
285267
 variable rtree {}
286268
 variable ntrunk 0
287269
288270
 write 0 cvs "Extracting the trunk"
289271
@@ -294,15 +276,14 @@
294276
 set b 0 ; # No branch csets found yet.
295277
296278
 # Extracting the trunk is easy, simply by looking at the involved
297279
 # version numbers.
298280
299
- ::foreach c [lrange [lsort -integer [array names csets]] 1 end] {
300
- ::foreach {u cm s e rd f} $csets($c) break
301
-
281
+ for {set c 1} {$c < [csets::num]} {incr c} {
282
+ array set cs [csets::get $c]
302283
 # Ignore branch changes, just count them for the statistics.
303
- if {$rd != 2} {
284
+ if {$cs(lastd) != 2} {
304285
 incr b
305286
 continue
306287
 }
307288
308289
 # Trunk revision, connect to, and update the head.
@@ -322,78 +303,10 @@
322303
323304
 variable rtree {}
324305
 variable ntrunk 0
325306
 }
326307
327
-proc ::vc::cvs::ws::wssetup {c} {
328
- variable csets
329
- variable base
330
- variable project
331
-
332
- # pwd = workspace
333
-
334
- ::foreach {u cm s e rd fs} $csets($c) break
335
-
336
- write 1 cvs "@ $s"
337
-
338
- ::foreach l [split [string trim $cm] \n] {
339
- write 1 cvs "| $l"
340
- }
341
-
342
- ::foreach {f or} $fs {
343
- ::foreach {op r} $or break
344
- write 2 cvs "$op $f $r"
345
-
346
- if {$op eq "R"} {
347
- # Remove file from workspace. Prune empty directories.
348
- #
349
- # NOTE: A dead-first file (rev 1.1 dead) will never have
350
- # existed.
351
- #
352
- # NOTE: Logically empty directories still physically
353
- # contain the CVS admin directory, hence the check for ==
354
- # 1, not == 0. There might also be hidden files, we count
355
- # them as well. Always hidden are . and .. and they do not
356
- # count as user file.
357
-
358
- file delete $f
359
- set fd [file dirname $f]
360
- if {
361
- ([llength [glob -nocomplain -directory $fd *]] == 1) &&
362
- ([llength [glob -nocomplain -directory -type hidden $fd *]] == 2)
363
- } {
364
- file delete -force $fd
365
- }
366
- } else {
367
- # Added or modified, put the requested version of the file
368
- # into the workspace.
369
-
370
- if {$project ne ""} {set f $project/$f}
371
- if {[catch {
372
- dova -d $base co -r $r $f
373
- } msg]} {
374
- if {[string match {*invalid change text*} $msg]} {
375
- # The archive of the file is corrupted and the
376
- # chosen version not accessible due to that. We
377
- # report the problem, but otherwise ignore it. As
378
- # a consequence the destination repository will not
379
- # contain the full history of the named file. By
380
- # ignoring the problem we however get as much as
381
- # is possible.
382
-
383
- write 0 cvs "EE Corrupted archive file. Inaccessible revision."
384
- continue
385
- }
386
- return -code error $msg
387
- }
388
- }
389
- }
390
-
391
- # Provide metadata about the changeset the backend may wish to have
392
- return [list $u $s $cm]
393
-}
394
-
395308
 proc ::vc::cvs::ws::foreach_cset {cv node script} {
396309
 upvar 1 $cv c
397310
 variable rtree
398311
399312
 set c $node
@@ -421,98 +334,58 @@
421334
 set c [lindex [$rtree children $c] 0]
422335
 }
423336
 return
424337
 }
425338
426
-# -----------------------------------------------------------------------------
427
-# Internal helper commands: Changeset inspection and construction.
428
-
429
-proc ::vc::cvs::ws::CSClear {} {
430
- upvar 1 start start end end cm cm user user files files lastd lastd
431
-
432
- set start {}
433
- set end {}
434
- set cm {}
435
- set user {}
436
- set lastd {}
437
- array unset files *
438
- array set files {}
439
- return
440
-}
441
-
442
-proc ::vc::cvs::ws::CSNone {} {
443
- upvar 1 start start
444
- return [expr {$start eq ""}]
445
-}
446
-
447
-proc ::vc::cvs::ws::CSNew {entry} {
448
- upvar 1 start start end end cm cm user user files files lastd lastd reason reason
449
-
450
- #puts -nonewline stdout . ; flush stdout
451
-
452
- ::foreach {op ts a rev f ecm} $entry break
453
-
454
- # User change
455
- if {$a ne $user} {set reason user ; return 1}
456
-
457
- # File already in current cset
458
- if {[info exists files($f)]} {set reason file ; return 1}
459
-
460
- # Current cset trunk/branch different from entry.
461
- set depth [llength [split $rev .]]
462
- if {($lastd == 2) != ($depth == 2)} {set reason depth/$lastd/$depth/($rev)/$f ; return 1}
463
-
464
- # Commit message changed
465
- if {$cm ne $ecm} {set reason cmsg\ <<$ecm>> ; return 1}
466
-
467
- # Everything is good, still the same cset
468
- return 0
469
-}
470
-
471
-proc ::vc::cvs::ws::CSSave {} {
472
- variable cmap
473
- variable csets
474
- variable ncs
475
- upvar 1 start start end end cm cm user user files files lastd lastd
476
-
477
- set csets($ncs) [list $user $cm $start $end $lastd [array get files]]
478
-
479
- # Record which revisions of a file are in what csets
480
- ::foreach {f or} [array get files] {
481
- ::foreach {_ rev} $or break
482
- set cmap([list $f $rev]) $ncs
483
- }
484
-
485
- #CSDump $ncs
486
-
487
- incr ncs
488
- return
489
-}
490
-
491
-proc ::vc::cvs::ws::CSAdd {entry} {
492
- upvar 1 start start end end cm cm user user files files lastd lastd
493
-
494
- ::foreach {op ts a rev f ecm} $entry break
495
-
496
- if {$start eq ""} {set start $ts}
497
- set end $ts
498
- set cm $ecm
499
- set user $a
500
- set files($f) [list $op $rev]
501
- set lastd [llength [split $rev .]]
502
- return
503
-}
504
-
505
-proc ::vc::cvs::ws::CSDump {c} {
506
- variable csets
507
- ::foreach {u cm s e rd f} $csets($c) break
508
-
509
- puts "$u $s"; regsub -all {.} $u { } b
510
- puts "$b $e"
511
- ::foreach {f or} $f {
512
- ::foreach {o r} $or break
513
- puts "$b $o $f $r"
339
+proc ::vc::cvs::ws::Checkout {f r} {
340
+ variable base
341
+ variable project
342
+
343
+ # Added or modified, put the requested version of the file into
344
+ # the workspace.
345
+
346
+ if {$project ne ""} {set f $project/$f}
347
+ if {[catch {
348
+ dova -d $base co -r $r $f
349
+ } msg]} {
350
+ if {[string match {*invalid change text*} $msg]} {
351
+
352
+ # The archive of the file is corrupted and the chosen
353
+ # version not accessible due to that. We report the
354
+ # problem, but otherwise ignore it. As a consequence the
355
+ # destination repository will not contain the full history
356
+ # of the named file. By ignoring the problem we however
357
+ # get as much as is possible.
358
+
359
+ write 0 cvs "EE Corrupted archive file. Inaccessible revision."
360
+ return
361
+ }
362
+ return -code error $msg
363
+ }
364
+ return
365
+}
366
+
367
+proc ::vc::cvs::ws::Remove {f r} {
368
+ # Remove file from workspace. Prune empty directories.
369
+ # NOTE: A dead-first file (rev 1.1 dead) will never have existed.
370
+
371
+ file delete $f
372
+ Prune [file dirname $f]
373
+ return
374
+}
375
+
376
+proc ::vc::cvs::ws::Prune {path} {
377
+ # NOTE: Logically empty directories still physically contain the
378
+ # CVS admin directory, hence the check for == 1, not == 0. There
379
+ # might also be hidden files, we count them as well. Always hidden
380
+ # are . and .. and they do not count as user file.
381
+
382
+ if {
383
+ ([llength [glob -nocomplain -directory $path *]] == 1) &&
384
+ ([llength [glob -nocomplain -directory -type hidden $path *]] == 2)
385
+ } {
386
+ file delete -force $path
514387
 }
515388
 return
516389
 }
517390
518391
 proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
519392
520393
ADDED tools/lib/cvs_csets.tcl
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -9,10 +9,11 @@
9 package require vc::rcs::parser ; # Handling the RCS archive files.
10 package require vc::tools::log ; # User feedback
11 package require vc::cvs::cmd ; # Access to cvs application.
12 package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
13 package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
 
14 package require struct::tree
15
16 namespace eval ::vc::cvs::ws {
17 vc::tools::log::system cvs
18 namespace import ::vc::tools::log::write
@@ -72,13 +73,13 @@
72 proc ::vc::cvs::ws::begin {src} {
73 if {![check $src msg]} { return -code error $msg }
74
75 DefBase $src
76 MakeTimeline [ScanArchives [files::find [RootPath]]]
 
77
78 # OLD api calls ... TODO rework for more structure ...
79 csets ; # Group changes into sets
80 rtree ; # Build revision tree (trunk only right now).
81
82 return [MakeWorkspace]
83 }
84
@@ -92,11 +93,10 @@
92 # OLD api ... TODO inline
93 uplevel 1 [list ::vc::cvs::ws::foreach_cset $cv 0 $script]
94 }
95
96 proc ::vc::cvs::ws::ncsets {args} {
97 variable ncs
98 variable ntrunk
99
100 if {[llength $args] > 1} {
101 return -code error "wrong#args: Expected ?-import?"
102 } elseif {[llength $args] == 1} {
@@ -105,11 +105,11 @@
105 } else {
106 return $ntrunk
107 }
108 }
109
110 return $ncs
111 }
112
113 proc ::vc::cvs::ws::isadmin {path} {
114 # Check if path is a CVS admin file.
115 if {[string match CVS/* $path]} {return 1}
@@ -116,16 +116,30 @@
116 if {[string match */CVS/* $path]} {return 1}
117 return 0
118 }
119
120 proc ::vc::cvs::ws::checkout {id} {
121 variable workspace ; cd $workspace
122 wssetup $id ; # OLD api ... TODO inline
 
 
 
 
 
 
 
 
 
 
 
 
 
 
123 }
124
125 # -----------------------------------------------------------------------------
126 # Internals - Old API for now.
127
128 proc ::vc::cvs::ws::DefBase {path} {
129 variable project
130 variable base
131
@@ -149,13 +163,10 @@
149 } else {
150 return $base/$project
151 }
152 }
153
154 # Scan repository, collect archives, parse them, and collect revision
155 # information (file, revision -> date, author, commit message)
156
157 proc ::vc::cvs::ws::ScanArchives {files} {
158 write 0 cvs "Scanning archives ..."
159
160 set d [RootPath]
161 set r {}
@@ -196,11 +207,11 @@
196 unset auth
197 unset cmsg
198 unset stat
199 }
200
201 write 0 cvs "Generated [NSIPL $n entry entries]"
202 return
203 }
204
205 proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
206 # A dead-first revision is rev 1.1 with op R. For an example see
@@ -218,10 +229,23 @@
218 proc ::vc::cvs::ws::Operation {rev state} {
219 if {$state eq "dead"} {return "R"} ; # Removed
220 if {$rev eq "1.1"} {return "A"} ; # Added
221 return "M" ; # Modified
222 }
 
 
 
 
 
 
 
 
 
 
 
 
 
223
224 proc ::vc::cvs::ws::MakeWorkspace {} {
225 variable project
226 variable workspace [fileutil::tempfile importF_cvs_ws_]
227
@@ -233,57 +257,15 @@
233
234 write 0 cvs "Workspace: $workspace"
235 return $w
236 }
237
238
239 # Group single changes into changesets
240
241 proc ::vc::cvs::ws::csets {} {
242 variable timeline
243 variable csets
244 variable ncs
245 variable cmap
246
247 array unset csets * ; array set csets {}
248 array unset cmap * ; array set cmap {}
249 set ncs 0
250
251 write 0 cvs "Generating changesets from timeline"
252
253 CSClear
254 timeline::foreach date file revision operation author cmsg {
255 # API adaption
256 set entry [list $operation $date $author $revision $file $cmsg]
257
258 if {![CSNone] && [CSNew $entry]} {
259 CSSave
260 CSClear
261 }
262 CSAdd $entry
263 }
264
265 write 0 cvs "Found [NSIPL [array size csets] changeset]"
266 return
267 }
268
269
270 namespace eval ::vc::cvs::ws {
271 # Changeset data:
272 # ncs: Counter-based id generation
273 # csets: id -> (user commit start end depth (file -> (op rev)))
274
275 variable ncs ; set ncs 0 ; # Counter for changesets
276 variable csets ; array set csets {} ; # Changeset data
277 }
278
279 # Building the revision tree from the changesets.
280 # Limitation: Currently only trunk csets is handled.
281 # Limitation: Dead files are not removed, i.e. no 'R' actions right now.
282
283 proc ::vc::cvs::ws::rtree {} {
284 variable csets
285 variable rtree {}
286 variable ntrunk 0
287
288 write 0 cvs "Extracting the trunk"
289
@@ -294,15 +276,14 @@
294 set b 0 ; # No branch csets found yet.
295
296 # Extracting the trunk is easy, simply by looking at the involved
297 # version numbers.
298
299 ::foreach c [lrange [lsort -integer [array names csets]] 1 end] {
300 ::foreach {u cm s e rd f} $csets($c) break
301
302 # Ignore branch changes, just count them for the statistics.
303 if {$rd != 2} {
304 incr b
305 continue
306 }
307
308 # Trunk revision, connect to, and update the head.
@@ -322,78 +303,10 @@
322
323 variable rtree {}
324 variable ntrunk 0
325 }
326
327 proc ::vc::cvs::ws::wssetup {c} {
328 variable csets
329 variable base
330 variable project
331
332 # pwd = workspace
333
334 ::foreach {u cm s e rd fs} $csets($c) break
335
336 write 1 cvs "@ $s"
337
338 ::foreach l [split [string trim $cm] \n] {
339 write 1 cvs "| $l"
340 }
341
342 ::foreach {f or} $fs {
343 ::foreach {op r} $or break
344 write 2 cvs "$op $f $r"
345
346 if {$op eq "R"} {
347 # Remove file from workspace. Prune empty directories.
348 #
349 # NOTE: A dead-first file (rev 1.1 dead) will never have
350 # existed.
351 #
352 # NOTE: Logically empty directories still physically
353 # contain the CVS admin directory, hence the check for ==
354 # 1, not == 0. There might also be hidden files, we count
355 # them as well. Always hidden are . and .. and they do not
356 # count as user file.
357
358 file delete $f
359 set fd [file dirname $f]
360 if {
361 ([llength [glob -nocomplain -directory $fd *]] == 1) &&
362 ([llength [glob -nocomplain -directory -type hidden $fd *]] == 2)
363 } {
364 file delete -force $fd
365 }
366 } else {
367 # Added or modified, put the requested version of the file
368 # into the workspace.
369
370 if {$project ne ""} {set f $project/$f}
371 if {[catch {
372 dova -d $base co -r $r $f
373 } msg]} {
374 if {[string match {*invalid change text*} $msg]} {
375 # The archive of the file is corrupted and the
376 # chosen version not accessible due to that. We
377 # report the problem, but otherwise ignore it. As
378 # a consequence the destination repository will not
379 # contain the full history of the named file. By
380 # ignoring the problem we however get as much as
381 # is possible.
382
383 write 0 cvs "EE Corrupted archive file. Inaccessible revision."
384 continue
385 }
386 return -code error $msg
387 }
388 }
389 }
390
391 # Provide metadata about the changeset the backend may wish to have
392 return [list $u $s $cm]
393 }
394
395 proc ::vc::cvs::ws::foreach_cset {cv node script} {
396 upvar 1 $cv c
397 variable rtree
398
399 set c $node
@@ -421,98 +334,58 @@
421 set c [lindex [$rtree children $c] 0]
422 }
423 return
424 }
425
426 # -----------------------------------------------------------------------------
427 # Internal helper commands: Changeset inspection and construction.
428
429 proc ::vc::cvs::ws::CSClear {} {
430 upvar 1 start start end end cm cm user user files files lastd lastd
431
432 set start {}
433 set end {}
434 set cm {}
435 set user {}
436 set lastd {}
437 array unset files *
438 array set files {}
439 return
440 }
441
442 proc ::vc::cvs::ws::CSNone {} {
443 upvar 1 start start
444 return [expr {$start eq ""}]
445 }
446
447 proc ::vc::cvs::ws::CSNew {entry} {
448 upvar 1 start start end end cm cm user user files files lastd lastd reason reason
449
450 #puts -nonewline stdout . ; flush stdout
451
452 ::foreach {op ts a rev f ecm} $entry break
453
454 # User change
455 if {$a ne $user} {set reason user ; return 1}
456
457 # File already in current cset
458 if {[info exists files($f)]} {set reason file ; return 1}
459
460 # Current cset trunk/branch different from entry.
461 set depth [llength [split $rev .]]
462 if {($lastd == 2) != ($depth == 2)} {set reason depth/$lastd/$depth/($rev)/$f ; return 1}
463
464 # Commit message changed
465 if {$cm ne $ecm} {set reason cmsg\ <<$ecm>> ; return 1}
466
467 # Everything is good, still the same cset
468 return 0
469 }
470
471 proc ::vc::cvs::ws::CSSave {} {
472 variable cmap
473 variable csets
474 variable ncs
475 upvar 1 start start end end cm cm user user files files lastd lastd
476
477 set csets($ncs) [list $user $cm $start $end $lastd [array get files]]
478
479 # Record which revisions of a file are in what csets
480 ::foreach {f or} [array get files] {
481 ::foreach {_ rev} $or break
482 set cmap([list $f $rev]) $ncs
483 }
484
485 #CSDump $ncs
486
487 incr ncs
488 return
489 }
490
491 proc ::vc::cvs::ws::CSAdd {entry} {
492 upvar 1 start start end end cm cm user user files files lastd lastd
493
494 ::foreach {op ts a rev f ecm} $entry break
495
496 if {$start eq ""} {set start $ts}
497 set end $ts
498 set cm $ecm
499 set user $a
500 set files($f) [list $op $rev]
501 set lastd [llength [split $rev .]]
502 return
503 }
504
505 proc ::vc::cvs::ws::CSDump {c} {
506 variable csets
507 ::foreach {u cm s e rd f} $csets($c) break
508
509 puts "$u $s"; regsub -all {.} $u { } b
510 puts "$b $e"
511 ::foreach {f or} $f {
512 ::foreach {o r} $or break
513 puts "$b $o $f $r"
514 }
515 return
516 }
517
518 proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
519
520 DDED tools/lib/cvs_csets.tcl
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -9,10 +9,11 @@
9 package require vc::rcs::parser ; # Handling the RCS archive files.
10 package require vc::tools::log ; # User feedback
11 package require vc::cvs::cmd ; # Access to cvs application.
12 package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
13 package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
14 package require vc::cvs::ws::csets ; # Manage the changesets found in the timeline
15 package require struct::tree
16
17 namespace eval ::vc::cvs::ws {
18 vc::tools::log::system cvs
19 namespace import ::vc::tools::log::write
@@ -72,13 +73,13 @@
73 proc ::vc::cvs::ws::begin {src} {
74 if {![check $src msg]} { return -code error $msg }
75
76 DefBase $src
77 MakeTimeline [ScanArchives [files::find [RootPath]]]
78 MakeChangesets
79
80 # OLD api calls ... TODO rework for more structure ...
 
81 rtree ; # Build revision tree (trunk only right now).
82
83 return [MakeWorkspace]
84 }
85
@@ -92,11 +93,10 @@
93 # OLD api ... TODO inline
94 uplevel 1 [list ::vc::cvs::ws::foreach_cset $cv 0 $script]
95 }
96
97 proc ::vc::cvs::ws::ncsets {args} {
 
98 variable ntrunk
99
100 if {[llength $args] > 1} {
101 return -code error "wrong#args: Expected ?-import?"
102 } elseif {[llength $args] == 1} {
@@ -105,11 +105,11 @@
105 } else {
106 return $ntrunk
107 }
108 }
109
110 return [csets::num]
111 }
112
113 proc ::vc::cvs::ws::isadmin {path} {
114 # Check if path is a CVS admin file.
115 if {[string match CVS/* $path]} {return 1}
@@ -116,16 +116,30 @@
116 if {[string match */CVS/* $path]} {return 1}
117 return 0
118 }
119
120 proc ::vc::cvs::ws::checkout {id} {
121 variable workspace
122 cd $workspace
123
124 array set cs [csets::get $id]
125
126 write 1 cvs "@ $cs(date)"
127 ::foreach l [split [string trim $cs(cmsg)] \n] {
128 write 1 cvs "| $l"
129 }
130
131 ::foreach {f r} $cs(removed) { write 2 cvs "R $f $r" ; Remove $f $r }
132 ::foreach {f r} $cs(added) { write 2 cvs "A $f $r" ; Checkout $f $r }
133 ::foreach {f r} $cs(changed) { write 2 cvs "M $f $r" ; Checkout $f $r }
134
135 # Provide metadata about the changeset the backend may wish to have
136 return [list $cs(author) $cs(date) $cs(cmsg)]
137 }
138
139 # -----------------------------------------------------------------------------
140 # Internals
141
142 proc ::vc::cvs::ws::DefBase {path} {
143 variable project
144 variable base
145
@@ -149,13 +163,10 @@
163 } else {
164 return $base/$project
165 }
166 }
167
 
 
 
168 proc ::vc::cvs::ws::ScanArchives {files} {
169 write 0 cvs "Scanning archives ..."
170
171 set d [RootPath]
172 set r {}
@@ -196,11 +207,11 @@
207 unset auth
208 unset cmsg
209 unset stat
210 }
211
212 write 0 cvs "Timeline has [NSIPL $n entry entries]"
213 return
214 }
215
216 proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} {
217 # A dead-first revision is rev 1.1 with op R. For an example see
@@ -218,10 +229,23 @@
229 proc ::vc::cvs::ws::Operation {rev state} {
230 if {$state eq "dead"} {return "R"} ; # Removed
231 if {$rev eq "1.1"} {return "A"} ; # Added
232 return "M" ; # Modified
233 }
234
235 proc ::vc::cvs::ws::MakeChangesets {} {
236 write 0 cvs "Generating changesets from timeline"
237
238 csets::init
239 timeline::foreach date file revision operation author cmsg {
240 csets::add $date $file $revision $operation $author $cmsg
241 }
242 csets::done
243
244 write 0 cvs "Found [NSIPL [csets::num] changeset]"
245 return
246 }
247
248 proc ::vc::cvs::ws::MakeWorkspace {} {
249 variable project
250 variable workspace [fileutil::tempfile importF_cvs_ws_]
251
@@ -233,57 +257,15 @@
257
258 write 0 cvs "Workspace: $workspace"
259 return $w
260 }
261
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
262 # Building the revision tree from the changesets.
263 # Limitation: Currently only trunk csets is handled.
264 # Limitation: Dead files are not removed, i.e. no 'R' actions right now.
265
266 proc ::vc::cvs::ws::rtree {} {
 
267 variable rtree {}
268 variable ntrunk 0
269
270 write 0 cvs "Extracting the trunk"
271
@@ -294,15 +276,14 @@
276 set b 0 ; # No branch csets found yet.
277
278 # Extracting the trunk is easy, simply by looking at the involved
279 # version numbers.
280
281 for {set c 1} {$c < [csets::num]} {incr c} {
282 array set cs [csets::get $c]
 
283 # Ignore branch changes, just count them for the statistics.
284 if {$cs(lastd) != 2} {
285 incr b
286 continue
287 }
288
289 # Trunk revision, connect to, and update the head.
@@ -322,78 +303,10 @@
303
304 variable rtree {}
305 variable ntrunk 0
306 }
307
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
308 proc ::vc::cvs::ws::foreach_cset {cv node script} {
309 upvar 1 $cv c
310 variable rtree
311
312 set c $node
@@ -421,98 +334,58 @@
334 set c [lindex [$rtree children $c] 0]
335 }
336 return
337 }
338
339 proc ::vc::cvs::ws::Checkout {f r} {
340 variable base
341 variable project
342
343 # Added or modified, put the requested version of the file into
344 # the workspace.
345
346 if {$project ne ""} {set f $project/$f}
347 if {[catch {
348 dova -d $base co -r $r $f
349 } msg]} {
350 if {[string match {*invalid change text*} $msg]} {
351
352 # The archive of the file is corrupted and the chosen
353 # version not accessible due to that. We report the
354 # problem, but otherwise ignore it. As a consequence the
355 # destination repository will not contain the full history
356 # of the named file. By ignoring the problem we however
357 # get as much as is possible.
358
359 write 0 cvs "EE Corrupted archive file. Inaccessible revision."
360 return
361 }
362 return -code error $msg
363 }
364 return
365 }
366
367 proc ::vc::cvs::ws::Remove {f r} {
368 # Remove file from workspace. Prune empty directories.
369 # NOTE: A dead-first file (rev 1.1 dead) will never have existed.
370
371 file delete $f
372 Prune [file dirname $f]
373 return
374 }
375
376 proc ::vc::cvs::ws::Prune {path} {
377 # NOTE: Logically empty directories still physically contain the
378 # CVS admin directory, hence the check for == 1, not == 0. There
379 # might also be hidden files, we count them as well. Always hidden
380 # are . and .. and they do not count as user file.
381
382 if {
383 ([llength [glob -nocomplain -directory $path *]] == 1) &&
384 ([llength [glob -nocomplain -directory -type hidden $path *]] == 2)
385 } {
386 file delete -force $path
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
387 }
388 return
389 }
390
391 proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} {
392
393 DDED tools/lib/cvs_csets.tcl
A tools/lib/cvs_csets.tcl
+138
--- a/tools/lib/cvs_csets.tcl
+++ b/tools/lib/cvs_csets.tcl
@@ -0,0 +1,138 @@
1
+# -----------------------------------------------------------------------------
2
+# Repository management (CVS), Changeset grouping and storage.
3
+
4
+# -----------------------------------------------------------------------------
5
+# Requirements
6
+
7
+package require Tcl 8.4
8
+
9
+namespace eval ::vc::
10
+# -----------------------------------------------------------------------------
11
+# API---------------------
12
+# API
13
+
14
+# vc::cvs::ws::csets::init - Initialize accumulator
15
+# vc::cvs::ws::csets::add - Add timeline entry to accumulor, may generate new cset
16
+# vc::cvs::ws::csets::done - Complete cset generation.
17
+#
18
+# vc::cvs::ws::csets::get id - Get data of a cset.
19
+# vc::cvs::ws::csets::num - Get number of csets.
20
+
21
+# -----------------------------------------------------------------------------
22
+# API Implementation
23
+
24
+proc ::vc::cvs::ws::csets::init {} {
25
+ Current::Clear
26
+ return
27
+}
28
+
29
+proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
30
+ if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
31
+ Save [Current::Complete]
32
+ }
33
+ Current::Add $date $file $revision $operation $author $cmsg
34
+ return
35
+}
36
+
37
+proc ::vc::cvs::ws::csets::done {} {
38
+ if {![Current::Empty]} {
39
+ Save [Current::Complete]
40
+ }
41
+ return
42
+}
43
+
44
+proc ::vc::cvs::ws::csets::getproc ::vc::cvs::ws::csets::num {# -------------------------} {
45
+ variable csets
46
+ return [array size csets]
47
+}
48
+
49
+proc ::vc::cvs::ws::csets::# -----------------------------------------------------------------------------
50
+# ::cvs::ws::csets::num - Get number of csets.
51
+
52
+# -----------------------------------------------------------------------------
53
+# API Implementation
54
+
55
+proc ::vc::cvs::ws::csets::init {} {
56
+ variable ncs 0
57
+ Current::Clear
58
+ return
59
+}
60
+
61
+proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
62
+ if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
63
+ Save [Current::Complete]
64
+ }
65
+ Current::Add $date $file $revision $operation $author $cmsg
66
+ return
67
+}
68
+
69
+proc ::vc::cvs::ws::csets::done {} {
70
+ if {![Current::Empty]} {
71
+ Save [Current::Complete]
72
+ }
73
+ return
74
+}
75
+
76
+proc ::vc::cvs::ws::csets::get {id} {
77
+ variable csets
78
+ return $csets($id)
79
+}
80
+
81
+
82
+proc ::vc::cvs::ws::csets::DUMP {id} {
83
+ puts /${id}/_________________
84
+ array set cs [get $id]
85
+ parray cs
86
+ return
87
+}
88
+
89
+proc ::vc::cvs::ws::csets::num {} {
90
+ variable csets
91
+ return [array size csets]
92
+}
93
+
94
+proc ::vc::cvs::ws::csets::isTrunk {id} {
95
+ variable csets
96
+ array set cs $csets($id)
97
+ return [expr {$cs(lastd) == 2}]
98
+}
99
+
100
+proc ::vc::cvs::ws::csets::setParentOf {id parent} {
101
+ variable csets
102
+ lappend csets($id) parent $parent
103
+
104
+ array set cs $csets($id)
105
+ sig::def $id $parent $cs(added) $cs(changed) $cs(removed)
106
+ return
107
+}
108
+
109
+proc ::vc::cvs::ws::csets::parentOf {id} {
110
+ variable csets
111
+ array set cs $csets($id)
112
+ return $cs(parent)
113
+}
114
+
115
+proc ::vc::cvs::ws::csets::sameBranch {id parent tag} {
116
+ variable csets
117
+ array set cs $csets($id)
118
+ return [sig::next $parent $cs(added) $cs(changed) $cs(removed) $tag $cs(date)]
119
+}
120
+
121
+# -----------------------------------------------------------------------------
122
+# Internal helper commands: Changeset inspection and construction.
123
+
124
+proc ::vc::cvs::ws::csets::Save {data} {
125
+ variable csets
126
+ variable ncs
127
+
128
+ set csets($ncs) $data
129
+ incr ncs
130
+ return
131
+}
132
+
133
+proc ::vc::cvs::ws::csets::Current::Clear {} {
134
+ variable star
135
+}
136
+
137
+# -----------------------------------------------------------------------------
138
+# Re
--- a/tools/lib/cvs_csets.tcl
+++ b/tools/lib/cvs_csets.tcl
@@ -0,0 +1,138 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/lib/cvs_csets.tcl
+++ b/tools/lib/cvs_csets.tcl
@@ -0,0 +1,138 @@
1 # -----------------------------------------------------------------------------
2 # Repository management (CVS), Changeset grouping and storage.
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8
9 namespace eval ::vc::
10 # -----------------------------------------------------------------------------
11 # API---------------------
12 # API
13
14 # vc::cvs::ws::csets::init - Initialize accumulator
15 # vc::cvs::ws::csets::add - Add timeline entry to accumulor, may generate new cset
16 # vc::cvs::ws::csets::done - Complete cset generation.
17 #
18 # vc::cvs::ws::csets::get id - Get data of a cset.
19 # vc::cvs::ws::csets::num - Get number of csets.
20
21 # -----------------------------------------------------------------------------
22 # API Implementation
23
24 proc ::vc::cvs::ws::csets::init {} {
25 Current::Clear
26 return
27 }
28
29 proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
30 if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
31 Save [Current::Complete]
32 }
33 Current::Add $date $file $revision $operation $author $cmsg
34 return
35 }
36
37 proc ::vc::cvs::ws::csets::done {} {
38 if {![Current::Empty]} {
39 Save [Current::Complete]
40 }
41 return
42 }
43
44 proc ::vc::cvs::ws::csets::getproc ::vc::cvs::ws::csets::num {# -------------------------} {
45 variable csets
46 return [array size csets]
47 }
48
49 proc ::vc::cvs::ws::csets::# -----------------------------------------------------------------------------
50 # ::cvs::ws::csets::num - Get number of csets.
51
52 # -----------------------------------------------------------------------------
53 # API Implementation
54
55 proc ::vc::cvs::ws::csets::init {} {
56 variable ncs 0
57 Current::Clear
58 return
59 }
60
61 proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
62 if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
63 Save [Current::Complete]
64 }
65 Current::Add $date $file $revision $operation $author $cmsg
66 return
67 }
68
69 proc ::vc::cvs::ws::csets::done {} {
70 if {![Current::Empty]} {
71 Save [Current::Complete]
72 }
73 return
74 }
75
76 proc ::vc::cvs::ws::csets::get {id} {
77 variable csets
78 return $csets($id)
79 }
80
81
82 proc ::vc::cvs::ws::csets::DUMP {id} {
83 puts /${id}/_________________
84 array set cs [get $id]
85 parray cs
86 return
87 }
88
89 proc ::vc::cvs::ws::csets::num {} {
90 variable csets
91 return [array size csets]
92 }
93
94 proc ::vc::cvs::ws::csets::isTrunk {id} {
95 variable csets
96 array set cs $csets($id)
97 return [expr {$cs(lastd) == 2}]
98 }
99
100 proc ::vc::cvs::ws::csets::setParentOf {id parent} {
101 variable csets
102 lappend csets($id) parent $parent
103
104 array set cs $csets($id)
105 sig::def $id $parent $cs(added) $cs(changed) $cs(removed)
106 return
107 }
108
109 proc ::vc::cvs::ws::csets::parentOf {id} {
110 variable csets
111 array set cs $csets($id)
112 return $cs(parent)
113 }
114
115 proc ::vc::cvs::ws::csets::sameBranch {id parent tag} {
116 variable csets
117 array set cs $csets($id)
118 return [sig::next $parent $cs(added) $cs(changed) $cs(removed) $tag $cs(date)]
119 }
120
121 # -----------------------------------------------------------------------------
122 # Internal helper commands: Changeset inspection and construction.
123
124 proc ::vc::cvs::ws::csets::Save {data} {
125 variable csets
126 variable ncs
127
128 set csets($ncs) $data
129 incr ncs
130 return
131 }
132
133 proc ::vc::cvs::ws::csets::Current::Clear {} {
134 variable star
135 }
136
137 # -----------------------------------------------------------------------------
138 # Re
M tools/lib/pkgIndex.tcl
+1
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -2,10 +2,11 @@
22
 package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
33
 package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
44
 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
55
 package ifneeded vc::cvs::ws::files 1.0 [list source [file join $dir cvs_files.tcl]]
66
 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]]
78
 package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
89
 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
910
 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
1011
 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
1112
 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
1213
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -2,10 +2,11 @@
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::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
8 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
9 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
10 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
11 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
12
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -2,10 +2,11 @@
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::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
9 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
10 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
11 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
12 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
13

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button