|
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 revision import. Essentially maps lines of |
|
6b78df3…
|
drh
|
14 |
## developments to their workspace state. |
|
6b78df3…
|
drh
|
15 |
|
|
6b78df3…
|
drh
|
16 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
17 |
## Requirements |
|
6b78df3…
|
drh
|
18 |
|
|
6b78df3…
|
drh
|
19 |
package require Tcl 8.4 ; # Required runtime. |
|
6b78df3…
|
drh
|
20 |
package require snit ; # OO system. |
|
6b78df3…
|
drh
|
21 |
package require struct::list ; # List assignment |
|
6b78df3…
|
drh
|
22 |
package require vc::fossil::import::cvs::wsstate ; # Workspace state |
|
6b78df3…
|
drh
|
23 |
package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
|
6b78df3…
|
drh
|
24 |
package require vc::tools::log ; # User feedback. |
|
6b78df3…
|
drh
|
25 |
package require vc::tools::trouble ; # Error reporting. |
|
6b78df3…
|
drh
|
26 |
|
|
6b78df3…
|
drh
|
27 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
28 |
## |
|
6b78df3…
|
drh
|
29 |
|
|
6b78df3…
|
drh
|
30 |
snit::type ::vc::fossil::import::cvs::ristate { |
|
6b78df3…
|
drh
|
31 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
32 |
## Public API |
|
6b78df3…
|
drh
|
33 |
|
|
6b78df3…
|
drh
|
34 |
constructor {} { |
|
6b78df3…
|
drh
|
35 |
# Start with an empty state |
|
6b78df3…
|
drh
|
36 |
return |
|
6b78df3…
|
drh
|
37 |
} |
|
6b78df3…
|
drh
|
38 |
|
|
6b78df3…
|
drh
|
39 |
method new {lod {parentlod {}}} { |
|
300f312…
|
aku
|
40 |
# Create a workspace for a line of development (LOD). If a |
|
300f312…
|
aku
|
41 |
# parent LOD is specified let the new workspace inherit the |
|
300f312…
|
aku
|
42 |
# current state of the parent. |
|
6b78df3…
|
drh
|
43 |
|
|
300f312…
|
aku
|
44 |
log write 8 ristate {Open workspace for LOD "$lod"} |
|
6b78df3…
|
drh
|
45 |
|
|
6b78df3…
|
drh
|
46 |
integrity assert { |
|
6b78df3…
|
drh
|
47 |
![info exists mystate($lod)] |
|
6b78df3…
|
drh
|
48 |
} {Trying to override existing state for lod "$lod"} |
|
6b78df3…
|
drh
|
49 |
|
|
6b78df3…
|
drh
|
50 |
set wss [wsstate ${selfns}::%AUTO% $lod] |
|
6b78df3…
|
drh
|
51 |
set mystate($lod) $wss |
|
6b78df3…
|
drh
|
52 |
|
|
6b78df3…
|
drh
|
53 |
if {$parentlod ne ""} { |
|
300f312…
|
aku
|
54 |
log write 8 ristate {Inheriting from workspace for LOD "$parentlod"} |
|
6b78df3…
|
drh
|
55 |
|
|
6b78df3…
|
drh
|
56 |
integrity assert { |
|
6b78df3…
|
drh
|
57 |
[info exists mystate($parentlod)] |
|
6b78df3…
|
drh
|
58 |
} {Trying to inherit from undefined lod "$parentlod"} |
|
6b78df3…
|
drh
|
59 |
|
|
6b78df3…
|
drh
|
60 |
set pwss $mystate($parentlod) |
|
6b78df3…
|
drh
|
61 |
|
|
011fb38…
|
aku
|
62 |
$wss defstate [$pwss getstate] |
|
011fb38…
|
aku
|
63 |
$wss defid [$pwss getid] |
|
011fb38…
|
aku
|
64 |
$wss defparent $pwss |
|
6b78df3…
|
drh
|
65 |
} |
|
6b78df3…
|
drh
|
66 |
|
|
6b78df3…
|
drh
|
67 |
return $wss |
|
6b78df3…
|
drh
|
68 |
} |
|
6b78df3…
|
drh
|
69 |
|
|
6b78df3…
|
drh
|
70 |
method get {lod} { return $mystate($lod) } |
|
6b78df3…
|
drh
|
71 |
method has {lod} { return [info exists mystate($lod)] } |
|
6b78df3…
|
drh
|
72 |
|
|
6b78df3…
|
drh
|
73 |
method names {} { return [array names mystate] } |
|
6b78df3…
|
drh
|
74 |
|
|
6d5de5f…
|
aku
|
75 |
method dup {dst _from_ src} { |
|
300f312…
|
aku
|
76 |
log write 8 ristate {Duplicate workspace for LOD "$dst" from "$src"} |
|
6d5de5f…
|
aku
|
77 |
set mystate($dst) $mystate($src) |
|
6d5de5f…
|
aku
|
78 |
return |
|
6d5de5f…
|
aku
|
79 |
} |
|
6d5de5f…
|
aku
|
80 |
|
|
6b78df3…
|
drh
|
81 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
82 |
## State |
|
6b78df3…
|
drh
|
83 |
|
|
6b78df3…
|
drh
|
84 |
variable mystate -array {} ; # Map from lines of development |
|
6b78df3…
|
drh
|
85 |
# (identified by name) to their |
|
300f312…
|
aku
|
86 |
# workspace. |
|
6b78df3…
|
drh
|
87 |
|
|
6b78df3…
|
drh
|
88 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
89 |
## Configuration |
|
6b78df3…
|
drh
|
90 |
|
|
6b78df3…
|
drh
|
91 |
pragma -hastypeinfo no ; # no type introspection |
|
6b78df3…
|
drh
|
92 |
pragma -hasinfo no ; # no object introspection |
|
6b78df3…
|
drh
|
93 |
pragma -hastypemethods no ; # type is not relevant. |
|
6b78df3…
|
drh
|
94 |
|
|
6b78df3…
|
drh
|
95 |
# # ## ### ##### ######## ############# |
|
6b78df3…
|
drh
|
96 |
} |
|
6b78df3…
|
drh
|
97 |
|
|
6b78df3…
|
drh
|
98 |
namespace eval ::vc::fossil::import::cvs { |
|
6b78df3…
|
drh
|
99 |
namespace export ristate |
|
6b78df3…
|
drh
|
100 |
namespace eval ristate { |
|
6b78df3…
|
drh
|
101 |
namespace import ::vc::fossil::import::cvs::wsstate |
|
6b78df3…
|
drh
|
102 |
namespace import ::vc::fossil::import::cvs::integrity |
|
6b78df3…
|
drh
|
103 |
namespace import ::vc::tools::trouble |
|
6b78df3…
|
drh
|
104 |
namespace import ::vc::tools::log |
|
6b78df3…
|
drh
|
105 |
log register ristate |
|
6b78df3…
|
drh
|
106 |
} |
|
6b78df3…
|
drh
|
107 |
} |
|
6b78df3…
|
drh
|
108 |
|
|
6b78df3…
|
drh
|
109 |
# # ## ### ##### ######## ############# ##################### |
|
6b78df3…
|
drh
|
110 |
## Ready |
|
6b78df3…
|
drh
|
111 |
|
|
6b78df3…
|
drh
|
112 |
package provide vc::fossil::import::cvs::ristate 1.0 |
|
6b78df3…
|
drh
|
113 |
return |