diff options
| author | Gerd Moellmann | 2000-09-04 19:46:19 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2000-09-04 19:46:19 +0000 |
| commit | 0e362f54037b2f8271c905a39278fa3fa5fc7a1b (patch) | |
| tree | b812a460b8b6c11b06b296a136e0cf21b2b9e46c | |
| parent | 39efdf3f2f02431d44ff5f2fe548afc83edf17c4 (diff) | |
| download | emacs-0e362f54037b2f8271c905a39278fa3fa5fc7a1b.tar.gz emacs-0e362f54037b2f8271c905a39278fa3fa5fc7a1b.zip | |
(vc-next-action-on-file): Do not visit the file if it's
not necessary. If verbose in state `needs-patch', do the same as
under `up-to-date'. When NOT verbose and `needs-patch', check out
latest version instead of `merge-news'.
(vc-next-action-dired): Don't mess with default-directory here; it
breaks other parts of dired. It is the job of the
backend-specific functions to adjust it temporarily if they need
it.
(vc-next-action): Remove a special CVS case.
(vc-clear-headers): New optional arg FILE.
(vc-checkin, vc-checkout): Set properties vc-state and
vc-checkout-time properly.
(vc-finish-steal): Call steal-lock, not steal, which doesn't
exist.
(vc-print-log): Use new backend function `show-log-entry'.
(vc-cancel-version): Do the checks in a different order. Added a
FIXME concerning RCS-only code.
(vc-responsible-backend): New optional arg `register'.
(vc-default-could-register): New function.
(vc-dired-buffers-for-dir, vc-dired-resynch-file): New functions.
(vc-resynch-buffer): Call vc-dired-resynch-file.
(vc-start-entry, vc-finish-logentry, vc-revert-buffer): Use
vc-resynch-buffer instead of vc-resynch-window.
(vc-next-action-dired): Don't redisplay here, that gets done as a
result of the individual file operations.
(vc-retrieve-snapshot): Corrected prompt order.
(vc-version-diff): Use `require' to check for existence of
diff-mode.
(vc-do-command): Doc fix.
(vc-finish-logentry): When checking in from vc-dired, choose the
right backend for logentry check.
(vc-dired-mode-map): Inherit from dired-mode-map.
(vc-dired-mode): Local value of dired-move-to-filename-regexp
simplified.
(vc-dired-state-info): Removed, updated caller.
(vc-default-dired-state-info): Use parentheses instead of hyphens.
(vc-dired-hook): Use vc-BACKEND-dir-state, if available.
(vc-dired-listing-switches): New variable.
(vc-directory): Use it, instead of dired-listing-switches.
(vc-revert-buffer): Hide the frame for dedicated windows
(vc-update-changelog): Split into generic part and default
implementation. Doc string adapted.
(vc-default-update-changelog): New function. Call the `rcs2log'
script in exec-directory, to fix a long-standing nuisance.
(vc-next-action-on-file): Doc fix.
(vc-maybe-resolve-conflicts): Don't just toggle smerge-mode.
(vc-print-log): Eval `file' before constructing the continuation.
(vc-next-action-on-file): Corrected several messages.
(vc-merge): Add prefix arg `merge-news'; handle it.
(vc-finish-logentry): Thinko in the "same comment"
detection.
(vc-parent-buffer, vc-parent-buffer-name): Protect them
against kill-all-local-variables.
(vc-log-edit): Don't save vc-parent-buffer any more.
(vc-last-comment-match): Initialize to an empty string.
(vc-post-command-functions): New hook.
(vc-do-command): Run it.
(vc-next-action-on-file): Remove unnecessary pop-to-buffer.
(vc-finish-logentry): Only add the comment to the ring if it's
different from the last comment entered.
(vc-new-comment-index): New function.
(vc-previous-comment): Use it. Make the minibuffer message
slightly less terse.
(vc-comment-search-reverse): Make it work forward as well. Don't
set vc-comment-ring-index if no match is found. Use
vc-new-comment-index.
(vc-comment-search-forward): Use vc-comment-search-reverse.
(vc-dired-mode-map): Don't inherit from dired-mode-map since
define-derived-mode will do it for us. Bind `v' to a keymap that
inherits from vc-prefix-map so that we can bind `vt' without
binding C-x v t.
(vc-retrieve-snapshot): Parenthesis typo.
(vc-create-snapshot, vc-default-create-snapshot): Swap DIR
and NAME.
(vc-retrieve-snapshot): Split into two parts.
(vc-default-retrieve-snapshot): New function.
(vc-do-command): Remove unused commands.
(vc-version-diff): Make sure default-directory ends with a slash.
Move the window commands into a vc-exec-after.
(vc-print-log): Move more of the code into the `vc-exec-after'.
(vc-exec-after): Fix disassembly of previous sentinel.
(vc-print-log): Search current revision from beginning of buffer.
(vc-revert-buffer): Clear echo area after the diff is finished.
(vc-prefix-map): Removed definition of "t" for terse display in vc
dired.
(vc-dired-mode-map): Inherit from dired-mode-map. Added
definition of "vt" for terse display.
(vc-dired-mode): Fix dired-move-to-filename-regexp.
(vc-exec-after): Avoid caddr.
(vc-exec-after): New function.
(vc-do-command): Use it to add a termination message for async
procs.
(vc-checkout): Try to handle a missing-backend situation.
(vc-version-diff): Use vc-exec-after to fix the behavior for diffs
of a directory with a backend using async diffs.
(vc-print-log): Use vc-exec-after and use log-view-goto-rev if
present.
(vc-next-action-on-file): Use vc-revert-buffer to revert
when there are no changes.
(vc-prefix-map): Move the autoload to vc-hooks.el and move
the `fset' outside of the defvar so that it works even if
vc-prefix-map was already defined.
(vc-setup-buffer): New function, split out of vc-do-command.
(vc-do-command): Allow BUFFER to be t to mean `just use the
current buffer without any fuss'.
(vc-version-diff): Change the `diff' backend operation to just put
the diff in the current buffer without erasing it. Always use
(vc-workfile-unchanged-p): If checkout-time comparison is
not possible, use vc-BACKEND-workfile-unchanged-p.
(vc-default-workfile-unchanged-p): New function. Delegates to a
full vc-BACKEND-diff.
(vc-editable-p): Renamed from vc-writable-p.
(with-vc-file, vc-merge): Use vc-editable-p.
(vc-do-command): Remove unused var vc-file and fix the
doubly-defined `status' var. Add a user message when starting an
async command.
(vc-restore-buffer-context, vc-resynch-buffer, vc-start-entry)
(vc-finish-steal, vc-checkin, vc-finish-logentry, vc-rename-file):
Use with-current-buffer.
(vc-buffer-sync): Use unless.
(vc-next-action-on-file): If the file is 'edited by read-only,
make it read-write instead of trying to commit.
(vc-version-diff, vc-update-change-log): Use `setq
default-directory' rather than `cd'.
(vc-log-edit): Don't forget to set default-directory in the
buffer.
(vc-checkout): Don't do anything special for ange-ftp
files since ange-ftp already has vc-registered return nil.
(vc-do-command): Use file-relative-name.
(vc-responsible-backend): Use vc-backend if possible.
(vc-create-snapshot): Improve the `interactive' spec. Add support
for branches and dispatch to backend-specific `create-snapshot'.
(vc-default-create-snapshot): New function, containing the bulk of
the old vc-create-snapshot.
(vc-retrieve-snapshot): Improve the interactive spec.
(vc-do-command): Get rid of the `last' argument.
(vc-header-alist): Remove, replaced by vc-X-header.
(vc-insert-headers): Use vc-X-header instead of vc-header-alist.
(vc-dired-hook): Use expand-file-name instead of concat.
(vc-directory): Use file-name-as-directory.
(vc-snapshot-precondition, vc-create-snapshot)
(vc-retrieve-snapshot): Allow the command to operate on any
directory.
Update Copyright and add a crude list of backend funs.
(vc-writable-p): New function.
(with-vc-file): Use vc-writable-p.
(vc-next-action-on-file): Update call to vc-steal-lock and
cleanup.
(vc-register): Avoid vc-name.
(vc-locking-user): Remove.
(vc-steal-lock): Make the `owner' arg non-optional.
(vc-merge): Use vc-writable-p instead of vc-locking-user and
vc-checkout-model.
(vc-default-dired-state-info): Use vc-state instead of
vc-locking-user and return special strings for special states.
(vc-dired-hook): Use vc-up-to-date-p instead of vc-locking-user
and get rid of one of the special CVS cases.
(vc-cancel-version): prettify error message with \\[...].
(vc-rename-master): New function.
(vc-rename-file): Use vc-BACKEND-rename-file (which might in turn
use vc-rename-master) instead of vc-BACKEND-record-rename. Make
the CVS special case generic.
(vc-default-record-rename): Remove.
(vc-file-tree-walk-internal): Only call FUNC for files that are
under control of some VC backend and replace `concat' with
expand-file-name.
(vc-file-tree-walk): Update docstring.
(vc-version-diff, vc-snapshot-precondition, vc-create-snapshot)
(vc-retrieve-snapshot): Update call to vc-file-tree-walk.
(vc-version-diff): Expand file name read from the
minibuffer. Handle the case when a previous version number can't
be guessed. Give suitable messages when there were no differences
found.
(vc-clear-headers): Call backend-specific implementation, if one
exists.
(vc-cancel-version): Made error checks generic. When done, clear
headers generically, too.
(vc-locking-user): Moved from vc-hooks.el.
(vc-version-diff): Left out a vc- in call to
vc-call-backend.
(vc-default-dired-state-info, vc-default-record-rename)
(vc-default-merge-news): Update for the new backend argument.
(vc-merge): Use vc-find-backend-function.
(vc-register): Put a FIXME note for a newly found bug.
Call vc-call-backend without the leading vc-.
(vc-responsible-backend, vc-finish-logentry, vc-annotate)
(vc-check-headers): Call vc-call-backend without the leading vc-.
(vc-annotate-time-span): Replace confusing use of `cond' with
`or'.
(vc-annotate-display): Replace confusing use of `cond' with `or'.
Call vc-call-backend without the leading vc-.
(vc-process-filter): New function.
(vc-do-command): Setup `vc-process-filter' for the async process.
(vc-maybe-resolve-conflicts): New function to reduce
code-duplication. Additionally, it puts the buffer in
`smerge-mode' if applicable.
(vc-next-action-on-file): Use `vc-maybe-resolve-conflicts' after
calling `merge-news'.
(vc-merge): Use `vc-maybe-resolve-conflicts' after calling
`merge'.
(vc-log-edit): New function. Replacement for `vc-log-mode' by
interfacing to log-edit.el.
(vc-start-entry): Call `vc-log-edit' instead of `vc-log-mode' if
log-edit is available.
(vc-resolve-conflicts): Delegate to `smerge-ediff' if available.
(vc-register): Remove `vc-buffer-backend' setup.
(vc-log-mode-map): New name for vc-log-entry-mode and merge the
defvar and the initialization.
(vc-log-mode): Minor docstring fix and use vc-log-mode-map.
(vc-file-clear-masterprops): Removed.
(vc-checkin, vc-revert-buffer): Removed calls to the above.
(vc-version-diff): Use buffer-size without argument.
(vc-register): Heed vc-initial-comment.
(vc-workfile-unchanged-p): Remove unused argument
`want-differences-if-changed' and simplify.
(vc-next-action-on-file) [needs-merge]: Resynch the buffer.
(vc-revert-buffer): Use `unchanged-p' rather than vc-diff's status
output (which is invalid for async vc-diff) to decide whether to
do the revert silently or not.
(with-vc-file, vc-next-action, vc-version-diff)
(vc-dired-mark-locked): Replaced usage of vc-locking-user with
vc-state or vc-up-to-date-p.
(vc-merge): Use vc-backend-defines to check whether merging is
possible. Set state to 'edited after successful merge.
(vc-recompute-state, vc-next-action-on-file): Update to
new `vc-state' semantics.
(vc-finish-steal): Set 'vc-state to 'edited rather than setting
'vc-locking-user to the current user.
(vc-merge): Inline vc-backend-merge. Comment out code that I
don't understand and hence can't adapt to the new `vc-state' and
`vc-locking-user' semantics.
(vc-backend-merge): Remove.
(vc-do-command): kill-all-local-variables, to reset any
major-mode in which the buffer might have been put earlier. Use
`remove' and `when'. Allow `okstatus' to be `async' and use
`start-process' in this case.
(vc-version-diff): Handle the case where the diff looks empty
because of the use of an async process.
(vc-next-action-on-file): Removed optional parameter
`simple'. Recompute state unconditionally.
(vc-default-toggle-read-only): Removed.
(vc-backend-dispatch, vc-annotate-mode-syntax-table):
Remove.
(vc-prefix-map): Move from vc-hooks.el and make autoloaded.
(vc-release-greater-or-equal-p): Move to vc-rcs.el.
(vc-file-clear-masterprops): Braindead "fix". It was a nop and
still is. So maybe it should be removed.
(vc-head-version, vc-find-binary): Remove.
(vc-recompute-state): Move from vc-hooks.el.
(vc-next-action-on-file): Add a `simple' argument to allow
avoiding the `recompute' step (use for vc-cvs-simple-toggle).
(vc-default-toggle-read-only, vc-default-record-rename): New
functions.
(vc-next-action, vc-dired-hook): Use vc-state instead of
vc-cvs-status.
(vc-dired-mode-map): Properly defvar it.
(vc-print-log): Call log-view-mode if available.
(small-temporary-file-directory): defvar instead of use boundp.
(vc-merge-news): Moved to vc-cvs.el.
(vc-default-merge-news): New function.
(function' quotes.
(vc-annotate-mode-map, vc-annotate-mode-syntax-table): Initialize
directly in the defvar.
(vc-do-command): Bind inhibit-read-only so as to properly handle
the case where the destination buffer has been made read-only.
(vc-diff): Delegate to vc-version-diff in all cases.
(vc-version-diff): Setup the *vc-diff* buffer as was done in
vc-diff.
(vc-annotate-mode-variables): Removed (code moved partly to
defvars and partly to vc-annotate-add-menu).
(vc-annotate-mode): Turned into a derived-mode.
(vc-annotate-add-menu): Moved in code in
vc-annotate-mode-variables.
(vc-update-change-log): Use make-temp-file if available.
(vc-next-action-on-file): Added handling of state
`unlocked-changes'.
(vc-checkout-carefully): Is now practically obsolete, unless the
above is too slow to be enabled unconditionally.
(vc-update-change-log): Fixed typo.
(vc-responsible-backend): New function.
(vc-register): Largely rewritten.
(vc-admin): Removed (implementation moved into vc-register).
(vc-checkin): Redocumented.
(vc-finish-logentry): If no backend defined yet (because we are in
the process of registering), use the responsible backend.
Updated callers of `vc-checkout-required' to use
`vc-checkout-model'.
(vc-backend-release, vc-backend-release-p): Functions
moved into vc-rcs.el
(vc-backend-revert): Function moved into `vc-revert';
`vc-next-action' must be updated to accomodate this change.
(vc-backend-steal): Function moved into `vc-finish-steal'.
(vc-backend-logentry-check): Function moved into
`vc-finish-logentry'.
(vc-backend-printlog): Function moved into `vc-print-log'.
(vc-backend-uncheck): Function moved into `vc-cancel-version'.
(vc-backend-assign-name): Function moved into
`vc-create-snapshot'.
(vc-workfile-unchanged-p,vc-diff,vc-version-diff): Updated
to use the vc-BACKEND-diff functions instead; `vc-diff' is now
working.
Typo fixed. This checkin is made with our new VC code
base for the very first time. A simple `(vc-checkin
(buffer-file-name))' was used to perform it.
(vc-checkin): Merged with `vc-backend-checkin' and updated
to match the split into various backends.
(vc-backend-checkin): Removed. Merged with `vc-checkin'.
(vc-retrieve-snapshot): Bug fix.
(vc-next-action-on-file): Bug found and fixed.
(vc-checkout, vc-version-other-window, vc-retrieve-snapshot)
(vc-cancel-version): Handle of vc-BACKEND-checkout updated.
(vc-next-action-on-file): Rewritten for the new state model.
(vc-backend-merge-news): Renamed to `vc-merge-news'. (Specific parts
still need to be split, and implemented for RCS).
(vc-admin): Updated to handle selection of appropriate
backend. Current implementation is crufty and need re-thinking.
(vc-annotate-get-backend, vc-annotate-display-default)
(vc-annotate-add-menu, vc-annotate, vc-annotate-display): Annotate
functionality updated quite a lot to support multiple backends.
Variables `vc-annotate-mode', `vc-annotate-buffers',
`vc-annotate-backend' added.
Renamed
`vc-uses-locking' to `vc-checkout-required'. Renamed the `locked'
state to `reserved'.
(vc-update-change-log): Use small-temporary-file-directory,
if defined. (Merged from main line, slightly adapted.)
Split the annotate feature into a BACKEND specific part
and moved it from the vc-cvs.el file to this one.
(vc-resynch-window): Added TODO comment: check for
interaction with view mode according to recent RCS change.
(vc-backend-merge-news): Merged "CMUP" patch from mainline.
Converted the remaining function comments to
documentation strings.
(vc-backend-release, vc-release-greater-or-equal)
(vc-backend-release-p, vc-trunk-p, vc-branch-p, vc-branch-part)
(vc-minor-part, vc-previous-version): Functions that operate and
compare revision numbers got proper documentation. Comments added
about their possible removal.
(vc-latest-on-branch-p): Function removed and replaced in
the vc-backend.el files.
(vc-backend-diff): Function removed and placed in the
backend files.
(vc-backend-checkout): Function removed and replaced in
the vc-backend.el files.
(vc-backend-admin): Removed and replaced in the
vc-backend.el files.
(Martin): Removed all the annotate functionality since it
is CVS backend specific.
[Merged from mainline.]
(vc-dired-mode): Make the dired-move-to-filename-regexp
regexp match the date, to avoid treating date as file size.
Add YYYY S option to WESTERN/
Require `compile' when compiling.
(vc-logentry-check-hook): New option.
(vc-steal-lock): Use compose-mail.
(vc-dired-mode-map): Defvar when compiling.
(vc-add-triple, vc-record-rename, vc-lookup-triple): Moved to
vc-sccs.el and renamed. Callers changed.
(vc-backend-checkout, vc-backend-logentry-check)
(vc-backend-merge-news): Doc fix.
(vc-default-logentry-check): New function.
(vc-backend-checkin, vc-backend-revert, vc-backend-steal)
(vc-backend-uncheck, vc-backend-print-log, vc-backend-assign-name)
(vc-backend-merge): Doc fix. Use backend functions.
(vc-check-headers): Use backend functions.
(vc-backend-release): Call vc-system-release.
(vc-rcs-release, vc-cvs-release, vc-sccs-release): Moved to
backend files.
(vc-backend-release): Dispatch to backend functions.
(vc-backend-release-p): Don't mention CVS, RCS. [The SCCS case
probably needs attention.]
(vc-dired-mode, vc-dired-reformat-line, vc-dired-purge):
Doc fix.
(vc-fetch-cvs-status): Moved to vc-cvs.el and renamed.
(vc-default-dired-state-info): New function.
(vc-dired-state-info): Dispatch to backends.
(vc-dired-hook): Doc fix. Simplify, pending removal of CVS specifics.
(vc-file-clear-masterprops, vc-latest-on-branch-p)
(vc-version-other-window, vc-backend-assign-name): Removed
references to vc-latest-version; sometimes changed into
vc-workfile-version.
(with-vc-file, vc-next-action-on-file, vc-merge)
(vc-backend-checkout): Changed calls to `vc-checkout-model' to
`vc-uses-locking'.
(vc-fetch-cvs-status): Use renamed vc-cvs-parse-status.
Some doc fixes for autoloaded and interactive functions.
Fix compilation warnings from ediff stuff.
(vc-rcs-release, vc-cvs-release, vc-sccs-release): Custom fix.
This is 1999-03-13T05:04:24Z!kwzh@gnu.org from the emacs sources
| -rw-r--r-- | lisp/vc.el | 3357 |
1 files changed, 1391 insertions, 1966 deletions
diff --git a/lisp/vc.el b/lisp/vc.el index 250084402e6..6415619acb3 100644 --- a/lisp/vc.el +++ b/lisp/vc.el | |||
| @@ -1,11 +1,11 @@ | |||
| 1 | ;;; vc.el --- drive a version-control system from within Emacs | 1 | ;;; vc.el --- drive a version-control system from within Emacs |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1992,93,94,95,96,97,98,2000 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | 5 | ;; Author: FSF (see below for full credits) |
| 6 | ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de> | 6 | ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
| 7 | 7 | ||
| 8 | ;; $Id: vc.el,v 1.259 2000/01/26 10:31:13 gerd Exp $ | 8 | ;; $Id: vc.el,v 1.1 2000/09/04 19:35:57 gerd Exp gerd $ |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 11 | 11 | ||
| @@ -24,29 +24,36 @@ | |||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, USA. | 25 | ;; Boston, MA 02111-1307, USA. |
| 26 | 26 | ||
| 27 | ;;; Credits: | ||
| 28 | |||
| 29 | ;; VC was initially designed and implemented by Eric S. Raymond | ||
| 30 | ;; <esr@snark.thyrsus.com>. Over the years, many people have | ||
| 31 | ;; contributed substantial amounts of work to VC. These include: | ||
| 32 | ;; Per Cederqvist <ceder@lysator.liu.se> | ||
| 33 | ;; Paul Eggert <eggert@twinsun.com> | ||
| 34 | ;; Sebastian Kremer <sk@thp.uni-koeln.de> | ||
| 35 | ;; Martin Lorentzson <martinl@gnu.org> | ||
| 36 | ;; Dave Love <d.love@dl.ac.uk> | ||
| 37 | ;; Stefan Monnier <monnier@cs.yale.edu> | ||
| 38 | ;; Andre Spiegel <spiegel@gnu.org> | ||
| 39 | ;; Richard Stallman <rms@gnu.org> | ||
| 40 | ;; ttn@netcom.com | ||
| 41 | |||
| 27 | ;;; Commentary: | 42 | ;;; Commentary: |
| 28 | 43 | ||
| 29 | ;; This mode is fully documented in the Emacs user's manual. | 44 | ;; This mode is fully documented in the Emacs user's manual. |
| 30 | ;; | 45 | ;; |
| 31 | ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>. | ||
| 32 | ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>, | ||
| 33 | ;; and Richard Stallman contributed valuable criticism, support, and testing. | ||
| 34 | ;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se> | ||
| 35 | ;; in Jan-Feb 1994. Further enhancements came from ttn@netcom.com and | ||
| 36 | ;; Andre Spiegel <spiegel@inf.fu-berlin.de>. | ||
| 37 | ;; | ||
| 38 | ;; Supported version-control systems presently include SCCS, RCS, and CVS. | 46 | ;; Supported version-control systems presently include SCCS, RCS, and CVS. |
| 39 | ;; | 47 | ;; |
| 40 | ;; Some features will not work with old RCS versions. Where | 48 | ;; Some features will not work with old RCS versions. Where |
| 41 | ;; appropriate, VC finds out which version you have, and allows or | 49 | ;; appropriate, VC finds out which version you have, and allows or |
| 42 | ;; disallows those features (stealing locks, for example, works only | 50 | ;; disallows those features (stealing locks, for example, works only |
| 43 | ;; from 5.6.2 onwards). | 51 | ;; from 5.6.2 onwards). |
| 44 | ;; Even initial checkins will fail if your RCS version is so old that ci | 52 | ;; Even initial checkins will fail if your RCS version is so old that ci |
| 45 | ;; doesn't understand -t-; this has been known to happen to people running | 53 | ;; doesn't understand -t-; this has been known to happen to people running |
| 46 | ;; NExTSTEP 3.0. | 54 | ;; NExTSTEP 3.0. |
| 47 | ;; | 55 | ;; |
| 48 | ;; You can support the RCS -x option by adding pairs to the | 56 | ;; You can support the RCS -x option by customizing vc-rcs-master-templates. |
| 49 | ;; vc-master-templates list. | ||
| 50 | ;; | 57 | ;; |
| 51 | ;; Proper function of the SCCS diff commands requires the shellscript vcdiff | 58 | ;; Proper function of the SCCS diff commands requires the shellscript vcdiff |
| 52 | ;; to be installed somewhere on Emacs's path for executables. | 59 | ;; to be installed somewhere on Emacs's path for executables. |
| @@ -54,11 +61,6 @@ | |||
| 54 | ;; If your site uses the ChangeLog convention supported by Emacs, the | 61 | ;; If your site uses the ChangeLog convention supported by Emacs, the |
| 55 | ;; function vc-comment-to-change-log should prove a useful checkin hook. | 62 | ;; function vc-comment-to-change-log should prove a useful checkin hook. |
| 56 | ;; | 63 | ;; |
| 57 | ;; This code depends on call-process passing back the subprocess exit | ||
| 58 | ;; status. Thus, you need Emacs 18.58 or later to run it. For the | ||
| 59 | ;; vc-directory command to work properly as documented, you need 19. | ||
| 60 | ;; You also need Emacs 19's ring.el. | ||
| 61 | ;; | ||
| 62 | ;; The vc code maintains some internal state in order to reduce expensive | 64 | ;; The vc code maintains some internal state in order to reduce expensive |
| 63 | ;; version-control operations to a minimum. Some names are only computed | 65 | ;; version-control operations to a minimum. Some names are only computed |
| 64 | ;; once. If you perform version control operations with RCS/SCCS/CVS while | 66 | ;; once. If you perform version control operations with RCS/SCCS/CVS while |
| @@ -70,32 +72,90 @@ | |||
| 70 | 72 | ||
| 71 | ;;; Code: | 73 | ;;; Code: |
| 72 | 74 | ||
| 75 | ;;;;;;;;;;;;;;;;; Backend-specific functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 76 | ;; | ||
| 77 | ;; for each operation FUN, the backend should provide a function vc-BACKEND-FUN. | ||
| 78 | ;; Operations marked with a `-' instead of a `*' have a sensible default | ||
| 79 | ;; behavior. | ||
| 80 | |||
| 81 | ;; * registered (file) | ||
| 82 | ;; * state (file) | ||
| 83 | ;; - state-heuristic (file) | ||
| 84 | ;; The default behavior delegates to `state'. | ||
| 85 | ;; - dir-state (dir) | ||
| 86 | ;; * checkout-model (file) | ||
| 87 | ;; - mode-line-string (file) | ||
| 88 | ;; * workfile-version (file) | ||
| 89 | ;; * revert (file) | ||
| 90 | ;; * merge-news (file) | ||
| 91 | ;; * merge (file rev1 rev2) | ||
| 92 | ;; * steal-lock (file &optional version) | ||
| 93 | ;; * register (file rev comment) | ||
| 94 | ;; * responsible-p (file) | ||
| 95 | ;; Should also work if FILE is a directory (ends with a slash). | ||
| 96 | ;; - could-register (file) | ||
| 97 | ;; * checkout (file writable &optional rev destfile) | ||
| 98 | ;; Checkout revision REV of FILE into DESTFILE. | ||
| 99 | ;; DESTFILE defaults to FILE. | ||
| 100 | ;; The file should be made writable if WRITABLE is non-nil. | ||
| 101 | ;; REV can be nil (BASE) or "" (HEAD) or any other revision. | ||
| 102 | ;; * checkin (file rev comment) | ||
| 103 | ;; - logentry-check () | ||
| 104 | ;; * diff (file &optional rev1 rev2) | ||
| 105 | ;; Insert the diff for FILE into the current buffer. | ||
| 106 | ;; REV1 should default to workfile-version. | ||
| 107 | ;; REV2 should default to the current workfile | ||
| 108 | ;; Return a status of either 0 (i.e. no diff) or 1 (i.e. either non-empty | ||
| 109 | ;; diff or the diff is run asynchronously). | ||
| 110 | ;; - workfile-unchanged-p (file) | ||
| 111 | ;; Return non-nil if FILE is unchanged from its current workfile version. | ||
| 112 | ;; This function should do a brief comparison of FILE's contents | ||
| 113 | ;; with those of the master version. If the backend does not have | ||
| 114 | ;; such a brief-comparison feature, the default implementation of this | ||
| 115 | ;; function can be used, which delegates to a full vc-BACKEND-diff. | ||
| 116 | ;; - clear-headers () | ||
| 117 | ;; * check-headers () | ||
| 118 | ;; - dired-state-info (file) | ||
| 119 | ;; - create-snapshot (dir name branchp) | ||
| 120 | ;; Take a snapshot of the current state of files under DIR and name it NAME. | ||
| 121 | ;; This should make sure that files are up-to-date before proceeding | ||
| 122 | ;; with the action. | ||
| 123 | ;; DIR can also be a file and if BRANCHP is specified, NAME | ||
| 124 | ;; should be created as a branch and DIR should be checked out under | ||
| 125 | ;; this new branch. The default behavior does not support branches | ||
| 126 | ;; but does a sanity check, a tree traversal and for each file calls | ||
| 127 | ;; `assign-name'. | ||
| 128 | ;; * assign-name (file name) | ||
| 129 | ;; Give name NAME to the current version of FILE, assuming it is | ||
| 130 | ;; up-to-date. Only used by the default version of `create-snapshot'. | ||
| 131 | ;; - retrieve-snapshot (dir name update) | ||
| 132 | ;; Retrieve a named snapshot of all registered files at or below DIR. | ||
| 133 | ;; If UPDATE is non-nil, then update buffers of any files in the snapshot | ||
| 134 | ;; that are currently visited. | ||
| 135 | ;; * print-log (file) | ||
| 136 | ;; Insert the revision log of FILE into the current buffer. | ||
| 137 | ;; - show-log-entry (version) | ||
| 138 | ;; - update-changelog (files) | ||
| 139 | ;; Find changelog entries for FILES, or for all files at or below | ||
| 140 | ;; the default-directory if FILES is nil. | ||
| 141 | ;; * latest-on-branch-p (file) | ||
| 142 | ;; Only used for sanity check before calling `uncheck'. | ||
| 143 | ;; * uncheck (file target) | ||
| 144 | ;; * rename-file (old new) | ||
| 145 | ;; * annotate-command (file buf) | ||
| 146 | ;; * annotate-difference (pos) | ||
| 147 | |||
| 73 | (require 'vc-hooks) | 148 | (require 'vc-hooks) |
| 74 | (require 'ring) | 149 | (require 'ring) |
| 75 | (eval-when-compile (require 'dired)) ; for dired-map-over-marks macro | 150 | (eval-when-compile |
| 151 | (require 'compile) | ||
| 152 | (require 'dired)) ; for dired-map-over-marks macro | ||
| 76 | 153 | ||
| 77 | (if (not (assoc 'vc-parent-buffer minor-mode-alist)) | 154 | (if (not (assoc 'vc-parent-buffer minor-mode-alist)) |
| 78 | (setq minor-mode-alist | 155 | (setq minor-mode-alist |
| 79 | (cons '(vc-parent-buffer vc-parent-buffer-name) | 156 | (cons '(vc-parent-buffer vc-parent-buffer-name) |
| 80 | minor-mode-alist))) | 157 | minor-mode-alist))) |
| 81 | 158 | ||
| 82 | ;; To implement support for a new version-control system, add another | ||
| 83 | ;; branch to the vc-backend-dispatch macro and fill it in in each | ||
| 84 | ;; call. The variable vc-master-templates in vc-hooks.el will also | ||
| 85 | ;; have to change. | ||
| 86 | |||
| 87 | (defmacro vc-backend-dispatch (f s r c) | ||
| 88 | "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively. | ||
| 89 | If FORM3 is `RCS', use FORM2 for CVS as well as RCS. | ||
| 90 | \(CVS shares some code with RCS)." | ||
| 91 | (list 'let (list (list 'type (list 'vc-backend f))) | ||
| 92 | (list 'cond | ||
| 93 | (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS | ||
| 94 | (list (list 'eq 'type (quote 'RCS)) r) ;; RCS | ||
| 95 | (list (list 'eq 'type (quote 'CVS)) ;; CVS | ||
| 96 | (if (eq c 'RCS) r c)) | ||
| 97 | ))) | ||
| 98 | |||
| 99 | ;; General customization | 159 | ;; General customization |
| 100 | 160 | ||
| 101 | (defgroup vc nil | 161 | (defgroup vc nil |
| @@ -122,7 +182,7 @@ preserve the setting." | |||
| 122 | 182 | ||
| 123 | (defcustom vc-default-init-version "1.1" | 183 | (defcustom vc-default-init-version "1.1" |
| 124 | "*A string used as the default version number when a new file is registered. | 184 | "*A string used as the default version number when a new file is registered. |
| 125 | This can be overriden by giving a prefix argument to \\[vc-register]." | 185 | This can be overridden by giving a prefix argument to \\[vc-register]." |
| 126 | :type 'string | 186 | :type 'string |
| 127 | :group 'vc | 187 | :group 'vc |
| 128 | :version "20.3") | 188 | :version "20.3") |
| @@ -162,6 +222,12 @@ These are passed to the checkin program by \\[vc-register]." | |||
| 162 | string)) | 222 | string)) |
| 163 | :group 'vc) | 223 | :group 'vc) |
| 164 | 224 | ||
| 225 | (defcustom vc-dired-listing-switches "-al" | ||
| 226 | "*Switches passed to `ls' for vc-dired. MUST contain the `l' option." | ||
| 227 | :type 'string | ||
| 228 | :group 'vc | ||
| 229 | :version "21.0") | ||
| 230 | |||
| 165 | (defcustom vc-dired-recurse t | 231 | (defcustom vc-dired-recurse t |
| 166 | "*If non-nil, show directory trees recursively in VC Dired." | 232 | "*If non-nil, show directory trees recursively in VC Dired." |
| 167 | :type 'boolean | 233 | :type 'boolean |
| @@ -184,8 +250,31 @@ These are passed to the checkin program by \\[vc-register]." | |||
| 184 | 250 | ||
| 185 | ;;; This is duplicated in diff.el. | 251 | ;;; This is duplicated in diff.el. |
| 186 | (defvar diff-switches "-c" | 252 | (defvar diff-switches "-c" |
| 187 | "*A string or list of strings specifying switches to be be passed to diff.") | 253 | "*A string or list of strings specifying switches to be passed to diff.") |
| 254 | |||
| 255 | ;;;###autoload | ||
| 256 | (defcustom vc-checkin-hook nil | ||
| 257 | "*Normal hook (list of functions) run after a checkin is done. | ||
| 258 | See `run-hooks'." | ||
| 259 | :type 'hook | ||
| 260 | :options '(vc-comment-to-change-log) | ||
| 261 | :group 'vc) | ||
| 262 | |||
| 263 | ;;;###autoload | ||
| 264 | (defcustom vc-before-checkin-hook nil | ||
| 265 | "*Normal hook (list of functions) run before a file gets checked in. | ||
| 266 | See `run-hooks'." | ||
| 267 | :type 'hook | ||
| 268 | :group 'vc) | ||
| 269 | |||
| 270 | (defcustom vc-logentry-check-hook nil | ||
| 271 | "*Normal hook run by `vc-backend-logentry-check'. | ||
| 272 | Use this to impose your own rules on the entry in addition to any the | ||
| 273 | version control backend imposes itself." | ||
| 274 | :type 'hook | ||
| 275 | :group 'vc) | ||
| 188 | 276 | ||
| 277 | ;; Annotate customization | ||
| 189 | (defcustom vc-annotate-color-map | 278 | (defcustom vc-annotate-color-map |
| 190 | '(( 26.3672 . "#FF0000") | 279 | '(( 26.3672 . "#FF0000") |
| 191 | ( 52.7344 . "#FF3800") | 280 | ( 52.7344 . "#FF3800") |
| @@ -207,7 +296,7 @@ These are passed to the checkin program by \\[vc-register]." | |||
| 207 | "*Association list of age versus color, for \\[vc-annotate]. | 296 | "*Association list of age versus color, for \\[vc-annotate]. |
| 208 | Ages are given in units of 2**-16 seconds. | 297 | Ages are given in units of 2**-16 seconds. |
| 209 | Default is eighteen steps using a twenty day increment." | 298 | Default is eighteen steps using a twenty day increment." |
| 210 | :type 'sexp | 299 | :type 'alist |
| 211 | :group 'vc) | 300 | :group 'vc) |
| 212 | 301 | ||
| 213 | (defcustom vc-annotate-very-old-color "#0046FF" | 302 | (defcustom vc-annotate-very-old-color "#0046FF" |
| @@ -224,52 +313,30 @@ Default color is used if nil." | |||
| 224 | (defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01) | 313 | (defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01) |
| 225 | "*Menu elements for the mode-specific menu of VC-Annotate mode. | 314 | "*Menu elements for the mode-specific menu of VC-Annotate mode. |
| 226 | List of factors, used to expand/compress the time scale. See `vc-annotate'." | 315 | List of factors, used to expand/compress the time scale. See `vc-annotate'." |
| 227 | :type 'sexp | 316 | :type '(repeat number) |
| 228 | :group 'vc) | 317 | :group 'vc) |
| 229 | 318 | ||
| 230 | ;;;###autoload | 319 | ;; vc-annotate functionality (CVS only). |
| 231 | (defcustom vc-checkin-hook nil | 320 | (defvar vc-annotate-mode nil |
| 232 | "*Normal hook (list of functions) run after a checkin is done. | 321 | "Variable indicating if VC-Annotate mode is active.") |
| 233 | See `run-hooks'." | ||
| 234 | :type 'hook | ||
| 235 | :options '(vc-comment-to-change-log) | ||
| 236 | :group 'vc) | ||
| 237 | 322 | ||
| 238 | ;;;###autoload | 323 | (defvar vc-annotate-mode-map |
| 239 | (defcustom vc-before-checkin-hook nil | 324 | (let ((m (make-sparse-keymap))) |
| 240 | "*Normal hook (list of functions) run before a file gets checked in. | 325 | (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate")) |
| 241 | See `run-hooks'." | 326 | m) |
| 242 | :type 'hook | 327 | "Local keymap used for VC-Annotate mode.") |
| 243 | :group 'vc) | ||
| 244 | 328 | ||
| 245 | ;;;###autoload | 329 | (defvar vc-annotate-mode-menu nil |
| 246 | (defcustom vc-annotate-mode-hook nil | 330 | "Local keymap used for VC-Annotate mode's menu bar menu.") |
| 247 | "*Hooks to run when VC-Annotate mode is turned on." | ||
| 248 | :type 'hook | ||
| 249 | :group 'vc) | ||
| 250 | 331 | ||
| 251 | ;; Header-insertion hair | 332 | ;; Header-insertion hair |
| 252 | 333 | ||
| 253 | (defcustom vc-header-alist | ||
| 254 | '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$")) | ||
| 255 | "*Header keywords to be inserted by `vc-insert-headers'. | ||
| 256 | Must be a list of two-element lists, the first element of each must | ||
| 257 | be `RCS', `CVS', or `SCCS'. The second element is the string to | ||
| 258 | be inserted for this particular backend." | ||
| 259 | :type '(repeat (list :format "%v" | ||
| 260 | (choice :tag "System" | ||
| 261 | (const SCCS) | ||
| 262 | (const RCS) | ||
| 263 | (const CVS)) | ||
| 264 | (string :tag "Header"))) | ||
| 265 | :group 'vc) | ||
| 266 | |||
| 267 | (defcustom vc-static-header-alist | 334 | (defcustom vc-static-header-alist |
| 268 | '(("\\.c$" . | 335 | '(("\\.c$" . |
| 269 | "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) | 336 | "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) |
| 270 | "*Associate static header string templates with file types. A \%s in the | 337 | "*Associate static header string templates with file types. |
| 271 | template is replaced with the first string associated with the file's | 338 | A \%s in the template is replaced with the first string associated with |
| 272 | version-control type in `vc-header-alist'." | 339 | the file's version-control type in `vc-header-alist'." |
| 273 | :type '(repeat (cons :format "%v" | 340 | :type '(repeat (cons :format "%v" |
| 274 | (regexp :tag "File Type") | 341 | (regexp :tag "File Type") |
| 275 | (string :tag "Header String"))) | 342 | (string :tag "Header String"))) |
| @@ -288,6 +355,9 @@ is sensitive to blank lines." | |||
| 288 | :group 'vc) | 355 | :group 'vc) |
| 289 | 356 | ||
| 290 | ;; Default is to be extra careful for super-user. | 357 | ;; Default is to be extra careful for super-user. |
| 358 | ;; TODO: This variable is no longer used; the corresponding checks | ||
| 359 | ;; are always done now. If that turns out to be fast enough, | ||
| 360 | ;; the variable can be obsoleted. | ||
| 291 | (defcustom vc-checkout-carefully (= (user-uid) 0) | 361 | (defcustom vc-checkout-carefully (= (user-uid) 0) |
| 292 | "*Non-nil means be extra-careful in checkout. | 362 | "*Non-nil means be extra-careful in checkout. |
| 293 | Verify that the file really is not locked | 363 | Verify that the file really is not locked |
| @@ -295,44 +365,61 @@ and that its contents match what the master file says." | |||
| 295 | :type 'boolean | 365 | :type 'boolean |
| 296 | :group 'vc) | 366 | :group 'vc) |
| 297 | 367 | ||
| 298 | (defcustom vc-rcs-release nil | 368 | |
| 299 | "*The release number of your RCS installation, as a string. | 369 | ;;; The main keymap |
| 300 | If nil, VC itself computes this value when it is first needed." | 370 | |
| 301 | :type '(choice (const :tag "Auto" nil) | 371 | (defvar vc-prefix-map |
| 302 | string | 372 | (let ((map (make-sparse-keymap))) |
| 303 | (const :tag "Unknown" unknown)) | 373 | (define-key map "a" 'vc-update-change-log) |
| 304 | :group 'vc) | 374 | (define-key map "c" 'vc-cancel-version) |
| 305 | 375 | (define-key map "d" 'vc-directory) | |
| 306 | (defcustom vc-sccs-release nil | 376 | (define-key map "g" 'vc-annotate) |
| 307 | "*The release number of your SCCS installation, as a string. | 377 | (define-key map "h" 'vc-insert-headers) |
| 308 | If nil, VC itself computes this value when it is first needed." | 378 | (define-key map "i" 'vc-register) |
| 309 | :type '(choice (const :tag "Auto" nil) | 379 | (define-key map "l" 'vc-print-log) |
| 310 | string | 380 | (define-key map "m" 'vc-merge) |
| 311 | (const :tag "Unknown" unknown)) | 381 | (define-key map "r" 'vc-retrieve-snapshot) |
| 312 | :group 'vc) | 382 | (define-key map "s" 'vc-create-snapshot) |
| 383 | (define-key map "u" 'vc-revert-buffer) | ||
| 384 | (define-key map "v" 'vc-next-action) | ||
| 385 | (define-key map "=" 'vc-diff) | ||
| 386 | (define-key map "~" 'vc-version-other-window) | ||
| 387 | map)) | ||
| 388 | (fset 'vc-prefix-map vc-prefix-map) | ||
| 313 | 389 | ||
| 314 | (defcustom vc-cvs-release nil | 390 | ;; Initialization code, to be done just once at load-time |
| 315 | "*The release number of your CVS installation, as a string. | 391 | (defvar vc-log-mode-map |
| 316 | If nil, VC itself computes this value when it is first needed." | 392 | (let ((map (make-sparse-keymap))) |
| 317 | :type '(choice (const :tag "Auto" nil) | 393 | (define-key map "\M-n" 'vc-next-comment) |
| 318 | string | 394 | (define-key map "\M-p" 'vc-previous-comment) |
| 319 | (const :tag "Unknown" unknown)) | 395 | (define-key map "\M-r" 'vc-comment-search-reverse) |
| 320 | :group 'vc) | 396 | (define-key map "\M-s" 'vc-comment-search-forward) |
| 397 | (define-key map "\C-c\C-c" 'vc-finish-logentry) | ||
| 398 | map)) | ||
| 399 | ;; Compatibility with old name. Should we bother ? | ||
| 400 | (defvar vc-log-entry-mode vc-log-mode-map) | ||
| 321 | 401 | ||
| 402 | |||
| 322 | ;; Variables the user doesn't need to know about. | 403 | ;; Variables the user doesn't need to know about. |
| 323 | (defvar vc-log-entry-mode nil) | ||
| 324 | (defvar vc-log-operation nil) | 404 | (defvar vc-log-operation nil) |
| 325 | (defvar vc-log-after-operation-hook nil) | 405 | (defvar vc-log-after-operation-hook nil) |
| 326 | (defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer) | 406 | (defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer) |
| 407 | (defvar vc-annotate-buffers nil | ||
| 408 | "An association list of current \"Annotate\" buffers and their | ||
| 409 | corresponding backends. The keys are \(BUFFER . BACKEND\). See also | ||
| 410 | `vc-annotate-get-backend'.") | ||
| 327 | ;; In a log entry buffer, this is a local variable | 411 | ;; In a log entry buffer, this is a local variable |
| 328 | ;; that points to the buffer for which it was made | 412 | ;; that points to the buffer for which it was made |
| 329 | ;; (either a file, or a VC dired buffer). | 413 | ;; (either a file, or a VC dired buffer). |
| 330 | (defvar vc-parent-buffer nil) | 414 | (defvar vc-parent-buffer nil) |
| 415 | (put 'vc-parent-buffer 'permanent-local t) | ||
| 331 | (defvar vc-parent-buffer-name nil) | 416 | (defvar vc-parent-buffer-name nil) |
| 417 | (put 'vc-parent-buffer-name 'permanent-local t) | ||
| 332 | 418 | ||
| 333 | (defvar vc-log-file) | 419 | (defvar vc-log-file) |
| 334 | (defvar vc-log-version) | 420 | (defvar vc-log-version) |
| 335 | 421 | ||
| 422 | ;; FIXME: only used in vc-sccs.el | ||
| 336 | (defconst vc-name-assoc-file "VC-names") | 423 | (defconst vc-name-assoc-file "VC-names") |
| 337 | 424 | ||
| 338 | (defvar vc-dired-mode nil) | 425 | (defvar vc-dired-mode nil) |
| @@ -340,93 +427,30 @@ If nil, VC itself computes this value when it is first needed." | |||
| 340 | 427 | ||
| 341 | (defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size)) | 428 | (defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size)) |
| 342 | (defvar vc-comment-ring-index nil) | 429 | (defvar vc-comment-ring-index nil) |
| 343 | (defvar vc-last-comment-match nil) | 430 | (defvar vc-last-comment-match "") |
| 344 | |||
| 345 | ;;; Find and compare backend releases | ||
| 346 | |||
| 347 | (defun vc-backend-release (backend) | ||
| 348 | ;; Returns which backend release is installed on this system. | ||
| 349 | (cond | ||
| 350 | ((eq backend 'RCS) | ||
| 351 | (or vc-rcs-release | ||
| 352 | (and (zerop (vc-do-command nil nil "rcs" nil nil "-V")) | ||
| 353 | (save-excursion | ||
| 354 | (set-buffer (get-buffer "*vc*")) | ||
| 355 | (setq vc-rcs-release | ||
| 356 | (car (vc-parse-buffer | ||
| 357 | '(("^RCS version \\([0-9.]+ *.*\\)" 1))))))) | ||
| 358 | (setq vc-rcs-release 'unknown))) | ||
| 359 | ((eq backend 'CVS) | ||
| 360 | (or vc-cvs-release | ||
| 361 | (and (zerop (vc-do-command nil 1 "cvs" nil nil "-v")) | ||
| 362 | (save-excursion | ||
| 363 | (set-buffer (get-buffer "*vc*")) | ||
| 364 | (setq vc-cvs-release | ||
| 365 | (car (vc-parse-buffer | ||
| 366 | '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)" | ||
| 367 | 1))))))) | ||
| 368 | (setq vc-cvs-release 'unknown))) | ||
| 369 | ((eq backend 'SCCS) | ||
| 370 | vc-sccs-release))) | ||
| 371 | |||
| 372 | (defun vc-release-greater-or-equal (r1 r2) | ||
| 373 | ;; Compare release numbers, represented as strings. | ||
| 374 | ;; Release components are assumed cardinal numbers, not decimal | ||
| 375 | ;; fractions (5.10 is a higher release than 5.9). Omitted fields | ||
| 376 | ;; are considered lower (5.6.7 is earlier than 5.6.7.1). | ||
| 377 | ;; Comparison runs till the end of the string is found, or a | ||
| 378 | ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta", | ||
| 379 | ;; which is probably not what you want in some cases). | ||
| 380 | ;; This code is suitable for existing RCS release numbers. | ||
| 381 | ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5). | ||
| 382 | (let (v1 v2 i1 i2) | ||
| 383 | (catch 'done | ||
| 384 | (or (and (string-match "^\\.?\\([0-9]+\\)" r1) | ||
| 385 | (setq i1 (match-end 0)) | ||
| 386 | (setq v1 (string-to-number (match-string 1 r1))) | ||
| 387 | (or (and (string-match "^\\.?\\([0-9]+\\)" r2) | ||
| 388 | (setq i2 (match-end 0)) | ||
| 389 | (setq v2 (string-to-number (match-string 1 r2))) | ||
| 390 | (if (> v1 v2) (throw 'done t) | ||
| 391 | (if (< v1 v2) (throw 'done nil) | ||
| 392 | (throw 'done | ||
| 393 | (vc-release-greater-or-equal | ||
| 394 | (substring r1 i1) | ||
| 395 | (substring r2 i2))))))) | ||
| 396 | (throw 'done t))) | ||
| 397 | (or (and (string-match "^\\.?\\([0-9]+\\)" r2) | ||
| 398 | (throw 'done nil)) | ||
| 399 | (throw 'done t))))) | ||
| 400 | |||
| 401 | (defun vc-backend-release-p (backend release) | ||
| 402 | ;; Return t if we have RELEASE of BACKEND or better | ||
| 403 | (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend))) | ||
| 404 | (if (not (eq installation 'unknown)) | ||
| 405 | (cond | ||
| 406 | ((or (eq backend 'RCS) (eq backend 'CVS)) | ||
| 407 | (vc-release-greater-or-equal installation release)))))) | ||
| 408 | |||
| 409 | ;;; functions that operate on RCS revision numbers | ||
| 410 | 431 | ||
| 432 | ;;; functions that operate on RCS revision numbers. This code should | ||
| 433 | ;;; also be moved into the backends. It stays for now, however, since | ||
| 434 | ;;; it is used in code below. | ||
| 411 | (defun vc-trunk-p (rev) | 435 | (defun vc-trunk-p (rev) |
| 412 | ;; return t if REV is a revision on the trunk | 436 | "Return t if REV is a revision on the trunk" |
| 413 | (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) | 437 | (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) |
| 414 | 438 | ||
| 415 | (defun vc-branch-p (rev) | 439 | (defun vc-branch-p (rev) |
| 416 | ;; return t if REV is a branch revision | 440 | "Return t if REV is a branch revision" |
| 417 | (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev)))) | 441 | (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev)))) |
| 418 | 442 | ||
| 419 | (defun vc-branch-part (rev) | 443 | (defun vc-branch-part (rev) |
| 420 | ;; return the branch part of a revision number REV | 444 | "return the branch part of a revision number REV" |
| 421 | (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) | 445 | (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) |
| 422 | 446 | ||
| 423 | (defun vc-minor-part (rev) | 447 | (defun vc-minor-part (rev) |
| 424 | ;; return the minor version number of a revision number REV | 448 | "Return the minor version number of a revision number REV" |
| 425 | (string-match "[0-9]+\\'" rev) | 449 | (string-match "[0-9]+\\'" rev) |
| 426 | (substring rev (match-beginning 0) (match-end 0))) | 450 | (substring rev (match-beginning 0) (match-end 0))) |
| 427 | 451 | ||
| 428 | (defun vc-previous-version (rev) | 452 | (defun vc-previous-version (rev) |
| 429 | ;; guess the previous version number | 453 | "Guess the previous version number" |
| 430 | (let ((branch (vc-branch-part rev)) | 454 | (let ((branch (vc-branch-part rev)) |
| 431 | (minor-num (string-to-number (vc-minor-part rev)))) | 455 | (minor-num (string-to-number (vc-minor-part rev)))) |
| 432 | (if (> minor-num 1) | 456 | (if (> minor-num 1) |
| @@ -450,86 +474,36 @@ If nil, VC itself computes this value when it is first needed." | |||
| 450 | ;; log buffer with a nonzero local value of vc-comment-ring-index. | 474 | ;; log buffer with a nonzero local value of vc-comment-ring-index. |
| 451 | (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) | 475 | (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) |
| 452 | 476 | ||
| 453 | (defun vc-file-clear-masterprops (file) | ||
| 454 | ;; clear all properties of FILE that were retrieved | ||
| 455 | ;; from the master file | ||
| 456 | (vc-file-setprop file 'vc-latest-version nil) | ||
| 457 | (vc-file-setprop file 'vc-your-latest-version nil) | ||
| 458 | (vc-backend-dispatch file | ||
| 459 | (progn ;; SCCS | ||
| 460 | (vc-file-setprop file 'vc-master-locks nil)) | ||
| 461 | (progn ;; RCS | ||
| 462 | (vc-file-setprop file 'vc-default-branch nil) | ||
| 463 | (vc-file-setprop file 'vc-head-version nil) | ||
| 464 | (vc-file-setprop file 'vc-master-workfile-version nil) | ||
| 465 | (vc-file-setprop file 'vc-master-locks nil)) | ||
| 466 | (progn | ||
| 467 | (vc-file-setprop file 'vc-cvs-status nil)))) | ||
| 468 | |||
| 469 | (defun vc-head-version (file) | ||
| 470 | ;; Return the RCS head version of FILE | ||
| 471 | (cond ((vc-file-getprop file 'vc-head-version)) | ||
| 472 | (t (vc-fetch-master-properties file) | ||
| 473 | (vc-file-getprop file 'vc-head-version)))) | ||
| 474 | |||
| 475 | ;; Random helper functions | 477 | ;; Random helper functions |
| 476 | 478 | ||
| 477 | (defun vc-latest-on-branch-p (file) | 479 | (defsubst vc-editable-p (file) |
| 478 | ;; return t iff the current workfile version of FILE is | 480 | (or (eq (vc-checkout-model file) 'implicit) |
| 479 | ;; the latest on its branch. | 481 | (eq (vc-state file) 'edited) |
| 480 | (vc-backend-dispatch file | 482 | (eq (vc-state file) 'needs-merge))) |
| 481 | ;; SCCS | ||
| 482 | (string= (vc-workfile-version file) (vc-latest-version file)) | ||
| 483 | ;; RCS | ||
| 484 | (let ((workfile-version (vc-workfile-version file)) tip-version) | ||
| 485 | (if (vc-trunk-p workfile-version) | ||
| 486 | (progn | ||
| 487 | ;; Re-fetch the head version number. This is to make | ||
| 488 | ;; sure that no-one has checked in a new version behind | ||
| 489 | ;; our back. | ||
| 490 | (vc-fetch-master-properties file) | ||
| 491 | (string= (vc-file-getprop file 'vc-head-version) | ||
| 492 | workfile-version)) | ||
| 493 | ;; If we are not on the trunk, we need to examine the | ||
| 494 | ;; whole current branch. (vc-master-workfile-version | ||
| 495 | ;; is not what we need.) | ||
| 496 | (save-excursion | ||
| 497 | (set-buffer (get-buffer-create "*vc-info*")) | ||
| 498 | (vc-insert-file (vc-name file) "^desc") | ||
| 499 | (setq tip-version (car (vc-parse-buffer (list (list | ||
| 500 | (concat "^\\(" (regexp-quote (vc-branch-part workfile-version)) | ||
| 501 | "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))))) | ||
| 502 | (if (get-buffer "*vc-info*") | ||
| 503 | (kill-buffer (get-buffer "*vc-info*"))) | ||
| 504 | (string= tip-version workfile-version)))) | ||
| 505 | ;; CVS | ||
| 506 | t)) | ||
| 507 | 483 | ||
| 508 | ;;; Two macros for elisp programming | 484 | ;;; Two macros for elisp programming |
| 509 | ;;;###autoload | 485 | ;;;###autoload |
| 510 | (defmacro with-vc-file (file comment &rest body) | 486 | (defmacro with-vc-file (file comment &rest body) |
| 511 | "Execute BODY, checking out a writable copy of FILE first if necessary. | 487 | "Check out a writable copy of FILE if necessary and execute the body. |
| 512 | After BODY has been executed, check-in FILE with COMMENT (a string). | 488 | Check in FILE with COMMENT (a string) after BODY has been executed. |
| 513 | FILE is passed through `expand-file-name'; BODY executed within | 489 | FILE is passed through `expand-file-name'; BODY executed within |
| 514 | `save-excursion'. If FILE is not under version control, or locked by | 490 | `save-excursion'. If FILE is not under version control, or locked by |
| 515 | somebody else, signal error." | 491 | somebody else, signal error." |
| 516 | `(let ((file (expand-file-name ,file))) | 492 | `(let ((file (expand-file-name ,file))) |
| 517 | (or (vc-registered file) | 493 | (or (vc-registered file) |
| 518 | (error (format "File not under version control: `%s'" file))) | 494 | (error (format "File not under version control: `%s'" file))) |
| 519 | (let ((locking-user (vc-locking-user file))) | 495 | (unless (vc-editable-p file) |
| 520 | (cond ((and (not locking-user) | 496 | (let ((state (vc-state file))) |
| 521 | (eq (vc-checkout-model file) 'manual)) | 497 | (if (stringp state) (error (format "`%s' is locking `%s'" state file)) |
| 522 | (vc-checkout file t)) | 498 | (vc-checkout file t)))) |
| 523 | ((and (stringp locking-user) | ||
| 524 | (not (string= locking-user (vc-user-login-name)))) | ||
| 525 | (error (format "`%s' is locking `%s'" locking-user file))))) | ||
| 526 | (save-excursion | 499 | (save-excursion |
| 527 | ,@body) | 500 | ,@body) |
| 528 | (vc-checkin file nil ,comment))) | 501 | (vc-checkin file nil ,comment))) |
| 529 | 502 | ||
| 530 | ;;;###autoload | 503 | ;;;###autoload |
| 531 | (defmacro edit-vc-file (file comment &rest body) | 504 | (defmacro edit-vc-file (file comment &rest body) |
| 532 | "Edit FILE under version control, executing BODY. Checkin with COMMENT. | 505 | "Edit FILE under version control, executing body. |
| 506 | Checkin with COMMENT after executing BODY. | ||
| 533 | This macro uses `with-vc-file', passing args to it. | 507 | This macro uses `with-vc-file', passing args to it. |
| 534 | However, before executing BODY, find FILE, and after BODY, save buffer." | 508 | However, before executing BODY, find FILE, and after BODY, save buffer." |
| 535 | `(with-vc-file | 509 | `(with-vc-file |
| @@ -539,7 +513,8 @@ However, before executing BODY, find FILE, and after BODY, save buffer." | |||
| 539 | (save-buffer))) | 513 | (save-buffer))) |
| 540 | 514 | ||
| 541 | (defun vc-ensure-vc-buffer () | 515 | (defun vc-ensure-vc-buffer () |
| 542 | ;; Make sure that the current buffer visits a version-controlled file. | 516 | "Make sure that the current buffer visits a version-controlled |
| 517 | file." | ||
| 543 | (if vc-dired-mode | 518 | (if vc-dired-mode |
| 544 | (set-buffer (find-file-noselect (dired-get-filename))) | 519 | (set-buffer (find-file-noselect (dired-get-filename))) |
| 545 | (while vc-parent-buffer | 520 | (while vc-parent-buffer |
| @@ -554,111 +529,131 @@ However, before executing BODY, find FILE, and after BODY, save buffer." | |||
| 554 | (if (memq system-type '(ms-dos windows-nt)) | 529 | (if (memq system-type '(ms-dos windows-nt)) |
| 555 | '(".exe" ".com" ".bat" ".cmd" ".btm" "") | 530 | '(".exe" ".com" ".bat" ".cmd" ".btm" "") |
| 556 | '(""))) | 531 | '(""))) |
| 557 | (defun vc-find-binary (name) | 532 | |
| 558 | "Look for a command anywhere on the subprocess-command search path." | 533 | (defun vc-process-filter (p s) |
| 559 | (or (cdr (assoc name vc-binary-assoc)) | 534 | "An alternative output filter for async processes. |
| 560 | (catch 'found | 535 | The only difference with the default filter is to insert S after markers." |
| 561 | (mapcar | 536 | (with-current-buffer (process-buffer p) |
| 562 | (function | 537 | (save-excursion |
| 563 | (lambda (s) | 538 | (let ((inhibit-read-only t)) |
| 564 | (if s | 539 | (goto-char (process-mark p)) |
| 565 | (let ((full (concat s "/" name)) | 540 | (insert s) |
| 566 | (suffixes vc-binary-suffixes) | 541 | (set-marker (process-mark p) (point)))))) |
| 567 | candidate) | 542 | |
| 568 | (while suffixes | 543 | (defun vc-setup-buffer (&optional buf) |
| 569 | (setq candidate (concat full (car suffixes))) | 544 | "prepare BUF for executing a VC command and make it the current buffer. |
| 570 | (if (and (file-executable-p candidate) | 545 | BUF defaults to \"*vc*\", can be a string and will be created if necessary." |
| 571 | (not (file-directory-p candidate))) | 546 | (unless buf (setq buf "*vc*")) |
| 572 | (progn | 547 | (let ((camefrom (current-buffer)) |
| 573 | (setq vc-binary-assoc | 548 | (olddir default-directory)) |
| 574 | (cons (cons name candidate) vc-binary-assoc)) | 549 | (set-buffer (get-buffer-create buf)) |
| 575 | (throw 'found candidate)) | 550 | (kill-all-local-variables) |
| 576 | (setq suffixes (cdr suffixes)))))))) | 551 | (set (make-local-variable 'vc-parent-buffer) camefrom) |
| 577 | exec-path) | 552 | (set (make-local-variable 'vc-parent-buffer-name) |
| 578 | nil))) | 553 | (concat " from " (buffer-name camefrom))) |
| 579 | 554 | (setq default-directory olddir) | |
| 580 | (defun vc-do-command (buffer okstatus command file last &rest flags) | 555 | (let ((inhibit-read-only t)) |
| 556 | (erase-buffer)))) | ||
| 557 | |||
| 558 | (defun vc-exec-after (code) | ||
| 559 | "Eval CODE when the current buffer's process is done. | ||
| 560 | If the current buffer has no process, just evaluate CODE. | ||
| 561 | Else, add CODE to the process' sentinel." | ||
| 562 | (let ((proc (get-buffer-process (current-buffer)))) | ||
| 563 | (cond | ||
| 564 | ;; If there's no background process, just execute the code. | ||
| 565 | ((null proc) (eval code)) | ||
| 566 | ;; If the background process has exited, reap it and try again | ||
| 567 | ((eq (process-status proc) 'exit) | ||
| 568 | (delete-process proc) | ||
| 569 | (vc-exec-after code)) | ||
| 570 | ;; If a process is running, add CODE to the sentinel | ||
| 571 | ((eq (process-status proc) 'run) | ||
| 572 | (let ((sentinel (process-sentinel proc))) | ||
| 573 | (set-process-sentinel proc | ||
| 574 | `(lambda (p s) | ||
| 575 | (with-current-buffer ',(current-buffer) | ||
| 576 | (goto-char (process-mark p)) | ||
| 577 | ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf | ||
| 578 | ; (goto-char...)' | ||
| 579 | (car (cdr (cdr ;strip off `lambda (p s)' | ||
| 580 | sentinel)))))) | ||
| 581 | (list `(vc-exec-after ',code)))))))) | ||
| 582 | (t (error "Unexpected process state")))) | ||
| 583 | nil) | ||
| 584 | |||
| 585 | (defvar vc-post-command-functions nil | ||
| 586 | "Hook run at the end of `vc-do-command'. | ||
| 587 | Each function is called inside the buffer in which the command was run | ||
| 588 | and is passed 3 argument: the COMMAND, the FILE and the FLAGS.") | ||
| 589 | |||
| 590 | (defun vc-do-command (buffer okstatus command file &rest flags) | ||
| 581 | "Execute a version-control command, notifying user and checking for errors. | 591 | "Execute a version-control command, notifying user and checking for errors. |
| 582 | Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil. The | 592 | Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current |
| 593 | buffer (which is assumed to be properly setup) if BUFFER is t. The | ||
| 583 | command is considered successful if its exit status does not exceed | 594 | command is considered successful if its exit status does not exceed |
| 584 | OKSTATUS (if OKSTATUS is nil, that means to ignore errors). FILE is | 595 | OKSTATUS (if OKSTATUS is nil, that means to ignore errors, if it is 'async, |
| 596 | that means not to wait for termination of the subprocess). FILE is | ||
| 585 | the name of the working file (may also be nil, to execute commands | 597 | the name of the working file (may also be nil, to execute commands |
| 586 | that don't expect a file name). If FILE is non-nil, the argument LAST | 598 | that don't expect a file name). If an optional list of FLAGS is present, |
| 587 | indicates what filename should actually be passed to the command: if | 599 | that is inserted into the command line before the filename." |
| 588 | it is `MASTER', the name of FILE's master file is used, if it is | ||
| 589 | `WORKFILE', then FILE is passed through unchanged. If an optional | ||
| 590 | list of FLAGS is present, that is inserted into the command line | ||
| 591 | before the filename." | ||
| 592 | (and file (setq file (expand-file-name file))) | 600 | (and file (setq file (expand-file-name file))) |
| 593 | (if (not buffer) (setq buffer "*vc*")) | ||
| 594 | (if vc-command-messages | 601 | (if vc-command-messages |
| 595 | (message "Running %s on %s..." command file)) | 602 | (message "Running %s on %s..." command file)) |
| 596 | (let ((obuf (current-buffer)) (camefrom (current-buffer)) | 603 | (save-current-buffer |
| 597 | (squeezed nil) | 604 | (unless (eq buffer t) (vc-setup-buffer buffer)) |
| 598 | (olddir default-directory) | 605 | (let ((squeezed nil) |
| 599 | vc-file status) | 606 | (inhibit-read-only t) |
| 600 | (set-buffer (get-buffer-create buffer)) | 607 | (status 0)) |
| 601 | (set (make-local-variable 'vc-parent-buffer) camefrom) | 608 | (setq squeezed (delq nil (copy-sequence flags))) |
| 602 | (set (make-local-variable 'vc-parent-buffer-name) | 609 | (when file |
| 603 | (concat " from " (buffer-name camefrom))) | 610 | ;; FIXME: file-relative-name can return a bogus result because |
| 604 | (setq default-directory olddir) | 611 | ;; it doesn't look at the actual file-system to see if symlinks |
| 605 | 612 | ;; come into play. | |
| 606 | (erase-buffer) | 613 | (setq squeezed (append squeezed (list (file-relative-name file))))) |
| 607 | 614 | (let ((exec-path (append vc-path exec-path)) | |
| 608 | (mapcar | 615 | ;; Add vc-path to PATH for the execution of this command. |
| 609 | (function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) | 616 | (process-environment |
| 610 | flags) | 617 | (cons (concat "PATH=" (getenv "PATH") |
| 611 | (if (and (eq last 'MASTER) file (setq vc-file (vc-name file))) | 618 | path-separator |
| 612 | (setq squeezed (append squeezed (list vc-file)))) | 619 | (mapconcat 'identity vc-path path-separator)) |
| 613 | (if (and file (eq last 'WORKFILE)) | 620 | process-environment)) |
| 614 | (progn | 621 | (w32-quote-process-args t)) |
| 615 | (let* ((pwd (expand-file-name default-directory)) | 622 | (if (eq okstatus 'async) |
| 616 | (preflen (length pwd))) | 623 | (let ((proc (apply 'start-process command (current-buffer) command |
| 617 | (if (string= (substring file 0 preflen) pwd) | 624 | squeezed))) |
| 618 | (setq file (substring file preflen)))) | 625 | (message "Running %s in the background..." command) |
| 619 | (setq squeezed (append squeezed (list file))))) | 626 | ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) |
| 620 | (let ((exec-path (append vc-path exec-path)) | 627 | (set-process-filter proc 'vc-process-filter) |
| 621 | ;; Add vc-path to PATH for the execution of this command. | 628 | (vc-exec-after |
| 622 | (process-environment | 629 | `(message "Running %s in the background... done" ',command))) |
| 623 | (cons (concat "PATH=" (getenv "PATH") | 630 | (setq status (apply 'call-process command nil t nil squeezed)) |
| 624 | path-separator | 631 | (when (or (not (integerp status)) (and okstatus (< okstatus status))) |
| 625 | (mapconcat 'identity vc-path path-separator)) | 632 | (pop-to-buffer (current-buffer)) |
| 626 | process-environment)) | 633 | (goto-char (point-min)) |
| 627 | (w32-quote-process-args t)) | 634 | (shrink-window-if-larger-than-buffer) |
| 628 | (setq status (apply 'call-process command nil t nil squeezed))) | 635 | (error "Running %s...FAILED (%s)" command |
| 629 | (goto-char (point-max)) | 636 | (if (integerp status) (format "status %d" status) status)))) |
| 630 | (set-buffer-modified-p nil) | 637 | (if vc-command-messages |
| 631 | (forward-line -1) | 638 | (message "Running %s...OK" command))) |
| 632 | (if (or (not (integerp status)) (and okstatus (< okstatus status))) | 639 | (vc-exec-after |
| 633 | (progn | 640 | `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags)) |
| 634 | (pop-to-buffer buffer) | 641 | status))) |
| 635 | (goto-char (point-min)) | ||
| 636 | (shrink-window-if-larger-than-buffer) | ||
| 637 | (error "Running %s...FAILED (%s)" command | ||
| 638 | (if (integerp status) | ||
| 639 | (format "status %d" status) | ||
| 640 | status)) | ||
| 641 | ) | ||
| 642 | (if vc-command-messages | ||
| 643 | (message "Running %s...OK" command)) | ||
| 644 | ) | ||
| 645 | (set-buffer obuf) | ||
| 646 | status) | ||
| 647 | ) | ||
| 648 | 642 | ||
| 649 | ;;; Save a bit of the text around POSN in the current buffer, to help | ||
| 650 | ;;; us find the corresponding position again later. This works even | ||
| 651 | ;;; if all markers are destroyed or corrupted. | ||
| 652 | ;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode. | ||
| 653 | (defun vc-position-context (posn) | 643 | (defun vc-position-context (posn) |
| 644 | "Save a bit of the text around POSN in the current buffer, to help | ||
| 645 | us find the corresponding position again later. This works even if | ||
| 646 | all markers are destroyed or corrupted." | ||
| 647 | ;; A lot of this was shamelessly lifted from Sebastian Kremer's | ||
| 648 | ;; rcs.el mode. | ||
| 654 | (list posn | 649 | (list posn |
| 655 | (buffer-size) | 650 | (buffer-size) |
| 656 | (buffer-substring posn | 651 | (buffer-substring posn |
| 657 | (min (point-max) (+ posn 100))))) | 652 | (min (point-max) (+ posn 100))))) |
| 658 | 653 | ||
| 659 | ;;; Return the position of CONTEXT in the current buffer, or nil if we | ||
| 660 | ;;; couldn't find it. | ||
| 661 | (defun vc-find-position-by-context (context) | 654 | (defun vc-find-position-by-context (context) |
| 655 | "Return the position of CONTEXT in the current buffer, or nil if we | ||
| 656 | couldn't find it." | ||
| 662 | (let ((context-string (nth 2 context))) | 657 | (let ((context-string (nth 2 context))) |
| 663 | (if (equal "" context-string) | 658 | (if (equal "" context-string) |
| 664 | (point-max) | 659 | (point-max) |
| @@ -677,7 +672,7 @@ before the filename." | |||
| 677 | (- (point) (length context-string)))))))) | 672 | (- (point) (length context-string)))))))) |
| 678 | 673 | ||
| 679 | (defun vc-context-matches-p (posn context) | 674 | (defun vc-context-matches-p (posn context) |
| 680 | ;; Returns t if POSN matches CONTEXT, nil otherwise. | 675 | "Returns t if POSN matches CONTEXT, nil otherwise." |
| 681 | (let* ((context-string (nth 2 context)) | 676 | (let* ((context-string (nth 2 context)) |
| 682 | (len (length context-string)) | 677 | (len (length context-string)) |
| 683 | (end (+ posn len))) | 678 | (end (+ posn len))) |
| @@ -686,8 +681,8 @@ before the filename." | |||
| 686 | (string= context-string (buffer-substring posn end))))) | 681 | (string= context-string (buffer-substring posn end))))) |
| 687 | 682 | ||
| 688 | (defun vc-buffer-context () | 683 | (defun vc-buffer-context () |
| 689 | ;; Return a list '(point-context mark-context reparse); from which | 684 | "Return a list '(point-context mark-context reparse); from which |
| 690 | ;; vc-restore-buffer-context can later restore the context. | 685 | vc-restore-buffer-context can later restore the context." |
| 691 | (let ((point-context (vc-position-context (point))) | 686 | (let ((point-context (vc-position-context (point))) |
| 692 | ;; Use mark-marker to avoid confusion in transient-mark-mode. | 687 | ;; Use mark-marker to avoid confusion in transient-mark-mode. |
| 693 | (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer)) | 688 | (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer)) |
| @@ -701,8 +696,7 @@ before the filename." | |||
| 701 | ;; iff that buffer is a compilation output buffer | 696 | ;; iff that buffer is a compilation output buffer |
| 702 | ;; that contains markers into the current buffer. | 697 | ;; that contains markers into the current buffer. |
| 703 | (save-excursion | 698 | (save-excursion |
| 704 | (mapcar (function | 699 | (mapcar (lambda (buffer) |
| 705 | (lambda (buffer) | ||
| 706 | (set-buffer buffer) | 700 | (set-buffer buffer) |
| 707 | (let ((errors (or | 701 | (let ((errors (or |
| 708 | compilation-old-error-list | 702 | compilation-old-error-list |
| @@ -716,21 +710,20 @@ before the filename." | |||
| 716 | (cdr (car errors)))) | 710 | (cdr (car errors)))) |
| 717 | (setq buffer-error-marked-p t)) | 711 | (setq buffer-error-marked-p t)) |
| 718 | (setq errors (cdr errors))) | 712 | (setq errors (cdr errors))) |
| 719 | (if buffer-error-marked-p buffer)))) | 713 | (if buffer-error-marked-p buffer))) |
| 720 | (buffer-list))))))) | 714 | (buffer-list))))))) |
| 721 | (list point-context mark-context reparse))) | 715 | (list point-context mark-context reparse))) |
| 722 | 716 | ||
| 723 | (defun vc-restore-buffer-context (context) | 717 | (defun vc-restore-buffer-context (context) |
| 724 | ;; Restore point/mark, and reparse any affected compilation buffers. | 718 | "Restore point/mark, and reparse any affected compilation buffers. |
| 725 | ;; CONTEXT is that which vc-buffer-context returns. | 719 | CONTEXT is that which vc-buffer-context returns." |
| 726 | (let ((point-context (nth 0 context)) | 720 | (let ((point-context (nth 0 context)) |
| 727 | (mark-context (nth 1 context)) | 721 | (mark-context (nth 1 context)) |
| 728 | (reparse (nth 2 context))) | 722 | (reparse (nth 2 context))) |
| 729 | ;; Reparse affected compilation buffers. | 723 | ;; Reparse affected compilation buffers. |
| 730 | (while reparse | 724 | (while reparse |
| 731 | (if (car reparse) | 725 | (if (car reparse) |
| 732 | (save-excursion | 726 | (with-current-buffer (car reparse) |
| 733 | (set-buffer (car reparse)) | ||
| 734 | (let ((compilation-last-buffer (current-buffer)) ;select buffer | 727 | (let ((compilation-last-buffer (current-buffer)) ;select buffer |
| 735 | ;; Record the position in the compilation buffer of | 728 | ;; Record the position in the compilation buffer of |
| 736 | ;; the last error next-error went to. | 729 | ;; the last error next-error went to. |
| @@ -755,211 +748,191 @@ before the filename." | |||
| 755 | (let ((new-mark (vc-find-position-by-context mark-context))) | 748 | (let ((new-mark (vc-find-position-by-context mark-context))) |
| 756 | (if new-mark (set-mark new-mark)))))) | 749 | (if new-mark (set-mark new-mark)))))) |
| 757 | 750 | ||
| 758 | ;; Maybe this "smart mark preservation" could be added directly | ||
| 759 | ;; to revert-buffer since it can be generally useful. -sm | ||
| 760 | (defun vc-revert-buffer1 (&optional arg no-confirm) | 751 | (defun vc-revert-buffer1 (&optional arg no-confirm) |
| 761 | ;; Revert buffer, try to keep point and mark where user expects them in spite | 752 | "Revert buffer, try to keep point and mark where user expects them |
| 762 | ;; of changes because of expanded version-control key words. | 753 | in spite of changes because of expanded version-control key words. |
| 763 | ;; This is quite important since otherwise typeahead won't work as expected. | 754 | This is quite important since otherwise typeahead won't work as |
| 755 | expected." | ||
| 764 | (interactive "P") | 756 | (interactive "P") |
| 765 | (widen) | 757 | (widen) |
| 766 | (let ((context (vc-buffer-context))) | 758 | (let ((context (vc-buffer-context))) |
| 767 | ;; Use save-excursion here, because it may be able to restore point | 759 | ;; Use save-excursion here, because it may be able to restore point |
| 768 | ;; and mark properly even in cases where vc-restore-buffer-context | 760 | ;; and mark properly even in cases where vc-restore-buffer-context |
| 769 | ;; would fail. However, save-excursion might also get it wrong -- | 761 | ;; would fail. However, save-excursion might also get it wrong -- |
| 770 | ;; in this case, vc-restore-buffer-context gives it a second try. | 762 | ;; in this case, vc-restore-buffer-context gives it a second try. |
| 771 | (save-excursion | 763 | (save-excursion |
| 772 | ;; t means don't call normal-mode; | 764 | ;; t means don't call normal-mode; |
| 773 | ;; that's to preserve various minor modes. | 765 | ;; that's to preserve various minor modes. |
| 774 | (revert-buffer arg no-confirm t)) | 766 | (revert-buffer arg no-confirm t)) |
| 775 | (vc-restore-buffer-context context))) | 767 | (vc-restore-buffer-context context))) |
| 776 | 768 | ||
| 777 | 769 | ||
| 778 | (defun vc-buffer-sync (&optional not-urgent) | 770 | (defun vc-buffer-sync (&optional not-urgent) |
| 779 | ;; Make sure the current buffer and its working file are in sync | 771 | "Make sure the current buffer and its working file are in sync |
| 780 | ;; NOT-URGENT means it is ok to continue if the user says not to save. | 772 | NOT-URGENT means it is ok to continue if the user says not to save." |
| 781 | (if (buffer-modified-p) | 773 | (if (buffer-modified-p) |
| 782 | (if (or vc-suppress-confirm | 774 | (if (or vc-suppress-confirm |
| 783 | (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))) | 775 | (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))) |
| 784 | (save-buffer) | 776 | (save-buffer) |
| 785 | (if not-urgent | 777 | (unless not-urgent |
| 786 | nil | ||
| 787 | (error "Aborted"))))) | 778 | (error "Aborted"))))) |
| 788 | 779 | ||
| 789 | 780 | (defun vc-workfile-unchanged-p (file) | |
| 790 | (defun vc-workfile-unchanged-p (file &optional want-differences-if-changed) | 781 | "Has the given workfile changed since last checkout?" |
| 791 | ;; Has the given workfile changed since last checkout? | ||
| 792 | (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) | 782 | (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) |
| 793 | (lastmod (nth 5 (file-attributes file)))) | 783 | (lastmod (nth 5 (file-attributes file)))) |
| 794 | (or (equal checkout-time lastmod) | 784 | (if checkout-time |
| 795 | (and (or (not checkout-time) want-differences-if-changed) | 785 | (equal checkout-time lastmod) |
| 796 | (let ((unchanged (zerop (vc-backend-diff file nil nil | 786 | (let ((unchanged (vc-call workfile-unchanged-p file))) |
| 797 | (not want-differences-if-changed))))) | 787 | (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) |
| 798 | ;; 0 stands for an unknown time; it can't match any mod time. | 788 | unchanged)))) |
| 799 | (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) | 789 | |
| 800 | unchanged))))) | 790 | (defun vc-default-workfile-unchanged-p (file) |
| 791 | "Default check whether workfile is unchanged: diff against master version." | ||
| 792 | (zerop (vc-call diff file (vc-workfile-version file)))) | ||
| 801 | 793 | ||
| 802 | (defun vc-next-action-on-file (file verbose &optional comment) | 794 | (defun vc-recompute-state (file) |
| 803 | ;;; If comment is specified, it will be used as an admin or checkin comment. | 795 | "Force a recomputation of the version control state of FILE. |
| 804 | (let ((vc-type (vc-backend file)) | 796 | The state is computed using the exact, and possibly expensive |
| 805 | owner version buffer) | 797 | function `vc-BACKEND-state', not the heuristic." |
| 806 | (cond | 798 | (vc-file-setprop file 'vc-state (vc-call state file))) |
| 807 | 799 | ||
| 808 | ;; If the file is not under version control, register it | 800 | (defun vc-next-action-on-file (file verbose &optional comment) |
| 809 | ((not vc-type) | 801 | "Do The Right Thing for a given version-controlled FILE. |
| 810 | (vc-register verbose comment)) | 802 | If COMMENT is specified, it will be used as an admin or checkin comment. |
| 811 | 803 | If VERBOSE is non-nil, query the user rather than using default parameters." | |
| 812 | ;; CVS: changes to the master file need to be | 804 | (let ((visited (get-file-buffer file)) |
| 813 | ;; merged back into the working file | 805 | state version) |
| 814 | ((and (eq vc-type 'CVS) | 806 | (when visited |
| 815 | (or (eq (vc-cvs-status file) 'needs-checkout) | 807 | ;; Check relation of buffer and file, and make sure |
| 816 | (eq (vc-cvs-status file) 'needs-merge))) | 808 | ;; user knows what he's doing. First, finding the file |
| 817 | (if (or vc-dired-mode | 809 | ;; will check whether the file on disk is newer. |
| 818 | (yes-or-no-p | 810 | (if vc-dired-mode |
| 819 | (format "%s is not up-to-date. Merge in changes now? " | 811 | (find-file-other-window file) |
| 820 | (buffer-name)))) | 812 | (find-file file)) |
| 821 | (progn | 813 | (if (not (verify-visited-file-modtime (current-buffer))) |
| 822 | (if vc-dired-mode | 814 | (if (yes-or-no-p "Replace file on disk with buffer contents? ") |
| 823 | (and (setq buffer (get-file-buffer file)) | 815 | (write-file (buffer-file-name)) |
| 824 | (buffer-modified-p buffer) | 816 | (error "Aborted")) |
| 825 | (switch-to-buffer-other-window buffer) | 817 | ;; Now, check if we have unsaved changes. |
| 826 | (vc-buffer-sync t)) | 818 | (vc-buffer-sync t) |
| 827 | (setq buffer (current-buffer)) | 819 | (if (buffer-modified-p) |
| 828 | (vc-buffer-sync t)) | 820 | (or (y-or-n-p "Operate on disk file, keeping modified buffer? ") |
| 829 | (if (and buffer (buffer-modified-p buffer) | 821 | (error "Aborted"))))) |
| 830 | (not (yes-or-no-p | 822 | |
| 831 | (format | 823 | ;; Do the right thing |
| 832 | "Buffer %s modified; merge file on disc anyhow? " | 824 | (if (not (vc-registered file)) |
| 833 | (buffer-name buffer))))) | 825 | (vc-register verbose comment) |
| 834 | (error "Merge aborted")) | 826 | (vc-recompute-state file) |
| 835 | (let ((status (vc-backend-merge-news file))) | 827 | (setq state (vc-state file)) |
| 836 | (and buffer | 828 | (cond |
| 837 | (vc-resynch-buffer file t | 829 | ;; up-to-date |
| 838 | (not (buffer-modified-p buffer)))) | 830 | ((or (eq state 'up-to-date) |
| 839 | (if (not (zerop status)) | 831 | (and verbose (eq state 'needs-patch))) |
| 840 | (if (y-or-n-p "Conflicts detected. Resolve them now? ") | 832 | (cond |
| 841 | (vc-resolve-conflicts))))) | 833 | (verbose |
| 842 | (error "%s needs update" (buffer-name)))) | 834 | ;; go to a different version |
| 843 | 835 | (setq version (read-string "Branch or version to move to: ")) | |
| 844 | ;; For CVS files with implicit checkout: if unmodified, don't do anything | 836 | (vc-checkout file (eq (vc-checkout-model file) 'implicit) version)) |
| 845 | ((and (eq vc-type 'CVS) | 837 | ((not (eq (vc-checkout-model file) 'implicit)) |
| 846 | (eq (vc-checkout-model file) 'implicit) | 838 | ;; check the file out |
| 847 | (not (vc-locking-user file)) | 839 | (vc-checkout file t)) |
| 848 | (not verbose)) | 840 | (t |
| 849 | (message "%s is up to date" (buffer-name))) | 841 | ;; do nothing |
| 850 | 842 | (message "%s is up-to-date" file)))) | |
| 851 | ;; If there is no lock on the file, assert one and get it. | 843 | |
| 852 | ((not (setq owner (vc-locking-user file))) | 844 | ;; Abnormal: edited but read-only |
| 853 | ;; With implicit checkout, make sure not to lose unsaved changes. | 845 | ((and visited (eq state 'edited) buffer-read-only) |
| 854 | (and (eq (vc-checkout-model file) 'implicit) | 846 | ;; Make the file+buffer read-write. If the user really wanted to |
| 855 | (buffer-modified-p buffer) | 847 | ;; commit, he'll get a chance to do that next time around, anyway. |
| 856 | (vc-buffer-sync)) | 848 | (message "File is edited but read-only; making it writable") |
| 857 | (if (and vc-checkout-carefully | 849 | (set-file-modes buffer-file-name |
| 858 | (not (vc-workfile-unchanged-p file t))) | 850 | (logior (file-modes buffer-file-name) 128)) |
| 859 | (if (save-window-excursion | 851 | (toggle-read-only -1)) |
| 860 | (pop-to-buffer "*vc-diff*") | 852 | |
| 861 | (goto-char (point-min)) | 853 | ;; edited |
| 862 | (insert-string (format "Changes to %s since last lock:\n\n" | 854 | ((eq state 'edited) |
| 863 | file)) | 855 | (cond |
| 864 | (not (beep)) | 856 | ;; For files with locking, if the file does not contain |
| 865 | (yes-or-no-p | 857 | ;; any changes, just let go of the lock, i.e. revert. |
| 866 | (concat "File has unlocked changes, " | 858 | ((and (not (eq (vc-checkout-model file) 'implicit)) |
| 867 | "claim lock retaining changes? "))) | 859 | (vc-workfile-unchanged-p file) |
| 868 | (progn (vc-backend-steal file) | 860 | ;; If buffer is modified, that means the user just |
| 869 | (vc-mode-line file)) | 861 | ;; said no to saving it; in that case, don't revert, |
| 870 | (if (not (yes-or-no-p "Revert to checked-in version, instead? ")) | 862 | ;; because the user might intend to save after |
| 871 | (error "Checkout aborted") | 863 | ;; finishing the log entry. |
| 872 | (vc-revert-buffer1 t t) | 864 | (not (and visited (buffer-modified-p)))) |
| 873 | (vc-checkout-writable-buffer file)) | 865 | ;; DO NOT revert the file without asking the user! |
| 874 | ) | 866 | (if (not visited) (find-file-other-window file)) |
| 875 | (if verbose | 867 | (if (yes-or-no-p "Revert to master version? ") |
| 876 | (if (not (eq vc-type 'SCCS)) | 868 | (vc-revert-buffer))) |
| 877 | (vc-checkout file nil | 869 | (t ;; normal action |
| 878 | (read-string "Branch or version to move to: ")) | 870 | (if verbose (setq version (read-string "New version: "))) |
| 879 | (error "Sorry, this is not implemented for SCCS")) | 871 | (vc-checkin file version comment)))) |
| 880 | (if (vc-latest-on-branch-p file) | 872 | |
| 881 | (vc-checkout-writable-buffer file) | 873 | ;; locked by somebody else |
| 882 | (if (yes-or-no-p | 874 | ((stringp state) |
| 883 | "This is not the latest version. Really lock it? ") | 875 | (if comment |
| 884 | (vc-checkout-writable-buffer file) | 876 | (error "Sorry, you can't steal the lock on %s this way" |
| 885 | (if (yes-or-no-p "Lock the latest version instead? ") | 877 | (file-name-nondirectory file))) |
| 886 | (vc-checkout-writable-buffer file | 878 | (vc-steal-lock file |
| 887 | (if (vc-trunk-p (vc-workfile-version file)) | 879 | (if verbose (read-string "Version to steal: ") |
| 888 | "" ;; this means check out latest on trunk | 880 | (vc-workfile-version file)) |
| 889 | (vc-branch-part (vc-workfile-version file))))))) | 881 | state)) |
| 890 | ))) | 882 | |
| 891 | 883 | ;; needs-patch | |
| 892 | ;; a checked-out version exists, but the user may not own the lock | 884 | ((eq state 'needs-patch) |
| 893 | ((and (not (eq vc-type 'CVS)) | 885 | (if (yes-or-no-p (format |
| 894 | (not (string-equal owner (vc-user-login-name)))) | 886 | "%s is not up-to-date. Get latest version? " |
| 895 | (if comment | 887 | (file-name-nondirectory file))) |
| 896 | (error "Sorry, you can't steal the lock on %s this way" file)) | 888 | (vc-checkout file (eq (vc-checkout-model file) 'implicit) "") |
| 897 | (and (eq vc-type 'RCS) | 889 | (if (and (not (eq (vc-checkout-model file) 'implicit)) |
| 898 | (not (vc-backend-release-p 'RCS "5.6.2")) | 890 | (yes-or-no-p "Lock this version? ")) |
| 899 | (error "File is locked by %s" owner)) | 891 | (vc-checkout file t) |
| 900 | (vc-steal-lock | 892 | (error "Aborted")))) |
| 901 | file | 893 | |
| 902 | (if verbose (read-string "Version to steal: ") | 894 | ;; needs-merge |
| 903 | (vc-workfile-version file)) | 895 | ((eq state 'needs-merge) |
| 904 | owner)) | 896 | (if (yes-or-no-p (format |
| 905 | 897 | "%s is not up-to-date. Merge in changes now? " | |
| 906 | ;; OK, user owns the lock on the file | 898 | (file-name-nondirectory file))) |
| 907 | (t | 899 | (vc-maybe-resolve-conflicts file (vc-call merge-news file)) |
| 908 | (if vc-dired-mode | 900 | (error "Aborted"))) |
| 909 | (find-file-other-window file) | 901 | |
| 910 | (find-file file)) | 902 | ;; unlocked-changes |
| 911 | 903 | ((eq state 'unlocked-changes) | |
| 912 | ;; If the file on disk is newer, then the user just | 904 | (if (not visited) (find-file-other-window file)) |
| 913 | ;; said no to rereading it. So the user probably wishes to | 905 | (if (save-window-excursion |
| 914 | ;; overwrite the file with the buffer's contents, and check | 906 | (vc-version-diff file (vc-workfile-version file) nil) |
| 915 | ;; that in. | 907 | (goto-char (point-min)) |
| 916 | (if (not (verify-visited-file-modtime (current-buffer))) | 908 | (insert-string (format "Changes to %s since last lock:\n\n" |
| 917 | (if (yes-or-no-p "Replace file on disk with buffer contents? ") | 909 | file)) |
| 918 | (write-file (buffer-file-name)) | 910 | (not (beep)) |
| 919 | (error "Aborted")) | 911 | (yes-or-no-p (concat "File has unlocked changes. " |
| 920 | ;; if buffer is not saved, give user a chance to do it | 912 | "Claim lock retaining changes? "))) |
| 921 | (vc-buffer-sync)) | 913 | (progn (vc-call steal-lock file) |
| 922 | 914 | ;; Must clear any headers here because they wouldn't | |
| 923 | ;; Revert if file is unchanged and buffer is too. | 915 | ;; show that the file is locked now. |
| 924 | ;; If buffer is modified, that means the user just said no | 916 | (vc-clear-headers file) |
| 925 | ;; to saving it; in that case, don't revert, | 917 | (vc-mode-line file)) |
| 926 | ;; because the user might intend to save | 918 | (if (not (yes-or-no-p |
| 927 | ;; after finishing the log entry. | 919 | "Revert to checked-in version, instead? ")) |
| 928 | (if (and (vc-workfile-unchanged-p file) | 920 | (error "Checkout aborted") |
| 929 | (not (buffer-modified-p))) | 921 | (vc-revert-buffer1 t t) |
| 930 | ;; DO NOT revert the file without asking the user! | 922 | (vc-checkout file t)))))))) |
| 931 | (cond | ||
| 932 | ((yes-or-no-p "Revert to master version? ") | ||
| 933 | (vc-backend-revert file) | ||
| 934 | (vc-resynch-window file t t))) | ||
| 935 | |||
| 936 | ;; user may want to set nonstandard parameters | ||
| 937 | (if verbose | ||
| 938 | (setq version (read-string "New version level: "))) | ||
| 939 | |||
| 940 | ;; OK, let's do the checkin | ||
| 941 | (vc-checkin file version comment) | ||
| 942 | ))))) | ||
| 943 | 923 | ||
| 944 | (defvar vc-dired-window-configuration) | 924 | (defvar vc-dired-window-configuration) |
| 945 | 925 | ||
| 946 | (defun vc-next-action-dired (file rev comment) | 926 | (defun vc-next-action-dired (file rev comment) |
| 947 | ;; Do a vc-next-action-on-file on all the marked files, possibly | 927 | "Do a vc-next-action-on-file on all the marked files, possibly |
| 948 | ;; passing on the log comment we've just entered. | 928 | passing on the log comment we've just entered." |
| 949 | (let ((dired-buffer (current-buffer)) | 929 | (let ((dired-buffer (current-buffer)) |
| 950 | (dired-dir default-directory)) | 930 | (dired-dir default-directory)) |
| 951 | (dired-map-over-marks | 931 | (dired-map-over-marks |
| 952 | (let ((file (dired-get-filename))) | 932 | (let ((file (dired-get-filename))) |
| 953 | (message "Processing %s..." file) | 933 | (message "Processing %s..." file) |
| 954 | ;; Adjust the default directory so that checkouts | 934 | (vc-next-action-on-file file nil comment) |
| 955 | ;; go to the right place. | 935 | (set-buffer dired-buffer) |
| 956 | (let ((default-directory (file-name-directory file))) | ||
| 957 | (vc-next-action-on-file file nil comment) | ||
| 958 | (set-buffer dired-buffer)) | ||
| 959 | ;; Make sure that files don't vanish | ||
| 960 | ;; after they are checked in. | ||
| 961 | (let ((vc-dired-terse-mode nil)) | ||
| 962 | (dired-do-redisplay file)) | ||
| 963 | (set-window-configuration vc-dired-window-configuration) | 936 | (set-window-configuration vc-dired-window-configuration) |
| 964 | (message "Processing %s...done" file)) | 937 | (message "Processing %s...done" file)) |
| 965 | nil t)) | 938 | nil t)) |
| @@ -970,14 +943,17 @@ before the filename." | |||
| 970 | ;;;###autoload | 943 | ;;;###autoload |
| 971 | (defun vc-next-action (verbose) | 944 | (defun vc-next-action (verbose) |
| 972 | "Do the next logical checkin or checkout operation on the current file. | 945 | "Do the next logical checkin or checkout operation on the current file. |
| 973 | If you call this from within a VC dired buffer with no files marked, | 946 | |
| 947 | If you call this from within a VC dired buffer with no files marked, | ||
| 974 | it will operate on the file in the current line. | 948 | it will operate on the file in the current line. |
| 975 | If you call this from within a VC dired buffer, and one or more | 949 | |
| 950 | If you call this from within a VC dired buffer, and one or more | ||
| 976 | files are marked, it will accept a log message and then operate on | 951 | files are marked, it will accept a log message and then operate on |
| 977 | each one. The log message will be used as a comment for any register | 952 | each one. The log message will be used as a comment for any register |
| 978 | or checkin operations, but ignored when doing checkouts. Attempted | 953 | or checkin operations, but ignored when doing checkouts. Attempted |
| 979 | lock steals will raise an error. | 954 | lock steals will raise an error. |
| 980 | A prefix argument lets you specify the version number to use. | 955 | |
| 956 | A prefix argument lets you specify the version number to use. | ||
| 981 | 957 | ||
| 982 | For RCS and SCCS files: | 958 | For RCS and SCCS files: |
| 983 | If the file is not already registered, this registers it for version | 959 | If the file is not already registered, this registers it for version |
| @@ -1012,14 +988,10 @@ merge in the changes into your working copy." | |||
| 1012 | (let ((files (dired-get-marked-files))) | 988 | (let ((files (dired-get-marked-files))) |
| 1013 | (set (make-local-variable 'vc-dired-window-configuration) | 989 | (set (make-local-variable 'vc-dired-window-configuration) |
| 1014 | (current-window-configuration)) | 990 | (current-window-configuration)) |
| 1015 | (if (string= "" | 991 | (if (string= "" |
| 1016 | (mapconcat | 992 | (mapconcat |
| 1017 | (function (lambda (f) | 993 | (lambda (f) |
| 1018 | (if (eq (vc-backend f) 'CVS) | 994 | (if (not (vc-up-to-date-p f)) "@" "")) |
| 1019 | (if (or (eq (vc-cvs-status f) 'locally-modified) | ||
| 1020 | (eq (vc-cvs-status f) 'locally-added)) | ||
| 1021 | "@" "") | ||
| 1022 | (if (vc-locking-user f) "@" "")))) | ||
| 1023 | files "")) | 995 | files "")) |
| 1024 | (vc-next-action-dired nil nil "dummy") | 996 | (vc-next-action-dired nil nil "dummy") |
| 1025 | (vc-start-entry nil nil nil | 997 | (vc-start-entry nil nil nil |
| @@ -1040,17 +1012,25 @@ merge in the changes into your working copy." | |||
| 1040 | ) | 1012 | ) |
| 1041 | 1013 | ||
| 1042 | ;;;###autoload | 1014 | ;;;###autoload |
| 1043 | (defun vc-register (&optional override comment) | 1015 | (defun vc-register (&optional set-version comment) |
| 1044 | "Register the current file into your version-control system." | 1016 | "Register the current file into a version-control system. |
| 1017 | With prefix argument SET-VERSION, allow user to specify initial version | ||
| 1018 | level. If COMMENT is present, use that as an initial comment. | ||
| 1019 | |||
| 1020 | The version-control system to use is found by cycling through the list | ||
| 1021 | `vc-handled-backends'. The first backend in that list which declares | ||
| 1022 | itself responsible for the file (usually because other files in that | ||
| 1023 | directory are already registered under that backend) will be used to | ||
| 1024 | register the file. If no backend declares itself responsible, the | ||
| 1025 | first backend that could register the file is used." | ||
| 1045 | (interactive "P") | 1026 | (interactive "P") |
| 1046 | (or buffer-file-name | 1027 | (or buffer-file-name |
| 1047 | (error "No visited file")) | 1028 | (error "No visited file")) |
| 1048 | (let ((master (vc-name buffer-file-name))) | 1029 | (when (vc-backend buffer-file-name) |
| 1049 | (and master (file-exists-p master) | 1030 | (if (vc-registered buffer-file-name) |
| 1050 | (error "This file is already registered")) | 1031 | (error "This file is already registered") |
| 1051 | (and master | 1032 | (unless (y-or-n-p "Previous master file has vanished. Make a new one? ") |
| 1052 | (not (y-or-n-p "Previous master file has vanished. Make a new one? ")) | 1033 | (error "Aborted")))) |
| 1053 | (error "This file is already registered"))) | ||
| 1054 | ;; Watch out for new buffers of size 0: the corresponding file | 1034 | ;; Watch out for new buffers of size 0: the corresponding file |
| 1055 | ;; does not exist yet, even though buffer-modified-p is nil. | 1035 | ;; does not exist yet, even though buffer-modified-p is nil. |
| 1056 | (if (and (not (buffer-modified-p)) | 1036 | (if (and (not (buffer-modified-p)) |
| @@ -1058,32 +1038,66 @@ merge in the changes into your working copy." | |||
| 1058 | (not (file-exists-p buffer-file-name))) | 1038 | (not (file-exists-p buffer-file-name))) |
| 1059 | (set-buffer-modified-p t)) | 1039 | (set-buffer-modified-p t)) |
| 1060 | (vc-buffer-sync) | 1040 | (vc-buffer-sync) |
| 1061 | (cond ((not vc-make-backup-files) | 1041 | |
| 1062 | ;; inhibit backup for this buffer | 1042 | (vc-start-entry buffer-file-name |
| 1063 | (make-local-variable 'backup-inhibited) | 1043 | (if set-version |
| 1064 | (setq backup-inhibited t))) | 1044 | (read-string "Initial version level for %s: " |
| 1065 | (vc-admin | 1045 | (buffer-name)) |
| 1066 | buffer-file-name | 1046 | ;; TODO: Use backend-specific init version. |
| 1067 | (or (and override | 1047 | vc-default-init-version) |
| 1068 | (read-string | 1048 | (or comment (not vc-initial-comment)) |
| 1069 | (format "Initial version level for %s: " buffer-file-name))) | 1049 | "Enter initial comment." |
| 1070 | vc-default-init-version) | 1050 | (lambda (file rev comment) |
| 1071 | comment) | 1051 | (message "Registering %s... " file) |
| 1072 | ;; Recompute backend property (it may have been set to nil before). | 1052 | (let ((backend (vc-responsible-backend file))) |
| 1073 | (setq vc-buffer-backend (vc-backend (buffer-file-name))) | 1053 | (vc-call-backend backend 'register file rev comment) |
| 1074 | ) | 1054 | (vc-file-setprop file 'vc-backend backend) |
| 1055 | (unless vc-make-backup-files | ||
| 1056 | (make-local-variable 'backup-inhibited) | ||
| 1057 | (setq backup-inhibited t))) | ||
| 1058 | (message "Registering %s... done" file)))) | ||
| 1059 | |||
| 1060 | (defun vc-responsible-backend (file &optional register) | ||
| 1061 | "Return the name of the backend system that is responsible for FILE. | ||
| 1062 | If no backend in variable `vc-handled-backends' declares itself | ||
| 1063 | responsible, the first backend in that list will be returned (if optional | ||
| 1064 | arg REGISTER is non-nil, return the first backend that could register the | ||
| 1065 | file). | ||
| 1066 | FILE can also be a directory name (ending with a slash)." | ||
| 1067 | (if (null vc-handled-backends) | ||
| 1068 | (error "Cannot register, no backends in `vc-handled-backends'")) | ||
| 1069 | (or (and (not (file-directory-p file)) (vc-backend file)) | ||
| 1070 | (catch 'found | ||
| 1071 | (mapcar (lambda (backend) | ||
| 1072 | (if (vc-call-backend backend 'responsible-p file) | ||
| 1073 | (throw 'found backend))) | ||
| 1074 | vc-handled-backends) | ||
| 1075 | (if register | ||
| 1076 | (mapcar (lambda (backend) | ||
| 1077 | (if (vc-call-backend backend 'could-register file) | ||
| 1078 | (throw 'found backend))) | ||
| 1079 | vc-handled-backends) | ||
| 1080 | (car vc-handled-backends))))) | ||
| 1081 | |||
| 1082 | (defun vc-default-could-register (backend file) | ||
| 1083 | "Return non-nil if BACKEND could be used to register FILE. | ||
| 1084 | The default implementation returns t for all files." | ||
| 1085 | t) | ||
| 1075 | 1086 | ||
| 1076 | (defun vc-resynch-window (file &optional keep noquery) | 1087 | (defun vc-resynch-window (file &optional keep noquery) |
| 1077 | ;; If the given file is in the current buffer, | 1088 | "If the given file is in the current buffer, either revert on it so |
| 1078 | ;; either revert on it so we see expanded keywords, | 1089 | we see expanded keywords, or unvisit it (depending on |
| 1079 | ;; or unvisit it (depending on vc-keep-workfiles) | 1090 | vc-keep-workfiles) NOQUERY if non-nil inhibits confirmation for |
| 1080 | ;; NOQUERY if non-nil inhibits confirmation for reverting. | 1091 | reverting. NOQUERY should be t *only* if it is known the only |
| 1081 | ;; NOQUERY should be t *only* if it is known the only difference | 1092 | difference between the buffer and the file is due to version control |
| 1082 | ;; between the buffer and the file is due to RCS rather than user editing! | 1093 | rather than user editing!" |
| 1083 | (and (string= buffer-file-name file) | 1094 | (and (string= buffer-file-name file) |
| 1084 | (if keep | 1095 | (if keep |
| 1085 | (progn | 1096 | (progn |
| 1086 | (vc-revert-buffer1 t noquery) | 1097 | (vc-revert-buffer1 t noquery) |
| 1098 | ;; TODO: Adjusting view mode might no longer be necessary | ||
| 1099 | ;; after RMS change to files.el of 1999-08-08. Investigate | ||
| 1100 | ;; this when we install the new VC. | ||
| 1087 | (and view-read-only | 1101 | (and view-read-only |
| 1088 | (if (file-writable-p file) | 1102 | (if (file-writable-p file) |
| 1089 | (and view-mode | 1103 | (and view-mode |
| @@ -1096,26 +1110,25 @@ merge in the changes into your working copy." | |||
| 1096 | (kill-buffer (current-buffer))))) | 1110 | (kill-buffer (current-buffer))))) |
| 1097 | 1111 | ||
| 1098 | (defun vc-resynch-buffer (file &optional keep noquery) | 1112 | (defun vc-resynch-buffer (file &optional keep noquery) |
| 1099 | ;; if FILE is currently visited, resynch its buffer | 1113 | "If FILE is currently visited, resynch its buffer." |
| 1100 | (if (string= buffer-file-name file) | 1114 | (if (string= buffer-file-name file) |
| 1101 | (vc-resynch-window file keep noquery) | 1115 | (vc-resynch-window file keep noquery) |
| 1102 | (let ((buffer (get-file-buffer file))) | 1116 | (let ((buffer (get-file-buffer file))) |
| 1103 | (if buffer | 1117 | (if buffer |
| 1104 | (save-excursion | 1118 | (with-current-buffer buffer |
| 1105 | (set-buffer buffer) | 1119 | (vc-resynch-window file keep noquery))))) |
| 1106 | (vc-resynch-window file keep noquery)))))) | 1120 | (vc-dired-resynch-file file)) |
| 1107 | 1121 | ||
| 1108 | (defun vc-start-entry (file rev comment msg action &optional after-hook) | 1122 | (defun vc-start-entry (file rev comment msg action &optional after-hook) |
| 1109 | ;; Accept a comment for an operation on FILE revision REV. If COMMENT | 1123 | "Accept a comment for an operation on FILE revision REV. If COMMENT |
| 1110 | ;; is nil, pop up a VC-log buffer, emit MSG, and set the | 1124 | is nil, pop up a VC-log buffer, emit MSG, and set the action on close |
| 1111 | ;; action on close to ACTION; otherwise, do action immediately. | 1125 | to ACTION; otherwise, do action immediately. Remember the file's |
| 1112 | ;; Remember the file's buffer in vc-parent-buffer (current one if no file). | 1126 | buffer in vc-parent-buffer (current one if no file). AFTER-HOOK |
| 1113 | ;; AFTER-HOOK specifies the local value for vc-log-operation-hook. | 1127 | specifies the local value for vc-log-operation-hook." |
| 1114 | (let ((parent (if file (find-file-noselect file) (current-buffer)))) | 1128 | (let ((parent (if file (find-file-noselect file) (current-buffer)))) |
| 1115 | (if vc-before-checkin-hook | 1129 | (if vc-before-checkin-hook |
| 1116 | (if file | 1130 | (if file |
| 1117 | (save-excursion | 1131 | (with-current-buffer parent |
| 1118 | (set-buffer parent) | ||
| 1119 | (run-hooks 'vc-before-checkin-hook)) | 1132 | (run-hooks 'vc-before-checkin-hook)) |
| 1120 | (run-hooks 'vc-before-checkin-hook))) | 1133 | (run-hooks 'vc-before-checkin-hook))) |
| 1121 | (if comment | 1134 | (if comment |
| @@ -1125,7 +1138,7 @@ merge in the changes into your working copy." | |||
| 1125 | (set (make-local-variable 'vc-parent-buffer-name) | 1138 | (set (make-local-variable 'vc-parent-buffer-name) |
| 1126 | (concat " from " (buffer-name vc-parent-buffer))) | 1139 | (concat " from " (buffer-name vc-parent-buffer))) |
| 1127 | (if file (vc-mode-line file)) | 1140 | (if file (vc-mode-line file)) |
| 1128 | (vc-log-mode file) | 1141 | (if (fboundp 'log-edit) (vc-log-edit file) (vc-log-mode file)) |
| 1129 | (make-local-variable 'vc-log-after-operation-hook) | 1142 | (make-local-variable 'vc-log-after-operation-hook) |
| 1130 | (if after-hook | 1143 | (if after-hook |
| 1131 | (setq vc-log-after-operation-hook after-hook)) | 1144 | (setq vc-log-after-operation-hook after-hook)) |
| @@ -1138,44 +1151,41 @@ merge in the changes into your working copy." | |||
| 1138 | (vc-finish-logentry t) | 1151 | (vc-finish-logentry t) |
| 1139 | (insert comment) | 1152 | (insert comment) |
| 1140 | (vc-finish-logentry nil))) | 1153 | (vc-finish-logentry nil))) |
| 1141 | (message "%s Type C-c C-c when done." msg)))) | 1154 | (message "%s Type C-c C-c when done" msg)))) |
| 1142 | |||
| 1143 | (defun vc-admin (file rev &optional comment) | ||
| 1144 | "Check a file into your version-control system. | ||
| 1145 | FILE is the unmodified name of the file. REV should be the base version | ||
| 1146 | level to check it in under. COMMENT, if specified, is the checkin comment." | ||
| 1147 | (vc-start-entry file rev | ||
| 1148 | (or comment (not vc-initial-comment)) | ||
| 1149 | "Enter initial comment." 'vc-backend-admin | ||
| 1150 | nil)) | ||
| 1151 | 1155 | ||
| 1152 | (defun vc-checkout (file &optional writable rev) | 1156 | (defun vc-checkout (file &optional writable rev) |
| 1153 | "Retrieve a copy of the latest version of the given file." | 1157 | "Retrieve a copy of the latest version of the given file." |
| 1154 | ;; If ftp is on this system and the name matches the ange-ftp format | 1158 | (condition-case err |
| 1155 | ;; for a remote file, the user is trying something that won't work. | 1159 | (vc-call checkout file writable rev) |
| 1156 | (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) | 1160 | (file-error |
| 1157 | (error "Sorry, you can't check out files over FTP")) | 1161 | ;; Maybe the backend is not installed ;-( |
| 1158 | (vc-backend-checkout file writable rev) | 1162 | (when writable |
| 1163 | (let ((buf (get-file-buffer file))) | ||
| 1164 | (when buf (with-current-buffer buf (toggle-read-only -1))))) | ||
| 1165 | (signal (car err) (cdr err)))) | ||
| 1166 | (vc-file-setprop file 'vc-state | ||
| 1167 | (if (or (eq (vc-checkout-model file) 'implicit) | ||
| 1168 | (not writable)) | ||
| 1169 | (if (vc-call latest-on-branch-p file) | ||
| 1170 | 'up-to-date | ||
| 1171 | 'needs-patch) | ||
| 1172 | 'edited)) | ||
| 1173 | (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) | ||
| 1159 | (vc-resynch-buffer file t t)) | 1174 | (vc-resynch-buffer file t t)) |
| 1160 | 1175 | ||
| 1161 | (defun vc-steal-lock (file rev &optional owner) | 1176 | (defun vc-steal-lock (file rev owner) |
| 1162 | "Steal the lock on the current workfile." | 1177 | "Steal the lock on the current workfile." |
| 1163 | (let (file-description) | 1178 | (let (file-description) |
| 1164 | (if (not owner) | ||
| 1165 | (setq owner (vc-locking-user file))) | ||
| 1166 | (if rev | 1179 | (if rev |
| 1167 | (setq file-description (format "%s:%s" file rev)) | 1180 | (setq file-description (format "%s:%s" file rev)) |
| 1168 | (setq file-description file)) | 1181 | (setq file-description file)) |
| 1169 | (if (not (yes-or-no-p (format "Steal the lock on %s from %s? " | 1182 | (if (not (yes-or-no-p (format "Steal the lock on %s from %s? " |
| 1170 | file-description owner))) | 1183 | file-description owner))) |
| 1171 | (error "Steal cancelled")) | 1184 | (error "Steal canceled")) |
| 1172 | (pop-to-buffer (get-buffer-create "*VC-mail*")) | 1185 | (compose-mail owner (format "Stolen lock on %s" file-description) |
| 1186 | nil nil nil nil | ||
| 1187 | (list (list 'vc-finish-steal file rev))) | ||
| 1173 | (setq default-directory (expand-file-name "~/")) | 1188 | (setq default-directory (expand-file-name "~/")) |
| 1174 | (auto-save-mode auto-save-default) | ||
| 1175 | (mail-mode) | ||
| 1176 | (erase-buffer) | ||
| 1177 | (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil | ||
| 1178 | (list (list 'vc-finish-steal file rev))) | ||
| 1179 | (goto-char (point-max)) | 1189 | (goto-char (point-max)) |
| 1180 | (insert | 1190 | (insert |
| 1181 | (format "I stole the lock on %s, " file-description) | 1191 | (format "I stole the lock on %s, " file-description) |
| @@ -1183,27 +1193,40 @@ level to check it in under. COMMENT, if specified, is the checkin comment." | |||
| 1183 | ".\n") | 1193 | ".\n") |
| 1184 | (message "Please explain why you stole the lock. Type C-c C-c when done."))) | 1194 | (message "Please explain why you stole the lock. Type C-c C-c when done."))) |
| 1185 | 1195 | ||
| 1186 | ;; This is called when the notification has been sent. | ||
| 1187 | (defun vc-finish-steal (file version) | 1196 | (defun vc-finish-steal (file version) |
| 1188 | (vc-backend-steal file version) | 1197 | ;; This is called when the notification has been sent. |
| 1189 | (if (get-file-buffer file) | 1198 | (message "Stealing lock on %s..." file) |
| 1190 | (save-excursion | 1199 | (vc-call steal-lock file version) |
| 1191 | (set-buffer (get-file-buffer file)) | 1200 | (vc-file-setprop file 'vc-state 'edited) |
| 1192 | (vc-resynch-window file t t)))) | 1201 | (vc-resynch-buffer file t t) |
| 1202 | (message "Stealing lock on %s...done" file)) | ||
| 1193 | 1203 | ||
| 1194 | (defun vc-checkin (file &optional rev comment) | 1204 | (defun vc-checkin (file &optional rev comment) |
| 1195 | "Check in the file specified by FILE. | 1205 | "Check in FILE. |
| 1196 | The optional argument REV may be a string specifying the new version level | 1206 | The optional argument REV may be a string specifying the new version |
| 1197 | \(if nil increment the current level). The file is either retained with write | 1207 | level (if nil increment the current level). COMMENT is a comment |
| 1198 | permissions zeroed, or deleted (according to the value of `vc-keep-workfiles'). | 1208 | string; if omitted, a buffer is popped up to accept a comment. |
| 1199 | If the back-end is CVS, a writable workfile is always kept. | 1209 | |
| 1200 | COMMENT is a comment string; if omitted, a buffer is popped up to accept a | 1210 | If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided |
| 1201 | comment. | 1211 | that the version control system supports this mode of operation. |
| 1202 | 1212 | ||
| 1203 | Runs the normal hook `vc-checkin-hook'." | 1213 | Runs the normal hook `vc-checkin-hook'." |
| 1204 | (vc-start-entry file rev comment | 1214 | (vc-start-entry |
| 1205 | "Enter a change comment." 'vc-backend-checkin | 1215 | file rev comment |
| 1206 | 'vc-checkin-hook)) | 1216 | "Enter a change comment." |
| 1217 | (lambda (file rev comment) | ||
| 1218 | (message "Checking in %s..." file) | ||
| 1219 | ;; "This log message intentionally left almost blank". | ||
| 1220 | ;; RCS 5.7 gripes about white-space-only comments too. | ||
| 1221 | (or (and comment (string-match "[^\t\n ]" comment)) | ||
| 1222 | (setq comment "*** empty log message ***")) | ||
| 1223 | ;; Change buffers to get local value of vc-checkin-switches. | ||
| 1224 | (with-current-buffer (or (get-file-buffer file) (current-buffer)) | ||
| 1225 | (vc-call checkin file rev comment)) | ||
| 1226 | (vc-file-setprop file 'vc-state 'up-to-date) | ||
| 1227 | (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) | ||
| 1228 | (message "Checking in %s...done" file)) | ||
| 1229 | 'vc-checkin-hook)) | ||
| 1207 | 1230 | ||
| 1208 | (defun vc-comment-to-change-log (&optional whoami file-name) | 1231 | (defun vc-comment-to-change-log (&optional whoami file-name) |
| 1209 | "Enter last VC comment into change log file for current buffer's file. | 1232 | "Enter last VC comment into change log file for current buffer's file. |
| @@ -1256,19 +1279,22 @@ May be useful as a `vc-checkin-hook' to update change logs automatically." | |||
| 1256 | "Complete the operation implied by the current log entry." | 1279 | "Complete the operation implied by the current log entry." |
| 1257 | (interactive) | 1280 | (interactive) |
| 1258 | ;; Check and record the comment, if any. | 1281 | ;; Check and record the comment, if any. |
| 1259 | (if (not nocomment) | 1282 | (unless nocomment |
| 1260 | (progn | 1283 | ;; Comment too long? |
| 1261 | ;; Comment too long? | 1284 | (vc-call-backend (or (and vc-log-file (vc-backend vc-log-file)) |
| 1262 | (vc-backend-logentry-check vc-log-file) | 1285 | (vc-responsible-backend default-directory)) |
| 1263 | ;; Record the comment in the comment ring | 1286 | 'logentry-check) |
| 1264 | (ring-insert vc-comment-ring (buffer-string)) | 1287 | (run-hooks 'vc-logentry-check-hook) |
| 1265 | )) | 1288 | ;; Record the comment in the comment ring |
| 1289 | (let ((comment (buffer-string))) | ||
| 1290 | (unless (and (ring-p vc-comment-ring) | ||
| 1291 | (not (ring-empty-p vc-comment-ring)) | ||
| 1292 | (equal comment (ring-ref vc-comment-ring 0))) | ||
| 1293 | (ring-insert vc-comment-ring comment)))) | ||
| 1266 | ;; Sync parent buffer in case the user modified it while editing the comment. | 1294 | ;; Sync parent buffer in case the user modified it while editing the comment. |
| 1267 | ;; But not if it is a vc-dired buffer. | 1295 | ;; But not if it is a vc-dired buffer. |
| 1268 | (save-excursion | 1296 | (with-current-buffer vc-parent-buffer |
| 1269 | (set-buffer vc-parent-buffer) | 1297 | (or vc-dired-mode (vc-buffer-sync))) |
| 1270 | (or vc-dired-mode | ||
| 1271 | (vc-buffer-sync))) | ||
| 1272 | (if (not vc-log-operation) (error "No log operation is pending")) | 1298 | (if (not vc-log-operation) (error "No log operation is pending")) |
| 1273 | ;; save the parameters held in buffer-local variables | 1299 | ;; save the parameters held in buffer-local variables |
| 1274 | (let ((log-operation vc-log-operation) | 1300 | (let ((log-operation vc-log-operation) |
| @@ -1280,7 +1306,7 @@ May be useful as a `vc-checkin-hook' to update change logs automatically." | |||
| 1280 | (pop-to-buffer vc-parent-buffer) | 1306 | (pop-to-buffer vc-parent-buffer) |
| 1281 | ;; OK, do it to it | 1307 | ;; OK, do it to it |
| 1282 | (save-excursion | 1308 | (save-excursion |
| 1283 | (funcall log-operation | 1309 | (funcall log-operation |
| 1284 | log-file | 1310 | log-file |
| 1285 | log-version | 1311 | log-version |
| 1286 | log-entry)) | 1312 | log-entry)) |
| @@ -1296,79 +1322,69 @@ May be useful as a `vc-checkin-hook' to update change logs automatically." | |||
| 1296 | (pop-to-buffer tmp-vc-parent-buffer)))) | 1322 | (pop-to-buffer tmp-vc-parent-buffer)))) |
| 1297 | ;; Now make sure we see the expanded headers | 1323 | ;; Now make sure we see the expanded headers |
| 1298 | (if buffer-file-name | 1324 | (if buffer-file-name |
| 1299 | (vc-resynch-window buffer-file-name vc-keep-workfiles t)) | 1325 | (vc-resynch-buffer buffer-file-name vc-keep-workfiles t)) |
| 1300 | (if vc-dired-mode | 1326 | (if vc-dired-mode |
| 1301 | (dired-move-to-filename)) | 1327 | (dired-move-to-filename)) |
| 1302 | (run-hooks after-hook 'vc-finish-logentry-hook))) | 1328 | (run-hooks after-hook 'vc-finish-logentry-hook))) |
| 1303 | 1329 | ||
| 1304 | ;; Code for access to the comment ring | 1330 | ;; Code for access to the comment ring |
| 1305 | 1331 | ||
| 1332 | (defun vc-new-comment-index (stride len) | ||
| 1333 | (mod (cond | ||
| 1334 | (vc-comment-ring-index (+ vc-comment-ring-index stride)) | ||
| 1335 | ;; Initialize the index on the first use of this command | ||
| 1336 | ;; so that the first M-p gets index 0, and the first M-n gets | ||
| 1337 | ;; index -1. | ||
| 1338 | ((> stride 0) (1- stride)) | ||
| 1339 | (t stride)) | ||
| 1340 | len)) | ||
| 1341 | |||
| 1306 | (defun vc-previous-comment (arg) | 1342 | (defun vc-previous-comment (arg) |
| 1307 | "Cycle backwards through comment history." | 1343 | "Cycle backwards through comment history." |
| 1308 | (interactive "*p") | 1344 | (interactive "*p") |
| 1309 | (let ((len (ring-length vc-comment-ring))) | 1345 | (let ((len (ring-length vc-comment-ring))) |
| 1310 | (cond ((<= len 0) | 1346 | (if (<= len 0) |
| 1311 | (message "Empty comment ring") | 1347 | (progn (message "Empty comment ring") (ding)) |
| 1312 | (ding)) | 1348 | (erase-buffer) |
| 1313 | (t | 1349 | (setq vc-comment-ring-index (vc-new-comment-index arg len)) |
| 1314 | (erase-buffer) | 1350 | (message "Comment %d" (1+ vc-comment-ring-index)) |
| 1315 | ;; Initialize the index on the first use of this command | 1351 | (insert (ring-ref vc-comment-ring vc-comment-ring-index))))) |
| 1316 | ;; so that the first M-p gets index 0, and the first M-n gets | ||
| 1317 | ;; index -1. | ||
| 1318 | (if (null vc-comment-ring-index) | ||
| 1319 | (setq vc-comment-ring-index | ||
| 1320 | (if (> arg 0) -1 | ||
| 1321 | (if (< arg 0) 1 0)))) | ||
| 1322 | (setq vc-comment-ring-index | ||
| 1323 | (mod (+ vc-comment-ring-index arg) len)) | ||
| 1324 | (message "%d" (1+ vc-comment-ring-index)) | ||
| 1325 | (insert (ring-ref vc-comment-ring vc-comment-ring-index)))))) | ||
| 1326 | 1352 | ||
| 1327 | (defun vc-next-comment (arg) | 1353 | (defun vc-next-comment (arg) |
| 1328 | "Cycle forwards through comment history." | 1354 | "Cycle forwards through comment history." |
| 1329 | (interactive "*p") | 1355 | (interactive "*p") |
| 1330 | (vc-previous-comment (- arg))) | 1356 | (vc-previous-comment (- arg))) |
| 1331 | 1357 | ||
| 1332 | (defun vc-comment-search-reverse (str) | 1358 | (defun vc-comment-search-reverse (str &optional stride) |
| 1333 | "Searches backwards through comment history for substring match." | 1359 | "Searches backwards through comment history for substring match." |
| 1334 | (interactive "sComment substring: ") | 1360 | ;; Why substring rather than regexp ? -sm |
| 1361 | (interactive | ||
| 1362 | (list (read-string "Comment substring: " nil nil vc-last-comment-match))) | ||
| 1363 | (unless stride (setq stride 1)) | ||
| 1335 | (if (string= str "") | 1364 | (if (string= str "") |
| 1336 | (setq str vc-last-comment-match) | 1365 | (setq str vc-last-comment-match) |
| 1337 | (setq vc-last-comment-match str)) | 1366 | (setq vc-last-comment-match str)) |
| 1338 | (if (null vc-comment-ring-index) | 1367 | (let* ((str (regexp-quote str)) |
| 1339 | (setq vc-comment-ring-index -1)) | 1368 | (len (ring-length vc-comment-ring)) |
| 1340 | (let ((str (regexp-quote str)) | 1369 | (n (vc-new-comment-index stride len))) |
| 1341 | (len (ring-length vc-comment-ring)) | 1370 | (while (progn (when (or (>= n len) (< n 0)) (error "Not found")) |
| 1342 | (n (1+ vc-comment-ring-index))) | 1371 | (not (string-match str (ring-ref vc-comment-ring n)))) |
| 1343 | (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n)))) | 1372 | (setq n (+ n stride))) |
| 1344 | (setq n (+ n 1))) | 1373 | (setq vc-comment-ring-index n) |
| 1345 | (cond ((< n len) | 1374 | (vc-previous-comment 0))) |
| 1346 | (vc-previous-comment (- n vc-comment-ring-index))) | ||
| 1347 | (t (error "Not found"))))) | ||
| 1348 | 1375 | ||
| 1349 | (defun vc-comment-search-forward (str) | 1376 | (defun vc-comment-search-forward (str) |
| 1350 | "Searches forwards through comment history for substring match." | 1377 | "Searches forwards through comment history for substring match." |
| 1351 | (interactive "sComment substring: ") | 1378 | (interactive |
| 1352 | (if (string= str "") | 1379 | (list (read-string "Comment substring: " nil nil vc-last-comment-match))) |
| 1353 | (setq str vc-last-comment-match) | 1380 | (vc-comment-search-reverse str -1)) |
| 1354 | (setq vc-last-comment-match str)) | ||
| 1355 | (if (null vc-comment-ring-index) | ||
| 1356 | (setq vc-comment-ring-index 0)) | ||
| 1357 | (let ((str (regexp-quote str)) | ||
| 1358 | (len (ring-length vc-comment-ring)) | ||
| 1359 | (n vc-comment-ring-index)) | ||
| 1360 | (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n)))) | ||
| 1361 | (setq n (- n 1))) | ||
| 1362 | (cond ((>= n 0) | ||
| 1363 | (vc-next-comment (- n vc-comment-ring-index))) | ||
| 1364 | (t (error "Not found"))))) | ||
| 1365 | 1381 | ||
| 1366 | ;; Additional entry points for examining version histories | 1382 | ;; Additional entry points for examining version histories |
| 1367 | 1383 | ||
| 1368 | ;;;###autoload | 1384 | ;;;###autoload |
| 1369 | (defun vc-diff (historic &optional not-urgent) | 1385 | (defun vc-diff (historic &optional not-urgent) |
| 1370 | "Display diffs between file versions. | 1386 | "Display diffs between file versions. |
| 1371 | Normally this compares the current file and buffer with the most recent | 1387 | Normally this compares the current file and buffer with the most recent |
| 1372 | checked in version of that file. This uses no arguments. | 1388 | checked in version of that file. This uses no arguments. |
| 1373 | With a prefix argument, it reads the file name to use | 1389 | With a prefix argument, it reads the file name to use |
| 1374 | and two version designators specifying which versions to compare." | 1390 | and two version designators specifying which versions to compare." |
| @@ -1376,36 +1392,17 @@ and two version designators specifying which versions to compare." | |||
| 1376 | (vc-ensure-vc-buffer) | 1392 | (vc-ensure-vc-buffer) |
| 1377 | (if historic | 1393 | (if historic |
| 1378 | (call-interactively 'vc-version-diff) | 1394 | (call-interactively 'vc-version-diff) |
| 1379 | (let ((file buffer-file-name) | 1395 | (let ((file buffer-file-name)) |
| 1380 | unchanged) | ||
| 1381 | (vc-buffer-sync not-urgent) | 1396 | (vc-buffer-sync not-urgent) |
| 1382 | (setq unchanged (vc-workfile-unchanged-p buffer-file-name)) | 1397 | (if (vc-workfile-unchanged-p buffer-file-name) |
| 1383 | (if unchanged | 1398 | (message "No changes to %s since latest version" file) |
| 1384 | (message "No changes to %s since latest version" file) | 1399 | (vc-version-diff file nil nil))))) |
| 1385 | (vc-backend-diff file) | ||
| 1386 | ;; Ideally, we'd like at this point to parse the diff so that | ||
| 1387 | ;; the buffer effectively goes into compilation mode and we | ||
| 1388 | ;; can visit the old and new change locations via next-error. | ||
| 1389 | ;; Unfortunately, this is just too painful to do. The basic | ||
| 1390 | ;; problem is that the `old' file doesn't exist to be | ||
| 1391 | ;; visited. This plays hell with numerous assumptions in | ||
| 1392 | ;; the diff.el and compile.el machinery. | ||
| 1393 | (set-buffer "*vc-diff*") | ||
| 1394 | (setq default-directory (file-name-directory file)) | ||
| 1395 | (if (= 0 (buffer-size)) | ||
| 1396 | (progn | ||
| 1397 | (setq unchanged t) | ||
| 1398 | (message "No changes to %s since latest version" file)) | ||
| 1399 | (pop-to-buffer "*vc-diff*") | ||
| 1400 | (goto-char (point-min)) | ||
| 1401 | (shrink-window-if-larger-than-buffer))) | ||
| 1402 | (not unchanged)))) | ||
| 1403 | 1400 | ||
| 1404 | (defun vc-version-diff (file rel1 rel2) | 1401 | (defun vc-version-diff (file rel1 rel2) |
| 1405 | "For FILE, report diffs between two stored versions REL1 and REL2 of it. | 1402 | "For FILE, report diffs between two stored versions REL1 and REL2 of it. |
| 1406 | If FILE is a directory, generate diffs between versions for all registered | 1403 | If FILE is a directory, generate diffs between versions for all registered |
| 1407 | files in or below it." | 1404 | files in or below it." |
| 1408 | (interactive | 1405 | (interactive |
| 1409 | (let ((file (expand-file-name | 1406 | (let ((file (expand-file-name |
| 1410 | (read-file-name (if buffer-file-name | 1407 | (read-file-name (if buffer-file-name |
| 1411 | "File or dir to diff: (default visited file) " | 1408 | "File or dir to diff: (default visited file) " |
| @@ -1414,18 +1411,19 @@ files in or below it." | |||
| 1414 | (rel1-default nil) (rel2-default nil)) | 1411 | (rel1-default nil) (rel2-default nil)) |
| 1415 | ;; compute default versions based on the file state | 1412 | ;; compute default versions based on the file state |
| 1416 | (cond | 1413 | (cond |
| 1417 | ;; if it's a directory, don't supply any version defauolt | 1414 | ;; if it's a directory, don't supply any version default |
| 1418 | ((file-directory-p file) | 1415 | ((file-directory-p file) |
| 1419 | nil) | 1416 | nil) |
| 1420 | ;; if the file is locked, use current version as older version | 1417 | ;; if the file is not up-to-date, use current version as older version |
| 1421 | ((vc-locking-user file) | 1418 | ((not (vc-up-to-date-p file)) |
| 1422 | (setq rel1-default (vc-workfile-version file))) | 1419 | (setq rel1-default (vc-workfile-version file))) |
| 1423 | ;; if the file is not locked, use last and previous version as default | 1420 | ;; if the file is not locked, use last and previous version as default |
| 1424 | (t | 1421 | (t |
| 1425 | (setq rel1-default (vc-previous-version (vc-workfile-version file))) | 1422 | (setq rel1-default (vc-previous-version (vc-workfile-version file))) |
| 1423 | (if (string= rel1-default "") (setq rel1-default nil)) | ||
| 1426 | (setq rel2-default (vc-workfile-version file)))) | 1424 | (setq rel2-default (vc-workfile-version file)))) |
| 1427 | ;; construct argument list | 1425 | ;; construct argument list |
| 1428 | (list file | 1426 | (list file |
| 1429 | (read-string (if rel1-default | 1427 | (read-string (if rel1-default |
| 1430 | (concat "Older version: (default " | 1428 | (concat "Older version: (default " |
| 1431 | rel1-default ") ") | 1429 | rel1-default ") ") |
| @@ -1438,52 +1436,58 @@ files in or below it." | |||
| 1438 | nil nil rel2-default)))) | 1436 | nil nil rel2-default)))) |
| 1439 | (if (string-equal rel1 "") (setq rel1 nil)) | 1437 | (if (string-equal rel1 "") (setq rel1 nil)) |
| 1440 | (if (string-equal rel2 "") (setq rel2 nil)) | 1438 | (if (string-equal rel2 "") (setq rel2 nil)) |
| 1439 | (vc-setup-buffer "*vc-diff*") | ||
| 1441 | (if (file-directory-p file) | 1440 | (if (file-directory-p file) |
| 1442 | (let ((camefrom (current-buffer))) | 1441 | (let ((inhibit-read-only t)) |
| 1443 | (set-buffer (get-buffer-create "*vc-status*")) | ||
| 1444 | (set (make-local-variable 'vc-parent-buffer) camefrom) | ||
| 1445 | (set (make-local-variable 'vc-parent-buffer-name) | ||
| 1446 | (concat " from " (buffer-name camefrom))) | ||
| 1447 | (erase-buffer) | ||
| 1448 | (insert "Diffs between " | 1442 | (insert "Diffs between " |
| 1449 | (or rel1 "last version checked in") | 1443 | (or rel1 "last version checked in") |
| 1450 | " and " | 1444 | " and " |
| 1451 | (or rel2 "current workfile(s)") | 1445 | (or rel2 "current workfile(s)") |
| 1452 | ":\n\n") | 1446 | ":\n\n") |
| 1453 | (set-buffer (get-buffer-create "*vc-diff*")) | 1447 | (setq default-directory (file-name-as-directory file)) |
| 1454 | (cd file) | 1448 | ;; FIXME: this should do a single exec in CVS. |
| 1455 | (vc-file-tree-walk | 1449 | (vc-file-tree-walk |
| 1456 | default-directory | 1450 | default-directory |
| 1457 | (function (lambda (f) | 1451 | (lambda (f) |
| 1458 | (message "Looking at %s" f) | 1452 | (vc-exec-after |
| 1459 | (and | 1453 | `(progn |
| 1460 | (not (file-directory-p f)) | 1454 | (message "Looking at %s" ',f) |
| 1461 | (vc-registered f) | 1455 | (vc-call-backend ',(vc-backend file) 'diff ',f ',rel1 ',rel2))))) |
| 1462 | (vc-backend-diff f rel1 rel2) | 1456 | (vc-exec-after `(let ((inhibit-read-only t)) |
| 1463 | (append-to-buffer "*vc-status*" (point-min) (point-max))) | 1457 | (insert "\nEnd of diffs.\n")))) |
| 1464 | ))) | 1458 | |
| 1465 | (pop-to-buffer "*vc-status*") | 1459 | (cd (file-name-directory file)) |
| 1466 | (insert "\nEnd of diffs.\n") | 1460 | (vc-call diff file rel1 rel2)) |
| 1467 | (goto-char (point-min)) | 1461 | (if (and (zerop (buffer-size)) |
| 1468 | (set-buffer-modified-p nil) | 1462 | (not (get-buffer-process (current-buffer)))) |
| 1469 | ) | 1463 | (progn |
| 1470 | (if (zerop (vc-backend-diff file rel1 rel2)) | 1464 | (if rel1 |
| 1471 | (message "No changes to %s between %s and %s." file rel1 rel2) | 1465 | (if rel2 |
| 1472 | (pop-to-buffer "*vc-diff*")))) | 1466 | (message "No changes to %s between %s and %s" file rel1 rel2) |
| 1467 | (message "No changes to %s since %s" file rel1)) | ||
| 1468 | (message "No changes to %s since latest version" file)) | ||
| 1469 | nil) | ||
| 1470 | (pop-to-buffer (current-buffer)) | ||
| 1471 | ;; Gnus-5.8.5 sets up an autoload for diff-mode, even if it's | ||
| 1472 | ;; not available. Work around that. | ||
| 1473 | (if (require 'diff-mode nil t) (diff-mode)) | ||
| 1474 | (vc-exec-after '(progn (goto-char (point-min)) | ||
| 1475 | (shrink-window-if-larger-than-buffer))) | ||
| 1476 | t)) | ||
| 1473 | 1477 | ||
| 1474 | ;;;###autoload | 1478 | ;;;###autoload |
| 1475 | (defun vc-version-other-window (rev) | 1479 | (defun vc-version-other-window (rev) |
| 1476 | "Visit version REV of the current buffer in another window. | 1480 | "Visit version REV of the current buffer in another window. |
| 1477 | If the current buffer is named `F', the version is named `F.~REV~'. | 1481 | If the current buffer is named `F', the version is named `F.~REV~'. |
| 1478 | If `F.~REV~' already exists, it is used instead of being re-created." | 1482 | If `F.~REV~' already exists, it is used instead of being re-created." |
| 1479 | (interactive "sVersion to visit (default is latest version): ") | 1483 | (interactive "sVersion to visit (default is workfile version): ") |
| 1480 | (vc-ensure-vc-buffer) | 1484 | (vc-ensure-vc-buffer) |
| 1481 | (let* ((version (if (string-equal rev "") | 1485 | (let* ((version (if (string-equal rev "") |
| 1482 | (vc-latest-version buffer-file-name) | 1486 | (vc-workfile-version buffer-file-name) |
| 1483 | rev)) | 1487 | rev)) |
| 1484 | (filename (concat buffer-file-name ".~" version "~"))) | 1488 | (filename (concat buffer-file-name ".~" version "~"))) |
| 1485 | (or (file-exists-p filename) | 1489 | (or (file-exists-p filename) |
| 1486 | (vc-backend-checkout buffer-file-name nil version filename)) | 1490 | (vc-call checkout buffer-file-name nil version filename)) |
| 1487 | (find-file-other-window filename))) | 1491 | (find-file-other-window filename))) |
| 1488 | 1492 | ||
| 1489 | ;; Header-insertion code | 1493 | ;; Header-insertion code |
| @@ -1492,7 +1496,7 @@ If `F.~REV~' already exists, it is used instead of being re-created." | |||
| 1492 | (defun vc-insert-headers () | 1496 | (defun vc-insert-headers () |
| 1493 | "Insert headers in a file for use with your version-control system. | 1497 | "Insert headers in a file for use with your version-control system. |
| 1494 | Headers desired are inserted at point, and are pulled from | 1498 | Headers desired are inserted at point, and are pulled from |
| 1495 | the variable `vc-header-alist'." | 1499 | the variable `vc-BACKEND-header'." |
| 1496 | (interactive) | 1500 | (interactive) |
| 1497 | (vc-ensure-vc-buffer) | 1501 | (vc-ensure-vc-buffer) |
| 1498 | (save-excursion | 1502 | (save-excursion |
| @@ -1504,83 +1508,99 @@ the variable `vc-header-alist'." | |||
| 1504 | (let* ((delims (cdr (assq major-mode vc-comment-alist))) | 1508 | (let* ((delims (cdr (assq major-mode vc-comment-alist))) |
| 1505 | (comment-start-vc (or (car delims) comment-start "#")) | 1509 | (comment-start-vc (or (car delims) comment-start "#")) |
| 1506 | (comment-end-vc (or (car (cdr delims)) comment-end "")) | 1510 | (comment-end-vc (or (car (cdr delims)) comment-end "")) |
| 1507 | (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist)))) | 1511 | (hdsym (vc-make-backend-sym (vc-backend (buffer-file-name)) |
| 1508 | (mapcar (function (lambda (s) | 1512 | 'header)) |
| 1509 | (insert comment-start-vc "\t" s "\t" | 1513 | (hdstrings (and (boundp hdsym) (symbol-value hdsym)))) |
| 1510 | comment-end-vc "\n"))) | 1514 | (mapcar (lambda (s) |
| 1515 | (insert comment-start-vc "\t" s "\t" | ||
| 1516 | comment-end-vc "\n")) | ||
| 1511 | hdstrings) | 1517 | hdstrings) |
| 1512 | (if vc-static-header-alist | 1518 | (if vc-static-header-alist |
| 1513 | (mapcar (function (lambda (f) | 1519 | (mapcar (lambda (f) |
| 1514 | (if (string-match (car f) buffer-file-name) | 1520 | (if (string-match (car f) buffer-file-name) |
| 1515 | (insert (format (cdr f) (car hdstrings)))))) | 1521 | (insert (format (cdr f) (car hdstrings))))) |
| 1516 | vc-static-header-alist)) | 1522 | vc-static-header-alist)) |
| 1517 | ) | 1523 | ) |
| 1518 | ))))) | 1524 | ))))) |
| 1519 | 1525 | ||
| 1520 | (defun vc-clear-headers () | 1526 | (defun vc-clear-headers (&optional file) |
| 1521 | ;; Clear all version headers in the current buffer, i.e. reset them | 1527 | "Clear all version headers in the current buffer (or FILE), i.e. reset them |
| 1522 | ;; to the nonexpanded form. Only implemented for RCS, yet. | 1528 | to the non-expanded form." |
| 1523 | ;; Don't lose point and mark during this. | 1529 | (let* ((filename (or file buffer-file-name)) |
| 1524 | (let ((context (vc-buffer-context)) | 1530 | (visited (find-buffer-visiting filename)) |
| 1525 | (case-fold-search nil)) | 1531 | (backend (vc-backend filename))) |
| 1526 | ;; save-excursion may be able to relocate point and mark properly. | 1532 | (when (vc-find-backend-function backend 'clear-headers) |
| 1527 | ;; If it fails, vc-restore-buffer-context will give it a second try. | 1533 | (if visited |
| 1528 | (save-excursion | 1534 | (let ((context (vc-buffer-context))) |
| 1529 | (goto-char (point-min)) | 1535 | ;; save-excursion may be able to relocate point and mark |
| 1530 | (while (re-search-forward | 1536 | ;; properly. If it fails, vc-restore-buffer-context |
| 1531 | (concat "\\$\\(Author\\|Date\\|Header\\|Id\\|Locker\\|Name\\|" | 1537 | ;; will give it a second try. |
| 1532 | "RCSfile\\|Revision\\|Source\\|State\\): [^$\n]+\\$") | 1538 | (save-excursion |
| 1533 | nil t) | 1539 | (vc-call-backend backend 'clear-headers)) |
| 1534 | (replace-match "$\\1$"))) | 1540 | (vc-restore-buffer-context context)) |
| 1535 | (vc-restore-buffer-context context))) | 1541 | (find-file filename) |
| 1542 | (vc-call-backend backend 'clear-headers) | ||
| 1543 | (kill-buffer filename))))) | ||
| 1536 | 1544 | ||
| 1537 | ;;;###autoload | 1545 | ;;;###autoload |
| 1538 | (defun vc-merge () | 1546 | (defun vc-merge (&optional merge-news) |
| 1539 | (interactive) | 1547 | "Merge changes between two revisions into the work file. |
| 1548 | With prefix arg, merge news, i.e. recent changes from the current branch. | ||
| 1549 | |||
| 1550 | See Info node `Merging'." | ||
| 1551 | (interactive "P") | ||
| 1540 | (vc-ensure-vc-buffer) | 1552 | (vc-ensure-vc-buffer) |
| 1541 | (vc-buffer-sync) | 1553 | (vc-buffer-sync) |
| 1542 | (let* ((file buffer-file-name) | 1554 | (let* ((file buffer-file-name) |
| 1543 | (backend (vc-backend file)) | 1555 | (backend (vc-backend file)) |
| 1544 | first-version second-version locking-user) | 1556 | (state (vc-state file)) |
| 1545 | (if (eq backend 'SCCS) | 1557 | first-version second-version) |
| 1546 | (error "Sorry, merging is not implemented for SCCS") | 1558 | (cond |
| 1547 | (setq locking-user (vc-locking-user file)) | 1559 | ((not (vc-find-backend-function backend |
| 1548 | (if (eq (vc-checkout-model file) 'manual) | 1560 | (if merge-news 'merge-news 'merge))) |
| 1549 | (if (not locking-user) | 1561 | (error "Sorry, merging is not implemented for %s" backend)) |
| 1550 | (if (not (y-or-n-p | 1562 | ((stringp state) |
| 1551 | (format "File must be %s for merging. %s now? " | 1563 | (error "File is locked by %s" state)) |
| 1552 | (if (eq backend 'RCS) "locked" "writable") | 1564 | ((not (vc-editable-p file)) |
| 1553 | (if (eq backend 'RCS) "Lock" "Check out")))) | 1565 | (if (y-or-n-p |
| 1554 | (error "Merge aborted") | 1566 | "File must be checked out for merging. Check out now? ") |
| 1555 | (vc-checkout file t)) | 1567 | (vc-checkout file t) |
| 1556 | (if (not (string= locking-user (vc-user-login-name))) | 1568 | (error "Merge aborted")))) |
| 1557 | (error "File is locked by %s" locking-user)))) | 1569 | (unless merge-news |
| 1558 | (setq first-version (read-string "Branch or version to merge from: ")) | 1570 | (setq first-version (read-string "Branch or version to merge from: ")) |
| 1559 | (if (and (>= (elt first-version 0) ?0) | 1571 | (if (and (>= (elt first-version 0) ?0) |
| 1560 | (<= (elt first-version 0) ?9)) | 1572 | (<= (elt first-version 0) ?9)) |
| 1561 | (if (not (vc-branch-p first-version)) | 1573 | (if (not (vc-branch-p first-version)) |
| 1562 | (setq second-version | 1574 | (setq second-version |
| 1563 | (read-string "Second version: " | 1575 | (read-string "Second version: " |
| 1564 | (concat (vc-branch-part first-version) "."))) | 1576 | (concat (vc-branch-part first-version) "."))) |
| 1565 | ;; We want to merge an entire branch. Set versions | 1577 | ;; We want to merge an entire branch. Set versions |
| 1566 | ;; accordingly, so that vc-backend-merge understands us. | 1578 | ;; accordingly, so that vc-backend-merge understands us. |
| 1567 | (setq second-version first-version) | 1579 | (setq second-version first-version) |
| 1568 | ;; first-version must be the starting point of the branch | 1580 | ;; first-version must be the starting point of the branch |
| 1569 | (setq first-version (vc-branch-part first-version)))) | 1581 | (setq first-version (vc-branch-part first-version))))) |
| 1570 | (let ((status (vc-backend-merge file first-version second-version))) | 1582 | (let ((status (if merge-news |
| 1571 | (if (and (eq (vc-checkout-model file) 'implicit) | 1583 | (vc-call merge-news file) |
| 1572 | (not (vc-locking-user file))) | 1584 | (vc-call merge file first-version second-version)))) |
| 1573 | (vc-file-setprop file 'vc-locking-user nil)) | 1585 | (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))) |
| 1574 | (vc-resynch-buffer file t t) | 1586 | |
| 1575 | (if (not (zerop status)) | 1587 | (defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) |
| 1576 | (if (y-or-n-p "Conflicts detected. Resolve them now? ") | 1588 | (vc-resynch-buffer file t (not (buffer-modified-p))) |
| 1577 | (vc-resolve-conflicts "WORKFILE" "MERGE SOURCE") | 1589 | (if (zerop status) (message "Merge successful") |
| 1578 | (message "File contains conflict markers")) | 1590 | (if (fboundp 'smerge-mode) (smerge-mode 1)) |
| 1579 | (message "Merge successful")))))) | 1591 | (if (y-or-n-p "Conflicts detected. Resolve them now? ") |
| 1592 | (if (fboundp 'smerge-ediff) | ||
| 1593 | (smerge-ediff) | ||
| 1594 | (vc-resolve-conflicts name-A name-B)) | ||
| 1595 | (message "File contains conflict markers")))) | ||
| 1580 | 1596 | ||
| 1581 | (defvar vc-ediff-windows) | 1597 | (defvar vc-ediff-windows) |
| 1582 | (defvar vc-ediff-result) | 1598 | (defvar vc-ediff-result) |
| 1583 | 1599 | (eval-when-compile | |
| 1600 | (defvar ediff-buffer-A) | ||
| 1601 | (defvar ediff-buffer-B) | ||
| 1602 | (defvar ediff-buffer-C) | ||
| 1603 | (require 'ediff-util)) | ||
| 1584 | ;;;###autoload | 1604 | ;;;###autoload |
| 1585 | (defun vc-resolve-conflicts (&optional name-A name-B) | 1605 | (defun vc-resolve-conflicts (&optional name-A name-B) |
| 1586 | "Invoke ediff to resolve conflicts in the current buffer. | 1606 | "Invoke ediff to resolve conflicts in the current buffer. |
| @@ -1589,19 +1609,19 @@ The conflicts must be marked with rcsmerge conflict markers." | |||
| 1589 | (vc-ensure-vc-buffer) | 1609 | (vc-ensure-vc-buffer) |
| 1590 | (let* ((found nil) | 1610 | (let* ((found nil) |
| 1591 | (file-name (file-name-nondirectory buffer-file-name)) | 1611 | (file-name (file-name-nondirectory buffer-file-name)) |
| 1592 | (your-buffer (generate-new-buffer | 1612 | (your-buffer (generate-new-buffer |
| 1593 | (concat "*" file-name | 1613 | (concat "*" file-name |
| 1594 | " " (or name-A "WORKFILE") "*"))) | 1614 | " " (or name-A "WORKFILE") "*"))) |
| 1595 | (other-buffer (generate-new-buffer | 1615 | (other-buffer (generate-new-buffer |
| 1596 | (concat "*" file-name | 1616 | (concat "*" file-name |
| 1597 | " " (or name-B "CHECKED-IN") "*"))) | 1617 | " " (or name-B "CHECKED-IN") "*"))) |
| 1598 | (result-buffer (current-buffer))) | 1618 | (result-buffer (current-buffer))) |
| 1599 | (save-excursion | 1619 | (save-excursion |
| 1600 | (set-buffer your-buffer) | 1620 | (set-buffer your-buffer) |
| 1601 | (erase-buffer) | 1621 | (erase-buffer) |
| 1602 | (insert-buffer result-buffer) | 1622 | (insert-buffer result-buffer) |
| 1603 | (goto-char (point-min)) | 1623 | (goto-char (point-min)) |
| 1604 | (while (re-search-forward (concat "^<<<<<<< " | 1624 | (while (re-search-forward (concat "^<<<<<<< " |
| 1605 | (regexp-quote file-name) "\n") nil t) | 1625 | (regexp-quote file-name) "\n") nil t) |
| 1606 | (setq found t) | 1626 | (setq found t) |
| 1607 | (replace-match "") | 1627 | (replace-match "") |
| @@ -1621,7 +1641,7 @@ The conflicts must be marked with rcsmerge conflict markers." | |||
| 1621 | (erase-buffer) | 1641 | (erase-buffer) |
| 1622 | (insert-buffer result-buffer) | 1642 | (insert-buffer result-buffer) |
| 1623 | (goto-char (point-min)) | 1643 | (goto-char (point-min)) |
| 1624 | (while (re-search-forward (concat "^<<<<<<< " | 1644 | (while (re-search-forward (concat "^<<<<<<< " |
| 1625 | (regexp-quote file-name) "\n") nil t) | 1645 | (regexp-quote file-name) "\n") nil t) |
| 1626 | (let ((start (match-beginning 0))) | 1646 | (let ((start (match-beginning 0))) |
| 1627 | (if (not (re-search-forward "^=======\n" nil t)) | 1647 | (if (not (re-search-forward "^=======\n" nil t)) |
| @@ -1643,25 +1663,24 @@ The conflicts must be marked with rcsmerge conflict markers." | |||
| 1643 | (make-local-variable 'vc-ediff-windows) | 1663 | (make-local-variable 'vc-ediff-windows) |
| 1644 | (setq vc-ediff-windows config) | 1664 | (setq vc-ediff-windows config) |
| 1645 | (make-local-variable 'vc-ediff-result) | 1665 | (make-local-variable 'vc-ediff-result) |
| 1646 | (setq vc-ediff-result result-buffer) | 1666 | (setq vc-ediff-result result-buffer) |
| 1647 | (make-local-variable 'ediff-quit-hook) | 1667 | (make-local-variable 'ediff-quit-hook) |
| 1648 | (setq ediff-quit-hook | 1668 | (setq ediff-quit-hook |
| 1649 | (function | 1669 | (lambda () |
| 1650 | (lambda () | 1670 | (let ((buffer-A ediff-buffer-A) |
| 1651 | (let ((buffer-A ediff-buffer-A) | 1671 | (buffer-B ediff-buffer-B) |
| 1652 | (buffer-B ediff-buffer-B) | 1672 | (buffer-C ediff-buffer-C) |
| 1653 | (buffer-C ediff-buffer-C) | 1673 | (result vc-ediff-result) |
| 1654 | (result vc-ediff-result) | 1674 | (windows vc-ediff-windows)) |
| 1655 | (windows vc-ediff-windows)) | 1675 | (ediff-cleanup-mess) |
| 1656 | (ediff-cleanup-mess) | 1676 | (set-buffer result) |
| 1657 | (set-buffer result) | 1677 | (erase-buffer) |
| 1658 | (erase-buffer) | 1678 | (insert-buffer buffer-C) |
| 1659 | (insert-buffer buffer-C) | 1679 | (kill-buffer buffer-A) |
| 1660 | (kill-buffer buffer-A) | 1680 | (kill-buffer buffer-B) |
| 1661 | (kill-buffer buffer-B) | 1681 | (kill-buffer buffer-C) |
| 1662 | (kill-buffer buffer-C) | 1682 | (set-window-configuration windows) |
| 1663 | (set-window-configuration windows) | 1683 | (message "Conflict resolution finished; you may save the buffer")))) |
| 1664 | (message "Conflict resolution finished; you may save the buffer"))))) | ||
| 1665 | (message "Please resolve conflicts now; exit ediff when done") | 1684 | (message "Please resolve conflicts now; exit ediff when done") |
| 1666 | nil)))) | 1685 | nil)))) |
| 1667 | 1686 | ||
| @@ -1671,14 +1690,27 @@ The conflicts must be marked with rcsmerge conflict markers." | |||
| 1671 | (defvar vc-dired-switches) | 1690 | (defvar vc-dired-switches) |
| 1672 | (defvar vc-dired-terse-mode) | 1691 | (defvar vc-dired-terse-mode) |
| 1673 | 1692 | ||
| 1693 | (defvar vc-dired-mode-map | ||
| 1694 | (let ((map (make-sparse-keymap)) | ||
| 1695 | (vmap (make-sparse-keymap))) | ||
| 1696 | (set-keymap-parent map dired-mode-map) | ||
| 1697 | (define-key map "\C-xv" vc-prefix-map) | ||
| 1698 | (define-key map "v" vmap) | ||
| 1699 | (set-keymap-parent vmap vc-prefix-map) | ||
| 1700 | (define-key vmap "t" 'vc-dired-toggle-terse-mode) | ||
| 1701 | map)) | ||
| 1702 | |||
| 1674 | (define-derived-mode vc-dired-mode dired-mode "Dired under VC" | 1703 | (define-derived-mode vc-dired-mode dired-mode "Dired under VC" |
| 1675 | "The major mode used in VC directory buffers. It works like Dired, | 1704 | "The major mode used in VC directory buffers. |
| 1676 | but lists only files under version control, with the current VC state of | 1705 | |
| 1677 | each file being indicated in the place of the file's link count, owner, | 1706 | It works like Dired, but lists only files under version control, with |
| 1678 | group and size. Subdirectories are also listed, and you may insert them | 1707 | the current VC state of each file being indicated in the place of the |
| 1679 | into the buffer as desired, like in Dired. | 1708 | file's link count, owner, group and size. Subdirectories are also |
| 1680 | All Dired commands operate normally, with the exception of `v', which | 1709 | listed, and you may insert them into the buffer as desired, like in |
| 1681 | is redefined as the version control prefix, so that you can type | 1710 | Dired. |
| 1711 | |||
| 1712 | All Dired commands operate normally, with the exception of `v', which | ||
| 1713 | is redefined as the version control prefix, so that you can type | ||
| 1682 | `vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on | 1714 | `vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on |
| 1683 | the file named in the current Dired buffer line. `vv' invokes | 1715 | the file named in the current Dired buffer line. `vv' invokes |
| 1684 | `vc-next-action' on this file, or on all files currently marked. | 1716 | `vc-next-action' on this file, or on all files currently marked. |
| @@ -1688,12 +1720,12 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1688 | ;; The following is slightly modified from dired.el, | 1720 | ;; The following is slightly modified from dired.el, |
| 1689 | ;; because file lines look a bit different in vc-dired-mode. | 1721 | ;; because file lines look a bit different in vc-dired-mode. |
| 1690 | (set (make-local-variable 'dired-move-to-filename-regexp) | 1722 | (set (make-local-variable 'dired-move-to-filename-regexp) |
| 1691 | (let* | 1723 | (let* |
| 1692 | ((l "\\([A-Za-z]\\|[^\0-\177]\\)") | 1724 | ((l "\\([A-Za-z]\\|[^\0-\177]\\)") |
| 1693 | ;; In some locales, month abbreviations are as short as 2 letters, | 1725 | ;; In some locales, month abbreviations are as short as 2 letters, |
| 1694 | ;; and they can be padded on the right with spaces. | 1726 | ;; and they can be padded on the right with spaces. |
| 1695 | (month (concat l l "+ *")) | 1727 | (month (concat l l "+ *")) |
| 1696 | ;; Recognize any non-ASCII character. | 1728 | ;; Recognize any non-ASCII character. |
| 1697 | ;; The purpose is to match a Kanji character. | 1729 | ;; The purpose is to match a Kanji character. |
| 1698 | (k "[^\0-\177]") | 1730 | (k "[^\0-\177]") |
| 1699 | ;; (k "[^\x00-\x7f\x80-\xff]") | 1731 | ;; (k "[^\x00-\x7f\x80-\xff]") |
| @@ -1705,7 +1737,8 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1705 | (western (concat "\\(" month s dd "\\|" dd s month "\\)" | 1737 | (western (concat "\\(" month s dd "\\|" dd s month "\\)" |
| 1706 | s "\\(" HH:MM "\\|" s yyyy"\\|" yyyy s "\\)")) | 1738 | s "\\(" HH:MM "\\|" s yyyy"\\|" yyyy s "\\)")) |
| 1707 | (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)"))) | 1739 | (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)"))) |
| 1708 | (concat s "\\(" western "\\|" japanese "\\)" s))) | 1740 | ;; the .* below ensures that we find the last match on a line |
| 1741 | (concat ".*" s "\\(" western "\\|" japanese "\\)" s))) | ||
| 1709 | (and (boundp 'vc-dired-switches) | 1742 | (and (boundp 'vc-dired-switches) |
| 1710 | vc-dired-switches | 1743 | vc-dired-switches |
| 1711 | (set (make-local-variable 'dired-actual-switches) | 1744 | (set (make-local-variable 'dired-actual-switches) |
| @@ -1713,9 +1746,6 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1713 | (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display) | 1746 | (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display) |
| 1714 | (setq vc-dired-mode t)) | 1747 | (setq vc-dired-mode t)) |
| 1715 | 1748 | ||
| 1716 | (define-key vc-dired-mode-map "\C-xv" vc-prefix-map) | ||
| 1717 | (define-key vc-dired-mode-map "v" vc-prefix-map) | ||
| 1718 | |||
| 1719 | (defun vc-dired-toggle-terse-mode () | 1749 | (defun vc-dired-toggle-terse-mode () |
| 1720 | "Toggle terse display in VC Dired." | 1750 | "Toggle terse display in VC Dired." |
| 1721 | (interactive) | 1751 | (interactive) |
| @@ -1726,53 +1756,30 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1726 | (vc-dired-hook) | 1756 | (vc-dired-hook) |
| 1727 | (revert-buffer)))) | 1757 | (revert-buffer)))) |
| 1728 | 1758 | ||
| 1729 | (define-key vc-dired-mode-map "vt" 'vc-dired-toggle-terse-mode) | ||
| 1730 | |||
| 1731 | (defun vc-dired-mark-locked () | 1759 | (defun vc-dired-mark-locked () |
| 1732 | "Mark all files currently locked." | 1760 | "Mark all files currently locked." |
| 1733 | (interactive) | 1761 | (interactive) |
| 1734 | (dired-mark-if (let ((f (dired-get-filename nil t))) | 1762 | (dired-mark-if (let ((f (dired-get-filename nil t))) |
| 1735 | (and f | 1763 | (and f |
| 1736 | (not (file-directory-p f)) | 1764 | (not (file-directory-p f)) |
| 1737 | (vc-locking-user f))) | 1765 | (not (vc-up-to-date-p f)))) |
| 1738 | "locked file")) | 1766 | "locked file")) |
| 1739 | 1767 | ||
| 1740 | (define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked) | 1768 | (define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked) |
| 1741 | 1769 | ||
| 1742 | (defun vc-fetch-cvs-status (dir) | 1770 | (defun vc-default-dired-state-info (backend file) |
| 1743 | (let ((default-directory dir)) | 1771 | (let ((state (vc-state file))) |
| 1744 | ;; Don't specify DIR in this command, the default-directory is | 1772 | (cond |
| 1745 | ;; enough. Otherwise it might fail with remote repositories. | 1773 | ((stringp state) (concat "(" state ")")) |
| 1746 | (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" "-l") | 1774 | ((eq state 'edited) (concat "(" (vc-user-login-name) ")")) |
| 1747 | (save-excursion | 1775 | ((eq state 'needs-merge) "(merge)") |
| 1748 | (set-buffer (get-buffer "*vc-info*")) | 1776 | ((eq state 'needs-patch) "(patch)") |
| 1749 | (goto-char (point-min)) | 1777 | ((eq state 'unlocked-changes) "(stale)")))) |
| 1750 | (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) | ||
| 1751 | (narrow-to-region (match-beginning 0) (match-end 0)) | ||
| 1752 | (vc-parse-cvs-status) | ||
| 1753 | (goto-char (point-max)) | ||
| 1754 | (widen))))) | ||
| 1755 | |||
| 1756 | (defun vc-dired-state-info (file) | ||
| 1757 | ;; Return the string that indicates the version control status | ||
| 1758 | ;; on a VC dired line. | ||
| 1759 | (let* ((cvs-state (and (eq (vc-backend file) 'CVS) | ||
| 1760 | (vc-cvs-status file))) | ||
| 1761 | (state | ||
| 1762 | (if cvs-state | ||
| 1763 | (cond ((eq cvs-state 'up-to-date) nil) | ||
| 1764 | ((eq cvs-state 'needs-checkout) "patch") | ||
| 1765 | ((eq cvs-state 'locally-modified) "modified") | ||
| 1766 | ((eq cvs-state 'needs-merge) "merge") | ||
| 1767 | ((eq cvs-state 'unresolved-conflict) "conflict") | ||
| 1768 | ((eq cvs-state 'locally-added) "added")) | ||
| 1769 | (vc-locking-user file)))) | ||
| 1770 | (if state (concat "(" state ")")))) | ||
| 1771 | 1778 | ||
| 1772 | (defun vc-dired-reformat-line (x) | 1779 | (defun vc-dired-reformat-line (x) |
| 1773 | ;; Reformat a directory-listing line, replacing various columns with | 1780 | "Reformat a directory-listing line. |
| 1774 | ;; version control information. | 1781 | Replace various columns with version control information. |
| 1775 | ;; This code, like dired, assumes UNIX -l format. | 1782 | This code, like dired, assumes UNIX -l format." |
| 1776 | (beginning-of-line) | 1783 | (beginning-of-line) |
| 1777 | (let ((pos (point)) limit perm date-and-file) | 1784 | (let ((pos (point)) limit perm date-and-file) |
| 1778 | (end-of-line) | 1785 | (end-of-line) |
| @@ -1782,9 +1789,9 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1782 | (or | 1789 | (or |
| 1783 | (re-search-forward ;; owner and group | 1790 | (re-search-forward ;; owner and group |
| 1784 | "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)" | 1791 | "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)" |
| 1785 | limit t) | 1792 | limit t) |
| 1786 | (re-search-forward ;; only owner displayed | 1793 | (re-search-forward ;; only owner displayed |
| 1787 | "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)" | 1794 | "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)" |
| 1788 | limit t) | 1795 | limit t) |
| 1789 | (re-search-forward ;; OS/2 -l format, no links, owner, group | 1796 | (re-search-forward ;; OS/2 -l format, no links, owner, group |
| 1790 | "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)" | 1797 | "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)" |
| @@ -1795,34 +1802,32 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1795 | (replace-match (concat perm x date-and-file))))) | 1802 | (replace-match (concat perm x date-and-file))))) |
| 1796 | 1803 | ||
| 1797 | (defun vc-dired-hook () | 1804 | (defun vc-dired-hook () |
| 1798 | ;; Called by dired after any portion of a vc-dired buffer has been read in. | 1805 | "Reformat the listing according to version control. |
| 1799 | ;; Reformat the listing according to version control. | 1806 | Called by dired after any portion of a vc-dired buffer has been read in." |
| 1800 | (message "Getting version information... ") | 1807 | (message "Getting version information... ") |
| 1801 | (let (subdir filename (buffer-read-only nil) cvs-dir) | 1808 | (let (subdir filename (buffer-read-only nil) cvs-dir) |
| 1802 | (goto-char (point-min)) | 1809 | (goto-char (point-min)) |
| 1803 | (while (not (eq (point) (point-max))) | 1810 | (while (not (eobp)) |
| 1804 | (cond | 1811 | (cond |
| 1805 | ;; subdir header line | 1812 | ;; subdir header line |
| 1806 | ((setq subdir (dired-get-subdir)) | 1813 | ((setq subdir (dired-get-subdir)) |
| 1807 | (if (file-directory-p (concat subdir "/CVS")) | 1814 | ;; if the backend supports it, get the state |
| 1808 | (progn | 1815 | ;; of all files in this directory at once |
| 1809 | (vc-fetch-cvs-status (file-name-as-directory subdir)) | 1816 | (let ((backend (vc-responsible-backend subdir))) |
| 1810 | (setq cvs-dir t)) | 1817 | (if (vc-find-backend-function backend 'dir-state) |
| 1811 | (setq cvs-dir nil)) | 1818 | (vc-call-backend backend 'dir-state subdir))) |
| 1812 | (forward-line 1) | 1819 | (forward-line 1) |
| 1813 | ;; erase (but don't remove) the "total" line | 1820 | ;; erase (but don't remove) the "total" line |
| 1814 | (let ((start (point))) | 1821 | (delete-region (point) (line-end-position)) |
| 1815 | (end-of-line) | 1822 | (beginning-of-line) |
| 1816 | (delete-region start (point)) | 1823 | (forward-line 1)) |
| 1817 | (beginning-of-line) | 1824 | ;; file line |
| 1818 | (forward-line 1))) | ||
| 1819 | ;; directory entry | ||
| 1820 | ((setq filename (dired-get-filename nil t)) | 1825 | ((setq filename (dired-get-filename nil t)) |
| 1821 | (cond | 1826 | (cond |
| 1822 | ;; subdir | 1827 | ;; subdir |
| 1823 | ((file-directory-p filename) | 1828 | ((file-directory-p filename) |
| 1824 | (cond | 1829 | (cond |
| 1825 | ((member (file-name-nondirectory filename) | 1830 | ((member (file-name-nondirectory filename) |
| 1826 | vc-directory-exclusion-list) | 1831 | vc-directory-exclusion-list) |
| 1827 | (let ((pos (point))) | 1832 | (let ((pos (point))) |
| 1828 | (dired-kill-tree filename) | 1833 | (dired-kill-tree filename) |
| @@ -1832,7 +1837,7 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1832 | ;; Don't show directories in terse mode. Don't use | 1837 | ;; Don't show directories in terse mode. Don't use |
| 1833 | ;; dired-kill-line to remove it, because in recursive listings, | 1838 | ;; dired-kill-line to remove it, because in recursive listings, |
| 1834 | ;; that would remove the directory contents as well. | 1839 | ;; that would remove the directory contents as well. |
| 1835 | (delete-region (progn (beginning-of-line) (point)) | 1840 | (delete-region (line-beginning-position) |
| 1836 | (progn (forward-line 1) (point)))) | 1841 | (progn (forward-line 1) (point)))) |
| 1837 | ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename)) | 1842 | ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename)) |
| 1838 | (dired-kill-line)) | 1843 | (dired-kill-line)) |
| @@ -1840,16 +1845,12 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1840 | (vc-dired-reformat-line nil) | 1845 | (vc-dired-reformat-line nil) |
| 1841 | (forward-line 1)))) | 1846 | (forward-line 1)))) |
| 1842 | ;; ordinary file | 1847 | ;; ordinary file |
| 1843 | ((if cvs-dir | 1848 | ((and (vc-backend filename) |
| 1844 | (and (eq (vc-file-getprop filename 'vc-backend) 'CVS) | 1849 | (not (and vc-dired-terse-mode |
| 1845 | (or (not vc-dired-terse-mode) | 1850 | (vc-up-to-date-p filename)))) |
| 1846 | (not (eq (vc-cvs-status filename) 'up-to-date)))) | 1851 | (vc-dired-reformat-line (vc-call dired-state-info filename)) |
| 1847 | (and (vc-backend filename) | ||
| 1848 | (or (not vc-dired-terse-mode) | ||
| 1849 | (vc-locking-user filename)))) | ||
| 1850 | (vc-dired-reformat-line (vc-dired-state-info filename)) | ||
| 1851 | (forward-line 1)) | 1852 | (forward-line 1)) |
| 1852 | (t | 1853 | (t |
| 1853 | (dired-kill-line)))) | 1854 | (dired-kill-line)))) |
| 1854 | ;; any other line | 1855 | ;; any other line |
| 1855 | (t (forward-line 1)))) | 1856 | (t (forward-line 1)))) |
| @@ -1862,7 +1863,7 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1862 | (message "No files locked under %s" default-directory))))) | 1863 | (message "No files locked under %s" default-directory))))) |
| 1863 | 1864 | ||
| 1864 | (defun vc-dired-purge () | 1865 | (defun vc-dired-purge () |
| 1865 | ;; Remove empty subdirs | 1866 | "Remove empty subdirs." |
| 1866 | (let (subdir) | 1867 | (let (subdir) |
| 1867 | (goto-char (point-min)) | 1868 | (goto-char (point-min)) |
| 1868 | (while (setq subdir (dired-get-subdir)) | 1869 | (while (setq subdir (dired-get-subdir)) |
| @@ -1881,139 +1882,136 @@ There is a special command, `*l', to mark all files currently locked." | |||
| 1881 | (goto-char (point-max)))))) | 1882 | (goto-char (point-max)))))) |
| 1882 | (goto-char (point-min)))) | 1883 | (goto-char (point-min)))) |
| 1883 | 1884 | ||
| 1885 | (defun vc-dired-buffers-for-dir (dir) | ||
| 1886 | "Return a list of all vc-dired buffers that currently display DIR." | ||
| 1887 | (let (result) | ||
| 1888 | (mapcar (lambda (buffer) | ||
| 1889 | (with-current-buffer buffer | ||
| 1890 | (if vc-dired-mode | ||
| 1891 | (setq result (append result (list buffer)))))) | ||
| 1892 | (dired-buffers-for-dir dir)) | ||
| 1893 | result)) | ||
| 1894 | |||
| 1895 | (defun vc-dired-resynch-file (file) | ||
| 1896 | "Update the entries for FILE in any VC Dired buffers that list it." | ||
| 1897 | (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file)))) | ||
| 1898 | (when buffers | ||
| 1899 | (mapcar (lambda (buffer) | ||
| 1900 | (with-current-buffer buffer | ||
| 1901 | (if (dired-goto-file file) | ||
| 1902 | ;; bind vc-dired-terse-mode to nil so that | ||
| 1903 | ;; files won't vanish when they are checked in | ||
| 1904 | (let ((vc-dired-terse-mode nil)) | ||
| 1905 | (dired-do-redisplay 1))))) | ||
| 1906 | buffers)))) | ||
| 1907 | |||
| 1884 | ;;;###autoload | 1908 | ;;;###autoload |
| 1885 | (defun vc-directory (dirname read-switches) | 1909 | (defun vc-directory (dir read-switches) |
| 1910 | "Create a buffer in VC Dired Mode for directory DIR. | ||
| 1911 | |||
| 1912 | See Info node `VC Dired Mode'. | ||
| 1913 | |||
| 1914 | With prefix arg READ-SWITCHES, specify a value to override | ||
| 1915 | `dired-listing-switches' when generating the listing." | ||
| 1886 | (interactive "DDired under VC (directory): \nP") | 1916 | (interactive "DDired under VC (directory): \nP") |
| 1887 | (let ((vc-dired-switches (concat dired-listing-switches | 1917 | (let ((vc-dired-switches (concat vc-dired-listing-switches |
| 1888 | (if vc-dired-recurse "R" "")))) | 1918 | (if vc-dired-recurse "R" "")))) |
| 1889 | (if read-switches | 1919 | (if read-switches |
| 1890 | (setq vc-dired-switches | 1920 | (setq vc-dired-switches |
| 1891 | (read-string "Dired listing switches: " | 1921 | (read-string "Dired listing switches: " |
| 1892 | vc-dired-switches))) | 1922 | vc-dired-switches))) |
| 1893 | (require 'dired) | 1923 | (require 'dired) |
| 1894 | (require 'dired-aux) | 1924 | (require 'dired-aux) |
| 1895 | ;; force a trailing slash | 1925 | (switch-to-buffer |
| 1896 | (if (not (eq (elt dirname (1- (length dirname))) ?/)) | 1926 | (dired-internal-noselect (expand-file-name (file-name-as-directory dir)) |
| 1897 | (setq dirname (concat dirname "/"))) | 1927 | vc-dired-switches |
| 1898 | (switch-to-buffer | ||
| 1899 | (dired-internal-noselect (expand-file-name dirname) | ||
| 1900 | (or vc-dired-switches dired-listing-switches) | ||
| 1901 | 'vc-dired-mode)))) | 1928 | 'vc-dired-mode)))) |
| 1902 | 1929 | ||
| 1903 | ;; Named-configuration support for SCCS | ||
| 1904 | |||
| 1905 | (defun vc-add-triple (name file rev) | ||
| 1906 | (save-excursion | ||
| 1907 | (find-file (expand-file-name | ||
| 1908 | vc-name-assoc-file | ||
| 1909 | (file-name-directory (vc-name file)))) | ||
| 1910 | (goto-char (point-max)) | ||
| 1911 | (insert name "\t:\t" file "\t" rev "\n") | ||
| 1912 | (basic-save-buffer) | ||
| 1913 | (kill-buffer (current-buffer)) | ||
| 1914 | )) | ||
| 1915 | |||
| 1916 | (defun vc-record-rename (file newname) | ||
| 1917 | (save-excursion | ||
| 1918 | (find-file | ||
| 1919 | (expand-file-name | ||
| 1920 | vc-name-assoc-file | ||
| 1921 | (file-name-directory (vc-name file)))) | ||
| 1922 | (goto-char (point-min)) | ||
| 1923 | ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) | ||
| 1924 | (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t) | ||
| 1925 | (replace-match (concat ":" newname) nil nil)) | ||
| 1926 | (basic-save-buffer) | ||
| 1927 | (kill-buffer (current-buffer)) | ||
| 1928 | )) | ||
| 1929 | |||
| 1930 | (defun vc-lookup-triple (file name) | ||
| 1931 | ;; Return the numeric version corresponding to a named snapshot of file | ||
| 1932 | ;; If name is nil or a version number string it's just passed through | ||
| 1933 | (cond ((null name) name) | ||
| 1934 | ((let ((firstchar (aref name 0))) | ||
| 1935 | (and (>= firstchar ?0) (<= firstchar ?9))) | ||
| 1936 | name) | ||
| 1937 | (t | ||
| 1938 | (save-excursion | ||
| 1939 | (set-buffer (get-buffer-create "*vc-info*")) | ||
| 1940 | (vc-insert-file | ||
| 1941 | (expand-file-name | ||
| 1942 | vc-name-assoc-file | ||
| 1943 | (file-name-directory (vc-name file)))) | ||
| 1944 | (prog1 | ||
| 1945 | (car (vc-parse-buffer | ||
| 1946 | (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1)))) | ||
| 1947 | (kill-buffer "*vc-info*")))) | ||
| 1948 | )) | ||
| 1949 | 1930 | ||
| 1950 | ;; Named-configuration entry points | 1931 | ;; Named-configuration entry points |
| 1951 | 1932 | ||
| 1952 | (defun vc-snapshot-precondition () | 1933 | (defun vc-snapshot-precondition (dir) |
| 1953 | ;; Scan the tree below the current directory. | 1934 | "Scan the tree below the current directory. If any files are |
| 1954 | ;; If any files are locked, return the name of the first such file. | 1935 | locked, return the name of the first such file. \(This means, neither |
| 1955 | ;; (This means, neither snapshot creation nor retrieval is allowed.) | 1936 | snapshot creation nor retrieval is allowed.\) If one or more of the |
| 1956 | ;; If one or more of the files are currently visited, return `visited'. | 1937 | files are currently visited, return `visited'. Otherwise, return |
| 1957 | ;; Otherwise, return nil. | 1938 | nil." |
| 1958 | (let ((status nil)) | 1939 | (let ((status nil)) |
| 1959 | (catch 'vc-locked-example | 1940 | (catch 'vc-locked-example |
| 1960 | (vc-file-tree-walk | 1941 | (vc-file-tree-walk |
| 1961 | default-directory | 1942 | dir |
| 1962 | (function (lambda (f) | 1943 | (lambda (f) |
| 1963 | (and (vc-registered f) | 1944 | (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f) |
| 1964 | (if (vc-locking-user f) (throw 'vc-locked-example f) | 1945 | (if (get-file-buffer f) (setq status 'visited))))) |
| 1965 | (if (get-file-buffer f) (setq status 'visited))))))) | ||
| 1966 | status))) | 1946 | status))) |
| 1967 | 1947 | ||
| 1968 | ;;;###autoload | 1948 | ;;;###autoload |
| 1969 | (defun vc-create-snapshot (name) | 1949 | (defun vc-create-snapshot (dir name branchp) |
| 1970 | "Make a snapshot called NAME. | 1950 | "Descending recursively from DIR, make a snapshot called NAME. |
| 1971 | The snapshot is made from all registered files at or below the current | 1951 | For each registered file, the version level of its latest version |
| 1972 | directory. For each file, the version level of its latest | 1952 | becomes part of the named configuration. If the prefix argument |
| 1973 | version becomes part of the named configuration." | 1953 | BRANCHP is given, the snapshot is made as a new branch and the files |
| 1974 | (interactive "sNew snapshot name: ") | 1954 | are checked out in that new branch." |
| 1975 | (let ((result (vc-snapshot-precondition))) | 1955 | (interactive |
| 1956 | (list (read-file-name "Directory: " default-directory default-directory t) | ||
| 1957 | (read-string "New snapshot name: ") | ||
| 1958 | current-prefix-arg)) | ||
| 1959 | (message "Making %s... " (if branchp "branch" "snapshot")) | ||
| 1960 | (if (file-directory-p dir) (setq dir (file-name-as-directory dir))) | ||
| 1961 | (vc-call-backend (vc-responsible-backend dir) | ||
| 1962 | 'create-snapshot dir name branchp) | ||
| 1963 | (message "Making %s... done" (if branchp "branch" "snapshot"))) | ||
| 1964 | |||
| 1965 | (defun vc-default-create-snapshot (backend dir name branchp) | ||
| 1966 | (when branchp | ||
| 1967 | (error "VC backend %s does not support module branches" backend)) | ||
| 1968 | (let ((result (vc-snapshot-precondition dir))) | ||
| 1976 | (if (stringp result) | 1969 | (if (stringp result) |
| 1977 | (error "File %s is locked" result) | 1970 | (error "File %s is not up-to-date" result) |
| 1978 | (vc-file-tree-walk | 1971 | (vc-file-tree-walk |
| 1979 | default-directory | 1972 | dir |
| 1980 | (function (lambda (f) (and | 1973 | (lambda (f) |
| 1981 | (vc-name f) | 1974 | (vc-call assign-name f name)))))) |
| 1982 | (vc-backend-assign-name f name))))) | ||
| 1983 | ))) | ||
| 1984 | 1975 | ||
| 1985 | ;;;###autoload | 1976 | ;;;###autoload |
| 1986 | (defun vc-retrieve-snapshot (name) | 1977 | (defun vc-retrieve-snapshot (dir name) |
| 1987 | "Retrieve the snapshot called NAME, or latest versions if NAME is empty. | 1978 | "Descending recursively from DIR, retrieve the snapshot called NAME, |
| 1988 | When retrieving a snapshot, there must not be any locked files at or below | 1979 | or latest versions if NAME is empty. If locking is used for the files |
| 1989 | the current directory. If none are locked, all registered files are | 1980 | in DIR, then there must not be any locked files at or below DIR (but |
| 1990 | checked out (unlocked) at their version levels in the snapshot NAME. | 1981 | if NAME is empty, locked files are allowed and simply skipped)." |
| 1991 | If NAME is the empty string, all registered files that are not currently | 1982 | (interactive |
| 1992 | locked are updated to the latest versions." | 1983 | (list (read-file-name "Directory: " default-directory default-directory t) |
| 1993 | (interactive "sSnapshot name to retrieve (default latest versions): ") | 1984 | (read-string "Snapshot name to retrieve (default latest versions): "))) |
| 1994 | (let ((update (yes-or-no-p "Update any affected buffers? "))) | 1985 | (let ((update (yes-or-no-p "Update any affected buffers? ")) |
| 1995 | (if (string= name "") | 1986 | (msg (if (or (not name) (string= name "")) |
| 1996 | (progn | 1987 | (format "Updating %s... " (abbreviate-file-name dir)) |
| 1997 | (vc-file-tree-walk | 1988 | (format "Retrieving snapshot into %s... " |
| 1998 | default-directory | 1989 | (abbreviate-file-name dir))))) |
| 1999 | (function (lambda (f) (and | 1990 | (message msg) |
| 2000 | (vc-registered f) | 1991 | (vc-call-backend (vc-responsible-backend dir) |
| 2001 | (not (vc-locking-user f)) | 1992 | 'retrieve-snapshot dir name update) |
| 2002 | (vc-error-occurred | 1993 | (message (concat msg "done")))) |
| 2003 | (vc-backend-checkout f nil "") | 1994 | |
| 2004 | (if update (vc-resynch-buffer f t t)))))))) | 1995 | (defun vc-default-retrieve-snapshot (backend dir name update) |
| 2005 | (let ((result (vc-snapshot-precondition))) | 1996 | (if (string= name "") |
| 2006 | (if (stringp result) | 1997 | (progn |
| 2007 | (error "File %s is locked" result) | 1998 | (vc-file-tree-walk |
| 2008 | (setq update (and (eq result 'visited) update)) | 1999 | dir |
| 2009 | (vc-file-tree-walk | 2000 | (lambda (f) (and |
| 2010 | default-directory | 2001 | (vc-up-to-date-p f) |
| 2011 | (function (lambda (f) (and | 2002 | (vc-error-occurred |
| 2012 | (vc-name f) | 2003 | (vc-call checkout f nil "") |
| 2013 | (vc-error-occurred | 2004 | (if update (vc-resynch-buffer f t t))))))) |
| 2014 | (vc-backend-checkout f nil name) | 2005 | (let ((result (vc-snapshot-precondition dir))) |
| 2015 | (if update (vc-resynch-buffer f t t))))))) | 2006 | (if (stringp result) |
| 2016 | ))))) | 2007 | (error "File %s is locked" result) |
| 2008 | (setq update (and (eq result 'visited) update)) | ||
| 2009 | (vc-file-tree-walk | ||
| 2010 | dir | ||
| 2011 | (lambda (f) (and | ||
| 2012 | (vc-error-occurred | ||
| 2013 | (vc-call checkout f nil name) | ||
| 2014 | (if update (vc-resynch-buffer f t t)))))))))) | ||
| 2017 | 2015 | ||
| 2018 | ;; Miscellaneous other entry points | 2016 | ;; Miscellaneous other entry points |
| 2019 | 2017 | ||
| @@ -2023,73 +2021,60 @@ locked are updated to the latest versions." | |||
| 2023 | (interactive) | 2021 | (interactive) |
| 2024 | (vc-ensure-vc-buffer) | 2022 | (vc-ensure-vc-buffer) |
| 2025 | (let ((file buffer-file-name)) | 2023 | (let ((file buffer-file-name)) |
| 2026 | (vc-backend-print-log file) | 2024 | (vc-setup-buffer nil) |
| 2027 | (pop-to-buffer (get-buffer-create "*vc*")) | ||
| 2028 | (setq default-directory (file-name-directory file)) | 2025 | (setq default-directory (file-name-directory file)) |
| 2029 | (goto-char (point-max)) (forward-line -1) | 2026 | (vc-call print-log file) |
| 2030 | (while (looking-at "=*\n") | 2027 | (pop-to-buffer (current-buffer)) |
| 2031 | (delete-char (- (match-end 0) (match-beginning 0))) | 2028 | (if (fboundp 'log-view-mode) (log-view-mode)) |
| 2032 | (forward-line -1)) | 2029 | (vc-exec-after |
| 2033 | (goto-char (point-min)) | 2030 | `(progn |
| 2034 | (if (looking-at "[\b\t\n\v\f\r ]+") | 2031 | (goto-char (point-max)) (forward-line -1) |
| 2035 | (delete-char (- (match-end 0) (match-beginning 0)))) | 2032 | (while (looking-at "=*\n") |
| 2036 | (shrink-window-if-larger-than-buffer) | 2033 | (delete-char (- (match-end 0) (match-beginning 0))) |
| 2037 | ;; move point to the log entry for the current version | 2034 | (forward-line -1)) |
| 2038 | (and (not (eq (vc-backend file) 'SCCS)) | 2035 | (goto-char (point-min)) |
| 2039 | (re-search-forward | 2036 | (if (looking-at "[\b\t\n\v\f\r ]+") |
| 2040 | ;; also match some context, for safety | 2037 | (delete-char (- (match-end 0) (match-beginning 0)))) |
| 2041 | (concat "----\nrevision " (vc-workfile-version file) | 2038 | (shrink-window-if-larger-than-buffer) |
| 2042 | "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t) | 2039 | ;; move point to the log entry for the current version |
| 2043 | ;; set the display window so that | 2040 | (if (fboundp 'log-view-goto-rev) |
| 2044 | ;; the whole log entry is displayed | 2041 | (log-view-goto-rev ',(vc-workfile-version file)) |
| 2045 | (let (start end lines) | 2042 | (if (vc-find-backend-function ',(vc-backend file) 'show-log-entry) |
| 2046 | (beginning-of-line) (forward-line -1) (setq start (point)) | 2043 | (vc-call-backend ',(vc-backend file) |
| 2047 | (if (not (re-search-forward "^----*\nrevision" nil t)) | 2044 | 'show-log-entry |
| 2048 | (setq end (point-max)) | 2045 | ',(vc-workfile-version file)))))))) |
| 2049 | (beginning-of-line) (forward-line -1) (setq end (point))) | ||
| 2050 | (setq lines (count-lines start end)) | ||
| 2051 | (cond | ||
| 2052 | ;; if the global information and this log entry fit | ||
| 2053 | ;; into the window, display from the beginning | ||
| 2054 | ((< (count-lines (point-min) end) (window-height)) | ||
| 2055 | (goto-char (point-min)) | ||
| 2056 | (recenter 0) | ||
| 2057 | (goto-char start)) | ||
| 2058 | ;; if the whole entry fits into the window, | ||
| 2059 | ;; display it centered | ||
| 2060 | ((< (1+ lines) (window-height)) | ||
| 2061 | (goto-char start) | ||
| 2062 | (recenter (1- (- (/ (window-height) 2) (/ lines 2))))) | ||
| 2063 | ;; otherwise (the entry is too large for the window), | ||
| 2064 | ;; display from the start | ||
| 2065 | (t | ||
| 2066 | (goto-char start) | ||
| 2067 | (recenter 0))))))) | ||
| 2068 | 2046 | ||
| 2069 | ;;;###autoload | 2047 | ;;;###autoload |
| 2070 | (defun vc-revert-buffer () | 2048 | (defun vc-revert-buffer () |
| 2071 | "Revert the current buffer's file back to the version it was based on. | 2049 | "Revert the current buffer's file back to the version it was based on. |
| 2072 | This asks for confirmation if the buffer contents are not identical | 2050 | This asks for confirmation if the buffer contents are not identical |
| 2073 | to that version. Note that for RCS and CVS, this function does not | 2051 | to that version. Note that for RCS and CVS, this function does not |
| 2074 | automatically pick up newer changes found in the master file; | 2052 | automatically pick up newer changes found in the master file; |
| 2075 | use C-u \\[vc-next-action] RET to do so." | 2053 | use \\[universal-argument] \\[vc-next-action] to do so." |
| 2076 | (interactive) | 2054 | (interactive) |
| 2077 | (vc-ensure-vc-buffer) | 2055 | (vc-ensure-vc-buffer) |
| 2078 | (let ((file buffer-file-name) | 2056 | (let ((file buffer-file-name) |
| 2079 | ;; This operation should always ask for confirmation. | 2057 | ;; This operation should always ask for confirmation. |
| 2080 | (vc-suppress-confirm nil) | 2058 | (vc-suppress-confirm nil) |
| 2081 | (obuf (current-buffer)) (changed (vc-diff nil t))) | 2059 | (obuf (current-buffer))) |
| 2082 | (if changed | 2060 | (unless (vc-workfile-unchanged-p file) |
| 2083 | (unwind-protect | 2061 | (vc-diff nil t) |
| 2084 | (if (not (yes-or-no-p "Discard changes? ")) | 2062 | (vc-exec-after `(message nil)) |
| 2085 | (error "Revert cancelled")) | 2063 | (unwind-protect |
| 2086 | (if (and (window-dedicated-p (selected-window)) | 2064 | (if (not (yes-or-no-p "Discard changes? ")) |
| 2087 | (one-window-p t 'selected-frame)) | 2065 | (error "Revert canceled")) |
| 2088 | (make-frame-invisible (selected-frame)) | 2066 | (if (or (window-dedicated-p (selected-window)) |
| 2089 | (delete-window)))) | 2067 | (one-window-p t 'selected-frame)) |
| 2068 | (make-frame-invisible (selected-frame)) | ||
| 2069 | (delete-window)))) | ||
| 2090 | (set-buffer obuf) | 2070 | (set-buffer obuf) |
| 2091 | (vc-backend-revert file) | 2071 | ;; Do the reverting |
| 2092 | (vc-resynch-window file t t))) | 2072 | (message "Reverting %s..." file) |
| 2073 | (vc-call revert file) | ||
| 2074 | (vc-file-setprop file 'vc-state 'up-to-date) | ||
| 2075 | (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) | ||
| 2076 | (vc-resynch-buffer file t t) | ||
| 2077 | (message "Reverting %s...done" file))) | ||
| 2093 | 2078 | ||
| 2094 | ;;;###autoload | 2079 | ;;;###autoload |
| 2095 | (defun vc-cancel-version (norevert) | 2080 | (defun vc-cancel-version (norevert) |
| @@ -2097,21 +2082,26 @@ use C-u \\[vc-next-action] RET to do so." | |||
| 2097 | A prefix argument means do not revert the buffer afterwards." | 2082 | A prefix argument means do not revert the buffer afterwards." |
| 2098 | (interactive "P") | 2083 | (interactive "P") |
| 2099 | (vc-ensure-vc-buffer) | 2084 | (vc-ensure-vc-buffer) |
| 2100 | (cond | 2085 | (let* ((backend (vc-backend (buffer-file-name))) |
| 2101 | ((eq (vc-backend (buffer-file-name)) 'CVS) | 2086 | (target (vc-workfile-version (buffer-file-name))) |
| 2102 | (error "Unchecking files under CVS is dangerous and not supported in VC")) | ||
| 2103 | ((vc-locking-user (buffer-file-name)) | ||
| 2104 | (error "This version is locked; use vc-revert-buffer to discard changes")) | ||
| 2105 | ((not (vc-latest-on-branch-p (buffer-file-name))) | ||
| 2106 | (error "This is not the latest version--VC cannot cancel it"))) | ||
| 2107 | (let* ((target (vc-workfile-version (buffer-file-name))) | ||
| 2108 | (recent (if (vc-trunk-p target) "" (vc-branch-part target))) | 2087 | (recent (if (vc-trunk-p target) "" (vc-branch-part target))) |
| 2109 | (config (current-window-configuration)) done) | 2088 | (config (current-window-configuration)) done) |
| 2089 | (cond | ||
| 2090 | ((not (vc-find-backend-function backend 'uncheck)) | ||
| 2091 | (error "Sorry, canceling versions is not supported under %s" backend)) | ||
| 2092 | ((not (vc-call latest-on-branch-p (buffer-file-name))) | ||
| 2093 | (error "This is not the latest version; VC cannot cancel it")) | ||
| 2094 | ((not (vc-up-to-date-p (buffer-file-name))) | ||
| 2095 | (error (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes")))) | ||
| 2110 | (if (null (yes-or-no-p (format "Remove version %s from master? " target))) | 2096 | (if (null (yes-or-no-p (format "Remove version %s from master? " target))) |
| 2111 | nil | 2097 | nil |
| 2112 | (setq norevert (or norevert (not | 2098 | (setq norevert (or norevert (not |
| 2113 | (yes-or-no-p "Revert buffer to most recent remaining version? ")))) | 2099 | (yes-or-no-p "Revert buffer to most recent remaining version? ")))) |
| 2114 | (vc-backend-uncheck (buffer-file-name) target) | 2100 | |
| 2101 | (message "Removing last change from %s..." (buffer-file-name)) | ||
| 2102 | (vc-call uncheck (buffer-file-name) target) | ||
| 2103 | (message "Removing last change from %s...done" (buffer-file-name)) | ||
| 2104 | |||
| 2115 | ;; Check out the most recent remaining version. If it fails, because | 2105 | ;; Check out the most recent remaining version. If it fails, because |
| 2116 | ;; the whole branch got deleted, do a double-take and check out the | 2106 | ;; the whole branch got deleted, do a double-take and check out the |
| 2117 | ;; version where the branch started. | 2107 | ;; version where the branch started. |
| @@ -2119,15 +2109,16 @@ A prefix argument means do not revert the buffer afterwards." | |||
| 2119 | (condition-case err | 2109 | (condition-case err |
| 2120 | (progn | 2110 | (progn |
| 2121 | (if norevert | 2111 | (if norevert |
| 2122 | ;; Check out locked, but only to disc, and keep | 2112 | ;; Check out locked, but only to disk, and keep |
| 2123 | ;; modifications in the buffer. | 2113 | ;; modifications in the buffer. |
| 2124 | (vc-backend-checkout (buffer-file-name) t recent) | 2114 | (vc-call checkout (buffer-file-name) t recent) |
| 2125 | ;; Check out unlocked, and revert buffer. | 2115 | ;; Check out unlocked, and revert buffer. |
| 2126 | (vc-checkout (buffer-file-name) nil recent)) | 2116 | (vc-checkout (buffer-file-name) nil recent)) |
| 2127 | (setq done t)) | 2117 | (setq done t)) |
| 2128 | ;; If the checkout fails, vc-do-command signals an error. | 2118 | ;; If the checkout fails, vc-do-command signals an error. |
| 2129 | ;; We catch this error, check the reason, correct the | 2119 | ;; We catch this error, check the reason, correct the |
| 2130 | ;; version number, and try a second time. | 2120 | ;; version number, and try a second time. |
| 2121 | ;; FIXME: This is still RCS-only code. | ||
| 2131 | (error (set-buffer "*vc*") | 2122 | (error (set-buffer "*vc*") |
| 2132 | (goto-char (point-min)) | 2123 | (goto-char (point-min)) |
| 2133 | (if (search-forward "no side branches present for" nil t) | 2124 | (if (search-forward "no side branches present for" nil t) |
| @@ -2146,12 +2137,41 @@ A prefix argument means do not revert the buffer afterwards." | |||
| 2146 | ;; inhibit backup for this buffer | 2137 | ;; inhibit backup for this buffer |
| 2147 | (progn (make-local-variable 'backup-inhibited) | 2138 | (progn (make-local-variable 'backup-inhibited) |
| 2148 | (setq backup-inhibited t))) | 2139 | (setq backup-inhibited t))) |
| 2149 | (if (eq (vc-backend (buffer-file-name)) 'RCS) | 2140 | (setq buffer-read-only nil) |
| 2150 | (progn (setq buffer-read-only nil) | 2141 | (vc-clear-headers) |
| 2151 | (vc-clear-headers))) | ||
| 2152 | (vc-mode-line (buffer-file-name)))) | 2142 | (vc-mode-line (buffer-file-name)))) |
| 2153 | (message "Version %s has been removed from the master" target) | 2143 | (message "Version %s has been removed from the master" target)))) |
| 2154 | ))) | 2144 | |
| 2145 | (defun vc-rename-master (oldmaster newfile templates) | ||
| 2146 | "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES." | ||
| 2147 | (let* ((dir (file-name-directory (expand-file-name oldmaster))) | ||
| 2148 | (newdir (or (file-name-directory newfile) "")) | ||
| 2149 | (newbase (file-name-nondirectory newfile)) | ||
| 2150 | (masters | ||
| 2151 | ;; List of potential master files for `newfile' | ||
| 2152 | (mapcar | ||
| 2153 | (lambda (s) (vc-possible-master s newdir newbase)) | ||
| 2154 | templates))) | ||
| 2155 | (if (or (file-symlink-p oldmaster) | ||
| 2156 | (file-symlink-p (file-name-directory oldmaster))) | ||
| 2157 | (error "This unsafe in the presence of symbolic links")) | ||
| 2158 | (rename-file | ||
| 2159 | oldmaster | ||
| 2160 | (catch 'found | ||
| 2161 | ;; If possible, keep the master file in the same directory. | ||
| 2162 | (mapcar (lambda (f) | ||
| 2163 | (if (and f (string= (file-name-directory (expand-file-name f)) | ||
| 2164 | dir)) | ||
| 2165 | (throw 'found f))) | ||
| 2166 | masters) | ||
| 2167 | ;; If not, just use the first possible place. | ||
| 2168 | (mapcar (lambda (f) | ||
| 2169 | (and f | ||
| 2170 | (or (not (setq dir (file-name-directory f))) | ||
| 2171 | (file-directory-p dir)) | ||
| 2172 | (throw 'found f))) | ||
| 2173 | masters) | ||
| 2174 | (error "New file lacks a version control directory"))))) | ||
| 2155 | 2175 | ||
| 2156 | ;;;###autoload | 2176 | ;;;###autoload |
| 2157 | (defun vc-rename-file (old new) | 2177 | (defun vc-rename-file (old new) |
| @@ -2163,77 +2183,42 @@ A prefix argument means do not revert the buffer afterwards." | |||
| 2163 | ;; consider to be wrong. When the famous, long-awaited rename database is | 2183 | ;; consider to be wrong. When the famous, long-awaited rename database is |
| 2164 | ;; implemented things might change for the better. This is unlikely to occur | 2184 | ;; implemented things might change for the better. This is unlikely to occur |
| 2165 | ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51 | 2185 | ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51 |
| 2166 | (if (eq (vc-backend old) 'CVS) | 2186 | (let ((oldbuf (get-file-buffer old)) |
| 2167 | (error "Renaming files under CVS is dangerous and not supported in VC")) | 2187 | (backend (vc-backend old))) |
| 2168 | (let ((oldbuf (get-file-buffer old))) | 2188 | (unless (or (null backend) (vc-find-backend-function backend 'rename-file)) |
| 2189 | (error "Renaming files under %s is not supported in VC" backend)) | ||
| 2169 | (if (and oldbuf (buffer-modified-p oldbuf)) | 2190 | (if (and oldbuf (buffer-modified-p oldbuf)) |
| 2170 | (error "Please save files before moving them")) | 2191 | (error "Please save files before moving them")) |
| 2171 | (if (get-file-buffer new) | 2192 | (if (get-file-buffer new) |
| 2172 | (error "Already editing new file name")) | 2193 | (error "Already editing new file name")) |
| 2173 | (if (file-exists-p new) | 2194 | (if (file-exists-p new) |
| 2174 | (error "New file already exists")) | 2195 | (error "New file already exists")) |
| 2175 | (let ((oldmaster (vc-name old)) newmaster) | 2196 | (when backend |
| 2176 | (if oldmaster | 2197 | (if (and backend (not (vc-up-to-date-p old))) |
| 2177 | (progn | 2198 | (error "Please check in files before moving them")) |
| 2178 | (if (vc-locking-user old) | 2199 | (vc-call-backend backend 'rename-file old new)) |
| 2179 | (error "Please check in files before moving them")) | 2200 | ;; Move the actual file (unless the backend did it already) |
| 2180 | (if (or (file-symlink-p oldmaster) | 2201 | (if (or (not backend) (file-exists-p old)) |
| 2181 | ;; This had FILE, I changed it to OLD. -- rms. | 2202 | (rename-file old new)) |
| 2182 | (file-symlink-p (vc-backend-subdirectory-name old))) | 2203 | ;; ?? Renaming a file might change its contents due to keyword expansion. |
| 2183 | (error "This is not a safe thing to do in the presence of symbolic links")) | 2204 | ;; We should really check out a new copy if the old copy was precisely equal |
| 2184 | (setq newmaster | 2205 | ;; to some checked in version. However, testing for this is tricky.... |
| 2185 | (let ((backend (vc-backend old)) | ||
| 2186 | (newdir (or (file-name-directory new) "")) | ||
| 2187 | (newbase (file-name-nondirectory new))) | ||
| 2188 | (catch 'found | ||
| 2189 | (mapcar | ||
| 2190 | (function | ||
| 2191 | (lambda (s) | ||
| 2192 | (if (eq backend (cdr s)) | ||
| 2193 | (let* ((newmaster (format (car s) newdir newbase)) | ||
| 2194 | (newmasterdir (file-name-directory newmaster))) | ||
| 2195 | (if (or (not newmasterdir) | ||
| 2196 | (file-directory-p newmasterdir)) | ||
| 2197 | (throw 'found newmaster)))))) | ||
| 2198 | vc-master-templates) | ||
| 2199 | (error "New file lacks a version control directory")))) | ||
| 2200 | ;; Handle the SCCS PROJECTDIR feature. It is odd that this | ||
| 2201 | ;; is a special case, but a more elegant solution would require | ||
| 2202 | ;; significant changes in other parts of VC. | ||
| 2203 | (if (eq (vc-backend old) 'SCCS) | ||
| 2204 | (let ((project-dir (vc-sccs-project-dir))) | ||
| 2205 | (if project-dir | ||
| 2206 | (setq newmaster | ||
| 2207 | (concat project-dir | ||
| 2208 | (file-name-nondirectory newmaster)))))) | ||
| 2209 | (rename-file oldmaster newmaster))) | ||
| 2210 | (if (or (not oldmaster) (file-exists-p old)) | ||
| 2211 | (rename-file old new))) | ||
| 2212 | ; ?? Renaming a file might change its contents due to keyword expansion. | ||
| 2213 | ; We should really check out a new copy if the old copy was precisely equal | ||
| 2214 | ; to some checked in version. However, testing for this is tricky.... | ||
| 2215 | (if oldbuf | 2206 | (if oldbuf |
| 2216 | (save-excursion | 2207 | (with-current-buffer oldbuf |
| 2217 | (set-buffer oldbuf) | ||
| 2218 | (let ((buffer-read-only buffer-read-only)) | 2208 | (let ((buffer-read-only buffer-read-only)) |
| 2219 | (set-visited-file-name new)) | 2209 | (set-visited-file-name new)) |
| 2220 | (vc-backend new) | 2210 | (vc-backend new) |
| 2221 | (vc-mode-line new) | 2211 | (vc-mode-line new) |
| 2222 | (set-buffer-modified-p nil)))) | 2212 | (set-buffer-modified-p nil))))) |
| 2223 | ;; This had FILE, I changed it to OLD. -- rms. | 2213 | |
| 2224 | (vc-backend-dispatch old | 2214 | ;; Only defined in very recent Emacsen |
| 2225 | (vc-record-rename old new) ;SCCS | 2215 | (defvar small-temporary-file-directory nil) |
| 2226 | nil ;RCS | ||
| 2227 | nil ;CVS | ||
| 2228 | ) | ||
| 2229 | ) | ||
| 2230 | 2216 | ||
| 2231 | ;;;###autoload | 2217 | ;;;###autoload |
| 2232 | (defun vc-update-change-log (&rest args) | 2218 | (defun vc-update-change-log (&rest args) |
| 2233 | "Find change log file and add entries from recent RCS/CVS logs. | 2219 | "Find change log file and add entries from recent version control logs. |
| 2234 | Normally, find log entries for all registered files in the default | 2220 | Normally, find log entries for all registered files in the default |
| 2235 | directory using `rcs2log', which finds CVS logs preferentially. | 2221 | directory. |
| 2236 | The mark is left at the end of the text prepended to the change log. | ||
| 2237 | 2222 | ||
| 2238 | With prefix arg of C-u, only find log entries for the current buffer's file. | 2223 | With prefix arg of C-u, only find log entries for the current buffer's file. |
| 2239 | 2224 | ||
| @@ -2241,9 +2226,8 @@ With any numeric prefix arg, find log entries for all currently visited | |||
| 2241 | files that are under version control. This puts all the entries in the | 2226 | files that are under version control. This puts all the entries in the |
| 2242 | log for the default directory, which may not be appropriate. | 2227 | log for the default directory, which may not be appropriate. |
| 2243 | 2228 | ||
| 2244 | From a program, any arguments are assumed to be filenames and are | 2229 | From a program, any arguments are assumed to be filenames for which |
| 2245 | passed to the `rcs2log' script after massaging to be relative to the | 2230 | log entries should be gathered." |
| 2246 | default directory." | ||
| 2247 | (interactive | 2231 | (interactive |
| 2248 | (cond ((consp current-prefix-arg) ;C-u | 2232 | (cond ((consp current-prefix-arg) ;C-u |
| 2249 | (list buffer-file-name)) | 2233 | (list buffer-file-name)) |
| @@ -2258,13 +2242,22 @@ default directory." | |||
| 2258 | (setq buffers (cdr buffers))) | 2242 | (setq buffers (cdr buffers))) |
| 2259 | files)) | 2243 | files)) |
| 2260 | (t | 2244 | (t |
| 2261 | ;; `rcs2log' will find the relevant RCS or CVS files | 2245 | ;; Don't supply any filenames to backend; this means |
| 2262 | ;; relative to the curent directory if none supplied. | 2246 | ;; it should find all relevant files relative to |
| 2247 | ;; the default-directory. | ||
| 2263 | nil))) | 2248 | nil))) |
| 2249 | (vc-call-backend (vc-responsible-backend default-directory) | ||
| 2250 | 'update-changelog args)) | ||
| 2251 | |||
| 2252 | (defun vc-default-update-changelog (backend files) | ||
| 2253 | "Default implementation of update-changelog; uses `rcs2log' which only | ||
| 2254 | works for RCS and CVS." | ||
| 2255 | ;; FIXME: We (c|sh)ould add support for cvs2cl | ||
| 2264 | (let ((odefault default-directory) | 2256 | (let ((odefault default-directory) |
| 2265 | (changelog (find-change-log)) | 2257 | (changelog (find-change-log)) |
| 2266 | ;; Presumably not portable to non-Unixy systems, along with rcs2log: | 2258 | ;; Presumably not portable to non-Unixy systems, along with rcs2log: |
| 2267 | (tempfile (make-temp-file | 2259 | (tempfile (funcall |
| 2260 | (if (fboundp 'make-temp-file) 'make-temp-file 'make-temp-name) | ||
| 2268 | (expand-file-name "vc" | 2261 | (expand-file-name "vc" |
| 2269 | (or small-temporary-file-directory | 2262 | (or small-temporary-file-directory |
| 2270 | temporary-file-directory)))) | 2263 | temporary-file-directory)))) |
| @@ -2284,93 +2277,74 @@ default directory." | |||
| 2284 | (message "Computing change log entries... %s" | 2277 | (message "Computing change log entries... %s" |
| 2285 | (unwind-protect | 2278 | (unwind-protect |
| 2286 | (progn | 2279 | (progn |
| 2287 | (cd odefault) | 2280 | (setq default-directory odefault) |
| 2288 | (if (eq 0 (apply 'call-process | 2281 | (if (eq 0 (apply 'call-process |
| 2289 | (expand-file-name "rcs2log" exec-directory) | 2282 | (expand-file-name "rcs2log" |
| 2290 | nil | 2283 | exec-directory) |
| 2291 | (list t tempfile) nil | 2284 | nil (list t tempfile) nil |
| 2292 | "-c" changelog | 2285 | "-c" changelog |
| 2293 | "-u" (concat (vc-user-login-name) | 2286 | "-u" (concat (vc-user-login-name) |
| 2294 | "\t" full-name | 2287 | "\t" full-name |
| 2295 | "\t" mailing-address) | 2288 | "\t" mailing-address) |
| 2296 | (mapcar | 2289 | (mapcar |
| 2297 | (function | 2290 | (lambda (f) |
| 2298 | (lambda (f) | 2291 | (file-relative-name |
| 2299 | (file-relative-name | 2292 | (if (file-name-absolute-p f) |
| 2300 | (if (file-name-absolute-p f) | 2293 | f |
| 2301 | f | 2294 | (concat odefault f)))) |
| 2302 | (concat odefault f))))) | 2295 | files))) |
| 2303 | args))) | 2296 | "done" |
| 2304 | "done" | ||
| 2305 | (pop-to-buffer | 2297 | (pop-to-buffer |
| 2306 | (set-buffer (get-buffer-create "*vc*"))) | 2298 | (set-buffer (get-buffer-create "*vc*"))) |
| 2307 | (erase-buffer) | 2299 | (erase-buffer) |
| 2308 | (insert-file tempfile) | 2300 | (insert-file tempfile) |
| 2309 | "failed")) | 2301 | "failed")) |
| 2310 | (cd (file-name-directory changelog)) | 2302 | (setq default-directory (file-name-directory changelog)) |
| 2311 | (delete-file tempfile))))) | 2303 | (delete-file tempfile))))) |
| 2312 | |||
| 2313 | ;; vc-annotate functionality (CVS only). | ||
| 2314 | (defvar vc-annotate-mode-map nil | ||
| 2315 | "Local keymap used for VC-Annotate mode.") | ||
| 2316 | 2304 | ||
| 2317 | (defvar vc-annotate-mode-menu nil | 2305 | ;;; Annotate functionality |
| 2318 | "Local keymap used for VC-Annotate mode's menu bar menu.") | ||
| 2319 | |||
| 2320 | ;; Syntax Table | ||
| 2321 | (defvar vc-annotate-mode-syntax-table nil | ||
| 2322 | "Syntax table used in VC-Annotate mode buffers.") | ||
| 2323 | 2306 | ||
| 2324 | ;; Declare globally instead of additional parameter to | 2307 | ;; Declare globally instead of additional parameter to |
| 2325 | ;; temp-buffer-show-function (not possible to pass more than one | 2308 | ;; temp-buffer-show-function (not possible to pass more than one |
| 2326 | ;; parameter). | 2309 | ;; parameter). |
| 2327 | (defvar vc-annotate-ratio nil) | 2310 | (defvar vc-annotate-ratio nil "Global variable") |
| 2328 | 2311 | (defvar vc-annotate-backend nil "Global variable") | |
| 2329 | (defun vc-annotate-mode-variables () | 2312 | |
| 2330 | (if (not vc-annotate-mode-syntax-table) | 2313 | (defun vc-annotate-get-backend (buffer) |
| 2331 | (progn (setq vc-annotate-mode-syntax-table (make-syntax-table)) | 2314 | "Return the backend matching \"Annotate\" buffer BUFFER. Return NIL |
| 2332 | (set-syntax-table vc-annotate-mode-syntax-table))) | 2315 | if no match made. Associations are made based on |
| 2333 | (if (not vc-annotate-mode-map) | 2316 | `vc-annotate-buffers'." |
| 2334 | (setq vc-annotate-mode-map (make-sparse-keymap))) | 2317 | (cdr (assoc buffer vc-annotate-buffers))) |
| 2335 | (setq vc-annotate-mode-menu (make-sparse-keymap "Annotate")) | ||
| 2336 | (define-key vc-annotate-mode-map [menu-bar] | ||
| 2337 | (make-sparse-keymap "VC-Annotate")) | ||
| 2338 | (define-key vc-annotate-mode-map [menu-bar vc-annotate-mode] | ||
| 2339 | (cons "VC-Annotate" vc-annotate-mode-menu))) | ||
| 2340 | 2318 | ||
| 2341 | (defun vc-annotate-mode () | 2319 | (define-derived-mode vc-annotate-mode fundamental-mode "Annotate" |
| 2342 | "Major mode for buffers displaying output from the CVS `annotate' command. | 2320 | "Major mode for buffers displaying output from the `annotate' command. |
| 2343 | 2321 | ||
| 2344 | You can use the mode-specific menu to alter the time-span of the used | 2322 | You can use the mode-specific menu to alter the time-span of the used |
| 2345 | colors. See variable `vc-annotate-menu-elements' for customizing the | 2323 | colors. See variable `vc-annotate-menu-elements' for customizing the |
| 2346 | menu items." | 2324 | menu items." |
| 2347 | (interactive) | ||
| 2348 | (kill-all-local-variables) ; Recommended by RMS. | ||
| 2349 | (vc-annotate-mode-variables) ; This defines various variables. | ||
| 2350 | (use-local-map vc-annotate-mode-map) ; This provides the local keymap. | ||
| 2351 | (set-syntax-table vc-annotate-mode-syntax-table) | ||
| 2352 | (setq major-mode 'vc-annotate-mode) ; This is how `describe-mode' | ||
| 2353 | ; finds out what to describe. | ||
| 2354 | (setq mode-name "Annotate") ; This goes into the mode line. | ||
| 2355 | (run-hooks 'vc-annotate-mode-hook) | ||
| 2356 | (vc-annotate-add-menu)) | 2325 | (vc-annotate-add-menu)) |
| 2357 | 2326 | ||
| 2358 | (defun vc-annotate-display-default (&optional event) | 2327 | (defun vc-annotate-display-default (&optional event) |
| 2359 | "Use the default color spectrum for VC Annotate mode." | 2328 | "Use the default color spectrum for VC Annotate mode." |
| 2360 | (interactive) | 2329 | (interactive "e") |
| 2361 | (message "Redisplaying annotation...") | 2330 | (message "Redisplaying annotation...") |
| 2362 | (vc-annotate-display (get-buffer (buffer-name))) | 2331 | (vc-annotate-display (current-buffer) |
| 2332 | nil | ||
| 2333 | (vc-annotate-get-backend (current-buffer))) | ||
| 2363 | (message "Redisplaying annotation...done")) | 2334 | (message "Redisplaying annotation...done")) |
| 2364 | 2335 | ||
| 2365 | (defun vc-annotate-add-menu () | 2336 | (defun vc-annotate-add-menu () |
| 2366 | "Adds the menu 'Annotate' to the menu bar in VC-Annotate mode." | 2337 | "Add the menu 'Annotate' to the menu bar in VC-Annotate mode." |
| 2338 | (setq vc-annotate-mode-menu (make-sparse-keymap "Annotate")) | ||
| 2339 | (define-key vc-annotate-mode-map [menu-bar vc-annotate-mode] | ||
| 2340 | (cons "VC-Annotate" vc-annotate-mode-menu)) | ||
| 2367 | (define-key vc-annotate-mode-menu [default] | 2341 | (define-key vc-annotate-mode-menu [default] |
| 2368 | '("Default" . vc-annotate-display-default)) | 2342 | '("Default" . vc-annotate-display-default)) |
| 2369 | (let ((menu-elements vc-annotate-menu-elements)) | 2343 | (let ((menu-elements vc-annotate-menu-elements)) |
| 2370 | (while menu-elements | 2344 | (while menu-elements |
| 2371 | (let* ((element (car menu-elements)) | 2345 | (let* ((element (car menu-elements)) |
| 2372 | (days (round (* element | 2346 | (days (round (* element |
| 2373 | (vc-annotate-car-last-cons vc-annotate-color-map) | 2347 | (vc-annotate-car-last-cons vc-annotate-color-map) |
| 2374 | 0.7585)))) | 2348 | 0.7585)))) |
| 2375 | (setq menu-elements (cdr menu-elements)) | 2349 | (setq menu-elements (cdr menu-elements)) |
| 2376 | (define-key vc-annotate-mode-menu | 2350 | (define-key vc-annotate-mode-menu |
| @@ -2383,14 +2357,21 @@ menu items." | |||
| 2383 | (message "Redisplaying annotation...") | 2357 | (message "Redisplaying annotation...") |
| 2384 | (vc-annotate-display | 2358 | (vc-annotate-display |
| 2385 | (get-buffer (buffer-name)) | 2359 | (get-buffer (buffer-name)) |
| 2386 | (vc-annotate-time-span vc-annotate-color-map ,element)) | 2360 | (vc-annotate-time-span vc-annotate-color-map ,element) |
| 2361 | (vc-annotate-get-backend (current-buffer))) | ||
| 2387 | (message "Redisplaying annotation...done")))))))) | 2362 | (message "Redisplaying annotation...done")))))))) |
| 2388 | 2363 | ||
| 2364 | |||
| 2365 | ;;;; (defun vc-BACKEND-annotate-command (file buffer) ...) | ||
| 2366 | ;;;; Execute "annotate" on FILE by using `call-process' and insert | ||
| 2367 | ;;;; the contents in BUFFER. | ||
| 2368 | |||
| 2389 | ;;;###autoload | 2369 | ;;;###autoload |
| 2390 | (defun vc-annotate (ratio) | 2370 | (defun vc-annotate (ratio) |
| 2391 | "Display the result of the CVS `annotate' command using colors. | 2371 | "Display the result of the \"Annotate\" command using colors. |
| 2392 | New lines are displayed in red, old in blue. | 2372 | \"Annotate\" is defined by `vc-BACKEND-annotate-command'. New lines |
| 2393 | A prefix argument specifies a factor for stretching the time scale. | 2373 | are displayed in red, old in blue. A prefix argument specifies a |
| 2374 | factor for stretching the time scale. | ||
| 2394 | 2375 | ||
| 2395 | `vc-annotate-menu-elements' customizes the menu elements of the | 2376 | `vc-annotate-menu-elements' customizes the menu elements of the |
| 2396 | mode-specific menu. `vc-annotate-color-map' and | 2377 | mode-specific menu. `vc-annotate-color-map' and |
| @@ -2398,17 +2379,23 @@ mode-specific menu. `vc-annotate-color-map' and | |||
| 2398 | colors. `vc-annotate-background' specifies the background color." | 2379 | colors. `vc-annotate-background' specifies the background color." |
| 2399 | (interactive "p") | 2380 | (interactive "p") |
| 2400 | (vc-ensure-vc-buffer) | 2381 | (vc-ensure-vc-buffer) |
| 2401 | (if (not (eq (vc-backend (buffer-file-name)) 'CVS)) | ||
| 2402 | (error "Sorry, vc-annotate is only implemented for CVS")) | ||
| 2403 | (message "Annotating...") | 2382 | (message "Annotating...") |
| 2404 | (let ((temp-buffer-name (concat "*cvs annotate " (buffer-name) "*")) | 2383 | (let ((temp-buffer-name (concat "*Annotate " (buffer-name) "*")) |
| 2405 | (temp-buffer-show-function 'vc-annotate-display) | 2384 | (temp-buffer-show-function 'vc-annotate-display) |
| 2406 | (vc-annotate-ratio ratio)) | 2385 | (vc-annotate-ratio ratio) |
| 2407 | (with-output-to-temp-buffer temp-buffer-name | 2386 | (vc-annotate-backend (vc-backend (buffer-file-name)))) |
| 2408 | (call-process "cvs" nil (get-buffer temp-buffer-name) nil | 2387 | (with-output-to-temp-buffer temp-buffer-name |
| 2409 | "annotate" (file-name-nondirectory (buffer-file-name))))) | 2388 | (vc-call-backend vc-annotate-backend 'annotate-command |
| 2389 | (file-name-nondirectory (buffer-file-name)) | ||
| 2390 | (get-buffer temp-buffer-name))) | ||
| 2391 | ;; Don't use the temp-buffer-name until the buffer is created | ||
| 2392 | ;; (only after `with-output-to-temp-buffer'.) | ||
| 2393 | (setq vc-annotate-buffers | ||
| 2394 | (append vc-annotate-buffers | ||
| 2395 | (list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))) | ||
| 2410 | (message "Annotating... done")) | 2396 | (message "Annotating... done")) |
| 2411 | 2397 | ||
| 2398 | |||
| 2412 | (defun vc-annotate-car-last-cons (a-list) | 2399 | (defun vc-annotate-car-last-cons (a-list) |
| 2413 | "Return car of last cons in association list A-LIST." | 2400 | "Return car of last cons in association list A-LIST." |
| 2414 | (if (not (eq nil (cdr a-list))) | 2401 | (if (not (eq nil (cdr a-list))) |
| @@ -2416,21 +2403,21 @@ colors. `vc-annotate-background' specifies the background color." | |||
| 2416 | (car (car a-list)))) | 2403 | (car (car a-list)))) |
| 2417 | 2404 | ||
| 2418 | (defun vc-annotate-time-span (a-list span &optional quantize) | 2405 | (defun vc-annotate-time-span (a-list span &optional quantize) |
| 2419 | "Return an association list with factor SPAN applied to the time-span | 2406 | "Apply factor SPAN to the time-span of association list A-LIST |
| 2420 | of association list A-LIST. Optionaly quantize to the factor of | 2407 | Return the new alist. |
| 2421 | QUANTIZE." | 2408 | Optionally quantize to the factor of QUANTIZE." |
| 2422 | ;; Apply span to each car of every cons | 2409 | ;; Apply span to each car of every cons |
| 2423 | (if (not (eq nil a-list)) | 2410 | (if (not (eq nil a-list)) |
| 2424 | (append (list (cons (* (car (car a-list)) span) | 2411 | (append (list (cons (* (car (car a-list)) span) |
| 2425 | (cdr (car a-list)))) | 2412 | (cdr (car a-list)))) |
| 2426 | (vc-annotate-time-span (nthcdr (cond (quantize) ; optional | 2413 | (vc-annotate-time-span (nthcdr (or quantize ; optional |
| 2427 | (1)) ; Default to cdr | 2414 | 1) ; Default to cdr |
| 2428 | a-list) span quantize)))) | 2415 | a-list) span quantize)))) |
| 2429 | 2416 | ||
| 2430 | (defun vc-annotate-compcar (threshold a-list) | 2417 | (defun vc-annotate-compcar (threshold a-list) |
| 2431 | "Test successive cons cells of association list A-LIST against | 2418 | "Test successive cons cells of association list A-LIST against THRESHOLD. |
| 2432 | THRESHOLD. Return the first cons cell which car is not less than | 2419 | Return the first cons cell which car is not less than THRESHOLD, |
| 2433 | THRESHOLD, nil otherwise" | 2420 | nil otherwise" |
| 2434 | (let ((i 1) | 2421 | (let ((i 1) |
| 2435 | (tmp-cons (car a-list))) | 2422 | (tmp-cons (car a-list))) |
| 2436 | (while (and tmp-cons (< (car tmp-cons) threshold)) | 2423 | (while (and tmp-cons (< (car tmp-cons) threshold)) |
| @@ -2439,649 +2426,91 @@ THRESHOLD, nil otherwise" | |||
| 2439 | tmp-cons)) ; Return the appropriate value | 2426 | tmp-cons)) ; Return the appropriate value |
| 2440 | 2427 | ||
| 2441 | 2428 | ||
| 2442 | (defun vc-annotate-display (buffer &optional color-map) | 2429 | ;;;; (defun vc-BACKEND-annotate-difference (point) ...) |
| 2443 | "Do the VC-Annotate display in BUFFER using COLOR-MAP." | 2430 | ;;;; |
| 2431 | ;;;; Return the difference between the age of the line at point and | ||
| 2432 | ;;;; the current time. Return NIL if there is no more comparison to | ||
| 2433 | ;;;; be made in the buffer. Return value as defined for | ||
| 2434 | ;;;; `current-time'. You can safely assume that point is placed at | ||
| 2435 | ;;;; the beginning of each line, starting at `point-min'. The buffer | ||
| 2436 | ;;;; that point is placed in is the Annotate output, as defined by | ||
| 2437 | ;;;; the relevant backend. | ||
| 2438 | |||
| 2439 | (defun vc-annotate-display (buffer &optional color-map backend) | ||
| 2440 | "Do the VC-Annotate display in BUFFER using COLOR-MAP. The original | ||
| 2441 | Annotating file is supposed to be handled by BACKEND. If BACKEND is | ||
| 2442 | NIL, variable VC-ANNOTATE-BACKEND is used instead. This function is | ||
| 2443 | destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil." | ||
| 2444 | 2444 | ||
| 2445 | ;; Handle the case of the global variable vc-annotate-ratio being | 2445 | ;; Handle the case of the global variable vc-annotate-ratio being |
| 2446 | ;; set. This variable is used to pass information from function | 2446 | ;; set. This variable is used to pass information from function |
| 2447 | ;; vc-annotate since it is not possible to use another parameter | 2447 | ;; vc-annotate since it is not possible to use another parameter |
| 2448 | ;; (see temp-buffer-show-function). | 2448 | ;; (see temp-buffer-show-function). |
| 2449 | (if (and (not color-map) vc-annotate-ratio) | 2449 | (if (and (not color-map) vc-annotate-ratio) |
| 2450 | ;; This will only be true if called from vc-annotate with ratio | 2450 | ;; This will only be true if called from vc-annotate with ratio |
| 2451 | ;; being non-nil. | 2451 | ;; being non-nil. |
| 2452 | (setq color-map (vc-annotate-time-span vc-annotate-color-map | 2452 | (setq color-map (vc-annotate-time-span vc-annotate-color-map |
| 2453 | vc-annotate-ratio))) | 2453 | vc-annotate-ratio))) |
| 2454 | 2454 | (set-buffer buffer) | |
| 2455 | ;; We need a list of months and their corresponding numbers. | 2455 | (display-buffer buffer) |
| 2456 | (let* ((local-month-numbers | 2456 | (if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done |
| 2457 | '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) | 2457 | (vc-annotate-mode)) |
| 2458 | ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) | 2458 | (goto-char (point-min)) ; Position at the top of the buffer. |
| 2459 | ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))) | 2459 | ;; Delete old overlays |
| 2460 | (set-buffer buffer) | 2460 | (mapcar |
| 2461 | (display-buffer buffer) | 2461 | (lambda (overlay) |
| 2462 | (or (eq major-mode 'vc-annotate-mode) ; Turn on vc-annotate-mode if not done | 2462 | (if (overlay-get overlay 'vc-annotation) |
| 2463 | (vc-annotate-mode)) | 2463 | (delete-overlay overlay))) |
| 2464 | ;; Delete old overlays | 2464 | (overlays-in (point-min) (point-max))) |
| 2465 | (mapcar | 2465 | (goto-char (point-min)) ; Position at the top of the buffer. |
| 2466 | (lambda (overlay) | 2466 | |
| 2467 | (if (overlay-get overlay 'vc-annotation) | 2467 | (if backend (setq vc-annotate-backend backend)) ; Destructive on `vc-annotate-backend' |
| 2468 | (delete-overlay overlay))) | 2468 | |
| 2469 | (overlays-in (point-min) (point-max))) | 2469 | (let ((difference (vc-call-backend vc-annotate-backend 'annotate-difference (point)))) |
| 2470 | (goto-char (point-min)) ; Position at the top of the buffer. | 2470 | (while difference |
| 2471 | (while (re-search-forward | 2471 | (let* |
| 2472 | "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " | 2472 | ((color (or (vc-annotate-compcar |
| 2473 | ;; "^[0-9]+\\(\.[0-9]+\\)*\\s-+(\\sw+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " | 2473 | difference (or color-map vc-annotate-color-map)) |
| 2474 | nil t) | 2474 | (cons nil vc-annotate-very-old-color))) |
| 2475 | 2475 | ;; substring from index 1 to remove any leading `#' in the name | |
| 2476 | (let* (;; Unfortunately, order is important. match-string will | 2476 | (face-name (concat "vc-annotate-face-" (substring (cdr color) 1))) |
| 2477 | ;; be corrupted by extent functions in XEmacs. Access | 2477 | ;; Make the face if not done. |
| 2478 | ;; string-matches first. | 2478 | (face (or (intern-soft face-name) |
| 2479 | (day (string-to-number (match-string 1))) | 2479 | (let ((tmp-face (make-face (intern face-name)))) |
| 2480 | (month (cdr (assoc (match-string 2) local-month-numbers))) | 2480 | (set-face-foreground tmp-face (cdr color)) |
| 2481 | (year-tmp (string-to-number (match-string 3))) | 2481 | (if vc-annotate-background |
| 2482 | ;; Years 0..68 are 2000..2068. | 2482 | (set-face-background tmp-face vc-annotate-background)) |
| 2483 | ;; Years 69..99 are 1969..1999. | 2483 | tmp-face))) ; Return the face |
| 2484 | (year (+ (cond ((> 69 year-tmp) 2000) | 2484 | (point (point)) |
| 2485 | ((> 100 year-tmp) 1900) | 2485 | overlay) |
| 2486 | (t 0)) | ||
| 2487 | year-tmp)) | ||
| 2488 | (high (- (car (current-time)) | ||
| 2489 | (car (encode-time 0 0 0 day month year)))) | ||
| 2490 | (color (cond ((vc-annotate-compcar high (cond (color-map) | ||
| 2491 | (vc-annotate-color-map)))) | ||
| 2492 | ((cons nil vc-annotate-very-old-color)))) | ||
| 2493 | ;; substring from index 1 to remove any leading `#' in the name | ||
| 2494 | (face-name (concat "vc-annotate-face-" (substring (cdr color) 1))) | ||
| 2495 | ;; Make the face if not done. | ||
| 2496 | (face (cond ((intern-soft face-name)) | ||
| 2497 | ((let ((tmp-face (make-face (intern face-name)))) | ||
| 2498 | (set-face-foreground tmp-face (cdr color)) | ||
| 2499 | (if vc-annotate-background | ||
| 2500 | (set-face-background tmp-face vc-annotate-background)) | ||
| 2501 | tmp-face)))) ; Return the face | ||
| 2502 | (point (point)) | ||
| 2503 | overlay) | ||
| 2504 | |||
| 2505 | (forward-line 1) | 2486 | (forward-line 1) |
| 2506 | (setq overlay (make-overlay point (point))) | 2487 | (setq overlay (make-overlay point (point))) |
| 2507 | (overlay-put overlay 'face face) | 2488 | (overlay-put overlay 'face face) |
| 2508 | (overlay-put overlay 'vc-annotation t))))) | 2489 | (overlay-put overlay 'vc-annotation t)) |
| 2490 | (setq difference (vc-call-backend vc-annotate-backend 'annotate-difference (point)))))) | ||
| 2509 | 2491 | ||
| 2510 | 2492 | ||
| 2511 | ;; Collect back-end-dependent stuff here | 2493 | ;; Collect back-end-dependent stuff here |
| 2512 | 2494 | ||
| 2513 | (defun vc-backend-admin (file &optional rev comment) | 2495 | (defalias 'vc-default-logentry-check 'ignore) |
| 2514 | ;; Register a file into the version-control system | ||
| 2515 | ;; Automatically retrieves a read-only version of the file with | ||
| 2516 | ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise | ||
| 2517 | ;; it deletes the workfile. | ||
| 2518 | (vc-file-clearprops file) | ||
| 2519 | (or vc-default-back-end | ||
| 2520 | (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))) | ||
| 2521 | (message "Registering %s..." file) | ||
| 2522 | (let* ((switches | ||
| 2523 | (if (stringp vc-register-switches) | ||
| 2524 | (list vc-register-switches) | ||
| 2525 | vc-register-switches)) | ||
| 2526 | (project-dir) | ||
| 2527 | (backend | ||
| 2528 | (cond | ||
| 2529 | ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end) | ||
| 2530 | ((file-exists-p "RCS") 'RCS) | ||
| 2531 | ((file-exists-p "CVS") 'CVS) | ||
| 2532 | ((file-exists-p "SCCS") 'SCCS) | ||
| 2533 | ((setq project-dir (vc-sccs-project-dir)) 'SCCS) | ||
| 2534 | (t vc-default-back-end)))) | ||
| 2535 | (cond ((eq backend 'SCCS) | ||
| 2536 | (let ((vc-name | ||
| 2537 | (if project-dir (concat project-dir | ||
| 2538 | "s." (file-name-nondirectory file)) | ||
| 2539 | (format | ||
| 2540 | (car (rassq 'SCCS vc-master-templates)) | ||
| 2541 | (or (file-name-directory file) "") | ||
| 2542 | (file-name-nondirectory file))))) | ||
| 2543 | (apply 'vc-do-command nil 0 "admin" nil nil ;; SCCS | ||
| 2544 | (and rev (concat "-r" rev)) | ||
| 2545 | "-fb" | ||
| 2546 | (concat "-i" file) | ||
| 2547 | (and comment (concat "-y" comment)) | ||
| 2548 | vc-name | ||
| 2549 | switches)) | ||
| 2550 | (delete-file file) | ||
| 2551 | (if vc-keep-workfiles | ||
| 2552 | (vc-do-command nil 0 "get" file 'MASTER))) | ||
| 2553 | ((eq backend 'RCS) | ||
| 2554 | (apply 'vc-do-command nil 0 "ci" file 'WORKFILE ;; RCS | ||
| 2555 | ;; if available, use the secure registering option | ||
| 2556 | (and (vc-backend-release-p 'RCS "5.6.4") "-i") | ||
| 2557 | (concat (if vc-keep-workfiles "-u" "-r") rev) | ||
| 2558 | (and comment (concat "-t-" comment)) | ||
| 2559 | switches)) | ||
| 2560 | ((eq backend 'CVS) | ||
| 2561 | (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS | ||
| 2562 | "add" | ||
| 2563 | (and comment (string-match "[^\t\n ]" comment) | ||
| 2564 | (concat "-m" comment)) | ||
| 2565 | switches) | ||
| 2566 | ))) | ||
| 2567 | (message "Registering %s...done" file) | ||
| 2568 | ) | ||
| 2569 | 2496 | ||
| 2570 | (defun vc-backend-checkout (file &optional writable rev workfile) | 2497 | (defun vc-default-merge-news (backend file) |
| 2571 | ;; Retrieve a copy of a saved version into a workfile | 2498 | (error "vc-merge-news not meaningful for %s files" backend)) |
| 2572 | (let ((filename (or workfile file)) | ||
| 2573 | (file-buffer (get-file-buffer file)) | ||
| 2574 | switches) | ||
| 2575 | (message "Checking out %s..." filename) | ||
| 2576 | (save-excursion | ||
| 2577 | ;; Change buffers to get local value of vc-checkout-switches. | ||
| 2578 | (if file-buffer (set-buffer file-buffer)) | ||
| 2579 | (setq switches (if (stringp vc-checkout-switches) | ||
| 2580 | (list vc-checkout-switches) | ||
| 2581 | vc-checkout-switches)) | ||
| 2582 | ;; Save this buffer's default-directory | ||
| 2583 | ;; and use save-excursion to make sure it is restored | ||
| 2584 | ;; in the same buffer it was saved in. | ||
| 2585 | (let ((default-directory default-directory)) | ||
| 2586 | (save-excursion | ||
| 2587 | ;; Adjust the default-directory so that the check-out creates | ||
| 2588 | ;; the file in the right place. | ||
| 2589 | (setq default-directory (file-name-directory filename)) | ||
| 2590 | (vc-backend-dispatch file | ||
| 2591 | (progn ;; SCCS | ||
| 2592 | (and rev (string= rev "") (setq rev nil)) | ||
| 2593 | (if workfile | ||
| 2594 | ;; Some SCCS implementations allow checking out directly to a | ||
| 2595 | ;; file using the -G option, but then some don't so use the | ||
| 2596 | ;; least common denominator approach and use the -p option | ||
| 2597 | ;; ala RCS. | ||
| 2598 | (let ((vc-modes (logior (file-modes (vc-name file)) | ||
| 2599 | (if writable 128 0))) | ||
| 2600 | (failed t)) | ||
| 2601 | (unwind-protect | ||
| 2602 | (progn | ||
| 2603 | (let ((coding-system-for-read 'no-conversion) | ||
| 2604 | (coding-system-for-write 'no-conversion)) | ||
| 2605 | (with-temp-file filename | ||
| 2606 | (apply 'vc-do-command | ||
| 2607 | (current-buffer) 0 "get" file 'MASTER | ||
| 2608 | "-s" ;; suppress diagnostic output | ||
| 2609 | (if writable "-e") | ||
| 2610 | "-p" | ||
| 2611 | (and rev | ||
| 2612 | (concat "-r" | ||
| 2613 | (vc-lookup-triple file rev))) | ||
| 2614 | switches))) | ||
| 2615 | (set-file-modes filename | ||
| 2616 | (logior (file-modes (vc-name file)) | ||
| 2617 | (if writable 128 0))) | ||
| 2618 | (setq failed nil)) | ||
| 2619 | (and failed (file-exists-p filename) | ||
| 2620 | (delete-file filename)))) | ||
| 2621 | (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS | ||
| 2622 | (if writable "-e") | ||
| 2623 | (and rev (concat "-r" (vc-lookup-triple file rev))) | ||
| 2624 | switches) | ||
| 2625 | (vc-file-setprop file 'vc-workfile-version nil))) | ||
| 2626 | (if workfile ;; RCS | ||
| 2627 | ;; RCS doesn't let us check out into arbitrary file names directly. | ||
| 2628 | ;; Use `co -p' and make stdout point to the correct file. | ||
| 2629 | (let ((vc-modes (logior (file-modes (vc-name file)) | ||
| 2630 | (if writable 128 0))) | ||
| 2631 | (failed t)) | ||
| 2632 | (unwind-protect | ||
| 2633 | (progn | ||
| 2634 | (let ((coding-system-for-read 'no-conversion) | ||
| 2635 | (coding-system-for-write 'no-conversion)) | ||
| 2636 | (with-temp-file filename | ||
| 2637 | (apply 'vc-do-command | ||
| 2638 | (current-buffer) 0 "co" file 'MASTER | ||
| 2639 | "-q" ;; suppress diagnostic output | ||
| 2640 | (if writable "-l") | ||
| 2641 | (concat "-p" rev) | ||
| 2642 | switches))) | ||
| 2643 | (set-file-modes filename | ||
| 2644 | (logior (file-modes (vc-name file)) | ||
| 2645 | (if writable 128 0))) | ||
| 2646 | (setq failed nil)) | ||
| 2647 | (and failed (file-exists-p filename) (delete-file filename)))) | ||
| 2648 | (let (new-version) | ||
| 2649 | ;; if we should go to the head of the trunk, | ||
| 2650 | ;; clear the default branch first | ||
| 2651 | (and rev (string= rev "") | ||
| 2652 | (vc-do-command nil 0 "rcs" file 'MASTER "-b")) | ||
| 2653 | ;; now do the checkout | ||
| 2654 | (apply 'vc-do-command | ||
| 2655 | nil 0 "co" file 'MASTER | ||
| 2656 | ;; If locking is not strict, force to overwrite | ||
| 2657 | ;; the writable workfile. | ||
| 2658 | (if (eq (vc-checkout-model file) 'implicit) "-f") | ||
| 2659 | (if writable "-l") | ||
| 2660 | (if rev (concat "-r" rev) | ||
| 2661 | ;; if no explicit revision was specified, | ||
| 2662 | ;; check out that of the working file | ||
| 2663 | (let ((workrev (vc-workfile-version file))) | ||
| 2664 | (if workrev (concat "-r" workrev) | ||
| 2665 | nil))) | ||
| 2666 | switches) | ||
| 2667 | ;; determine the new workfile version | ||
| 2668 | (save-excursion | ||
| 2669 | (set-buffer "*vc*") | ||
| 2670 | (goto-char (point-min)) | ||
| 2671 | (setq new-version | ||
| 2672 | (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t) | ||
| 2673 | (buffer-substring (match-beginning 1) (match-end 1))))) | ||
| 2674 | (vc-file-setprop file 'vc-workfile-version new-version) | ||
| 2675 | ;; if necessary, adjust the default branch | ||
| 2676 | (and rev (not (string= rev "")) | ||
| 2677 | (vc-do-command nil 0 "rcs" file 'MASTER | ||
| 2678 | (concat "-b" (if (vc-latest-on-branch-p file) | ||
| 2679 | (if (vc-trunk-p new-version) nil | ||
| 2680 | (vc-branch-part new-version)) | ||
| 2681 | new-version)))))) | ||
| 2682 | (if workfile ;; CVS | ||
| 2683 | ;; CVS is much like RCS | ||
| 2684 | (let ((failed t)) | ||
| 2685 | (unwind-protect | ||
| 2686 | (progn | ||
| 2687 | (let ((coding-system-for-read 'no-conversion) | ||
| 2688 | (coding-system-for-write 'no-conversion)) | ||
| 2689 | (with-temp-file filename | ||
| 2690 | (apply 'vc-do-command | ||
| 2691 | (current-buffer) 0 "cvs" file 'WORKFILE | ||
| 2692 | "-Q" ;; suppress diagnostic output | ||
| 2693 | "update" | ||
| 2694 | (concat "-r" rev) | ||
| 2695 | "-p" | ||
| 2696 | switches))) | ||
| 2697 | (setq failed nil)) | ||
| 2698 | (and failed (file-exists-p filename) (delete-file filename)))) | ||
| 2699 | ;; default for verbose checkout: clear the sticky tag | ||
| 2700 | ;; so that the actual update will get the head of the trunk | ||
| 2701 | (and rev (string= rev "") | ||
| 2702 | (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) | ||
| 2703 | ;; If a revision was specified, check that out. | ||
| 2704 | (if rev | ||
| 2705 | (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE | ||
| 2706 | (and writable (eq (vc-checkout-model file) 'manual) "-w") | ||
| 2707 | "update" | ||
| 2708 | (and rev (not (string= rev "")) | ||
| 2709 | (concat "-r" rev)) | ||
| 2710 | switches) | ||
| 2711 | ;; If no revision was specified, call "cvs edit" to make | ||
| 2712 | ;; the file writeable. | ||
| 2713 | (and writable (eq (vc-checkout-model file) 'manual) | ||
| 2714 | (vc-do-command nil 0 "cvs" file 'WORKFILE "edit"))) | ||
| 2715 | (if rev (vc-file-setprop file 'vc-workfile-version nil)))) | ||
| 2716 | (cond | ||
| 2717 | ((not workfile) | ||
| 2718 | (vc-file-clear-masterprops file) | ||
| 2719 | (if writable | ||
| 2720 | (vc-file-setprop file 'vc-locking-user (vc-user-login-name))) | ||
| 2721 | (vc-file-setprop file | ||
| 2722 | 'vc-checkout-time (nth 5 (file-attributes file))))) | ||
| 2723 | (message "Checking out %s...done" filename)))))) | ||
| 2724 | |||
| 2725 | (defun vc-backend-logentry-check (file) | ||
| 2726 | (vc-backend-dispatch file | ||
| 2727 | (if (>= (buffer-size) 512) ;; SCCS | ||
| 2728 | (progn | ||
| 2729 | (goto-char 512) | ||
| 2730 | (error | ||
| 2731 | "Log must be less than 512 characters; point is now at pos 512"))) | ||
| 2732 | nil ;; RCS | ||
| 2733 | nil) ;; CVS | ||
| 2734 | ) | ||
| 2735 | |||
| 2736 | (defun vc-backend-checkin (file rev comment) | ||
| 2737 | ;; Register changes to FILE as level REV with explanatory COMMENT. | ||
| 2738 | ;; Automatically retrieves a read-only version of the file with | ||
| 2739 | ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise | ||
| 2740 | ;; it deletes the workfile. | ||
| 2741 | ;; Adaptation for RCS branch support: if this is an explicit checkin, | ||
| 2742 | ;; or if the checkin creates a new branch, set the master file branch | ||
| 2743 | ;; accordingly. | ||
| 2744 | (message "Checking in %s..." file) | ||
| 2745 | ;; "This log message intentionally left almost blank". | ||
| 2746 | ;; RCS 5.7 gripes about white-space-only comments too. | ||
| 2747 | (or (and comment (string-match "[^\t\n ]" comment)) | ||
| 2748 | (setq comment "*** empty log message ***")) | ||
| 2749 | (save-excursion | ||
| 2750 | ;; Change buffers to get local value of vc-checkin-switches. | ||
| 2751 | (set-buffer (or (get-file-buffer file) (current-buffer))) | ||
| 2752 | (let ((switches | ||
| 2753 | (if (stringp vc-checkin-switches) | ||
| 2754 | (list vc-checkin-switches) | ||
| 2755 | vc-checkin-switches))) | ||
| 2756 | ;; Clear the master-properties. Do that here, not at the | ||
| 2757 | ;; end, because if the check-in fails we want them to get | ||
| 2758 | ;; re-computed before the next try. | ||
| 2759 | (vc-file-clear-masterprops file) | ||
| 2760 | (vc-backend-dispatch file | ||
| 2761 | ;; SCCS | ||
| 2762 | (progn | ||
| 2763 | (apply 'vc-do-command nil 0 "delta" file 'MASTER | ||
| 2764 | (if rev (concat "-r" rev)) | ||
| 2765 | (concat "-y" comment) | ||
| 2766 | switches) | ||
| 2767 | (vc-file-setprop file 'vc-locking-user 'none) | ||
| 2768 | (vc-file-setprop file 'vc-workfile-version nil) | ||
| 2769 | (if vc-keep-workfiles | ||
| 2770 | (vc-do-command nil 0 "get" file 'MASTER)) | ||
| 2771 | ) | ||
| 2772 | ;; RCS | ||
| 2773 | (let ((old-version (vc-workfile-version file)) new-version) | ||
| 2774 | (apply 'vc-do-command nil 0 "ci" file 'MASTER | ||
| 2775 | ;; if available, use the secure check-in option | ||
| 2776 | (and (vc-backend-release-p 'RCS "5.6.4") "-j") | ||
| 2777 | (concat (if vc-keep-workfiles "-u" "-r") rev) | ||
| 2778 | (concat "-m" comment) | ||
| 2779 | switches) | ||
| 2780 | (vc-file-setprop file 'vc-locking-user 'none) | ||
| 2781 | (vc-file-setprop file 'vc-workfile-version nil) | ||
| 2782 | |||
| 2783 | ;; determine the new workfile version | ||
| 2784 | (set-buffer "*vc*") | ||
| 2785 | (goto-char (point-min)) | ||
| 2786 | (if (or (re-search-forward | ||
| 2787 | "new revision: \\([0-9.]+\\);" nil t) | ||
| 2788 | (re-search-forward | ||
| 2789 | "reverting to previous revision \\([0-9.]+\\)" nil t)) | ||
| 2790 | (progn (setq new-version (buffer-substring (match-beginning 1) | ||
| 2791 | (match-end 1))) | ||
| 2792 | (vc-file-setprop file 'vc-workfile-version new-version))) | ||
| 2793 | |||
| 2794 | ;; if we got to a different branch, adjust the default | ||
| 2795 | ;; branch accordingly | ||
| 2796 | (cond | ||
| 2797 | ((and old-version new-version | ||
| 2798 | (not (string= (vc-branch-part old-version) | ||
| 2799 | (vc-branch-part new-version)))) | ||
| 2800 | (vc-do-command nil 0 "rcs" file 'MASTER | ||
| 2801 | (if (vc-trunk-p new-version) "-b" | ||
| 2802 | (concat "-b" (vc-branch-part new-version)))) | ||
| 2803 | ;; If this is an old RCS release, we might have | ||
| 2804 | ;; to remove a remaining lock. | ||
| 2805 | (if (not (vc-backend-release-p 'RCS "5.6.2")) | ||
| 2806 | ;; exit status of 1 is also accepted. | ||
| 2807 | ;; It means that the lock was removed before. | ||
| 2808 | (vc-do-command nil 1 "rcs" file 'MASTER | ||
| 2809 | (concat "-u" old-version)))))) | ||
| 2810 | ;; CVS | ||
| 2811 | (progn | ||
| 2812 | ;; explicit check-in to the trunk requires a | ||
| 2813 | ;; double check-in (first unexplicit) (CVS-1.3) | ||
| 2814 | (condition-case nil | ||
| 2815 | (progn | ||
| 2816 | (if (and rev (vc-trunk-p rev)) | ||
| 2817 | (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE | ||
| 2818 | "ci" "-m" "intermediate" | ||
| 2819 | switches)) | ||
| 2820 | (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE | ||
| 2821 | "ci" (if rev (concat "-r" rev)) | ||
| 2822 | (concat "-m" comment) | ||
| 2823 | switches)) | ||
| 2824 | (error (if (eq (vc-cvs-status file) 'needs-merge) | ||
| 2825 | ;; The CVS output will be on top of this message. | ||
| 2826 | (error "Type C-x 0 C-x C-q to merge in changes") | ||
| 2827 | (error "Check-in failed")))) | ||
| 2828 | ;; determine and store the new workfile version | ||
| 2829 | (set-buffer "*vc*") | ||
| 2830 | (goto-char (point-min)) | ||
| 2831 | (if (re-search-forward | ||
| 2832 | "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t) | ||
| 2833 | (vc-file-setprop file 'vc-workfile-version | ||
| 2834 | (buffer-substring (match-beginning 2) | ||
| 2835 | (match-end 2))) | ||
| 2836 | (vc-file-setprop file 'vc-workfile-version nil)) | ||
| 2837 | ;; if this was an explicit check-in, remove the sticky tag | ||
| 2838 | (if rev | ||
| 2839 | (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) | ||
| 2840 | ;; Forget the checkout model, because we might have assumed | ||
| 2841 | ;; a wrong one when we found the file. After commit, we can | ||
| 2842 | ;; tell it from the permissions of the file | ||
| 2843 | ;; (see vc-checkout-model). | ||
| 2844 | (vc-file-setprop file 'vc-checkout-model nil) | ||
| 2845 | (vc-file-setprop file 'vc-locking-user 'none) | ||
| 2846 | (vc-file-setprop file 'vc-checkout-time | ||
| 2847 | (nth 5 (file-attributes file))))))) | ||
| 2848 | (message "Checking in %s...done" file)) | ||
| 2849 | |||
| 2850 | (defun vc-backend-revert (file) | ||
| 2851 | ;; Revert file to the version it was based on. | ||
| 2852 | (message "Reverting %s..." file) | ||
| 2853 | (vc-file-clear-masterprops file) | ||
| 2854 | (vc-backend-dispatch | ||
| 2855 | file | ||
| 2856 | ;; SCCS | ||
| 2857 | (progn | ||
| 2858 | (vc-do-command nil 0 "unget" file 'MASTER nil) | ||
| 2859 | (vc-do-command nil 0 "get" file 'MASTER nil) | ||
| 2860 | ;; Checking out explicit versions is not supported under SCCS, yet. | ||
| 2861 | ;; We always "revert" to the latest version; therefore | ||
| 2862 | ;; vc-workfile-version is cleared here so that it gets recomputed. | ||
| 2863 | (vc-file-setprop file 'vc-workfile-version nil)) | ||
| 2864 | ;; RCS | ||
| 2865 | (vc-do-command nil 0 "co" file 'MASTER | ||
| 2866 | "-f" (concat "-u" (vc-workfile-version file))) | ||
| 2867 | ;; CVS | ||
| 2868 | (progn | ||
| 2869 | ;; Check out via standard output (caused by the final argument | ||
| 2870 | ;; FILE below), so that no sticky tag is set. | ||
| 2871 | (vc-backend-checkout file nil (vc-workfile-version file) file) | ||
| 2872 | ;; If "cvs edit" was used to make the file writeable, | ||
| 2873 | ;; call "cvs unedit" now to undo that. | ||
| 2874 | (if (eq (vc-checkout-model file) 'manual) | ||
| 2875 | (vc-do-command nil 0 "cvs" file 'WORKFILE "unedit")))) | ||
| 2876 | (vc-file-setprop file 'vc-locking-user 'none) | ||
| 2877 | (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) | ||
| 2878 | (message "Reverting %s...done" file) | ||
| 2879 | ) | ||
| 2880 | |||
| 2881 | (defun vc-backend-steal (file &optional rev) | ||
| 2882 | ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M. | ||
| 2883 | (message "Stealing lock on %s..." file) | ||
| 2884 | (vc-backend-dispatch file | ||
| 2885 | (progn ;SCCS | ||
| 2886 | (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev))) | ||
| 2887 | (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev))) | ||
| 2888 | ) | ||
| 2889 | (vc-do-command nil 0 "rcs" file 'MASTER ;RCS | ||
| 2890 | "-M" (concat "-u" rev) (concat "-l" rev)) | ||
| 2891 | (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS | ||
| 2892 | ) | ||
| 2893 | (vc-file-setprop file 'vc-locking-user (vc-user-login-name)) | ||
| 2894 | (message "Stealing lock on %s...done" file) | ||
| 2895 | ) | ||
| 2896 | |||
| 2897 | (defun vc-backend-uncheck (file target) | ||
| 2898 | ;; Undo the latest checkin. | ||
| 2899 | (message "Removing last change from %s..." file) | ||
| 2900 | (vc-backend-dispatch file | ||
| 2901 | (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target)) | ||
| 2902 | (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target)) | ||
| 2903 | nil ;; this is never reached under CVS | ||
| 2904 | ) | ||
| 2905 | (message "Removing last change from %s...done" file) | ||
| 2906 | ) | ||
| 2907 | |||
| 2908 | (defun vc-backend-print-log (file) | ||
| 2909 | ;; Get change log associated with FILE. | ||
| 2910 | (vc-backend-dispatch | ||
| 2911 | file | ||
| 2912 | (vc-do-command nil 0 "prs" file 'MASTER) | ||
| 2913 | (vc-do-command nil 0 "rlog" file 'MASTER) | ||
| 2914 | (vc-do-command nil 0 "cvs" file 'WORKFILE "log"))) | ||
| 2915 | |||
| 2916 | (defun vc-backend-assign-name (file name) | ||
| 2917 | ;; Assign to a FILE's latest version a given NAME. | ||
| 2918 | (vc-backend-dispatch file | ||
| 2919 | (vc-add-triple name file (vc-latest-version file)) ;; SCCS | ||
| 2920 | (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS | ||
| 2921 | (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name) ;; CVS | ||
| 2922 | ) | ||
| 2923 | ) | ||
| 2924 | |||
| 2925 | (defun vc-backend-diff (file &optional oldvers newvers cmp) | ||
| 2926 | ;; Get a difference report between two versions of FILE. | ||
| 2927 | ;; Get only a brief comparison report if CMP, a difference report otherwise. | ||
| 2928 | (let ((backend (vc-backend file)) options status | ||
| 2929 | (diff-switches-list (if (listp diff-switches) | ||
| 2930 | diff-switches | ||
| 2931 | (list diff-switches)))) | ||
| 2932 | (cond | ||
| 2933 | ((eq backend 'SCCS) | ||
| 2934 | (setq oldvers (vc-lookup-triple file oldvers)) | ||
| 2935 | (setq newvers (vc-lookup-triple file newvers)) | ||
| 2936 | (setq options (append (list (and cmp "--brief") "-q" | ||
| 2937 | (and oldvers (concat "-r" oldvers)) | ||
| 2938 | (and newvers (concat "-r" newvers))) | ||
| 2939 | (and (not cmp) diff-switches-list))) | ||
| 2940 | (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" file 'MASTER options)) | ||
| 2941 | ((eq backend 'RCS) | ||
| 2942 | (if (not oldvers) (setq oldvers (vc-workfile-version file))) | ||
| 2943 | ;; If we know that --brief is not supported, don't try it. | ||
| 2944 | (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no)))) | ||
| 2945 | (setq options (append (list (and cmp "--brief") "-q" | ||
| 2946 | (concat "-r" oldvers) | ||
| 2947 | (and newvers (concat "-r" newvers))) | ||
| 2948 | (and (not cmp) diff-switches-list))) | ||
| 2949 | (setq status (apply 'vc-do-command "*vc-diff*" 2 | ||
| 2950 | "rcsdiff" file 'WORKFILE options)) | ||
| 2951 | ;; If --brief didn't work, do a double-take and remember it | ||
| 2952 | ;; for the future. | ||
| 2953 | (if (eq status 2) | ||
| 2954 | (setq status | ||
| 2955 | (prog1 | ||
| 2956 | (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE | ||
| 2957 | (if cmp (cdr options) options)) | ||
| 2958 | (if cmp (setq vc-rcsdiff-knows-brief 'no)))) | ||
| 2959 | ;; If --brief DID work, remember that, too. | ||
| 2960 | (and cmp (not vc-rcsdiff-knows-brief) | ||
| 2961 | (setq vc-rcsdiff-knows-brief 'yes)) | ||
| 2962 | status)) | ||
| 2963 | ;; CVS is different. | ||
| 2964 | ((eq backend 'CVS) | ||
| 2965 | (if (string= (vc-workfile-version file) "0") | ||
| 2966 | ;; This file is added but not yet committed; there is no master file. | ||
| 2967 | (if (or oldvers newvers) | ||
| 2968 | (error "No revisions of %s exist" file) | ||
| 2969 | (if cmp 1 ;; file is added but not committed, | ||
| 2970 | ;; we regard this as "changed". | ||
| 2971 | ;; diff it against /dev/null. | ||
| 2972 | (apply 'vc-do-command | ||
| 2973 | "*vc-diff*" 1 "diff" file 'WORKFILE | ||
| 2974 | (append diff-switches-list '("/dev/null"))))) | ||
| 2975 | ;; cmp is not yet implemented -- we always do a full diff. | ||
| 2976 | (apply 'vc-do-command | ||
| 2977 | "*vc-diff*" 1 "cvs" file 'WORKFILE "diff" | ||
| 2978 | (and oldvers (concat "-r" oldvers)) | ||
| 2979 | (and newvers (concat "-r" newvers)) | ||
| 2980 | diff-switches-list)))))) | ||
| 2981 | |||
| 2982 | (defun vc-backend-merge-news (file) | ||
| 2983 | ;; Merge in any new changes made to FILE. | ||
| 2984 | (message "Merging changes into %s..." file) | ||
| 2985 | (prog1 | ||
| 2986 | (vc-backend-dispatch | ||
| 2987 | file | ||
| 2988 | (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS | ||
| 2989 | (error "vc-backend-merge-news not meaningful for RCS files") ;RCS | ||
| 2990 | (save-excursion ; CVS | ||
| 2991 | (vc-file-clear-masterprops file) | ||
| 2992 | (vc-file-setprop file 'vc-workfile-version nil) | ||
| 2993 | (vc-file-setprop file 'vc-locking-user nil) | ||
| 2994 | (vc-file-setprop file 'vc-checkout-time nil) | ||
| 2995 | (vc-do-command nil 0 "cvs" file 'WORKFILE "update") | ||
| 2996 | ;; Analyze the merge result reported by CVS, and set | ||
| 2997 | ;; file properties accordingly. | ||
| 2998 | (set-buffer (get-buffer "*vc*")) | ||
| 2999 | (goto-char (point-min)) | ||
| 3000 | ;; get new workfile version | ||
| 3001 | (if (re-search-forward (concat "^Merging differences between " | ||
| 3002 | "[01234567890.]* and " | ||
| 3003 | "\\([01234567890.]*\\) into") | ||
| 3004 | nil t) | ||
| 3005 | (vc-file-setprop file 'vc-workfile-version (match-string 1))) | ||
| 3006 | ;; get file status | ||
| 3007 | (if (re-search-forward | ||
| 3008 | (concat "^\\(\\([CMUP]\\) \\)?" | ||
| 3009 | (regexp-quote (file-name-nondirectory file)) | ||
| 3010 | "\\( already contains the differences between \\)?") | ||
| 3011 | nil t) | ||
| 3012 | (cond | ||
| 3013 | ;; Merge successful, we are in sync with repository now | ||
| 3014 | ((or (string= (match-string 2) "U") | ||
| 3015 | (string= (match-string 2) "P") | ||
| 3016 | ;; Special case: file contents in sync with | ||
| 3017 | ;; repository anyhow: | ||
| 3018 | (match-string 3)) | ||
| 3019 | (vc-file-setprop file 'vc-locking-user 'none) | ||
| 3020 | (vc-file-setprop file 'vc-checkout-time | ||
| 3021 | (nth 5 (file-attributes file))) | ||
| 3022 | 0) ;; indicate success to the caller | ||
| 3023 | ;; Merge successful, but our own changes are still in the file | ||
| 3024 | ((string= (match-string 2) "M") | ||
| 3025 | (vc-file-setprop file 'vc-locking-user (vc-file-owner file)) | ||
| 3026 | (vc-file-setprop file 'vc-checkout-time 0) | ||
| 3027 | 0) ;; indicate success to the caller | ||
| 3028 | ;; Conflicts detected! | ||
| 3029 | ((string= (match-string 2) "C") | ||
| 3030 | (vc-file-setprop file 'vc-locking-user (vc-file-owner file)) | ||
| 3031 | (vc-file-setprop file 'vc-checkout-time 0) | ||
| 3032 | 1) ;; signal the error to the caller | ||
| 3033 | ) | ||
| 3034 | (pop-to-buffer "*vc*") | ||
| 3035 | (error "Couldn't analyze cvs update result")))) | ||
| 3036 | (message "Merging changes into %s...done" file))) | ||
| 3037 | |||
| 3038 | (defun vc-backend-merge (file first-version &optional second-version) | ||
| 3039 | ;; Merge the changes between FIRST-VERSION and SECOND-VERSION into | ||
| 3040 | ;; the current working copy of FILE. It is assumed that FILE is | ||
| 3041 | ;; locked and writable (vc-merge ensures this). | ||
| 3042 | (vc-backend-dispatch file | ||
| 3043 | ;; SCCS | ||
| 3044 | (error "Sorry, merging is not implemented for SCCS") | ||
| 3045 | ;; RCS | ||
| 3046 | (vc-do-command nil 1 "rcsmerge" file 'MASTER | ||
| 3047 | "-kk" ;; ignore keyword conflicts | ||
| 3048 | (concat "-r" first-version) | ||
| 3049 | (if second-version (concat "-r" second-version))) | ||
| 3050 | ;; CVS | ||
| 3051 | (progn | ||
| 3052 | (vc-do-command nil 0 "cvs" file 'WORKFILE | ||
| 3053 | "update" "-kk" | ||
| 3054 | (concat "-j" first-version) | ||
| 3055 | (concat "-j" second-version)) | ||
| 3056 | (save-excursion | ||
| 3057 | (set-buffer (get-buffer "*vc*")) | ||
| 3058 | (goto-char (point-min)) | ||
| 3059 | (if (re-search-forward "conflicts during merge" nil t) | ||
| 3060 | 1 ;; signal error | ||
| 3061 | 0 ;; signal success | ||
| 3062 | ))))) | ||
| 3063 | 2499 | ||
| 3064 | (defun vc-check-headers () | 2500 | (defun vc-check-headers () |
| 3065 | "Check if the current file has any headers in it." | 2501 | "Check if the current file has any headers in it." |
| 3066 | (interactive) | 2502 | (interactive) |
| 3067 | (save-excursion | 2503 | (vc-call-backend (vc-backend buffer-file-name) 'check-headers)) |
| 3068 | (goto-char (point-min)) | ||
| 3069 | (vc-backend-dispatch buffer-file-name | ||
| 3070 | (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ;; SCCS | ||
| 3071 | (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ;; RCS | ||
| 3072 | 'RCS ;; CVS works like RCS in this regard. | ||
| 3073 | ) | ||
| 3074 | )) | ||
| 3075 | 2504 | ||
| 3076 | ;; Back-end-dependent stuff ends here. | 2505 | ;; Back-end-dependent stuff ends here. |
| 3077 | 2506 | ||
| 3078 | ;; Set up key bindings for use while editing log messages | 2507 | ;; Set up key bindings for use while editing log messages |
| 3079 | 2508 | ||
| 3080 | (defun vc-log-mode (&optional file) | 2509 | (defun vc-log-mode (&optional file) |
| 3081 | "Minor mode for driving version-control tools. | 2510 | "Major mode for editing VC log entries. |
| 3082 | These bindings are added to the global keymap when you enter this mode: | 2511 | These bindings are added to the global keymap when you enter this mode: |
| 3083 | \\[vc-next-action] perform next logical version-control operation on current file | 2512 | \\[vc-next-action] perform next logical version-control operation on current file |
| 3084 | \\[vc-register] register current file | 2513 | \\[vc-register] register current file |
| 3085 | \\[vc-toggle-read-only] like next-action, but won't register files | 2514 | \\[vc-toggle-read-only] like next-action, but won't register files |
| 3086 | \\[vc-insert-headers] insert version-control headers in current file | 2515 | \\[vc-insert-headers] insert version-control headers in current file |
| 3087 | \\[vc-print-log] display change history of current file | 2516 | \\[vc-print-log] display change history of current file |
| @@ -3090,7 +2519,7 @@ These bindings are added to the global keymap when you enter this mode: | |||
| 3090 | \\[vc-diff] show diffs between file versions | 2519 | \\[vc-diff] show diffs between file versions |
| 3091 | \\[vc-version-other-window] visit old version in another window | 2520 | \\[vc-version-other-window] visit old version in another window |
| 3092 | \\[vc-directory] show all files locked by any user in or below . | 2521 | \\[vc-directory] show all files locked by any user in or below . |
| 3093 | \\[vc-annotate] colorful display of the cvs annotate command | 2522 | \\[vc-annotate] colorful display of the cvs annotate command |
| 3094 | \\[vc-update-change-log] add change log entry from recent checkins | 2523 | \\[vc-update-change-log] add change log entry from recent checkins |
| 3095 | 2524 | ||
| 3096 | While you are entering a change log message for a version, the following | 2525 | While you are entering a change log message for a version, the following |
| @@ -3106,39 +2535,39 @@ saved comments. These can be recalled as follows: | |||
| 3106 | \\[vc-comment-search-reverse] search backward for regexp in the comment ring | 2535 | \\[vc-comment-search-reverse] search backward for regexp in the comment ring |
| 3107 | \\[vc-comment-search-forward] search backward for regexp in the comment ring | 2536 | \\[vc-comment-search-forward] search backward for regexp in the comment ring |
| 3108 | 2537 | ||
| 3109 | Entry to the change-log submode calls the value of text-mode-hook, then | 2538 | Entry to the change-log submode calls the value of `text-mode-hook', then |
| 3110 | the value of vc-log-mode-hook. | 2539 | the value of `vc-log-mode-hook'. |
| 3111 | 2540 | ||
| 3112 | Global user options: | 2541 | Global user options: |
| 3113 | vc-initial-comment If non-nil, require user to enter a change | 2542 | `vc-initial-comment' If non-nil, require user to enter a change |
| 3114 | comment upon first checkin of the file. | 2543 | comment upon first checkin of the file. |
| 3115 | 2544 | ||
| 3116 | vc-keep-workfiles Non-nil value prevents workfiles from being | 2545 | `vc-keep-workfiles' Non-nil value prevents workfiles from being |
| 3117 | deleted when changes are checked in | 2546 | deleted when changes are checked in |
| 3118 | 2547 | ||
| 3119 | vc-suppress-confirm Suppresses some confirmation prompts, | 2548 | `vc-suppress-confirm' Suppresses some confirmation prompts, |
| 3120 | notably for reversions. | 2549 | notably for reversions. |
| 3121 | 2550 | ||
| 3122 | vc-header-alist Which keywords to insert when adding headers | 2551 | vc-BACKEND-header Which keywords to insert when adding headers |
| 3123 | with \\[vc-insert-headers]. Defaults to | 2552 | with \\[vc-insert-headers]. Defaults to |
| 3124 | '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under | 2553 | '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under |
| 3125 | RCS and CVS. | 2554 | RCS and CVS. |
| 3126 | 2555 | ||
| 3127 | vc-static-header-alist By default, version headers inserted in C files | 2556 | `vc-static-header-alist' By default, version headers inserted in C files |
| 3128 | get stuffed in a static string area so that | 2557 | get stuffed in a static string area so that |
| 3129 | ident(RCS/CVS) or what(SCCS) can see them in | 2558 | ident(RCS/CVS) or what(SCCS) can see them in |
| 3130 | the compiled object code. You can override | 2559 | the compiled object code. You can override |
| 3131 | this by setting this variable to nil, or change | 2560 | this by setting this variable to nil, or change |
| 3132 | the header template by changing it. | 2561 | the header template by changing it. |
| 3133 | 2562 | ||
| 3134 | vc-command-messages if non-nil, display run messages from the | 2563 | `vc-command-messages' if non-nil, display run messages from the |
| 3135 | actual version-control utilities (this is | 2564 | actual version-control utilities (this is |
| 3136 | intended primarily for people hacking vc | 2565 | intended primarily for people hacking vc |
| 3137 | itself). | 2566 | itself). |
| 3138 | " | 2567 | " |
| 3139 | (interactive) | 2568 | (interactive) |
| 3140 | (set-syntax-table text-mode-syntax-table) | 2569 | (set-syntax-table text-mode-syntax-table) |
| 3141 | (use-local-map vc-log-entry-mode) | 2570 | (use-local-map vc-log-mode-map) |
| 3142 | (setq local-abbrev-table text-mode-abbrev-table) | 2571 | (setq local-abbrev-table text-mode-abbrev-table) |
| 3143 | (setq major-mode 'vc-log-mode) | 2572 | (setq major-mode 'vc-log-mode) |
| 3144 | (setq mode-name "VC-Log") | 2573 | (setq mode-name "VC-Log") |
| @@ -3148,43 +2577,39 @@ Global user options: | |||
| 3148 | (make-local-variable 'vc-comment-ring-index) | 2577 | (make-local-variable 'vc-comment-ring-index) |
| 3149 | (set-buffer-modified-p nil) | 2578 | (set-buffer-modified-p nil) |
| 3150 | (setq buffer-file-name nil) | 2579 | (setq buffer-file-name nil) |
| 3151 | (run-hooks 'text-mode-hook 'vc-log-mode-hook) | 2580 | (run-hooks 'text-mode-hook 'vc-log-mode-hook)) |
| 3152 | ) | 2581 | |
| 3153 | 2582 | (defun vc-log-edit (file) | |
| 3154 | ;; Initialization code, to be done just once at load-time | 2583 | "Interface between VC and `log-edit'." |
| 3155 | (if vc-log-entry-mode | 2584 | (setq default-directory (file-name-directory file)) |
| 3156 | nil | 2585 | (log-edit 'vc-finish-logentry nil |
| 3157 | (setq vc-log-entry-mode (make-sparse-keymap)) | 2586 | `(lambda () ',(list (file-name-nondirectory file)))) |
| 3158 | (define-key vc-log-entry-mode "\M-n" 'vc-next-comment) | 2587 | (set (make-local-variable 'vc-log-file) file) |
| 3159 | (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment) | 2588 | (make-local-variable 'vc-log-version) |
| 3160 | (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse) | 2589 | (setq buffer-file-name nil)) |
| 3161 | (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward) | ||
| 3162 | (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry) | ||
| 3163 | ) | ||
| 3164 | 2590 | ||
| 3165 | ;;; These things should probably be generally available | 2591 | ;;; These things should probably be generally available |
| 3166 | 2592 | ||
| 3167 | (defun vc-file-tree-walk (dirname func &rest args) | 2593 | (defun vc-file-tree-walk (dirname func &rest args) |
| 3168 | "Walk recursively through DIRNAME. | 2594 | "Walk recursively through DIRNAME. |
| 3169 | Invoke FUNC f ARGS on each non-directory file f underneath it." | 2595 | Invoke FUNC f ARGS on each VC-managed file f underneath it." |
| 3170 | (vc-file-tree-walk-internal (expand-file-name dirname) func args) | 2596 | (vc-file-tree-walk-internal (expand-file-name dirname) func args) |
| 3171 | (message "Traversing directory %s...done" dirname)) | 2597 | (message "Traversing directory %s...done" dirname)) |
| 3172 | 2598 | ||
| 3173 | (defun vc-file-tree-walk-internal (file func args) | 2599 | (defun vc-file-tree-walk-internal (file func args) |
| 3174 | (if (not (file-directory-p file)) | 2600 | (if (not (file-directory-p file)) |
| 3175 | (apply func file args) | 2601 | (if (vc-backend file) (apply func file args)) |
| 3176 | (message "Traversing directory %s..." (abbreviate-file-name file)) | 2602 | (message "Traversing directory %s..." (abbreviate-file-name file)) |
| 3177 | (let ((dir (file-name-as-directory file))) | 2603 | (let ((dir (file-name-as-directory file))) |
| 3178 | (mapcar | 2604 | (mapcar |
| 3179 | (function | 2605 | (lambda (f) (or |
| 3180 | (lambda (f) (or | 2606 | (string-equal f ".") |
| 3181 | (string-equal f ".") | 2607 | (string-equal f "..") |
| 3182 | (string-equal f "..") | 2608 | (member f vc-directory-exclusion-list) |
| 3183 | (member f vc-directory-exclusion-list) | 2609 | (let ((dirf (expand-file-name f dir))) |
| 3184 | (let ((dirf (concat dir f))) | 2610 | (or |
| 3185 | (or | 2611 | (file-symlink-p dirf);; Avoid possible loops |
| 3186 | (file-symlink-p dirf) ;; Avoid possible loops | 2612 | (vc-file-tree-walk-internal dirf func args))))) |
| 3187 | (vc-file-tree-walk-internal dirf func args)))))) | ||
| 3188 | (directory-files dir))))) | 2613 | (directory-files dir))))) |
| 3189 | 2614 | ||
| 3190 | (provide 'vc) | 2615 | (provide 'vc) |
| @@ -3195,61 +2620,61 @@ Invoke FUNC f ARGS on each non-directory file f underneath it." | |||
| 3195 | ;;; (Note that this information corresponds to versions 5.x. Some of it | 2620 | ;;; (Note that this information corresponds to versions 5.x. Some of it |
| 3196 | ;;; might have been invalidated by the additions to support branching | 2621 | ;;; might have been invalidated by the additions to support branching |
| 3197 | ;;; and RCS keyword lookup. AS, 1995/03/24) | 2622 | ;;; and RCS keyword lookup. AS, 1995/03/24) |
| 3198 | ;;; | 2623 | ;;; |
| 3199 | ;;; A fundamental problem in VC is that there are time windows between | 2624 | ;;; A fundamental problem in VC is that there are time windows between |
| 3200 | ;;; vc-next-action's computations of the file's version-control state and | 2625 | ;;; vc-next-action's computations of the file's version-control state and |
| 3201 | ;;; the actions that change it. This is a window open to lossage in a | 2626 | ;;; the actions that change it. This is a window open to lossage in a |
| 3202 | ;;; multi-user environment; someone else could nip in and change the state | 2627 | ;;; multi-user environment; someone else could nip in and change the state |
| 3203 | ;;; of the master during it. | 2628 | ;;; of the master during it. |
| 3204 | ;;; | 2629 | ;;; |
| 3205 | ;;; The performance problem is that rlog/prs calls are very expensive; we want | 2630 | ;;; The performance problem is that rlog/prs calls are very expensive; we want |
| 3206 | ;;; to avoid them as much as possible. | 2631 | ;;; to avoid them as much as possible. |
| 3207 | ;;; | 2632 | ;;; |
| 3208 | ;;; ANALYSIS: | 2633 | ;;; ANALYSIS: |
| 3209 | ;;; | 2634 | ;;; |
| 3210 | ;;; The performance problem, it turns out, simplifies in practice to the | 2635 | ;;; The performance problem, it turns out, simplifies in practice to the |
| 3211 | ;;; problem of making vc-locking-user fast. The two other functions that call | 2636 | ;;; problem of making vc-state fast. The two other functions that call |
| 3212 | ;;; prs/rlog will not be so commonly used that the slowdown is a problem; one | 2637 | ;;; prs/rlog will not be so commonly used that the slowdown is a problem; one |
| 3213 | ;;; makes snapshots, the other deletes the calling user's last change in the | 2638 | ;;; makes snapshots, the other deletes the calling user's last change in the |
| 3214 | ;;; master. | 2639 | ;;; master. |
| 3215 | ;;; | 2640 | ;;; |
| 3216 | ;;; The race condition implies that we have to either (a) lock the master | 2641 | ;;; The race condition implies that we have to either (a) lock the master |
| 3217 | ;;; during the entire execution of vc-next-action, or (b) detect and | 2642 | ;;; during the entire execution of vc-next-action, or (b) detect and |
| 3218 | ;;; recover from errors resulting from dispatch on an out-of-date state. | 2643 | ;;; recover from errors resulting from dispatch on an out-of-date state. |
| 3219 | ;;; | 2644 | ;;; |
| 3220 | ;;; Alternative (a) appears to be infeasible. The problem is that we can't | 2645 | ;;; Alternative (a) appears to be infeasible. The problem is that we can't |
| 3221 | ;;; guarantee that the lock will ever be removed. Suppose a user starts a | 2646 | ;;; guarantee that the lock will ever be removed. Suppose a user starts a |
| 3222 | ;;; checkin, the change message buffer pops up, and the user, having wandered | 2647 | ;;; checkin, the change message buffer pops up, and the user, having wandered |
| 3223 | ;;; off to do something else, simply forgets about it? | 2648 | ;;; off to do something else, simply forgets about it? |
| 3224 | ;;; | 2649 | ;;; |
| 3225 | ;;; Alternative (b), on the other hand, works well with a cheap way to speed up | 2650 | ;;; Alternative (b), on the other hand, works well with a cheap way to speed up |
| 3226 | ;;; vc-locking-user. Usually, if a file is registered, we can read its locked/ | 2651 | ;;; vc-state. Usually, if a file is registered, we can read its locked/ |
| 3227 | ;;; unlocked state and its current owner from its permissions. | 2652 | ;;; unlocked state and its current owner from its permissions. |
| 3228 | ;;; | 2653 | ;;; |
| 3229 | ;;; This shortcut will fail if someone has manually changed the workfile's | 2654 | ;;; This shortcut will fail if someone has manually changed the workfile's |
| 3230 | ;;; permissions; also if developers are munging the workfile in several | 2655 | ;;; permissions; also if developers are munging the workfile in several |
| 3231 | ;;; directories, with symlinks to a master (in this latter case, the | 2656 | ;;; directories, with symlinks to a master (in this latter case, the |
| 3232 | ;;; permissions shortcut will fail to detect a lock asserted from another | 2657 | ;;; permissions shortcut will fail to detect a lock asserted from another |
| 3233 | ;;; directory). | 2658 | ;;; directory). |
| 3234 | ;;; | 2659 | ;;; |
| 3235 | ;;; Note that these cases correspond exactly to the errors which could happen | 2660 | ;;; Note that these cases correspond exactly to the errors which could happen |
| 3236 | ;;; because of a competing checkin/checkout race in between two instances of | 2661 | ;;; because of a competing checkin/checkout race in between two instances of |
| 3237 | ;;; vc-next-action. | 2662 | ;;; vc-next-action. |
| 3238 | ;;; | 2663 | ;;; |
| 3239 | ;;; For VC's purposes, a workfile/master pair may have the following states: | 2664 | ;;; For VC's purposes, a workfile/master pair may have the following states: |
| 3240 | ;;; | 2665 | ;;; |
| 3241 | ;;; A. Unregistered. There is a workfile, there is no master. | 2666 | ;;; A. Unregistered. There is a workfile, there is no master. |
| 3242 | ;;; | 2667 | ;;; |
| 3243 | ;;; B. Registered and not locked by anyone. | 2668 | ;;; B. Registered and not locked by anyone. |
| 3244 | ;;; | 2669 | ;;; |
| 3245 | ;;; C. Locked by calling user and unchanged. | 2670 | ;;; C. Locked by calling user and unchanged. |
| 3246 | ;;; | 2671 | ;;; |
| 3247 | ;;; D. Locked by the calling user and changed. | 2672 | ;;; D. Locked by the calling user and changed. |
| 3248 | ;;; | 2673 | ;;; |
| 3249 | ;;; E. Locked by someone other than the calling user. | 2674 | ;;; E. Locked by someone other than the calling user. |
| 3250 | ;;; | 2675 | ;;; |
| 3251 | ;;; This makes for 25 states and 20 error conditions. Here's the matrix: | 2676 | ;;; This makes for 25 states and 20 error conditions. Here's the matrix: |
| 3252 | ;;; | 2677 | ;;; |
| 3253 | ;;; VC's idea of state | 2678 | ;;; VC's idea of state |
| 3254 | ;;; | | 2679 | ;;; | |
| 3255 | ;;; V Actual state RCS action SCCS action Effect | 2680 | ;;; V Actual state RCS action SCCS action Effect |
| @@ -3259,280 +2684,280 @@ Invoke FUNC f ARGS on each non-directory file f underneath it." | |||
| 3259 | ;;; C 9 10 . 11 12 co -u unget; get revert | 2684 | ;;; C 9 10 . 11 12 co -u unget; get revert |
| 3260 | ;;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin | 2685 | ;;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin |
| 3261 | ;;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock | 2686 | ;;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock |
| 3262 | ;;; | 2687 | ;;; |
| 3263 | ;;; All commands take the master file name as a last argument (not shown). | 2688 | ;;; All commands take the master file name as a last argument (not shown). |
| 3264 | ;;; | 2689 | ;;; |
| 3265 | ;;; In the discussion below, a "self-race" is a pathological situation in | 2690 | ;;; In the discussion below, a "self-race" is a pathological situation in |
| 3266 | ;;; which VC operations are being attempted simultaneously by two or more | 2691 | ;;; which VC operations are being attempted simultaneously by two or more |
| 3267 | ;;; Emacsen running under the same username. | 2692 | ;;; Emacsen running under the same username. |
| 3268 | ;;; | 2693 | ;;; |
| 3269 | ;;; The vc-next-action code has the following windows: | 2694 | ;;; The vc-next-action code has the following windows: |
| 3270 | ;;; | 2695 | ;;; |
| 3271 | ;;; Window P: | 2696 | ;;; Window P: |
| 3272 | ;;; Between the check for existence of a master file and the call to | 2697 | ;;; Between the check for existence of a master file and the call to |
| 3273 | ;;; admin/checkin in vc-buffer-admin (apparent state A). This window may | 2698 | ;;; admin/checkin in vc-buffer-admin (apparent state A). This window may |
| 3274 | ;;; never close if the initial-comment feature is on. | 2699 | ;;; never close if the initial-comment feature is on. |
| 3275 | ;;; | 2700 | ;;; |
| 3276 | ;;; Window Q: | 2701 | ;;; Window Q: |
| 3277 | ;;; Between the call to vc-workfile-unchanged-p in and the immediately | 2702 | ;;; Between the call to vc-workfile-unchanged-p in and the immediately |
| 3278 | ;;; following revert (apparent state C). | 2703 | ;;; following revert (apparent state C). |
| 3279 | ;;; | 2704 | ;;; |
| 3280 | ;;; Window R: | 2705 | ;;; Window R: |
| 3281 | ;;; Between the call to vc-workfile-unchanged-p in and the following | 2706 | ;;; Between the call to vc-workfile-unchanged-p in and the following |
| 3282 | ;;; checkin (apparent state D). This window may never close. | 2707 | ;;; checkin (apparent state D). This window may never close. |
| 3283 | ;;; | 2708 | ;;; |
| 3284 | ;;; Window S: | 2709 | ;;; Window S: |
| 3285 | ;;; Between the unlock and the immediately following checkout during a | 2710 | ;;; Between the unlock and the immediately following checkout during a |
| 3286 | ;;; revert operation (apparent state C). Included in window Q. | 2711 | ;;; revert operation (apparent state C). Included in window Q. |
| 3287 | ;;; | 2712 | ;;; |
| 3288 | ;;; Window T: | 2713 | ;;; Window T: |
| 3289 | ;;; Between vc-locking-user and the following checkout (apparent state B). | 2714 | ;;; Between vc-state and the following checkout (apparent state B). |
| 3290 | ;;; | 2715 | ;;; |
| 3291 | ;;; Window U: | 2716 | ;;; Window U: |
| 3292 | ;;; Between vc-locking-user and the following revert (apparent state C). | 2717 | ;;; Between vc-state and the following revert (apparent state C). |
| 3293 | ;;; Includes windows Q and S. | 2718 | ;;; Includes windows Q and S. |
| 3294 | ;;; | 2719 | ;;; |
| 3295 | ;;; Window V: | 2720 | ;;; Window V: |
| 3296 | ;;; Between vc-locking-user and the following checkin (apparent state | 2721 | ;;; Between vc-state and the following checkin (apparent state |
| 3297 | ;;; D). This window may never be closed if the user fails to complete the | 2722 | ;;; D). This window may never be closed if the user fails to complete the |
| 3298 | ;;; checkin message. Includes window R. | 2723 | ;;; checkin message. Includes window R. |
| 3299 | ;;; | 2724 | ;;; |
| 3300 | ;;; Window W: | 2725 | ;;; Window W: |
| 3301 | ;;; Between vc-locking-user and the following steal-lock (apparent | 2726 | ;;; Between vc-state and the following steal-lock (apparent |
| 3302 | ;;; state E). This window may never close if the user fails to complete | 2727 | ;;; state E). This window may never close if the user fails to complete |
| 3303 | ;;; the steal-lock message. Includes window X. | 2728 | ;;; the steal-lock message. Includes window X. |
| 3304 | ;;; | 2729 | ;;; |
| 3305 | ;;; Window X: | 2730 | ;;; Window X: |
| 3306 | ;;; Between the unlock and the immediately following re-lock during a | 2731 | ;;; Between the unlock and the immediately following re-lock during a |
| 3307 | ;;; steal-lock operation (apparent state E). This window may never cloce | 2732 | ;;; steal-lock operation (apparent state E). This window may never close |
| 3308 | ;;; if the user fails to complete the steal-lock message. | 2733 | ;;; if the user fails to complete the steal-lock message. |
| 3309 | ;;; | 2734 | ;;; |
| 3310 | ;;; Errors: | 2735 | ;;; Errors: |
| 3311 | ;;; | 2736 | ;;; |
| 3312 | ;;; Apparent state A --- | 2737 | ;;; Apparent state A --- |
| 3313 | ;;; | 2738 | ;;; |
| 3314 | ;;; 1. File looked unregistered but is actually registered and not locked. | 2739 | ;;; 1. File looked unregistered but is actually registered and not locked. |
| 3315 | ;;; | 2740 | ;;; |
| 3316 | ;;; Potential cause: someone else's admin during window P, with | 2741 | ;;; Potential cause: someone else's admin during window P, with |
| 3317 | ;;; caller's admin happening before their checkout. | 2742 | ;;; caller's admin happening before their checkout. |
| 3318 | ;;; | 2743 | ;;; |
| 3319 | ;;; RCS: Prior to version 5.6.4, ci fails with message | 2744 | ;;; RCS: Prior to version 5.6.4, ci fails with message |
| 3320 | ;;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new | 2745 | ;;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new |
| 3321 | ;;; ci -i option and the message is "<file>,v: already exists". | 2746 | ;;; ci -i option and the message is "<file>,v: already exists". |
| 3322 | ;;; SCCS: admin will fail with error (ad19). | 2747 | ;;; SCCS: admin will fail with error (ad19). |
| 3323 | ;;; | 2748 | ;;; |
| 3324 | ;;; We can let these errors be passed up to the user. | 2749 | ;;; We can let these errors be passed up to the user. |
| 3325 | ;;; | 2750 | ;;; |
| 3326 | ;;; 2. File looked unregistered but is actually locked by caller, unchanged. | 2751 | ;;; 2. File looked unregistered but is actually locked by caller, unchanged. |
| 3327 | ;;; | 2752 | ;;; |
| 3328 | ;;; Potential cause: self-race during window P. | 2753 | ;;; Potential cause: self-race during window P. |
| 3329 | ;;; | 2754 | ;;; |
| 3330 | ;;; RCS: Prior to version 5.6.4, reverts the file to the last saved | 2755 | ;;; RCS: Prior to version 5.6.4, reverts the file to the last saved |
| 3331 | ;;; version and unlocks it. From 5.6.4 onwards, VC uses the new | 2756 | ;;; version and unlocks it. From 5.6.4 onwards, VC uses the new |
| 3332 | ;;; ci -i option, failing with message "<file>,v: already exists". | 2757 | ;;; ci -i option, failing with message "<file>,v: already exists". |
| 3333 | ;;; SCCS: will fail with error (ad19). | 2758 | ;;; SCCS: will fail with error (ad19). |
| 3334 | ;;; | 2759 | ;;; |
| 3335 | ;;; Either of these consequences is acceptable. | 2760 | ;;; Either of these consequences is acceptable. |
| 3336 | ;;; | 2761 | ;;; |
| 3337 | ;;; 3. File looked unregistered but is actually locked by caller, changed. | 2762 | ;;; 3. File looked unregistered but is actually locked by caller, changed. |
| 3338 | ;;; | 2763 | ;;; |
| 3339 | ;;; Potential cause: self-race during window P. | 2764 | ;;; Potential cause: self-race during window P. |
| 3340 | ;;; | 2765 | ;;; |
| 3341 | ;;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as | 2766 | ;;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as |
| 3342 | ;;; a delta with a null change comment (the -t- switch will be | 2767 | ;;; a delta with a null change comment (the -t- switch will be |
| 3343 | ;;; ignored). From 5.6.4 onwards, VC uses the new ci -i option, | 2768 | ;;; ignored). From 5.6.4 onwards, VC uses the new ci -i option, |
| 3344 | ;;; failing with message "<file>,v: already exists". | 2769 | ;;; failing with message "<file>,v: already exists". |
| 3345 | ;;; SCCS: will fail with error (ad19). | 2770 | ;;; SCCS: will fail with error (ad19). |
| 3346 | ;;; | 2771 | ;;; |
| 3347 | ;;; 4. File looked unregistered but is locked by someone else. | 2772 | ;;; 4. File looked unregistered but is locked by someone else. |
| 3348 | ;;; | 2773 | ;;; |
| 3349 | ;;; Potential cause: someone else's admin during window P, with | 2774 | ;;; Potential cause: someone else's admin during window P, with |
| 3350 | ;;; caller's admin happening *after* their checkout. | 2775 | ;;; caller's admin happening *after* their checkout. |
| 3351 | ;;; | 2776 | ;;; |
| 3352 | ;;; RCS: Prior to version 5.6.4, ci fails with a | 2777 | ;;; RCS: Prior to version 5.6.4, ci fails with a |
| 3353 | ;;; "no lock set by <user>" message. From 5.6.4 onwards, | 2778 | ;;; "no lock set by <user>" message. From 5.6.4 onwards, |
| 3354 | ;;; VC uses the new ci -i option, failing with message | 2779 | ;;; VC uses the new ci -i option, failing with message |
| 3355 | ;;; "<file>,v: already exists". | 2780 | ;;; "<file>,v: already exists". |
| 3356 | ;;; SCCS: will fail with error (ad19). | 2781 | ;;; SCCS: will fail with error (ad19). |
| 3357 | ;;; | 2782 | ;;; |
| 3358 | ;;; We can let these errors be passed up to the user. | 2783 | ;;; We can let these errors be passed up to the user. |
| 3359 | ;;; | 2784 | ;;; |
| 3360 | ;;; Apparent state B --- | 2785 | ;;; Apparent state B --- |
| 3361 | ;;; | 2786 | ;;; |
| 3362 | ;;; 5. File looked registered and not locked, but is actually unregistered. | 2787 | ;;; 5. File looked registered and not locked, but is actually unregistered. |
| 3363 | ;;; | 2788 | ;;; |
| 3364 | ;;; Potential cause: master file got nuked during window P. | 2789 | ;;; Potential cause: master file got nuked during window P. |
| 3365 | ;;; | 2790 | ;;; |
| 3366 | ;;; RCS: will fail with "RCS/<file>: No such file or directory" | 2791 | ;;; RCS: will fail with "RCS/<file>: No such file or directory" |
| 3367 | ;;; SCCS: will fail with error ut4. | 2792 | ;;; SCCS: will fail with error ut4. |
| 3368 | ;;; | 2793 | ;;; |
| 3369 | ;;; We can let these errors be passed up to the user. | 2794 | ;;; We can let these errors be passed up to the user. |
| 3370 | ;;; | 2795 | ;;; |
| 3371 | ;;; 6. File looked registered and not locked, but is actually locked by the | 2796 | ;;; 6. File looked registered and not locked, but is actually locked by the |
| 3372 | ;;; calling user and unchanged. | 2797 | ;;; calling user and unchanged. |
| 3373 | ;;; | 2798 | ;;; |
| 3374 | ;;; Potential cause: self-race during window T. | 2799 | ;;; Potential cause: self-race during window T. |
| 3375 | ;;; | 2800 | ;;; |
| 3376 | ;;; RCS: in the same directory as the previous workfile, co -l will fail | 2801 | ;;; RCS: in the same directory as the previous workfile, co -l will fail |
| 3377 | ;;; with "co error: writable foo exists; checkout aborted". In any other | 2802 | ;;; with "co error: writable foo exists; checkout aborted". In any other |
| 3378 | ;;; directory, checkout will succeed. | 2803 | ;;; directory, checkout will succeed. |
| 3379 | ;;; SCCS: will fail with ge17. | 2804 | ;;; SCCS: will fail with ge17. |
| 3380 | ;;; | 2805 | ;;; |
| 3381 | ;;; Either of these consequences is acceptable. | 2806 | ;;; Either of these consequences is acceptable. |
| 3382 | ;;; | 2807 | ;;; |
| 3383 | ;;; 7. File looked registered and not locked, but is actually locked by the | 2808 | ;;; 7. File looked registered and not locked, but is actually locked by the |
| 3384 | ;;; calling user and changed. | 2809 | ;;; calling user and changed. |
| 3385 | ;;; | 2810 | ;;; |
| 3386 | ;;; As case 6. | 2811 | ;;; As case 6. |
| 3387 | ;;; | 2812 | ;;; |
| 3388 | ;;; 8. File looked registered and not locked, but is actually locked by another | 2813 | ;;; 8. File looked registered and not locked, but is actually locked by another |
| 3389 | ;;; user. | 2814 | ;;; user. |
| 3390 | ;;; | 2815 | ;;; |
| 3391 | ;;; Potential cause: someone else checks it out during window T. | 2816 | ;;; Potential cause: someone else checks it out during window T. |
| 3392 | ;;; | 2817 | ;;; |
| 3393 | ;;; RCS: co error: revision 1.3 already locked by <user> | 2818 | ;;; RCS: co error: revision 1.3 already locked by <user> |
| 3394 | ;;; SCCS: fails with ge4 (in directory) or ut7 (outside it). | 2819 | ;;; SCCS: fails with ge4 (in directory) or ut7 (outside it). |
| 3395 | ;;; | 2820 | ;;; |
| 3396 | ;;; We can let these errors be passed up to the user. | 2821 | ;;; We can let these errors be passed up to the user. |
| 3397 | ;;; | 2822 | ;;; |
| 3398 | ;;; Apparent state C --- | 2823 | ;;; Apparent state C --- |
| 3399 | ;;; | 2824 | ;;; |
| 3400 | ;;; 9. File looks locked by calling user and unchanged, but is unregistered. | 2825 | ;;; 9. File looks locked by calling user and unchanged, but is unregistered. |
| 3401 | ;;; | 2826 | ;;; |
| 3402 | ;;; As case 5. | 2827 | ;;; As case 5. |
| 3403 | ;;; | 2828 | ;;; |
| 3404 | ;;; 10. File looks locked by calling user and unchanged, but is actually not | 2829 | ;;; 10. File looks locked by calling user and unchanged, but is actually not |
| 3405 | ;;; locked. | 2830 | ;;; locked. |
| 3406 | ;;; | 2831 | ;;; |
| 3407 | ;;; Potential cause: a self-race in window U, or by the revert's | 2832 | ;;; Potential cause: a self-race in window U, or by the revert's |
| 3408 | ;;; landing during window X of some other user's steal-lock or window S | 2833 | ;;; landing during window X of some other user's steal-lock or window S |
| 3409 | ;;; of another user's revert. | 2834 | ;;; of another user's revert. |
| 3410 | ;;; | 2835 | ;;; |
| 3411 | ;;; RCS: succeeds, refreshing the file from the identical version in | 2836 | ;;; RCS: succeeds, refreshing the file from the identical version in |
| 3412 | ;;; the master. | 2837 | ;;; the master. |
| 3413 | ;;; SCCS: fails with error ut4 (p file nonexistent). | 2838 | ;;; SCCS: fails with error ut4 (p file nonexistent). |
| 3414 | ;;; | 2839 | ;;; |
| 3415 | ;;; Either of these consequences is acceptable. | 2840 | ;;; Either of these consequences is acceptable. |
| 3416 | ;;; | 2841 | ;;; |
| 3417 | ;;; 11. File is locked by calling user. It looks unchanged, but is actually | 2842 | ;;; 11. File is locked by calling user. It looks unchanged, but is actually |
| 3418 | ;;; changed. | 2843 | ;;; changed. |
| 3419 | ;;; | 2844 | ;;; |
| 3420 | ;;; Potential cause: the file would have to be touched by a self-race | 2845 | ;;; Potential cause: the file would have to be touched by a self-race |
| 3421 | ;;; during window Q. | 2846 | ;;; during window Q. |
| 3422 | ;;; | 2847 | ;;; |
| 3423 | ;;; The revert will succeed, removing whatever changes came with | 2848 | ;;; The revert will succeed, removing whatever changes came with |
| 3424 | ;;; the touch. It is theoretically possible that work could be lost. | 2849 | ;;; the touch. It is theoretically possible that work could be lost. |
| 3425 | ;;; | 2850 | ;;; |
| 3426 | ;;; 12. File looks like it's locked by the calling user and unchanged, but | 2851 | ;;; 12. File looks like it's locked by the calling user and unchanged, but |
| 3427 | ;;; it's actually locked by someone else. | 2852 | ;;; it's actually locked by someone else. |
| 3428 | ;;; | 2853 | ;;; |
| 3429 | ;;; Potential cause: a steal-lock in window V. | 2854 | ;;; Potential cause: a steal-lock in window V. |
| 3430 | ;;; | 2855 | ;;; |
| 3431 | ;;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u | 2856 | ;;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u |
| 3432 | ;;; SCCS: fails with error un2 | 2857 | ;;; SCCS: fails with error un2 |
| 3433 | ;;; | 2858 | ;;; |
| 3434 | ;;; We can pass these errors up to the user. | 2859 | ;;; We can pass these errors up to the user. |
| 3435 | ;;; | 2860 | ;;; |
| 3436 | ;;; Apparent state D --- | 2861 | ;;; Apparent state D --- |
| 3437 | ;;; | 2862 | ;;; |
| 3438 | ;;; 13. File looks like it's locked by the calling user and changed, but it's | 2863 | ;;; 13. File looks like it's locked by the calling user and changed, but it's |
| 3439 | ;;; actually unregistered. | 2864 | ;;; actually unregistered. |
| 3440 | ;;; | 2865 | ;;; |
| 3441 | ;;; Potential cause: master file got nuked during window P. | 2866 | ;;; Potential cause: master file got nuked during window P. |
| 3442 | ;;; | 2867 | ;;; |
| 3443 | ;;; RCS: Prior to version 5.6.4, checks in the user's version as an | 2868 | ;;; RCS: Prior to version 5.6.4, checks in the user's version as an |
| 3444 | ;;; initial delta. From 5.6.4 onwards, VC uses the new ci -j | 2869 | ;;; initial delta. From 5.6.4 onwards, VC uses the new ci -j |
| 3445 | ;;; option, failing with message "no such file or directory". | 2870 | ;;; option, failing with message "no such file or directory". |
| 3446 | ;;; SCCS: will fail with error ut4. | 2871 | ;;; SCCS: will fail with error ut4. |
| 3447 | ;;; | 2872 | ;;; |
| 3448 | ;;; This case is kind of nasty. Under RCS prior to version 5.6.4, | 2873 | ;;; This case is kind of nasty. Under RCS prior to version 5.6.4, |
| 3449 | ;;; VC may fail to detect the loss of previous version information. | 2874 | ;;; VC may fail to detect the loss of previous version information. |
| 3450 | ;;; | 2875 | ;;; |
| 3451 | ;;; 14. File looks like it's locked by the calling user and changed, but it's | 2876 | ;;; 14. File looks like it's locked by the calling user and changed, but it's |
| 3452 | ;;; actually unlocked. | 2877 | ;;; actually unlocked. |
| 3453 | ;;; | 2878 | ;;; |
| 3454 | ;;; Potential cause: self-race in window V, or the checkin happening | 2879 | ;;; Potential cause: self-race in window V, or the checkin happening |
| 3455 | ;;; during the window X of someone else's steal-lock or window S of | 2880 | ;;; during the window X of someone else's steal-lock or window S of |
| 3456 | ;;; someone else's revert. | 2881 | ;;; someone else's revert. |
| 3457 | ;;; | 2882 | ;;; |
| 3458 | ;;; RCS: ci will fail with "no lock set by <user>". | 2883 | ;;; RCS: ci will fail with "no lock set by <user>". |
| 3459 | ;;; SCCS: delta will fail with error ut4. | 2884 | ;;; SCCS: delta will fail with error ut4. |
| 3460 | ;;; | 2885 | ;;; |
| 3461 | ;;; 15. File looks like it's locked by the calling user and changed, but it's | 2886 | ;;; 15. File looks like it's locked by the calling user and changed, but it's |
| 3462 | ;;; actually locked by the calling user and unchanged. | 2887 | ;;; actually locked by the calling user and unchanged. |
| 3463 | ;;; | 2888 | ;;; |
| 3464 | ;;; Potential cause: another self-race --- a whole checkin/checkout | 2889 | ;;; Potential cause: another self-race --- a whole checkin/checkout |
| 3465 | ;;; sequence by the calling user would have to land in window R. | 2890 | ;;; sequence by the calling user would have to land in window R. |
| 3466 | ;;; | 2891 | ;;; |
| 3467 | ;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual. | 2892 | ;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual. |
| 3468 | ;;; RCS: reverts to the file state as of the second user's checkin, leaving | 2893 | ;;; RCS: reverts to the file state as of the second user's checkin, leaving |
| 3469 | ;;; the file unlocked. | 2894 | ;;; the file unlocked. |
| 3470 | ;;; | 2895 | ;;; |
| 3471 | ;;; It is theoretically possible that work could be lost under RCS. | 2896 | ;;; It is theoretically possible that work could be lost under RCS. |
| 3472 | ;;; | 2897 | ;;; |
| 3473 | ;;; 16. File looks like it's locked by the calling user and changed, but it's | 2898 | ;;; 16. File looks like it's locked by the calling user and changed, but it's |
| 3474 | ;;; actually locked by a different user. | 2899 | ;;; actually locked by a different user. |
| 3475 | ;;; | 2900 | ;;; |
| 3476 | ;;; RCS: ci error: no lock set by <user> | 2901 | ;;; RCS: ci error: no lock set by <user> |
| 3477 | ;;; SCCS: unget will fail with error un2 | 2902 | ;;; SCCS: unget will fail with error un2 |
| 3478 | ;;; | 2903 | ;;; |
| 3479 | ;;; We can pass these errors up to the user. | 2904 | ;;; We can pass these errors up to the user. |
| 3480 | ;;; | 2905 | ;;; |
| 3481 | ;;; Apparent state E --- | 2906 | ;;; Apparent state E --- |
| 3482 | ;;; | 2907 | ;;; |
| 3483 | ;;; 17. File looks like it's locked by some other user, but it's actually | 2908 | ;;; 17. File looks like it's locked by some other user, but it's actually |
| 3484 | ;;; unregistered. | 2909 | ;;; unregistered. |
| 3485 | ;;; | 2910 | ;;; |
| 3486 | ;;; As case 13. | 2911 | ;;; As case 13. |
| 3487 | ;;; | 2912 | ;;; |
| 3488 | ;;; 18. File looks like it's locked by some other user, but it's actually | 2913 | ;;; 18. File looks like it's locked by some other user, but it's actually |
| 3489 | ;;; unlocked. | 2914 | ;;; unlocked. |
| 3490 | ;;; | 2915 | ;;; |
| 3491 | ;;; Potential cause: someone released a lock during window W. | 2916 | ;;; Potential cause: someone released a lock during window W. |
| 3492 | ;;; | 2917 | ;;; |
| 3493 | ;;; RCS: The calling user will get the lock on the file. | 2918 | ;;; RCS: The calling user will get the lock on the file. |
| 3494 | ;;; SCCS: unget -n will fail with cm4. | 2919 | ;;; SCCS: unget -n will fail with cm4. |
| 3495 | ;;; | 2920 | ;;; |
| 3496 | ;;; Either of these consequences will be OK. | 2921 | ;;; Either of these consequences will be OK. |
| 3497 | ;;; | 2922 | ;;; |
| 3498 | ;;; 19. File looks like it's locked by some other user, but it's actually | 2923 | ;;; 19. File looks like it's locked by some other user, but it's actually |
| 3499 | ;;; locked by the calling user and unchanged. | 2924 | ;;; locked by the calling user and unchanged. |
| 3500 | ;;; | 2925 | ;;; |
| 3501 | ;;; Potential cause: the other user relinquishing a lock followed by | 2926 | ;;; Potential cause: the other user relinquishing a lock followed by |
| 3502 | ;;; a self-race, both in window W. | 2927 | ;;; a self-race, both in window W. |
| 3503 | ;;; | 2928 | ;;; |
| 3504 | ;;; Under both RCS and SCCS, both unlock and lock will succeed, making | 2929 | ;;; Under both RCS and SCCS, both unlock and lock will succeed, making |
| 3505 | ;;; the sequence a no-op. | 2930 | ;;; the sequence a no-op. |
| 3506 | ;;; | 2931 | ;;; |
| 3507 | ;;; 20. File looks like it's locked by some other user, but it's actually | 2932 | ;;; 20. File looks like it's locked by some other user, but it's actually |
| 3508 | ;;; locked by the calling user and changed. | 2933 | ;;; locked by the calling user and changed. |
| 3509 | ;;; | 2934 | ;;; |
| 3510 | ;;; As case 19. | 2935 | ;;; As case 19. |
| 3511 | ;;; | 2936 | ;;; |
| 3512 | ;;; PROBLEM CASES: | 2937 | ;;; PROBLEM CASES: |
| 3513 | ;;; | 2938 | ;;; |
| 3514 | ;;; In order of decreasing severity: | 2939 | ;;; In order of decreasing severity: |
| 3515 | ;;; | 2940 | ;;; |
| 3516 | ;;; Cases 11 and 15 are the only ones that potentially lose work. | 2941 | ;;; Cases 11 and 15 are the only ones that potentially lose work. |
| 3517 | ;;; They would require a self-race for this to happen. | 2942 | ;;; They would require a self-race for this to happen. |
| 3518 | ;;; | 2943 | ;;; |
| 3519 | ;;; Case 13 in RCS loses information about previous deltas, retaining | 2944 | ;;; Case 13 in RCS loses information about previous deltas, retaining |
| 3520 | ;;; only the information in the current workfile. This can only happen | 2945 | ;;; only the information in the current workfile. This can only happen |
| 3521 | ;;; if the master file gets nuked in window P. | 2946 | ;;; if the master file gets nuked in window P. |
| 3522 | ;;; | 2947 | ;;; |
| 3523 | ;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with | 2948 | ;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with |
| 3524 | ;;; no change comment in the master. This would require a self-race in | 2949 | ;;; no change comment in the master. This would require a self-race in |
| 3525 | ;;; window P or R respectively. | 2950 | ;;; window P or R respectively. |
| 3526 | ;;; | 2951 | ;;; |
| 3527 | ;;; Cases 2, 10, 19 and 20 do extra work, but make no changes. | 2952 | ;;; Cases 2, 10, 19 and 20 do extra work, but make no changes. |
| 3528 | ;;; | 2953 | ;;; |
| 3529 | ;;; Unfortunately, it appears to me that no recovery is possible in these | 2954 | ;;; Unfortunately, it appears to me that no recovery is possible in these |
| 3530 | ;;; cases. They don't yield error messages, so there's no way to tell that | 2955 | ;;; cases. They don't yield error messages, so there's no way to tell that |
| 3531 | ;;; a race condition has occurred. | 2956 | ;;; a race condition has occurred. |
| 3532 | ;;; | 2957 | ;;; |
| 3533 | ;;; All other cases don't change either the workfile or the master, and | 2958 | ;;; All other cases don't change either the workfile or the master, and |
| 3534 | ;;; trigger command errors which the user will see. | 2959 | ;;; trigger command errors which the user will see. |
| 3535 | ;;; | 2960 | ;;; |
| 3536 | ;;; Thus, there is no explicit recovery code. | 2961 | ;;; Thus, there is no explicit recovery code. |
| 3537 | 2962 | ||
| 3538 | ;;; vc.el ends here | 2963 | ;;; vc.el ends here |