1 ;;; vc-hooks.el --- resident support for version-control
3 ;; Copyright (C) 1992-1996, 1998-2016 Free Software Foundation, Inc.
5 ;; Author: FSF (see vc.el for full credits)
6 ;; 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/>.
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.
33 (eval-when-compile (require 'cl-lib
))
37 (defgroup vc-state-faces nil
38 "Faces used in the mode line by the VC state indicator."
43 (defface vc-state-base
45 "Base face for VC state indicator."
50 (defface vc-up-to-date-state
51 '((default :inherit vc-state-base
))
52 "Face for VC modeline state when the file is up to date."
56 (defface vc-needs-update-state
57 '((default :inherit vc-state-base
))
58 "Face for VC modeline state when the file needs update."
62 (defface vc-locked-state
63 '((default :inherit vc-state-base
))
64 "Face for VC modeline state when the file locked."
68 (defface vc-locally-added-state
69 '((default :inherit vc-state-base
))
70 "Face for VC modeline state when the file is locally added."
74 (defface vc-conflict-state
75 '((default :inherit vc-state-base
))
76 "Face for VC modeline state when the file contains merge conflicts."
80 (defface vc-removed-state
81 '((default :inherit vc-state-base
))
82 "Face for VC modeline state when the file was removed from the VC system."
86 (defface vc-missing-state
87 '((default :inherit vc-state-base
))
88 "Face for VC modeline state when the file is missing from the file system."
92 (defface vc-edited-state
93 '((default :inherit vc-state-base
))
94 "Face for VC modeline state when the file is edited."
98 ;; Customization Variables (the rest is in vc.el)
100 (defcustom vc-ignore-dir-regexp
101 ;; Stop SMB, automounter, AFS, and DFS host lookups.
102 locate-dominating-stop-dir-regexp
103 "Regexp matching directory names that are not under VC's control.
104 The default regexp prevents fruitless and time-consuming attempts
105 to determine the VC status in directories in which filenames are
106 interpreted as hostnames."
110 (defcustom vc-handled-backends
'(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn
)
111 ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir
112 ;; rather than per-tree. RCS comes first because of the multibackend
113 ;; support intended to use RCS for local commits (with a remote CVS server).
114 "List of version control backends for which VC will be used.
115 Entries in this list will be tried in order to determine whether a
116 file is under that sort of version control.
117 Removing an entry from the list prevents VC from being activated
118 when visiting a file managed by that backend.
119 An empty list disables VC altogether."
120 :type
'(repeat symbol
)
124 ;; Note: we don't actually have a darcs back end yet.
125 ;; Also, Arch is unsupported, and the Meta-CVS back end has been removed.
126 ;; The Arch back end will be retrieved and fixed if it is ever required.
127 (defcustom vc-directory-exclusion-list
(purecopy '("SCCS" "RCS" "CVS" "MCVS"
128 ".src" ".svn" ".git" ".hg" ".bzr"
129 "_MTN" "_darcs" "{arch}"))
130 "List of directory names to be ignored when walking directory trees."
131 :type
'(repeat string
)
134 (defcustom vc-make-backup-files nil
135 "If non-nil, backups of registered files are made as with other files.
136 If nil (the default), files covered by version control don't get backups."
141 (defcustom vc-follow-symlinks
'ask
142 "What to do if visiting a symbolic link to a file under version control.
143 Editing such a file through the link bypasses the version control system,
144 which is dangerous and probably not what you want.
146 If this variable is t, VC follows the link and visits the real file,
147 telling you about it in the echo area. If it is `ask', VC asks for
148 confirmation whether it should follow the link. If nil, the link is
149 visited and a warning displayed."
150 :type
'(choice (const :tag
"Ask for confirmation" ask
)
151 (const :tag
"Visit link and warn" nil
)
152 (const :tag
"Follow link" t
))
155 (defcustom vc-display-status t
156 "If non-nil, display revision number and lock status in mode line.
157 Otherwise, not displayed."
162 (defcustom vc-consult-headers t
163 "If non-nil, identify work files by searching for version headers."
167 ;;; This is handled specially now.
168 ;; Tell Emacs about this new kind of minor mode
169 ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
172 (put 'vc-mode
'risky-local-variable t
)
173 (make-variable-buffer-local 'vc-mode
)
174 (put 'vc-mode
'permanent-local t
)
176 ;;; We signal this error when we try to do something a VC backend
177 ;;; doesn't support. Two arguments: the method that's not supported
179 (define-error 'vc-not-supported
"VC method not implemented for backend")
181 (defun vc-mode (&optional _arg
)
182 ;; Dummy function for C-h m
183 "Version Control minor mode.
184 This minor mode is automatically activated whenever you visit a file under
185 control of one of the revision control systems in `vc-handled-backends'.
186 VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
189 (defmacro vc-error-occurred
(&rest body
)
190 `(condition-case nil
(progn ,@body nil
) (error t
)))
192 ;; We need a notion of per-file properties because the version
193 ;; control state of a file is expensive to derive --- we compute
194 ;; them when the file is initially found, keep them up to date
195 ;; during any subsequent VC operations, and forget them when
196 ;; the buffer is killed.
198 (defvar vc-file-prop-obarray
(make-vector 17 0)
199 "Obarray for per-file properties.")
201 (defvar vc-touched-properties nil
)
203 (defun vc-file-setprop (file property value
)
204 "Set per-file VC PROPERTY for FILE to VALUE."
205 (if (and vc-touched-properties
206 (not (memq property vc-touched-properties
)))
207 (setq vc-touched-properties
(append (list property
)
208 vc-touched-properties
)))
209 (put (intern (expand-file-name file
) vc-file-prop-obarray
) property value
))
211 (defun vc-file-getprop (file property
)
212 "Get per-file VC PROPERTY for FILE."
213 (get (intern (expand-file-name file
) vc-file-prop-obarray
) property
))
215 (defun vc-file-clearprops (file)
216 "Clear all VC properties of FILE."
217 (if (boundp 'vc-parent-buffer
)
218 (kill-local-variable 'vc-parent-buffer
))
219 (setplist (intern (expand-file-name file
) vc-file-prop-obarray
) nil
))
222 ;; We keep properties on each symbol naming a backend as follows:
223 ;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
225 (defun vc-make-backend-sym (backend sym
)
226 "Return BACKEND-specific version of VC symbol SYM."
227 (intern (concat "vc-" (downcase (symbol-name backend
))
228 "-" (symbol-name sym
))))
230 (defun vc-find-backend-function (backend fun
)
231 "Return BACKEND-specific implementation of FUN.
232 If there is no such implementation, return the default implementation;
233 if that doesn't exist either, return nil."
234 (let ((f (vc-make-backend-sym backend fun
)))
236 ;; Load vc-BACKEND.el if needed.
237 (require (intern (concat "vc-" (downcase (symbol-name backend
)))))
239 (let ((def (vc-make-backend-sym 'default fun
)))
240 (if (fboundp def
) (cons def backend
) nil
))))))
242 (defun vc-call-backend (backend function-name
&rest args
)
243 "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
246 (apply \\='vc-BACKEND-FUN ARGS)
248 if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
251 (apply \\='vc-default-FUN BACKEND ARGS)
253 It is usually called via the `vc-call' macro."
254 (let ((f (assoc function-name
(get backend
'vc-functions
))))
255 (if f
(setq f
(cdr f
))
256 (setq f
(vc-find-backend-function backend function-name
))
257 (push (cons function-name f
) (get backend
'vc-functions
)))
260 (signal 'vc-not-supported
(list function-name backend
)))
261 ((consp f
) (apply (car f
) (cdr f
) args
))
262 (t (apply f args
)))))
264 (defmacro vc-call
(fun file
&rest args
)
265 "A convenience macro for calling VC backend functions.
266 Functions called by this macro must accept FILE as the first argument.
267 ARGS specifies any additional arguments. FUN should be unquoted.
268 BEWARE!! FILE is evaluated twice!!"
269 `(vc-call-backend (vc-backend ,file
) ',fun
,file
,@args
))
271 (defsubst vc-parse-buffer
(pattern i
)
272 "Find PATTERN in the current buffer and return its Ith submatch."
273 (goto-char (point-min))
274 (if (re-search-forward pattern nil t
)
277 (defun vc-insert-file (file &optional limit blocksize
)
278 "Insert the contents of FILE into the current buffer.
280 Optional argument LIMIT is a regexp. If present, the file is inserted
281 in chunks of size BLOCKSIZE (default 8 kByte), until the first
282 occurrence of LIMIT is found. Anything from the start of that occurrence
283 to the end of the buffer is then deleted. The function returns
284 non-nil if FILE exists and its contents were successfully inserted."
286 (when (file-exists-p file
)
288 (insert-file-contents file
)
289 (unless blocksize
(setq blocksize
8192))
292 (and (< 0 (cadr (insert-file-contents
293 file nil filepos
(cl-incf filepos blocksize
))))
294 (progn (beginning-of-line)
295 (let ((pos (re-search-forward limit nil
'move
)))
296 (when pos
(delete-region (match-beginning 0)
299 (set-buffer-modified-p nil
)
302 (defun vc-find-root (file witness
)
303 "Find the root of a checked out project.
304 The function walks up the directory tree from FILE looking for WITNESS.
305 If WITNESS if not found, return nil, otherwise return the root."
306 (let ((locate-dominating-stop-dir-regexp
307 (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp
)))
308 (locate-dominating-file file witness
)))
310 ;; Access functions to file properties
311 ;; (Properties should be _set_ using vc-file-setprop, but
312 ;; _retrieved_ only through these functions, which decide
313 ;; if the property is already known or not. A property should
314 ;; only be retrieved by vc-file-getprop if there is no
317 ;; properties indicating the backend being used for FILE
319 (defun vc-registered (file)
320 "Return non-nil if FILE is registered in a version control system.
322 This function performs the check each time it is called. To rely
323 on the result of a previous call, use `vc-backend' instead. If the
324 file was previously registered under a certain backend, then that
325 backend is tried first."
328 ((and (file-name-directory file
)
329 (string-match vc-ignore-dir-regexp
(file-name-directory file
)))
331 ((and (boundp 'file-name-handler-alist
)
332 (setq handler
(find-file-name-handler file
'vc-registered
)))
333 ;; handler should set vc-backend and return t if registered
334 (funcall handler
'vc-registered file
))
336 ;; There is no file name handler.
337 ;; Try vc-BACKEND-registered for each handled BACKEND.
339 (let ((backend (vc-file-getprop file
'vc-backend
)))
342 (and (vc-call-backend b
'registered file
)
343 (vc-file-setprop file
'vc-backend b
)
345 (if (or (not backend
) (eq backend
'none
))
347 (cons backend vc-handled-backends
))))
348 ;; File is not registered.
349 (vc-file-setprop file
'vc-backend
'none
)
352 (defun vc-backend (file-or-list)
353 "Return the version control type of FILE-OR-LIST, nil if it's not registered.
354 If the argument is a list, the files must all have the same back end."
355 ;; `file' can be nil in several places (typically due to the use of
356 ;; code like (vc-backend buffer-file-name)).
357 (cond ((stringp file-or-list
)
358 (let ((property (vc-file-getprop file-or-list
'vc-backend
)))
359 ;; Note that internally, Emacs remembers unregistered
360 ;; files by setting the property to `none'.
361 (cond ((eq property
'none
) nil
)
363 ;; vc-registered sets the vc-backend property
364 (t (if (vc-registered file-or-list
)
365 (vc-file-getprop file-or-list
'vc-backend
)
367 ((and file-or-list
(listp file-or-list
))
368 (vc-backend (car file-or-list
)))
373 (defun vc-backend-subdirectory-name (file)
374 "Return where the repository for the current directory is kept."
375 (symbol-name (vc-backend file
)))
377 (defun vc-checkout-model (backend files
)
378 "Indicate how FILES are checked out.
380 If FILES are not registered, this function always returns nil.
381 For registered files, the possible values are:
383 `implicit' FILES are always writable, and checked out `implicitly'
384 when the user saves the first changes to the file.
386 `locking' FILES are read-only if up-to-date; user must type
387 \\[vc-next-action] before editing. Strict locking
390 `announce' FILES are read-only if up-to-date; user must type
391 \\[vc-next-action] before editing. But other users
392 may be editing at the same time."
393 (vc-call-backend backend
'checkout-model files
))
395 (defun vc-user-login-name (file)
396 "Return the name under which the user accesses the given FILE."
397 (or (and (eq (string-match tramp-file-name-regexp file
) 0)
398 ;; tramp case: execute "whoami" via tramp
399 (let ((default-directory (file-name-directory file
))
400 process-file-side-effects
)
402 (if (not (zerop (process-file "whoami" nil t
)))
403 ;; fall through if "whoami" didn't work
405 ;; remove trailing newline
406 (delete-region (1- (point-max)) (point-max))
410 ;; if user-login-name is nil, return the UID as a string
411 (number-to-string (user-uid))))
413 (defun vc-state (file &optional backend
)
414 "Return the version control state of FILE.
416 A return of nil from this function means we have no information on the
417 status of this file. Otherwise, the value returned is one of:
419 `up-to-date' The working file is unmodified with respect to the
420 latest version on the current branch, and not locked.
422 `edited' The working file has been edited by the user. If
423 locking is used for the file, this state means that
424 the current version is locked by the calling user.
425 This status should *not* be reported for files
426 which have a changed mtime but the same content
429 USER The current version of the working file is locked by
430 some other USER (a string).
432 `needs-update' The file has not been edited by the user, but there is
433 a more recent version on the current branch stored
436 `needs-merge' The file has been edited by the user, and there is also
437 a more recent version on the current branch stored in
438 the repository. This state can only occur if locking
439 is not used for the file.
441 `unlocked-changes' The working version of the file is not locked,
442 but the working file has been changed with respect
443 to that version. This state can only occur for files
444 with locking; it represents an erroneous condition that
445 should be resolved by the user (vc-next-action will
446 prompt the user to do it).
448 `added' Scheduled to go into the repository on the next commit.
449 Often represented by vc-working-revision = \"0\" in VCSes
450 with monotonic IDs like Subversion and Mercurial.
452 `removed' Scheduled to be deleted from the repository on next commit.
454 `conflict' The file contains conflicts as the result of a merge.
455 For now the conflicts are text conflicts. In the
456 future this might be extended to deal with metadata
459 `missing' The file is not present in the file system, but the VC
460 system still tracks it.
462 `ignored' The file showed up in a dir-status listing with a flag
463 indicating the version-control system is ignoring it,
464 Note: This property is not set reliably (some VCSes
465 don't have useful directory-status commands) so assume
466 that any file with vc-state nil might be ignorable
467 without VC knowing it.
469 `unregistered' The file is not under version control."
471 ;; Note: in Emacs 22 and older, return of nil meant the file was
472 ;; unregistered. This is potentially a source of
473 ;; backward-compatibility bugs.
475 ;; FIXME: New (sub)states needed (?):
476 ;; - `copied' and `moved' (might be handled by `removed' and `added')
477 (or (vc-file-getprop file
'vc-state
)
478 (and (not (vc-registered file
)) 'unregistered
)
479 (when (> (length file
) 0) ;Why?? --Stef
480 (setq backend
(or backend
(vc-responsible-backend file
)))
482 (vc-state-refresh file backend
)))))
484 (defun vc-state-refresh (file backend
)
485 "Quickly recompute the `state' of FILE."
488 (vc-call-backend backend
'state file
)))
490 (defsubst vc-up-to-date-p
(file)
491 "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
492 (eq (vc-state file
) 'up-to-date
))
494 (defun vc-working-revision (file &optional backend
)
495 "Return the repository version from which FILE was checked out.
496 If FILE is not registered, this function always returns nil."
497 (or (vc-file-getprop file
'vc-working-revision
)
498 (and (vc-registered file
)
500 (setq backend
(or backend
(vc-responsible-backend file
)))
502 (vc-file-setprop file
'vc-working-revision
504 backend
'working-revision file
)))))))
506 ;; Backward compatibility.
507 (define-obsolete-function-alias
508 'vc-workfile-version
'vc-working-revision
"23.1")
509 (defun vc-default-working-revision (backend file
)
511 "`working-revision' not found: using the old `workfile-version' instead")
512 (vc-call-backend backend
'workfile-version file
))
514 (defun vc-default-registered (backend file
)
515 "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
516 (let ((sym (vc-make-backend-sym backend
'master-templates
)))
517 (unless (get backend
'vc-templates-grabbed
)
518 (put backend
'vc-templates-grabbed t
))
519 (let ((result (vc-check-master-templates file
(symbol-value sym
))))
521 (vc-file-setprop file
'vc-master-name result
)
522 nil
)))) ; Not registered
525 (defun vc-possible-master (s dirname basename
)
527 ((stringp s
) (format s dirname basename
))
529 ;; The template is a function to invoke. If the
530 ;; function returns non-nil, that means it has found a
531 ;; master. For backward compatibility, we also handle
532 ;; the case that the function throws a 'found atom
533 ;; and a pair (cons MASTER-FILE BACKEND).
534 (let ((result (catch 'found
(funcall s dirname basename
))))
535 (if (consp result
) (car result
) result
)))))
537 (defun vc-check-master-templates (file templates
)
538 "Return non-nil if there is a master corresponding to FILE.
540 TEMPLATES is a list of strings or functions. If an element is a
541 string, it must be a control string as required by `format', with two
542 string placeholders, such as \"%sRCS/%s,v\". The directory part of
543 FILE is substituted for the first placeholder, the basename of FILE
544 for the second. If a file with the resulting name exists, it is taken
545 as the master of FILE, and returned.
547 If an element of TEMPLATES is a function, it is called with the
548 directory part and the basename of FILE as arguments. It should
549 return non-nil if it finds a master; that value is then returned by
551 (let ((dirname (or (file-name-directory file
) ""))
552 (basename (file-name-nondirectory file
)))
556 (let ((trial (vc-possible-master s dirname basename
)))
557 (when (and trial
(file-exists-p trial
)
558 ;; Make sure the file we found with name
559 ;; TRIAL is not the source file itself.
560 ;; That can happen with RCS-style names if
561 ;; the file name is truncated (e.g. to 14
562 ;; chars). See if either directory or
563 ;; attributes differ.
564 (or (not (string= dirname
565 (file-name-directory trial
)))
566 (not (equal (file-attributes file
)
567 (file-attributes trial
)))))
568 (throw 'found trial
))))
572 ;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made
573 ;; obsolete earlier, it is ok for the latter to be an alias to the former,
574 ;; since the latter will be removed first. We can't just make it
575 ;; an alias for read-only-mode, since that is not 100% the same.
576 (defalias 'vc-toggle-read-only
'toggle-read-only
)
577 (make-obsolete 'vc-toggle-read-only
578 "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)."
581 (defun vc-default-make-version-backups-p (_backend _file
)
582 "Return non-nil if unmodified versions should be backed up locally.
583 The default is to switch off this feature."
586 (defun vc-version-backup-file-name (file &optional rev manual regexp
)
587 "Return a backup file name for REV or the current version of FILE.
588 If MANUAL is non-nil it means that a name for backups created by
589 the user should be returned; if REGEXP is non-nil that means to return
590 a regexp for matching all such backup files, regardless of the version."
592 (concat (regexp-quote (file-name-nondirectory file
))
593 "\\.~.+" (unless manual
"\\.") "~")
594 (expand-file-name (concat (file-name-nondirectory file
)
595 ".~" (subst-char-in-string
596 ?
/ ?_
(or rev
(vc-working-revision file
)))
597 (unless manual
".") "~")
598 (file-name-directory file
))))
600 (defun vc-delete-automatic-version-backups (file)
601 "Delete all existing automatic version backups for FILE."
605 (directory-files (or (file-name-directory file
) default-directory
) t
606 (vc-version-backup-file-name file nil nil t
)))
607 ;; Don't fail when the directory doesn't exist.
610 (defun vc-make-version-backup (file)
611 "Make a backup copy of FILE, which is assumed in sync with the repository.
612 Before doing that, check if there are any old backups and get rid of them."
613 (unless (and (fboundp 'msdos-long-file-names
)
614 (not (with-no-warnings (msdos-long-file-names))))
615 (vc-delete-automatic-version-backups file
)
617 (copy-file file
(vc-version-backup-file-name file
)
619 ;; It's ok if it doesn't work (e.g. directory not writable),
620 ;; since this is just for efficiency.
623 (concat "Warning: Cannot make version backup; "
624 "diff/revert therefore not local"))))))
626 (defun vc-before-save ()
627 "Function to be called by `basic-save-buffer' (in files.el)."
628 ;; If the file on disk is still in sync with the repository,
629 ;; and version backups should be made, copy the file to
630 ;; another name. This enables local diffs and local reverting.
631 (let ((file buffer-file-name
)
633 (ignore-errors ;Be careful not to prevent saving the file.
634 (unless (file-exists-p file
)
635 (vc-file-clearprops file
))
636 (and (setq backend
(vc-backend file
))
637 (vc-up-to-date-p file
)
638 (eq (vc-checkout-model backend
(list file
)) 'implicit
)
639 (vc-call-backend backend
'make-version-backups-p file
)
640 (vc-make-version-backup file
)))))
642 (declare-function vc-dir-resynch-file
"vc-dir" (&optional fname
))
644 (defvar vc-dir-buffers nil
"List of vc-dir buffers.")
646 (defun vc-after-save ()
647 "Function to be called by `basic-save-buffer' (in files.el)."
648 ;; If the file in the current buffer is under version control,
649 ;; up-to-date, and locking is not used for the file, set
650 ;; the state to 'edited and redisplay the mode line.
651 (let* ((file buffer-file-name
)
652 (backend (vc-backend file
)))
655 ((eq (vc-checkout-model backend
(list file
)) 'implicit
)
656 ;; If the file was saved in the same second in which it was
657 ;; checked out, clear the checkout-time to avoid confusion.
658 (if (equal (vc-file-getprop file
'vc-checkout-time
)
659 (nth 5 (file-attributes file
)))
660 (vc-file-setprop file
'vc-checkout-time nil
))
661 (if (vc-state-refresh file backend
)
662 (vc-mode-line file backend
)))
663 ;; If we saved an unlocked file on a locking based VCS, that
664 ;; file is not longer up-to-date.
665 ((eq (vc-file-getprop file
'vc-state
) 'up-to-date
)
666 (vc-file-setprop file
'vc-state nil
)))
667 ;; Resynch *vc-dir* buffers, if any are present.
669 (vc-dir-resynch-file file
))))
671 (defvar vc-menu-entry
672 `(menu-item ,(purecopy "Version Control") vc-menu-map
673 :filter vc-menu-map-filter
))
675 (when (boundp 'menu-bar-tools-menu
)
676 ;; We do not need to worry here about the placement of this entry
677 ;; because menu-bar.el has already created the proper spot for us
678 ;; and this will simply use it.
679 (define-key menu-bar-tools-menu
[vc] vc-menu-entry))
681 (defconst vc-mode-line-map
682 (let ((map (make-sparse-keymap)))
683 (define-key map [mode-line down-mouse-1] vc-menu-entry)
686 (defun vc-mode-line (file &optional backend)
687 "Set `vc-mode' to display type of version control for FILE.
688 The value is set in the current buffer, which should be the buffer
690 If BACKEND is passed use it as the VC backend when computing the result."
691 (interactive (list buffer-file-name))
692 (setq backend (or backend (vc-backend file)))
695 (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
696 (ml-echo (get-text-property 0 'help-echo ml-string)))
700 (if (null vc-display-status)
701 (symbol-name backend)
704 'mouse-face 'mode-line-highlight
707 (format "File under the %s version control system"
709 "\nmouse-1: Version Control menu")
710 'local-map vc-mode-line-map)))))
711 ;; If the user is root, and the file is not owner-writable,
712 ;; then pretend that we can't write it
713 ;; even though we can (because root can write anything).
714 ;; This way, even root cannot modify a file that isn't locked.
715 (and (equal file buffer-file-name)
716 (not buffer-read-only)
717 (zerop (user-real-uid))
718 (zerop (logand (file-modes buffer-file-name) 128))
719 (setq buffer-read-only t)))
720 (force-mode-line-update)
723 (defun vc-default-mode-line-string (backend file)
724 "Return a string for `vc-mode-line' to put in the mode line for FILE.
727 \"BACKEND-REV\" if the file is up-to-date
728 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
729 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
730 \"BACKEND@REV\" if the file was locally added
731 \"BACKEND!REV\" if the file contains conflicts or was removed
732 \"BACKEND?REV\" if the file is under VC, but is missing
734 This function assumes that the file is registered."
735 (let* ((backend-name (symbol-name backend))
736 (state (vc-state file backend))
739 (rev (vc-working-revision file backend)))
741 (cond ((or (eq state 'up-to-date)
742 (eq state 'needs-update))
743 (setq state-echo "Up to date file")
744 (setq face 'vc-up-to-date-state)
745 (concat backend-name "-" rev))
747 (setq state-echo (concat "File locked by" state))
748 (setq face 'vc-locked-state)
749 (concat backend-name ":" state ":" rev))
751 (setq state-echo "Locally added file")
752 (setq face 'vc-locally-added-state)
753 (concat backend-name "@" rev))
754 ((eq state 'conflict)
755 (setq state-echo "File contains conflicts after the last merge")
756 (setq face 'vc-conflict-state)
757 (concat backend-name "!" rev))
759 (setq state-echo "File removed from the VC system")
760 (setq face 'vc-removed-state)
761 (concat backend-name "!" rev))
763 (setq state-echo "File tracked by the VC system, but missing from the file system")
764 (setq face 'vc-missing-state)
765 (concat backend-name "?" rev))
767 ;; Not just for the 'edited state, but also a fallback
768 ;; for all other states. Think about different symbols
769 ;; for 'needs-update and 'needs-merge.
770 (setq state-echo "Locally modified file")
771 (setq face 'vc-edited-state)
772 (concat backend-name ":" rev)))
774 'help-echo (concat state-echo " under the " backend-name
775 " version control system"))))
777 (defun vc-follow-link ()
778 "If current buffer visits a symbolic link, visit the real file.
779 If the real file is already visited in another buffer, make that buffer
780 current, and kill the buffer that visits the link."
781 (let* ((true-buffer (find-buffer-visiting buffer-file-truename))
782 (this-buffer (current-buffer)))
783 (if (eq true-buffer this-buffer)
784 (let ((truename buffer-file-truename))
785 (kill-buffer this-buffer)
786 ;; In principle, we could do something like set-visited-file-name.
787 ;; However, it can't be exactly the same as set-visited-file-name.
788 ;; I'm not going to work out the details right now. -- rms.
789 (set-buffer (find-file-noselect truename)))
790 (set-buffer true-buffer)
791 (kill-buffer this-buffer))))
793 (defun vc-default-find-file-hook (_backend)
796 (defun vc-refresh-state ()
797 "Refresh the VC state of the current buffer's file.
799 This command is more thorough than `vc-state-refresh', in that it
800 also supports switching a back-end or removing the file from VC.
801 In the latter case, VC mode is deactivated for this buffer."
803 ;; Recompute whether file is version controlled,
804 ;; if user has killed the buffer and revisited.
807 (when buffer-file-name
808 (vc-file-clearprops buffer-file-name)
809 ;; FIXME: Why use a hook? Why pass it buffer-file-name?
810 (add-hook 'vc-mode-line-hook 'vc-mode-line nil t)
813 ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
814 ;; Let the backend setup any buffer-local things he needs.
815 (vc-call-backend backend 'find-file-hook)
816 ;; Compute the state and put it in the mode line.
817 (vc-mode-line buffer-file-name backend)
818 (unless vc-make-backup-files
819 ;; Use this variable, not make-backup-files,
820 ;; because this is for things that depend on the file name.
821 (set (make-local-variable 'backup-inhibited) t)))
822 ((let* ((truename (and buffer-file-truename
823 (expand-file-name buffer-file-truename)))
824 (link-type (and truename
825 (not (equal buffer-file-name truename))
826 (vc-backend truename))))
827 (cond ((not link-type) nil) ;Nothing to do.
828 ((eq vc-follow-symlinks nil)
830 "Warning: symbolic link to %s-controlled source file" link-type))
831 ((or (not (eq vc-follow-symlinks 'ask))
832 ;; Assume we cannot ask, default to yes.
834 ;; Copied from server-start. Seems like there should
835 ;; be a better way to ask "can we get user input?"...
837 (null (cdr (frame-list)))
838 (eq (selected-frame) terminal-frame))
839 ;; If we already visited this file by following
840 ;; the link, don't ask again if we try to visit
841 ;; it again. GUD does that, and repeated questions
844 (abbreviate-file-name
845 (file-chase-links buffer-file-name))))
848 (message "Followed link to %s" buffer-file-name)
851 (if (yes-or-no-p (format
852 "Symbolic link to %s-controlled source file; follow link? " link-type))
853 (progn (vc-follow-link)
854 (message "Followed link to %s" buffer-file-name)
857 "Warning: editing through the link bypasses version control")
860 (add-hook 'find-file-hook #'vc-refresh-state)
861 (define-obsolete-function-alias 'vc-find-file-hook 'vc-refresh-state "25.1")
863 (defun vc-kill-buffer-hook ()
864 "Discard VC info about a file when we kill its buffer."
865 (when buffer-file-name (vc-file-clearprops buffer-file-name)))
867 (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
869 ;; Now arrange for (autoloaded) bindings of the main package.
870 ;; Bindings for this have to go in the global map, as we'll often
871 ;; want to call them from random buffers.
873 ;; Autoloading works fine, but it prevents shortcuts from appearing
874 ;; in the menu because they don't exist yet when the menu is built.
875 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
876 (defvar vc-prefix-map
877 (let ((map (make-sparse-keymap)))
878 (define-key map "a" 'vc-update-change-log)
879 (define-key map "b" 'vc-switch-backend)
880 (define-key map "d" 'vc-dir)
881 (define-key map "g" 'vc-annotate)
882 (define-key map "G" 'vc-ignore)
883 (define-key map "h" 'vc-insert-headers)
884 (define-key map "i" 'vc-register)
885 (define-key map "l" 'vc-print-log)
886 (define-key map "L" 'vc-print-root-log)
887 (define-key map "I" 'vc-log-incoming)
888 (define-key map "O" 'vc-log-outgoing)
889 (define-key map "m" 'vc-merge)
890 (define-key map "r" 'vc-retrieve-tag)
891 (define-key map "s" 'vc-create-tag)
892 (define-key map "u" 'vc-revert)
893 (define-key map "v" 'vc-next-action)
894 (define-key map "+" 'vc-update)
895 ;; I'd prefer some kind of symmetry with vc-update:
896 (define-key map "P" 'vc-push)
897 (define-key map "=" 'vc-diff)
898 (define-key map "D" 'vc-root-diff)
899 (define-key map "~" 'vc-revision-other-window)
900 (define-key map "x" 'vc-delete-file)
902 (fset 'vc-prefix-map vc-prefix-map)
903 (define-key ctl-x-map "v" 'vc-prefix-map)
906 (let ((map (make-sparse-keymap "Version Control")))
907 ;;(define-key map [show-files]
908 ;; '("Show Files under VC" . (vc-directory t)))
909 (bindings--define-key map [vc-retrieve-tag]
910 '(menu-item "Retrieve Tag" vc-retrieve-tag
911 :help "Retrieve tagged version or branch"))
912 (bindings--define-key map [vc-create-tag]
913 '(menu-item "Create Tag" vc-create-tag
914 :help "Create version tag"))
915 (bindings--define-key map [separator1] menu-bar-separator)
916 (bindings--define-key map [vc-annotate]
917 '(menu-item "Annotate" vc-annotate
918 :help "Display the edit history of the current file using colors"))
919 (bindings--define-key map [vc-rename-file]
920 '(menu-item "Rename File" vc-rename-file
921 :help "Rename file"))
922 (bindings--define-key map [vc-revision-other-window]
923 '(menu-item "Show Other Version" vc-revision-other-window
924 :help "Visit another version of the current file in another window"))
925 (bindings--define-key map [vc-diff]
926 '(menu-item "Compare with Base Version" vc-diff
927 :help "Compare file set with the base version"))
928 (bindings--define-key map [vc-root-diff]
929 '(menu-item "Compare Tree with Base Version" vc-root-diff
930 :help "Compare current tree with the base version"))
931 (bindings--define-key map [vc-update-change-log]
932 '(menu-item "Update ChangeLog" vc-update-change-log
933 :help "Find change log file and add entries from recent version control logs"))
934 (bindings--define-key map [vc-log-out]
935 '(menu-item "Show Outgoing Log" vc-log-outgoing
936 :help "Show a log of changes that will be sent with a push operation"))
937 (bindings--define-key map [vc-log-in]
938 '(menu-item "Show Incoming Log" vc-log-incoming
939 :help "Show a log of changes that will be received with a pull operation"))
940 (bindings--define-key map [vc-print-log]
941 '(menu-item "Show History" vc-print-log
942 :help "List the change log of the current file set in a window"))
943 (bindings--define-key map [vc-print-root-log]
944 '(menu-item "Show Top of the Tree History " vc-print-root-log
945 :help "List the change log for the current tree in a window"))
946 (bindings--define-key map [separator2] menu-bar-separator)
947 (bindings--define-key map [vc-insert-header]
948 '(menu-item "Insert Header" vc-insert-headers
949 :help "Insert headers into a file for use with a version control system.
951 (bindings--define-key map [vc-revert]
952 '(menu-item "Revert to Base Version" vc-revert
953 :help "Revert working copies of the selected file set to their repository contents"))
954 ;; TODO Only :enable if (vc-find-backend-function backend 'push)
955 (bindings--define-key map [vc-push]
956 '(menu-item "Push Changes" vc-push
957 :help "Push the current branch's changes"))
958 (bindings--define-key map [vc-update]
959 '(menu-item "Update to Latest Version" vc-update
960 :help "Update the current fileset's files to their tip revisions"))
961 (bindings--define-key map [vc-next-action]
962 '(menu-item "Check In/Out" vc-next-action
963 :help "Do the next logical version control operation on the current fileset"))
964 (bindings--define-key map [vc-register]
965 '(menu-item "Register" vc-register
966 :help "Register file set into a version control system"))
967 (bindings--define-key map [vc-ignore]
968 '(menu-item "Ignore File..." vc-ignore
969 :help "Ignore a file under current version control system"))
970 (bindings--define-key map [vc-dir]
971 '(menu-item "VC Dir" vc-dir
972 :help "Show the VC status of files in a directory"))
975 (defalias 'vc-menu-map vc-menu-map)
977 (declare-function vc-responsible-backend "vc" (file))
979 (defun vc-menu-map-filter (orig-binding)
980 (if (and (symbolp orig-binding) (fboundp orig-binding))
981 (setq orig-binding (indirect-function orig-binding)))
986 (vc-backend buffer-file-name)
987 (vc-responsible-backend default-directory))
989 ;; Give the VC backend a chance to add menu entries
990 ;; specific for that backend.
991 (if (null ext-binding)
994 '((ext-menu-separator "--"))
997 (defun vc-default-extra-menu (_backend)
1002 ;;; vc-hooks.el ends here