Checked anti.texi, errors.texi, and maps.texi.
[emacs.git] / lisp / vc-hooks.el
blobf9a73b21b2ee02cf03c27aa0f7b0a9e8d3bbc905
1 ;;; vc-hooks.el --- resident support for version-control
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: FSF (see vc.el for full credits)
7 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; This is the always-loaded portion of VC. It takes care of
27 ;; VC-related activities that are done when you visit a file, so that
28 ;; vc.el itself is loaded only when you use a VC command. See the
29 ;; commentary of vc.el.
31 ;;; Code:
33 (eval-when-compile
34 (require 'cl))
36 ;; Customization Variables (the rest is in vc.el)
38 (defvar vc-ignore-vc-files nil)
39 (make-obsolete-variable 'vc-ignore-vc-files
40 "set `vc-handled-backends' to nil to disable VC."
41 "21.1")
43 (defvar vc-master-templates ())
44 (make-obsolete-variable 'vc-master-templates
45 "to define master templates for a given BACKEND, use
46 vc-BACKEND-master-templates. To enable or disable VC for a given
47 BACKEND, use `vc-handled-backends'."
48 "21.1")
50 (defvar vc-header-alist ())
51 (make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header "21.1")
53 (defcustom vc-ignore-dir-regexp
54 ;; Stop SMB, automounter, AFS, and DFS host lookups.
55 locate-dominating-stop-dir-regexp
56 "Regexp matching directory names that are not under VC's control.
57 The default regexp prevents fruitless and time-consuming attempts
58 to determine the VC status in directories in which filenames are
59 interpreted as hostnames."
60 :type 'regexp
61 :group 'vc)
63 (defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
64 ;; RCS, CVS, SVN and SCCS come first because they are per-dir
65 ;; rather than per-tree. RCS comes first because of the multibackend
66 ;; support intended to use RCS for local commits (with a remote CVS server).
67 "List of version control backends for which VC will be used.
68 Entries in this list will be tried in order to determine whether a
69 file is under that sort of version control.
70 Removing an entry from the list prevents VC from being activated
71 when visiting a file managed by that backend.
72 An empty list disables VC altogether."
73 :type '(repeat symbol)
74 :version "23.1"
75 :group 'vc)
77 ;; Note: we don't actually have a darcs back end yet.
78 ;; Also, Meta-CVS (corresponsding to MCVS) is unsupported.
79 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS"
80 ".svn" ".git" ".hg" ".bzr"
81 "_MTN" "_darcs" "{arch}")
82 "List of directory names to be ignored when walking directory trees."
83 :type '(repeat string)
84 :group 'vc)
86 (defcustom vc-path nil
87 "List of extra directories to search for version control commands."
88 :type '(repeat directory)
89 :group 'vc)
91 (defcustom vc-make-backup-files nil
92 "If non-nil, backups of registered files are made as with other files.
93 If nil (the default), files covered by version control don't get backups."
94 :type 'boolean
95 :group 'vc
96 :group 'backup)
98 (defcustom vc-follow-symlinks 'ask
99 "What to do if visiting a symbolic link to a file under version control.
100 Editing such a file through the link bypasses the version control system,
101 which is dangerous and probably not what you want.
103 If this variable is t, VC follows the link and visits the real file,
104 telling you about it in the echo area. If it is `ask', VC asks for
105 confirmation whether it should follow the link. If nil, the link is
106 visited and a warning displayed."
107 :type '(choice (const :tag "Ask for confirmation" ask)
108 (const :tag "Visit link and warn" nil)
109 (const :tag "Follow link" t))
110 :group 'vc)
112 (defcustom vc-display-status t
113 "If non-nil, display revision number and lock status in modeline.
114 Otherwise, not displayed."
115 :type 'boolean
116 :group 'vc)
119 (defcustom vc-consult-headers t
120 "If non-nil, identify work files by searching for version headers."
121 :type 'boolean
122 :group 'vc)
124 (defcustom vc-keep-workfiles t
125 "If non-nil, don't delete working files after registering changes.
126 If the back-end is CVS, workfiles are always kept, regardless of the
127 value of this flag."
128 :type 'boolean
129 :group 'vc)
131 (defcustom vc-mistrust-permissions nil
132 "If non-nil, don't assume permissions/ownership track version-control status.
133 If nil, do rely on the permissions.
134 See also variable `vc-consult-headers'."
135 :type 'boolean
136 :group 'vc)
138 (defun vc-mistrust-permissions (file)
139 "Internal access function to variable `vc-mistrust-permissions' for FILE."
140 (or (eq vc-mistrust-permissions 't)
141 (and vc-mistrust-permissions
142 (funcall vc-mistrust-permissions
143 (vc-backend-subdirectory-name file)))))
145 (defcustom vc-stay-local 'only-file
146 "Non-nil means use local operations when possible for remote repositories.
147 This avoids slow queries over the network and instead uses heuristics
148 and past information to determine the current status of a file.
150 If value is the symbol `only-file' `vc-dir' will connect to the
151 server, but heuristics will be used to determine the status for
152 all other VC operations.
154 The value can also be a regular expression or list of regular
155 expressions to match against the host name of a repository; then VC
156 only stays local for hosts that match it. Alternatively, the value
157 can be a list of regular expressions where the first element is the
158 symbol `except'; then VC always stays local except for hosts matched
159 by these regular expressions."
160 :type '(choice
161 (const :tag "Always stay local" t)
162 (const :tag "Only for file operations" only-file)
163 (const :tag "Don't stay local" nil)
164 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
165 (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
166 (regexp :format " stay local,\n%t: %v" :tag "if it matches")
167 (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
168 :version "23.1"
169 :group 'vc)
171 (defun vc-stay-local-p (file)
172 "Return non-nil if VC should stay local when handling FILE.
173 This uses the `repository-hostname' backend operation.
174 If FILE is a list of files, return non-nil if any of them
175 individually should stay local."
176 (if (listp file)
177 (delq nil (mapcar 'vc-stay-local-p file))
178 (let* ((backend (vc-backend file))
179 (sym (vc-make-backend-sym backend 'stay-local))
180 (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
181 (if (symbolp stay-local) stay-local
182 (let ((dirname (if (file-directory-p file)
183 (directory-file-name file)
184 (file-name-directory file))))
185 (eq 'yes
186 (or (vc-file-getprop dirname 'vc-stay-local-p)
187 (vc-file-setprop
188 dirname 'vc-stay-local-p
189 (let ((hostname (vc-call-backend
190 backend 'repository-hostname dirname)))
191 (if (not hostname)
193 (let ((default t))
194 (if (eq (car-safe stay-local) 'except)
195 (setq default nil stay-local (cdr stay-local)))
196 (when (consp stay-local)
197 (setq stay-local
198 (mapconcat 'identity stay-local "\\|")))
199 (if (if (string-match stay-local hostname)
200 default (not default))
201 'yes 'no))))))))))))
203 ;;; This is handled specially now.
204 ;; Tell Emacs about this new kind of minor mode
205 ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
207 (make-variable-buffer-local 'vc-mode)
208 (put 'vc-mode 'permanent-local t)
210 (defun vc-mode (&optional arg)
211 ;; Dummy function for C-h m
212 "Version Control minor mode.
213 This minor mode is automatically activated whenever you visit a file under
214 control of one of the revision control systems in `vc-handled-backends'.
215 VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
216 \\{vc-prefix-map}")
218 (defmacro vc-error-occurred (&rest body)
219 `(condition-case nil (progn ,@body nil) (error t)))
221 ;; We need a notion of per-file properties because the version
222 ;; control state of a file is expensive to derive --- we compute
223 ;; them when the file is initially found, keep them up to date
224 ;; during any subsequent VC operations, and forget them when
225 ;; the buffer is killed.
227 (defvar vc-file-prop-obarray (make-vector 17 0)
228 "Obarray for per-file properties.")
230 (defvar vc-touched-properties nil)
232 (defun vc-file-setprop (file property value)
233 "Set per-file VC PROPERTY for FILE to VALUE."
234 (if (and vc-touched-properties
235 (not (memq property vc-touched-properties)))
236 (setq vc-touched-properties (append (list property)
237 vc-touched-properties)))
238 (put (intern file vc-file-prop-obarray) property value))
240 (defun vc-file-getprop (file property)
241 "Get per-file VC PROPERTY for FILE."
242 (get (intern file vc-file-prop-obarray) property))
244 (defun vc-file-clearprops (file)
245 "Clear all VC properties of FILE."
246 (setplist (intern file vc-file-prop-obarray) nil))
249 ;; We keep properties on each symbol naming a backend as follows:
250 ;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
252 (defun vc-make-backend-sym (backend sym)
253 "Return BACKEND-specific version of VC symbol SYM."
254 (intern (concat "vc-" (downcase (symbol-name backend))
255 "-" (symbol-name sym))))
257 (defun vc-find-backend-function (backend fun)
258 "Return BACKEND-specific implementation of FUN.
259 If there is no such implementation, return the default implementation;
260 if that doesn't exist either, return nil."
261 (let ((f (vc-make-backend-sym backend fun)))
262 (if (fboundp f) f
263 ;; Load vc-BACKEND.el if needed.
264 (require (intern (concat "vc-" (downcase (symbol-name backend)))))
265 (if (fboundp f) f
266 (let ((def (vc-make-backend-sym 'default fun)))
267 (if (fboundp def) (cons def backend) nil))))))
269 (defun vc-call-backend (backend function-name &rest args)
270 "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
271 Calls
273 (apply 'vc-BACKEND-FUN ARGS)
275 if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
276 and else calls
278 (apply 'vc-default-FUN BACKEND ARGS)
280 It is usually called via the `vc-call' macro."
281 (let ((f (assoc function-name (get backend 'vc-functions))))
282 (if f (setq f (cdr f))
283 (setq f (vc-find-backend-function backend function-name))
284 (push (cons function-name f) (get backend 'vc-functions)))
285 (cond
286 ((null f)
287 (error "Sorry, %s is not implemented for %s" function-name backend))
288 ((consp f) (apply (car f) (cdr f) args))
289 (t (apply f args)))))
291 (defmacro vc-call (fun file &rest args)
292 "A convenience macro for calling VC backend functions.
293 Functions called by this macro must accept FILE as the first argument.
294 ARGS specifies any additional arguments. FUN should be unquoted.
295 BEWARE!! FILE is evaluated twice!!"
296 `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
298 (defsubst vc-parse-buffer (pattern i)
299 "Find PATTERN in the current buffer and return its Ith submatch."
300 (goto-char (point-min))
301 (if (re-search-forward pattern nil t)
302 (match-string i)))
304 (defun vc-insert-file (file &optional limit blocksize)
305 "Insert the contents of FILE into the current buffer.
307 Optional argument LIMIT is a regexp. If present, the file is inserted
308 in chunks of size BLOCKSIZE (default 8 kByte), until the first
309 occurrence of LIMIT is found. Anything from the start of that occurrence
310 to the end of the buffer is then deleted. The function returns
311 non-nil if FILE exists and its contents were successfully inserted."
312 (erase-buffer)
313 (when (file-exists-p file)
314 (if (not limit)
315 (insert-file-contents file)
316 (unless blocksize (setq blocksize 8192))
317 (let ((filepos 0))
318 (while
319 (and (< 0 (cadr (insert-file-contents
320 file nil filepos (incf filepos blocksize))))
321 (progn (beginning-of-line)
322 (let ((pos (re-search-forward limit nil 'move)))
323 (when pos (delete-region (match-beginning 0)
324 (point-max)))
325 (not pos)))))))
326 (set-buffer-modified-p nil)
329 (defun vc-find-root (file witness)
330 "Find the root of a checked out project.
331 The function walks up the directory tree from FILE looking for WITNESS.
332 If WITNESS if not found, return nil, otherwise return the root."
333 (let ((locate-dominating-stop-dir-regexp
334 (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)))
335 (locate-dominating-file file witness)))
337 ;; Access functions to file properties
338 ;; (Properties should be _set_ using vc-file-setprop, but
339 ;; _retrieved_ only through these functions, which decide
340 ;; if the property is already known or not. A property should
341 ;; only be retrieved by vc-file-getprop if there is no
342 ;; access function.)
344 ;; properties indicating the backend being used for FILE
346 (defun vc-registered (file)
347 "Return non-nil if FILE is registered in a version control system.
349 This function performs the check each time it is called. To rely
350 on the result of a previous call, use `vc-backend' instead. If the
351 file was previously registered under a certain backend, then that
352 backend is tried first."
353 (let (handler)
354 (cond
355 ((and (file-name-directory file)
356 (string-match vc-ignore-dir-regexp (file-name-directory file)))
357 nil)
358 ((and (boundp 'file-name-handler-alist)
359 (setq handler (find-file-name-handler file 'vc-registered)))
360 ;; handler should set vc-backend and return t if registered
361 (funcall handler 'vc-registered file))
363 ;; There is no file name handler.
364 ;; Try vc-BACKEND-registered for each handled BACKEND.
365 (catch 'found
366 (let ((backend (vc-file-getprop file 'vc-backend)))
367 (mapc
368 (lambda (b)
369 (and (vc-call-backend b 'registered file)
370 (vc-file-setprop file 'vc-backend b)
371 (throw 'found t)))
372 (if (or (not backend) (eq backend 'none))
373 vc-handled-backends
374 (cons backend vc-handled-backends))))
375 ;; File is not registered.
376 (vc-file-setprop file 'vc-backend 'none)
377 nil)))))
379 (defun vc-backend (file-or-list)
380 "Return the version control type of FILE-OR-LIST, nil if it's not registered.
381 If the argument is a list, the files must all have the same back end."
382 ;; `file' can be nil in several places (typically due to the use of
383 ;; code like (vc-backend buffer-file-name)).
384 (cond ((stringp file-or-list)
385 (let ((property (vc-file-getprop file-or-list 'vc-backend)))
386 ;; Note that internally, Emacs remembers unregistered
387 ;; files by setting the property to `none'.
388 (cond ((eq property 'none) nil)
389 (property)
390 ;; vc-registered sets the vc-backend property
391 (t (if (vc-registered file-or-list)
392 (vc-file-getprop file-or-list 'vc-backend)
393 nil)))))
394 ((and file-or-list (listp file-or-list))
395 (vc-backend (car file-or-list)))
397 nil)))
400 (defun vc-backend-subdirectory-name (file)
401 "Return where the master and lock FILEs for the current directory are kept."
402 (symbol-name (vc-backend file)))
404 (defun vc-name (file)
405 "Return the master name of FILE.
406 If the file is not registered, or the master name is not known, return nil."
407 ;; TODO: This should ultimately become obsolete, at least up here
408 ;; in vc-hooks.
409 (or (vc-file-getprop file 'vc-name)
410 ;; force computation of the property by calling
411 ;; vc-BACKEND-registered explicitly
412 (let ((backend (vc-backend file)))
413 (if (and backend
414 (vc-call-backend backend 'registered file))
415 (vc-file-getprop file 'vc-name)))))
417 (defun vc-checkout-model (backend files)
418 "Indicate how FILES are checked out.
420 If FILES are not registered, this function always returns nil.
421 For registered files, the possible values are:
423 'implicit FILES are always writable, and checked out `implicitly'
424 when the user saves the first changes to the file.
426 'locking FILES are read-only if up-to-date; user must type
427 \\[vc-next-action] before editing. Strict locking
428 is assumed.
430 'announce FILES are read-only if up-to-date; user must type
431 \\[vc-next-action] before editing. But other users
432 may be editing at the same time."
433 (vc-call-backend backend 'checkout-model files))
435 (defun vc-user-login-name (file)
436 "Return the name under which the user accesses the given FILE."
437 (or (and (eq (string-match tramp-file-name-regexp file) 0)
438 ;; tramp case: execute "whoami" via tramp
439 (let ((default-directory (file-name-directory file)))
440 (with-temp-buffer
441 (if (not (zerop (process-file "whoami" nil t)))
442 ;; fall through if "whoami" didn't work
444 ;; remove trailing newline
445 (delete-region (1- (point-max)) (point-max))
446 (buffer-string)))))
447 ;; normal case
448 (user-login-name)
449 ;; if user-login-name is nil, return the UID as a string
450 (number-to-string (user-uid))))
452 (defun vc-state (file)
453 "Return the version control state of FILE.
455 If FILE is not registered, this function always returns nil.
456 For registered files, the value returned is one of:
458 'up-to-date The working file is unmodified with respect to the
459 latest version on the current branch, and not locked.
461 'edited The working file has been edited by the user. If
462 locking is used for the file, this state means that
463 the current version is locked by the calling user.
465 USER The current version of the working file is locked by
466 some other USER (a string).
468 'needs-update The file has not been edited by the user, but there is
469 a more recent version on the current branch stored
470 in the master file.
472 'needs-merge The file has been edited by the user, and there is also
473 a more recent version on the current branch stored in
474 the master file. This state can only occur if locking
475 is not used for the file.
477 'unlocked-changes The working version of the file is not locked,
478 but the working file has been changed with respect
479 to that version. This state can only occur for files
480 with locking; it represents an erroneous condition that
481 should be resolved by the user (vc-next-action will
482 prompt the user to do it).
484 'added Scheduled to go into the repository on the next commit.
485 Often represented by vc-working-revision = \"0\" in VCSes
486 with monotonic IDs like Subversion and Mercurial.
488 'removed Scheduled to be deleted from the repository on next commit.
490 'conflict The file contains conflicts as the result of a merge.
491 For now the conflicts are text conflicts. In the
492 future this might be extended to deal with metadata
493 conflicts too.
495 'missing The file is not present in the file system, but the VC
496 system still tracks it.
498 'ignored The file showed up in a dir-status listing with a flag
499 indicating the version-control system is ignoring it,
500 Note: This property is not set reliably (some VCSes
501 don't have useful directory-status commands) so assume
502 that any file with vc-state nil might be ignorable
503 without VC knowing it.
505 'unregistered The file is not under version control.
507 A return of nil from this function means we have no information on the
508 status of this file."
509 ;; Note: in Emacs 22 and older, return of nil meant the file was
510 ;; unregistered. This is potentially a source of
511 ;; backward-compatibility bugs.
513 ;; FIXME: New (sub)states needed (?):
514 ;; - `copied' and `moved' (might be handled by `removed' and `added')
515 (or (vc-file-getprop file 'vc-state)
516 (when (> (length file) 0)
517 (let ((backend (vc-backend file)))
518 (when backend
519 (vc-file-setprop
520 file 'vc-state
521 (vc-call-backend backend 'state-heuristic file)))))))
523 (defsubst vc-up-to-date-p (file)
524 "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
525 (eq (vc-state file) 'up-to-date))
527 (defun vc-default-state-heuristic (backend file)
528 "Default implementation of vc-BACKEND-state-heuristic.
529 It simply calls the real state computation function `vc-BACKEND-state'
530 and does not employ any heuristic at all."
531 (vc-call-backend backend 'state file))
533 (defun vc-workfile-unchanged-p (file)
534 "Return non-nil if FILE has not changed since the last checkout."
535 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
536 (lastmod (nth 5 (file-attributes file))))
537 ;; This is a shortcut for determining when the workfile is
538 ;; unchanged. It can fail under some circumstances; see the
539 ;; discussion in bug#694.
540 (if (and checkout-time
541 ;; Tramp and Ange-FTP return this when they don't know the time.
542 (not (equal lastmod '(0 0))))
543 (equal checkout-time lastmod)
544 (let ((unchanged (vc-call workfile-unchanged-p file)))
545 (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
546 unchanged))))
548 (defun vc-default-workfile-unchanged-p (backend file)
549 "Check if FILE is unchanged by diffing against the master version.
550 Return non-nil if FILE is unchanged."
551 (zerop (condition-case err
552 ;; If the implementation supports it, let the output
553 ;; go to *vc*, not *vc-diff*, since this is an internal call.
554 (vc-call-backend backend 'diff (list file) nil nil "*vc*")
555 (wrong-number-of-arguments
556 ;; If this error came from the above call to vc-BACKEND-diff,
557 ;; try again without the optional buffer argument (for
558 ;; backward compatibility). Otherwise, resignal.
559 (if (or (not (eq (cadr err)
560 (indirect-function
561 (vc-find-backend-function backend 'diff))))
562 (not (eq (caddr err) 4)))
563 (signal (car err) (cdr err))
564 (vc-call-backend backend 'diff (list file)))))))
566 (defun vc-working-revision (file)
567 "Return the repository version from which FILE was checked out.
568 If FILE is not registered, this function always returns nil."
569 (or (vc-file-getprop file 'vc-working-revision)
570 (let ((backend (vc-backend file)))
571 (when backend
572 (vc-file-setprop file 'vc-working-revision
573 (vc-call-backend backend 'working-revision file))))))
575 ;; Backward compatibility.
576 (define-obsolete-function-alias
577 'vc-workfile-version 'vc-working-revision "23.1")
578 (defun vc-default-working-revision (backend file)
579 (message
580 "`working-revision' not found: using the old `workfile-version' instead")
581 (vc-call-backend backend 'workfile-version file))
583 (defun vc-default-registered (backend file)
584 "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
585 (let ((sym (vc-make-backend-sym backend 'master-templates)))
586 (unless (get backend 'vc-templates-grabbed)
587 (put backend 'vc-templates-grabbed t)
588 (set sym (append (delq nil
589 (mapcar
590 (lambda (template)
591 (and (consp template)
592 (eq (cdr template) backend)
593 (car template)))
594 (with-no-warnings
595 vc-master-templates)))
596 (symbol-value sym))))
597 (let ((result (vc-check-master-templates file (symbol-value sym))))
598 (if (stringp result)
599 (vc-file-setprop file 'vc-name result)
600 nil)))) ; Not registered
602 (defun vc-possible-master (s dirname basename)
603 (cond
604 ((stringp s) (format s dirname basename))
605 ((functionp s)
606 ;; The template is a function to invoke. If the
607 ;; function returns non-nil, that means it has found a
608 ;; master. For backward compatibility, we also handle
609 ;; the case that the function throws a 'found atom
610 ;; and a pair (cons MASTER-FILE BACKEND).
611 (let ((result (catch 'found (funcall s dirname basename))))
612 (if (consp result) (car result) result)))))
614 (defun vc-check-master-templates (file templates)
615 "Return non-nil if there is a master corresponding to FILE.
617 TEMPLATES is a list of strings or functions. If an element is a
618 string, it must be a control string as required by `format', with two
619 string placeholders, such as \"%sRCS/%s,v\". The directory part of
620 FILE is substituted for the first placeholder, the basename of FILE
621 for the second. If a file with the resulting name exists, it is taken
622 as the master of FILE, and returned.
624 If an element of TEMPLATES is a function, it is called with the
625 directory part and the basename of FILE as arguments. It should
626 return non-nil if it finds a master; that value is then returned by
627 this function."
628 (let ((dirname (or (file-name-directory file) ""))
629 (basename (file-name-nondirectory file)))
630 (catch 'found
631 (mapcar
632 (lambda (s)
633 (let ((trial (vc-possible-master s dirname basename)))
634 (when (and trial (file-exists-p trial)
635 ;; Make sure the file we found with name
636 ;; TRIAL is not the source file itself.
637 ;; That can happen with RCS-style names if
638 ;; the file name is truncated (e.g. to 14
639 ;; chars). See if either directory or
640 ;; attributes differ.
641 (or (not (string= dirname
642 (file-name-directory trial)))
643 (not (equal (file-attributes file)
644 (file-attributes trial)))))
645 (throw 'found trial))))
646 templates))))
648 (defun vc-toggle-read-only (&optional verbose)
649 "Change read-only status of current buffer, perhaps via version control.
651 If the buffer is visiting a file registered with version control,
652 throw an error, because this is not a safe or really meaningful operation
653 on any version-control system newer than RCS.
655 Otherwise, just change the read-only flag of the buffer.
657 If you bind this function to \\[toggle-read-only], then Emacs
658 will properly intercept all attempts to toggle the read-only flag
659 on version-controlled buffer."
660 (interactive "P")
661 (if (vc-backend buffer-file-name)
662 (error "Toggling the readability of a version controlled file is likely to wreak havoc.")
663 (toggle-read-only)))
665 (defun vc-default-make-version-backups-p (backend file)
666 "Return non-nil if unmodified versions should be backed up locally.
667 The default is to switch off this feature."
668 nil)
670 (defun vc-version-backup-file-name (file &optional rev manual regexp)
671 "Return a backup file name for REV or the current version of FILE.
672 If MANUAL is non-nil it means that a name for backups created by
673 the user should be returned; if REGEXP is non-nil that means to return
674 a regexp for matching all such backup files, regardless of the version."
675 (if regexp
676 (concat (regexp-quote (file-name-nondirectory file))
677 "\\.~.+" (unless manual "\\.") "~")
678 (expand-file-name (concat (file-name-nondirectory file)
679 ".~" (subst-char-in-string
680 ?/ ?_ (or rev (vc-working-revision file)))
681 (unless manual ".") "~")
682 (file-name-directory file))))
684 (defun vc-delete-automatic-version-backups (file)
685 "Delete all existing automatic version backups for FILE."
686 (condition-case nil
687 (mapc
688 'delete-file
689 (directory-files (or (file-name-directory file) default-directory) t
690 (vc-version-backup-file-name file nil nil t)))
691 ;; Don't fail when the directory doesn't exist.
692 (file-error nil)))
694 (defun vc-make-version-backup (file)
695 "Make a backup copy of FILE, which is assumed in sync with the repository.
696 Before doing that, check if there are any old backups and get rid of them."
697 (unless (and (fboundp 'msdos-long-file-names)
698 (not (with-no-warnings (msdos-long-file-names))))
699 (vc-delete-automatic-version-backups file)
700 (condition-case nil
701 (copy-file file (vc-version-backup-file-name file)
702 nil 'keep-date)
703 ;; It's ok if it doesn't work (e.g. directory not writable),
704 ;; since this is just for efficiency.
705 (file-error
706 (message
707 (concat "Warning: Cannot make version backup; "
708 "diff/revert therefore not local"))))))
710 (defun vc-before-save ()
711 "Function to be called by `basic-save-buffer' (in files.el)."
712 ;; If the file on disk is still in sync with the repository,
713 ;; and version backups should be made, copy the file to
714 ;; another name. This enables local diffs and local reverting.
715 (let ((file buffer-file-name)
716 backend)
717 (ignore-errors ;Be careful not to prevent saving the file.
718 (and (setq backend (vc-backend file))
719 (vc-up-to-date-p file)
720 (eq (vc-checkout-model backend (list file)) 'implicit)
721 (vc-call-backend backend 'make-version-backups-p file)
722 (vc-make-version-backup file)))))
724 (declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
726 (defun vc-after-save ()
727 "Function to be called by `basic-save-buffer' (in files.el)."
728 ;; If the file in the current buffer is under version control,
729 ;; up-to-date, and locking is not used for the file, set
730 ;; the state to 'edited and redisplay the mode line.
731 (let* ((file buffer-file-name)
732 (backend (vc-backend file)))
733 (and backend
734 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
735 (nth 5 (file-attributes file)))
736 ;; File has been saved in the same second in which
737 ;; it was checked out. Clear the checkout-time
738 ;; to avoid confusion.
739 (vc-file-setprop file 'vc-checkout-time nil))
741 (vc-up-to-date-p file)
742 (eq (vc-checkout-model backend (list file)) 'implicit)
743 (vc-file-setprop file 'vc-state 'edited)
744 (vc-mode-line file)
745 ;; Try to avoid unnecessary work, a *vc-dir* buffer is only
746 ;; present if this is true.
747 (when (memq 'vc-dir-resynch-file after-save-hook)
748 (vc-dir-resynch-file file)))))
750 (defvar vc-menu-entry
751 '(menu-item "Version Control" vc-menu-map
752 :filter vc-menu-map-filter))
754 (when (boundp 'menu-bar-tools-menu)
755 ;; We do not need to worry here about the placement of this entry
756 ;; because menu-bar.el has already created the proper spot for us
757 ;; and this will simply use it.
758 (define-key menu-bar-tools-menu [vc] vc-menu-entry))
760 (defconst vc-mode-line-map
761 (let ((map (make-sparse-keymap)))
762 (define-key map [mode-line down-mouse-1] vc-menu-entry)
763 map))
765 (defun vc-mode-line (file &optional backend)
766 "Set `vc-mode' to display type of version control for FILE.
767 The value is set in the current buffer, which should be the buffer
768 visiting FILE.
769 If BACKEND is passed use it as the VC backend when computing the result."
770 (interactive (list buffer-file-name))
771 (setq backend (or backend (vc-backend file)))
772 (if (not backend)
773 (setq vc-mode nil)
774 (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
775 (ml-echo (get-text-property 0 'help-echo ml-string)))
776 (setq vc-mode
777 (concat
779 (if (null vc-display-status)
780 (symbol-name backend)
781 (propertize
782 ml-string
783 'mouse-face 'mode-line-highlight
784 'help-echo
785 (concat (or ml-echo
786 (format "File under the %s version control system"
787 backend))
788 "\nmouse-1: Version Control menu")
789 'local-map vc-mode-line-map)))))
790 ;; If the file is locked by some other user, make
791 ;; the buffer read-only. Like this, even root
792 ;; cannot modify a file that someone else has locked.
793 (and (equal file buffer-file-name)
794 (stringp (vc-state file))
795 (setq buffer-read-only t))
796 ;; If the user is root, and the file is not owner-writable,
797 ;; then pretend that we can't write it
798 ;; even though we can (because root can write anything).
799 ;; This way, even root cannot modify a file that isn't locked.
800 (and (equal file buffer-file-name)
801 (not buffer-read-only)
802 (zerop (user-real-uid))
803 (zerop (logand (file-modes buffer-file-name) 128))
804 (setq buffer-read-only t)))
805 (force-mode-line-update)
806 backend)
808 (defun vc-default-mode-line-string (backend file)
809 "Return string for placement in modeline by `vc-mode-line' for FILE.
810 Format:
812 \"BACKEND-REV\" if the file is up-to-date
813 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
814 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
816 This function assumes that the file is registered."
817 (setq backend (symbol-name backend))
818 (let ((state (vc-state file))
819 (state-echo nil)
820 (rev (vc-working-revision file)))
821 (propertize
822 (cond ((or (eq state 'up-to-date)
823 (eq state 'needs-update))
824 (setq state-echo "Up to date file")
825 (concat backend "-" rev))
826 ((stringp state)
827 (setq state-echo (concat "File locked by" state))
828 (concat backend ":" state ":" rev))
829 ((eq state 'added)
830 (setq state-echo "Locally added file")
831 (concat backend "@" rev))
832 ((eq state 'conflict)
833 (setq state-echo "File contains conflicts after the last merge")
834 (concat backend "!" rev))
835 ((eq state 'removed)
836 (setq state-echo "File removed from the VC system")
837 (concat backend "!" rev))
838 ((eq state 'missing)
839 (setq state-echo "File tracked by the VC system, but missing from the file system")
840 (concat backend "?" rev))
842 ;; Not just for the 'edited state, but also a fallback
843 ;; for all other states. Think about different symbols
844 ;; for 'needs-update and 'needs-merge.
845 (setq state-echo "Locally modified file")
846 (concat backend ":" rev)))
847 'help-echo (concat state-echo " under the " backend
848 " version control system"))))
850 (defun vc-follow-link ()
851 "If current buffer visits a symbolic link, visit the real file.
852 If the real file is already visited in another buffer, make that buffer
853 current, and kill the buffer that visits the link."
854 (let* ((true-buffer (find-buffer-visiting buffer-file-truename))
855 (this-buffer (current-buffer)))
856 (if (eq true-buffer this-buffer)
857 (let ((truename buffer-file-truename))
858 (kill-buffer this-buffer)
859 ;; In principle, we could do something like set-visited-file-name.
860 ;; However, it can't be exactly the same as set-visited-file-name.
861 ;; I'm not going to work out the details right now. -- rms.
862 (set-buffer (find-file-noselect truename)))
863 (set-buffer true-buffer)
864 (kill-buffer this-buffer))))
866 (defun vc-default-find-file-hook (backend)
867 nil)
869 (defun vc-find-file-hook ()
870 "Function for `find-file-hook' activating VC mode if appropriate."
871 ;; Recompute whether file is version controlled,
872 ;; if user has killed the buffer and revisited.
873 (when vc-mode
874 (setq vc-mode nil))
875 (when buffer-file-name
876 (vc-file-clearprops buffer-file-name)
877 (add-hook 'mode-line-hook 'vc-mode-line nil t)
878 (let (backend)
879 (cond
880 ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
881 ;; Compute the state and put it in the modeline.
882 (vc-mode-line buffer-file-name backend)
883 (unless vc-make-backup-files
884 ;; Use this variable, not make-backup-files,
885 ;; because this is for things that depend on the file name.
886 (set (make-local-variable 'backup-inhibited) t))
887 ;; Let the backend setup any buffer-local things he needs.
888 (vc-call-backend backend 'find-file-hook))
889 ((let ((link-type (and (not (equal buffer-file-name buffer-file-truename))
890 (vc-backend buffer-file-truename))))
891 (cond ((not link-type) nil) ;Nothing to do.
892 ((eq vc-follow-symlinks nil)
893 (message
894 "Warning: symbolic link to %s-controlled source file" link-type))
895 ((or (not (eq vc-follow-symlinks 'ask))
896 ;; If we already visited this file by following
897 ;; the link, don't ask again if we try to visit
898 ;; it again. GUD does that, and repeated questions
899 ;; are painful.
900 (get-file-buffer
901 (abbreviate-file-name
902 (file-chase-links buffer-file-name))))
904 (vc-follow-link)
905 (message "Followed link to %s" buffer-file-name)
906 (vc-find-file-hook))
908 (if (yes-or-no-p (format
909 "Symbolic link to %s-controlled source file; follow link? " link-type))
910 (progn (vc-follow-link)
911 (message "Followed link to %s" buffer-file-name)
912 (vc-find-file-hook))
913 (message
914 "Warning: editing through the link bypasses version control")
915 )))))))))
917 (add-hook 'find-file-hook 'vc-find-file-hook)
919 ;; more hooks, this time for file-not-found
920 (defun vc-file-not-found-hook ()
921 "When file is not found, try to check it out from version control.
922 Returns t if checkout was successful, nil otherwise.
923 Used in `find-file-not-found-functions'."
924 ;; When a file does not exist, ignore cached info about it
925 ;; from a previous visit.
926 ;; We check that `buffer-file-name' is non-nil. It should be always
927 ;; the case, but in conjunction with Tramp, it might be nil. M. Albinus.
928 (when buffer-file-name
929 (vc-file-clearprops buffer-file-name)
930 (let ((backend (vc-backend buffer-file-name)))
931 (when backend (vc-call-backend backend 'find-file-not-found-hook)))))
933 (defun vc-default-find-file-not-found-hook (backend)
934 ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only
935 ;; really makes sense for RCS. For other backends, better not do anything.
936 nil)
938 (add-hook 'find-file-not-found-functions 'vc-file-not-found-hook)
940 (defun vc-kill-buffer-hook ()
941 "Discard VC info about a file when we kill its buffer."
942 (when buffer-file-name (vc-file-clearprops buffer-file-name)))
944 (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
946 ;; Now arrange for (autoloaded) bindings of the main package.
947 ;; Bindings for this have to go in the global map, as we'll often
948 ;; want to call them from random buffers.
950 ;; Autoloading works fine, but it prevents shortcuts from appearing
951 ;; in the menu because they don't exist yet when the menu is built.
952 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
953 (defvar vc-prefix-map
954 (let ((map (make-sparse-keymap)))
955 (define-key map "a" 'vc-update-change-log)
956 (define-key map "b" 'vc-switch-backend)
957 (define-key map "c" 'vc-rollback)
958 (define-key map "d" 'vc-dir)
959 (define-key map "g" 'vc-annotate)
960 (define-key map "h" 'vc-insert-headers)
961 (define-key map "i" 'vc-register)
962 (define-key map "l" 'vc-print-log)
963 (define-key map "m" 'vc-merge)
964 (define-key map "r" 'vc-retrieve-tag)
965 (define-key map "s" 'vc-create-tag)
966 (define-key map "u" 'vc-revert)
967 (define-key map "v" 'vc-next-action)
968 (define-key map "+" 'vc-update)
969 (define-key map "=" 'vc-diff)
970 (define-key map "~" 'vc-revision-other-window)
971 map))
972 (fset 'vc-prefix-map vc-prefix-map)
973 (define-key global-map "\C-xv" 'vc-prefix-map)
975 (defvar vc-menu-map
976 (let ((map (make-sparse-keymap "Version Control")))
977 ;;(define-key map [show-files]
978 ;; '("Show Files under VC" . (vc-directory t)))
979 (define-key map [vc-retrieve-tag]
980 '(menu-item "Retrieve Tag" vc-retrieve-tag
981 :help "Retrieve tagged version or branch"))
982 (define-key map [vc-create-tag]
983 '(menu-item "Create Tag" vc-create-tag
984 :help "Create version tag"))
985 (define-key map [separator1] '("----"))
986 (define-key map [vc-annotate]
987 '(menu-item "Annotate" vc-annotate
988 :help "Display the edit history of the current file using colors"))
989 (define-key map [vc-rename-file]
990 '(menu-item "Rename File" vc-rename-file
991 :help "Rename file"))
992 (define-key map [vc-revision-other-window]
993 '(menu-item "Show Other Version" vc-revision-other-window
994 :help "Visit another version of the current file in another window"))
995 (define-key map [vc-diff]
996 '(menu-item "Compare with Base Version" vc-diff
997 :help "Compare file set with the base version"))
998 (define-key map [vc-update-change-log]
999 '(menu-item "Update ChangeLog" vc-update-change-log
1000 :help "Find change log file and add entries from recent version control logs"))
1001 (define-key map [vc-print-log]
1002 '(menu-item "Show History" vc-print-log
1003 :help "List the change log of the current file set in a window"))
1004 (define-key map [separator2] '("----"))
1005 (define-key map [vc-insert-header]
1006 '(menu-item "Insert Header" vc-insert-headers
1007 :help "Insert headers into a file for use with a version control system.
1009 (define-key map [undo]
1010 '(menu-item "Undo Last Check-In" vc-rollback
1011 :help "Remove the most recent changeset committed to the repository"))
1012 (define-key map [vc-revert]
1013 '(menu-item "Revert to Base Version" vc-revert
1014 :help "Revert working copies of the selected file set to their repository contents"))
1015 (define-key map [vc-update]
1016 '(menu-item "Update to Latest Version" vc-update
1017 :help "Update the current fileset's files to their tip revisions"))
1018 (define-key map [vc-next-action]
1019 '(menu-item "Check In/Out" vc-next-action
1020 :help "Do the next logical version control operation on the current fileset"))
1021 (define-key map [vc-register]
1022 '(menu-item "Register" vc-register
1023 :help "Register file set into a version control system"))
1024 (define-key map [vc-dir]
1025 '(menu-item "VC Dir" vc-dir
1026 :help "Show the VC status of files in a directory"))
1027 map))
1029 (defalias 'vc-menu-map vc-menu-map)
1031 (declare-function vc-responsible-backend "vc" (file &optional register))
1033 (defun vc-menu-map-filter (orig-binding)
1034 (if (and (symbolp orig-binding) (fboundp orig-binding))
1035 (setq orig-binding (indirect-function orig-binding)))
1036 (let ((ext-binding
1037 (when vc-mode
1038 (vc-call-backend
1039 (if buffer-file-name
1040 (vc-backend buffer-file-name)
1041 (vc-responsible-backend default-directory))
1042 'extra-menu))))
1043 ;; Give the VC backend a chance to add menu entries
1044 ;; specific for that backend.
1045 (if (null ext-binding)
1046 orig-binding
1047 (append orig-binding
1048 '((ext-menu-separator "---"))
1049 ext-binding))))
1051 (defun vc-default-extra-menu (backend)
1052 nil)
1054 (provide 'vc-hooks)
1056 ;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
1057 ;;; vc-hooks.el ends here