/[meta-cvs]/meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0
ViewVC logotype

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26 - (show annotations)
Sun Apr 13 14:39:12 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.25: +4 -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 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "system")
6 (require "mapping")
7 (require "chatter")
8 (require "find-bind")
9 (require "mcvs-package")
10 (provide "remove")
11
12 (in-package "META-CVS")
13
14 (defun mcvs-remove (recursivep files &key no-sync)
15 (when (null files)
16 (return-from mcvs-remove (values)))
17
18 (in-sandbox-root-dir
19 (let (files-to-remove (filemap (mapping-read *mcvs-map*)))
20
21 (chatter-debug "Unmapping.~%")
22 (dolist (file files)
23 (can-restart-here ("Continue unmapping files.")
24 (let* ((full-name (sandbox-translate-path file))
25 (abs-name (canonicalize-path
26 (real-to-abstract-path full-name)))
27 (entries (mapping-prefix-matches filemap abs-name)))
28 (cond
29 ((path-prefix-equal *mcvs-dir* full-name)
30 (error "cannot remove ~a: path is in a reserved Meta-CVS area."
31 full-name))
32 ((and (second entries) (not recursivep))
33 (error "cannot remove ~a: it is a directory, use -R to remove."
34 full-name))
35 ((not entries)
36 (if (exists full-name)
37 (error "cannot remove ~a: it is local, not versioned under Meta-CVS."
38 full-name)
39 (error "cannot remove ~a: it does not exist." full-name)))
40 (t (setf files-to-remove (nconc files-to-remove entries)))))))
41
42 (when files-to-remove
43 ;; Removed files might have unsynchronized local edits, which
44 ;; will be irretrievably lost if we don't synchronize.
45 ;; But the grab command does not need this, hence no-sync option.
46 (chatter-debug "Synchronizing.~%")
47 (unless no-sync
48 (mapping-synchronize :direction :left))
49 (let ((new-filemap (set-difference filemap files-to-remove
50 :test #'mapping-same-id-p)))
51 (mapping-write new-filemap *mcvs-map* :sort-map t))
52
53 (chatter-debug "Updating file structure.~%")
54 (mapping-update :no-delete-removed no-sync))))
55 (values))
56
57 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
58 (declare (ignore cvs-options))
59 (find-bind (:test #'string= :key #'first)
60 ((recursivep "R"))
61 cvs-command-options
62 (mcvs-remove recursivep mcvs-args)))
63
64 (defconstant *remove-help*
65 "Syntax:
66
67 mcvs remove [ options ] objects ...
68
69 Options:
70
71 -R Recursive behavior: recursively remove objects
72 in subdirectories. By default, trying to remove
73 a subdirectory signals a continuable error.
74
75 Semantics:
76
77 The remove command removes objects from the mapping. To propagate
78 the removal to the repository, a commit operation must be invoked.
79
80 Removed files are not actually subject to a CVS-level erasure; they are
81 merely removed from the map, but still exist in the MCVS subdirectory. Their
82 local modifications are not lost. To actually remove files from CVS,
83 use the purge command. Removed files that have not been purged can be
84 recovered via the restore command which re-creates mapping entries for them
85 in the lost+found directory under machine-generated names; they can then be
86 renamed to more appropriate names. Symbolic links cannot be restored;
87 they exist as mapping entries only.")

  ViewVC Help
Powered by ViewVC 1.1.5