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

Contents of /meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.35 - (hide annotations)
Tue Nov 28 07:47:21 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.34: +5 -5 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

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

  ViewVC Help
Powered by ViewVC 1.1.5