/[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.15 by kaz, Mon Oct 21 04:48:14 2002 UTC revision 1.16 by kaz, Thu Oct 31 04:06:01 2002 UTC
# Line 5  Line 5 
5  (require "system")  (require "system")
6  (require "mapping")  (require "mapping")
7  (require "options")  (require "options")
8    (require "mcvs-package")
9  (provide "filt")  (provide "filt")
10    
11    (in-package "META-CVS")
12    
13  (defun make-filt-hash (mapping)  (defun make-filt-hash (mapping)
14    (let ((h (make-hash-table :test #'equal)))    (let ((h (make-hash-table :test #'equal)))
15      (dolist (entry mapping h)      (dolist (entry mapping h)
# Line 46  Line 49 
49                  (cond                  (cond
50                    ((and mcvs-dir (or (and f-start (< mcvs-dir f-start))                    ((and mcvs-dir (or (and f-start (< mcvs-dir f-start))
51                                       (not f-start)))                                       (not f-start)))
52                      (write-string (substring line 0 (+ mcvs-dir 7)))                      (write-string (subseq line 0 (+ mcvs-dir 7)))
53                      (setf line (substring line (+ mcvs-dir 7))))                      (setf line (subseq line (+ mcvs-dir 7))))
54                    (f-start                    (f-start
55                      (write-string (substring line 0 f-start))                      (write-string (subseq line 0 f-start))
56                      (setf line (substring line (+ f-start 2)))                      (setf line (subseq line (+ f-start 2)))
57                      (when (< (length line) 32)                      (when (< (length line) 32)
58                        (write-string "F-")                        (write-string "F-")
59                        (write-line line)                        (write-line line)
60                        (return))                        (return))
61                      (cond                      (cond
62                        ((notevery #'is-hex-digit (substring line 0 32))                        ((notevery #'is-hex-digit (subseq line 0 32))
63                           (write-string "F-")                           (write-string "F-")
64                           (setf line (substring line 2)))                           (setf line (subseq line 2)))
65                        (t (let* ((f-digits (substring line 0 32))                        (t (let* ((f-digits (subseq line 0 32))
66                                  (entry (gethash (format nil "F-~a" f-digits)                                  (entry (gethash (format nil "F-~a" f-digits)
67                                                  filehash))                                                  filehash))
68                                  (suffix (and entry                                  (suffix (and entry
69                                               (suffix (mapping-entry-id entry)))))                                               (suffix (mapping-entry-id entry)))))
70                             (setf line (substring line 32))                             (setf line (subseq line 32))
71                             (cond                             (cond
72                               ((null entry)                               ((null entry)
73                                  (write-string "F-")                                  (write-string "F-")
74                                  (write-string f-digits))                                  (write-string f-digits))
75                               ((and suffix                               ((and suffix
76                                     (or (< (length line) (1+ (length suffix)))                                     (or (< (length line) (1+ (length suffix)))
77                                         (not (path-equal (substring line 1                                         (not (path-equal (subseq line 1
78                                                                     (1+ (length suffix)))                                                                     (1+ (length suffix)))
79                                                          suffix))))                                                          suffix))))
80                                  (write-string "F-")                                  (write-string "F-")
# Line 79  Line 82 
82                               (t (write-string (mapping-entry-path entry))                               (t (write-string (mapping-entry-path entry))
83                                  (when suffix                                  (when suffix
84                                    (setf line                                    (setf line
85                                          (substring line                                          (subseq line
86                                                     (1+ (length suffix)))))))))))                                                     (1+ (length suffix)))))))))))
87                    (t (write-line line)                    (t (write-line line)
88                       (return)))))))))))                       (return)))))))))))

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

  ViewVC Help
Powered by ViewVC 1.1.5