/[meta-cvs]/meta-cvs/F-26D2A2DCE1CF180F943606C59DC63A51.lisp
ViewVC logotype

Diff of /meta-cvs/F-26D2A2DCE1CF180F943606C59DC63A51.lisp

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

revision 1.7 by kaz, Mon Jul 1 16:16:25 2002 UTC revision 1.7.2.2 by kaz, Sat Jul 6 16:59:57 2002 UTC
# Line 159  Line 159 
159              (set-difference added-files taken-added :test #'eq)              (set-difference added-files taken-added :test #'eq)
160              (set-difference removed-files taken-removed :test #'eq))))              (set-difference removed-files taken-removed :test #'eq))))
161    
162  (defun mcvs-grab (global-options command-options module branch)  (defun mcvs-grab (global-options command-options module subdir branch)
163    (declare (ignore command-options))    (declare (ignore command-options))
164    (mcvs-checkout module global-options    (mcvs-checkout module subdir global-options
165                   `(("d" ,*this-dir*) ("r" ,branch))                   `(("d" ,*this-dir*) ("r" ,branch))
166                   :no-generate t)                   :no-generate t)
167    (in-sandbox-root-dir    (in-sandbox-root-dir
168      (let ((old-paths (sort (mapping-read *mcvs-map*)      (let ((old-paths (mapping-read *mcvs-map*))
169                             #'string< :key #'second))            invisible-old-paths new-paths added-files removed-files stable-files)
           new-paths added-files removed-files stable-files)  
170        (chatter-info "Scanning directory structure.~%")        (chatter-info "Scanning directory structure.~%")
171          (multiple-value-setq (old-paths invisible-old-paths)
172                               (separate-if #'real-path-exists old-paths
173                                            :key #'second))
174          (setf old-paths (mapcar #'(lambda (entry)
175                                      (destructuring-bind (object name &rest stuff)
176                                                          entry
177                                        (list* object (abstract-to-real-path name)
178                                               stuff))) old-paths))
179    
180          (setf old-paths (sort old-paths #'string< :key #'second))
181    
182        (for-each-file-info (fi *this-dir*)        (for-each-file-info (fi *this-dir*)
183          (let ((path (canonicalize-path (file-name fi))))          (let* ((path (canonicalize-path (file-name fi))))
184            (cond            (cond
185              ((regular-p fi)              ((regular-p fi)
186                 (push path new-paths))                 (push path new-paths))
# Line 225  Line 234 
234                                (let ((replacement (gethash (first entry)                                (let ((replacement (gethash (first entry)
235                                                            f-hash)))                                                            f-hash)))
236                                  (if replacement                                  (if replacement
237                                    (list (first entry) replacement)                                    (list (first entry)
238                                            (real-to-abstract-path replacement))
239                                    entry)))                                    entry)))
240                            mapping))                            mapping))
241              (mapping-write mapping *mcvs-map*))              (mapping-write mapping *mcvs-map*))
# Line 233  Line 243 
243            (dolist (entry mapping)            (dolist (entry mapping)
244              (when (gethash (first entry) f-hash)              (when (gethash (first entry) f-hash)
245                (unlink (first entry))                (unlink (first entry))
246                (link (second entry) (first entry))))                (link (abstract-to-real-path (second entry)) (first entry))))
247            (dolist (entry stable-files)            (dolist (entry stable-files)
248              (unlink (first entry))              (unlink (first entry))
249              (link (second entry) (first entry))))              (link (second entry) (first entry))))
# Line 243  Line 253 
253            (mcvs-add nil global-options nil (mapcar #'first added-files)))))))            (mcvs-add nil global-options nil (mapcar #'first added-files)))))))
254    
255  (defun mcvs-grab-wrapper (global-options command-options args)  (defun mcvs-grab-wrapper (global-options command-options args)
256    (when (/= (length args) 2)    (flet ((error ()
257      (error "mcvs-grab: specify module name and branch."))             (error "mcvs-grab: specify module name, branch and optional subdirectory.")))
258    (destructuring-bind (module branch) args      (when (< (length args) 2)
259      (mcvs-grab global-options command-options module branch)))        (error))
260        (destructuring-bind (module branch &optional subdir &rest superfluous) args
261          (when superfluous
262            (error))
263          (mcvs-grab global-options command-options module subdir branch))))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.7.2.2

  ViewVC Help
Powered by ViewVC 1.1.5