/[meta-cvs]/meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C
ViewVC logotype

Diff of /meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C

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

revision 1.21 by kaz, Mon Jul 8 05:50:17 2002 UTC revision 1.22 by kaz, Sat Oct 5 18:09:48 2002 UTC
# Line 11  Line 11 
11  (defun source-check (expansion source)  (defun source-check (expansion source)
12    (let ((real (abstract-to-real-path source)))    (let ((real (abstract-to-real-path source)))
13      (when (path-prefix-equal *mcvs-dir* real)      (when (path-prefix-equal *mcvs-dir* real)
14         (error "mcvs-move: source path ~a is in a reserved Meta-CVS area." real))         (error "source path ~a is in a reserved Meta-CVS area." real))
15      (when (not expansion)      (when (not expansion)
16        (if (exists real)        (if (exists real)
17          (error "mcvs-move: ~a is local, not versioned under Meta-CVS." real)          (error "~a is local, not versioned under Meta-CVS." real)
18          (error "mcvs-move: ~a does not exist." real)))))          (error "~a does not exist." real)))))
19    
20  (defun simple-rename (filemap source dest-file)  (defun simple-rename (filemap source dest-file)
21    (let ((dir-expansion (mapping-extract-paths    (let ((dir-expansion (mapping-extract-paths
# Line 56  Line 56 
56          (simple-move-to-dir filemap (first sources) destination)          (simple-move-to-dir filemap (first sources) destination)
57          (simple-rename filemap (first sources) destination))          (simple-rename filemap (first sources) destination))
58        (if destination-file-exists        (if destination-file-exists
59          (error "mcvs-move: cannot move multiple to ~a." destination)          (error "cannot move multiple to ~a." destination)
60          (dolist (source sources filemap)          (dolist (source sources filemap)
61            (can-restart-here ("Skip ~a and continue renaming." source)            (can-restart-here ("Skip ~a and continue renaming." source)
62              (setf filemap (simple-move-to-dir filemap source destination))))))))              (setf filemap (simple-move-to-dir filemap source destination))))))))
63    
64  (defun mcvs-move (args)  (defun mcvs-move (args)
65    (when (< (length args) 2)    (when (< (length args) 2)
66      (error "mcvs-move: requires at least two arguments."))      (error "requires at least two arguments."))
67    (in-sandbox-root-dir    (in-sandbox-root-dir
68      (chatter-debug "Renaming.~%")      (chatter-debug "Renaming.~%")
69      (let ((filemap (mapping-read *mcvs-map*))      (let ((filemap (mapping-read *mcvs-map*))
# Line 74  Line 74 
74    
75        (let ((dest-real (abstract-to-real-path destination)))        (let ((dest-real (abstract-to-real-path destination)))
76          (when (path-prefix-equal *mcvs-dir* dest-real)          (when (path-prefix-equal *mcvs-dir* dest-real)
77            (error "mcvs-move: destination path ~a is in a reserved Meta-CVS area."            (error "destination path ~a is in a reserved Meta-CVS area."
78                   dest-real)))                   dest-real)))
79    
80        (let ((edited-filemap (move-guts filemap sources destination))        (let ((edited-filemap (move-guts filemap sources destination))
# Line 88  Line 88 
88              (when (mapping-update)              (when (mapping-update)
89                (setf restore-map nil)))                (setf restore-map nil)))
90            (when restore-map            (when restore-map
91              (chatter-debug "Undoing move.~%")              (chatter-terse "Undoing move.~%")
92              (mapping-write filemap *mcvs-map*)))))              (mapping-write filemap *mcvs-map*)))))
93    (values)))    (values)))
94    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

  ViewVC Help
Powered by ViewVC 1.1.5