ViewVC logotype

Contents of /meta-cvs/F-5E30677BF94A6FA7AD45BAA270984CFA.lisp

Parent Directory Parent Directory | Revision Log Revision Log

Revision - (show annotations)
Sun Apr 13 06:22:43 2003 UTC (11 years ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-9, mcvs-1-0-8, mcvs-1-0-7, mcvs-1-0-6
Changes since +4 -1 lines
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.

* code/mapping.lisp (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.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
5 (require "system")
6 (require "mapping")
7 (require "chatter")
8 (provide "link")
10 (defun mcvs-link (target name)
11 (when (or (string= "" target)
12 (string= "" name))
13 (error "empty path names are invalid."))
14 (in-sandbox-root-dir
15 (let* ((mapping (mapping-read *mcvs-map*))
16 (real-name (sandbox-translate-path name))
17 (abs-name (real-to-abstract-path real-name))
18 (trailing-slash (string= (char name (1- (length name))) *path-sep*))
19 (file-info (no-existence-error (stat real-name)))
20 (in-map (mapping-lookup mapping abs-name))
21 (prefix-in-map (mapping-prefix-lookup mapping abs-name))
22 (is-non-dir (or in-map (and file-info (not (directory-p file-info)))))
23 (is-dir (and (not is-non-dir)
24 (or prefix-in-map (directory-p file-info) trailing-slash)))
25 (need-new-entry t))
26 (when (path-prefix-equal *mcvs-dir* abs-name)
27 (error "path ~a is in a reserved Meta-CVS area." abs-name))
29 ;; In case a link clobbers some object that has local edits,
30 ;; we need to synchronize it to the MCVS directory.
31 (chatter-debug "Synchronizing.~%")
32 (mapping-synchronize :direction :left)
34 (flet ((edit-map (entry)
35 (with-slots (path kind (tgt target)) entry
36 (chatter-debug "Clobbering existing object ~a.~%" path)
37 (unlink (abstract-to-real-path path))
38 (cond
39 ((eq kind :symlink)
40 (chatter-debug "Editing existing link.~%")
41 (setf tgt target)
42 (setf need-new-entry nil)
43 (symlink target (abstract-to-real-path path)))
44 (t (setf mapping
45 (remove entry mapping
46 :test #'eq))))))
47 (make-new-entry (abs-name)
48 (when need-new-entry
49 (chatter-debug "Making new symlink entry ~a.~%" abs-name)
50 (push (make-mapping-entry :kind :symlink
51 :id (mapping-generate-id :no-dir t :prefix "S-")
52 :path abs-name
53 :target target)
54 mapping))))
56 (cond
57 (in-map
58 (edit-map in-map)
59 (make-new-entry abs-name))
60 (is-dir
61 (let* ((base (basename target))
62 (real-name (canonicalize-path (path-cat real-name base)))
63 (abs-name (canonicalize-path (path-cat abs-name base)))
64 (name (path-cat name base))
65 (file-info (no-existence-error (stat real-name)))
66 (in-map (mapping-lookup mapping abs-name))
67 (prefix-in-map (mapping-prefix-lookup mapping abs-name))
68 (is-non-dir (or in-map (and file-info (not (directory-p file-info)))))
69 (is-dir (and (not is-non-dir)
70 (or prefix-in-map (directory-p file-info)))))
71 (when is-dir
72 (error "~a is a directory." name))
73 (when in-map
74 (edit-map in-map))
75 (make-new-entry abs-name)))
76 (t (make-new-entry abs-name))))
77 (mapping-write mapping *mcvs-map* :sort-map t)
78 (chatter-debug "Updating file structure.~%")
79 (mapping-update)))
80 (values))
82 (defun mcvs-link-wrapper (global-options command-options args)
83 (declare (ignore global-options command-options))
84 (when (/= (length args) 2)
85 (error "specify link target and link name."))
86 (mcvs-link (first args) (second args)))
88 (defconstant *link-help*
89 "Syntax:
91 mcvs link target-path name
93 Semantics:
95 Create a symbolic link with the given, pointing to the given target path.
96 Note the braindamaged reverse syntax, which is designed to be consistent
97 with the Unix ``ln'' command. To make the symbolic link @foo -> bar,
98 use ``mcvs ln bar foo''.
100 Another way to add links is to create a symlink, and then use the add
101 command.")

  ViewVC Help
Powered by ViewVC 1.1.5