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