ViewVC logotype

Diff of /meta-cvs/F-FA1826D235E55390A70DEBE51DC3234B.lisp

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

revision 1.3 by kaz, Sat Jul 6 17:15:02 2002 UTC revision 1.4 by kaz, Sat Aug 31 20:53:13 2002 UTC
# Line 11  Line 11 
11      (let* ((old-mapping (mapping-read *mcvs-map-local*))      (let* ((old-mapping (mapping-read *mcvs-map-local*))
12             (cvs-mapping (mapping-read *mcvs-map*))             (cvs-mapping (mapping-read *mcvs-map*))
13             (inode-hash (make-hash-table :test #'eql))             (inode-hash (make-hash-table :test #'eql))
14             (new-mapping (remove-if #'real-path-exists             (new-mapping (remove-if #'(lambda (entry)
15                                     old-mapping :key #'second)))                                         (with-slots (path kind) entry
16                                             (and (eq kind :file)
17                                                  (real-path-exists path))))
18                                       old-mapping)))
19        (restart-case        (restart-case
20          (when (not (equal old-mapping cvs-mapping))          (when (not (equal-filemaps old-mapping cvs-mapping))
21            (error "mcvs-remap: local and repository mappings differ."))            (error "mcvs-remap: local and repository mappings differ."))
22          (ignore () :report "remap anyway, clobbering repository mapping"))          (ignore () :report "remap anyway, clobbering repository mapping"))
23        (dolist (entry old-mapping)        (dolist (entry old-mapping)
24          (let ((file-info (stat (first entry))))          (with-slots (id kind) entry
25            (setf (gethash (inode file-info) inode-hash) (first entry))))            (when (eq kind :file)
26                (let ((file-info (stat id)))
27                  (setf (gethash (inode file-info) inode-hash) id)))))
28        (for-each-file-info (fi ".")        (for-each-file-info (fi ".")
29          (let* ((path (canonicalize-path (file-name fi)))          (let* ((path (canonicalize-path (file-name fi)))
30                 (abs-path (real-to-abstract-path path)))                 (abs-path (real-to-abstract-path path)))
# Line 27  Line 32 
32              ((regular-p fi)              ((regular-p fi)
33                (let ((f-file (gethash (inode fi) inode-hash)))                (let ((f-file (gethash (inode fi) inode-hash)))
34                  (when f-file                  (when f-file
35                    (push (list f-file abs-path) new-mapping)                    (push (make-mapping-entry :kind :file
36                                                :id f-file
37                                                :path abs-path)
38                            new-mapping)
39                    (setf (gethash (inode fi) inode-hash) nil))))                    (setf (gethash (inode fi) inode-hash) nil))))
40                ((symlink-p fi)
41                  (chatter-info "skipping symbolic link ~a.~%" path))
42              ((directory-p fi)              ((directory-p fi)
43                (when (path-equal path *mcvs-dir*)                (when (path-equal path *mcvs-dir*)
44                  (skip))))))                  (skip))))))

Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5