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

Contents of /meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.29 - (hide annotations)
Mon Nov 4 02:09:17 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-3
Changes since 1.28: +1 -5 lines
Merging from mcvs-1-0-branch.
1 kaz 1.9 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.5 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "system")
6     (require "mapping")
7     (require "chatter")
8 kaz 1.21 (require "restart")
9 kaz 1.28 (require "mcvs-package")
10 kaz 1.1 (provide "move")
11 kaz 1.28
12     (in-package "META-CVS")
13 kaz 1.1
14 kaz 1.17 (defun source-check (expansion source)
15 kaz 1.20 (let ((real (abstract-to-real-path source)))
16     (when (path-prefix-equal *mcvs-dir* real)
17 kaz 1.22 (error "source path ~a is in a reserved Meta-CVS area." real))
18 kaz 1.24 (when (path-equal *this-dir* real)
19     (error "cannot move the sandbox root directory."))
20 kaz 1.20 (when (not expansion)
21     (if (exists real)
22 kaz 1.22 (error "~a is local, not versioned under Meta-CVS." real)
23     (error "~a does not exist." real)))))
24 kaz 1.17
25 kaz 1.1 (defun simple-rename (filemap source dest-file)
26 kaz 1.11 (let ((dir-expansion (mapping-extract-paths
27     (mapping-prefix-matches filemap source))))
28 kaz 1.17 (source-check dir-expansion source)
29 kaz 1.12 (mapping-rename-files filemap dir-expansion source dest-file)))
30 kaz 1.1
31     (defun simple-move-to-dir (filemap source dest-dir)
32 kaz 1.11 (let ((dir-expansion (mapping-extract-paths
33     (mapping-prefix-matches filemap source))))
34 kaz 1.17 (source-check dir-expansion source)
35 kaz 1.7 (multiple-value-bind (base dir) (basename source)
36     (if dir
37     (if (path-equal dest-dir *this-dir*)
38 kaz 1.11 (mapping-rename-files filemap dir-expansion source base)
39     (mapping-rename-files filemap dir-expansion dir dest-dir))
40     (mapping-rename-files filemap dir-expansion source
41 kaz 1.21 (canonicalize-path (path-cat dest-dir base)))))))
42 kaz 1.1
43     (defun move-guts (filemap sources destination)
44     (let* ((two-args (null (second sources)))
45 kaz 1.15 (destination-trailing-slash (string= (char destination
46     (1- (length destination)))
47     *path-sep*))
48 kaz 1.26 (dest-real-path (abstract-to-real-path destination))
49 kaz 1.20 (destination-file-object (no-existence-error (stat dest-real-path)))
50 kaz 1.11 (destination-file-exists (or (mapping-lookup filemap destination)
51 kaz 1.8 (and destination-file-object
52     (not (directory-p
53     destination-file-object)))))
54 kaz 1.1 (destination-dir-exists (and (not destination-file-exists)
55 kaz 1.11 (or (mapping-prefix-lookup filemap
56 kaz 1.8 destination)
57 kaz 1.15 (directory-p destination-file-object)
58     destination-trailing-slash))))
59 kaz 1.1 (if two-args
60     (if destination-dir-exists
61     (simple-move-to-dir filemap (first sources) destination)
62     (simple-rename filemap (first sources) destination))
63     (if destination-file-exists
64 kaz 1.22 (error "cannot move multiple to ~a." destination)
65 kaz 1.25 (let ((skipped-all t))
66     (dolist (source sources filemap)
67     (can-restart-here ("Skip ~a and continue renaming." source)
68     (setf filemap (simple-move-to-dir filemap source destination))
69     (setf skipped-all nil)))
70     (when skipped-all
71     (error "skipped all move sources."))
72     filemap)))))
73 kaz 1.1
74 kaz 1.4 (defun mcvs-move (args)
75     (when (< (length args) 2)
76 kaz 1.22 (error "requires at least two arguments."))
77 kaz 1.1 (in-sandbox-root-dir
78 kaz 1.14 (chatter-debug "Renaming.~%")
79 kaz 1.10 (let ((filemap (mapping-read *mcvs-map*))
80 kaz 1.20 (sources (mapcar #'real-to-abstract-path
81     (mapcar #'sandbox-translate-path (butlast args))))
82 kaz 1.26 (destination (canonicalize-path
83     (real-to-abstract-path
84     (sandbox-translate-path (first (last args)))))))
85 kaz 1.1
86 kaz 1.20 (let ((dest-real (abstract-to-real-path destination)))
87     (when (path-prefix-equal *mcvs-dir* dest-real)
88 kaz 1.22 (error "destination path ~a is in a reserved Meta-CVS area."
89 kaz 1.20 dest-real)))
90 kaz 1.2
91 kaz 1.13 (let ((edited-filemap (move-guts filemap sources destination))
92     (restore-map t))
93 kaz 1.23 (setf edited-filemap (sort edited-filemap
94     #'string< :key #'mapping-entry-id))
95     (when (equal-filemaps edited-filemap filemap)
96     (error "useless move of an object onto itself"))
97 kaz 1.14 (chatter-debug "Synchronizing.~%")
98 kaz 1.13 (mapping-synchronize)
99     (unwind-protect
100     (progn
101 kaz 1.23 (mapping-write edited-filemap *mcvs-map* :sort-map nil)
102 kaz 1.14 (chatter-debug "Updating file structure.~%")
103 kaz 1.13 (when (mapping-update)
104     (setf restore-map nil)))
105     (when restore-map
106 kaz 1.22 (chatter-terse "Undoing move.~%")
107 kaz 1.13 (mapping-write filemap *mcvs-map*)))))
108 kaz 1.1 (values)))
109 kaz 1.2
110 kaz 1.6 (defun mcvs-move-wrapper (cvs-options cvs-command-options mcvs-args)
111 kaz 1.29 (declare (ignore cvs-options cvs-command-options))
112 kaz 1.4 (mcvs-move mcvs-args))
113 kaz 1.27
114     (defconstant *move-help*
115     "Syntax:
116    
117     mcvs move objects ... destination
118    
119     Options:
120    
121     none
122    
123     Semantics:
124    
125     The move command changes the names of versioned objects, resulting in a local
126     edit of the map. Like any other local change, a move is not published to the
127     repository until it is committed.
128    
129     A move which affects the last component of a path is known as a rename; the
130     object appears to stay in the same directory, but its name changes. A move
131     affecting one or more of the other components appears to be a relocation.
132     Both of these are the same thing to the software.
133    
134     The move command relocates only those files which are versioned in Meta-CVS;
135     it does not act upon local files. However, files can be moved into local
136     directories. Files can also be moved such that they clobber local files.
137    
138     The behavior of the command very convenient, obeying the following rules:
139    
140     - If the destination is an existing directory in the sandbox,
141     then the pathnames of the objects are renamed such that the objects are
142     relocated into that directory. If any of the source objects
143     are directories, then they are moved.
144    
145     - If the destination is an existing file, then there must be exactly one
146     source argument; two or more objects cannot be moved to a non-directory
147     object. If that object is a local file, then the move produces an error,
148     which can be interactively resolved in favor of clobbering the file.
149     If the object is a Meta-CVS versioned file, then it is silently removed
150     as if by the remove command (which means that it is not lost, merely
151     unlinked from the map).
152    
153     - If the destination does not exist, then it is deemed to be a directory
154     name if there are two or more source arguments, or to be a non-directory
155     name if there is one source argument. In the first case, the directory
156     is automatically created; there is no need for mkdir as with the Unix
157     mv command, so this is a nice convenience.
158    
159     - If a move causes any directory to become empty, meaning that it contains
160     no local files, or Meta-CVS versioned files, that directory is removed.
161     This rule is applied recursively all the way up to the sandbox root: if
162     removing a directory causes its parent to become empty, that parent is
163     removed and so forth. Remember, empty directories have no representation
164     in Meta-CVS, and this is another way in which this turns out to be
165     a convenience. Directories that are not empty are not removed, even
166     if they contain only local files not known to the version control system.
167    
168     - A directory can be moved into itself or to a subdirectory of itself.
169     The reader is invited to experiment to see how this works. The Unix
170     mv command disallows this, as does the underlying rename() system
171     call, so this is a third convenience.
172    
173     - The root directory of a full or partial sandbox cannot be a source
174     argument.")

  ViewVC Help
Powered by ViewVC 1.1.5