Line data Source code
1 : ;;; vc-hooks.el --- resident support for version-control
2 :
3 : ;; Copyright (C) 1992-1996, 1998-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: FSF (see vc.el for full credits)
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Package: vc
8 :
9 : ;; This file is part of GNU Emacs.
10 :
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.
15 :
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.
20 :
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/>.
23 :
24 : ;;; Commentary:
25 :
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.
30 :
31 : ;;; Code:
32 :
33 : (eval-when-compile (require 'cl-lib))
34 :
35 : ;; Faces
36 :
37 : (defgroup vc-state-faces nil
38 : "Faces used in the mode line by the VC state indicator."
39 : :group 'vc-faces
40 : :group 'mode-line
41 : :version "25.1")
42 :
43 : (defface vc-state-base
44 : '((default))
45 : "Base face for VC state indicator."
46 : :group 'vc-faces
47 : :group 'mode-line
48 : :version "25.1")
49 :
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."
53 : :version "25.1"
54 : :group 'vc-faces)
55 :
56 : (defface vc-needs-update-state
57 : '((default :inherit vc-state-base))
58 : "Face for VC modeline state when the file needs update."
59 : :version "25.1"
60 : :group 'vc-faces)
61 :
62 : (defface vc-locked-state
63 : '((default :inherit vc-state-base))
64 : "Face for VC modeline state when the file locked."
65 : :version "25.1"
66 : :group 'vc-faces)
67 :
68 : (defface vc-locally-added-state
69 : '((default :inherit vc-state-base))
70 : "Face for VC modeline state when the file is locally added."
71 : :version "25.1"
72 : :group 'vc-faces)
73 :
74 : (defface vc-conflict-state
75 : '((default :inherit vc-state-base))
76 : "Face for VC modeline state when the file contains merge conflicts."
77 : :version "25.1"
78 : :group 'vc-faces)
79 :
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."
83 : :version "25.1"
84 : :group 'vc-faces)
85 :
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."
89 : :version "25.1"
90 : :group 'vc-faces)
91 :
92 : (defface vc-edited-state
93 : '((default :inherit vc-state-base))
94 : "Face for VC modeline state when the file is edited."
95 : :version "25.1"
96 : :group 'vc-faces)
97 :
98 : ;; Customization Variables (the rest is in vc.el)
99 :
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."
107 : :type 'regexp
108 : :group 'vc)
109 :
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)
121 : :version "25.1"
122 : :group 'vc)
123 :
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)
132 : :group 'vc)
133 :
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."
137 : :type 'boolean
138 : :group 'vc
139 : :group 'backup)
140 :
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.
145 :
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))
153 : :group 'vc)
154 :
155 : (defcustom vc-display-status t
156 : "If non-nil, display revision number and lock status in mode line.
157 : Otherwise, not displayed."
158 : :type 'boolean
159 : :group 'vc)
160 :
161 :
162 : (defcustom vc-consult-headers t
163 : "If non-nil, identify work files by searching for version headers."
164 : :type 'boolean
165 : :group 'vc)
166 :
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))
170 :
171 : ;;;###autoload
172 : (put 'vc-mode 'risky-local-variable t)
173 : (make-variable-buffer-local 'vc-mode)
174 : (put 'vc-mode 'permanent-local t)
175 :
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
178 : ;;; and the backend
179 : (define-error 'vc-not-supported "VC method not implemented for backend")
180 :
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]':
187 : \\{vc-prefix-map}")
188 :
189 : (defmacro vc-error-occurred (&rest body)
190 0 : `(condition-case nil (progn ,@body nil) (error t)))
191 :
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.
197 :
198 : (defvar vc-file-prop-obarray (make-vector 17 0)
199 : "Obarray for per-file properties.")
200 :
201 : (defvar vc-touched-properties nil)
202 :
203 : (defun vc-file-setprop (file property value)
204 : "Set per-file VC PROPERTY for FILE to VALUE."
205 268 : (if (and vc-touched-properties
206 268 : (not (memq property vc-touched-properties)))
207 0 : (setq vc-touched-properties (append (list property)
208 268 : vc-touched-properties)))
209 268 : (put (intern (expand-file-name file) vc-file-prop-obarray) property value))
210 :
211 : (defun vc-file-getprop (file property)
212 : "Get per-file VC PROPERTY for FILE."
213 444 : (get (intern (expand-file-name file) vc-file-prop-obarray) property))
214 :
215 : (defun vc-file-clearprops (file)
216 : "Clear all VC properties of FILE."
217 55 : (if (boundp 'vc-parent-buffer)
218 55 : (kill-local-variable 'vc-parent-buffer))
219 55 : (setplist (intern (expand-file-name file) vc-file-prop-obarray) nil))
220 :
221 :
222 : ;; We keep properties on each symbol naming a backend as follows:
223 : ;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
224 :
225 : (defun vc-make-backend-sym (backend sym)
226 : "Return BACKEND-specific version of VC symbol SYM."
227 206 : (intern (concat "vc-" (downcase (symbol-name backend))
228 206 : "-" (symbol-name sym))))
229 :
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 2 : (let ((f (vc-make-backend-sym backend fun)))
235 2 : (if (fboundp f) f
236 : ;; Load vc-BACKEND.el if needed.
237 0 : (require (intern (concat "vc-" (downcase (symbol-name backend)))))
238 0 : (if (fboundp f) f
239 0 : (let ((def (vc-make-backend-sym 'default fun)))
240 2 : (if (fboundp def) (cons def backend) nil))))))
241 :
242 : (defun vc-call-backend (backend function-name &rest args)
243 : "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
244 : Calls
245 :
246 : (apply \\='vc-BACKEND-FUN ARGS)
247 :
248 : if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
249 : and else calls
250 :
251 : (apply \\='vc-default-FUN BACKEND ARGS)
252 :
253 : It is usually called via the `vc-call' macro."
254 700 : (let ((f (assoc function-name (get backend 'vc-functions))))
255 700 : (if f (setq f (cdr f))
256 2 : (setq f (vc-find-backend-function backend function-name))
257 700 : (push (cons function-name f) (get backend 'vc-functions)))
258 700 : (cond
259 700 : ((null f)
260 0 : (signal 'vc-not-supported (list function-name backend)))
261 700 : ((consp f) (apply (car f) (cdr f) args))
262 700 : (t (apply f args)))))
263 :
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 0 : `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
270 :
271 : (defsubst vc-parse-buffer (pattern i)
272 : "Find PATTERN in the current buffer and return its Ith submatch."
273 0 : (goto-char (point-min))
274 0 : (if (re-search-forward pattern nil t)
275 0 : (match-string i)))
276 :
277 : (defun vc-insert-file (file &optional limit blocksize)
278 : "Insert the contents of FILE into the current buffer.
279 :
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."
285 0 : (erase-buffer)
286 0 : (when (file-exists-p file)
287 0 : (if (not limit)
288 0 : (insert-file-contents file)
289 0 : (unless blocksize (setq blocksize 8192))
290 0 : (let ((filepos 0))
291 0 : (while
292 0 : (and (< 0 (cadr (insert-file-contents
293 0 : file nil filepos (cl-incf filepos blocksize))))
294 0 : (progn (beginning-of-line)
295 0 : (let ((pos (re-search-forward limit nil 'move)))
296 0 : (when pos (delete-region (match-beginning 0)
297 0 : (point-max)))
298 0 : (not pos)))))))
299 0 : (set-buffer-modified-p nil)
300 0 : t))
301 :
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 252 : (let ((locate-dominating-stop-dir-regexp
307 252 : (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)))
308 252 : (locate-dominating-file file witness)))
309 :
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
315 : ;; access function.)
316 :
317 : ;; properties indicating the backend being used for FILE
318 :
319 : (defun vc-registered (file)
320 : "Return non-nil if FILE is registered in a version control system.
321 :
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."
326 68 : (let (handler)
327 68 : (cond
328 68 : ((and (file-name-directory file)
329 68 : (string-match vc-ignore-dir-regexp (file-name-directory file)))
330 : nil)
331 68 : ((and (boundp 'file-name-handler-alist)
332 68 : (setq handler (find-file-name-handler file 'vc-registered)))
333 : ;; handler should set vc-backend and return t if registered
334 0 : (funcall handler 'vc-registered file))
335 : (t
336 : ;; There is no file name handler.
337 : ;; Try vc-BACKEND-registered for each handled BACKEND.
338 68 : (catch 'found
339 68 : (let ((backend (vc-file-getprop file 'vc-backend)))
340 68 : (mapc
341 : (lambda (b)
342 524 : (and (vc-call-backend b 'registered file)
343 44 : (vc-file-setprop file 'vc-backend b)
344 480 : (throw 'found t)))
345 68 : (if (or (not backend) (eq backend 'none))
346 68 : vc-handled-backends
347 68 : (cons backend vc-handled-backends))))
348 : ;; File is not registered.
349 24 : (vc-file-setprop file 'vc-backend 'none)
350 68 : nil)))))
351 :
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 51 : (cond ((stringp file-or-list)
358 51 : (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 51 : (cond ((eq property 'none) nil)
362 51 : (property)
363 : ;; vc-registered sets the vc-backend property
364 51 : (t (if (vc-registered file-or-list)
365 44 : (vc-file-getprop file-or-list 'vc-backend)
366 51 : nil)))))
367 0 : ((and file-or-list (listp file-or-list))
368 0 : (vc-backend (car file-or-list)))
369 : (t
370 51 : nil)))
371 :
372 :
373 : (defun vc-backend-subdirectory-name (file)
374 : "Return where the repository for the current directory is kept."
375 0 : (symbol-name (vc-backend file)))
376 :
377 : (defun vc-checkout-model (backend files)
378 : "Indicate how FILES are checked out.
379 :
380 : If FILES are not registered, this function always returns nil.
381 : For registered files, the possible values are:
382 :
383 : `implicit' FILES are always writable, and checked out `implicitly'
384 : when the user saves the first changes to the file.
385 :
386 : `locking' FILES are read-only if up-to-date; user must type
387 : \\[vc-next-action] before editing. Strict locking
388 : is assumed.
389 :
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 0 : (vc-call-backend backend 'checkout-model files))
394 :
395 : (defun vc-user-login-name (file)
396 : "Return the name under which the user accesses the given FILE."
397 0 : (or (and (file-remote-p file)
398 : ;; tramp case: execute "whoami" via tramp
399 0 : (let ((default-directory (file-name-directory file))
400 : process-file-side-effects)
401 0 : (with-temp-buffer
402 0 : (if (not (zerop (process-file "whoami" nil t)))
403 : ;; fall through if "whoami" didn't work
404 : nil
405 : ;; remove trailing newline
406 0 : (delete-region (1- (point-max)) (point-max))
407 0 : (buffer-string)))))
408 : ;; normal case
409 0 : (user-login-name)
410 : ;; if user-login-name is nil, return the UID as a string
411 0 : (number-to-string (user-uid))))
412 :
413 : (defun vc-state (file &optional backend)
414 : "Return the version control state of FILE.
415 :
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:
418 :
419 : `up-to-date' The working file is unmodified with respect to the
420 : latest version on the current branch, and not locked.
421 :
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
427 : as the repo copy.
428 :
429 : USER The current version of the working file is locked by
430 : some other USER (a string).
431 :
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
434 : in the repository.
435 :
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.
440 :
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).
447 :
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.
451 :
452 : `removed' Scheduled to be deleted from the repository on next commit.
453 :
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
457 : conflicts too.
458 :
459 : `missing' The file is not present in the file system, but the VC
460 : system still tracks it.
461 :
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.
468 :
469 : `unregistered' The file is not under version control."
470 :
471 : ;; Note: we usually return nil here for unregistered files anyway
472 : ;; when called with only one argument. This doesn't seem to cause
473 : ;; any problems. But if we wanted to change that, we should
474 : ;; probably opt for redefining the `registered' command to return
475 : ;; non-nil even for unregistered files (maybe also rename it), and
476 : ;; then make sure that all `state' implementations handle
477 : ;; unregistered file appropriately.
478 :
479 : ;; FIXME: New (sub)states needed (?):
480 : ;; - `copied' and `moved' (might be handled by `removed' and `added')
481 44 : (or (vc-file-getprop file 'vc-state)
482 44 : (when (> (length file) 0) ;Why?? --Stef
483 44 : (setq backend (or backend (vc-backend file)))
484 44 : (when backend
485 44 : (vc-state-refresh file backend)))))
486 :
487 : (defun vc-state-refresh (file backend)
488 : "Quickly recompute the `state' of FILE."
489 44 : (vc-file-setprop
490 44 : file 'vc-state
491 44 : (vc-call-backend backend 'state file)))
492 :
493 : (defsubst vc-up-to-date-p (file)
494 : "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
495 0 : (eq (vc-state file) 'up-to-date))
496 :
497 : (defun vc-working-revision (file &optional backend)
498 : "Return the repository version from which FILE was checked out.
499 : If FILE is not registered, this function always returns nil."
500 88 : (or (vc-file-getprop file 'vc-working-revision)
501 44 : (progn
502 44 : (setq backend (or backend (vc-backend file)))
503 44 : (when backend
504 44 : (vc-file-setprop file 'vc-working-revision
505 44 : (vc-call-backend
506 88 : backend 'working-revision file))))))
507 :
508 : ;; Backward compatibility.
509 : (define-obsolete-function-alias
510 : 'vc-workfile-version 'vc-working-revision "23.1")
511 : (defun vc-default-working-revision (backend file)
512 0 : (message
513 0 : "`working-revision' not found: using the old `workfile-version' instead")
514 0 : (vc-call-backend backend 'workfile-version file))
515 :
516 : (defun vc-default-registered (backend file)
517 : "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
518 204 : (let ((sym (vc-make-backend-sym backend 'master-templates)))
519 204 : (unless (get backend 'vc-templates-grabbed)
520 204 : (put backend 'vc-templates-grabbed t))
521 204 : (let ((result (vc-check-master-templates file (symbol-value sym))))
522 204 : (if (stringp result)
523 0 : (vc-file-setprop file 'vc-master-name result)
524 204 : nil)))) ; Not registered
525 :
526 : ;;;###autoload
527 : (defun vc-possible-master (s dirname basename)
528 476 : (cond
529 476 : ((stringp s) (format s dirname basename))
530 68 : ((functionp s)
531 : ;; The template is a function to invoke. If the
532 : ;; function returns non-nil, that means it has found a
533 : ;; master. For backward compatibility, we also handle
534 : ;; the case that the function throws a 'found atom
535 : ;; and a pair (cons MASTER-FILE BACKEND).
536 68 : (let ((result (catch 'found (funcall s dirname basename))))
537 476 : (if (consp result) (car result) result)))))
538 :
539 : (defun vc-check-master-templates (file templates)
540 : "Return non-nil if there is a master corresponding to FILE.
541 :
542 : TEMPLATES is a list of strings or functions. If an element is a
543 : string, it must be a control string as required by `format', with two
544 : string placeholders, such as \"%sRCS/%s,v\". The directory part of
545 : FILE is substituted for the first placeholder, the basename of FILE
546 : for the second. If a file with the resulting name exists, it is taken
547 : as the master of FILE, and returned.
548 :
549 : If an element of TEMPLATES is a function, it is called with the
550 : directory part and the basename of FILE as arguments. It should
551 : return non-nil if it finds a master; that value is then returned by
552 : this function."
553 204 : (let ((dirname (or (file-name-directory file) ""))
554 204 : (basename (file-name-nondirectory file)))
555 204 : (catch 'found
556 204 : (mapcar
557 : (lambda (s)
558 476 : (let ((trial (vc-possible-master s dirname basename)))
559 476 : (when (and trial (file-exists-p trial)
560 : ;; Make sure the file we found with name
561 : ;; TRIAL is not the source file itself.
562 : ;; That can happen with RCS-style names if
563 : ;; the file name is truncated (e.g. to 14
564 : ;; chars). See if either directory or
565 : ;; attributes differ.
566 0 : (or (not (string= dirname
567 0 : (file-name-directory trial)))
568 0 : (not (equal (file-attributes file)
569 476 : (file-attributes trial)))))
570 476 : (throw 'found trial))))
571 204 : templates))))
572 :
573 :
574 : ;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made
575 : ;; obsolete earlier, it is ok for the latter to be an alias to the former,
576 : ;; since the latter will be removed first. We can't just make it
577 : ;; an alias for read-only-mode, since that is not 100% the same.
578 : (defalias 'vc-toggle-read-only 'toggle-read-only)
579 : (make-obsolete 'vc-toggle-read-only
580 : "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)."
581 : "24.1")
582 :
583 : (defun vc-default-make-version-backups-p (_backend _file)
584 : "Return non-nil if unmodified versions should be backed up locally.
585 : The default is to switch off this feature."
586 : nil)
587 :
588 : (defun vc-version-backup-file-name (file &optional rev manual regexp)
589 : "Return a backup file name for REV or the current version of FILE.
590 : If MANUAL is non-nil it means that a name for backups created by
591 : the user should be returned; if REGEXP is non-nil that means to return
592 : a regexp for matching all such backup files, regardless of the version."
593 0 : (if regexp
594 0 : (concat (regexp-quote (file-name-nondirectory file))
595 0 : "\\.~.+" (unless manual "\\.") "~")
596 0 : (expand-file-name (concat (file-name-nondirectory file)
597 0 : ".~" (subst-char-in-string
598 0 : ?/ ?_ (or rev (vc-working-revision file)))
599 0 : (unless manual ".") "~")
600 0 : (file-name-directory file))))
601 :
602 : (defun vc-delete-automatic-version-backups (file)
603 : "Delete all existing automatic version backups for FILE."
604 0 : (condition-case nil
605 0 : (mapc
606 : 'delete-file
607 0 : (directory-files (or (file-name-directory file) default-directory) t
608 0 : (vc-version-backup-file-name file nil nil t)))
609 : ;; Don't fail when the directory doesn't exist.
610 0 : (file-error nil)))
611 :
612 : (defun vc-make-version-backup (file)
613 : "Make a backup copy of FILE, which is assumed in sync with the repository.
614 : Before doing that, check if there are any old backups and get rid of them."
615 0 : (unless (and (fboundp 'msdos-long-file-names)
616 0 : (not (with-no-warnings (msdos-long-file-names))))
617 0 : (vc-delete-automatic-version-backups file)
618 0 : (condition-case nil
619 0 : (copy-file file (vc-version-backup-file-name file)
620 0 : nil 'keep-date)
621 : ;; It's ok if it doesn't work (e.g. directory not writable),
622 : ;; since this is just for efficiency.
623 : (file-error
624 0 : (message
625 0 : (concat "Warning: Cannot make version backup; "
626 0 : "diff/revert therefore not local"))))))
627 :
628 : (defun vc-before-save ()
629 : "Function to be called by `basic-save-buffer' (in files.el)."
630 : ;; If the file on disk is still in sync with the repository,
631 : ;; and version backups should be made, copy the file to
632 : ;; another name. This enables local diffs and local reverting.
633 0 : (let ((file buffer-file-name)
634 : backend)
635 0 : (ignore-errors ;Be careful not to prevent saving the file.
636 0 : (unless (file-exists-p file)
637 0 : (vc-file-clearprops file))
638 0 : (and (setq backend (vc-backend file))
639 0 : (vc-up-to-date-p file)
640 0 : (eq (vc-checkout-model backend (list file)) 'implicit)
641 0 : (vc-call-backend backend 'make-version-backups-p file)
642 0 : (vc-make-version-backup file)))))
643 :
644 : (declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
645 :
646 : (defvar vc-dir-buffers nil "List of vc-dir buffers.")
647 :
648 : (defun vc-after-save ()
649 : "Function to be called by `basic-save-buffer' (in files.el)."
650 : ;; If the file in the current buffer is under version control,
651 : ;; up-to-date, and locking is not used for the file, set
652 : ;; the state to 'edited and redisplay the mode line.
653 0 : (let* ((file buffer-file-name)
654 0 : (backend (vc-backend file)))
655 0 : (cond
656 0 : ((null backend))
657 0 : ((eq (vc-checkout-model backend (list file)) 'implicit)
658 : ;; If the file was saved in the same second in which it was
659 : ;; checked out, clear the checkout-time to avoid confusion.
660 0 : (if (equal (vc-file-getprop file 'vc-checkout-time)
661 0 : (nth 5 (file-attributes file)))
662 0 : (vc-file-setprop file 'vc-checkout-time nil))
663 0 : (if (vc-state-refresh file backend)
664 0 : (vc-mode-line file backend)))
665 : ;; If we saved an unlocked file on a locking based VCS, that
666 : ;; file is not longer up-to-date.
667 0 : ((eq (vc-file-getprop file 'vc-state) 'up-to-date)
668 0 : (vc-file-setprop file 'vc-state nil)))
669 : ;; Resynch *vc-dir* buffers, if any are present.
670 0 : (when vc-dir-buffers
671 0 : (vc-dir-resynch-file file))))
672 :
673 : (defvar vc-menu-entry
674 : `(menu-item ,(purecopy "Version Control") vc-menu-map
675 : :filter vc-menu-map-filter))
676 :
677 : (when (boundp 'menu-bar-tools-menu)
678 : ;; We do not need to worry here about the placement of this entry
679 : ;; because menu-bar.el has already created the proper spot for us
680 : ;; and this will simply use it.
681 : (define-key menu-bar-tools-menu [vc] vc-menu-entry))
682 :
683 : (defconst vc-mode-line-map
684 : (let ((map (make-sparse-keymap)))
685 : (define-key map [mode-line down-mouse-1] vc-menu-entry)
686 : map))
687 :
688 : (defun vc-mode-line (file &optional backend)
689 : "Set `vc-mode' to display type of version control for FILE.
690 : The value is set in the current buffer, which should be the buffer
691 : visiting FILE.
692 : If BACKEND is passed use it as the VC backend when computing the result."
693 0 : (interactive (list buffer-file-name))
694 44 : (setq backend (or backend (vc-backend file)))
695 44 : (if (not backend)
696 0 : (setq vc-mode nil)
697 44 : (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
698 44 : (ml-echo (get-text-property 0 'help-echo ml-string)))
699 44 : (setq vc-mode
700 44 : (concat
701 : " "
702 44 : (if (null vc-display-status)
703 0 : (symbol-name backend)
704 44 : (propertize
705 44 : ml-string
706 : 'mouse-face 'mode-line-highlight
707 : 'help-echo
708 44 : (concat (or ml-echo
709 0 : (format "File under the %s version control system"
710 44 : backend))
711 44 : "\nmouse-1: Version Control menu")
712 44 : 'local-map vc-mode-line-map)))))
713 : ;; If the user is root, and the file is not owner-writable,
714 : ;; then pretend that we can't write it
715 : ;; even though we can (because root can write anything).
716 : ;; This way, even root cannot modify a file that isn't locked.
717 44 : (and (equal file buffer-file-name)
718 44 : (not buffer-read-only)
719 44 : (zerop (user-real-uid))
720 0 : (zerop (logand (file-modes buffer-file-name) 128))
721 44 : (setq buffer-read-only t)))
722 44 : (force-mode-line-update)
723 44 : backend)
724 :
725 : (defun vc-default-mode-line-string (backend file)
726 : "Return a string for `vc-mode-line' to put in the mode line for FILE.
727 : Format:
728 :
729 : \"BACKEND-REV\" if the file is up-to-date
730 : \"BACKEND:REV\" if the file is edited (or locked by the calling user)
731 : \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
732 : \"BACKEND@REV\" if the file was locally added
733 : \"BACKEND!REV\" if the file contains conflicts or was removed
734 : \"BACKEND?REV\" if the file is under VC, but is missing
735 :
736 : This function assumes that the file is registered."
737 44 : (let* ((backend-name (symbol-name backend))
738 44 : (state (vc-state file backend))
739 : (state-echo nil)
740 : (face nil)
741 44 : (rev (vc-working-revision file backend)))
742 44 : (propertize
743 44 : (cond ((or (eq state 'up-to-date)
744 44 : (eq state 'needs-update))
745 43 : (setq state-echo "Up to date file")
746 43 : (setq face 'vc-up-to-date-state)
747 43 : (concat backend-name "-" rev))
748 1 : ((stringp state)
749 0 : (setq state-echo (concat "File locked by" state))
750 0 : (setq face 'vc-locked-state)
751 0 : (concat backend-name ":" state ":" rev))
752 1 : ((eq state 'added)
753 0 : (setq state-echo "Locally added file")
754 0 : (setq face 'vc-locally-added-state)
755 0 : (concat backend-name "@" rev))
756 1 : ((eq state 'conflict)
757 0 : (setq state-echo "File contains conflicts after the last merge")
758 0 : (setq face 'vc-conflict-state)
759 0 : (concat backend-name "!" rev))
760 1 : ((eq state 'removed)
761 0 : (setq state-echo "File removed from the VC system")
762 0 : (setq face 'vc-removed-state)
763 0 : (concat backend-name "!" rev))
764 1 : ((eq state 'missing)
765 0 : (setq state-echo "File tracked by the VC system, but missing from the file system")
766 0 : (setq face 'vc-missing-state)
767 0 : (concat backend-name "?" rev))
768 : (t
769 : ;; Not just for the 'edited state, but also a fallback
770 : ;; for all other states. Think about different symbols
771 : ;; for 'needs-update and 'needs-merge.
772 1 : (setq state-echo "Locally modified file")
773 1 : (setq face 'vc-edited-state)
774 44 : (concat backend-name ":" rev)))
775 44 : 'face face
776 44 : 'help-echo (concat state-echo " under the " backend-name
777 44 : " version control system"))))
778 :
779 : (defun vc-follow-link ()
780 : "If current buffer visits a symbolic link, visit the real file.
781 : If the real file is already visited in another buffer, make that buffer
782 : current, and kill the buffer that visits the link."
783 0 : (let* ((true-buffer (find-buffer-visiting buffer-file-truename))
784 0 : (this-buffer (current-buffer)))
785 0 : (if (eq true-buffer this-buffer)
786 0 : (let ((truename buffer-file-truename))
787 0 : (kill-buffer this-buffer)
788 : ;; In principle, we could do something like set-visited-file-name.
789 : ;; However, it can't be exactly the same as set-visited-file-name.
790 : ;; I'm not going to work out the details right now. -- rms.
791 0 : (set-buffer (find-file-noselect truename)))
792 0 : (set-buffer true-buffer)
793 0 : (kill-buffer this-buffer))))
794 :
795 : (defun vc-default-find-file-hook (_backend)
796 : nil)
797 :
798 : (defun vc-refresh-state ()
799 : "Refresh the VC state of the current buffer's file.
800 :
801 : This command is more thorough than `vc-state-refresh', in that it
802 : also supports switching a back-end or removing the file from VC.
803 : In the latter case, VC mode is deactivated for this buffer."
804 : (interactive)
805 : ;; Recompute whether file is version controlled,
806 : ;; if user has killed the buffer and revisited.
807 51 : (when vc-mode
808 51 : (setq vc-mode nil))
809 51 : (when buffer-file-name
810 51 : (vc-file-clearprops buffer-file-name)
811 : ;; FIXME: Why use a hook? Why pass it buffer-file-name?
812 51 : (add-hook 'vc-mode-line-hook 'vc-mode-line nil t)
813 51 : (let (backend)
814 51 : (cond
815 51 : ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
816 : ;; Let the backend setup any buffer-local things he needs.
817 44 : (vc-call-backend backend 'find-file-hook)
818 : ;; Compute the state and put it in the mode line.
819 44 : (vc-mode-line buffer-file-name backend)
820 44 : (unless vc-make-backup-files
821 : ;; Use this variable, not make-backup-files,
822 : ;; because this is for things that depend on the file name.
823 44 : (set (make-local-variable 'backup-inhibited) t)))
824 7 : ((let* ((truename (and buffer-file-truename
825 7 : (expand-file-name buffer-file-truename)))
826 7 : (link-type (and truename
827 7 : (not (equal buffer-file-name truename))
828 7 : (vc-backend truename))))
829 7 : (cond ((not link-type) nil) ;Nothing to do.
830 0 : ((eq vc-follow-symlinks nil)
831 0 : (message
832 0 : "Warning: symbolic link to %s-controlled source file" link-type))
833 0 : ((or (not (eq vc-follow-symlinks 'ask))
834 : ;; Assume we cannot ask, default to yes.
835 0 : noninteractive
836 : ;; Copied from server-start. Seems like there should
837 : ;; be a better way to ask "can we get user input?"...
838 0 : (and (daemonp)
839 0 : (null (cdr (frame-list)))
840 0 : (eq (selected-frame) terminal-frame))
841 : ;; If we already visited this file by following
842 : ;; the link, don't ask again if we try to visit
843 : ;; it again. GUD does that, and repeated questions
844 : ;; are painful.
845 0 : (get-file-buffer
846 0 : (abbreviate-file-name
847 0 : (file-chase-links buffer-file-name))))
848 :
849 0 : (vc-follow-link)
850 0 : (message "Followed link to %s" buffer-file-name)
851 0 : (vc-refresh-state))
852 : (t
853 0 : (if (yes-or-no-p (format
854 0 : "Symbolic link to %s-controlled source file; follow link? " link-type))
855 0 : (progn (vc-follow-link)
856 0 : (message "Followed link to %s" buffer-file-name)
857 0 : (vc-refresh-state))
858 0 : (message
859 0 : "Warning: editing through the link bypasses version control")
860 51 : )))))))))
861 :
862 : (add-hook 'find-file-hook #'vc-refresh-state)
863 : (define-obsolete-function-alias 'vc-find-file-hook 'vc-refresh-state "25.1")
864 :
865 : (defun vc-kill-buffer-hook ()
866 : "Discard VC info about a file when we kill its buffer."
867 1960 : (when buffer-file-name (vc-file-clearprops buffer-file-name)))
868 :
869 : (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
870 :
871 : ;; Now arrange for (autoloaded) bindings of the main package.
872 : ;; Bindings for this have to go in the global map, as we'll often
873 : ;; want to call them from random buffers.
874 :
875 : ;; Autoloading works fine, but it prevents shortcuts from appearing
876 : ;; in the menu because they don't exist yet when the menu is built.
877 : ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
878 : (defvar vc-prefix-map
879 : (let ((map (make-sparse-keymap)))
880 : (define-key map "a" 'vc-update-change-log)
881 : (define-key map "b" 'vc-switch-backend)
882 : (define-key map "d" 'vc-dir)
883 : (define-key map "g" 'vc-annotate)
884 : (define-key map "G" 'vc-ignore)
885 : (define-key map "h" 'vc-insert-headers)
886 : (define-key map "i" 'vc-register)
887 : (define-key map "l" 'vc-print-log)
888 : (define-key map "L" 'vc-print-root-log)
889 : (define-key map "I" 'vc-log-incoming)
890 : (define-key map "O" 'vc-log-outgoing)
891 : (define-key map "m" 'vc-merge)
892 : (define-key map "r" 'vc-retrieve-tag)
893 : (define-key map "s" 'vc-create-tag)
894 : (define-key map "u" 'vc-revert)
895 : (define-key map "v" 'vc-next-action)
896 : (define-key map "+" 'vc-update)
897 : ;; I'd prefer some kind of symmetry with vc-update:
898 : (define-key map "P" 'vc-push)
899 : (define-key map "=" 'vc-diff)
900 : (define-key map "D" 'vc-root-diff)
901 : (define-key map "~" 'vc-revision-other-window)
902 : (define-key map "x" 'vc-delete-file)
903 : map))
904 : (fset 'vc-prefix-map vc-prefix-map)
905 : (define-key ctl-x-map "v" 'vc-prefix-map)
906 :
907 : (defvar vc-menu-map
908 : (let ((map (make-sparse-keymap "Version Control")))
909 : ;;(define-key map [show-files]
910 : ;; '("Show Files under VC" . (vc-directory t)))
911 : (bindings--define-key map [vc-retrieve-tag]
912 : '(menu-item "Retrieve Tag" vc-retrieve-tag
913 : :help "Retrieve tagged version or branch"))
914 : (bindings--define-key map [vc-create-tag]
915 : '(menu-item "Create Tag" vc-create-tag
916 : :help "Create version tag"))
917 : (bindings--define-key map [separator1] menu-bar-separator)
918 : (bindings--define-key map [vc-annotate]
919 : '(menu-item "Annotate" vc-annotate
920 : :help "Display the edit history of the current file using colors"))
921 : (bindings--define-key map [vc-rename-file]
922 : '(menu-item "Rename File" vc-rename-file
923 : :help "Rename file"))
924 : (bindings--define-key map [vc-revision-other-window]
925 : '(menu-item "Show Other Version" vc-revision-other-window
926 : :help "Visit another version of the current file in another window"))
927 : (bindings--define-key map [vc-diff]
928 : '(menu-item "Compare with Base Version" vc-diff
929 : :help "Compare file set with the base version"))
930 : (bindings--define-key map [vc-root-diff]
931 : '(menu-item "Compare Tree with Base Version" vc-root-diff
932 : :help "Compare current tree with the base version"))
933 : (bindings--define-key map [vc-update-change-log]
934 : '(menu-item "Update ChangeLog" vc-update-change-log
935 : :help "Find change log file and add entries from recent version control logs"))
936 : (bindings--define-key map [vc-log-out]
937 : '(menu-item "Show Outgoing Log" vc-log-outgoing
938 : :help "Show a log of changes that will be sent with a push operation"))
939 : (bindings--define-key map [vc-log-in]
940 : '(menu-item "Show Incoming Log" vc-log-incoming
941 : :help "Show a log of changes that will be received with a pull operation"))
942 : (bindings--define-key map [vc-print-log]
943 : '(menu-item "Show History" vc-print-log
944 : :help "List the change log of the current file set in a window"))
945 : (bindings--define-key map [vc-print-root-log]
946 : '(menu-item "Show Top of the Tree History " vc-print-root-log
947 : :help "List the change log for the current tree in a window"))
948 : (bindings--define-key map [separator2] menu-bar-separator)
949 : (bindings--define-key map [vc-insert-header]
950 : '(menu-item "Insert Header" vc-insert-headers
951 : :help "Insert headers into a file for use with a version control system.
952 : "))
953 : (bindings--define-key map [vc-revert]
954 : '(menu-item "Revert to Base Version" vc-revert
955 : :help "Revert working copies of the selected file set to their repository contents"))
956 : ;; TODO Only :enable if (vc-find-backend-function backend 'push)
957 : (bindings--define-key map [vc-push]
958 : '(menu-item "Push Changes" vc-push
959 : :help "Push the current branch's changes"))
960 : (bindings--define-key map [vc-update]
961 : '(menu-item "Update to Latest Version" vc-update
962 : :help "Update the current fileset's files to their tip revisions"))
963 : (bindings--define-key map [vc-next-action]
964 : '(menu-item "Check In/Out" vc-next-action
965 : :help "Do the next logical version control operation on the current fileset"))
966 : (bindings--define-key map [vc-register]
967 : '(menu-item "Register" vc-register
968 : :help "Register file set into a version control system"))
969 : (bindings--define-key map [vc-ignore]
970 : '(menu-item "Ignore File..." vc-ignore
971 : :help "Ignore a file under current version control system"))
972 : (bindings--define-key map [vc-dir]
973 : '(menu-item "VC Dir" vc-dir
974 : :help "Show the VC status of files in a directory"))
975 : map))
976 :
977 : (defalias 'vc-menu-map vc-menu-map)
978 :
979 : (declare-function vc-responsible-backend "vc" (file))
980 :
981 : (defun vc-menu-map-filter (orig-binding)
982 0 : (if (and (symbolp orig-binding) (fboundp orig-binding))
983 0 : (setq orig-binding (indirect-function orig-binding)))
984 0 : (let ((ext-binding
985 0 : (when vc-mode
986 0 : (vc-call-backend
987 0 : (if buffer-file-name
988 0 : (vc-backend buffer-file-name)
989 0 : (vc-responsible-backend default-directory))
990 0 : 'extra-menu))))
991 : ;; Give the VC backend a chance to add menu entries
992 : ;; specific for that backend.
993 0 : (if (null ext-binding)
994 0 : orig-binding
995 0 : (append orig-binding
996 : '((ext-menu-separator "--"))
997 0 : ext-binding))))
998 :
999 : (defun vc-default-extra-menu (_backend)
1000 : nil)
1001 :
1002 : (provide 'vc-hooks)
1003 :
1004 : ;;; vc-hooks.el ends here
|