/[meta-cvs]/meta-cvs/F-36433FEEE65F109159A4ADF217F5145C
ViewVC logotype

Diff of /meta-cvs/F-36433FEEE65F109159A4ADF217F5145C

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

revision 1.13 by kaz, Sat Oct 5 18:09:48 2002 UTC revision 1.13.2.2 by kaz, Mon Oct 21 04:46:05 2002 UTC
# Line 26  Line 26 
26           (with-input-from-program (stream `("cvs" "-Q" "up" "-p"           (with-input-from-program (stream `("cvs" "-Q" "up" "-p"
27                                              ,@(format-opt filt-options)                                              ,@(format-opt filt-options)
28                                              ,*mcvs-map*))                                              ,*mcvs-map*))
29             (let ((map (read stream nil :error)))             (mapping-read stream)))
              (if (eq map :error)  
                (error "didn't obtain valid map from CVS.")  
                 map))))  
30        (t (mapping-read *mcvs-map-local*)))))        (t (mapping-read *mcvs-map-local*)))))
31    
32  (defun mcvs-filt (filt-options)  (defun mcvs-filt (filt-options)
# Line 41  Line 38 
38            (when (null line)            (when (null line)
39              (return (values)))              (return (values)))
40            (loop            (loop
41              (let ((f-start (search "F-" line)))              (let ((f-start (search "F-" line :test #'char=))
42                      (mcvs-dir (search "MCVS/F-" line :test #'char=)))
43                (flet ((is-hex-digit (x)                (flet ((is-hex-digit (x)
44                         (or (digit-char-p x)                         (or (digit-char-p x)
45                             (find x "ABCDEF"))))                             (find x "ABCDEF"))))
46                  (when (not f-start)                  (cond
47                    (write-line line)                    ((and mcvs-dir (or (and f-start (< mcvs-dir f-start))
48                    (return))                                       (not f-start)))
49                  (write-string (substring line 0 f-start))                      (write-string (substring line 0 (+ mcvs-dir 7)))
50                  (setf line (substring line (+ f-start 2)))                      (setf line (substring line (+ mcvs-dir 7))))
51                  (when (< (length line) 32)                    (f-start
52                    (write-string "F-")                      (write-string (substring line 0 f-start))
53                    (write-line line)                      (setf line (substring line (+ f-start 2)))
54                    (return))                      (when (< (length line) 32)
55                  (cond                        (write-string "F-")
56                    ((notevery #'is-hex-digit (substring line 0 32))                        (write-line line)
57                       (write-string "F-")                        (return))
58                       (setf line (substring line 2)))                      (cond
59                    (t (let* ((f-digits (substring line 0 32))                        ((notevery #'is-hex-digit (substring line 0 32))
60                              (entry (gethash (format nil "F-~a" f-digits)                           (write-string "F-")
61                                              filehash))                           (setf line (substring line 2)))
62                              (suffix (and entry                        (t (let* ((f-digits (substring line 0 32))
63                                           (suffix (mapping-entry-id entry)))))                                  (entry (gethash (format nil "F-~a" f-digits)
64                         (setf line (substring line 32))                                                  filehash))
65                         (cond                                  (suffix (and entry
66                           ((null entry)                                               (suffix (mapping-entry-id entry)))))
67                              (write-string "F-")                             (setf line (substring line 32))
68                              (write-string f-digits))                             (cond
69                           ((and suffix                               ((null entry)
70                                 (or (< (length line) (1+ (length suffix)))                                  (write-string "F-")
71                                     (not (path-equal (substring line 1                                  (write-string f-digits))
72                                                                 (1+ (length suffix)))                               ((and suffix
73                                                      suffix))))                                     (or (< (length line) (1+ (length suffix)))
74                              (write-string "F-")                                         (not (path-equal (substring line 1
75                              (write-string f-digits))                                                                     (1+ (length suffix)))
76                           (t (write-string (mapping-entry-path entry))                                                          suffix))))
77                              (when suffix                                  (write-string "F-")
78                                (setf line                                  (write-string f-digits))
79                                      (substring line                               (t (write-string (mapping-entry-path entry))
80                                                 (1+ (length suffix))))))))))))))))))                                  (when suffix
81                                      (setf line
82                                            (substring line
83                                                       (1+ (length suffix)))))))))))
84                      (t (write-line line)
85                         (return)))))))))))
86    
87  (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)  (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)
88    (declare (ignore cvs-options))    (declare (ignore cvs-options))

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.13.2.2

  ViewVC Help
Powered by ViewVC 1.1.5