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