ViewVC logotype

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

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-6
Changes since +17 -9 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 "types")
8 (require "chatter")
9 (require "options")
10 (provide "generic")
12 (defun mcvs-generic (cvs-command cvs-options command-options command-args
13 files &key need-sync-before need-sync-after
14 default-include-meta-files need-update-after
15 global-if-empty-file-list)
16 (in-sandbox-root-dir
17 (let (files-to-process
18 (filemap (mapping-read *mcvs-map-local*))
19 (do-meta-files (and (or *metaonly-option* *meta-option*
20 default-include-meta-files)
21 (not (and (null files)
22 global-if-empty-file-list
23 (not *metaonly-option*)))
24 (not *nometa-option*))))
26 (unless (or *metaonly-option*)
27 (chatter-debug "Preparing file list.~%")
29 (if (null files)
30 (unless global-if-empty-file-list
31 (setf files-to-process
32 (mapping-prefix-matches filemap
33 (sandbox-translate-path "."))))
34 (dolist (file files)
35 (can-restart-here ("Continue preparing file list.")
36 (let* ((full-name (sandbox-translate-path file))
37 (abs-name (canonicalize-path
38 (real-to-abstract-path full-name)))
39 (entries (mapping-prefix-matches filemap abs-name)))
40 (if (not entries)
41 (error "~a is not known to Meta-CVS." full-name)
42 (setf files-to-process (nconc files-to-process entries))))))))
44 (setf files-to-process (mapping-extract-kind files-to-process :file))
46 (when (or files-to-process
47 do-meta-files
48 global-if-empty-file-list)
49 (when need-sync-before
50 (chatter-debug "Synchronizing.~%")
51 (mapping-synchronize :filemap files-to-process
52 :direction :left))
53 (current-dir-restore
54 (chdir *mcvs-dir*)
55 (chatter-debug "Invoking CVS.~%")
56 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
57 ,cvs-command ,@(format-opt command-options)
58 ,@command-args)
59 `(,@(when do-meta-files
60 (let (metas)
61 (when (exists ".cvsignore")
62 (push ".cvsignore" metas))
63 (when (exists *mcvs-types-name*)
64 (push *mcvs-types-name* metas))
65 (cons *mcvs-map-name* metas)))
66 ,@(mapcar #'(lambda (x)
67 (basename
68 (mapping-entry-id x)))
69 files-to-process))))
70 (when (and do-meta-files need-update-after)
71 (chatter-debug "Updating file structure.~%")
72 (mapping-update))
73 (when need-sync-after
74 (chatter-debug "Synchronizing again.~%")
75 (mapping-synchronize :filemap files-to-process))))
76 (values)))
78 (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
79 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
80 :need-sync-before t
81 :need-sync-after t
82 :default-include-meta-files t
83 :global-if-empty-file-list t))
85 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
86 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args
87 :need-sync-before t))
89 (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
90 (if (null mcvs-args)
91 (error "specify tag optionally followed by files."))
92 (mcvs-generic "tag" cvs-options
93 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)
94 :default-include-meta-files t
95 :global-if-empty-file-list t))
97 (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
98 (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
100 (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
101 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args
102 :need-sync-before t))
104 (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
105 (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))
107 (defun mcvs-watchers-wrapper (cvs-options cvs-command-options mcvs-args)
108 (mcvs-generic "watchers" cvs-options cvs-command-options nil mcvs-args))
110 (defun mcvs-edit-wrapper (cvs-options cvs-command-options mcvs-args)
111 (mcvs-generic "edit" cvs-options cvs-command-options nil mcvs-args
112 :need-sync-before t))
114 (defun mcvs-unedit-wrapper (cvs-options cvs-command-options mcvs-args)
115 (mcvs-generic "unedit" cvs-options cvs-command-options nil mcvs-args
116 :need-sync-before t
117 :need-sync-after t))
119 (defun mcvs-editors-wrapper (cvs-options cvs-command-options mcvs-args)
120 (mcvs-generic "editors" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5