(authors-add): Don't add an entry if
[bpt/emacs.git] / lisp / vc-hooks.el
CommitLineData
aae56ea7 1;;; vc-hooks.el --- resident support for version-control
594722a8 2
0e0d9831 3;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc.
594722a8 4
0e0d9831
GM
5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
594722a8 7
67c6f446 8;; $Id: vc-hooks.el,v 1.122 2000/10/04 09:50:21 spiegel Exp $
f4c72097 9
594722a8
ER
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267
EN
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
594722a8
ER
26
27;;; Commentary:
28
0e0d9831
GM
29;; This is the always-loaded portion of VC. It takes care of
30;; VC-related activities that are done when you visit a file, so that
31;; vc.el itself is loaded only when you use a VC command. See the
32;; commentary of vc.el.
594722a8
ER
33
34;;; Code:
35
8ddceaf1
GM
36;(eval-when-compile
37; (require 'vc))
099bd78a 38
e1c0c2d1
KH
39;; Customization Variables (the rest is in vc.el)
40
0e0d9831
GM
41(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.")
42(defvar vc-master-templates () "Obsolete -- use vc-BACKEND-master-templates.")
43(defvar vc-header-alist () "Obsolete -- use vc-BACKEND-header.")
44
45(defcustom vc-handled-backends '(RCS CVS SCCS)
46 "*List of version control backends for which VC will be used.
47Entries in this list will be tried in order to determine whether a
48file is under that sort of version control.
49Removing an entry from the list prevents VC from being activated
50when visiting a file managed by that backend.
51An empty list disables VC altogether."
52 :type '(repeat symbol)
099bd78a 53 :version "21.1"
50bec091 54 :group 'vc)
31888047 55
50bec091 56(defcustom vc-path
e1c0c2d1
KH
57 (if (file-directory-p "/usr/sccs")
58 '("/usr/sccs")
59 nil)
50bec091
KH
60 "*List of extra directories to search for version control commands."
61 :type '(repeat directory)
62 :group 'vc)
e1c0c2d1 63
50bec091 64(defcustom vc-make-backup-files nil
5032bd23 65 "*If non-nil, backups of registered files are made as with other files.
50bec091
KH
66If nil (the default), files covered by version control don't get backups."
67 :type 'boolean
68 :group 'vc)
594722a8 69
50bec091 70(defcustom vc-follow-symlinks 'ask
0e0d9831
GM
71 "*What to do if visiting a symbolic link to a file under version control.
72Editing such a file through the link bypasses the version control system,
73which is dangerous and probably not what you want.
74
75If this variable is t, VC follows the link and visits the real file,
b8063212
AS
76telling you about it in the echo area. If it is `ask', VC asks for
77confirmation whether it should follow the link. If nil, the link is
50bec091 78visited and a warning displayed."
0e0d9831
GM
79 :type '(choice (const :tag "Ask for confirmation" ask)
80 (const :tag "Visit link and warn" nil)
81 (const :tag "Follow link" t))
50bec091 82 :group 'vc)
b8063212 83
50bec091 84(defcustom vc-display-status t
624c0e9d 85 "*If non-nil, display revision number and lock status in modeline.
50bec091
KH
86Otherwise, not displayed."
87 :type 'boolean
88 :group 'vc)
89
198d5c00 90
50bec091
KH
91(defcustom vc-consult-headers t
92 "*If non-nil, identify work files by searching for version headers."
93 :type 'boolean
94 :group 'vc)
e1c0c2d1 95
50bec091 96(defcustom vc-keep-workfiles t
e1c0c2d1
KH
97 "*If non-nil, don't delete working files after registering changes.
98If the back-end is CVS, workfiles are always kept, regardless of the
50bec091
KH
99value of this flag."
100 :type 'boolean
101 :group 'vc)
e1c0c2d1 102
50bec091 103(defcustom vc-mistrust-permissions nil
0e0d9831
GM
104 "*If non-nil, don't assume permissions/ownership track version-control status.
105If nil, do rely on the permissions.
50bec091
KH
106See also variable `vc-consult-headers'."
107 :type 'boolean
108 :group 'vc)
e66eac08
AS
109
110(defun vc-mistrust-permissions (file)
0e0d9831 111 "Internal access function to variable `vc-mistrust-permissions' for FILE."
e66eac08
AS
112 (or (eq vc-mistrust-permissions 't)
113 (and vc-mistrust-permissions
0e0d9831 114 (funcall vc-mistrust-permissions
e66eac08
AS
115 (vc-backend-subdirectory-name file)))))
116
594722a8 117;; Tell Emacs about this new kind of minor mode
0e0d9831 118(add-to-list 'minor-mode-alist '(vc-mode vc-mode))
594722a8 119
7bc2b98b 120(make-variable-buffer-local 'vc-mode)
c43e436c 121(put 'vc-mode 'permanent-local t)
594722a8 122
099bd78a
SM
123(defmacro vc-error-occurred (&rest body)
124 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
125
594722a8 126;; We need a notion of per-file properties because the version
f2ee4191 127;; control state of a file is expensive to derive --- we compute
0e0d9831 128;; them when the file is initially found, keep them up to date
f2ee4191
RS
129;; during any subsequent VC operations, and forget them when
130;; the buffer is killed.
594722a8 131
0e0d9831 132(defvar vc-file-prop-obarray (make-vector 16 0)
594722a8
ER
133 "Obarray for per-file properties.")
134
099bd78a
SM
135(defvar vc-touched-properties nil)
136
594722a8 137(defun vc-file-setprop (file property value)
0e0d9831 138 "Set per-file VC PROPERTY for FILE to VALUE."
099bd78a
SM
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)))
594722a8
ER
143 (put (intern file vc-file-prop-obarray) property value))
144
145(defun vc-file-getprop (file property)
099bd78a 146 "Get per-file VC PROPERTY for FILE."
594722a8
ER
147 (get (intern file vc-file-prop-obarray) property))
148
e1c0c2d1 149(defun vc-file-clearprops (file)
0e0d9831 150 "Clear all VC properties of FILE."
e1c0c2d1 151 (setplist (intern file vc-file-prop-obarray) nil))
f2ee4191 152
0e0d9831
GM
153\f
154;; We keep properties on each symbol naming a backend as follows:
155;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
156
157(defun vc-make-backend-sym (backend sym)
158 "Return BACKEND-specific version of VC symbol SYM."
159 (intern (concat "vc-" (downcase (symbol-name backend))
160 "-" (symbol-name sym))))
161
162(defun vc-find-backend-function (backend fun)
163 "Return BACKEND-specific implementation of FUN.
164If there is no such implementation, return the default implementation;
165if that doesn't exist either, return nil."
166 (let ((f (vc-make-backend-sym backend fun)))
167 (if (fboundp f) f
168 ;; Load vc-BACKEND.el if needed.
169 (require (intern (concat "vc-" (downcase (symbol-name backend)))))
170 (if (fboundp f) f
171 (let ((def (vc-make-backend-sym 'default fun)))
172 (if (fboundp def) (cons def backend) nil))))))
173
174(defun vc-call-backend (backend function-name &rest args)
175 "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
176Calls
177
178 (apply 'vc-BACKEND-FUN ARGS)
179
180if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
181and else calls
182
183 (apply 'vc-default-FUN BACKEND ARGS)
184
185It is usually called via the `vc-call' macro."
186 (let ((f (cdr (assoc function-name (get backend 'vc-functions)))))
187 (unless f
188 (setq f (vc-find-backend-function backend function-name))
189 (put backend 'vc-functions (cons (cons function-name f)
190 (get backend 'vc-functions))))
191 (if (consp f)
192 (apply (car f) (cdr f) args)
193 (apply f args))))
194
195(defmacro vc-call (fun file &rest args)
196 ;; BEWARE!! `file' is evaluated twice!!
197 `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
198
199\f
200(defsubst vc-parse-buffer (pattern i)
201 "Find PATTERN in the current buffer and return its Ith submatch."
202 (goto-char (point-min))
203 (if (re-search-forward pattern nil t)
204 (match-string i)))
e1c0c2d1 205
02d383eb 206(defun vc-insert-file (file &optional limit blocksize)
0e0d9831
GM
207 "Insert the contents of FILE into the current buffer.
208
209Optional argument LIMIT is a regexp. If present, the file is inserted
210in chunks of size BLOCKSIZE (default 8 kByte), until the first
211occurrence of LIMIT is found. The function returns nil if FILE doesn't
212exist."
07de4c3d 213 (erase-buffer)
02d383eb
RS
214 (cond ((file-exists-p file)
215 (cond (limit
216 (if (not blocksize) (setq blocksize 8192))
217 (let (found s)
218 (while (not found)
219 (setq s (buffer-size))
220 (goto-char (1+ s))
0e0d9831
GM
221 (setq found
222 (or (zerop (cadr (insert-file-contents
223 file nil s (+ s blocksize))))
02d383eb
RS
224 (progn (beginning-of-line)
225 (re-search-forward limit nil t)))))))
226 (t (insert-file-contents file)))
227 (set-buffer-modified-p nil)
228 (auto-save-mode nil)
229 t)
230 (t nil)))
231
02d383eb
RS
232;;; Access functions to file properties
233;;; (Properties should be _set_ using vc-file-setprop, but
234;;; _retrieved_ only through these functions, which decide
235;;; if the property is already known or not. A property should
0e0d9831 236;;; only be retrieved by vc-file-getprop if there is no
02d383eb
RS
237;;; access function.)
238
0e0d9831 239;;; properties indicating the backend being used for FILE
e1c0c2d1 240
0e0d9831
GM
241(defun vc-registered (file)
242 "Return non-nil if FILE is registered in a version control system.
243
1f22ad24
AS
244This function performs the check each time it is called. To rely
245on the result of a previous call, use `vc-backend' instead. If the
246file was previously registered under a certain backend, then that
247backend is tried first."
0e0d9831
GM
248 (let (handler)
249 (if (boundp 'file-name-handler-alist)
250 (setq handler (find-file-name-handler file 'vc-registered)))
251 (if handler
252 ;; handler should set vc-backend and return t if registered
253 (funcall handler 'vc-registered file)
254 ;; There is no file name handler.
255 ;; Try vc-BACKEND-registered for each handled BACKEND.
256 (catch 'found
1f22ad24
AS
257 (let ((backend (vc-file-getprop file 'vc-backend)))
258 (mapcar
259 (lambda (b)
260 (and (vc-call-backend b 'registered file)
261 (vc-file-setprop file 'vc-backend b)
262 (throw 'found t)))
263 (if (or (not backend) (eq backend 'none))
264 vc-handled-backends
265 (cons backend vc-handled-backends))))
0e0d9831
GM
266 ;; File is not registered.
267 (vc-file-setprop file 'vc-backend 'none)
268 nil))))
269
270(defun vc-backend (file)
271 "Return the version control type of FILE, nil if it is not registered."
272 ;; `file' can be nil in several places (typically due to the use of
273 ;; code like (vc-backend (buffer-file-name))).
274 (when (stringp file)
275 (let ((property (vc-file-getprop file 'vc-backend)))
276 ;; Note that internally, Emacs remembers unregistered
277 ;; files by setting the property to `none'.
278 (cond ((eq property 'none) nil)
279 (property)
280 ;; vc-registered sets the vc-backend property
281 (t (if (vc-registered file)
282 (vc-file-getprop file 'vc-backend)
283 nil))))))
284
285(defun vc-backend-subdirectory-name (file)
286 "Return where the master and lock FILEs for the current directory are kept."
287 (symbol-name (vc-backend file)))
e1c0c2d1 288
02d383eb 289(defun vc-name (file)
5eb2b516
DL
290 "Return the master name of FILE.
291If the file is not registered, or the master name is not known, return nil."
292 ;; TODO: This should ultimately become obsolete, at least up here
0e0d9831 293 ;; in vc-hooks.
02d383eb 294 (or (vc-file-getprop file 'vc-name)
64341022
AS
295 ;; force computation of the property by calling
296 ;; vc-BACKEND-registered explicitly
297 (if (and (vc-backend file)
298 (vc-call-backend (vc-backend file) 'registered file))
8aa81ea8 299 (vc-file-getprop file 'vc-name))))
e1c0c2d1 300
04446ed0 301(defun vc-checkout-model (file)
0e0d9831
GM
302 "Indicate how FILE is checked out.
303
304Possible values:
305
306 'implicit File is always writeable, and checked out `implicitly'
307 when the user saves the first changes to the file.
308
309 'locking File is read-only if up-to-date; user must type
310 \\[vc-toggle-read-only] before editing. Strict locking
311 is assumed.
312
313 'announce File is read-only if up-to-date; user must type
314 \\[vc-toggle-read-only] before editing. But other users
315 may be editing at the same time."
316 (or (vc-file-getprop file 'vc-checkout-model)
317 (vc-file-setprop file 'vc-checkout-model
318 (vc-call checkout-model file))))
7064821c 319
2a11c6f3 320(defun vc-user-login-name (&optional uid)
0e0d9831
GM
321 "Return the name under which the user is logged in, as a string.
322\(With optional argument UID, return the name of that user.)
323This function does the same as function `user-login-name', but unlike
324that, it never returns nil. If a UID cannot be resolved, that
325UID is returned as a string."
2a11c6f3 326 (or (user-login-name uid)
0e0d9831
GM
327 (number-to-string (or uid (user-uid)))))
328
329(defun vc-state (file)
330 "Return the version control state of FILE.
331
5eb2b516 332The value returned is one of:
0e0d9831
GM
333
334 'up-to-date The working file is unmodified with respect to the
335 latest version on the current branch, and not locked.
336
337 'edited The working file has been edited by the user. If
338 locking is used for the file, this state means that
339 the current version is locked by the calling user.
340
341 USER The current version of the working file is locked by
342 some other USER (a string).
343
344 'needs-patch The file has not been edited by the user, but there is
345 a more recent version on the current branch stored
346 in the master file.
347
348 'needs-merge The file has been edited by the user, and there is also
349 a more recent version on the current branch stored in
350 the master file. This state can only occur if locking
351 is not used for the file.
352
353 'unlocked-changes The current version of the working file is not locked,
354 but the working file has been changed with respect
355 to that version. This state can only occur for files
356 with locking; it represents an erroneous condition that
357 should be resolved by the user (vc-next-action will
358 prompt the user to do it)."
359 (or (vc-file-getprop file 'vc-state)
360 (vc-file-setprop file 'vc-state
361 (vc-call state-heuristic file))))
362
363(defsubst vc-up-to-date-p (file)
364 "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
365 (eq (vc-state file) 'up-to-date))
366
367(defun vc-default-state-heuristic (backend file)
5eb2b516
DL
368 "Default implementation of vc-state-heuristic.
369It simply calls the real state computation function `vc-BACKEND-state'
370and does not employ any heuristic at all."
0e0d9831 371 (vc-call-backend backend 'state file))
1efcbf46 372
e1c0c2d1 373(defun vc-workfile-version (file)
0e0d9831
GM
374 "Return version level of the current workfile FILE."
375 (or (vc-file-getprop file 'vc-workfile-version)
376 (vc-file-setprop file 'vc-workfile-version
377 (vc-call workfile-version file))))
f2ee4191 378
594722a8
ER
379;;; actual version-control code starts here
380
0e0d9831
GM
381(defun vc-default-registered (backend file)
382 "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
383 (let ((sym (vc-make-backend-sym backend 'master-templates)))
384 (unless (get backend 'vc-templates-grabbed)
385 (put backend 'vc-templates-grabbed t)
386 (set sym (append (delq nil
387 (mapcar
388 (lambda (template)
389 (and (consp template)
390 (eq (cdr template) backend)
391 (car template)))
392 vc-master-templates))
393 (symbol-value sym))))
394 (let ((result (vc-check-master-templates file (symbol-value sym))))
395 (if (stringp result)
396 (vc-file-setprop file 'vc-name result)
397 nil)))) ; Not registered
398
399(defun vc-possible-master (s dirname basename)
400 (cond
401 ((stringp s) (format s dirname basename))
402 ((functionp s)
403 ;; The template is a function to invoke. If the
404 ;; function returns non-nil, that means it has found a
405 ;; master. For backward compatibility, we also handle
406 ;; the case that the function throws a 'found atom
407 ;; and a pair (cons MASTER-FILE BACKEND).
408 (let ((result (catch 'found (funcall s dirname basename))))
409 (if (consp result) (car result) result)))))
410
411(defun vc-check-master-templates (file templates)
412 "Return non-nil if there is a master corresponding to FILE,
413according to any of the elements in TEMPLATES.
414
415TEMPLATES is a list of strings or functions. If an element is a
416string, it must be a control string as required by `format', with two
417string placeholders, such as \"%sRCS/%s,v\". The directory part of
418FILE is substituted for the first placeholder, the basename of FILE
419for the second. If a file with the resulting name exists, it is taken
420as the master of FILE, and returned.
421
422If an element of TEMPLATES is a function, it is called with the
423directory part and the basename of FILE as arguments. It should
424return non-nil if it finds a master; that value is then returned by
425this function."
426 (let ((dirname (or (file-name-directory file) ""))
427 (basename (file-name-nondirectory file)))
428 (catch 'found
5eb2b516 429 (mapcar
0e0d9831
GM
430 (lambda (s)
431 (let ((trial (vc-possible-master s dirname basename)))
432 (if (and trial (file-exists-p trial)
433 ;; Make sure the file we found with name
434 ;; TRIAL is not the source file itself.
435 ;; That can happen with RCS-style names if
436 ;; the file name is truncated (e.g. to 14
437 ;; chars). See if either directory or
438 ;; attributes differ.
439 (or (not (string= dirname
440 (file-name-directory trial)))
441 (not (equal (file-attributes file)
442 (file-attributes trial)))))
443 (throw 'found trial))))
444 templates))))
f2ee4191 445
c844616c 446(defun vc-toggle-read-only (&optional verbose)
c43e436c
RS
447 "Change read-only status of current buffer, perhaps via version control.
448If the buffer is visiting a file registered with version control,
449then check the file in or out. Otherwise, just change the read-only flag
ec44193a
KH
450of the buffer.
451With prefix argument, ask for version number to check in or check out.
452Check-out of a specified version number does not lock the file;
453to do that, use this command a second time with no argument."
c844616c 454 (interactive "P")
702220f3 455 (if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
0e0d9831
GM
456 ;; use boundp because vc.el might not be loaded
457 (vc-backend (buffer-file-name)))
c844616c 458 (vc-next-action verbose)
594722a8 459 (toggle-read-only)))
c43e436c 460(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
594722a8 461
d445a975
AS
462(defun vc-default-make-version-backups (backend file)
463 "Return non-nil if unmodified repository versions should
464be backed up locally. The default is to switch off this feature."
465 nil)
466
467(defun vc-version-backup-file-name (file &optional rev)
468 "Return a backup file name for REV or the current version of FILE."
469 (concat file ".~" (or rev (vc-workfile-version file)) "~"))
470
471(defun vc-before-save ()
472 "Function to be called by `basic-save-buffer' (in files.el)."
473 ;; If the file on disk is still in sync with the repository,
474 ;; and version backups should be made, copy the file to
475 ;; another name. This enables local diffs and local reverting.
476 (let ((file (buffer-file-name)))
477 (and (vc-backend file)
478 (vc-up-to-date-p file)
479 (eq (vc-checkout-model file) 'implicit)
480 (vc-call make-version-backups file)
481 (copy-file file (vc-version-backup-file-name file)
482 'ok-if-already-exists 'keep-date))))
483
e66eac08 484(defun vc-after-save ()
0e0d9831 485 "Function to be called by `basic-save-buffer' (in files.el)."
5eb2b516 486 ;; If the file in the current buffer is under version control,
0e0d9831
GM
487 ;; up-to-date, and locking is not used for the file, set
488 ;; the state to 'edited and redisplay the mode line.
e66eac08 489 (let ((file (buffer-file-name)))
8aa81ea8 490 (and (vc-backend file)
b23a2306
AS
491 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
492 (nth 5 (file-attributes file)))
493 ;; File has been saved in the same second in which
494 ;; it was checked out. Clear the checkout-time
495 ;; to avoid confusion.
496 (vc-file-setprop file 'vc-checkout-time nil))
497 t)
0e0d9831
GM
498 (vc-up-to-date-p file)
499 (eq (vc-checkout-model file) 'implicit)
500 (vc-file-setprop file 'vc-state 'edited)
501 (vc-mode-line file)
099bd78a
SM
502 (if (featurep 'vc)
503 ;; If VC is not loaded, then there can't be
504 ;; any VC Dired buffer to synchronize.
505 (vc-dired-resynch-file file)))))
04446ed0 506
0e0d9831 507(defun vc-mode-line (file)
7bc2b98b 508 "Set `vc-mode' to display type of version control for FILE.
594722a8 509The value is set in the current buffer, which should be the buffer
0e0d9831 510visiting FILE."
67c6f446 511 (interactive (list buffer-file-name))
0e0d9831 512 (unless (not (vc-backend file))
099bd78a
SM
513 (setq vc-mode (concat " " (if vc-display-status
514 (vc-call mode-line-string file)
515 (symbol-name (vc-backend file)))))
9becbeca
RS
516 ;; If the file is locked by some other user, make
517 ;; the buffer read-only. Like this, even root
defccde3 518 ;; cannot modify a file that someone else has locked.
0e0d9831
GM
519 (and (equal file (buffer-file-name))
520 (stringp (vc-state file))
e66eac08 521 (setq buffer-read-only t))
defccde3
RS
522 ;; If the user is root, and the file is not owner-writable,
523 ;; then pretend that we can't write it
524 ;; even though we can (because root can write anything).
525 ;; This way, even root cannot modify a file that isn't locked.
0e0d9831 526 (and (equal file (buffer-file-name))
9becbeca
RS
527 (not buffer-read-only)
528 (zerop (user-real-uid))
529 (zerop (logand (file-modes (buffer-file-name)) 128))
0e0d9831
GM
530 (setq buffer-read-only t)))
531 (force-mode-line-update)
532 (vc-backend file))
533
534(defun vc-default-mode-line-string (backend file)
535 "Return string for placement in modeline by `vc-mode-line' for FILE.
536Format:
537
538 \"BACKEND-REV\" if the file is up-to-date
539 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
540 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
0e0d9831
GM
541
542This function assumes that the file is registered."
543 (setq backend (symbol-name backend))
544 (let ((state (vc-state file))
545 (rev (vc-workfile-version file)))
099bd78a 546 (cond ((or (eq state 'up-to-date)
0e0d9831
GM
547 (eq state 'needs-patch))
548 (concat backend "-" rev))
549 ((stringp state)
550 (concat backend ":" state ":" rev))
551 (t
552 ;; Not just for the 'edited state, but also a fallback
553 ;; for all other states. Think about different symbols
554 ;; for 'needs-patch and 'needs-merge.
555 (concat backend ":" rev)))))
f2ee4191 556
a3a39848 557(defun vc-follow-link ()
0e0d9831
GM
558 "If current buffer visits a symbolic link, visit the real file.
559If the real file is already visited in another buffer, make that buffer
560current, and kill the buffer that visits the link."
566f2169 561 (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
e7f5ddc2
RS
562 (true-buffer (find-buffer-visiting truename))
563 (this-buffer (current-buffer)))
564 (if (eq true-buffer this-buffer)
565 (progn
d8221951 566 (kill-buffer this-buffer)
e7f5ddc2
RS
567 ;; In principle, we could do something like set-visited-file-name.
568 ;; However, it can't be exactly the same as set-visited-file-name.
569 ;; I'm not going to work out the details right now. -- rms.
d8221951 570 (set-buffer (find-file-noselect truename)))
e7f5ddc2
RS
571 (set-buffer true-buffer)
572 (kill-buffer this-buffer))))
a3a39848 573
594722a8 574(defun vc-find-file-hook ()
0e0d9831 575 "Function for `find-file-hooks' activating VC mode if appropriate."
18c8a18e
PE
576 ;; Recompute whether file is version controlled,
577 ;; if user has killed the buffer and revisited.
0e0d9831 578 (when buffer-file-name
f2ee4191
RS
579 (vc-file-clearprops buffer-file-name)
580 (cond
e1c0c2d1 581 ((vc-backend buffer-file-name)
f2ee4191
RS
582 (vc-mode-line buffer-file-name)
583 (cond ((not vc-make-backup-files)
584 ;; Use this variable, not make-backup-files,
585 ;; because this is for things that depend on the file name.
586 (make-local-variable 'backup-inhibited)
45fc7cc3
RS
587 (setq backup-inhibited t))))
588 ((let* ((link (file-symlink-p buffer-file-name))
227d2bed 589 (link-type (and link (vc-backend (file-chase-links link)))))
45fc7cc3 590 (if link-type
b8063212
AS
591 (cond ((eq vc-follow-symlinks nil)
592 (message
593 "Warning: symbolic link to %s-controlled source file" link-type))
566f2169
RS
594 ((or (not (eq vc-follow-symlinks 'ask))
595 ;; If we already visited this file by following
596 ;; the link, don't ask again if we try to visit
597 ;; it again. GUD does that, and repeated questions
598 ;; are painful.
599 (get-file-buffer
5eb2b516 600 (abbreviate-file-name
0e0d9831 601 (file-chase-links buffer-file-name))))
566f2169
RS
602
603 (vc-follow-link)
604 (message "Followed link to %s" buffer-file-name)
605 (vc-find-file-hook))
606 (t
b8063212
AS
607 (if (yes-or-no-p (format
608 "Symbolic link to %s-controlled source file; follow link? " link-type))
a3a39848 609 (progn (vc-follow-link)
b8063212
AS
610 (message "Followed link to %s" buffer-file-name)
611 (vc-find-file-hook))
0e0d9831 612 (message
b8063212 613 "Warning: editing through the link bypasses version control")
0e0d9831 614 )))))))))
594722a8 615
6379911c 616(add-hook 'find-file-hooks 'vc-find-file-hook)
594722a8
ER
617
618;;; more hooks, this time for file-not-found
619(defun vc-file-not-found-hook ()
0e0d9831
GM
620 "When file is not found, try to check it out from version control.
621Returns t if checkout was successful, nil otherwise.
622Used in `find-file-not-found-hooks'."
5f42a1d4
RS
623 ;; When a file does not exist, ignore cached info about it
624 ;; from a previous visit.
625 (vc-file-clearprops buffer-file-name)
0e0d9831 626 (if (and (vc-backend buffer-file-name)
5eb2b516 627 (yes-or-no-p
0e0d9831
GM
628 (format "File %s was lost; check out from version control? "
629 (file-name-nondirectory buffer-file-name))))
630 (save-excursion
631 (require 'vc)
632 (setq default-directory (file-name-directory buffer-file-name))
633 (not (vc-error-occurred (vc-checkout buffer-file-name))))))
594722a8 634
6379911c 635(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
594722a8 636
f2ee4191 637(defun vc-kill-buffer-hook ()
0e0d9831
GM
638 "Discard VC info about a file when we kill its buffer."
639 (if (buffer-file-name)
640 (vc-file-clearprops (buffer-file-name))))
f2ee4191 641
0e0d9831 642;; ??? DL: why is this not done?
f2ee4191
RS
643;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
644
594722a8 645;;; Now arrange for bindings and autoloading of the main package.
7bc2b98b
ER
646;;; Bindings for this have to go in the global map, as we'll often
647;;; want to call them from random buffers.
594722a8 648
0e0d9831
GM
649(autoload 'vc-prefix-map "vc" nil nil 'keymap)
650(define-key global-map "\C-xv" 'vc-prefix-map)
624c0e9d 651
b662fbb8
RM
652(if (not (boundp 'vc-menu-map))
653 ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
654 ;; vc-menu-map.
655 ()
656 ;;(define-key vc-menu-map [show-files]
657 ;; '("Show Files under VC" . (vc-directory t)))
9bef02e1
RS
658 (define-key vc-menu-map [vc-retrieve-snapshot]
659 '("Retrieve Snapshot" . vc-retrieve-snapshot))
660 (define-key vc-menu-map [vc-create-snapshot]
661 '("Create Snapshot" . vc-create-snapshot))
b64ea387 662 (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
b662fbb8 663 (define-key vc-menu-map [separator1] '("----"))
14aa11f4 664 (define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
b662fbb8
RM
665 (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
666 (define-key vc-menu-map [vc-version-other-window]
667 '("Show Other Version" . vc-version-other-window))
668 (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
669 (define-key vc-menu-map [vc-update-change-log]
670 '("Update ChangeLog" . vc-update-change-log))
671 (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
672 (define-key vc-menu-map [separator2] '("----"))
673 (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
674 (define-key vc-menu-map [vc-revert-buffer]
675 '("Revert to Last Version" . vc-revert-buffer))
676 (define-key vc-menu-map [vc-insert-header]
677 '("Insert Header" . vc-insert-headers))
9314395d 678 (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
738efc8e
KH
679 (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
680
b64ea387
DL
681;;; These are not correct and it's not currently clear how doing it
682;;; better (with more complicated expressions) might slow things down
683;;; on older systems.
684
685;;;(put 'vc-rename-file 'menu-enable 'vc-mode)
686;;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
687;;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
688;;;(put 'vc-diff 'menu-enable 'vc-mode)
689;;;(put 'vc-update-change-log 'menu-enable
0e0d9831 690;;; '(member (vc-buffer-backend) '(RCS CVS)))
b64ea387
DL
691;;;(put 'vc-print-log 'menu-enable 'vc-mode)
692;;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
693;;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)
694;;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
695;;;(put 'vc-next-action 'menu-enable 'vc-mode)
696;;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
594722a8 697
594722a8
ER
698(provide 'vc-hooks)
699
700;;; vc-hooks.el ends here