|
6b78df3…
|
drh
|
1 |
## -*- tcl -*- |
|
6b78df3…
|
drh
|
2 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
3 |
## Copyright (c) 2008 Andreas Kupries. |
|
6b78df3…
|
drh
|
4 |
# |
|
6b78df3…
|
drh
|
5 |
# This software is licensed as described in the file LICENSE, which |
|
6b78df3…
|
drh
|
6 |
# you should have received as part of this distribution. |
|
6b78df3…
|
drh
|
7 |
# |
|
6b78df3…
|
drh
|
8 |
# This software consists of voluntary contributions made by many |
|
6b78df3…
|
drh
|
9 |
# individuals. For exact contribution history, see the revision |
|
6b78df3…
|
drh
|
10 |
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
6b78df3…
|
drh
|
11 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
12 |
|
|
6b78df3…
|
drh
|
13 |
## Track the state of a cvs workspace as changesets are committed to |
|
6b78df3…
|
drh
|
14 |
## it. Nothing actually happens in the filesystem, this is completely |
|
6b78df3…
|
drh
|
15 |
## virtual. |
|
6b78df3…
|
drh
|
16 |
|
|
6b78df3…
|
drh
|
17 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
18 |
## Requirements |
|
6b78df3…
|
drh
|
19 |
|
|
6b78df3…
|
drh
|
20 |
package require Tcl 8.4 ; # Required runtime. |
|
6b78df3…
|
drh
|
21 |
package require snit ; # OO system. |
|
6b78df3…
|
drh
|
22 |
package require struct::list ; # List assignment |
|
6b78df3…
|
drh
|
23 |
package require vc::tools::log ; # User feedback. |
|
6b78df3…
|
drh
|
24 |
|
|
6b78df3…
|
drh
|
25 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
26 |
## |
|
6b78df3…
|
drh
|
27 |
|
|
6b78df3…
|
drh
|
28 |
snit::type ::vc::fossil::import::cvs::wsstate { |
|
6b78df3…
|
drh
|
29 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
30 |
## Public API |
|
6b78df3…
|
drh
|
31 |
|
|
6b78df3…
|
drh
|
32 |
constructor {lod} { |
|
6b78df3…
|
drh
|
33 |
# Start with an empty state |
|
011fb38…
|
aku
|
34 |
set myname $lod |
|
011fb38…
|
aku
|
35 |
set myticks 0 |
|
011fb38…
|
aku
|
36 |
set myparent {} |
|
6b78df3…
|
drh
|
37 |
return |
|
6b78df3…
|
drh
|
38 |
} |
|
6b78df3…
|
drh
|
39 |
|
|
011fb38…
|
aku
|
40 |
method name {} { return $myname } |
|
011fb38…
|
aku
|
41 |
method ticks {} { return $myticks } |
|
6b78df3…
|
drh
|
42 |
|
|
6b78df3…
|
drh
|
43 |
method add {oprevisioninfo} { |
|
6b78df3…
|
drh
|
44 |
# oprevisioninfo = list (rid path label op ...) /quadruples |
|
6b78df3…
|
drh
|
45 |
|
|
6b78df3…
|
drh
|
46 |
# Overwrite all changed files (identified by path) with the |
|
6b78df3…
|
drh
|
47 |
# new revisions. This keeps all unchanged files. Files marked |
|
6b78df3…
|
drh
|
48 |
# as dead are removed. |
|
6b78df3…
|
drh
|
49 |
|
|
6b78df3…
|
drh
|
50 |
foreach {rid path label rop} $oprevisioninfo { |
|
6b78df3…
|
drh
|
51 |
log write 5 wss {$myop($rop) $label} |
|
6b78df3…
|
drh
|
52 |
|
|
6b78df3…
|
drh
|
53 |
if {$rop < 0} { |
|
a25bafb…
|
aku
|
54 |
if {[catch { |
|
a25bafb…
|
aku
|
55 |
unset mystate($path) |
|
a25bafb…
|
aku
|
56 |
}]} { |
|
a25bafb…
|
aku
|
57 |
log write 0 wss "Removed path \"$path\" is not known to the workspace" |
|
a25bafb…
|
aku
|
58 |
} |
|
6b78df3…
|
drh
|
59 |
} else { |
|
6b78df3…
|
drh
|
60 |
set mystate($path) [list $rid $label] |
|
6b78df3…
|
drh
|
61 |
} |
|
6b78df3…
|
drh
|
62 |
} |
|
011fb38…
|
aku
|
63 |
|
|
011fb38…
|
aku
|
64 |
incr myticks |
|
6b78df3…
|
drh
|
65 |
return |
|
6b78df3…
|
drh
|
66 |
} |
|
6b78df3…
|
drh
|
67 |
|
|
6b78df3…
|
drh
|
68 |
method get {} { |
|
6b78df3…
|
drh
|
69 |
set res {} |
|
6b78df3…
|
drh
|
70 |
foreach path [lsort -dict [array names mystate]] { |
|
6b78df3…
|
drh
|
71 |
struct::list assign $mystate($path) rid label |
|
6b78df3…
|
drh
|
72 |
lappend res $rid $path $label |
|
6b78df3…
|
drh
|
73 |
} |
|
6b78df3…
|
drh
|
74 |
return $res |
|
6b78df3…
|
drh
|
75 |
} |
|
6b78df3…
|
drh
|
76 |
|
|
6b78df3…
|
drh
|
77 |
method defid {id} { |
|
6b78df3…
|
drh
|
78 |
set myid $id |
|
6b78df3…
|
drh
|
79 |
return |
|
6b78df3…
|
drh
|
80 |
} |
|
6b78df3…
|
drh
|
81 |
|
|
6b78df3…
|
drh
|
82 |
method getid {} { return $myid } |
|
6b78df3…
|
drh
|
83 |
|
|
6b78df3…
|
drh
|
84 |
method defstate {s} { array set mystate $s ; return } |
|
6b78df3…
|
drh
|
85 |
method getstate {} { return [array get mystate] } |
|
6b78df3…
|
drh
|
86 |
|
|
011fb38…
|
aku
|
87 |
method parent {} { return $myparent } |
|
011fb38…
|
aku
|
88 |
method defparent {parent} { |
|
011fb38…
|
aku
|
89 |
set myparent $parent |
|
011fb38…
|
aku
|
90 |
return |
|
011fb38…
|
aku
|
91 |
} |
|
011fb38…
|
aku
|
92 |
|
|
6b78df3…
|
drh
|
93 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
94 |
## State |
|
6b78df3…
|
drh
|
95 |
|
|
6b78df3…
|
drh
|
96 |
variable myname {} ; # Name of the LOD the workspace is |
|
6b78df3…
|
drh
|
97 |
# for. |
|
6b78df3…
|
drh
|
98 |
variable myid {} ; # Record id of the fossil manifest |
|
6b78df3…
|
drh
|
99 |
# associated with the current state. |
|
6b78df3…
|
drh
|
100 |
variable mystate -array {} ; # Map from paths to the recordid of |
|
6b78df3…
|
drh
|
101 |
# the file revision behind it, and |
|
6b78df3…
|
drh
|
102 |
# the associated label for logging. |
|
011fb38…
|
aku
|
103 |
variable myticks 0 ; # Number of 'add' operations |
|
011fb38…
|
aku
|
104 |
# performed on the state. |
|
011fb38…
|
aku
|
105 |
variable myparent {} ; # Reference to the parent workspace. |
|
6b78df3…
|
drh
|
106 |
|
|
6b78df3…
|
drh
|
107 |
typevariable myop -array { |
|
6b78df3…
|
drh
|
108 |
-1 REM |
|
6b78df3…
|
drh
|
109 |
0 --- |
|
6b78df3…
|
drh
|
110 |
1 ADD |
|
6b78df3…
|
drh
|
111 |
2 CHG |
|
6b78df3…
|
drh
|
112 |
} |
|
6b78df3…
|
drh
|
113 |
|
|
6b78df3…
|
drh
|
114 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
115 |
## Configuration |
|
6b78df3…
|
drh
|
116 |
|
|
6b78df3…
|
drh
|
117 |
pragma -hastypeinfo no ; # no type introspection |
|
6b78df3…
|
drh
|
118 |
pragma -hasinfo no ; # no object introspection |
|
6b78df3…
|
drh
|
119 |
pragma -hastypemethods no ; # type is not relevant. |
|
6b78df3…
|
drh
|
120 |
|
|
6b78df3…
|
drh
|
121 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
122 |
} |
|
6b78df3…
|
drh
|
123 |
|
|
6b78df3…
|
drh
|
124 |
namespace eval ::vc::fossil::import::cvs { |
|
6b78df3…
|
drh
|
125 |
namespace export wsstate |
|
6b78df3…
|
drh
|
126 |
namespace eval wsstate { |
|
6b78df3…
|
drh
|
127 |
namespace import ::vc::tools::log |
|
6b78df3…
|
drh
|
128 |
log register wss |
|
6b78df3…
|
drh
|
129 |
} |
|
6b78df3…
|
drh
|
130 |
} |
|
6b78df3…
|
drh
|
131 |
|
|
6b78df3…
|
drh
|
132 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
133 |
## Ready |
|
6b78df3…
|
drh
|
134 |
|
|
6b78df3…
|
drh
|
135 |
package provide vc::fossil::import::cvs::wsstate 1.0 |
|
6b78df3…
|
drh
|
136 |
return |