/[meta-cvs]/meta-cvs/F-300FB44635F94930416CE1B06097B230.lisp
ViewVC logotype

Contents of /meta-cvs/F-300FB44635F94930416CE1B06097B230.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (hide annotations)
Sun Apr 13 14:39:11 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.7: +2 -0 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.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 kaz 1.6 (require "mcvs-package")
9 kaz 1.1 (provide "prop")
10 kaz 1.6
11     (in-package "META-CVS")
12 kaz 1.1
13     (defun mcvs-prop (prop-options files)
14     (in-sandbox-root-dir
15     (let (entries-to-process
16 kaz 1.5 (filemap (mapping-read *mcvs-map*)))
17 kaz 1.1 (chatter-debug "Preparing file list.~%")
18    
19     (if (null files)
20     (setf entries-to-process
21     (mapping-prefix-matches filemap
22     (sandbox-translate-path ".")))
23     (dolist (file files)
24     (can-restart-here ("Continue preparing file list.")
25     (let* ((full-name (sandbox-translate-path file))
26 kaz 1.4 (abs-name (canonicalize-path
27     (real-to-abstract-path full-name)))
28 kaz 1.1 (entries (mapping-prefix-matches filemap abs-name)))
29     (if (not entries)
30 kaz 1.3 (error "~a is not known to Meta-CVS." full-name)
31 kaz 1.1 (setf entries-to-process (nconc entries-to-process entries)))))))
32    
33 kaz 1.7 (when (and entries-to-process prop-options)
34 kaz 1.1 ;; do the property update
35     (chatter-debug "Updating properties.~%")
36     (dolist (entry entries-to-process)
37     (with-slots (raw-plist) entry
38 kaz 1.2 (loop for (option prop-name value) in prop-options do
39     (let ((indicator (intern (string-upcase prop-name) "KEYWORD")))
40 kaz 1.1 (cond
41     ((string= option "set")
42     (setf (getf raw-plist indicator) t))
43     ((string= option "clear")
44     (setf (getf raw-plist indicator) nil))
45 kaz 1.2 ((string= option "value")
46     (setf (getf raw-plist indicator) (read-from-string value)))
47 kaz 1.1 ((string= option "remove")
48     (remf raw-plist indicator)))
49     (mapping-entry-parse-plist entry)))))
50     (chatter-debug "Writing out map.~%")
51     (mapping-write filemap *mcvs-map*)
52 kaz 1.8 ;; propagate changes to local map.
53 kaz 1.1 (chatter-debug "Updating file structure.~%")
54     (mapping-update)
55 kaz 1.8 ;; propagate permission changes to files.
56 kaz 1.1 (chatter-debug "Synchronizing.~%")
57     (mapping-synchronize))))
58     (values))
59    
60     (defun mcvs-prop-wrapper (mcvs-opts command-opts command-args)
61     (declare (ignore mcvs-opts))
62     (mcvs-prop command-opts command-args))

  ViewVC Help
Powered by ViewVC 1.1.5