aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2000-09-05 20:08:22 +0000
committerStefan Monnier2000-09-05 20:08:22 +0000
commit099bd78a963080c986d8374d8af79d32c5fe0ca3 (patch)
tree85c91f82453cd6a8ed691b6e0f37a97b131f9838
parent0772f3a31cd172365e87b25571201348b776648b (diff)
downloademacs-099bd78a963080c986d8374d8af79d32c5fe0ca3.tar.gz
emacs-099bd78a963080c986d8374d8af79d32c5fe0ca3.zip
2000-09-05 Stefan Monnier <monnier@cs.yale.edu>
* vc.el: (toplevel): Don't require `dired' at run-time. (vc-dired-resynch-file): Remove autoload cookie. 2000-09-05 Andre Spiegel <spiegel@gnu.org> * vc.el: Made several backend functions optional. (vc-default-responsible-p): New function. (vc-merge): Use RET for first version to trigger merge-news, not prefix arg. (vc-annotate): Handle backends that do not support annotation. (vc-default-merge-news): Removed. The existence of a merge-news implementation is now checked on caller sites. * vc-hooks.el (vc-default-mode-line-string): Removed CVS special case. * vc-cvs.el (vc-cvs-mode-line-string): New function, handles the special case that has been removed from the default in vc-hooks.el. 2000-09-05 Stefan Monnier <monnier@cs.yale.edu> * vc.el (vc-log-edit): Properly handle the case where FILE is nil. 2000-09-05 Andre Spiegel <spiegel@gnu.org> * vc-hooks.el: Require vc during compilation. (vc-file-setprop): Use `vc-touched-properties' if bound by the new macro `with-vc-properties' in vc.el. (vc-file-getprop): Doc fix. (vc-after-save): Call `vc-dired-resynch-file' only if vc is loaded. * vc.el: Require dired-aux during compilation. (vc-name-assoc-file): Moved to vc-sccs.el. (with-vc-properties): New macro. (vc-checkin, vc-checkout, vc-revert, vc-cancel-version, vc-finish-steal): Use it. (vc-cancel-version): Moved RCS-specific code to vc-rcs.el. The call to the backend-specific function is now supposed to do the checkout, too. (vc-log-edit): Handle FILE being nil and added a FIXME for log-edit. * vc-cvs.el (vc-cvs-checkin, vc-cvs-checkout): Don't bother to set file properties; that gets done in the generic code now. * vc-rcs.el (vc-rcs-uncheck): Renamed to `vc-rcs-cancel-version'. Changed parameter list, added code from vc.el that does the checkout, possibly with a double-take. * vc-sccs.el (vc-sccs-name-assoc-file): Moved here from vc.el. (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple): Use the above under the new name. (vc-sccs-uncheck): Renamed to `vc-sccs-cancel-version'. Changed parameter list, added checkout command. (vc-sccs-checkin, vc-sccs-checkout): Don't bother to set file properties; that gets done in the generic code now. 2000-09-05 Stefan Monnier <monnier@cs.yale.edu> * vc.el: Docstring fixes (courtesy of checkdoc). 2000-09-05 Stefan Monnier <monnier@cs.yale.edu> * vc.el (vc-checkout-writable-buffer-hook) (vc-checkout-writable-buffer): Remove. (vc-start-entry): Always call vc-log-edit, never vc-log-mode. (vc-log-mode): Make it into a clean derived major mode. (vc-log-edit): Mark buffer unmodified (as vc-log-mode did) and use vc-log-mode if log-edit is not available. (vc-dired-mode-map): Don't set-keymap-parent yet. (vc-dired-mode): Do set-keymap-parent here. (vc-dired-buffers-for-dir): Nop if dired is not loaded.
-rw-r--r--lisp/ChangeLog80
-rw-r--r--lisp/vc-cvs.el29
-rw-r--r--lisp/vc-hooks.el39
-rw-r--r--lisp/vc-rcs.el37
-rw-r--r--lisp/vc-sccs.el34
-rw-r--r--lisp/vc.el458
6 files changed, 402 insertions, 275 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7525999db14..55b0ecb0240 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,77 @@
12000-09-05 Stefan Monnier <monnier@cs.yale.edu>
2
3 * vc.el: (toplevel): Don't require `dired' at run-time.
4 (vc-dired-resynch-file): Remove autoload cookie.
5
62000-09-05 Andre Spiegel <spiegel@gnu.org>
7
8 * vc.el: Made several backend functions optional.
9 (vc-default-responsible-p): New function.
10 (vc-merge): Use RET for first version to trigger merge-news, not
11 prefix arg.
12 (vc-annotate): Handle backends that do not support annotation.
13 (vc-default-merge-news): Removed. The existence of a merge-news
14 implementation is now checked on caller sites.
15
16 * vc-hooks.el (vc-default-mode-line-string): Removed CVS special
17 case.
18
19 * vc-cvs.el (vc-cvs-mode-line-string): New function, handles the
20 special case that has been removed from the default in vc-hooks.el.
21
222000-09-05 Stefan Monnier <monnier@cs.yale.edu>
23
24 * vc.el (vc-log-edit): Properly handle the case where FILE is nil.
25
262000-09-05 Andre Spiegel <spiegel@gnu.org>
27
28 * vc-hooks.el: Require vc during compilation.
29 (vc-file-setprop): Use `vc-touched-properties' if bound by the new
30 macro `with-vc-properties' in vc.el.
31 (vc-file-getprop): Doc fix.
32 (vc-after-save): Call `vc-dired-resynch-file' only if vc is loaded.
33
34 * vc.el: Require dired-aux during compilation.
35 (vc-name-assoc-file): Moved to vc-sccs.el.
36 (with-vc-properties): New macro.
37 (vc-checkin, vc-checkout, vc-revert, vc-cancel-version,
38 vc-finish-steal): Use it.
39 (vc-cancel-version): Moved RCS-specific code to vc-rcs.el. The call
40 to the backend-specific function is now supposed to do the checkout,
41 too.
42 (vc-log-edit): Handle FILE being nil and added a FIXME for log-edit.
43
44 * vc-cvs.el (vc-cvs-checkin, vc-cvs-checkout): Don't bother to
45 set file properties; that gets done in the generic code now.
46
47 * vc-rcs.el (vc-rcs-uncheck): Renamed to `vc-rcs-cancel-version'.
48 Changed parameter list, added code from vc.el that does the
49 checkout, possibly with a double-take.
50
51 * vc-sccs.el (vc-sccs-name-assoc-file): Moved here from vc.el.
52 (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple): Use
53 the above under the new name.
54 (vc-sccs-uncheck): Renamed to `vc-sccs-cancel-version'. Changed
55 parameter list, added checkout command.
56 (vc-sccs-checkin, vc-sccs-checkout): Don't bother to set file
57 properties; that gets done in the generic code now.
58
592000-09-05 Stefan Monnier <monnier@cs.yale.edu>
60
61 * vc.el: Docstring fixes (courtesy of checkdoc).
62
632000-09-05 Stefan Monnier <monnier@cs.yale.edu>
64
65 * vc.el (vc-checkout-writable-buffer-hook)
66 (vc-checkout-writable-buffer): Remove.
67 (vc-start-entry): Always call vc-log-edit, never vc-log-mode.
68 (vc-log-mode): Make it into a clean derived major mode.
69 (vc-log-edit): Mark buffer unmodified (as vc-log-mode did) and use
70 vc-log-mode if log-edit is not available.
71 (vc-dired-mode-map): Don't set-keymap-parent yet.
72 (vc-dired-mode): Do set-keymap-parent here.
73 (vc-dired-buffers-for-dir): Nop if dired is not loaded.
74
12000-09-05 Gerd Moellmann <gerd@gnu.org> 752000-09-05 Gerd Moellmann <gerd@gnu.org>
2 76
3 * faces.el (set-face-attribute, face-spec-reset-face) 77 * faces.el (set-face-attribute, face-spec-reset-face)
@@ -46,14 +120,12 @@
46 latest version instead of `merge-news'. 120 latest version instead of `merge-news'.
47 (vc-next-action-dired): Don't mess with default-directory here; it 121 (vc-next-action-dired): Don't mess with default-directory here; it
48 breaks other parts of dired. It is the job of the 122 breaks other parts of dired. It is the job of the
49 backend-specific functions to adjust it temporarily if they need 123 backend-specific functions to adjust it temporarily if they need it.
50 it.
51 (vc-next-action): Remove a special CVS case. 124 (vc-next-action): Remove a special CVS case.
52 (vc-clear-headers): New optional arg FILE. 125 (vc-clear-headers): New optional arg FILE.
53 (vc-checkin, vc-checkout): Set properties vc-state and 126 (vc-checkin, vc-checkout): Set properties vc-state and
54 vc-checkout-time properly. 127 vc-checkout-time properly.
55 (vc-finish-steal): Call steal-lock, not steal, which doesn't 128 (vc-finish-steal): Call steal-lock, not steal, which doesn't exist.
56 exist.
57 (vc-print-log): Use new backend function `show-log-entry'. 129 (vc-print-log): Use new backend function `show-log-entry'.
58 (vc-cancel-version): Do the checks in a different order. Added a 130 (vc-cancel-version): Do the checks in a different order. Added a
59 FIXME concerning RCS-only code. 131 FIXME concerning RCS-only code.
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 7e41e9fe092..e7388ebbdd9 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-cvs.el,v 1.58 2000/08/12 18:47:41 spiegel Exp $ 8;; $Id: vc-cvs.el,v 1.1 2000/09/04 19:48:04 gerd Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -204,6 +204,26 @@ essential information."
204 'up-to-date 204 'up-to-date
205 'edited))) 205 'edited)))
206 206
207(defun vc-cvs-mode-line-string (file)
208 "Return string for placement into the modeline for FILE.
209Compared to the default implementation, this function handles the
210special case of a CVS file that is added but not yet comitted."
211 (let ((state (vc-state file))
212 (rev (vc-workfile-version file)))
213 (cond ((string= rev "0")
214 ;; A file that is added but not yet comitted.
215 "CVS @@")
216 ((or (eq state 'up-to-date)
217 (eq state 'needs-patch))
218 (concat "CVS-" rev))
219 ((stringp state)
220 (concat "CVS:" state ":" rev))
221 (t
222 ;; Not just for the 'edited state, but also a fallback
223 ;; for all other states. Think about different symbols
224 ;; for 'needs-patch and 'needs-merge.
225 (concat "CVS:" rev)))))
226
207(defun vc-cvs-dir-state (dir) 227(defun vc-cvs-dir-state (dir)
208 "Find the CVS state of all files in DIR." 228 "Find the CVS state of all files in DIR."
209 (if (vc-cvs-stay-local-p dir) 229 (if (vc-cvs-stay-local-p dir)
@@ -513,8 +533,6 @@ its branch."
513 ;; tell it from the permissions of the file (see 533 ;; tell it from the permissions of the file (see
514 ;; vc-cvs-checkout-model). 534 ;; vc-cvs-checkout-model).
515 (vc-file-setprop file 'vc-checkout-model nil) 535 (vc-file-setprop file 'vc-checkout-model nil)
516 (vc-file-setprop file 'vc-state 'up-to-date)
517 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
518 ;; if this was an explicit check-in, remove the sticky tag 536 ;; if this was an explicit check-in, remove the sticky tag
519 (if rev (vc-do-command t 0 "cvs" file "update" "-A")))) 537 (if rev (vc-do-command t 0 "cvs" file "update" "-A"))))
520 538
@@ -612,10 +630,7 @@ REV is the revision to check out into WORKFILE."
612 (if (or (not rev) (string= rev "")) 630 (if (or (not rev) (string= rev ""))
613 "-A" 631 "-A"
614 (concat "-r" rev)) 632 (concat "-r" rev))
615 switches)) 633 switches))))
616 (when writable (vc-file-setprop file 'vc-state 'edited))
617 (vc-file-setprop file
618 'vc-checkout-time (nth 5 (file-attributes file)))))
619 (vc-mode-line file) 634 (vc-mode-line file)
620 (message "Checking out %s...done" filename))))) 635 (message "Checking out %s...done" filename)))))
621 636
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index efb7a973405..4554e1e6860 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-hooks.el,v 1.53 2000/08/13 11:36:46 spiegel Exp $ 8;; $Id: vc-hooks.el,v 1.116 2000/09/04 19:47:25 gerd Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -33,6 +33,9 @@
33 33
34;;; Code: 34;;; Code:
35 35
36(eval-when-compile
37 (require 'vc))
38
36;; Customization Variables (the rest is in vc.el) 39;; Customization Variables (the rest is in vc.el)
37 40
38(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.") 41(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.")
@@ -47,7 +50,7 @@ Removing an entry from the list prevents VC from being activated
47when visiting a file managed by that backend. 50when visiting a file managed by that backend.
48An empty list disables VC altogether." 51An empty list disables VC altogether."
49 :type '(repeat symbol) 52 :type '(repeat symbol)
50 :version "20.5" 53 :version "21.1"
51 :group 'vc) 54 :group 'vc)
52 55
53(defcustom vc-path 56(defcustom vc-path
@@ -117,24 +120,30 @@ See also variable `vc-consult-headers'."
117(make-variable-buffer-local 'vc-mode) 120(make-variable-buffer-local 'vc-mode)
118(put 'vc-mode 'permanent-local t) 121(put 'vc-mode 'permanent-local t)
119 122
123(defmacro vc-error-occurred (&rest body)
124 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
125
120;; We need a notion of per-file properties because the version 126;; We need a notion of per-file properties because the version
121;; control state of a file is expensive to derive --- we compute 127;; control state of a file is expensive to derive --- we compute
122;; them when the file is initially found, keep them up to date 128;; them when the file is initially found, keep them up to date
123;; during any subsequent VC operations, and forget them when 129;; during any subsequent VC operations, and forget them when
124;; the buffer is killed. 130;; the buffer is killed.
125 131
126(defmacro vc-error-occurred (&rest body)
127 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
128
129(defvar vc-file-prop-obarray (make-vector 16 0) 132(defvar vc-file-prop-obarray (make-vector 16 0)
130 "Obarray for per-file properties.") 133 "Obarray for per-file properties.")
131 134
135(defvar vc-touched-properties nil)
136
132(defun vc-file-setprop (file property value) 137(defun vc-file-setprop (file property value)
133 "Set per-file VC PROPERTY for FILE to VALUE." 138 "Set per-file VC PROPERTY for FILE to VALUE."
139 (if (and vc-touched-properties
140 (not (memq property vc-touched-properties)))
141 (setq vc-touched-properties (append (list property)
142 vc-touched-properties)))
134 (put (intern file vc-file-prop-obarray) property value)) 143 (put (intern file vc-file-prop-obarray) property value))
135 144
136(defun vc-file-getprop (file property) 145(defun vc-file-getprop (file property)
137 "get per-file VC PROPERTY for FILE." 146 "Get per-file VC PROPERTY for FILE."
138 (get (intern file vc-file-prop-obarray) property)) 147 (get (intern file vc-file-prop-obarray) property))
139 148
140(defun vc-file-clearprops (file) 149(defun vc-file-clearprops (file)
@@ -462,7 +471,10 @@ to do that, use this command a second time with no argument."
462 (eq (vc-checkout-model file) 'implicit) 471 (eq (vc-checkout-model file) 'implicit)
463 (vc-file-setprop file 'vc-state 'edited) 472 (vc-file-setprop file 'vc-state 'edited)
464 (vc-mode-line file) 473 (vc-mode-line file)
465 (vc-dired-resynch-file file)))) 474 (if (featurep 'vc)
475 ;; If VC is not loaded, then there can't be
476 ;; any VC Dired buffer to synchronize.
477 (vc-dired-resynch-file file)))))
466 478
467(defun vc-mode-line (file) 479(defun vc-mode-line (file)
468 "Set `vc-mode' to display type of version control for FILE. 480 "Set `vc-mode' to display type of version control for FILE.
@@ -470,10 +482,9 @@ The value is set in the current buffer, which should be the buffer
470visiting FILE." 482visiting FILE."
471 (interactive (list buffer-file-name nil)) 483 (interactive (list buffer-file-name nil))
472 (unless (not (vc-backend file)) 484 (unless (not (vc-backend file))
473 (setq vc-mode (concat " " 485 (setq vc-mode (concat " " (if vc-display-status
474 (if vc-display-status 486 (vc-call mode-line-string file)
475 (vc-call mode-line-string file) 487 (symbol-name (vc-backend file)))))
476 (symbol-name (vc-backend file)))))
477 ;; If the file is locked by some other user, make 488 ;; If the file is locked by some other user, make
478 ;; the buffer read-only. Like this, even root 489 ;; the buffer read-only. Like this, even root
479 ;; cannot modify a file that someone else has locked. 490 ;; cannot modify a file that someone else has locked.
@@ -499,16 +510,12 @@ Format:
499 \"BACKEND-REV\" if the file is up-to-date 510 \"BACKEND-REV\" if the file is up-to-date
500 \"BACKEND:REV\" if the file is edited (or locked by the calling user) 511 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
501 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else 512 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
502 \"BACKEND @@\" for a CVS file that is added, but not yet committed
503 513
504This function assumes that the file is registered." 514This function assumes that the file is registered."
505 (setq backend (symbol-name backend)) 515 (setq backend (symbol-name backend))
506 (let ((state (vc-state file)) 516 (let ((state (vc-state file))
507 (rev (vc-workfile-version file))) 517 (rev (vc-workfile-version file)))
508 (cond ((string= "0" rev) 518 (cond ((or (eq state 'up-to-date)
509 ;; CVS special case; should go into a CVS-specific implementation
510 (concat backend " @@"))
511 ((or (eq state 'up-to-date)
512 (eq state 'needs-patch)) 519 (eq state 'needs-patch))
513 (concat backend "-" rev)) 520 (concat backend "-" rev))
514 ((stringp state) 521 ((stringp state)
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 4a936d2ee57..01852f69d3c 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-rcs.el,v 1.36 2000/08/12 18:51:30 spiegel Exp $ 8;; $Id: vc-rcs.el,v 1.1 2000/09/04 19:47:43 gerd Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -476,9 +476,35 @@ Needs RCS 5.6.2 or later for -M."
476 (vc-do-command nil 0 "rcs" (vc-name file) "-M" 476 (vc-do-command nil 0 "rcs" (vc-name file) "-M"
477 (concat "-u" rev) (concat "-l" rev))) 477 (concat "-u" rev) (concat "-l" rev)))
478 478
479(defun vc-rcs-uncheck (file target) 479(defun vc-rcs-cancel-version (file writable)
480 "Undo the checkin of FILE's revision TARGET." 480 "Undo the most recent checkin of FILE.
481 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))) 481WRITABLE non-nil means previous version should be locked."
482 (let* ((target (vc-workfile-version file))
483 (previous (if (vc-trunk-p target) "" (vc-branch-part target)))
484 (config (current-window-configuration))
485 (done nil))
486 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
487 ;; Check out the most recent remaining version. If it fails, because
488 ;; the whole branch got deleted, do a double-take and check out the
489 ;; version where the branch started.
490 (while (not done)
491 (condition-case err
492 (progn
493 (vc-do-command nil 0 "co" (vc-name file) "-f"
494 (concat (if writable "-l" "-u") previous))
495 (setq done t))
496 (error (set-buffer "*vc*")
497 (goto-char (point-min))
498 (if (search-forward "no side branches present for" nil t)
499 (progn (setq previous (vc-branch-part previous))
500 (vc-do-command nil 0 "rcs" (vc-name file)
501 (concat "-b" previous))
502 ;; vc-do-command popped up a window with
503 ;; the error message. Get rid of it, by
504 ;; restoring the old window configuration.
505 (set-window-configuration config))
506 ;; No, it was some other error: re-signal it.
507 (signal (car err) (cdr err))))))))
482 508
483(defun vc-rcs-revert (file) 509(defun vc-rcs-revert (file)
484 "Revert FILE to the version it was based on." 510 "Revert FILE to the version it was based on."
@@ -526,9 +552,6 @@ CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)."
526 552
527(defun vc-rcs-checkin (file rev comment) 553(defun vc-rcs-checkin (file rev comment)
528 "RCS-specific version of `vc-backend-checkin'." 554 "RCS-specific version of `vc-backend-checkin'."
529 ;; Adaptation for RCS branch support: if this is an explicit checkin,
530 ;; or if the checkin creates a new branch, set the master file branch
531 ;; accordingly.
532 (let ((switches (if (stringp vc-checkin-switches) 555 (let ((switches (if (stringp vc-checkin-switches)
533 (list vc-checkin-switches) 556 (list vc-checkin-switches)
534 vc-checkin-switches))) 557 vc-checkin-switches)))
diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el
index 9edd1f25267..79936a08c6e 100644
--- a/lisp/vc-sccs.el
+++ b/lisp/vc-sccs.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-sccs.el,v 1.35 2000/08/13 11:52:19 spiegel Exp $ 8;; $Id: vc-sccs.el,v 1.1 2000/09/04 19:48:23 gerd Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -57,6 +57,8 @@ For a description of possible values, see `vc-check-master-templates'."
57 :version "20.5" 57 :version "20.5"
58 :group 'vc) 58 :group 'vc)
59 59
60(defconst vc-sccs-name-assoc-file "VC-names")
61
60;;;###autoload 62;;;###autoload
61(progn (defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))) 63(progn (defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)))
62 64
@@ -172,7 +174,7 @@ The result is a list of the form ((VERSION . USER) (VERSION . USER) ...)."
172(defun vc-sccs-add-triple (name file rev) 174(defun vc-sccs-add-triple (name file rev)
173 (with-current-buffer 175 (with-current-buffer
174 (find-file-noselect 176 (find-file-noselect
175 (expand-file-name vc-name-assoc-file 177 (expand-file-name vc-sccs-name-assoc-file
176 (file-name-directory (vc-name file)))) 178 (file-name-directory (vc-name file))))
177 (goto-char (point-max)) 179 (goto-char (point-max))
178 (insert name "\t:\t" file "\t" rev "\n") 180 (insert name "\t:\t" file "\t" rev "\n")
@@ -185,7 +187,7 @@ The result is a list of the form ((VERSION . USER) (VERSION . USER) ...)."
185 ;; Update the snapshot file. 187 ;; Update the snapshot file.
186 (with-current-buffer 188 (with-current-buffer
187 (find-file-noselect 189 (find-file-noselect
188 (expand-file-name vc-name-assoc-file 190 (expand-file-name vc-sccs-name-assoc-file
189 (file-name-directory (vc-name old)))) 191 (file-name-directory (vc-name old))))
190 (goto-char (point-min)) 192 (goto-char (point-min))
191 ;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new)) 193 ;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
@@ -203,7 +205,7 @@ If NAME is nil or a version number string it's just passed through."
203 name 205 name
204 (with-temp-buffer 206 (with-temp-buffer
205 (vc-insert-file 207 (vc-insert-file
206 (expand-file-name vc-name-assoc-file 208 (expand-file-name vc-sccs-name-assoc-file
207 (file-name-directory (vc-name file)))) 209 (file-name-directory (vc-name file))))
208 (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1)))) 210 (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
209 211
@@ -221,9 +223,15 @@ If NAME is nil or a version number string it's just passed through."
221 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev))) 223 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
222 (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev)))) 224 (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev))))
223 225
224(defun vc-sccs-uncheck (file target) 226(defun vc-sccs-cancel-version (file writable)
225 "Undo the checkin of FILE's revision TARGET." 227 "Undo the most recent checkin of FILE.
226 (vc-do-command nil 0 "rmdel" (vc-name file) (concat "-r" target))) 228WRITABLE non-nil means previous version should be locked."
229 (vc-do-command nil 0 "rmdel"
230 (vc-name file)
231 (concat "-r" (vc-workfile-version file)))
232 (vc-do-command nil 0 "get"
233 (vc-name file)
234 (if writable "-e")))
227 235
228(defun vc-sccs-revert (file) 236(defun vc-sccs-revert (file)
229 "Revert FILE to the version it was based on." 237 "Revert FILE to the version it was based on."
@@ -243,8 +251,6 @@ If NAME is nil or a version number string it's just passed through."
243 (if rev (concat "-r" rev)) 251 (if rev (concat "-r" rev))
244 (concat "-y" comment) 252 (concat "-y" comment)
245 switches) 253 switches)
246 (vc-file-setprop file 'vc-state 'up-to-date)
247 (vc-file-setprop file 'vc-workfile-version nil)
248 (if vc-keep-workfiles 254 (if vc-keep-workfiles
249 (vc-do-command nil 0 "get" (vc-name file))))) 255 (vc-do-command nil 0 "get" (vc-name file)))))
250 256
@@ -371,14 +377,8 @@ REV is the revision to check out into WORKFILE."
371 (apply 'vc-do-command nil 0 "get" (vc-name file) 377 (apply 'vc-do-command nil 0 "get" (vc-name file)
372 (if writable "-e") 378 (if writable "-e")
373 (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) 379 (and rev (concat "-r" (vc-sccs-lookup-triple file rev)))
374 switches) 380 switches)))))
375 (vc-file-setprop file 'vc-workfile-version nil)) 381 (message "Checking out %s...done" filename)))
376 (unless workfile
377 (if writable
378 (vc-file-setprop file 'vc-state 'edited))
379 (vc-file-setprop file
380 'vc-checkout-time (nth 5 (file-attributes file))))
381 (message "Checking out %s...done" filename))))))
382 382
383(defun vc-sccs-update-changelog (files) 383(defun vc-sccs-update-changelog (files)
384 (error "Sorry, generating ChangeLog entries is not implemented for SCCS.")) 384 (error "Sorry, generating ChangeLog entries is not implemented for SCCS."))
diff --git a/lisp/vc.el b/lisp/vc.el
index fb3eddeb520..622b207d2e8 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see below for full credits) 5;; Author: FSF (see below for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc.el,v 1.262 2000/09/04 19:46:58 gerd Exp $ 8;; $Id: vc.el,v 1.263 2000/09/04 19:59:41 gerd Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -87,11 +87,13 @@
87;; - mode-line-string (file) 87;; - mode-line-string (file)
88;; * workfile-version (file) 88;; * workfile-version (file)
89;; * revert (file) 89;; * revert (file)
90;; * merge-news (file) 90;; - merge-news (file)
91;; * merge (file rev1 rev2) 91;; Only needed if state `needs-merge' is possible.
92;; * steal-lock (file &optional version) 92;; - merge (file rev1 rev2)
93;; - steal-lock (file &optional version)
94;; Only required if files can be locked by somebody else.
93;; * register (file rev comment) 95;; * register (file rev comment)
94;; * responsible-p (file) 96;; - responsible-p (file)
95;; Should also work if FILE is a directory (ends with a slash). 97;; Should also work if FILE is a directory (ends with a slash).
96;; - could-register (file) 98;; - could-register (file)
97;; * checkout (file writable &optional rev destfile) 99;; * checkout (file writable &optional rev destfile)
@@ -139,17 +141,18 @@
139;; Find changelog entries for FILES, or for all files at or below 141;; Find changelog entries for FILES, or for all files at or below
140;; the default-directory if FILES is nil. 142;; the default-directory if FILES is nil.
141;; * latest-on-branch-p (file) 143;; * latest-on-branch-p (file)
142;; Only used for sanity check before calling `uncheck'. 144;; - cancel-version (file writable)
143;; * uncheck (file target) 145;; - rename-file (old new)
144;; * rename-file (old new) 146;; - annotate-command (file buf)
145;; * annotate-command (file buf) 147;; - annotate-difference (pos)
146;; * annotate-difference (pos) 148;; Only required if `annotate-command' is defined for the backend.
147 149
148(require 'vc-hooks) 150(require 'vc-hooks)
149(require 'ring) 151(require 'ring)
150(require 'dired) ; for dired-mode-map
151(eval-when-compile 152(eval-when-compile
152 (require 'compile)) 153 (require 'compile)
154 (require 'dired) ; for dired-map-over-marks macro
155 (require 'dired-aux)) ; for dired-kill-{line,tree}
153 156
154(if (not (assoc 'vc-parent-buffer minor-mode-alist)) 157(if (not (assoc 'vc-parent-buffer minor-mode-alist))
155 (setq minor-mode-alist 158 (setq minor-mode-alist
@@ -336,7 +339,7 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
336 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) 339 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
337 "*Associate static header string templates with file types. 340 "*Associate static header string templates with file types.
338A \%s in the template is replaced with the first string associated with 341A \%s in the template is replaced with the first string associated with
339the file's version-control type in `vc-header-alist'." 342the file's version control type in `vc-header-alist'."
340 :type '(repeat (cons :format "%v" 343 :type '(repeat (cons :format "%v"
341 (regexp :tag "File Type") 344 (regexp :tag "File Type")
342 (string :tag "Header String"))) 345 (string :tag "Header String")))
@@ -345,8 +348,8 @@ the file's version-control type in `vc-header-alist'."
345(defcustom vc-comment-alist 348(defcustom vc-comment-alist
346 '((nroff-mode ".\\\"" "")) 349 '((nroff-mode ".\\\"" ""))
347 "*Special comment delimiters to be used in generating vc headers only. 350 "*Special comment delimiters to be used in generating vc headers only.
348Add an entry in this list if you need to override the normal comment-start 351Add an entry in this list if you need to override the normal `comment-start'
349and comment-end variables. This will only be necessary if the mode language 352and `comment-end' variables. This will only be necessary if the mode language
350is sensitive to blank lines." 353is sensitive to blank lines."
351 :type '(repeat (list :format "%v" 354 :type '(repeat (list :format "%v"
352 (symbol :tag "Mode") 355 (symbol :tag "Mode")
@@ -403,11 +406,9 @@ and that its contents match what the master file says."
403;; Variables the user doesn't need to know about. 406;; Variables the user doesn't need to know about.
404(defvar vc-log-operation nil) 407(defvar vc-log-operation nil)
405(defvar vc-log-after-operation-hook nil) 408(defvar vc-log-after-operation-hook nil)
406(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
407(defvar vc-annotate-buffers nil 409(defvar vc-annotate-buffers nil
408 "An association list of current \"Annotate\" buffers and their 410 "Alist of current \"Annotate\" buffers and their corresponding backends.
409corresponding backends. The keys are \(BUFFER . BACKEND\). See also 411The keys are \(BUFFER . BACKEND\). See also `vc-annotate-get-backend'.")
410`vc-annotate-get-backend'.")
411;; In a log entry buffer, this is a local variable 412;; In a log entry buffer, this is a local variable
412;; that points to the buffer for which it was made 413;; that points to the buffer for which it was made
413;; (either a file, or a VC dired buffer). 414;; (either a file, or a VC dired buffer).
@@ -419,9 +420,6 @@ corresponding backends. The keys are \(BUFFER . BACKEND\). See also
419(defvar vc-log-file) 420(defvar vc-log-file)
420(defvar vc-log-version) 421(defvar vc-log-version)
421 422
422;; FIXME: only used in vc-sccs.el
423(defconst vc-name-assoc-file "VC-names")
424
425(defvar vc-dired-mode nil) 423(defvar vc-dired-mode nil)
426(make-variable-buffer-local 'vc-dired-mode) 424(make-variable-buffer-local 'vc-dired-mode)
427 425
@@ -433,24 +431,24 @@ corresponding backends. The keys are \(BUFFER . BACKEND\). See also
433;;; also be moved into the backends. It stays for now, however, since 431;;; also be moved into the backends. It stays for now, however, since
434;;; it is used in code below. 432;;; it is used in code below.
435(defun vc-trunk-p (rev) 433(defun vc-trunk-p (rev)
436 "Return t if REV is a revision on the trunk" 434 "Return t if REV is a revision on the trunk."
437 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) 435 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
438 436
439(defun vc-branch-p (rev) 437(defun vc-branch-p (rev)
440 "Return t if REV is a branch revision" 438 "Return t if REV is a branch revision."
441 (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev)))) 439 (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
442 440
443(defun vc-branch-part (rev) 441(defun vc-branch-part (rev)
444 "return the branch part of a revision number REV" 442 "Return the branch part of a revision number REV."
445 (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) 443 (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
446 444
447(defun vc-minor-part (rev) 445(defun vc-minor-part (rev)
448 "Return the minor version number of a revision number REV" 446 "Return the minor version number of a revision number REV."
449 (string-match "[0-9]+\\'" rev) 447 (string-match "[0-9]+\\'" rev)
450 (substring rev (match-beginning 0) (match-end 0))) 448 (substring rev (match-beginning 0) (match-end 0)))
451 449
452(defun vc-previous-version (rev) 450(defun vc-previous-version (rev)
453 "Guess the previous version number" 451 "Guess the version number immediately preceding REV."
454 (let ((branch (vc-branch-part rev)) 452 (let ((branch (vc-branch-part rev))
455 (minor-num (string-to-number (vc-minor-part rev)))) 453 (minor-num (string-to-number (vc-minor-part rev))))
456 (if (> minor-num 1) 454 (if (> minor-num 1)
@@ -474,6 +472,21 @@ corresponding backends. The keys are \(BUFFER . BACKEND\). See also
474 ;; log buffer with a nonzero local value of vc-comment-ring-index. 472 ;; log buffer with a nonzero local value of vc-comment-ring-index.
475 (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) 473 (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
476 474
475(defmacro with-vc-properties (file form settings)
476 "Execute FORM, then set per-file properties for FILE, but only those
477that have not been set during the execution of FORM. SETTINGS is a list
478of two-element lists, each of which has the form (PROPERTY VALUE)."
479 `(let ((vc-touched-properties (list t))
480 (filename ,file))
481 ,form
482 (mapcar (lambda (setting)
483 (let ((property (nth 0 setting))
484 (value (nth 1 setting)))
485 (unless (memq property vc-touched-properties)
486 (put (intern filename vc-file-prop-obarray)
487 property value))))
488 ,settings)))
489
477;; Random helper functions 490;; Random helper functions
478 491
479(defsubst vc-editable-p (file) 492(defsubst vc-editable-p (file)
@@ -513,8 +526,7 @@ However, before executing BODY, find FILE, and after BODY, save buffer."
513 (save-buffer))) 526 (save-buffer)))
514 527
515(defun vc-ensure-vc-buffer () 528(defun vc-ensure-vc-buffer ()
516 "Make sure that the current buffer visits a version-controlled 529 "Make sure that the current buffer visits a version-controlled file."
517file."
518 (if vc-dired-mode 530 (if vc-dired-mode
519 (set-buffer (find-file-noselect (dired-get-filename))) 531 (set-buffer (find-file-noselect (dired-get-filename)))
520 (while vc-parent-buffer 532 (while vc-parent-buffer
@@ -531,7 +543,7 @@ file."
531 '(""))) 543 '("")))
532 544
533(defun vc-process-filter (p s) 545(defun vc-process-filter (p s)
534 "An alternative output filter for async processes. 546 "An alternative output filter for async process P.
535The only difference with the default filter is to insert S after markers." 547The only difference with the default filter is to insert S after markers."
536 (with-current-buffer (process-buffer p) 548 (with-current-buffer (process-buffer p)
537 (save-excursion 549 (save-excursion
@@ -541,7 +553,7 @@ The only difference with the default filter is to insert S after markers."
541 (set-marker (process-mark p) (point)))))) 553 (set-marker (process-mark p) (point))))))
542 554
543(defun vc-setup-buffer (&optional buf) 555(defun vc-setup-buffer (&optional buf)
544 "prepare BUF for executing a VC command and make it the current buffer. 556 "Prepare BUF for executing a VC command and make it the current buffer.
545BUF defaults to \"*vc*\", can be a string and will be created if necessary." 557BUF defaults to \"*vc*\", can be a string and will be created if necessary."
546 (unless buf (setq buf "*vc*")) 558 (unless buf (setq buf "*vc*"))
547 (let ((camefrom (current-buffer)) 559 (let ((camefrom (current-buffer))
@@ -588,7 +600,7 @@ Each function is called inside the buffer in which the command was run
588and is passed 3 argument: the COMMAND, the FILE and the FLAGS.") 600and is passed 3 argument: the COMMAND, the FILE and the FLAGS.")
589 601
590(defun vc-do-command (buffer okstatus command file &rest flags) 602(defun vc-do-command (buffer okstatus command file &rest flags)
591 "Execute a version-control command, notifying user and checking for errors. 603 "Execute a version control command, notifying user and checking for errors.
592Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current 604Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current
593buffer (which is assumed to be properly setup) if BUFFER is t. The 605buffer (which is assumed to be properly setup) if BUFFER is t. The
594command is considered successful if its exit status does not exceed 606command is considered successful if its exit status does not exceed
@@ -641,9 +653,9 @@ that is inserted into the command line before the filename."
641 status))) 653 status)))
642 654
643(defun vc-position-context (posn) 655(defun vc-position-context (posn)
644 "Save a bit of the text around POSN in the current buffer, to help 656 "Save a bit of the text around POSN in the current buffer.
645us find the corresponding position again later. This works even if 657Used to help us find the corresponding position again later
646all markers are destroyed or corrupted." 658if markers are destroyed or corrupted."
647 ;; A lot of this was shamelessly lifted from Sebastian Kremer's 659 ;; A lot of this was shamelessly lifted from Sebastian Kremer's
648 ;; rcs.el mode. 660 ;; rcs.el mode.
649 (list posn 661 (list posn
@@ -652,8 +664,7 @@ all markers are destroyed or corrupted."
652 (min (point-max) (+ posn 100))))) 664 (min (point-max) (+ posn 100)))))
653 665
654(defun vc-find-position-by-context (context) 666(defun vc-find-position-by-context (context)
655 "Return the position of CONTEXT in the current buffer, or nil if we 667 "Return the position of CONTEXT in the current buffer, or nil if not found."
656couldn't find it."
657 (let ((context-string (nth 2 context))) 668 (let ((context-string (nth 2 context)))
658 (if (equal "" context-string) 669 (if (equal "" context-string)
659 (point-max) 670 (point-max)
@@ -672,7 +683,7 @@ couldn't find it."
672 (- (point) (length context-string)))))))) 683 (- (point) (length context-string))))))))
673 684
674(defun vc-context-matches-p (posn context) 685(defun vc-context-matches-p (posn context)
675 "Returns t if POSN matches CONTEXT, nil otherwise." 686 "Return t if POSN matches CONTEXT, nil otherwise."
676 (let* ((context-string (nth 2 context)) 687 (let* ((context-string (nth 2 context))
677 (len (length context-string)) 688 (len (length context-string))
678 (end (+ posn len))) 689 (end (+ posn len)))
@@ -681,8 +692,8 @@ couldn't find it."
681 (string= context-string (buffer-substring posn end))))) 692 (string= context-string (buffer-substring posn end)))))
682 693
683(defun vc-buffer-context () 694(defun vc-buffer-context ()
684 "Return a list '(point-context mark-context reparse); from which 695 "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
685vc-restore-buffer-context can later restore the context." 696Used by `vc-restore-buffer-context' to later restore the context."
686 (let ((point-context (vc-position-context (point))) 697 (let ((point-context (vc-position-context (point)))
687 ;; Use mark-marker to avoid confusion in transient-mark-mode. 698 ;; Use mark-marker to avoid confusion in transient-mark-mode.
688 (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer)) 699 (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer))
@@ -716,7 +727,7 @@ vc-restore-buffer-context can later restore the context."
716 727
717(defun vc-restore-buffer-context (context) 728(defun vc-restore-buffer-context (context)
718 "Restore point/mark, and reparse any affected compilation buffers. 729 "Restore point/mark, and reparse any affected compilation buffers.
719CONTEXT is that which vc-buffer-context returns." 730CONTEXT is that which `vc-buffer-context' returns."
720 (let ((point-context (nth 0 context)) 731 (let ((point-context (nth 0 context))
721 (mark-context (nth 1 context)) 732 (mark-context (nth 1 context))
722 (reparse (nth 2 context))) 733 (reparse (nth 2 context)))
@@ -749,10 +760,10 @@ CONTEXT is that which vc-buffer-context returns."
749 (if new-mark (set-mark new-mark)))))) 760 (if new-mark (set-mark new-mark))))))
750 761
751(defun vc-revert-buffer1 (&optional arg no-confirm) 762(defun vc-revert-buffer1 (&optional arg no-confirm)
752 "Revert buffer, try to keep point and mark where user expects them 763 "Revert buffer, trying to keep point and mark where user expects them.
753in spite of changes because of expanded version-control key words. 764Tries to be clever in the face of changes due to expanded version control
754This is quite important since otherwise typeahead won't work as 765key words. This is important for typeahead to work as expected.
755expected." 766ARG and NO-CONFIRM are passed on to `revert-buffer'."
756 (interactive "P") 767 (interactive "P")
757 (widen) 768 (widen)
758 (let ((context (vc-buffer-context))) 769 (let ((context (vc-buffer-context)))
@@ -768,7 +779,7 @@ expected."
768 779
769 780
770(defun vc-buffer-sync (&optional not-urgent) 781(defun vc-buffer-sync (&optional not-urgent)
771 "Make sure the current buffer and its working file are in sync 782 "Make sure the current buffer and its working file are in sync.
772NOT-URGENT means it is ok to continue if the user says not to save." 783NOT-URGENT means it is ok to continue if the user says not to save."
773 (if (buffer-modified-p) 784 (if (buffer-modified-p)
774 (if (or vc-suppress-confirm 785 (if (or vc-suppress-confirm
@@ -778,7 +789,7 @@ NOT-URGENT means it is ok to continue if the user says not to save."
778 (error "Aborted"))))) 789 (error "Aborted")))))
779 790
780(defun vc-workfile-unchanged-p (file) 791(defun vc-workfile-unchanged-p (file)
781 "Has the given workfile changed since last checkout?" 792 "Has FILE changed since last checkout?"
782 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) 793 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
783 (lastmod (nth 5 (file-attributes file)))) 794 (lastmod (nth 5 (file-attributes file))))
784 (if checkout-time 795 (if checkout-time
@@ -788,7 +799,7 @@ NOT-URGENT means it is ok to continue if the user says not to save."
788 unchanged)))) 799 unchanged))))
789 800
790(defun vc-default-workfile-unchanged-p (file) 801(defun vc-default-workfile-unchanged-p (file)
791 "Default check whether workfile is unchanged: diff against master version." 802 "Default check whether FILE is unchanged: diff against master version."
792 (zerop (vc-call diff file (vc-workfile-version file)))) 803 (zerop (vc-call diff file (vc-workfile-version file))))
793 804
794(defun vc-recompute-state (file) 805(defun vc-recompute-state (file)
@@ -924,8 +935,8 @@ If VERBOSE is non-nil, query the user rather than using default parameters."
924(defvar vc-dired-window-configuration) 935(defvar vc-dired-window-configuration)
925 936
926(defun vc-next-action-dired (file rev comment) 937(defun vc-next-action-dired (file rev comment)
927 "Do a vc-next-action-on-file on all the marked files, possibly 938 "Call `vc-next-action-on-file' on all the marked files.
928passing on the log comment we've just entered." 939Ignores FILE and REV, but passes on COMMENT."
929 (let ((dired-buffer (current-buffer)) 940 (let ((dired-buffer (current-buffer))
930 (dired-dir default-directory)) 941 (dired-dir default-directory))
931 (dired-map-over-marks 942 (dired-map-over-marks
@@ -1006,14 +1017,9 @@ merge in the changes into your working copy."
1006 1017
1007;;; These functions help the vc-next-action entry point 1018;;; These functions help the vc-next-action entry point
1008 1019
1009(defun vc-checkout-writable-buffer (&optional file rev)
1010 "Retrieve a writable copy of the latest version of the current buffer's file."
1011 (vc-checkout (or file (buffer-file-name)) t rev)
1012 )
1013
1014;;;###autoload 1020;;;###autoload
1015(defun vc-register (&optional set-version comment) 1021(defun vc-register (&optional set-version comment)
1016 "Register the current file into a version-control system. 1022 "Register the current file into a version control system.
1017With prefix argument SET-VERSION, allow user to specify initial version 1023With prefix argument SET-VERSION, allow user to specify initial version
1018level. If COMMENT is present, use that as an initial comment. 1024level. If COMMENT is present, use that as an initial comment.
1019 1025
@@ -1024,8 +1030,7 @@ directory are already registered under that backend) will be used to
1024register the file. If no backend declares itself responsible, the 1030register the file. If no backend declares itself responsible, the
1025first backend that could register the file is used." 1031first backend that could register the file is used."
1026 (interactive "P") 1032 (interactive "P")
1027 (or buffer-file-name 1033 (unless buffer-file-name (error "No visited file"))
1028 (error "No visited file"))
1029 (when (vc-backend buffer-file-name) 1034 (when (vc-backend buffer-file-name)
1030 (if (vc-registered buffer-file-name) 1035 (if (vc-registered buffer-file-name)
1031 (error "This file is already registered") 1036 (error "This file is already registered")
@@ -1079,15 +1084,20 @@ FILE can also be a directory name (ending with a slash)."
1079 vc-handled-backends) 1084 vc-handled-backends)
1080 (car vc-handled-backends))))) 1085 (car vc-handled-backends)))))
1081 1086
1087(defun vc-default-responsible-p (backend file)
1088 "Indicate whether BACKEND is reponsible for FILE.
1089The default is to return nil always."
1090 nil)
1091
1082(defun vc-default-could-register (backend file) 1092(defun vc-default-could-register (backend file)
1083 "Return non-nil if BACKEND could be used to register FILE. 1093 "Return non-nil if BACKEND could be used to register FILE.
1084The default implementation returns t for all files." 1094The default implementation returns t for all files."
1085 t) 1095 t)
1086 1096
1087(defun vc-resynch-window (file &optional keep noquery) 1097(defun vc-resynch-window (file &optional keep noquery)
1088 "If the given file is in the current buffer, either revert on it so 1098 "If FILE is in the current buffer, either revert or unvisit it.
1089we see expanded keywords, or unvisit it (depending on 1099The choice between revert (to see expanded keywords) and unvisit depends on
1090vc-keep-workfiles) NOQUERY if non-nil inhibits confirmation for 1100`vc-keep-workfiles'. NOQUERY if non-nil inhibits confirmation for
1091reverting. NOQUERY should be t *only* if it is known the only 1101reverting. NOQUERY should be t *only* if it is known the only
1092difference between the buffer and the file is due to version control 1102difference between the buffer and the file is due to version control
1093rather than user editing!" 1103rather than user editing!"
@@ -1120,10 +1130,10 @@ rather than user editing!"
1120 (vc-dired-resynch-file file)) 1130 (vc-dired-resynch-file file))
1121 1131
1122(defun vc-start-entry (file rev comment msg action &optional after-hook) 1132(defun vc-start-entry (file rev comment msg action &optional after-hook)
1123 "Accept a comment for an operation on FILE revision REV. If COMMENT 1133 "Accept a comment for an operation on FILE revision REV.
1124is nil, pop up a VC-log buffer, emit MSG, and set the action on close 1134If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the action on close
1125to ACTION; otherwise, do action immediately. Remember the file's 1135to ACTION; otherwise, do action immediately. Remember the file's
1126buffer in vc-parent-buffer (current one if no file). AFTER-HOOK 1136buffer in `vc-parent-buffer' (current one if no file). AFTER-HOOK
1127specifies the local value for vc-log-operation-hook." 1137specifies the local value for vc-log-operation-hook."
1128 (let ((parent (if file (find-file-noselect file) (current-buffer)))) 1138 (let ((parent (if file (find-file-noselect file) (current-buffer))))
1129 (if vc-before-checkin-hook 1139 (if vc-before-checkin-hook
@@ -1138,7 +1148,7 @@ specifies the local value for vc-log-operation-hook."
1138 (set (make-local-variable 'vc-parent-buffer-name) 1148 (set (make-local-variable 'vc-parent-buffer-name)
1139 (concat " from " (buffer-name vc-parent-buffer))) 1149 (concat " from " (buffer-name vc-parent-buffer)))
1140 (if file (vc-mode-line file)) 1150 (if file (vc-mode-line file))
1141 (if (fboundp 'log-edit) (vc-log-edit file) (vc-log-mode file)) 1151 (vc-log-edit file)
1142 (make-local-variable 'vc-log-after-operation-hook) 1152 (make-local-variable 'vc-log-after-operation-hook)
1143 (if after-hook 1153 (if after-hook
1144 (setq vc-log-after-operation-hook after-hook)) 1154 (setq vc-log-after-operation-hook after-hook))
@@ -1154,27 +1164,30 @@ specifies the local value for vc-log-operation-hook."
1154 (message "%s Type C-c C-c when done" msg)))) 1164 (message "%s Type C-c C-c when done" msg))))
1155 1165
1156(defun vc-checkout (file &optional writable rev) 1166(defun vc-checkout (file &optional writable rev)
1157 "Retrieve a copy of the latest version of the given file." 1167 "Retrieve a copy of the revision REV of FILE.
1158 (condition-case err 1168If WRITABLE is non-nil, make sure the retrieved file is writable.
1159 (vc-call checkout file writable rev) 1169REV defaults to the latest revision."
1160 (file-error 1170 (with-vc-properties
1161 ;; Maybe the backend is not installed ;-( 1171 file
1162 (when writable 1172 (condition-case err
1163 (let ((buf (get-file-buffer file))) 1173 (vc-call checkout file writable rev)
1164 (when buf (with-current-buffer buf (toggle-read-only -1))))) 1174 (file-error
1165 (signal (car err) (cdr err)))) 1175 ;; Maybe the backend is not installed ;-(
1166 (vc-file-setprop file 'vc-state 1176 (when writable
1167 (if (or (eq (vc-checkout-model file) 'implicit) 1177 (let ((buf (get-file-buffer file)))
1168 (not writable)) 1178 (when buf (with-current-buffer buf (toggle-read-only -1)))))
1169 (if (vc-call latest-on-branch-p file) 1179 (signal (car err) (cdr err))))
1170 'up-to-date 1180 `((vc-state ,(if (or (eq (vc-checkout-model file) 'implicit)
1171 'needs-patch) 1181 (not writable))
1172 'edited)) 1182 (if (vc-call latest-on-branch-p file)
1173 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) 1183 'up-to-date
1184 'needs-patch)
1185 'edited))
1186 (vc-checkout-time ,(nth 5 (file-attributes file)))))
1174 (vc-resynch-buffer file t t)) 1187 (vc-resynch-buffer file t t))
1175 1188
1176(defun vc-steal-lock (file rev owner) 1189(defun vc-steal-lock (file rev owner)
1177 "Steal the lock on the current workfile." 1190 "Steal the lock on FILE."
1178 (let (file-description) 1191 (let (file-description)
1179 (if rev 1192 (if rev
1180 (setq file-description (format "%s:%s" file rev)) 1193 (setq file-description (format "%s:%s" file rev))
@@ -1196,8 +1209,10 @@ specifies the local value for vc-log-operation-hook."
1196(defun vc-finish-steal (file version) 1209(defun vc-finish-steal (file version)
1197 ;; This is called when the notification has been sent. 1210 ;; This is called when the notification has been sent.
1198 (message "Stealing lock on %s..." file) 1211 (message "Stealing lock on %s..." file)
1199 (vc-call steal-lock file version) 1212 (with-vc-properties
1200 (vc-file-setprop file 'vc-state 'edited) 1213 file
1214 (vc-call steal-lock file version)
1215 `((vc-state edited)))
1201 (vc-resynch-buffer file t t) 1216 (vc-resynch-buffer file t t)
1202 (message "Stealing lock on %s...done" file)) 1217 (message "Stealing lock on %s...done" file))
1203 1218
@@ -1220,11 +1235,14 @@ Runs the normal hook `vc-checkin-hook'."
1220 ;; RCS 5.7 gripes about white-space-only comments too. 1235 ;; RCS 5.7 gripes about white-space-only comments too.
1221 (or (and comment (string-match "[^\t\n ]" comment)) 1236 (or (and comment (string-match "[^\t\n ]" comment))
1222 (setq comment "*** empty log message ***")) 1237 (setq comment "*** empty log message ***"))
1223 ;; Change buffers to get local value of vc-checkin-switches. 1238 (with-vc-properties
1224 (with-current-buffer (or (get-file-buffer file) (current-buffer)) 1239 file
1225 (vc-call checkin file rev comment)) 1240 ;; Change buffers to get local value of vc-checkin-switches.
1226 (vc-file-setprop file 'vc-state 'up-to-date) 1241 (with-current-buffer (or (get-file-buffer file) (current-buffer))
1227 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) 1242 (vc-call checkin file rev comment))
1243 `((vc-state up-to-date)
1244 (vc-checkout-time ,(nth 5 (file-attributes file)))
1245 (vc-workfile-version nil)))
1228 (message "Checking in %s...done" file)) 1246 (message "Checking in %s...done" file))
1229 'vc-checkin-hook)) 1247 'vc-checkin-hook))
1230 1248
@@ -1494,7 +1512,7 @@ If `F.~REV~' already exists, it is used instead of being re-created."
1494 1512
1495;;;###autoload 1513;;;###autoload
1496(defun vc-insert-headers () 1514(defun vc-insert-headers ()
1497 "Insert headers in a file for use with your version-control system. 1515 "Insert headers in a file for use with your version control system.
1498Headers desired are inserted at point, and are pulled from 1516Headers desired are inserted at point, and are pulled from
1499the variable `vc-BACKEND-header'." 1517the variable `vc-BACKEND-header'."
1500 (interactive) 1518 (interactive)
@@ -1524,8 +1542,8 @@ the variable `vc-BACKEND-header'."
1524 ))))) 1542 )))))
1525 1543
1526(defun vc-clear-headers (&optional file) 1544(defun vc-clear-headers (&optional file)
1527 "Clear all version headers in the current buffer (or FILE), i.e. reset them 1545 "Clear all version headers in the current buffer (or FILE).
1528to the non-expanded form." 1546I.e. reset them to the non-expanded form."
1529 (let* ((filename (or file buffer-file-name)) 1547 (let* ((filename (or file buffer-file-name))
1530 (visited (find-buffer-visiting filename)) 1548 (visited (find-buffer-visiting filename))
1531 (backend (vc-backend filename))) 1549 (backend (vc-backend filename)))
@@ -1543,22 +1561,22 @@ to the non-expanded form."
1543 (kill-buffer filename))))) 1561 (kill-buffer filename)))))
1544 1562
1545;;;###autoload 1563;;;###autoload
1546(defun vc-merge (&optional merge-news) 1564(defun vc-merge ()
1547 "Merge changes between two revisions into the work file. 1565 "Merge changes between two versions into the current buffer's file.
1548With prefix arg, merge news, i.e. recent changes from the current branch. 1566This asks for two versions to merge from in the minibuffer. If the
1567first version is a branch number, then merge all changes from that
1568branch. If the first version is empty, merge news, i.e. recent changes
1569from the current branch.
1549 1570
1550See Info node `Merging'." 1571See Info node `Merging'."
1551 (interactive "P") 1572 (interactive)
1552 (vc-ensure-vc-buffer) 1573 (vc-ensure-vc-buffer)
1553 (vc-buffer-sync) 1574 (vc-buffer-sync)
1554 (let* ((file buffer-file-name) 1575 (let* ((file buffer-file-name)
1555 (backend (vc-backend file)) 1576 (backend (vc-backend file))
1556 (state (vc-state file)) 1577 (state (vc-state file))
1557 first-version second-version) 1578 first-version second-version status)
1558 (cond 1579 (cond
1559 ((not (vc-find-backend-function backend
1560 (if merge-news 'merge-news 'merge)))
1561 (error "Sorry, merging is not implemented for %s" backend))
1562 ((stringp state) 1580 ((stringp state)
1563 (error "File is locked by %s" state)) 1581 (error "File is locked by %s" state))
1564 ((not (vc-editable-p file)) 1582 ((not (vc-editable-p file))
@@ -1566,23 +1584,26 @@ See Info node `Merging'."
1566 "File must be checked out for merging. Check out now? ") 1584 "File must be checked out for merging. Check out now? ")
1567 (vc-checkout file t) 1585 (vc-checkout file t)
1568 (error "Merge aborted")))) 1586 (error "Merge aborted"))))
1569 (unless merge-news 1587 (setq first-version
1570 (setq first-version (read-string "Branch or version to merge from: ")) 1588 (read-string (concat "Branch or version to merge from "
1571 (if (and (>= (elt first-version 0) ?0) 1589 "(default: news on current branch): ")))
1572 (<= (elt first-version 0) ?9)) 1590 (if (string= first-version "")
1573 (if (not (vc-branch-p first-version)) 1591 (if (not (vc-find-backend-function backend 'merge-news))
1574 (setq second-version 1592 (error "Sorry, merging news is not implemented for %s" backend)
1575 (read-string "Second version: " 1593 (setq status (vc-call merge-news file)))
1576 (concat (vc-branch-part first-version) "."))) 1594 (if (not (vc-find-backend-function backend 'merge))
1577 ;; We want to merge an entire branch. Set versions 1595 (error "Sorry, merging is not implemented for %s" backend)
1578 ;; accordingly, so that vc-backend-merge understands us. 1596 (if (not (vc-branch-p first-version))
1579 (setq second-version first-version) 1597 (setq second-version
1580 ;; first-version must be the starting point of the branch 1598 (read-string "Second version: "
1581 (setq first-version (vc-branch-part first-version))))) 1599 (concat (vc-branch-part first-version) ".")))
1582 (let ((status (if merge-news 1600 ;; We want to merge an entire branch. Set versions
1583 (vc-call merge-news file) 1601 ;; accordingly, so that vc-BACKEND-merge understands us.
1584 (vc-call merge file first-version second-version)))) 1602 (setq second-version first-version)
1585 (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))) 1603 ;; first-version must be the starting point of the branch
1604 (setq first-version (vc-branch-part first-version)))
1605 (setq status (vc-call merge file first-version second-version))))
1606 (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
1586 1607
1587(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) 1608(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
1588 (vc-resynch-buffer file t (not (buffer-modified-p))) 1609 (vc-resynch-buffer file t (not (buffer-modified-p)))
@@ -1693,10 +1714,12 @@ The conflicts must be marked with rcsmerge conflict markers."
1693(defvar vc-dired-mode-map 1714(defvar vc-dired-mode-map
1694 (let ((map (make-sparse-keymap)) 1715 (let ((map (make-sparse-keymap))
1695 (vmap (make-sparse-keymap))) 1716 (vmap (make-sparse-keymap)))
1696 (set-keymap-parent map dired-mode-map)
1697 (define-key map "\C-xv" vc-prefix-map) 1717 (define-key map "\C-xv" vc-prefix-map)
1718 ;; Emacs-20 has a lousy keymap inheritance that won't work here.
1719 ;; Emacs-21's is still lousy but just better enough that it'd work. -sm
1720 ;; (set-keymap-parent vmap vc-prefix-map)
1721 (setq vmap vc-prefix-map)
1698 (define-key map "v" vmap) 1722 (define-key map "v" vmap)
1699 (set-keymap-parent vmap vc-prefix-map)
1700 (define-key vmap "t" 'vc-dired-toggle-terse-mode) 1723 (define-key vmap "t" 'vc-dired-toggle-terse-mode)
1701 map)) 1724 map))
1702 1725
@@ -1715,6 +1738,10 @@ is redefined as the version control prefix, so that you can type
1715the file named in the current Dired buffer line. `vv' invokes 1738the file named in the current Dired buffer line. `vv' invokes
1716`vc-next-action' on this file, or on all files currently marked. 1739`vc-next-action' on this file, or on all files currently marked.
1717There is a special command, `*l', to mark all files currently locked." 1740There is a special command, `*l', to mark all files currently locked."
1741 ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
1742 ;; We do it here because dired might not be loaded yet
1743 ;; when vc-dired-mode-map is initialized.
1744 (set-keymap-parent vc-dired-mode-map dired-mode-map)
1718 (make-local-hook 'dired-after-readin-hook) 1745 (make-local-hook 'dired-after-readin-hook)
1719 (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t) 1746 (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
1720 ;; The following is slightly modified from dired.el, 1747 ;; The following is slightly modified from dired.el,
@@ -1885,14 +1912,15 @@ Called by dired after any portion of a vc-dired buffer has been read in."
1885(defun vc-dired-buffers-for-dir (dir) 1912(defun vc-dired-buffers-for-dir (dir)
1886 "Return a list of all vc-dired buffers that currently display DIR." 1913 "Return a list of all vc-dired buffers that currently display DIR."
1887 (let (result) 1914 (let (result)
1888 (mapcar (lambda (buffer) 1915 ;; Check whether dired is loaded.
1889 (with-current-buffer buffer 1916 (when (fboundp 'dired-buffers-for-dir)
1890 (if vc-dired-mode 1917 (mapcar (lambda (buffer)
1891 (setq result (append result (list buffer)))))) 1918 (with-current-buffer buffer
1892 (dired-buffers-for-dir dir)) 1919 (if vc-dired-mode
1920 (setq result (append result (list buffer))))))
1921 (dired-buffers-for-dir dir)))
1893 result)) 1922 result))
1894 1923
1895;;;###autoload
1896(defun vc-dired-resynch-file (file) 1924(defun vc-dired-resynch-file (file)
1897 "Update the entries for FILE in any VC Dired buffers that list it." 1925 "Update the entries for FILE in any VC Dired buffers that list it."
1898 (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file)))) 1926 (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
@@ -1932,11 +1960,11 @@ With prefix arg READ-SWITCHES, specify a value to override
1932;; Named-configuration entry points 1960;; Named-configuration entry points
1933 1961
1934(defun vc-snapshot-precondition (dir) 1962(defun vc-snapshot-precondition (dir)
1935 "Scan the tree below the current directory. If any files are 1963 "Scan the tree below DIR, looking for non-uptodate files.
1936locked, return the name of the first such file. \(This means, neither 1964If any file is not up-to-date, return the name of the first such file.
1937snapshot creation nor retrieval is allowed.\) If one or more of the 1965\(This means, neither snapshot creation nor retrieval is allowed.\)
1938files are currently visited, return `visited'. Otherwise, return 1966If one or more of the files are currently visited, return `visited'.
1939nil." 1967Otherwise, return nil."
1940 (let ((status nil)) 1968 (let ((status nil))
1941 (catch 'vc-locked-example 1969 (catch 'vc-locked-example
1942 (vc-file-tree-walk 1970 (vc-file-tree-walk
@@ -1976,10 +2004,11 @@ are checked out in that new branch."
1976 2004
1977;;;###autoload 2005;;;###autoload
1978(defun vc-retrieve-snapshot (dir name) 2006(defun vc-retrieve-snapshot (dir name)
1979 "Descending recursively from DIR, retrieve the snapshot called NAME, 2007 "Descending recursively from DIR, retrieve the snapshot called NAME.
1980or latest versions if NAME is empty. If locking is used for the files 2008If NAME is empty, it refers to the latest versions.
1981in DIR, then there must not be any locked files at or below DIR (but 2009If locking is used for the files in DIR, then there must not be any
1982if NAME is empty, locked files are allowed and simply skipped)." 2010locked files at or below DIR (but if NAME is empty, locked files are
2011allowed and simply skipped)."
1983 (interactive 2012 (interactive
1984 (list (read-file-name "Directory: " default-directory default-directory t) 2013 (list (read-file-name "Directory: " default-directory default-directory t)
1985 (read-string "Snapshot name to retrieve (default latest versions): "))) 2014 (read-string "Snapshot name to retrieve (default latest versions): ")))
@@ -2071,76 +2100,60 @@ use \\[universal-argument] \\[vc-next-action] to do so."
2071 (set-buffer obuf) 2100 (set-buffer obuf)
2072 ;; Do the reverting 2101 ;; Do the reverting
2073 (message "Reverting %s..." file) 2102 (message "Reverting %s..." file)
2074 (vc-call revert file) 2103 (with-vc-properties
2075 (vc-file-setprop file 'vc-state 'up-to-date) 2104 file
2076 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) 2105 (vc-call revert file)
2106 `((vc-state up-to-date)
2107 (vc-checkout-time (nth 5 (file-attributes file)))))
2077 (vc-resynch-buffer file t t) 2108 (vc-resynch-buffer file t t)
2078 (message "Reverting %s...done" file))) 2109 (message "Reverting %s...done" file)))
2079 2110
2080;;;###autoload 2111;;;###autoload
2081(defun vc-cancel-version (norevert) 2112(defun vc-cancel-version (norevert)
2082 "Get rid of most recently checked in version of this file. 2113 "Get rid of most recently checked in version of this file.
2083A prefix argument means do not revert the buffer afterwards." 2114A prefix argument NOREVERT means do not revert the buffer afterwards."
2084 (interactive "P") 2115 (interactive "P")
2085 (vc-ensure-vc-buffer) 2116 (vc-ensure-vc-buffer)
2086 (let* ((backend (vc-backend (buffer-file-name))) 2117 (let* ((file (buffer-file-name))
2087 (target (vc-workfile-version (buffer-file-name))) 2118 (backend (vc-backend file))
2088 (recent (if (vc-trunk-p target) "" (vc-branch-part target))) 2119 (target (vc-workfile-version file))
2089 (config (current-window-configuration)) done) 2120 (config (current-window-configuration)) done)
2090 (cond 2121 (cond
2091 ((not (vc-find-backend-function backend 'uncheck)) 2122 ((not (vc-find-backend-function backend 'cancel-version))
2092 (error "Sorry, canceling versions is not supported under %s" backend)) 2123 (error "Sorry, canceling versions is not supported under %s" backend))
2093 ((not (vc-call latest-on-branch-p (buffer-file-name))) 2124 ((not (vc-call latest-on-branch-p file))
2094 (error "This is not the latest version; VC cannot cancel it")) 2125 (error "This is not the latest version; VC cannot cancel it"))
2095 ((not (vc-up-to-date-p (buffer-file-name))) 2126 ((not (vc-up-to-date-p file))
2096 (error (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes")))) 2127 (error (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
2097 (if (null (yes-or-no-p (format "Remove version %s from master? " target))) 2128 (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
2098 nil 2129 (error "Aborted")
2099 (setq norevert (or norevert (not 2130 (setq norevert (or norevert (not
2100 (yes-or-no-p "Revert buffer to most recent remaining version? ")))) 2131 (yes-or-no-p "Revert buffer to most recent remaining version? "))))
2101 2132
2102 (message "Removing last change from %s..." (buffer-file-name)) 2133 (message "Removing last change from %s..." file)
2103 (vc-call uncheck (buffer-file-name) target) 2134 (with-vc-properties
2104 (message "Removing last change from %s...done" (buffer-file-name)) 2135 file
2105 2136 (vc-call cancel-version file norevert)
2106 ;; Check out the most recent remaining version. If it fails, because 2137 `((vc-state ,(if norevert 'edited 'up-to-date))
2107 ;; the whole branch got deleted, do a double-take and check out the 2138 (vc-checkout-time ,(if norevert
2108 ;; version where the branch started. 2139 0
2109 (while (not done) 2140 (nth 5 (file-attributes file))))
2110 (condition-case err 2141 (vc-workfile-version nil)))
2111 (progn 2142 (message "Removing last change from %s...done" file)
2112 (if norevert 2143
2113 ;; Check out locked, but only to disk, and keep 2144 (cond
2114 ;; modifications in the buffer. 2145 (norevert ;; clear version headers and mark the buffer modified
2115 (vc-call checkout (buffer-file-name) t recent) 2146 (set-visited-file-name file)
2116 ;; Check out unlocked, and revert buffer. 2147 (when (not vc-make-backup-files)
2117 (vc-checkout (buffer-file-name) nil recent)) 2148 ;; inhibit backup for this buffer
2118 (setq done t)) 2149 (make-local-variable 'backup-inhibited)
2119 ;; If the checkout fails, vc-do-command signals an error. 2150 (setq backup-inhibited t))
2120 ;; We catch this error, check the reason, correct the 2151 (setq buffer-read-only nil)
2121 ;; version number, and try a second time. 2152 (vc-clear-headers)
2122 ;; FIXME: This is still RCS-only code. 2153 (vc-mode-line file)
2123 (error (set-buffer "*vc*") 2154 (vc-dired-resynch-file file))
2124 (goto-char (point-min)) 2155 (t ;; revert buffer to file on disk
2125 (if (search-forward "no side branches present for" nil t) 2156 (vc-resynch-buffer file t t)))
2126 (progn (setq recent (vc-branch-part recent))
2127 ;; vc-do-command popped up a window with
2128 ;; the error message. Get rid of it, by
2129 ;; restoring the old window configuration.
2130 (set-window-configuration config))
2131 ;; No, it was some other error: re-signal it.
2132 (signal (car err) (cdr err))))))
2133 ;; If norevert, clear version headers and mark the buffer modified.
2134 (if norevert
2135 (progn
2136 (set-visited-file-name (buffer-file-name))
2137 (if (not vc-make-backup-files)
2138 ;; inhibit backup for this buffer
2139 (progn (make-local-variable 'backup-inhibited)
2140 (setq backup-inhibited t)))
2141 (setq buffer-read-only nil)
2142 (vc-clear-headers)
2143 (vc-mode-line (buffer-file-name))))
2144 (message "Version %s has been removed from the master" target)))) 2157 (message "Version %s has been removed from the master" target))))
2145 2158
2146(defun vc-rename-master (oldmaster newfile templates) 2159(defun vc-rename-master (oldmaster newfile templates)
@@ -2221,13 +2234,13 @@ A prefix argument means do not revert the buffer afterwards."
2221Normally, find log entries for all registered files in the default 2234Normally, find log entries for all registered files in the default
2222directory. 2235directory.
2223 2236
2224With prefix arg of C-u, only find log entries for the current buffer's file. 2237With prefix arg of \\[universal-argument], only find log entries for the current buffer's file.
2225 2238
2226With any numeric prefix arg, find log entries for all currently visited 2239With any numeric prefix arg, find log entries for all currently visited
2227files that are under version control. This puts all the entries in the 2240files that are under version control. This puts all the entries in the
2228log for the default directory, which may not be appropriate. 2241log for the default directory, which may not be appropriate.
2229 2242
2230From a program, any arguments are assumed to be filenames for which 2243From a program, any ARGS are assumed to be filenames for which
2231log entries should be gathered." 2244log entries should be gathered."
2232 (interactive 2245 (interactive
2233 (cond ((consp current-prefix-arg) ;C-u 2246 (cond ((consp current-prefix-arg) ;C-u
@@ -2251,8 +2264,8 @@ log entries should be gathered."
2251 'update-changelog args)) 2264 'update-changelog args))
2252 2265
2253(defun vc-default-update-changelog (backend files) 2266(defun vc-default-update-changelog (backend files)
2254 "Default implementation of update-changelog; uses `rcs2log' which only 2267 "Default implementation of update-changelog.
2255works for RCS and CVS." 2268Uses `rcs2log' which only works for RCS and CVS."
2256 ;; FIXME: We (c|sh)ould add support for cvs2cl 2269 ;; FIXME: We (c|sh)ould add support for cvs2cl
2257 (let ((odefault default-directory) 2270 (let ((odefault default-directory)
2258 (changelog (find-change-log)) 2271 (changelog (find-change-log))
@@ -2308,12 +2321,12 @@ works for RCS and CVS."
2308;; Declare globally instead of additional parameter to 2321;; Declare globally instead of additional parameter to
2309;; temp-buffer-show-function (not possible to pass more than one 2322;; temp-buffer-show-function (not possible to pass more than one
2310;; parameter). 2323;; parameter).
2311(defvar vc-annotate-ratio nil "Global variable") 2324(defvar vc-annotate-ratio nil "Global variable.")
2312(defvar vc-annotate-backend nil "Global variable") 2325(defvar vc-annotate-backend nil "Global variable.")
2313 2326
2314(defun vc-annotate-get-backend (buffer) 2327(defun vc-annotate-get-backend (buffer)
2315 "Return the backend matching \"Annotate\" buffer BUFFER. Return NIL 2328 "Return the backend matching \"Annotate\" buffer BUFFER.
2316if no match made. Associations are made based on 2329Return NIL if no match made. Associations are made based on
2317`vc-annotate-buffers'." 2330`vc-annotate-buffers'."
2318 (cdr (assoc buffer vc-annotate-buffers))) 2331 (cdr (assoc buffer vc-annotate-buffers)))
2319 2332
@@ -2385,6 +2398,9 @@ colors. `vc-annotate-background' specifies the background color."
2385 (temp-buffer-show-function 'vc-annotate-display) 2398 (temp-buffer-show-function 'vc-annotate-display)
2386 (vc-annotate-ratio ratio) 2399 (vc-annotate-ratio ratio)
2387 (vc-annotate-backend (vc-backend (buffer-file-name)))) 2400 (vc-annotate-backend (vc-backend (buffer-file-name))))
2401 (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
2402 (error "Sorry, annotating is not implemented for %s"
2403 vc-annotate-backend))
2388 (with-output-to-temp-buffer temp-buffer-name 2404 (with-output-to-temp-buffer temp-buffer-name
2389 (vc-call-backend vc-annotate-backend 'annotate-command 2405 (vc-call-backend vc-annotate-backend 'annotate-command
2390 (file-name-nondirectory (buffer-file-name)) 2406 (file-name-nondirectory (buffer-file-name))
@@ -2404,7 +2420,7 @@ colors. `vc-annotate-background' specifies the background color."
2404 (car (car a-list)))) 2420 (car (car a-list))))
2405 2421
2406(defun vc-annotate-time-span (a-list span &optional quantize) 2422(defun vc-annotate-time-span (a-list span &optional quantize)
2407"Apply factor SPAN to the time-span of association list A-LIST 2423"Apply factor SPAN to the time-span of association list A-LIST.
2408Return the new alist. 2424Return the new alist.
2409Optionally quantize to the factor of QUANTIZE." 2425Optionally quantize to the factor of QUANTIZE."
2410 ;; Apply span to each car of every cons 2426 ;; Apply span to each car of every cons
@@ -2438,10 +2454,10 @@ nil otherwise"
2438;;;; the relevant backend. 2454;;;; the relevant backend.
2439 2455
2440(defun vc-annotate-display (buffer &optional color-map backend) 2456(defun vc-annotate-display (buffer &optional color-map backend)
2441 "Do the VC-Annotate display in BUFFER using COLOR-MAP. The original 2457 "Do the VC-Annotate display in BUFFER using COLOR-MAP.
2442Annotating file is supposed to be handled by BACKEND. If BACKEND is 2458The original annotating file is supposed to be handled by BACKEND.
2443NIL, variable VC-ANNOTATE-BACKEND is used instead. This function is 2459If BACKEND is NIL, variable VC-ANNOTATE-BACKEND is used instead.
2444destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil." 2460This function is destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
2445 2461
2446 ;; Handle the case of the global variable vc-annotate-ratio being 2462 ;; Handle the case of the global variable vc-annotate-ratio being
2447 ;; set. This variable is used to pass information from function 2463 ;; set. This variable is used to pass information from function
@@ -2495,9 +2511,6 @@ destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
2495 2511
2496(defalias 'vc-default-logentry-check 'ignore) 2512(defalias 'vc-default-logentry-check 'ignore)
2497 2513
2498(defun vc-default-merge-news (backend file)
2499 (error "vc-merge-news not meaningful for %s files" backend))
2500
2501(defun vc-check-headers () 2514(defun vc-check-headers ()
2502 "Check if the current file has any headers in it." 2515 "Check if the current file has any headers in it."
2503 (interactive) 2516 (interactive)
@@ -2507,7 +2520,7 @@ destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
2507 2520
2508;; Set up key bindings for use while editing log messages 2521;; Set up key bindings for use while editing log messages
2509 2522
2510(defun vc-log-mode (&optional file) 2523(define-derived-mode vc-log-mode text-mode "VC-Log"
2511 "Major mode for editing VC log entries. 2524 "Major mode for editing VC log entries.
2512These bindings are added to the global keymap when you enter this mode: 2525These bindings are added to the global keymap when you enter this mode:
2513\\[vc-next-action] perform next logical version-control operation on current file 2526\\[vc-next-action] perform next logical version-control operation on current file
@@ -2564,29 +2577,26 @@ Global user options:
2564 `vc-command-messages' if non-nil, display run messages from the 2577 `vc-command-messages' if non-nil, display run messages from the
2565 actual version-control utilities (this is 2578 actual version-control utilities (this is
2566 intended primarily for people hacking vc 2579 intended primarily for people hacking vc
2567 itself). 2580 itself)."
2568" 2581 (make-local-variable 'vc-comment-ring-index))
2569 (interactive)
2570 (set-syntax-table text-mode-syntax-table)
2571 (use-local-map vc-log-mode-map)
2572 (setq local-abbrev-table text-mode-abbrev-table)
2573 (setq major-mode 'vc-log-mode)
2574 (setq mode-name "VC-Log")
2575 (make-local-variable 'vc-log-file)
2576 (setq vc-log-file file)
2577 (make-local-variable 'vc-log-version)
2578 (make-local-variable 'vc-comment-ring-index)
2579 (set-buffer-modified-p nil)
2580 (setq buffer-file-name nil)
2581 (run-hooks 'text-mode-hook 'vc-log-mode-hook))
2582 2582
2583(defun vc-log-edit (file) 2583(defun vc-log-edit (file)
2584 "Interface between VC and `log-edit'." 2584 "Set up `log-edit' for use with VC on FILE.
2585 (setq default-directory (file-name-directory file)) 2585If `log-edit' is not available, resort to `vc-log-mode'."
2586 (log-edit 'vc-finish-logentry nil 2586 (setq default-directory
2587 `(lambda () ',(list (file-name-nondirectory file)))) 2587 (if file (file-name-directory file)
2588 (with-current-buffer vc-parent-buffer default-directory)))
2589 (if (fboundp 'log-edit)
2590 (log-edit 'vc-finish-logentry nil
2591 (if file `(lambda () ',(list (file-name-nondirectory file)))
2592 ;; If FILE is nil, we were called from vc-dired.
2593 (lambda ()
2594 (with-current-buffer vc-parent-buffer
2595 (dired-get-marked-files t)))))
2596 (vc-log-mode))
2588 (set (make-local-variable 'vc-log-file) file) 2597 (set (make-local-variable 'vc-log-file) file)
2589 (make-local-variable 'vc-log-version) 2598 (make-local-variable 'vc-log-version)
2599 (set-buffer-modified-p nil)
2590 (setq buffer-file-name nil)) 2600 (setq buffer-file-name nil))
2591 2601
2592;;; These things should probably be generally available 2602;;; These things should probably be generally available