Fossil SCM

Continuing namespace changes, rcs parser. Basic structure is now ok IMHO.

aku 2007-09-13 06:24 trunk
Commit d4aa7da67da6387025ed85eabf24e339f7dd0bae
Parent 00228d154780783…
3 files changed +5 -4 +1 -1 +37 -33
~ tools/lib/cvs.tcl ~ tools/lib/pkgIndex.tcl ~ tools/lib/rcsparser.tcl
M tools/lib/cvs.tcl
+5 -4
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,18 +3,19 @@
33
44
 # -----------------------------------------------------------------------------
55
 # Requirements
66
77
 package require Tcl 8.4
8
-package require fileutil ; # Tcllib (traverse directory hierarchy)
9
-package require rcsparser ; # Handling the RCS archive files.
10
-package require vc::tools::log ; # User feedback
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
1111
 package require struct::tree
1212
1313
 namespace eval ::vc::cvs::ws {
1414
 vc::tools::log::system cvs
1515
 namespace import ::vc::tools::log::write
16
+ namespace import ::vc::rcs::parser::process
1617
 }
1718
1819
 # -----------------------------------------------------------------------------
1920
 # API
2021
@@ -81,11 +82,11 @@
8182
 continue
8283
 }
8384
 }
8485
8586
 # Get the meta data we need (revisions, timeline, messages).
86
- set meta [::rcsparser::process $base/$rcs]
87
+ set meta [process $base/$rcs]
8788
8889
 set npaths($rcs) $f
8990
 set rpaths($f) $rcs
9091
9192
 array set p $meta
9293
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,18 +3,19 @@
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8 package require fileutil ; # Tcllib (traverse directory hierarchy)
9 package require rcsparser ; # Handling the RCS archive files.
10 package require vc::tools::log ; # User feedback
11 package require struct::tree
12
13 namespace eval ::vc::cvs::ws {
14 vc::tools::log::system cvs
15 namespace import ::vc::tools::log::write
 
16 }
17
18 # -----------------------------------------------------------------------------
19 # API
20
@@ -81,11 +82,11 @@
81 continue
82 }
83 }
84
85 # Get the meta data we need (revisions, timeline, messages).
86 set meta [::rcsparser::process $base/$rcs]
87
88 set npaths($rcs) $f
89 set rpaths($f) $rcs
90
91 array set p $meta
92
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,18 +3,19 @@
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 struct::tree
12
13 namespace eval ::vc::cvs::ws {
14 vc::tools::log::system cvs
15 namespace import ::vc::tools::log::write
16 namespace import ::vc::rcs::parser::process
17 }
18
19 # -----------------------------------------------------------------------------
20 # API
21
@@ -81,11 +82,11 @@
82 continue
83 }
84 }
85
86 # Get the meta data we need (revisions, timeline, messages).
87 set meta [process $base/$rcs]
88
89 set npaths($rcs) $f
90 set rpaths($f) $rcs
91
92 array set p $meta
93
M tools/lib/pkgIndex.tcl
+1 -1
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,6 +1,6 @@
11
 if {![package vsatisfies [package require Tcl] 8.4]} return
2
-package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
2
+package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
33
 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
44
 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
55
 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
66
 package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
77
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,6 +1,6 @@
1 if {![package vsatisfies [package require Tcl] 8.4]} return
2 package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
3 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
4 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
5 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
6 package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
7
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,6 +1,6 @@
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::ws 1.0 [list source [file join $dir cvs.tcl]]
4 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
5 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
6 package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]]
7
M tools/lib/rcsparser.tcl
+37 -33
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -13,19 +13,19 @@
1313
1414
 package require Tcl 8.4
1515
 package require fileutil ; # Tcllib (cat)
1616
 package require vc::tools::log ; # User feedback
1717
18
-namespace eval ::rcsparser {
18
+namespace eval ::vc::rcs::parser {
1919
 vc::tools::log::system rcs
2020
 namespace import ::vc::tools::log::progress
2121
 }
2222
2323
 # -----------------------------------------------------------------------------
2424
 # API
2525
26
-# rcsparser::process file
26
+# vc::rcs::parser::process file
2727
 #
2828
 # Parses the rcs file and returns a dictionary containing the meta
2929
 # data. The following keys are used
3030
 #
3131
 # Key Meaning
@@ -45,11 +45,11 @@
4545
 # The state 'dead' has special meaning, the user should know that.
4646
4747
 # -----------------------------------------------------------------------------
4848
 # API Implementation
4949
50
-proc ::rcsparser::process {path} {
50
+proc ::vc::rcs::parser::process {path} {
5151
 set data [fileutil::cat -encoding binary $path]
5252
 array set res {}
5353
 set res(size) [file size $path]
5454
 set res(done) 0
5555
 set res(nsize) [string length $res(size)]
@@ -70,97 +70,97 @@
7070
 }
7171
7272
 # -----------------------------------------------------------------------------
7373
 # Internal - Recursive Descent functions implementing the syntax.
7474
75
-proc ::rcsparser::Admin {} {
75
+proc ::vc::rcs::parser::Admin {} {
7676
 upvar 1 data data res res
7777
 Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
7878
 return
7979
 }
8080
81
-proc ::rcsparser::Deltas {} {
81
+proc ::vc::rcs::parser::Deltas {} {
8282
 upvar 1 data data res res
8383
 while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
8484
 return
8585
 }
8686
87
-proc ::rcsparser::Description {} {
87
+proc ::vc::rcs::parser::Description {} {
8888
 upvar 1 data data res res
8989
 Literal desc
9090
 String 1
9191
 Def desc
9292
 return
9393
 }
9494
95
-proc ::rcsparser::DeltaTexts {} {
95
+proc ::vc::rcs::parser::DeltaTexts {} {
9696
 upvar 1 data data res res
9797
 while {[Num 0]} { IsIdent ; Log ; Text }
9898
 return
9999
 }
100100
101
-proc ::rcsparser::Head {} {
101
+proc ::vc::rcs::parser::Head {} {
102102
 upvar 1 data data res res
103103
 Literal head ; Num 1 ; Literal \;
104104
 Def head
105105
 return
106106
 }
107107
108
-proc ::rcsparser::Branch {} {
108
+proc ::vc::rcs::parser::Branch {} {
109109
 upvar 1 data data res res
110110
 if {![Literal branch 0]} return ; Num 1 ; Literal \;
111111
 Def branch
112112
 return
113113
 }
114114
115
-proc ::rcsparser::Access {} {
115
+proc ::vc::rcs::parser::Access {} {
116116
 upvar 1 data data res res
117117
 Literal access ; Literal \;
118118
 return
119119
 }
120120
121
-proc ::rcsparser::Symbols {} {
121
+proc ::vc::rcs::parser::Symbols {} {
122122
 upvar 1 data data res res
123123
 Literal symbols
124124
 while {[Ident]} { Num 1 ; Map symbol }
125125
 Literal \;
126126
 return
127127
 }
128128
129
-proc ::rcsparser::Locks {} {
129
+proc ::vc::rcs::parser::Locks {} {
130130
 upvar 1 data data res res
131131
 Literal locks
132132
 while {[Ident]} { Num 1 ; Map lock }
133133
 Literal \;
134134
 return
135135
 }
136136
137
-proc ::rcsparser::Strict {} {
137
+proc ::vc::rcs::parser::Strict {} {
138138
 upvar 1 data data res res
139139
 if {![Literal strict 0]} return ; Literal \;
140140
 return
141141
 }
142142
143
-proc ::rcsparser::Comment {} {
143
+proc ::vc::rcs::parser::Comment {} {
144144
 upvar 1 data data res res
145145
 if {![Literal comment 0]} return ;
146146
 if {![String 0]} return ;
147147
 Literal \;
148148
 Def comment
149149
 return
150150
 }
151151
152
-proc ::rcsparser::Expand {} {
152
+proc ::vc::rcs::parser::Expand {} {
153153
 upvar 1 data data res res
154154
 if {![Literal expand 0]} return ;
155155
 if {![String 0]} return ;
156156
 Literal \;
157157
 Def expand
158158
 return
159159
 }
160160
161
-proc ::rcsparser::Date {} {
161
+proc ::vc::rcs::parser::Date {} {
162162
 upvar 1 data data res res
163163
 Literal date ; Num 1 ; Literal \;
164164
165165
 foreach {yr mo dy h m s} [split $res(lastval) .] break
166166
 if {$yr < 100} {incr yr 1900}
@@ -167,50 +167,50 @@
167167
 set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
168168
 Map date
169169
 return
170170
 }
171171
172
-proc ::rcsparser::Author {} {
172
+proc ::vc::rcs::parser::Author {} {
173173
 upvar 1 data data res res
174174
 Literal author ; Skip ; Literal \; ; Map author
175175
 return
176176
 }
177177
178
-proc ::rcsparser::State {} {
178
+proc ::vc::rcs::parser::State {} {
179179
 upvar 1 data data res res
180180
 Literal state ; Skip ; Literal \; ; Map state
181181
 return
182182
 }
183183
184
-proc ::rcsparser::Branches {} {
184
+proc ::vc::rcs::parser::Branches {} {
185185
 upvar 1 data data res res
186186
 Literal branches ; Skip ; Literal \;
187187
 return
188188
 }
189189
190
-proc ::rcsparser::NextRev {} {
190
+proc ::vc::rcs::parser::NextRev {} {
191191
 upvar 1 data data res res
192192
 Literal next ; Skip ; Literal \; ; Map parent
193193
 return
194194
 }
195195
196
-proc ::rcsparser::Log {} {
196
+proc ::vc::rcs::parser::Log {} {
197197
 upvar 1 data data res res
198198
 Literal log ; String 1 ; Map commit
199199
 return
200200
 }
201201
202
-proc ::rcsparser::Text {} {
202
+proc ::vc::rcs::parser::Text {} {
203203
 upvar 1 data data res res
204204
 Literal text ; String 1
205205
 return
206206
 }
207207
208208
 # -----------------------------------------------------------------------------
209209
 # Internal - Lexicographical commands and data aquisition preparation
210210
211
-proc ::rcsparser::Ident {} {
211
+proc ::vc::rcs::parser::Ident {} {
212212
 upvar 1 data data res res
213213
214214
 #puts I@?<[string range $data 0 10]...>
215215
216216
 if {[regexp -indices -- {^\s*;\s*} $data]} {
@@ -222,11 +222,11 @@
222222
 Get $val ; IsIdent
223223
 Next
224224
 return 1
225225
 }
226226
227
-proc ::rcsparser::Literal {name {required 1}} {
227
+proc ::vc::rcs::parser::Literal {name {required 1}} {
228228
 upvar 1 data data res res
229229
 if {![regexp -indices -- "^\\s*$name\\s*" $data match]} {
230230
 if {$required} {
231231
 return -code error "Expected '$name' @ '[string range $data 0 30]...'"
232232
 }
@@ -235,11 +235,11 @@
235235
236236
 Next
237237
 return 1
238238
 }
239239
240
-proc ::rcsparser::String {{required 1}} {
240
+proc ::vc::rcs::parser::String {{required 1}} {
241241
 upvar 1 data data res res
242242
243243
 if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} {
244244
 if {$required} {
245245
 return -code error "Expected string @ '[string range $data 0 30]...'"
@@ -250,11 +250,11 @@
250250
 Get $val
251251
 Next
252252
 return 1
253253
 }
254254
255
-proc ::rcsparser::Num {required} {
255
+proc ::vc::rcs::parser::Num {required} {
256256
 upvar 1 data data res res
257257
 if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} {
258258
 if {$required} {
259259
 return -code error "Expected id @ '[string range $data 0 30]...'"
260260
 }
@@ -264,11 +264,11 @@
264264
 Get $val
265265
 Next
266266
 return 1
267267
 }
268268
269
-proc ::rcsparser::Skip {} {
269
+proc ::vc::rcs::parser::Skip {} {
270270
 upvar 1 data data res res
271271
 regexp -indices -- {^\s*([^;]*)\s*} $data match val
272272
 Get $val
273273
 Next
274274
 return
@@ -275,51 +275,55 @@
275275
 }
276276
277277
 # -----------------------------------------------------------------------------
278278
 # Internal - Data aquisition
279279
280
-proc ::rcsparser::Def {key} {
280
+proc ::vc::rcs::parser::Def {key} {
281281
 upvar 1 data data res res
282282
 set res($key) $res(lastval)
283283
 unset res(lastval)
284284
 return
285285
 }
286286
287
-proc ::rcsparser::Map {key} {
287
+proc ::vc::rcs::parser::Map {key} {
288288
 upvar 1 data data res res
289289
 lappend res($key) $res(id) $res(lastval)
290290
 #puts Map($res(id))=($res(lastval))
291291
 unset res(lastval)
292292
 #unset res(id);#Keep id for additional mappings.
293293
 return
294294
 }
295295
296
-proc ::rcsparser::IsIdent {} {
296
+proc ::vc::rcs::parser::IsIdent {} {
297297
 upvar 1 data data res res
298298
 set res(id) $res(lastval)
299299
 unset res(lastval)
300300
 return
301301
 }
302302
303
-proc ::rcsparser::Get {val} {
303
+proc ::vc::rcs::parser::Get {val} {
304304
 upvar 1 data data res res
305305
 foreach {s e} $val break
306306
 set res(lastval) [string range $data $s $e]
307307
 #puts G|$res(lastval)
308308
 return
309309
 }
310310
311
-proc ::rcsparser::Next {} {
311
+proc ::vc::rcs::parser::Next {} {
312312
 upvar 1 match match data data res res
313313
 foreach {s e} $match break ; incr e
314314
 set data [string range $data $e end]
315315
 set res(done) [expr {$res(size) - [string length $data]}]
316316
317317
 progress 2 rcs $res(done) $res(size)
318318
 return
319319
 }
320
+
321
+namespace eval ::vc::rcs::parser {
322
+ namespace export process
323
+}
320324
321325
 # -----------------------------------------------------------------------------
322326
 # Ready
323327
324
-package provide rcsparser 1.0
328
+package provide vc::rcs::parser 1.0
325329
 return
326330
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -13,19 +13,19 @@
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 ::rcsparser {
19 vc::tools::log::system rcs
20 namespace import ::vc::tools::log::progress
21 }
22
23 # -----------------------------------------------------------------------------
24 # API
25
26 # rcsparser::process file
27 #
28 # Parses the rcs file and returns a dictionary containing the meta
29 # data. The following keys are used
30 #
31 # Key Meaning
@@ -45,11 +45,11 @@
45 # The state 'dead' has special meaning, the user should know that.
46
47 # -----------------------------------------------------------------------------
48 # API Implementation
49
50 proc ::rcsparser::process {path} {
51 set data [fileutil::cat -encoding binary $path]
52 array set res {}
53 set res(size) [file size $path]
54 set res(done) 0
55 set res(nsize) [string length $res(size)]
@@ -70,97 +70,97 @@
70 }
71
72 # -----------------------------------------------------------------------------
73 # Internal - Recursive Descent functions implementing the syntax.
74
75 proc ::rcsparser::Admin {} {
76 upvar 1 data data res res
77 Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
78 return
79 }
80
81 proc ::rcsparser::Deltas {} {
82 upvar 1 data data res res
83 while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
84 return
85 }
86
87 proc ::rcsparser::Description {} {
88 upvar 1 data data res res
89 Literal desc
90 String 1
91 Def desc
92 return
93 }
94
95 proc ::rcsparser::DeltaTexts {} {
96 upvar 1 data data res res
97 while {[Num 0]} { IsIdent ; Log ; Text }
98 return
99 }
100
101 proc ::rcsparser::Head {} {
102 upvar 1 data data res res
103 Literal head ; Num 1 ; Literal \;
104 Def head
105 return
106 }
107
108 proc ::rcsparser::Branch {} {
109 upvar 1 data data res res
110 if {![Literal branch 0]} return ; Num 1 ; Literal \;
111 Def branch
112 return
113 }
114
115 proc ::rcsparser::Access {} {
116 upvar 1 data data res res
117 Literal access ; Literal \;
118 return
119 }
120
121 proc ::rcsparser::Symbols {} {
122 upvar 1 data data res res
123 Literal symbols
124 while {[Ident]} { Num 1 ; Map symbol }
125 Literal \;
126 return
127 }
128
129 proc ::rcsparser::Locks {} {
130 upvar 1 data data res res
131 Literal locks
132 while {[Ident]} { Num 1 ; Map lock }
133 Literal \;
134 return
135 }
136
137 proc ::rcsparser::Strict {} {
138 upvar 1 data data res res
139 if {![Literal strict 0]} return ; Literal \;
140 return
141 }
142
143 proc ::rcsparser::Comment {} {
144 upvar 1 data data res res
145 if {![Literal comment 0]} return ;
146 if {![String 0]} return ;
147 Literal \;
148 Def comment
149 return
150 }
151
152 proc ::rcsparser::Expand {} {
153 upvar 1 data data res res
154 if {![Literal expand 0]} return ;
155 if {![String 0]} return ;
156 Literal \;
157 Def expand
158 return
159 }
160
161 proc ::rcsparser::Date {} {
162 upvar 1 data data res res
163 Literal date ; Num 1 ; Literal \;
164
165 foreach {yr mo dy h m s} [split $res(lastval) .] break
166 if {$yr < 100} {incr yr 1900}
@@ -167,50 +167,50 @@
167 set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
168 Map date
169 return
170 }
171
172 proc ::rcsparser::Author {} {
173 upvar 1 data data res res
174 Literal author ; Skip ; Literal \; ; Map author
175 return
176 }
177
178 proc ::rcsparser::State {} {
179 upvar 1 data data res res
180 Literal state ; Skip ; Literal \; ; Map state
181 return
182 }
183
184 proc ::rcsparser::Branches {} {
185 upvar 1 data data res res
186 Literal branches ; Skip ; Literal \;
187 return
188 }
189
190 proc ::rcsparser::NextRev {} {
191 upvar 1 data data res res
192 Literal next ; Skip ; Literal \; ; Map parent
193 return
194 }
195
196 proc ::rcsparser::Log {} {
197 upvar 1 data data res res
198 Literal log ; String 1 ; Map commit
199 return
200 }
201
202 proc ::rcsparser::Text {} {
203 upvar 1 data data res res
204 Literal text ; String 1
205 return
206 }
207
208 # -----------------------------------------------------------------------------
209 # Internal - Lexicographical commands and data aquisition preparation
210
211 proc ::rcsparser::Ident {} {
212 upvar 1 data data res res
213
214 #puts I@?<[string range $data 0 10]...>
215
216 if {[regexp -indices -- {^\s*;\s*} $data]} {
@@ -222,11 +222,11 @@
222 Get $val ; IsIdent
223 Next
224 return 1
225 }
226
227 proc ::rcsparser::Literal {name {required 1}} {
228 upvar 1 data data res res
229 if {![regexp -indices -- "^\\s*$name\\s*" $data match]} {
230 if {$required} {
231 return -code error "Expected '$name' @ '[string range $data 0 30]...'"
232 }
@@ -235,11 +235,11 @@
235
236 Next
237 return 1
238 }
239
240 proc ::rcsparser::String {{required 1}} {
241 upvar 1 data data res res
242
243 if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} {
244 if {$required} {
245 return -code error "Expected string @ '[string range $data 0 30]...'"
@@ -250,11 +250,11 @@
250 Get $val
251 Next
252 return 1
253 }
254
255 proc ::rcsparser::Num {required} {
256 upvar 1 data data res res
257 if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} {
258 if {$required} {
259 return -code error "Expected id @ '[string range $data 0 30]...'"
260 }
@@ -264,11 +264,11 @@
264 Get $val
265 Next
266 return 1
267 }
268
269 proc ::rcsparser::Skip {} {
270 upvar 1 data data res res
271 regexp -indices -- {^\s*([^;]*)\s*} $data match val
272 Get $val
273 Next
274 return
@@ -275,51 +275,55 @@
275 }
276
277 # -----------------------------------------------------------------------------
278 # Internal - Data aquisition
279
280 proc ::rcsparser::Def {key} {
281 upvar 1 data data res res
282 set res($key) $res(lastval)
283 unset res(lastval)
284 return
285 }
286
287 proc ::rcsparser::Map {key} {
288 upvar 1 data data res res
289 lappend res($key) $res(id) $res(lastval)
290 #puts Map($res(id))=($res(lastval))
291 unset res(lastval)
292 #unset res(id);#Keep id for additional mappings.
293 return
294 }
295
296 proc ::rcsparser::IsIdent {} {
297 upvar 1 data data res res
298 set res(id) $res(lastval)
299 unset res(lastval)
300 return
301 }
302
303 proc ::rcsparser::Get {val} {
304 upvar 1 data data res res
305 foreach {s e} $val break
306 set res(lastval) [string range $data $s $e]
307 #puts G|$res(lastval)
308 return
309 }
310
311 proc ::rcsparser::Next {} {
312 upvar 1 match match data data res res
313 foreach {s e} $match break ; incr e
314 set data [string range $data $e end]
315 set res(done) [expr {$res(size) - [string length $data]}]
316
317 progress 2 rcs $res(done) $res(size)
318 return
319 }
 
 
 
 
320
321 # -----------------------------------------------------------------------------
322 # Ready
323
324 package provide rcsparser 1.0
325 return
326
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -13,19 +13,19 @@
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 namespace import ::vc::tools::log::progress
21 }
22
23 # -----------------------------------------------------------------------------
24 # API
25
26 # vc::rcs::parser::process file
27 #
28 # Parses the rcs file and returns a dictionary containing the meta
29 # data. The following keys are used
30 #
31 # Key Meaning
@@ -45,11 +45,11 @@
45 # The state 'dead' has special meaning, the user should know that.
46
47 # -----------------------------------------------------------------------------
48 # API Implementation
49
50 proc ::vc::rcs::parser::process {path} {
51 set data [fileutil::cat -encoding binary $path]
52 array set res {}
53 set res(size) [file size $path]
54 set res(done) 0
55 set res(nsize) [string length $res(size)]
@@ -70,97 +70,97 @@
70 }
71
72 # -----------------------------------------------------------------------------
73 # Internal - Recursive Descent functions implementing the syntax.
74
75 proc ::vc::rcs::parser::Admin {} {
76 upvar 1 data data res res
77 Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
78 return
79 }
80
81 proc ::vc::rcs::parser::Deltas {} {
82 upvar 1 data data res res
83 while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
84 return
85 }
86
87 proc ::vc::rcs::parser::Description {} {
88 upvar 1 data data res res
89 Literal desc
90 String 1
91 Def desc
92 return
93 }
94
95 proc ::vc::rcs::parser::DeltaTexts {} {
96 upvar 1 data data res res
97 while {[Num 0]} { IsIdent ; Log ; Text }
98 return
99 }
100
101 proc ::vc::rcs::parser::Head {} {
102 upvar 1 data data res res
103 Literal head ; Num 1 ; Literal \;
104 Def head
105 return
106 }
107
108 proc ::vc::rcs::parser::Branch {} {
109 upvar 1 data data res res
110 if {![Literal branch 0]} return ; Num 1 ; Literal \;
111 Def branch
112 return
113 }
114
115 proc ::vc::rcs::parser::Access {} {
116 upvar 1 data data res res
117 Literal access ; Literal \;
118 return
119 }
120
121 proc ::vc::rcs::parser::Symbols {} {
122 upvar 1 data data res res
123 Literal symbols
124 while {[Ident]} { Num 1 ; Map symbol }
125 Literal \;
126 return
127 }
128
129 proc ::vc::rcs::parser::Locks {} {
130 upvar 1 data data res res
131 Literal locks
132 while {[Ident]} { Num 1 ; Map lock }
133 Literal \;
134 return
135 }
136
137 proc ::vc::rcs::parser::Strict {} {
138 upvar 1 data data res res
139 if {![Literal strict 0]} return ; Literal \;
140 return
141 }
142
143 proc ::vc::rcs::parser::Comment {} {
144 upvar 1 data data res res
145 if {![Literal comment 0]} return ;
146 if {![String 0]} return ;
147 Literal \;
148 Def comment
149 return
150 }
151
152 proc ::vc::rcs::parser::Expand {} {
153 upvar 1 data data res res
154 if {![Literal expand 0]} return ;
155 if {![String 0]} return ;
156 Literal \;
157 Def expand
158 return
159 }
160
161 proc ::vc::rcs::parser::Date {} {
162 upvar 1 data data res res
163 Literal date ; Num 1 ; Literal \;
164
165 foreach {yr mo dy h m s} [split $res(lastval) .] break
166 if {$yr < 100} {incr yr 1900}
@@ -167,50 +167,50 @@
167 set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
168 Map date
169 return
170 }
171
172 proc ::vc::rcs::parser::Author {} {
173 upvar 1 data data res res
174 Literal author ; Skip ; Literal \; ; Map author
175 return
176 }
177
178 proc ::vc::rcs::parser::State {} {
179 upvar 1 data data res res
180 Literal state ; Skip ; Literal \; ; Map state
181 return
182 }
183
184 proc ::vc::rcs::parser::Branches {} {
185 upvar 1 data data res res
186 Literal branches ; Skip ; Literal \;
187 return
188 }
189
190 proc ::vc::rcs::parser::NextRev {} {
191 upvar 1 data data res res
192 Literal next ; Skip ; Literal \; ; Map parent
193 return
194 }
195
196 proc ::vc::rcs::parser::Log {} {
197 upvar 1 data data res res
198 Literal log ; String 1 ; Map commit
199 return
200 }
201
202 proc ::vc::rcs::parser::Text {} {
203 upvar 1 data data res res
204 Literal text ; String 1
205 return
206 }
207
208 # -----------------------------------------------------------------------------
209 # Internal - Lexicographical commands and data aquisition preparation
210
211 proc ::vc::rcs::parser::Ident {} {
212 upvar 1 data data res res
213
214 #puts I@?<[string range $data 0 10]...>
215
216 if {[regexp -indices -- {^\s*;\s*} $data]} {
@@ -222,11 +222,11 @@
222 Get $val ; IsIdent
223 Next
224 return 1
225 }
226
227 proc ::vc::rcs::parser::Literal {name {required 1}} {
228 upvar 1 data data res res
229 if {![regexp -indices -- "^\\s*$name\\s*" $data match]} {
230 if {$required} {
231 return -code error "Expected '$name' @ '[string range $data 0 30]...'"
232 }
@@ -235,11 +235,11 @@
235
236 Next
237 return 1
238 }
239
240 proc ::vc::rcs::parser::String {{required 1}} {
241 upvar 1 data data res res
242
243 if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} {
244 if {$required} {
245 return -code error "Expected string @ '[string range $data 0 30]...'"
@@ -250,11 +250,11 @@
250 Get $val
251 Next
252 return 1
253 }
254
255 proc ::vc::rcs::parser::Num {required} {
256 upvar 1 data data res res
257 if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} {
258 if {$required} {
259 return -code error "Expected id @ '[string range $data 0 30]...'"
260 }
@@ -264,11 +264,11 @@
264 Get $val
265 Next
266 return 1
267 }
268
269 proc ::vc::rcs::parser::Skip {} {
270 upvar 1 data data res res
271 regexp -indices -- {^\s*([^;]*)\s*} $data match val
272 Get $val
273 Next
274 return
@@ -275,51 +275,55 @@
275 }
276
277 # -----------------------------------------------------------------------------
278 # Internal - Data aquisition
279
280 proc ::vc::rcs::parser::Def {key} {
281 upvar 1 data data res res
282 set res($key) $res(lastval)
283 unset res(lastval)
284 return
285 }
286
287 proc ::vc::rcs::parser::Map {key} {
288 upvar 1 data data res res
289 lappend res($key) $res(id) $res(lastval)
290 #puts Map($res(id))=($res(lastval))
291 unset res(lastval)
292 #unset res(id);#Keep id for additional mappings.
293 return
294 }
295
296 proc ::vc::rcs::parser::IsIdent {} {
297 upvar 1 data data res res
298 set res(id) $res(lastval)
299 unset res(lastval)
300 return
301 }
302
303 proc ::vc::rcs::parser::Get {val} {
304 upvar 1 data data res res
305 foreach {s e} $val break
306 set res(lastval) [string range $data $s $e]
307 #puts G|$res(lastval)
308 return
309 }
310
311 proc ::vc::rcs::parser::Next {} {
312 upvar 1 match match data data res res
313 foreach {s e} $match break ; incr e
314 set data [string range $data $e end]
315 set res(done) [expr {$res(size) - [string length $data]}]
316
317 progress 2 rcs $res(done) $res(size)
318 return
319 }
320
321 namespace eval ::vc::rcs::parser {
322 namespace export process
323 }
324
325 # -----------------------------------------------------------------------------
326 # Ready
327
328 package provide vc::rcs::parser 1.0
329 return
330

Keyboard Shortcuts

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