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

Contents of /meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26.2.4 - (hide annotations)
Thu Apr 24 04:02:55 2003 UTC (11 years ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-1-0-11, mcvs-1-0-10, mcvs-1-0-13, mcvs-1-0-12, mcvs-1-0-9, mcvs-1-0-8, mcvs-1-0-7
Changes since 1.26.2.3: +1 -1 lines
Improved error handling again in a flash of sanity. The whole
idea of ``bail'' as a restart is gone. All code which must perform
some complex cleanup action does so as part of normal unwinding.
And so termination becomes safe.

* code/update.lisp (mcvs-update): Change bail restart to continue.

* code/mcvs-main.lisp (*global-options*): Remove "error-bail".
(*usage*): Remove description of --error-bail.
(mcvs-execute): Bind *mcvs-error-treatment* to :terminate rather
than :bail if controlling TTY cannot be opened.

* code/move.lisp (mcvs-move): Change "Undoing move" error message
to "Undoing changes to map".

* code/add.lisp (mcvs-add): Get rid of bail restart; move cleanup
code into unwind-protect block.

* code/error.lisp (*mcvs-error-treatment*): Touch up docstring.
(mcvs-error-handler): Remove anything having to do with :bail.
Change description of `T' command to suggest that it is safe.

* code/options.lisp (filter-mcvs-options): Remove handling of
"error-bail" option.

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

  ViewVC Help
Powered by ViewVC 1.1.5