ViewVC logotype

Contents of /meta-cvs/F-255EFD9E99EDDE6614CF2CD912CA4E5C

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.30 - (hide annotations)
Sun Apr 13 14:39:11 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.29: +5 -1 lines
Merging from mcvs-1-0-branch.

* code/mapping.lisp (mapping-read): Provide a restart for
file errors, which lets the user interactively substitute an
empty map if the file can't be read. This is intended to handle
the case when MCVS/MAP is missing; for example, the user
updated to a sticky date for which no revision of the MAP
exists. The effect of continuing will be that all files
will disappear.
(mapping-synchronize): New :direction key
parameter, passed down to synchronize-filed. The new :no-sync
return value from synchronize-files is handled.
(mapping-update): Select the :right direction for synchronizing
moves, adds or rollbacks.

Revamped the synchronization logic. Synchronization now happens
in a specific direction.  For example, if we are doing a diff,
we just need to push changes from the tree to the MCVS directory,
not the other way around. Or: before an update or commit, we push from
the tree to MCVS, then after the update, in the other direction.

* code/update.lisp (mcvs-update): The before update is done
in the :left direction only, and the after update in the :right.

* code/move.lisp (mcvs-move): The just-in-case sync is done
in the :left direction only.

* code/link.lisp (mcvs-link): Likewise.

* code/remove.lisp (mcvs-remove): Likewise.

* code/add.lisp (mcvs-add): Get rid of mapping-synchronize call;
it's completely unnecessary, since the new files are not even
in the MAP-LOCAL, and the add logic explicitly links them into
the MCVS directory.

* code/generic.lisp (mcvs-generic): New keyword parameter,
need-sync-before. Before-synchronization done in :left direction,
after-synchronization in :right direction. Before-synchronization
is now not done by default; need-sync-before must be specified.
(mcvs-commit-wrapper): Specify before and after sync.
(mcvs-diff-wrapper, mcvs-status-wrapper,
mcvs-edit-wrapper): Explicitly specify before sync.
(mcvs-tag-wrapper, mcvs-annotate-wrapper): Implicitly specify no sync.
(mcvs-unedit-wrapper): Add before sync.

* code/sync.lisp (synchronize-files):  New key parameter :direction,
values can be :left, :right or :either. Default is :either.
If the value is :left or :right, then a sync is done only in that
direction, otherwise the value :no-sync is returned.
Behavior change: if the left file is missing (F- file in MCVS
directory) it is not re-created, but rather :no-sync is returned.
Also, if both files exist, have the same timestamp, and are
distinct objects, if the direction is :left or :right, then
the appropriate restart is automatically chosen. So this will
do the right thing on filesystems where link() is performed by
copying, without bothering the user with the error.
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
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.30
98     ;; In case a move clobbers some object that has local edits,
99     ;; we need to synchronize it to the MCVS directory.
100 kaz 1.14 (chatter-debug "Synchronizing.~%")
101 kaz 1.30 (mapping-synchronize :direction :left)
103 kaz 1.13 (unwind-protect
104     (progn
105 kaz 1.23 (mapping-write edited-filemap *mcvs-map* :sort-map nil)
106 kaz 1.14 (chatter-debug "Updating file structure.~%")
107 kaz 1.13 (when (mapping-update)
108     (setf restore-map nil)))
109     (when restore-map
110 kaz 1.22 (chatter-terse "Undoing move.~%")
111 kaz 1.13 (mapping-write filemap *mcvs-map*)))))
112 kaz 1.1 (values)))
113 kaz 1.2
114 kaz 1.6 (defun mcvs-move-wrapper (cvs-options cvs-command-options mcvs-args)
115 kaz 1.29 (declare (ignore cvs-options cvs-command-options))
116 kaz 1.4 (mcvs-move mcvs-args))
117 kaz 1.27
118     (defconstant *move-help*
119     "Syntax:
121     mcvs move objects ... destination
123     Options:
125     none
127     Semantics:
129     The move command changes the names of versioned objects, resulting in a local
130     edit of the map. Like any other local change, a move is not published to the
131     repository until it is committed.
133     A move which affects the last component of a path is known as a rename; the
134     object appears to stay in the same directory, but its name changes. A move
135     affecting one or more of the other components appears to be a relocation.
136     Both of these are the same thing to the software.
138     The move command relocates only those files which are versioned in Meta-CVS;
139     it does not act upon local files. However, files can be moved into local
140     directories. Files can also be moved such that they clobber local files.
142     The behavior of the command very convenient, obeying the following rules:
144     - If the destination is an existing directory in the sandbox,
145     then the pathnames of the objects are renamed such that the objects are
146     relocated into that directory. If any of the source objects
147     are directories, then they are moved.
149     - If the destination is an existing file, then there must be exactly one
150     source argument; two or more objects cannot be moved to a non-directory
151     object. If that object is a local file, then the move produces an error,
152     which can be interactively resolved in favor of clobbering the file.
153     If the object is a Meta-CVS versioned file, then it is silently removed
154     as if by the remove command (which means that it is not lost, merely
155     unlinked from the map).
157     - If the destination does not exist, then it is deemed to be a directory
158     name if there are two or more source arguments, or to be a non-directory
159     name if there is one source argument. In the first case, the directory
160     is automatically created; there is no need for mkdir as with the Unix
161     mv command, so this is a nice convenience.
163     - If a move causes any directory to become empty, meaning that it contains
164     no local files, or Meta-CVS versioned files, that directory is removed.
165     This rule is applied recursively all the way up to the sandbox root: if
166     removing a directory causes its parent to become empty, that parent is
167     removed and so forth. Remember, empty directories have no representation
168     in Meta-CVS, and this is another way in which this turns out to be
169     a convenience. Directories that are not empty are not removed, even
170     if they contain only local files not known to the version control system.
172     - A directory can be moved into itself or to a subdirectory of itself.
173     The reader is invited to experiment to see how this works. The Unix
174     mv command disallows this, as does the underlying rename() system
175     call, so this is a third convenience.
177     - The root directory of a full or partial sandbox cannot be a source
178     argument.")

  ViewVC Help
Powered by ViewVC 1.1.5