/[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.16 by kaz, Thu Oct 31 04:06:01 2002 UTC revision 1.17 by kaz, Wed Apr 16 05:12:21 2003 UTC
# Line 18  Line 18 
18          (declare (ignore suffix))          (declare (ignore suffix))
19          (setf (gethash nosuffix h) entry)))))          (setf (gethash nosuffix h) entry)))))
20    
21  (defun filt-select-map (filt-options)  (defun filt-select-map (filt-options &key remote-module)
22    (find-bind (:test #'string= :key #'first :take #'second)    (find-bind (:test #'string= :key #'first :take #'second)
23               ((revision "r") (date "D") (extra-r "r") (extra-d "D"))               ((revision "r") (date "D") (extra-r "r") (extra-d "D"))
24               filt-options               filt-options
25      (cond      (cond
26        ((or extra-r extra-d)        ((or extra-r extra-d)
27           (error "only one date or revision may be specified."))           (error "only one date or revision may be specified."))
28        ((or revision date)        ((or revision date remote-module)
29           (with-input-from-program (stream `("cvs" "-Q" "up" "-p"           (unless remote-module
30               (chdir *mcvs-dir*))
31             (with-input-from-program (stream `("cvs" "-Q"
32                                                ,(if remote-module "co" "up") "-p"
33                                              ,@(format-opt filt-options)                                              ,@(format-opt filt-options)
34                                              ,*mcvs-map*))                                              ,(if remote-module
35             (mapping-read stream)))                                                 (format nil "~a/~a"
36                                                           remote-module
37                                                           *mcvs-map-name*)
38                                                   *mcvs-map-name*)))
39               (handler-case
40                 (mapping-read stream)
41                 (error ()
42                   (error "unable to retrieve specified revision of map file.")))))
43        (t (mapping-read *mcvs-map-local*)))))        (t (mapping-read *mcvs-map-local*)))))
44    
45    (defun mcvs-filt-loop (filehash)
46      (loop
47        (let ((line (read-line t nil)))
48          (when (null line)
49            (return (values)))
50          (loop
51            (let ((f-start (search "F-" line :test #'char=))
52                  (mcvs-dir (search "MCVS/F-" line :test #'char=)))
53              (flet ((is-hex-digit (x)
54                       (or (digit-char-p x)
55                           (find x "ABCDEF"))))
56                (cond
57                  ((and mcvs-dir (or (and f-start (< mcvs-dir f-start))
58                                     (not f-start)))
59                    (write-string (subseq line 0 (+ mcvs-dir 7)))
60                    (setf line (subseq line (+ mcvs-dir 7))))
61                  (f-start
62                    (write-string (subseq line 0 f-start))
63                    (setf line (subseq line (+ f-start 2)))
64                    (when (< (length line) 32)
65                      (write-string "F-")
66                      (write-line line)
67                      (return))
68                    (cond
69                      ((notevery #'is-hex-digit (subseq line 0 32))
70                         (write-string "F-")
71                         (setf line (subseq line 2)))
72                      (t (let* ((f-digits (subseq line 0 32))
73                                (entry (gethash (format nil "F-~a" f-digits)
74                                                filehash))
75                                (suffix (and entry
76                                             (suffix (mapping-entry-id entry)))))
77                           (setf line (subseq line 32))
78                           (cond
79                             ((null entry)
80                                (write-string "F-")
81                                (write-string f-digits))
82                             ((and suffix
83                                   (or (< (length line) (1+ (length suffix)))
84                                       (not (path-equal (subseq line 1
85                                                                   (1+ (length suffix)))
86                                                        suffix))))
87                                (write-string "F-")
88                                (write-string f-digits))
89                             (t (write-string (mapping-entry-path entry))
90                                (when suffix
91                                  (setf line
92                                        (subseq line
93                                                   (1+ (length suffix)))))))))))
94                  (t (write-line line)
95                     (return)))))))))
96    
97  (defun mcvs-filt (filt-options)  (defun mcvs-filt (filt-options)
98    (in-sandbox-root-dir    (in-sandbox-root-dir
99      (let* ((filemap (filt-select-map filt-options))      (mcvs-filt-loop (make-filt-hash (filt-select-map filt-options)))))
100             (filehash (make-filt-hash filemap)))  
101        (loop  (defun mcvs-remote-filt (filt-options module)
102          (let ((line (read-line t nil)))    (mcvs-filt-loop (make-filt-hash (filt-select-map filt-options
103            (when (null line)                                                     :remote-module module))))
             (return (values)))  
           (loop  
             (let ((f-start (search "F-" line :test #'char=))  
                   (mcvs-dir (search "MCVS/F-" line :test #'char=)))  
               (flet ((is-hex-digit (x)  
                        (or (digit-char-p x)  
                            (find x "ABCDEF"))))  
                 (cond  
                   ((and mcvs-dir (or (and f-start (< mcvs-dir f-start))  
                                      (not f-start)))  
                     (write-string (subseq line 0 (+ mcvs-dir 7)))  
                     (setf line (subseq line (+ mcvs-dir 7))))  
                   (f-start  
                     (write-string (subseq line 0 f-start))  
                     (setf line (subseq line (+ f-start 2)))  
                     (when (< (length line) 32)  
                       (write-string "F-")  
                       (write-line line)  
                       (return))  
                     (cond  
                       ((notevery #'is-hex-digit (subseq line 0 32))  
                          (write-string "F-")  
                          (setf line (subseq line 2)))  
                       (t (let* ((f-digits (subseq line 0 32))  
                                 (entry (gethash (format nil "F-~a" f-digits)  
                                                 filehash))  
                                 (suffix (and entry  
                                              (suffix (mapping-entry-id entry)))))  
                            (setf line (subseq line 32))  
                            (cond  
                              ((null entry)  
                                 (write-string "F-")  
                                 (write-string f-digits))  
                              ((and suffix  
                                    (or (< (length line) (1+ (length suffix)))  
                                        (not (path-equal (subseq line 1  
                                                                    (1+ (length suffix)))  
                                                         suffix))))  
                                 (write-string "F-")  
                                 (write-string f-digits))  
                              (t (write-string (mapping-entry-path entry))  
                                 (when suffix  
                                   (setf line  
                                         (subseq line  
                                                    (1+ (length suffix)))))))))))  
                   (t (write-line line)  
                      (return)))))))))))  
104    
105  (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)  (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)
106    (declare (ignore cvs-options))    (declare (ignore cvs-options))
107    (when mcvs-args    (when mcvs-args
108      (error "no arguments permitted."))      (error "no arguments permitted."))
109    (mcvs-filt cvs-command-options))    (mcvs-filt cvs-command-options))
110    
111    (defun mcvs-remote-filt-wrapper (cvs-options cvs-command-options mcvs-args)
112      (declare (ignore cvs-options))
113      (unless (= (length mcvs-args) 1)
114        (error "module name required."))
115      (mcvs-remote-filt cvs-command-options (first mcvs-args)))

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

  ViewVC Help
Powered by ViewVC 1.1.5