33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
-
-
-
+
+
+
-
+
-
+
-
+
-
+
|
constructor {} {
# Start with an empty state
return
}
method new {lod {parentlod {}}} {
# Create the workspace state for a line of development
# (LOD). If a parent LOD is specified let the new state
# inherit the current state of the parent.
# Create a workspace for a line of development (LOD). If a
# parent LOD is specified let the new workspace inherit the
# current state of the parent.
log write 8 ristate {Open workspace state for LOD "$lod"}
log write 8 ristate {Open workspace for LOD "$lod"}
integrity assert {
![info exists mystate($lod)]
} {Trying to override existing state for lod "$lod"}
set wss [wsstate ${selfns}::%AUTO% $lod]
set mystate($lod) $wss
if {$parentlod ne ""} {
log write 8 ristate {Inheriting from workspace state for LOD "$parentlod"}
log write 8 ristate {Inheriting from workspace for LOD "$parentlod"}
integrity assert {
[info exists mystate($parentlod)]
} {Trying to inherit from undefined lod "$parentlod"}
set pwss $mystate($parentlod)
$wss defstate [$pwss getstate]
$wss defid [$pwss getid]
}
return $wss
}
method get {lod} { return $mystate($lod) }
method has {lod} { return [info exists mystate($lod)] }
method names {} { return [array names mystate] }
method dup {dst _from_ src} {
log write 8 ristate {Duplicate workspace state for LOD "$dst" from "$src"}
log write 8 ristate {Duplicate workspace for LOD "$dst" from "$src"}
set mystate($dst) $mystate($src)
return
}
# # ## ### ##### ######## #############
## State
variable mystate -array {} ; # Map from lines of development
# (identified by name) to their
# workspace state.
# workspace.
# # ## ### ##### ######## #############
## Configuration
pragma -hastypeinfo no ; # no type introspection
pragma -hasinfo no ; # no object introspection
pragma -hastypemethods no ; # type is not relevant.
|