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

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

  ViewVC Help
Powered by ViewVC 1.1.5