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