aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGerd Moellmann2000-09-04 19:47:25 +0000
committerGerd Moellmann2000-09-04 19:47:25 +0000
commit0e0d98319e3360bcfd12aabd3bc82a72aec700e6 (patch)
tree1cf24209abb58bcd23b9fb655fcc89bfb086cb4d
parent0769107a3c4214e26f1debd97553b67c90d0205c (diff)
downloademacs-0e0d98319e3360bcfd12aabd3bc82a72aec700e6.tar.gz
emacs-0e0d98319e3360bcfd12aabd3bc82a72aec700e6.zip
Minor doc fixes.
(vc-default-mode-line-string): Show state `needs-patch' as a `-' too. (vc-after-save): Call vc-dired-resynch-file. (vc-file-not-found-hook): Ask the user whether to check out a non-existing file. (vc-find-backend-function): If function doesn't exist, return nil instead of error. (vc-call-backend): Doc fix. (vc-prefix-map): Move the autoload from vc.el. (vc-simple-command): Removed. (vc-handled-backends): Docstring change. (vc-ignore-vc-files): Mark obsolete. (vc-registered): Check vc-ignore-vc-files. (vc-find-file-hook, vc-file-not-found-hook): Don't check vc-ignore-vc-files. (vc-parse-buffer): Lobotomize the monster. (vc-simple-command): Docstring fix. (vc-registered): Align the way the file-handler is called with the way the function itself works. (vc-file-owner): Remove. (vc-header-alist): Move the dummy def from vc.el. (vc-backend-hook-functions): Remove. (vc-find-backend-function): Don't try to load vc-X-hooks anymore. (vc-backend): Reintroduce the test for `file = nil' now that I know why it was there (and added a comment to better remember). Update Copyright. (vc-backend): Don't accept a nil argument any more. (vc-up-to-date-p): Turn into a defsubst. (vc-possible-master): New function. (vc-check-master-templates): Use `vc-possible-master' and allow funs in vc-X-master-templates to return a non-existent file. (vc-loadup): Remove. (vc-find-backend-function): Use `require'. Also, handle the case where vc-BACKEND-hooks.el doesn't exist. (vc-call-backend): Cleanup. (vc-find-backend-function): Return a cons cell if using the default function. (vc-call-backend): If calling the default function, pass it the backend as first argument. Update the docstring accordingly. (vc-default-state-heuristic, vc-default-mode-line-string): Update for the new backend argument. (vc-make-backend-sym): Renamed from vc-make-backend-function. (vc-find-backend-function): Use the new name. (vc-default-registered): New function. (vc-backend-functions): Remove. (vc-loadup): Don't setup 'vc-functions. (vc-find-backend-function): New function. (vc-call-backend): Use above fun and populate 'vc-functions lazily. (vc-backend-defines): Remove. (vc-backend-hook-functions, vc-backend-functions) (vc-make-backend-function, vc-call): Pass names without leading `vc-' to vc-call-backend so we can blindly prefix them with vc-BACKEND. (vc-loadup): Don't load vc-X-hooks if vc-X is requested. (vc-call-backend): Always try to load vc-X-hooks. (vc-registered): Remove vc- in call to vc-call-backend. (vc-default-back-end, vc-buffer-backend): Remove. (vc-kill-buffer-hook): Remove `vc-buffer-backend' handling. (vc-loadup): Load files quietly. (vc-call-backend): Oops, brain fart. (vc-locking-user): If locked by the calling user, return that name. Redocumented. (vc-user-login-name): Simplify the code a tiny bit. (vc-state): Don't use 'reserved any more. Just use the same convention as the one used for vc-<backend>-state where the locking user (as a string) is returned. (vc-locking-user): Update, based on the above convention. The 'vc-locking-user property has disappeared. (vc-mode-line, vc-default-mode-line-string): Adapt to new `vc-state'. (vc-backend-functions): Removed vc-toggle-read-only. (vc-toggle-read-only): Undid prev change. (vc-master-templates): Def the obsolete var. (vc-file-prop-obarray): Use `make-vector'. (vc-backend-functions): Add new hookable functions vc-toggle-read-only, vc-record-rename and vc-merge-news. (vc-loadup): If neither backend nor default functions exist, use the backend function rather than nil. (vc-call-backend): If the function if not bound yet, try to load the non-hook file to see if it provides it. (vc-call): New macro plus use it wherever possible. (vc-backend-subdirectory-name): Use neither `vc-default-back-end' nor `vc-find-binary' since it's only called from vc-mistrust-permission which is only used once the backend is known. (vc-checkout-model): Fix parenthesis. (vc-recompute-state, vc-prefix-map): Move to vc.el. (vc-backend-functions): Renamed `vc-steal' to `vc-steal-lock'. (vc-call-backend): Changed error message. (vc-state): Added description of state `unlocked-changes'. (vc-backend-hook-functions, vc-backend-functions): Updated function lists. (vc-call-backend): Fixed typo. (vc-backend-hook-functions): Renamed vc-uses-locking to vc-checkout-model. (vc-checkout-required): Renamed to vc-checkout-model. Re-implemented and re-commented. (vc-after-save): Use vc-checkout-model. (vc-backend-functions): Added `vc-diff' to the list of functions possibly implemented in a vc-BACKEND library. (vc-checkout-required): Bug fixed that caused an error to be signaled during `vc-after-save'. (vc-backend-hook-functions): `vc-checkout-required' updated to `vc-uses-locking'. (vc-checkout-required): Call to backend function `vc-checkout-required' updated to `vc-uses-locking' instead. (vc-parse-buffer): Bug found and fixed. (vc-backend-functions): `vc-annotate-command', `vc-annotate-difference' added to supported backend functions. vc-state-heuristic added to vc-backend-hook-functions. Implemented new state model. (vc-state, vc-state-heuristic, vc-default-state-heuristic): New functions. (vc-locking-user): Simplified. Now only needed if the file is locked by somebody else. (vc-lock-from-permissions): Removed. Functionality is in vc-sccs-hooks.el and vc-rcs-hooks.el now. (vc-mode-line-string): New name for former vc-status. Adapted. (vc-mode-line): Adapted to use the above. Removed optional parameter. (vc-master-templates): Is really obsolete. Commented out the definition for now. What is the right procedure to get rid of it? (vc-registered, vc-backend, vc-buffer-backend, vc-name): Largely rewritten. (vc-default-registered): Removed. (vc-check-master-templates): New function; does mostly what the above did before. (vc-locking-user): Don't rely on the backend to set the property. (vc-latest-version, vc-your-latest-version): Removed. (vc-backend-hook-functions): Removed them from this list, too. (vc-fetch-properties): Removed. (vc-workfile-version): Doc fix. (vc-consult-rcs-headers): Moved into vc-rcs-hooks.el, under the name vc-rcs-consult-headers. (vc-master-locks, vc-master-locking-user): Moved into both vc-rcs-hooks.el and vc-sccs-hooks.el. These properties and access functions are implementation details of those two backends. (vc-parse-locks, vc-fetch-master-properties): Split into back-end specific parts and removed. Callers not updated yet; because I guess these callers will disappear into back-end specific files anyway. (vc-checkout-model): Renamed to vc-uses-locking. Store yes/no in the property, and return t/nil. Updated all callers. (vc-checkout-model): Punt to backends. (vc-default-locking-user): New function. (vc-locking-user, vc-workfile-version): Punt to backends. (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff) (vc-master-workfile-version): Moved from vc-hooks. (vc-lock-file): Moved to vc-sccs-hooks and renamed. (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): Moved to vc-cvs-hooks. Add doc strings in various places. Simplify the minor mode setup. (vc-handled-backends): New user variable. (vc-parse-buffer, vc-insert-file, vc-default-registered): Minor simplification. (vc-backend-hook-functions, vc-backend-functions): New variable. (vc-make-backend-function, vc-loadup, vc-call-backend) (vc-backend-defines): New functions. Various doc fixes. (vc-default-back-end, vc-follow-symlinks): Custom fix. (vc-match-substring): Function removed. Callers changed to use match-string. (vc-lock-file, vc-consult-rcs-headers, vc-kill-buffer-hook): Simplify. vc-registered has been renamed vc-default-registered. Some functions have been moved to the backend specific files. they all support the vc-BACKEND-registered functions. This is 1998-11-11T18:47:32Z!kwzh@gnu.org from the emacs sources
-rw-r--r--lisp/vc-hooks.el1285
1 files changed, 362 insertions, 923 deletions
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 5591d490810..efb7a973405 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -1,11 +1,11 @@
1;;; vc-hooks.el --- resident support for version-control 1;;; vc-hooks.el --- resident support for version-control
2 2
3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998 Free Software Foundation, Inc. 3;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc.
4 4
5;; Author: Eric S. Raymond <esr@snark.thyrsus.com> 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-hooks.el,v 1.1 2000/01/10 13:25:12 gerd Exp gerd $ 8;; $Id: vc-hooks.el,v 1.53 2000/08/13 11:36:46 spiegel Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -26,32 +26,28 @@
26 26
27;;; Commentary: 27;;; Commentary:
28 28
29;; This is the always-loaded portion of VC. 29;; This is the always-loaded portion of VC. It takes care of
30;; It takes care VC-related activities that are done when you visit a file, 30;; VC-related activities that are done when you visit a file, so that
31;; so that vc.el itself is loaded only when you use a VC command. 31;; vc.el itself is loaded only when you use a VC command. See the
32;; See the commentary of vc.el. 32;; commentary of vc.el.
33 33
34;;; Code: 34;;; Code:
35 35
36;; Customization Variables (the rest is in vc.el) 36;; Customization Variables (the rest is in vc.el)
37 37
38(defcustom vc-default-back-end nil 38(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.")
39 "*Back-end actually used by this interface; may be SCCS or RCS. 39(defvar vc-master-templates () "Obsolete -- use vc-BACKEND-master-templates.")
40The value is only computed when needed to avoid an expensive search." 40(defvar vc-header-alist () "Obsolete -- use vc-BACKEND-header.")
41 :type '(choice (const nil) (const RCS) (const SCCS)) 41
42 :group 'vc) 42(defcustom vc-handled-backends '(RCS CVS SCCS)
43 43 "*List of version control backends for which VC will be used.
44(defcustom vc-handle-cvs t 44Entries in this list will be tried in order to determine whether a
45 "*If non-nil, use VC for files managed with CVS. 45file is under that sort of version control.
46If it is nil, don't use VC for those files." 46Removing an entry from the list prevents VC from being activated
47 :type 'boolean 47when visiting a file managed by that backend.
48 :group 'vc) 48An empty list disables VC altogether."
49 49 :type '(repeat symbol)
50(defcustom vc-rcsdiff-knows-brief nil 50 :version "20.5"
51 "*Indicates whether rcsdiff understands the --brief option.
52The value is either `yes', `no', or nil. If it is nil, VC tries
53to use --brief and sets this variable to remember whether it worked."
54 :type '(choice (const nil) (const yes) (const no))
55 :group 'vc) 51 :group 'vc)
56 52
57(defcustom vc-path 53(defcustom vc-path
@@ -62,18 +58,6 @@ to use --brief and sets this variable to remember whether it worked."
62 :type '(repeat directory) 58 :type '(repeat directory)
63 :group 'vc) 59 :group 'vc)
64 60
65(defcustom vc-master-templates
66 '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
67 ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
68 vc-find-cvs-master
69 vc-search-sccs-project-dir)
70 "*Where to look for version-control master files.
71The first pair corresponding to a given back end is used as a template
72when creating new masters.
73Setting this variable to nil turns off use of VC entirely."
74 :type '(repeat sexp)
75 :group 'vc)
76
77(defcustom vc-make-backup-files nil 61(defcustom vc-make-backup-files nil
78 "*If non-nil, backups of registered files are made as with other files. 62 "*If non-nil, backups of registered files are made as with other files.
79If nil (the default), files covered by version control don't get backups." 63If nil (the default), files covered by version control don't get backups."
@@ -81,15 +65,17 @@ If nil (the default), files covered by version control don't get backups."
81 :group 'vc) 65 :group 'vc)
82 66
83(defcustom vc-follow-symlinks 'ask 67(defcustom vc-follow-symlinks 'ask
84 "*Indicates what to do if you visit a symbolic link to a file 68 "*What to do if visiting a symbolic link to a file under version control.
85that is under version control. Editing such a file through the 69Editing such a file through the link bypasses the version control system,
86link bypasses the version control system, which is dangerous and 70which is dangerous and probably not what you want.
87probably not what you want. 71
88 If this variable is t, VC follows the link and visits the real file, 72If this variable is t, VC follows the link and visits the real file,
89telling you about it in the echo area. If it is `ask', VC asks for 73telling you about it in the echo area. If it is `ask', VC asks for
90confirmation whether it should follow the link. If nil, the link is 74confirmation whether it should follow the link. If nil, the link is
91visited and a warning displayed." 75visited and a warning displayed."
92 :type '(choice (const ask) (const nil) (const t)) 76 :type '(choice (const :tag "Ask for confirmation" ask)
77 (const :tag "Visit link and warn" nil)
78 (const :tag "Follow link" t))
93 :group 'vc) 79 :group 'vc)
94 80
95(defcustom vc-display-status t 81(defcustom vc-display-status t
@@ -112,133 +98,109 @@ value of this flag."
112 :group 'vc) 98 :group 'vc)
113 99
114(defcustom vc-mistrust-permissions nil 100(defcustom vc-mistrust-permissions nil
115 "*If non-nil, don't assume that permissions and ownership track 101 "*If non-nil, don't assume permissions/ownership track version-control status.
116version-control status. If nil, do rely on the permissions. 102If nil, do rely on the permissions.
117See also variable `vc-consult-headers'." 103See also variable `vc-consult-headers'."
118 :type 'boolean 104 :type 'boolean
119 :group 'vc) 105 :group 'vc)
120 106
121(defcustom vc-ignore-vc-files nil
122 "*If non-nil don't look for version control information when finding files.
123
124It may be useful to set this if (say) you edit files in a directory
125containing corresponding RCS files but don't have RCS available;
126similarly for other version control systems."
127 :type 'boolean
128 :group 'vc
129 :version "20.3")
130
131(defun vc-mistrust-permissions (file) 107(defun vc-mistrust-permissions (file)
132 ;; Access function to the above. 108 "Internal access function to variable `vc-mistrust-permissions' for FILE."
133 (or (eq vc-mistrust-permissions 't) 109 (or (eq vc-mistrust-permissions 't)
134 (and vc-mistrust-permissions 110 (and vc-mistrust-permissions
135 (funcall vc-mistrust-permissions 111 (funcall vc-mistrust-permissions
136 (vc-backend-subdirectory-name file))))) 112 (vc-backend-subdirectory-name file)))))
137 113
138;; Tell Emacs about this new kind of minor mode 114;; Tell Emacs about this new kind of minor mode
139(if (not (assoc 'vc-mode minor-mode-alist)) 115(add-to-list 'minor-mode-alist '(vc-mode vc-mode))
140 (setq minor-mode-alist (cons '(vc-mode vc-mode)
141 minor-mode-alist)))
142 116
143(make-variable-buffer-local 'vc-mode) 117(make-variable-buffer-local 'vc-mode)
144(put 'vc-mode 'permanent-local t) 118(put 'vc-mode 'permanent-local t)
145 119
146;; We need a notion of per-file properties because the version 120;; We need a notion of per-file properties because the version
147;; control state of a file is expensive to derive --- we compute 121;; control state of a file is expensive to derive --- we compute
148;; them when the file is initially found, keep them up to date 122;; them when the file is initially found, keep them up to date
149;; during any subsequent VC operations, and forget them when 123;; during any subsequent VC operations, and forget them when
150;; the buffer is killed. 124;; the buffer is killed.
151 125
152(defmacro vc-error-occurred (&rest body) 126(defmacro vc-error-occurred (&rest body)
153 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) 127 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
154 128
155(defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] 129(defvar vc-file-prop-obarray (make-vector 16 0)
156 "Obarray for per-file properties.") 130 "Obarray for per-file properties.")
157 131
158(defvar vc-buffer-backend t)
159(make-variable-buffer-local 'vc-buffer-backend)
160
161(defun vc-file-setprop (file property value) 132(defun vc-file-setprop (file property value)
162 ;; set per-file property 133 "Set per-file VC PROPERTY for FILE to VALUE."
163 (put (intern file vc-file-prop-obarray) property value)) 134 (put (intern file vc-file-prop-obarray) property value))
164 135
165(defun vc-file-getprop (file property) 136(defun vc-file-getprop (file property)
166 ;; get per-file property 137 "get per-file VC PROPERTY for FILE."
167 (get (intern file vc-file-prop-obarray) property)) 138 (get (intern file vc-file-prop-obarray) property))
168 139
169(defun vc-file-clearprops (file) 140(defun vc-file-clearprops (file)
170 ;; clear all properties of a given file 141 "Clear all VC properties of FILE."
171 (setplist (intern file vc-file-prop-obarray) nil)) 142 (setplist (intern file vc-file-prop-obarray) nil))
172 143
173;;; Functions that determine property values, by examining the 144
174;;; working file, the master file, or log program output 145;; We keep properties on each symbol naming a backend as follows:
175 146;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
176(defun vc-match-substring (bn) 147
177 (buffer-substring (match-beginning bn) (match-end bn))) 148(defun vc-make-backend-sym (backend sym)
178 149 "Return BACKEND-specific version of VC symbol SYM."
179(defun vc-lock-file (file) 150 (intern (concat "vc-" (downcase (symbol-name backend))
180 ;; Generate lock file name corresponding to FILE 151 "-" (symbol-name sym))))
181 (let ((master (vc-name file))) 152
182 (and 153(defun vc-find-backend-function (backend fun)
183 master 154 "Return BACKEND-specific implementation of FUN.
184 (string-match "\\(.*/\\)s\\.\\(.*\\)" master) 155If there is no such implementation, return the default implementation;
185 (concat 156if that doesn't exist either, return nil."
186 (substring master (match-beginning 1) (match-end 1)) 157 (let ((f (vc-make-backend-sym backend fun)))
187 "p." 158 (if (fboundp f) f
188 (substring master (match-beginning 2) (match-end 2)))))) 159 ;; Load vc-BACKEND.el if needed.
189 160 (require (intern (concat "vc-" (downcase (symbol-name backend)))))
190(defun vc-parse-buffer (patterns &optional file properties) 161 (if (fboundp f) f
191 ;; Use PATTERNS to parse information out of the current buffer. 162 (let ((def (vc-make-backend-sym 'default fun)))
192 ;; Each element of PATTERNS is a list of 2 to 3 elements. The first element 163 (if (fboundp def) (cons def backend) nil))))))
193 ;; is the pattern to be matched, and the second (an integer) is the 164
194 ;; number of the subexpression that should be returned. If there's 165(defun vc-call-backend (backend function-name &rest args)
195 ;; a third element (also the number of a subexpression), that 166 "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
196 ;; subexpression is assumed to be a date field and we want the most 167Calls
197 ;; recent entry matching the template; this works for RCS format dates only. 168
198 ;; If FILE and PROPERTIES are given, the latter must be a list of 169 (apply 'vc-BACKEND-FUN ARGS)
199 ;; properties of the same length as PATTERNS; each property is assigned 170
200 ;; the corresponding value. 171if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
201 (mapcar (function (lambda (p) 172and else calls
202 (goto-char (point-min)) 173
203 (cond 174 (apply 'vc-default-FUN BACKEND ARGS)
204 ((eq (length p) 2) ;; search for first entry 175
205 (let ((value nil)) 176It is usually called via the `vc-call' macro."
206 (if (re-search-forward (car p) nil t) 177 (let ((f (cdr (assoc function-name (get backend 'vc-functions)))))
207 (setq value (vc-match-substring (elt p 1)))) 178 (unless f
208 (if file 179 (setq f (vc-find-backend-function backend function-name))
209 (progn (vc-file-setprop file (car properties) value) 180 (put backend 'vc-functions (cons (cons function-name f)
210 (setq properties (cdr properties)))) 181 (get backend 'vc-functions))))
211 value)) 182 (if (consp f)
212 ((eq (length p) 3) ;; search for latest entry 183 (apply (car f) (cdr f) args)
213 (let ((latest-date "") (latest-val)) 184 (apply f args))))
214 (while (re-search-forward (car p) nil t) 185
215 (let ((date (vc-match-substring (elt p 2)))) 186(defmacro vc-call (fun file &rest args)
216 ;; Most (but not all) versions of RCS use two-digit years 187 ;; BEWARE!! `file' is evaluated twice!!
217 ;; to represent dates in the range 1900 through 1999. 188 `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
218 ;; The two-digit and four-digit notations can both appear 189
219 ;; in the same file. Normalize the two-digit versions. 190
220 (save-match-data 191(defsubst vc-parse-buffer (pattern i)
221 (if (string-match "\\`[0-9][0-9]\\." date) 192 "Find PATTERN in the current buffer and return its Ith submatch."
222 (setq date (concat "19" date)))) 193 (goto-char (point-min))
223 (if (string< latest-date date) 194 (if (re-search-forward pattern nil t)
224 (progn 195 (match-string i)))
225 (setq latest-date date)
226 (setq latest-val
227 (vc-match-substring (elt p 1)))))))
228 (if file
229 (progn (vc-file-setprop file (car properties) latest-val)
230 (setq properties (cdr properties))))
231 latest-val)))))
232 patterns)
233 )
234 196
235(defun vc-insert-file (file &optional limit blocksize) 197(defun vc-insert-file (file &optional limit blocksize)
236 ;; Insert the contents of FILE into the current buffer. 198 "Insert the contents of FILE into the current buffer.
237 ;; Optional argument LIMIT is a regexp. If present, 199
238 ;; the file is inserted in chunks of size BLOCKSIZE 200Optional argument LIMIT is a regexp. If present, the file is inserted
239 ;; (default 8 kByte), until the first occurrence of 201in chunks of size BLOCKSIZE (default 8 kByte), until the first
240 ;; LIMIT is found. The function returns nil if FILE 202occurrence of LIMIT is found. The function returns nil if FILE doesn't
241 ;; doesn't exist. 203exist."
242 (erase-buffer) 204 (erase-buffer)
243 (cond ((file-exists-p file) 205 (cond ((file-exists-p file)
244 (cond (limit 206 (cond (limit
@@ -247,10 +209,9 @@ similarly for other version control systems."
247 (while (not found) 209 (while (not found)
248 (setq s (buffer-size)) 210 (setq s (buffer-size))
249 (goto-char (1+ s)) 211 (goto-char (1+ s))
250 (setq found 212 (setq found
251 (or (zerop (car (cdr 213 (or (zerop (cadr (insert-file-contents
252 (insert-file-contents file nil s 214 file nil s (+ s blocksize))))
253 (+ s blocksize)))))
254 (progn (beginning-of-line) 215 (progn (beginning-of-line)
255 (re-search-forward limit nil t))))))) 216 (re-search-forward limit nil t)))))))
256 (t (insert-file-contents file))) 217 (t (insert-file-contents file)))
@@ -259,712 +220,213 @@ similarly for other version control systems."
259 t) 220 t)
260 (t nil))) 221 (t nil)))
261 222
262(defun vc-parse-locks (file locks)
263 ;; Parse RCS or SCCS locks.
264 ;; The result is a list of the form ((VERSION USER) (VERSION USER) ...),
265 ;; which is returned and stored into the property `vc-master-locks'.
266 (if (not locks)
267 (vc-file-setprop file 'vc-master-locks 'none)
268 (let ((found t) (index 0) master-locks version user)
269 (cond ((eq (vc-backend file) 'SCCS)
270 (while (string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
271 locks index)
272 (setq version (substring locks
273 (match-beginning 1) (match-end 1)))
274 (setq user (substring locks
275 (match-beginning 2) (match-end 2)))
276 (setq master-locks (append master-locks
277 (list (cons version user))))
278 (setq index (match-end 0))))
279 ((eq (vc-backend file) 'RCS)
280 (while (string-match "[ \t\n]*\\([^:]+\\):\\([0-9.]+\\)"
281 locks index)
282 (setq version (substring locks
283 (match-beginning 2) (match-end 2)))
284 (setq user (substring locks
285 (match-beginning 1) (match-end 1)))
286 (setq master-locks (append master-locks
287 (list (cons version user))))
288 (setq index (match-end 0)))
289 (if (string-match ";[ \t\n]+strict;" locks index)
290 (vc-file-setprop file 'vc-checkout-model 'manual)
291 (vc-file-setprop file 'vc-checkout-model 'implicit))))
292 (vc-file-setprop file 'vc-master-locks (or master-locks 'none)))))
293
294(defun vc-simple-command (okstatus command file &rest args)
295 ;; Simple version of vc-do-command, for use in vc-hooks only.
296 ;; Don't switch to the *vc-info* buffer before running the
297 ;; command, because that would change its default directory
298 (save-excursion (set-buffer (get-buffer-create "*vc-info*"))
299 (erase-buffer))
300 (let ((exec-path (append vc-path exec-path)) exec-status
301 ;; Add vc-path to PATH for the execution of this command.
302 (process-environment
303 (cons (concat "PATH=" (getenv "PATH")
304 path-separator
305 (mapconcat 'identity vc-path path-separator))
306 process-environment)))
307 (setq exec-status
308 (apply 'call-process command nil "*vc-info*" nil
309 (append args (list file))))
310 (cond ((> exec-status okstatus)
311 (switch-to-buffer (get-file-buffer file))
312 (shrink-window-if-larger-than-buffer
313 (display-buffer "*vc-info*"))
314 (error "Couldn't find version control information")))
315 exec-status))
316
317(defun vc-parse-cvs-status (&optional full)
318 ;; Parse output of "cvs status" command in the current buffer and
319 ;; set file properties accordingly. Unless FULL is t, parse only
320 ;; essential information.
321 (let (file status)
322 (goto-char (point-min))
323 (if (re-search-forward "^File: " nil t)
324 (cond
325 ((looking-at "no file") nil)
326 ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
327 (setq file (concat default-directory (match-string 1)))
328 (vc-file-setprop file 'vc-backend 'CVS)
329 (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
330 (setq status "Unknown")
331 (setq status (match-string 1)))
332 (if (and full
333 (re-search-forward
334 "\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)"
335 nil t))
336 (vc-file-setprop file 'vc-latest-version (match-string 2)))
337 (cond
338 ((string-match "Up-to-date" status)
339 (vc-file-setprop file 'vc-cvs-status 'up-to-date)
340 (vc-file-setprop file 'vc-checkout-time
341 (nth 5 (file-attributes file))))
342 ((vc-file-setprop file 'vc-cvs-status
343 (cond
344 ((string-match "Locally Modified" status) 'locally-modified)
345 ((string-match "Needs Merge" status) 'needs-merge)
346 ((string-match "Needs \\(Checkout\\|Patch\\)" status)
347 'needs-checkout)
348 ((string-match "Unresolved Conflict" status)
349 'unresolved-conflict)
350 ((string-match "File had conflicts on merge" status)
351 'unresolved-conflict)
352 ((string-match "Locally Added" status) 'locally-added)
353 ((string-match "New file!" status) 'locally-added)
354 (t 'unknown))))))))))
355
356(defun vc-fetch-master-properties (file)
357 ;; Fetch those properties of FILE that are stored in the master file.
358 ;; For an RCS file, we don't get vc-latest-version vc-your-latest-version
359 ;; here because that is slow.
360 ;; That gets done if/when the functions vc-latest-version
361 ;; and vc-your-latest-version get called.
362 (save-excursion
363 (cond
364 ((eq (vc-backend file) 'SCCS)
365 (set-buffer (get-buffer-create "*vc-info*"))
366 (if (vc-insert-file (vc-lock-file file))
367 (vc-parse-locks file (buffer-string))
368 (vc-file-setprop file 'vc-master-locks 'none))
369 (vc-insert-file (vc-name file) "^\001e")
370 (vc-parse-buffer
371 (list '("^\001d D \\([^ ]+\\)" 1)
372 (list (concat "^\001d D \\([^ ]+\\) .* "
373 (regexp-quote (vc-user-login-name)) " ") 1))
374 file
375 '(vc-latest-version vc-your-latest-version)))
376
377 ((eq (vc-backend file) 'RCS)
378 (set-buffer (get-buffer-create "*vc-info*"))
379 (vc-insert-file (vc-name file) "^[0-9]")
380 (vc-parse-buffer
381 (list '("^head[ \t\n]+\\([^;]+\\);" 1)
382 '("^branch[ \t\n]+\\([^;]+\\);" 1)
383 '("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1))
384 file
385 '(vc-head-version
386 vc-default-branch
387 vc-master-locks))
388 ;; determine vc-master-workfile-version: it is either the head
389 ;; of the trunk, the head of the default branch, or the
390 ;; "default branch" itself, if that is a full revision number.
391 (let ((default-branch (vc-file-getprop file 'vc-default-branch)))
392 (cond
393 ;; no default branch
394 ((or (not default-branch) (string= "" default-branch))
395 (vc-file-setprop file 'vc-master-workfile-version
396 (vc-file-getprop file 'vc-head-version)))
397 ;; default branch is actually a revision
398 ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
399 default-branch)
400 (vc-file-setprop file 'vc-master-workfile-version default-branch))
401 ;; else, search for the head of the default branch
402 (t (vc-insert-file (vc-name file) "^desc")
403 (vc-parse-buffer (list (list
404 (concat "^\\("
405 (regexp-quote default-branch)
406 "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))
407 file '(vc-master-workfile-version)))))
408 ;; translate the locks
409 (vc-parse-locks file (vc-file-getprop file 'vc-master-locks)))
410
411 ((eq (vc-backend file) 'CVS)
412 (save-excursion
413 ;; Call "cvs status" in the right directory, passing only the
414 ;; nondirectory part of the file name -- otherwise CVS might
415 ;; silently give a wrong result.
416 (let ((default-directory (file-name-directory file)))
417 (vc-simple-command 0 "cvs" (file-name-nondirectory file) "status"))
418 (set-buffer (get-buffer "*vc-info*"))
419 (vc-parse-cvs-status t))))
420 (if (get-buffer "*vc-info*")
421 (kill-buffer (get-buffer "*vc-info*")))))
422
423;;; Functions that determine property values, by examining the
424;;; working file, the master file, or log program output
425
426(defun vc-consult-rcs-headers (file)
427 ;; Search for RCS headers in FILE, and set properties
428 ;; accordingly. This function can be disabled by setting
429 ;; vc-consult-headers to nil.
430 ;; Returns: nil if no headers were found
431 ;; (or if the feature is disabled,
432 ;; or if there is currently no buffer
433 ;; visiting FILE)
434 ;; 'rev if a workfile revision was found
435 ;; 'rev-and-lock if revision and lock info was found
436 (cond
437 ((or (not vc-consult-headers)
438 (not (get-file-buffer file))) nil)
439 ((let (status version locking-user)
440 (save-excursion
441 (set-buffer (get-file-buffer file))
442 (goto-char (point-min))
443 (cond
444 ;; search for $Id or $Header
445 ;; -------------------------
446 ;; The `\ 's below avoid an RCS 5.7 bug when checking in this file.
447 ((or (and (search-forward "$Id\ : " nil t)
448 (looking-at "[^ ]+ \\([0-9.]+\\) "))
449 (and (progn (goto-char (point-min))
450 (search-forward "$Header\ : " nil t))
451 (looking-at "[^ ]+ \\([0-9.]+\\) ")))
452 (goto-char (match-end 0))
453 ;; if found, store the revision number ...
454 (setq version (buffer-substring-no-properties (match-beginning 1)
455 (match-end 1)))
456 ;; ... and check for the locking state
457 (cond
458 ((looking-at
459 (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date
460 "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
461 "[^ ]+ [^ ]+ ")) ; author & state
462 (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
463 (cond
464 ;; unlocked revision
465 ((looking-at "\\$")
466 (setq locking-user 'none)
467 (setq status 'rev-and-lock))
468 ;; revision is locked by some user
469 ((looking-at "\\([^ ]+\\) \\$")
470 (setq locking-user
471 (buffer-substring-no-properties (match-beginning 1)
472 (match-end 1)))
473 (setq status 'rev-and-lock))
474 ;; everything else: false
475 (nil)))
476 ;; unexpected information in
477 ;; keyword string --> quit
478 (nil)))
479 ;; search for $Revision
480 ;; --------------------
481 ((re-search-forward (concat "\\$"
482 "Revision: \\([0-9.]+\\) \\$")
483 nil t)
484 ;; if found, store the revision number ...
485 (setq version (buffer-substring-no-properties (match-beginning 1)
486 (match-end 1)))
487 ;; and see if there's any lock information
488 (goto-char (point-min))
489 (if (re-search-forward (concat "\\$" "Locker:") nil t)
490 (cond ((looking-at " \\([^ ]+\\) \\$")
491 (setq locking-user (buffer-substring-no-properties
492 (match-beginning 1)
493 (match-end 1)))
494 (setq status 'rev-and-lock))
495 ((looking-at " *\\$")
496 (setq locking-user 'none)
497 (setq status 'rev-and-lock))
498 (t
499 (setq locking-user 'none)
500 (setq status 'rev-and-lock)))
501 (setq status 'rev)))
502 ;; else: nothing found
503 ;; -------------------
504 (t nil)))
505 (if status (vc-file-setprop file 'vc-workfile-version version))
506 (and (eq status 'rev-and-lock)
507 (eq (vc-backend file) 'RCS)
508 (vc-file-setprop file 'vc-locking-user locking-user)
509 ;; If the file has headers, we don't want to query the master file,
510 ;; because that would eliminate all the performance gain the headers
511 ;; brought us. We therefore use a heuristic for the checkout model
512 ;; now: If we trust the file permissions, and the file is not
513 ;; locked, then if the file is read-only the checkout model is
514 ;; `manual', otherwise `implicit'.
515 (not (vc-mistrust-permissions file))
516 (not (vc-locking-user file))
517 (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
518 (vc-file-setprop file 'vc-checkout-model 'manual)
519 (vc-file-setprop file 'vc-checkout-model 'implicit)))
520 status))))
521
522;;; Access functions to file properties 223;;; Access functions to file properties
523;;; (Properties should be _set_ using vc-file-setprop, but 224;;; (Properties should be _set_ using vc-file-setprop, but
524;;; _retrieved_ only through these functions, which decide 225;;; _retrieved_ only through these functions, which decide
525;;; if the property is already known or not. A property should 226;;; if the property is already known or not. A property should
526;;; only be retrieved by vc-file-getprop if there is no 227;;; only be retrieved by vc-file-getprop if there is no
527;;; access function.) 228;;; access function.)
528 229
529;;; properties indicating the backend 230;;; properties indicating the backend being used for FILE
530;;; being used for FILE
531 231
532(defun vc-backend-subdirectory-name (&optional file) 232(defun vc-registered (file)
533 ;; Where the master and lock files for the current directory are kept 233 "Return non-nil if FILE is registered in a version control system.
534 (symbol-name 234
535 (or 235This function does not cache its result; it performs the test each
536 (and file (vc-backend file)) 236time it is invoked on a file. For a caching check whether a file is
537 vc-default-back-end 237registered, use `vc-backend'."
538 (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))))) 238 (let (handler)
239 (if (boundp 'file-name-handler-alist)
240 (setq handler (find-file-name-handler file 'vc-registered)))
241 (if handler
242 ;; handler should set vc-backend and return t if registered
243 (funcall handler 'vc-registered file)
244 ;; There is no file name handler.
245 ;; Try vc-BACKEND-registered for each handled BACKEND.
246 (catch 'found
247 (mapcar
248 (lambda (b)
249 (and (vc-call-backend b 'registered file)
250 (vc-file-setprop file 'vc-backend b)
251 (throw 'found t)))
252 (unless vc-ignore-vc-files
253 vc-handled-backends))
254 ;; File is not registered.
255 (vc-file-setprop file 'vc-backend 'none)
256 nil))))
257
258(defun vc-backend (file)
259 "Return the version control type of FILE, nil if it is not registered."
260 ;; `file' can be nil in several places (typically due to the use of
261 ;; code like (vc-backend (buffer-file-name))).
262 (when (stringp file)
263 (let ((property (vc-file-getprop file 'vc-backend)))
264 ;; Note that internally, Emacs remembers unregistered
265 ;; files by setting the property to `none'.
266 (cond ((eq property 'none) nil)
267 (property)
268 ;; vc-registered sets the vc-backend property
269 (t (if (vc-registered file)
270 (vc-file-getprop file 'vc-backend)
271 nil))))))
272
273(defun vc-backend-subdirectory-name (file)
274 "Return where the master and lock FILEs for the current directory are kept."
275 (symbol-name (vc-backend file)))
539 276
540(defun vc-name (file) 277(defun vc-name (file)
541 "Return the master name of a file, nil if it is not registered. 278 "Return the master name of FILE. If the file is not registered, or
542For CVS, the full name of CVS/Entries is returned." 279the master name is not known, return nil."
280 ;; TODO: This should ultimately become obsolete, at least up here
281 ;; in vc-hooks.
543 (or (vc-file-getprop file 'vc-name) 282 (or (vc-file-getprop file 'vc-name)
544 ;; Use the caching mechanism of vc-backend, below.
545 (if (vc-backend file) 283 (if (vc-backend file)
546 (vc-file-getprop file 'vc-name)))) 284 (vc-file-getprop file 'vc-name))))
547 285
548(defun vc-backend (file)
549 "Return the version-control type of a file, nil if it is not registered."
550 ;; Note that internally, Emacs remembers unregistered
551 ;; files by setting the property to `none'.
552 (if file
553 (let ((property (vc-file-getprop file 'vc-backend))
554 (name-and-type))
555 (cond ((eq property 'none) nil)
556 (property)
557 (t (setq name-and-type (vc-registered file))
558 (if name-and-type
559 (progn
560 (vc-file-setprop file 'vc-name (car name-and-type))
561 (vc-file-setprop file 'vc-backend (cdr name-and-type)))
562 (vc-file-setprop file 'vc-backend 'none)
563 nil))))))
564
565(defun vc-checkout-model (file) 286(defun vc-checkout-model (file)
566 ;; Return `manual' if the user has to type C-x C-q to check out FILE. 287 "Indicate how FILE is checked out.
567 ;; Return `implicit' if the file can be modified without locking it first. 288
568 (or 289Possible values:
569 (vc-file-getprop file 'vc-checkout-model) 290
570 (cond 291 'implicit File is always writeable, and checked out `implicitly'
571 ((eq (vc-backend file) 'SCCS) 292 when the user saves the first changes to the file.
572 (vc-file-setprop file 'vc-checkout-model 'manual)) 293
573 ((eq (vc-backend file) 'RCS) 294 'locking File is read-only if up-to-date; user must type
574 (vc-consult-rcs-headers file) 295 \\[vc-toggle-read-only] before editing. Strict locking
575 (or (vc-file-getprop file 'vc-checkout-model) 296 is assumed.
576 (progn (vc-fetch-master-properties file) 297
577 (vc-file-getprop file 'vc-checkout-model)))) 298 'announce File is read-only if up-to-date; user must type
578 ((eq (vc-backend file) 'CVS) 299 \\[vc-toggle-read-only] before editing. But other users
579 (vc-file-setprop file 'vc-checkout-model 300 may be editing at the same time."
580 (cond 301 (or (vc-file-getprop file 'vc-checkout-model)
581 ((getenv "CVSREAD") 'manual) 302 (vc-file-setprop file 'vc-checkout-model
582 ;; If the file is not writeable, this is probably because the 303 (vc-call checkout-model file))))
583 ;; file is being "watched" by other developers. Use "manual"
584 ;; checkout in this case. (If vc-mistrust-permissions was t,
585 ;; we actually shouldn't trust this, but there is no other way
586 ;; to learn this from CVS at the moment (version 1.9).)
587 ((string-match "r-..-..-." (nth 8 (file-attributes file)))
588 'manual)
589 (t 'implicit)))))))
590
591;;; properties indicating the locking state
592
593(defun vc-cvs-status (file)
594 ;; Return the cvs status of FILE
595 ;; (Status field in output of "cvs status")
596 (cond ((vc-file-getprop file 'vc-cvs-status))
597 (t (vc-fetch-master-properties file)
598 (vc-file-getprop file 'vc-cvs-status))))
599
600(defun vc-master-locks (file)
601 ;; Return the lock entries in the master of FILE.
602 ;; Return 'none if there are no such entries, and a list
603 ;; of the form ((VERSION USER) (VERSION USER) ...) otherwise.
604 (cond ((vc-file-getprop file 'vc-master-locks))
605 (t (vc-fetch-master-properties file)
606 (vc-file-getprop file 'vc-master-locks))))
607
608(defun vc-master-locking-user (file)
609 ;; Return the master file's idea of who is locking
610 ;; the current workfile version of FILE.
611 ;; Return 'none if it is not locked.
612 (let ((master-locks (vc-master-locks file)) lock)
613 (if (eq master-locks 'none) 'none
614 ;; search for a lock on the current workfile version
615 (setq lock (assoc (vc-workfile-version file) master-locks))
616 (cond (lock (cdr lock))
617 ('none)))))
618
619(defun vc-lock-from-permissions (file)
620 ;; If the permissions can be trusted for this file, determine the
621 ;; locking state from them. Returns (user-login-name), `none', or nil.
622 ;; This implementation assumes that any file which is under version
623 ;; control and has -rw-r--r-- is locked by its owner. This is true
624 ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
625 ;; We have to be careful not to exclude files with execute bits on;
626 ;; scripts can be under version control too. Also, we must ignore the
627 ;; group-read and other-read bits, since paranoid users turn them off.
628 ;; This hack wins because calls to the somewhat expensive
629 ;; `vc-fetch-master-properties' function only have to be made if
630 ;; (a) the file is locked by someone other than the current user,
631 ;; or (b) some untoward manipulation behind vc's back has changed
632 ;; the owner or the `group' or `other' write bits.
633 (let ((attributes (file-attributes file)))
634 (if (not (vc-mistrust-permissions file))
635 (cond ((string-match ".r-..-..-." (nth 8 attributes))
636 (vc-file-setprop file 'vc-locking-user 'none))
637 ((and (= (nth 2 attributes) (user-uid))
638 (string-match ".rw..-..-." (nth 8 attributes)))
639 (vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
640 (nil)))))
641 304
642(defun vc-user-login-name (&optional uid) 305(defun vc-user-login-name (&optional uid)
643 ;; Return the name under which the user is logged in, as a string. 306 "Return the name under which the user is logged in, as a string.
644 ;; (With optional argument UID, return the name of that user.) 307\(With optional argument UID, return the name of that user.)
645 ;; This function does the same as `user-login-name', but unlike 308This function does the same as function `user-login-name', but unlike
646 ;; that, it never returns nil. If a UID cannot be resolved, that 309that, it never returns nil. If a UID cannot be resolved, that
647 ;; UID is returned as a string. 310UID is returned as a string."
648 (or (user-login-name uid) 311 (or (user-login-name uid)
649 (and uid (number-to-string uid)) 312 (number-to-string (or uid (user-uid)))))
650 (number-to-string (user-uid)))) 313
651 314(defun vc-state (file)
652(defun vc-file-owner (file) 315 "Return the version control state of FILE.
653 ;; Return who owns FILE (user name, as a string). 316
654 (vc-user-login-name (nth 2 (file-attributes file)))) 317The value returned is one of:
655 318
656(defun vc-rcs-lock-from-diff (file) 319 'up-to-date The working file is unmodified with respect to the
657 ;; Diff the file against the master version. If differences are found, 320 latest version on the current branch, and not locked.
658 ;; mark the file locked. This is only used for RCS with non-strict 321
659 ;; locking. (If "rcsdiff" doesn't understand --brief, we do a double-take 322 'edited The working file has been edited by the user. If
660 ;; and remember the fact for the future.) 323 locking is used for the file, this state means that
661 (let* ((version (concat "-r" (vc-workfile-version file))) 324 the current version is locked by the calling user.
662 (status (if (eq vc-rcsdiff-knows-brief 'no) 325
663 (vc-simple-command 1 "rcsdiff" file version) 326 USER The current version of the working file is locked by
664 (vc-simple-command 2 "rcsdiff" file "--brief" version)))) 327 some other USER (a string).
665 (if (eq status 2) 328
666 (if (not vc-rcsdiff-knows-brief) 329 'needs-patch The file has not been edited by the user, but there is
667 (setq vc-rcsdiff-knows-brief 'no 330 a more recent version on the current branch stored
668 status (vc-simple-command 1 "rcsdiff" file version)) 331 in the master file.
669 (error "rcsdiff failed.")) 332
670 (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes))) 333 'needs-merge The file has been edited by the user, and there is also
671 (if (zerop status) 334 a more recent version on the current branch stored in
672 (vc-file-setprop file 'vc-locking-user 'none) 335 the master file. This state can only occur if locking
673 (vc-file-setprop file 'vc-locking-user (vc-file-owner file))))) 336 is not used for the file.
674 337
675(defun vc-locking-user (file) 338 'unlocked-changes The current version of the working file is not locked,
676 ;; Return the name of the person currently holding a lock on FILE. 339 but the working file has been changed with respect
677 ;; Return nil if there is no such person. 340 to that version. This state can only occur for files
678 ;; Under CVS, a file is considered locked if it has been modified since 341 with locking; it represents an erroneous condition that
679 ;; it was checked out. 342 should be resolved by the user (vc-next-action will
680 ;; The property is cached. It is only looked up if it is currently nil. 343 prompt the user to do it)."
681 ;; Note that, for a file that is not locked, the actual property value 344 (or (vc-file-getprop file 'vc-state)
682 ;; is `none', to distinguish it from an unknown locking state. That value 345 (vc-file-setprop file 'vc-state
683 ;; is converted to nil by this function, and returned to the caller. 346 (vc-call state-heuristic file))))
684 (let ((locking-user (vc-file-getprop file 'vc-locking-user))) 347
685 (if locking-user 348(defsubst vc-up-to-date-p (file)
686 ;; if we already know the property, return it 349 "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
687 (if (eq locking-user 'none) nil locking-user) 350 (eq (vc-state file) 'up-to-date))
688 351
689 ;; otherwise, infer the property... 352(defun vc-default-state-heuristic (backend file)
690 (cond 353 "Default implementation of vc-state-heuristic. It simply calls the
691 ((eq (vc-backend file) 'CVS) 354real state computation function `vc-BACKEND-state' and does not employ
692 (or (and (eq (vc-checkout-model file) 'manual) 355any heuristic at all."
693 (vc-lock-from-permissions file)) 356 (vc-call-backend backend 'state file))
694 (and (equal (vc-file-getprop file 'vc-checkout-time)
695 (nth 5 (file-attributes file)))
696 (vc-file-setprop file 'vc-locking-user 'none))
697 (vc-file-setprop file 'vc-locking-user (vc-file-owner file))))
698
699 ((eq (vc-backend file) 'RCS)
700 (let (p-lock)
701
702 ;; Check for RCS headers first
703 (or (eq (vc-consult-rcs-headers file) 'rev-and-lock)
704
705 ;; If there are no headers, try to learn it
706 ;; from the permissions.
707 (and (setq p-lock (vc-lock-from-permissions file))
708 (if (eq p-lock 'none)
709
710 ;; If the permissions say "not locked", we know
711 ;; that the checkout model must be `manual'.
712 (vc-file-setprop file 'vc-checkout-model 'manual)
713
714 ;; If the permissions say "locked", we can only trust
715 ;; this *if* the checkout model is `manual'.
716 (eq (vc-checkout-model file) 'manual)))
717
718 ;; Otherwise, use lock information from the master file.
719 (vc-file-setprop file 'vc-locking-user
720 (vc-master-locking-user file)))
721
722 ;; Finally, if the file is not explicitly locked
723 ;; it might still be locked implicitly.
724 (and (eq (vc-file-getprop file 'vc-locking-user) 'none)
725 (eq (vc-checkout-model file) 'implicit)
726 (vc-rcs-lock-from-diff file))))
727
728 ((eq (vc-backend file) 'SCCS)
729 (or (vc-lock-from-permissions file)
730 (vc-file-setprop file 'vc-locking-user
731 (vc-master-locking-user file)))))
732
733 ;; convert a possible 'none value
734 (setq locking-user (vc-file-getprop file 'vc-locking-user))
735 (if (eq locking-user 'none) nil locking-user))))
736
737;;; properties to store current and recent version numbers
738
739(defun vc-latest-version (file)
740 ;; Return version level of the latest version of FILE
741 (cond ((vc-file-getprop file 'vc-latest-version))
742 (t (vc-fetch-properties file)
743 (vc-file-getprop file 'vc-latest-version))))
744
745(defun vc-your-latest-version (file)
746 ;; Return version level of the latest version of FILE checked in by you
747 (cond ((vc-file-getprop file 'vc-your-latest-version))
748 (t (vc-fetch-properties file)
749 (vc-file-getprop file 'vc-your-latest-version))))
750
751(defun vc-master-workfile-version (file)
752 ;; Return the master file's idea of what is the current workfile version.
753 ;; This property is defined for RCS only.
754 (cond ((vc-file-getprop file 'vc-master-workfile-version))
755 (t (vc-fetch-master-properties file)
756 (vc-file-getprop file 'vc-master-workfile-version))))
757
758(defun vc-fetch-properties (file)
759 ;; Fetch vc-latest-version and vc-your-latest-version
760 ;; if that wasn't already done.
761 (cond
762 ((eq (vc-backend file) 'RCS)
763 (save-excursion
764 (set-buffer (get-buffer-create "*vc-info*"))
765 (vc-insert-file (vc-name file) "^desc")
766 (vc-parse-buffer
767 (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2)
768 (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n"
769 "date[ \t]+\\([0-9.]+\\);[ \t]+"
770 "author[ \t]+"
771 (regexp-quote (vc-user-login-name)) ";") 1 2))
772 file
773 '(vc-latest-version vc-your-latest-version))
774 (if (get-buffer "*vc-info*")
775 (kill-buffer (get-buffer "*vc-info*")))))
776 (t (vc-fetch-master-properties file))
777 ))
778 357
779(defun vc-workfile-version (file) 358(defun vc-workfile-version (file)
780 ;; Return version level of the current workfile FILE 359 "Return version level of the current workfile FILE."
781 ;; This is attempted by first looking at the RCS keywords. 360 (or (vc-file-getprop file 'vc-workfile-version)
782 ;; If there are no keywords in the working file, 361 (vc-file-setprop file 'vc-workfile-version
783 ;; vc-master-workfile-version is taken. 362 (vc-call workfile-version file))))
784 ;; Note that this property is cached, that is, it is only
785 ;; looked up if it is nil.
786 ;; For SCCS, this property is equivalent to vc-latest-version.
787 (cond ((vc-file-getprop file 'vc-workfile-version))
788 ((eq (vc-backend file) 'SCCS) (vc-latest-version file))
789 ((eq (vc-backend file) 'RCS)
790 (if (vc-consult-rcs-headers file)
791 (vc-file-getprop file 'vc-workfile-version)
792 (let ((rev (cond ((vc-master-workfile-version file))
793 ((vc-latest-version file)))))
794 (vc-file-setprop file 'vc-workfile-version rev)
795 rev)))
796 ((eq (vc-backend file) 'CVS)
797 (if (vc-consult-rcs-headers file) ;; CVS
798 (vc-file-getprop file 'vc-workfile-version)
799 (catch 'found
800 (vc-find-cvs-master (file-name-directory file)
801 (file-name-nondirectory file)))
802 (vc-file-getprop file 'vc-workfile-version)))))
803 363
804;;; actual version-control code starts here 364;;; actual version-control code starts here
805 365
806(defun vc-registered (file) 366(defun vc-default-registered (backend file)
807 (let (handler handlers) 367 "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
808 (if (boundp 'file-name-handler-alist) 368 (let ((sym (vc-make-backend-sym backend 'master-templates)))
809 (setq handler (find-file-name-handler file 'vc-registered))) 369 (unless (get backend 'vc-templates-grabbed)
810 (if handler 370 (put backend 'vc-templates-grabbed t)
811 (funcall handler 'vc-registered file) 371 (set sym (append (delq nil
812 ;; Search for a master corresponding to the given file 372 (mapcar
813 (let ((dirname (or (file-name-directory file) "")) 373 (lambda (template)
814 (basename (file-name-nondirectory file))) 374 (and (consp template)
815 (catch 'found 375 (eq (cdr template) backend)
816 (mapcar 376 (car template)))
817 (function (lambda (s) 377 vc-master-templates))
818 (if (atom s) 378 (symbol-value sym))))
819 (funcall s dirname basename) 379 (let ((result (vc-check-master-templates file (symbol-value sym))))
820 (let ((trial (format (car s) dirname basename))) 380 (if (stringp result)
821 (if (and (file-exists-p trial) 381 (vc-file-setprop file 'vc-name result)
822 ;; Make sure the file we found with name 382 nil)))) ; Not registered
823 ;; TRIAL is not the source file itself. 383
824 ;; That can happen with RCS-style names 384(defun vc-possible-master (s dirname basename)
825 ;; if the file name is truncated 385 (cond
826 ;; (e.g. to 14 chars). See if either 386 ((stringp s) (format s dirname basename))
827 ;; directory or attributes differ. 387 ((functionp s)
828 (or (not (string= dirname 388 ;; The template is a function to invoke. If the
829 (file-name-directory trial))) 389 ;; function returns non-nil, that means it has found a
830 (not (equal 390 ;; master. For backward compatibility, we also handle
831 (file-attributes file) 391 ;; the case that the function throws a 'found atom
832 (file-attributes trial))))) 392 ;; and a pair (cons MASTER-FILE BACKEND).
833 (throw 'found (cons trial (cdr s)))))))) 393 (let ((result (catch 'found (funcall s dirname basename))))
834 vc-master-templates) 394 (if (consp result) (car result) result)))))
835 nil))))) 395
836 396(defun vc-check-master-templates (file templates)
837(defun vc-sccs-project-dir () 397 "Return non-nil if there is a master corresponding to FILE,
838 ;; Return the full pathname of the SCCS PROJECTDIR, if it exists, 398according to any of the elements in TEMPLATES.
839 ;; otherwise nil. The PROJECTDIR is indicated by the environment 399
840 ;; variable of the same name. If its value starts with a slash, 400TEMPLATES is a list of strings or functions. If an element is a
841 ;; it must be an absolute path name that points to the 401string, it must be a control string as required by `format', with two
842 ;; directory where SCCS history files reside. If it does not 402string placeholders, such as \"%sRCS/%s,v\". The directory part of
843 ;; begin with a slash, it is taken as the name of a user, 403FILE is substituted for the first placeholder, the basename of FILE
844 ;; and history files reside in an "src" or "source" subdirectory 404for the second. If a file with the resulting name exists, it is taken
845 ;; of that user's home directory. 405as the master of FILE, and returned.
846 (let ((project-dir (getenv "PROJECTDIR"))) 406
847 (and project-dir 407If an element of TEMPLATES is a function, it is called with the
848 (if (eq (elt project-dir 0) ?/) 408directory part and the basename of FILE as arguments. It should
849 (if (file-exists-p (concat project-dir "/SCCS")) 409return non-nil if it finds a master; that value is then returned by
850 (concat project-dir "/SCCS/") 410this function."
851 (if (file-exists-p project-dir) 411 (let ((dirname (or (file-name-directory file) ""))
852 project-dir)) 412 (basename (file-name-nondirectory file)))
853 (setq project-dir (expand-file-name (concat "~" project-dir))) 413 (catch 'found
854 (let (trial) 414 (mapcar
855 (setq trial (concat project-dir "/src/SCCS")) 415 (lambda (s)
856 (if (file-exists-p trial) 416 (let ((trial (vc-possible-master s dirname basename)))
857 (concat trial "/") 417 (if (and trial (file-exists-p trial)
858 (setq trial (concat project-dir "/src")) 418 ;; Make sure the file we found with name
859 (if (file-exists-p trial) 419 ;; TRIAL is not the source file itself.
860 (concat trial "/") 420 ;; That can happen with RCS-style names if
861 (setq trial (concat project-dir "/source/SCCS")) 421 ;; the file name is truncated (e.g. to 14
862 (if (file-exists-p trial) 422 ;; chars). See if either directory or
863 (concat trial "/") 423 ;; attributes differ.
864 (setq trial (concat project-dir "/source/")) 424 (or (not (string= dirname
865 (if (file-exists-p trial) 425 (file-name-directory trial)))
866 (concat trial "/")))))))))) 426 (not (equal (file-attributes file)
867 427 (file-attributes trial)))))
868(defun vc-search-sccs-project-dir (dirname basename) 428 (throw 'found trial))))
869 ;; Check if there is a master file for BASENAME in the 429 templates))))
870 ;; SCCS project directory. If yes, throw `found' as
871 ;; expected by vc-registered. If not, return nil.
872 (let* ((project-dir (vc-sccs-project-dir))
873 (master-file (and project-dir (concat project-dir "s." basename))))
874 (and master-file
875 (file-exists-p master-file)
876 (throw 'found (cons master-file 'SCCS)))))
877
878(defun vc-find-cvs-master (dirname basename)
879 ;; Check if DIRNAME/BASENAME is handled by CVS.
880 ;; If it is, do a (throw 'found (cons MASTER-FILE 'CVS)).
881 ;; Note: This function throws the name of CVS/Entries
882 ;; NOT that of the RCS master file (because we wouldn't be able
883 ;; to access it under remote CVS).
884 ;; The function returns nil if DIRNAME/BASENAME is not handled by CVS.
885 (if (and vc-handle-cvs
886 (file-directory-p (concat dirname "CVS/"))
887 (file-readable-p (concat dirname "CVS/Entries")))
888 (let ((file (concat dirname basename))
889 buffer)
890 (unwind-protect
891 (save-excursion
892 (setq buffer (set-buffer (get-buffer-create "*vc-info*")))
893 (vc-insert-file (concat dirname "CVS/Entries"))
894 (goto-char (point-min))
895 ;; make sure that the file name is searched
896 ;; case-sensitively - case-fold-search is a buffer-local
897 ;; variable, so setting it here won't affect any other buffers
898 (setq case-fold-search nil)
899 (cond
900 ;; entry for a "locally added" file (not yet committed)
901 ((re-search-forward
902 (concat "^/" (regexp-quote basename) "/0/") nil t)
903 (vc-file-setprop file 'vc-checkout-time 0)
904 (vc-file-setprop file 'vc-workfile-version "0")
905 (throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
906 ;; normal entry
907 ((re-search-forward
908 (concat "^/" (regexp-quote basename)
909 ;; revision
910 "/\\([^/]*\\)"
911 ;; timestamp
912 "/[A-Z][a-z][a-z]" ;; week day (irrelevant)
913 " \\([A-Z][a-z][a-z]\\)" ;; month name
914 " *\\([0-9]*\\)" ;; day of month
915 " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)" ;; hms
916 " \\([0-9]*\\)" ;; year
917 ;; optional conflict field
918 "\\(+[^/]*\\)?/")
919 nil t)
920 ;; We found it. Store away version number now that we
921 ;; are anyhow so close to finding it.
922 (vc-file-setprop file
923 'vc-workfile-version
924 (match-string 1))
925 ;; If the file hasn't been modified since checkout,
926 ;; store the checkout-time.
927 (let ((mtime (nth 5 (file-attributes file)))
928 (second (string-to-number (match-string 6)))
929 (minute (string-to-number (match-string 5)))
930 (hour (string-to-number (match-string 4)))
931 (day (string-to-number (match-string 3)))
932 (year (string-to-number (match-string 7))))
933 (if (equal mtime
934 (encode-time
935 second minute hour day
936 (/ (string-match
937 (match-string 2)
938 "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
939 3)
940 year 0))
941 (vc-file-setprop file 'vc-checkout-time mtime)
942 (vc-file-setprop file 'vc-checkout-time 0)))
943 (throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
944 ;; entry with arbitrary text as timestamp
945 ;; (this means we should consider it modified)
946 ((re-search-forward
947 (concat "^/" (regexp-quote basename)
948 ;; revision
949 "/\\([^/]*\\)"
950 ;; timestamp (arbitrary text)
951 "/[^/]*"
952 ;; optional conflict field
953 "\\(+[^/]*\\)?/")
954 nil t)
955 ;; We found it. Store away version number now that we
956 ;; are anyhow so close to finding it.
957 (vc-file-setprop file 'vc-workfile-version (match-string 1))
958 (vc-file-setprop file 'vc-checkout-time 0)
959 (throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
960 (t nil)))
961 (kill-buffer buffer)))))
962
963(defun vc-buffer-backend ()
964 "Return the version-control type of the visited file, or nil if none."
965 (if (eq vc-buffer-backend t)
966 (setq vc-buffer-backend (vc-backend (buffer-file-name)))
967 vc-buffer-backend))
968 430
969(defun vc-toggle-read-only (&optional verbose) 431(defun vc-toggle-read-only (&optional verbose)
970 "Change read-only status of current buffer, perhaps via version control. 432 "Change read-only status of current buffer, perhaps via version control.
@@ -976,17 +438,17 @@ Check-out of a specified version number does not lock the file;
976to do that, use this command a second time with no argument." 438to do that, use this command a second time with no argument."
977 (interactive "P") 439 (interactive "P")
978 (if (or (and (boundp 'vc-dired-mode) vc-dired-mode) 440 (if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
979 ;; use boundp because vc.el might not be loaded 441 ;; use boundp because vc.el might not be loaded
980 (vc-backend (buffer-file-name))) 442 (vc-backend (buffer-file-name)))
981 (vc-next-action verbose) 443 (vc-next-action verbose)
982 (toggle-read-only))) 444 (toggle-read-only)))
983(define-key global-map "\C-x\C-q" 'vc-toggle-read-only) 445(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
984 446
985(defun vc-after-save () 447(defun vc-after-save ()
986 ;; Function to be called by basic-save-buffer (in files.el). 448 "Function to be called by `basic-save-buffer' (in files.el)."
987 ;; If the file in the current buffer is under version control, 449 ;; If the file in the current buffer is under version control,
988 ;; not locked, and the checkout model for it is `implicit', 450 ;; up-to-date, and locking is not used for the file, set
989 ;; mark it "locked" and redisplay the mode line. 451 ;; the state to 'edited and redisplay the mode line.
990 (let ((file (buffer-file-name))) 452 (let ((file (buffer-file-name)))
991 (and (vc-backend file) 453 (and (vc-backend file)
992 (or (and (equal (vc-file-getprop file 'vc-checkout-time) 454 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
@@ -996,79 +458,71 @@ to do that, use this command a second time with no argument."
996 ;; to avoid confusion. 458 ;; to avoid confusion.
997 (vc-file-setprop file 'vc-checkout-time nil)) 459 (vc-file-setprop file 'vc-checkout-time nil))
998 t) 460 t)
999 (not (vc-locking-user file)) 461 (vc-up-to-date-p file)
1000 (eq (vc-checkout-model file) 'implicit) 462 (eq (vc-checkout-model file) 'implicit)
1001 (vc-file-setprop file 'vc-locking-user (vc-user-login-name)) 463 (vc-file-setprop file 'vc-state 'edited)
1002 (or (and (eq (vc-backend file) 'CVS) 464 (vc-mode-line file)
1003 (vc-file-setprop file 'vc-cvs-status nil)) 465 (vc-dired-resynch-file file))))
1004 t)
1005 (vc-mode-line file))))
1006 466
1007(defun vc-mode-line (file &optional label) 467(defun vc-mode-line (file)
1008 "Set `vc-mode' to display type of version control for FILE. 468 "Set `vc-mode' to display type of version control for FILE.
1009The value is set in the current buffer, which should be the buffer 469The value is set in the current buffer, which should be the buffer
1010visiting FILE. Second optional arg LABEL is put in place of version 470visiting FILE."
1011control system name."
1012 (interactive (list buffer-file-name nil)) 471 (interactive (list buffer-file-name nil))
1013 (let ((vc-type (vc-backend file))) 472 (unless (not (vc-backend file))
1014 (setq vc-mode 473 (setq vc-mode (concat " "
1015 (and vc-type 474 (if vc-display-status
1016 (concat " " (or label (symbol-name vc-type)) 475 (vc-call mode-line-string file)
1017 (and vc-display-status (vc-status file))))) 476 (symbol-name (vc-backend file)))))
1018 ;; If the file is locked by some other user, make 477 ;; If the file is locked by some other user, make
1019 ;; the buffer read-only. Like this, even root 478 ;; the buffer read-only. Like this, even root
1020 ;; cannot modify a file that someone else has locked. 479 ;; cannot modify a file that someone else has locked.
1021 (and vc-type 480 (and (equal file (buffer-file-name))
1022 (equal file (buffer-file-name)) 481 (stringp (vc-state file))
1023 (vc-locking-user file)
1024 (not (string= (vc-user-login-name) (vc-locking-user file)))
1025 (setq buffer-read-only t)) 482 (setq buffer-read-only t))
1026 ;; If the user is root, and the file is not owner-writable, 483 ;; If the user is root, and the file is not owner-writable,
1027 ;; then pretend that we can't write it 484 ;; then pretend that we can't write it
1028 ;; even though we can (because root can write anything). 485 ;; even though we can (because root can write anything).
1029 ;; This way, even root cannot modify a file that isn't locked. 486 ;; This way, even root cannot modify a file that isn't locked.
1030 (and vc-type 487 (and (equal file (buffer-file-name))
1031 (equal file (buffer-file-name))
1032 (not buffer-read-only) 488 (not buffer-read-only)
1033 (zerop (user-real-uid)) 489 (zerop (user-real-uid))
1034 (zerop (logand (file-modes (buffer-file-name)) 128)) 490 (zerop (logand (file-modes (buffer-file-name)) 128))
1035 (setq buffer-read-only t)) 491 (setq buffer-read-only t)))
1036 (force-mode-line-update) 492 (force-mode-line-update)
1037 ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18 493 (vc-backend file))
1038 vc-type)) 494
1039 495(defun vc-default-mode-line-string (backend file)
1040(defun vc-status (file) 496 "Return string for placement in modeline by `vc-mode-line' for FILE.
1041 ;; Return string for placement in modeline by `vc-mode-line'. 497Format:
1042 ;; Format: 498
1043 ;; 499 \"BACKEND-REV\" if the file is up-to-date
1044 ;; "-REV" if the revision is not locked 500 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
1045 ;; ":REV" if the revision is locked by the user 501 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
1046 ;; ":LOCKER:REV" if the revision is locked by somebody else 502 \"BACKEND @@\" for a CVS file that is added, but not yet committed
1047 ;; " @@" for a CVS file that is added, but not yet committed 503
1048 ;; 504This function assumes that the file is registered."
1049 ;; In the CVS case, a "locked" working file is a 505 (setq backend (symbol-name backend))
1050 ;; working file that is modified with respect to the master. 506 (let ((state (vc-state file))
1051 ;; The file is "locked" from the moment when the user saves 507 (rev (vc-workfile-version file)))
1052 ;; the modified buffer.
1053 ;;
1054 ;; This function assumes that the file is registered.
1055
1056 (let ((locker (vc-locking-user file))
1057 (rev (vc-workfile-version file)))
1058 (cond ((string= "0" rev) 508 (cond ((string= "0" rev)
1059 " @@") 509 ;; CVS special case; should go into a CVS-specific implementation
1060 ((not locker) 510 (concat backend " @@"))
1061 (concat "-" rev)) 511 ((or (eq state 'up-to-date)
1062 ((string= locker (vc-user-login-name)) 512 (eq state 'needs-patch))
1063 (concat ":" rev)) 513 (concat backend "-" rev))
1064 (t 514 ((stringp state)
1065 (concat ":" locker ":" rev))))) 515 (concat backend ":" state ":" rev))
516 (t
517 ;; Not just for the 'edited state, but also a fallback
518 ;; for all other states. Think about different symbols
519 ;; for 'needs-patch and 'needs-merge.
520 (concat backend ":" rev)))))
1066 521
1067(defun vc-follow-link () 522(defun vc-follow-link ()
1068 ;; If the current buffer visits a symbolic link, this function makes it 523 "If current buffer visits a symbolic link, visit the real file.
1069 ;; visit the real file instead. If the real file is already visited in 524If the real file is already visited in another buffer, make that buffer
1070 ;; another buffer, make that buffer current, and kill the buffer 525current, and kill the buffer that visits the link."
1071 ;; that visits the link.
1072 (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name))) 526 (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
1073 (true-buffer (find-buffer-visiting truename)) 527 (true-buffer (find-buffer-visiting truename))
1074 (this-buffer (current-buffer))) 528 (this-buffer (current-buffer)))
@@ -1082,12 +536,11 @@ control system name."
1082 (set-buffer true-buffer) 536 (set-buffer true-buffer)
1083 (kill-buffer this-buffer)))) 537 (kill-buffer this-buffer))))
1084 538
1085;;; install a call to the above as a find-file hook
1086(defun vc-find-file-hook () 539(defun vc-find-file-hook ()
540 "Function for `find-file-hooks' activating VC mode if appropriate."
1087 ;; Recompute whether file is version controlled, 541 ;; Recompute whether file is version controlled,
1088 ;; if user has killed the buffer and revisited. 542 ;; if user has killed the buffer and revisited.
1089 (cond 543 (when buffer-file-name
1090 ((and (not vc-ignore-vc-files) buffer-file-name)
1091 (vc-file-clearprops buffer-file-name) 544 (vc-file-clearprops buffer-file-name)
1092 (cond 545 (cond
1093 ((vc-backend buffer-file-name) 546 ((vc-backend buffer-file-name)
@@ -1109,7 +562,8 @@ control system name."
1109 ;; it again. GUD does that, and repeated questions 562 ;; it again. GUD does that, and repeated questions
1110 ;; are painful. 563 ;; are painful.
1111 (get-file-buffer 564 (get-file-buffer
1112 (abbreviate-file-name (file-chase-links buffer-file-name)))) 565 (abbreviate-file-name
566 (file-chase-links buffer-file-name))))
1113 567
1114 (vc-follow-link) 568 (vc-follow-link)
1115 (message "Followed link to %s" buffer-file-name) 569 (message "Followed link to %s" buffer-file-name)
@@ -1120,60 +574,45 @@ control system name."
1120 (progn (vc-follow-link) 574 (progn (vc-follow-link)
1121 (message "Followed link to %s" buffer-file-name) 575 (message "Followed link to %s" buffer-file-name)
1122 (vc-find-file-hook)) 576 (vc-find-file-hook))
1123 (message 577 (message
1124 "Warning: editing through the link bypasses version control") 578 "Warning: editing through the link bypasses version control")
1125 )))))))))) 579 )))))))))
1126 580
1127(add-hook 'find-file-hooks 'vc-find-file-hook) 581(add-hook 'find-file-hooks 'vc-find-file-hook)
1128 582
1129;;; more hooks, this time for file-not-found 583;;; more hooks, this time for file-not-found
1130(defun vc-file-not-found-hook () 584(defun vc-file-not-found-hook ()
1131 "When file is not found, try to check it out from RCS or SCCS. 585 "When file is not found, try to check it out from version control.
1132Returns t if checkout was successful, nil otherwise." 586Returns t if checkout was successful, nil otherwise.
587Used in `find-file-not-found-hooks'."
1133 ;; When a file does not exist, ignore cached info about it 588 ;; When a file does not exist, ignore cached info about it
1134 ;; from a previous visit. 589 ;; from a previous visit.
1135 (vc-file-clearprops buffer-file-name) 590 (vc-file-clearprops buffer-file-name)
1136 (if (and (not vc-ignore-vc-files) 591 (if (and (vc-backend buffer-file-name)
1137 (vc-backend buffer-file-name)) 592 (yes-or-no-p
1138 (save-excursion 593 (format "File %s was lost; check out from version control? "
1139 (require 'vc) 594 (file-name-nondirectory buffer-file-name))))
1140 (setq default-directory (file-name-directory (buffer-file-name))) 595 (save-excursion
1141 (not (vc-error-occurred (vc-checkout buffer-file-name)))))) 596 (require 'vc)
597 (setq default-directory (file-name-directory buffer-file-name))
598 (not (vc-error-occurred (vc-checkout buffer-file-name))))))
1142 599
1143(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook) 600(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
1144 601
1145;; Discard info about a file when we kill its buffer.
1146(defun vc-kill-buffer-hook () 602(defun vc-kill-buffer-hook ()
1147 (if (stringp (buffer-file-name)) 603 "Discard VC info about a file when we kill its buffer."
1148 (progn 604 (if (buffer-file-name)
1149 (vc-file-clearprops (buffer-file-name)) 605 (vc-file-clearprops (buffer-file-name))))
1150 (kill-local-variable 'vc-buffer-backend))))
1151 606
607;; ??? DL: why is this not done?
1152;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) 608;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
1153 609
1154;;; Now arrange for bindings and autoloading of the main package. 610;;; Now arrange for bindings and autoloading of the main package.
1155;;; Bindings for this have to go in the global map, as we'll often 611;;; Bindings for this have to go in the global map, as we'll often
1156;;; want to call them from random buffers. 612;;; want to call them from random buffers.
1157 613
1158(setq vc-prefix-map (lookup-key global-map "\C-xv")) 614(autoload 'vc-prefix-map "vc" nil nil 'keymap)
1159(if (not (keymapp vc-prefix-map)) 615(define-key global-map "\C-xv" 'vc-prefix-map)
1160 (progn
1161 (setq vc-prefix-map (make-sparse-keymap))
1162 (define-key global-map "\C-xv" vc-prefix-map)
1163 (define-key vc-prefix-map "a" 'vc-update-change-log)
1164 (define-key vc-prefix-map "c" 'vc-cancel-version)
1165 (define-key vc-prefix-map "d" 'vc-directory)
1166 (define-key vc-prefix-map "g" 'vc-annotate)
1167 (define-key vc-prefix-map "h" 'vc-insert-headers)
1168 (define-key vc-prefix-map "i" 'vc-register)
1169 (define-key vc-prefix-map "l" 'vc-print-log)
1170 (define-key vc-prefix-map "m" 'vc-merge)
1171 (define-key vc-prefix-map "r" 'vc-retrieve-snapshot)
1172 (define-key vc-prefix-map "s" 'vc-create-snapshot)
1173 (define-key vc-prefix-map "u" 'vc-revert-buffer)
1174 (define-key vc-prefix-map "v" 'vc-next-action)
1175 (define-key vc-prefix-map "=" 'vc-diff)
1176 (define-key vc-prefix-map "~" 'vc-version-other-window)))
1177 616
1178(if (not (boundp 'vc-menu-map)) 617(if (not (boundp 'vc-menu-map))
1179 ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar 618 ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
@@ -1213,7 +652,7 @@ Returns t if checkout was successful, nil otherwise."
1213;;;(put 'vc-version-other-window 'menu-enable 'vc-mode) 652;;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
1214;;;(put 'vc-diff 'menu-enable 'vc-mode) 653;;;(put 'vc-diff 'menu-enable 'vc-mode)
1215;;;(put 'vc-update-change-log 'menu-enable 654;;;(put 'vc-update-change-log 'menu-enable
1216;;; '(eq (vc-buffer-backend) 'RCS)) 655;;; '(member (vc-buffer-backend) '(RCS CVS)))
1217;;;(put 'vc-print-log 'menu-enable 'vc-mode) 656;;;(put 'vc-print-log 'menu-enable 'vc-mode)
1218;;;(put 'vc-cancel-version 'menu-enable 'vc-mode) 657;;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
1219;;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) 658;;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)