/[meta-cvs]/meta-cvs/F-576B79B06E51052AA09B4F57264D05A9.lisp
ViewVC logotype

Diff of /meta-cvs/F-576B79B06E51052AA09B4F57264D05A9.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by kaz, Mon Mar 18 21:51:42 2002 UTC revision 1.2 by kaz, Tue Mar 19 22:10:57 2002 UTC
# Line 26  Line 26 
26    (expand)    (expand)
27    (newphrases))    (newphrases))
28    
29    (defstruct rcs-delta
30      (version)
31      (date)
32      (author)
33      (state)
34      (branches)
35      (next)
36      (newphrases))
37    
38  (defstruct rcs-file  (defstruct rcs-file
39    (admin))    (admin)
40      (deltas))
41    
42  (defun rcs-special-p (ch)  (defun rcs-special-p (ch)
43    (or (char= ch #\$) (char= ch #\,) (char= ch #\.)    (or (char= ch #\$) (char= ch #\,) (char= ch #\.)
# Line 134  Line 144 
144            (error "rcs-parse: expecting token of type ~a, not ~a." type-match type)))            (error "rcs-parse: expecting token of type ~a, not ~a." type-match type)))
145        token)))        token)))
146    
147    (defun rcs-parse-newphrases (stream)
148      (let (token newphrases)
149        (symbol-macrolet ((lexeme (slot-value token 'lexeme)))
150          (loop
151            (if (setf token (or (rcs-match-optional stream :sym)
152                                (rcs-match-optional stream :id)))
153              (let ((phrase (list lexeme)))
154                (loop
155                  (cond
156                    ((setf token (or (rcs-match-optional stream :sym)
157                                     (rcs-match-optional stream :id)
158                                     (rcs-match-optional stream :num)
159                                     (rcs-match-optional stream :string)))
160                       (push lexeme phrase))
161                    ((setf token (rcs-match-optional stream :special))
162                       (if (char= lexeme #\:)
163                         (push lexeme phrase)
164                         (progn
165                           (rcs-pushback-token stream token)
166                           (push (nreverse phrase) newphrases)
167                           (return))))
168                    (t (push (nreverse phrase) newphrases)
169                        (return))))
170                (rcs-match-token stream :special #\;))
171              (return))))
172        (nreverse newphrases)))
173    
174  (defun rcs-parse-admin (stream)  (defun rcs-parse-admin (stream)
175    (let ((admin (make-rcs-admin))    (let ((admin (make-rcs-admin))
176          token)          token)
# Line 219  Line 256 
256          (rcs-match-token stream :special #\;))          (rcs-match-token stream :special #\;))
257    
258        ;; { newphrase }*        ;; { newphrase }*
259        (loop        (setf newphrases (rcs-parse-newphrases stream))
         (if (setf token (or (rcs-match-optional stream :sym)  
                             (rcs-match-optional stream :id)))  
           (let ((phrase (list lexeme)))  
             (loop  
               (cond  
                 ((setf token (or (rcs-match-optional stream :sym)  
                                  (rcs-match-optional stream :id)  
                                  (rcs-match-optional stream :num)  
                                  (rcs-match-optional stream :string)))  
                    (push lexeme phrase))  
                 ((setf token (rcs-match-optional stream :special))  
                    (if (char= lexeme #\:)  
                      (push lexeme phrase)  
                      (progn  
                        (rcs-pushback-token stream token)  
                        (push (nreverse phrase) newphrases)  
                        (return))))  
                 (t (push (nreverse phrase) newphrases)  
                     (return))))  
             (rcs-match-token stream :special #\;))  
           (return)))  
       (nreverse newphrases)  
260        admin)))        admin)))
261    
262    (defun rcs-parse-delta (stream)
263      (let ((delta (make-rcs-delta))
264            token)
265        (symbol-macrolet ((version (slot-value delta 'version))
266                          (date (slot-value delta 'date))
267                          (author (slot-value delta 'author))
268                          (state (slot-value delta 'state))
269                          (branches (slot-value delta 'branches))
270                          (next (slot-value delta 'next))
271                          (newphrases (slot-value delta 'newphrases))
272                          (lexeme (slot-value token 'lexeme)))
273          ;; num
274          (setf token (rcs-match-optional stream :num))
275          (if (not token)
276            (return-from rcs-parse-delta nil))
277    
278          (setf version lexeme)
279    
280          ;; date num ;
281          (rcs-match-token stream :sym "date")
282          (setf token (rcs-match-token stream :num))
283          (setf date lexeme)
284          (rcs-match-token stream :special #\;)
285    
286          ;; author id ;
287          (rcs-match-token stream :sym "author")
288          (setf token (or (rcs-match-optional stream :sym)
289                          (rcs-match-token stream :id)))
290          (setf author lexeme)
291          (rcs-match-token stream :special #\;)
292    
293          ;; state { id } ;
294          (rcs-match-token stream :sym "state")
295          (setf token (or (rcs-match-optional stream :sym)
296                          (rcs-match-optional stream :id)))
297          (when token
298            (setf state lexeme))
299          (rcs-match-token stream :special #\;)
300    
301          ;; branches { num } * ;
302          (rcs-match-token stream :sym "branches")
303          (loop
304            (let ((token (rcs-match-optional stream :num)))
305              (if token
306                (push lexeme branches)
307                (return (nreverse branches)))))
308          (rcs-match-token stream :special #\;)
309    
310          ;; next { num } ;
311          (rcs-match-token stream :sym "next")
312          (setf token (rcs-match-optional stream :num))
313          (when token
314            (setf next lexeme))
315          (rcs-match-token stream :special #\;)
316    
317          ;; { newphrase }*
318          (when (not (rcs-match-optional stream :sym "desc"))
319            (setf newphrases (rcs-parse-newphrases stream)))
320          delta)))
321    
322    (defun rcs-parse-deltas (stream)
323      (let (deltas)
324        (loop
325          (let ((delta (rcs-parse-delta stream)))
326            (if delta
327              (push delta deltas)
328              (return (nreverse deltas)))))))
329    
330  (defun rcs-parse (stream)  (defun rcs-parse (stream)
331    "Parse RCS file."    "Parse RCS file."
332    (let ((token-stream (make-rcs-token-stream :stream stream)))    (let ((token-stream (make-rcs-token-stream :stream stream)))
333      ;; For now, we just need the admin section.      ;; We currently just need the admin and delta sections.
334      (make-rcs-file :admin (rcs-parse-admin token-stream))))      (make-rcs-file :admin (rcs-parse-admin token-stream)
335                       :deltas (rcs-parse-deltas token-stream))))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5