2232
|
1 ;;; vc-hooks.el --- resident support for version-control
|
904
|
2
|
31382
|
3 ;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc.
|
904
|
4
|
31382
|
5 ;; Author: FSF (see vc.el for full credits)
|
|
6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
|
904
|
7
|
39417
|
8 ;; $Id: vc-hooks.el,v 1.133 2001/09/22 20:09:40 monnier Exp $
|
20989
|
9
|
904
|
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
|
14169
|
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.
|
904
|
26
|
|
27 ;;; Commentary:
|
|
28
|
31382
|
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.
|
904
|
33
|
|
34 ;;; Code:
|
|
35
|
33856
|
36 (eval-when-compile
|
|
37 (require 'cl))
|
31404
|
38
|
11604
|
39 ;; Customization Variables (the rest is in vc.el)
|
|
40
|
31382
|
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.")
|
11604
|
44
|
31382
|
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)
|
31404
|
53 :version "21.1"
|
20413
|
54 :group 'vc)
|
13378
96ff45331eb4
(vc-utc-string): Use timezone of TIMEVAL for the correction, not the
André Spiegel <spiegel@gnu.org>
diff
changeset
|
55
|
20413
|
56 (defcustom vc-path
|
11604
|
57 (if (file-directory-p "/usr/sccs")
|
|
58 '("/usr/sccs")
|
|
59 nil)
|
20413
|
60 "*List of extra directories to search for version control commands."
|
|
61 :type '(repeat directory)
|
|
62 :group 'vc)
|
11604
|
63
|
20413
|
64 (defcustom vc-make-backup-files nil
|
5164
|
65 "*If non-nil, backups of registered files are made as with other files.
|
20413
|
66 If nil (the default), files covered by version control don't get backups."
|
|
67 :type 'boolean
|
|
68 :group 'vc)
|
904
|
69
|
20413
|
70 (defcustom vc-follow-symlinks 'ask
|
31382
|
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,
|
14142
|
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
|
20413
|
78 visited and a warning displayed."
|
31382
|
79 :type '(choice (const :tag "Ask for confirmation" ask)
|
|
80 (const :tag "Visit link and warn" nil)
|
|
81 (const :tag "Follow link" t))
|
20413
|
82 :group 'vc)
|
14142
|
83
|
20413
|
84 (defcustom vc-display-status t
|
8982
|
85 "*If non-nil, display revision number and lock status in modeline.
|
20413
|
86 Otherwise, not displayed."
|
|
87 :type 'boolean
|
|
88 :group 'vc)
|
|
89
|
3900
|
90
|
20413
|
91 (defcustom vc-consult-headers t
|
|
92 "*If non-nil, identify work files by searching for version headers."
|
|
93 :type 'boolean
|
|
94 :group 'vc)
|
11604
|
95
|
20413
|
96 (defcustom vc-keep-workfiles t
|
11604
|
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
|
20413
|
99 value of this flag."
|
|
100 :type 'boolean
|
|
101 :group 'vc)
|
11604
|
102
|
20413
|
103 (defcustom vc-mistrust-permissions nil
|
31382
|
104 "*If non-nil, don't assume permissions/ownership track version-control status.
|
|
105 If nil, do rely on the permissions.
|
20413
|
106 See also variable `vc-consult-headers'."
|
|
107 :type 'boolean
|
|
108 :group 'vc)
|
12914
|
109
|
|
110 (defun vc-mistrust-permissions (file)
|
31382
|
111 "Internal access function to variable `vc-mistrust-permissions' for FILE."
|
12914
|
112 (or (eq vc-mistrust-permissions 't)
|
|
113 (and vc-mistrust-permissions
|
31382
|
114 (funcall vc-mistrust-permissions
|
12914
|
115 (vc-backend-subdirectory-name file)))))
|
|
116
|
904
|
117 ;; Tell Emacs about this new kind of minor mode
|
31382
|
118 (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
|
904
|
119
|
2491
|
120 (make-variable-buffer-local 'vc-mode)
|
2620
|
121 (put 'vc-mode 'permanent-local t)
|
904
|
122
|
38373
|
123 (defun vc-mode (&optional arg)
|
|
124 ;; Dummy function for C-h m
|
|
125 "Version Control minor mode.
|
|
126 This minor mode is automatically activated whenever you visit a file under
|
|
127 control of one of the revision control systems in `vc-handled-backends'.
|
|
128 VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
|
|
129 \\{vc-prefix-map}")
|
|
130
|
31404
|
131 (defmacro vc-error-occurred (&rest body)
|
|
132 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
|
|
133
|
904
|
134 ;; We need a notion of per-file properties because the version
|
11598
|
135 ;; control state of a file is expensive to derive --- we compute
|
31382
|
136 ;; them when the file is initially found, keep them up to date
|
11598
|
137 ;; during any subsequent VC operations, and forget them when
|
|
138 ;; the buffer is killed.
|
904
|
139
|
31382
|
140 (defvar vc-file-prop-obarray (make-vector 16 0)
|
904
|
141 "Obarray for per-file properties.")
|
|
142
|
31404
|
143 (defvar vc-touched-properties nil)
|
|
144
|
904
|
145 (defun vc-file-setprop (file property value)
|
31382
|
146 "Set per-file VC PROPERTY for FILE to VALUE."
|
31404
|
147 (if (and vc-touched-properties
|
|
148 (not (memq property vc-touched-properties)))
|
|
149 (setq vc-touched-properties (append (list property)
|
|
150 vc-touched-properties)))
|
904
|
151 (put (intern file vc-file-prop-obarray) property value))
|
|
152
|
|
153 (defun vc-file-getprop (file property)
|
31404
|
154 "Get per-file VC PROPERTY for FILE."
|
904
|
155 (get (intern file vc-file-prop-obarray) property))
|
|
156
|
11604
|
157 (defun vc-file-clearprops (file)
|
31382
|
158 "Clear all VC properties of FILE."
|
11604
|
159 (setplist (intern file vc-file-prop-obarray) nil))
|
|
160
|
31382
|
161
|
|
162 ;; We keep properties on each symbol naming a backend as follows:
|
|
163 ;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
|
11604
|
164
|
31382
|
165 (defun vc-make-backend-sym (backend sym)
|
|
166 "Return BACKEND-specific version of VC symbol SYM."
|
|
167 (intern (concat "vc-" (downcase (symbol-name backend))
|
|
168 "-" (symbol-name sym))))
|
11604
|
169
|
31382
|
170 (defun vc-find-backend-function (backend fun)
|
|
171 "Return BACKEND-specific implementation of FUN.
|
|
172 If there is no such implementation, return the default implementation;
|
|
173 if that doesn't exist either, return nil."
|
|
174 (let ((f (vc-make-backend-sym backend fun)))
|
|
175 (if (fboundp f) f
|
|
176 ;; Load vc-BACKEND.el if needed.
|
|
177 (require (intern (concat "vc-" (downcase (symbol-name backend)))))
|
|
178 (if (fboundp f) f
|
|
179 (let ((def (vc-make-backend-sym 'default fun)))
|
|
180 (if (fboundp def) (cons def backend) nil))))))
|
|
181
|
|
182 (defun vc-call-backend (backend function-name &rest args)
|
|
183 "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
|
|
184 Calls
|
11604
|
185
|
31382
|
186 (apply 'vc-BACKEND-FUN ARGS)
|
|
187
|
|
188 if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
|
|
189 and else calls
|
|
190
|
|
191 (apply 'vc-default-FUN BACKEND ARGS)
|
|
192
|
|
193 It is usually called via the `vc-call' macro."
|
|
194 (let ((f (cdr (assoc function-name (get backend 'vc-functions)))))
|
|
195 (unless f
|
|
196 (setq f (vc-find-backend-function backend function-name))
|
|
197 (put backend 'vc-functions (cons (cons function-name f)
|
|
198 (get backend 'vc-functions))))
|
|
199 (if (consp f)
|
|
200 (apply (car f) (cdr f) args)
|
|
201 (apply f args))))
|
|
202
|
|
203 (defmacro vc-call (fun file &rest args)
|
|
204 ;; BEWARE!! `file' is evaluated twice!!
|
|
205 `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
|
|
206
|
|
207
|
|
208 (defsubst vc-parse-buffer (pattern i)
|
|
209 "Find PATTERN in the current buffer and return its Ith submatch."
|
|
210 (goto-char (point-min))
|
|
211 (if (re-search-forward pattern nil t)
|
|
212 (match-string i)))
|
11598
|
213
|
12251
|
214 (defun vc-insert-file (file &optional limit blocksize)
|
31382
|
215 "Insert the contents of FILE into the current buffer.
|
|
216
|
|
217 Optional argument LIMIT is a regexp. If present, the file is inserted
|
|
218 in chunks of size BLOCKSIZE (default 8 kByte), until the first
|
33206
|
219 occurrence of LIMIT is found. The function returns non-nil if FILE
|
|
220 exists and its contents were successfully inserted."
|
12367
f268f652055e
(vc-insert-file): Erase the current buffer before inserting the file.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
221 (erase-buffer)
|
33206
|
222 (when (file-exists-p file)
|
|
223 (if (not limit)
|
|
224 (insert-file-contents file)
|
|
225 (if (not blocksize) (setq blocksize 8192))
|
33247
|
226 (let ((filepos 0))
|
|
227 (while
|
|
228 (and (< 0 (cadr (insert-file-contents
|
|
229 file nil filepos (incf filepos blocksize))))
|
|
230 (progn (beginning-of-line)
|
|
231 (not (re-search-forward limit nil 'move)))))))
|
33206
|
232 (set-buffer-modified-p nil)
|
|
233 t))
|
12251
|
234
|
38373
|
235 ;; Access functions to file properties
|
|
236 ;; (Properties should be _set_ using vc-file-setprop, but
|
|
237 ;; _retrieved_ only through these functions, which decide
|
|
238 ;; if the property is already known or not. A property should
|
|
239 ;; only be retrieved by vc-file-getprop if there is no
|
|
240 ;; access function.)
|
11598
|
241
|
38373
|
242 ;; properties indicating the backend being used for FILE
|
31382
|
243
|
|
244 (defun vc-registered (file)
|
|
245 "Return non-nil if FILE is registered in a version control system.
|
11604
|
246
|
32070
|
247 This function performs the check each time it is called. To rely
|
|
248 on the result of a previous call, use `vc-backend' instead. If the
|
|
249 file was previously registered under a certain backend, then that
|
|
250 backend is tried first."
|
31382
|
251 (let (handler)
|
|
252 (if (boundp 'file-name-handler-alist)
|
|
253 (setq handler (find-file-name-handler file 'vc-registered)))
|
|
254 (if handler
|
|
255 ;; handler should set vc-backend and return t if registered
|
|
256 (funcall handler 'vc-registered file)
|
|
257 ;; There is no file name handler.
|
|
258 ;; Try vc-BACKEND-registered for each handled BACKEND.
|
|
259 (catch 'found
|
32070
|
260 (let ((backend (vc-file-getprop file 'vc-backend)))
|
|
261 (mapcar
|
|
262 (lambda (b)
|
|
263 (and (vc-call-backend b 'registered file)
|
|
264 (vc-file-setprop file 'vc-backend b)
|
|
265 (throw 'found t)))
|
|
266 (if (or (not backend) (eq backend 'none))
|
|
267 vc-handled-backends
|
|
268 (cons backend vc-handled-backends))))
|
31382
|
269 ;; File is not registered.
|
|
270 (vc-file-setprop file 'vc-backend 'none)
|
|
271 nil))))
|
|
272
|
|
273 (defun vc-backend (file)
|
|
274 "Return the version control type of FILE, nil if it is not registered."
|
|
275 ;; `file' can be nil in several places (typically due to the use of
|
|
276 ;; code like (vc-backend (buffer-file-name))).
|
|
277 (when (stringp file)
|
|
278 (let ((property (vc-file-getprop file 'vc-backend)))
|
|
279 ;; Note that internally, Emacs remembers unregistered
|
|
280 ;; files by setting the property to `none'.
|
|
281 (cond ((eq property 'none) nil)
|
|
282 (property)
|
|
283 ;; vc-registered sets the vc-backend property
|
|
284 (t (if (vc-registered file)
|
|
285 (vc-file-getprop file 'vc-backend)
|
|
286 nil))))))
|
|
287
|
|
288 (defun vc-backend-subdirectory-name (file)
|
|
289 "Return where the master and lock FILEs for the current directory are kept."
|
|
290 (symbol-name (vc-backend file)))
|
11604
|
291
|
12251
|
292 (defun vc-name (file)
|
31564
|
293 "Return the master name of FILE.
|
|
294 If the file is not registered, or the master name is not known, return nil."
|
|
295 ;; TODO: This should ultimately become obsolete, at least up here
|
31382
|
296 ;; in vc-hooks.
|
12251
|
297 (or (vc-file-getprop file 'vc-name)
|
31808
25632a490236
(vc-name): Force correct computation of the value in case it is missing.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
298 ;; force computation of the property by calling
|
25632a490236
(vc-name): Force correct computation of the value in case it is missing.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
299 ;; vc-BACKEND-registered explicitly
|
25632a490236
(vc-name): Force correct computation of the value in case it is missing.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
300 (if (and (vc-backend file)
|
25632a490236
(vc-name): Force correct computation of the value in case it is missing.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
301 (vc-call-backend (vc-backend file) 'registered file))
|
21356
|
302 (vc-file-getprop file 'vc-name))))
|
11604
|
303
|
31382
|
304 (defun vc-checkout-model (file)
|
|
305 "Indicate how FILE is checked out.
|
11604
|
306
|
31382
|
307 Possible values:
|
12884
f47248851f26
(vc-fetch-master-properties): Recognize cvs status "Unresolved Conflict".
André Spiegel <spiegel@gnu.org>
diff
changeset
|
308
|
31382
|
309 'implicit File is always writeable, and checked out `implicitly'
|
|
310 when the user saves the first changes to the file.
|
11604
|
311
|
31382
|
312 'locking File is read-only if up-to-date; user must type
|
|
313 \\[vc-toggle-read-only] before editing. Strict locking
|
|
314 is assumed.
|
12251
|
315
|
31382
|
316 'announce File is read-only if up-to-date; user must type
|
|
317 \\[vc-toggle-read-only] before editing. But other users
|
|
318 may be editing at the same time."
|
|
319 (or (vc-file-getprop file 'vc-checkout-model)
|
|
320 (vc-file-setprop file 'vc-checkout-model
|
|
321 (vc-call checkout-model file))))
|
12925
|
322
|
16742
|
323 (defun vc-user-login-name (&optional uid)
|
31382
|
324 "Return the name under which the user is logged in, as a string.
|
|
325 \(With optional argument UID, return the name of that user.)
|
|
326 This function does the same as function `user-login-name', but unlike
|
|
327 that, it never returns nil. If a UID cannot be resolved, that
|
|
328 UID is returned as a string."
|
16742
|
329 (or (user-login-name uid)
|
31382
|
330 (number-to-string (or uid (user-uid)))))
|
12925
|
331
|
31382
|
332 (defun vc-state (file)
|
|
333 "Return the version control state of FILE.
|
|
334
|
31564
|
335 The value returned is one of:
|
12251
|
336
|
31382
|
337 'up-to-date The working file is unmodified with respect to the
|
|
338 latest version on the current branch, and not locked.
|
12925
|
339
|
31382
|
340 'edited The working file has been edited by the user. If
|
|
341 locking is used for the file, this state means that
|
|
342 the current version is locked by the calling user.
|
12925
|
343
|
31382
|
344 USER The current version of the working file is locked by
|
|
345 some other USER (a string).
|
|
346
|
|
347 'needs-patch The file has not been edited by the user, but there is
|
|
348 a more recent version on the current branch stored
|
|
349 in the master file.
|
12251
|
350
|
31382
|
351 'needs-merge The file has been edited by the user, and there is also
|
|
352 a more recent version on the current branch stored in
|
|
353 the master file. This state can only occur if locking
|
|
354 is not used for the file.
|
11604
|
355
|
31382
|
356 'unlocked-changes The current version of the working file is not locked,
|
|
357 but the working file has been changed with respect
|
|
358 to that version. This state can only occur for files
|
|
359 with locking; it represents an erroneous condition that
|
|
360 should be resolved by the user (vc-next-action will
|
|
361 prompt the user to do it)."
|
|
362 (or (vc-file-getprop file 'vc-state)
|
|
363 (vc-file-setprop file 'vc-state
|
|
364 (vc-call state-heuristic file))))
|
11604
|
365
|
31382
|
366 (defsubst vc-up-to-date-p (file)
|
|
367 "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
|
|
368 (eq (vc-state file) 'up-to-date))
|
|
369
|
|
370 (defun vc-default-state-heuristic (backend file)
|
31564
|
371 "Default implementation of vc-state-heuristic.
|
|
372 It simply calls the real state computation function `vc-BACKEND-state'
|
|
373 and does not employ any heuristic at all."
|
31382
|
374 (vc-call-backend backend 'state file))
|
12252
|
375
|
11604
|
376 (defun vc-workfile-version (file)
|
31382
|
377 "Return version level of the current workfile FILE."
|
|
378 (or (vc-file-getprop file 'vc-workfile-version)
|
|
379 (vc-file-setprop file 'vc-workfile-version
|
|
380 (vc-call workfile-version file))))
|
11598
|
381
|
33634
|
382 ;;; actual version-control code starts here
|
|
383
|
31382
|
384 (defun vc-default-registered (backend file)
|
|
385 "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
|
|
386 (let ((sym (vc-make-backend-sym backend 'master-templates)))
|
|
387 (unless (get backend 'vc-templates-grabbed)
|
|
388 (put backend 'vc-templates-grabbed t)
|
|
389 (set sym (append (delq nil
|
|
390 (mapcar
|
|
391 (lambda (template)
|
|
392 (and (consp template)
|
|
393 (eq (cdr template) backend)
|
|
394 (car template)))
|
|
395 vc-master-templates))
|
|
396 (symbol-value sym))))
|
|
397 (let ((result (vc-check-master-templates file (symbol-value sym))))
|
|
398 (if (stringp result)
|
|
399 (vc-file-setprop file 'vc-name result)
|
|
400 nil)))) ; Not registered
|
904
|
401
|
31382
|
402 (defun vc-possible-master (s dirname basename)
|
|
403 (cond
|
|
404 ((stringp s) (format s dirname basename))
|
|
405 ((functionp s)
|
|
406 ;; The template is a function to invoke. If the
|
|
407 ;; function returns non-nil, that means it has found a
|
|
408 ;; master. For backward compatibility, we also handle
|
|
409 ;; the case that the function throws a 'found atom
|
|
410 ;; and a pair (cons MASTER-FILE BACKEND).
|
|
411 (let ((result (catch 'found (funcall s dirname basename))))
|
|
412 (if (consp result) (car result) result)))))
|
21232
b682a769996d
(vc-sccs-project-dir, vc-search-sccs-project-dir): New functions.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
413
|
31382
|
414 (defun vc-check-master-templates (file templates)
|
|
415 "Return non-nil if there is a master corresponding to FILE,
|
|
416 according to any of the elements in TEMPLATES.
|
|
417
|
|
418 TEMPLATES is a list of strings or functions. If an element is a
|
|
419 string, it must be a control string as required by `format', with two
|
|
420 string placeholders, such as \"%sRCS/%s,v\". The directory part of
|
|
421 FILE is substituted for the first placeholder, the basename of FILE
|
|
422 for the second. If a file with the resulting name exists, it is taken
|
|
423 as the master of FILE, and returned.
|
9248
|
424
|
31382
|
425 If an element of TEMPLATES is a function, it is called with the
|
|
426 directory part and the basename of FILE as arguments. It should
|
|
427 return non-nil if it finds a master; that value is then returned by
|
|
428 this function."
|
|
429 (let ((dirname (or (file-name-directory file) ""))
|
|
430 (basename (file-name-nondirectory file)))
|
|
431 (catch 'found
|
31564
|
432 (mapcar
|
31382
|
433 (lambda (s)
|
|
434 (let ((trial (vc-possible-master s dirname basename)))
|
|
435 (if (and trial (file-exists-p trial)
|
|
436 ;; Make sure the file we found with name
|
|
437 ;; TRIAL is not the source file itself.
|
|
438 ;; That can happen with RCS-style names if
|
|
439 ;; the file name is truncated (e.g. to 14
|
|
440 ;; chars). See if either directory or
|
|
441 ;; attributes differ.
|
|
442 (or (not (string= dirname
|
|
443 (file-name-directory trial)))
|
|
444 (not (equal (file-attributes file)
|
|
445 (file-attributes trial)))))
|
|
446 (throw 'found trial))))
|
|
447 templates))))
|
11598
|
448
|
10176
|
449 (defun vc-toggle-read-only (&optional verbose)
|
2620
|
450 "Change read-only status of current buffer, perhaps via version control.
|
|
451 If the buffer is visiting a file registered with version control,
|
|
452 then check the file in or out. Otherwise, just change the read-only flag
|
23693
|
453 of the buffer.
|
|
454 With prefix argument, ask for version number to check in or check out.
|
|
455 Check-out of a specified version number does not lock the file;
|
|
456 to do that, use this command a second time with no argument."
|
10176
|
457 (interactive "P")
|
18850
238067491696
(vc-find-cvs-master): Corrected parsing of CVS/Entries, according to CVS docs.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
458 (if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
|
31382
|
459 ;; use boundp because vc.el might not be loaded
|
|
460 (vc-backend (buffer-file-name)))
|
10176
|
461 (vc-next-action verbose)
|
904
|
462 (toggle-read-only)))
|
2620
|
463 (define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
|
904
|
464
|
32746
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
465 (defun vc-default-make-version-backups-p (backend file)
|
32127
|
466 "Return non-nil if unmodified repository versions should
|
|
467 be backed up locally. The default is to switch off this feature."
|
|
468 nil)
|
|
469
|
32746
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
470 (defun vc-version-backup-file-name (file &optional rev manual regexp)
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
471 "Return a backup file name for REV or the current version of FILE.
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
472 If MANUAL is non-nil it means that a name for backups created by
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
473 the user should be returned; if REGEXP is non-nil that means to return
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
474 a regexp for matching all such backup files, regardless of the version."
|
32949
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
475 (if regexp
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
476 (concat (regexp-quote (file-name-nondirectory file))
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
477 "\\.~[0-9.]+" (unless manual "\\.") "~")
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
478 (expand-file-name (concat (file-name-nondirectory file)
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
479 ".~" (or rev (vc-workfile-version file))
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
480 (unless manual ".") "~")
|
78fabc2762c4
(vc-version-backup-file-name): Use file.~<rev>~ for manual backups and
André Spiegel <spiegel@gnu.org>
diff
changeset
|
481 (file-name-directory file))))
|
32746
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
482
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
483 (defun vc-delete-automatic-version-backups (file)
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
484 "Delete all existing automatic version backups for FILE."
|
39389
|
485 (condition-case nil
|
|
486 (mapcar
|
|
487 'delete-file
|
39417
|
488 (directory-files (or (file-name-directory file) default-directory) t
|
39389
|
489 (vc-version-backup-file-name file nil nil t)))
|
|
490 ;; Don't fail when the directory doesn't exist.
|
|
491 (file-error nil)))
|
32746
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
492
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
493 (defun vc-make-version-backup (file)
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
494 "Make a backup copy of FILE, which is assumed in sync with the repository.
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
495 Before doing that, check if there are any old backups and get rid of them."
|
32953
3632d408929e
(vc-make-version-backup): Don't do it on MS-DOS without long file
André Spiegel <spiegel@gnu.org>
diff
changeset
|
496 (unless (and (fboundp 'msdos-long-file-names)
|
3632d408929e
(vc-make-version-backup): Don't do it on MS-DOS without long file
André Spiegel <spiegel@gnu.org>
diff
changeset
|
497 (not (msdos-long-file-names)))
|
3632d408929e
(vc-make-version-backup): Don't do it on MS-DOS without long file
André Spiegel <spiegel@gnu.org>
diff
changeset
|
498 (vc-delete-automatic-version-backups file)
|
3632d408929e
(vc-make-version-backup): Don't do it on MS-DOS without long file
André Spiegel <spiegel@gnu.org>
diff
changeset
|
499 (copy-file file (vc-version-backup-file-name file)
|
3632d408929e
(vc-make-version-backup): Don't do it on MS-DOS without long file
André Spiegel <spiegel@gnu.org>
diff
changeset
|
500 nil 'keep-date)))
|
32127
|
501
|
|
502 (defun vc-before-save ()
|
|
503 "Function to be called by `basic-save-buffer' (in files.el)."
|
|
504 ;; If the file on disk is still in sync with the repository,
|
|
505 ;; and version backups should be made, copy the file to
|
|
506 ;; another name. This enables local diffs and local reverting.
|
|
507 (let ((file (buffer-file-name)))
|
|
508 (and (vc-backend file)
|
|
509 (vc-up-to-date-p file)
|
|
510 (eq (vc-checkout-model file) 'implicit)
|
32746
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
511 (vc-call make-version-backups-p file)
|
033bb57afe0c
(vc-version-backup-file-name): New optional args MANUAL and REGEXP.
André Spiegel <spiegel@gnu.org>
diff
changeset
|
512 (vc-make-version-backup file))))
|
32127
|
513
|
12914
|
514 (defun vc-after-save ()
|
31382
|
515 "Function to be called by `basic-save-buffer' (in files.el)."
|
31564
|
516 ;; If the file in the current buffer is under version control,
|
31382
|
517 ;; up-to-date, and locking is not used for the file, set
|
|
518 ;; the state to 'edited and redisplay the mode line.
|
12914
|
519 (let ((file (buffer-file-name)))
|
21356
|
520 (and (vc-backend file)
|
12967
|
521 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
|
|
522 (nth 5 (file-attributes file)))
|
|
523 ;; File has been saved in the same second in which
|
|
524 ;; it was checked out. Clear the checkout-time
|
|
525 ;; to avoid confusion.
|
|
526 (vc-file-setprop file 'vc-checkout-time nil))
|
|
527 t)
|
31382
|
528 (vc-up-to-date-p file)
|
|
529 (eq (vc-checkout-model file) 'implicit)
|
|
530 (vc-file-setprop file 'vc-state 'edited)
|
|
531 (vc-mode-line file)
|
31404
|
532 (if (featurep 'vc)
|
|
533 ;; If VC is not loaded, then there can't be
|
|
534 ;; any VC Dired buffer to synchronize.
|
|
535 (vc-dired-resynch-file file)))))
|
12884
f47248851f26
(vc-fetch-master-properties): Recognize cvs status "Unresolved Conflict".
André Spiegel <spiegel@gnu.org>
diff
changeset
|
536
|
31382
|
537 (defun vc-mode-line (file)
|
2491
|
538 "Set `vc-mode' to display type of version control for FILE.
|
904
|
539 The value is set in the current buffer, which should be the buffer
|
31382
|
540 visiting FILE."
|
32188
|
541 (interactive (list buffer-file-name))
|
31382
|
542 (unless (not (vc-backend file))
|
31404
|
543 (setq vc-mode (concat " " (if vc-display-status
|
|
544 (vc-call mode-line-string file)
|
|
545 (symbol-name (vc-backend file)))))
|
15448
593dadb4f287
(vc-mode-line): If user is root, verify file really has user-writable bit.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
546 ;; If the file is locked by some other user, make
|
593dadb4f287
(vc-mode-line): If user is root, verify file really has user-writable bit.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
547 ;; the buffer read-only. Like this, even root
|
15517
|
548 ;; cannot modify a file that someone else has locked.
|
31382
|
549 (and (equal file (buffer-file-name))
|
|
550 (stringp (vc-state file))
|
12914
|
551 (setq buffer-read-only t))
|
15517
|
552 ;; If the user is root, and the file is not owner-writable,
|
|
553 ;; then pretend that we can't write it
|
|
554 ;; even though we can (because root can write anything).
|
|
555 ;; This way, even root cannot modify a file that isn't locked.
|
31382
|
556 (and (equal file (buffer-file-name))
|
15448
593dadb4f287
(vc-mode-line): If user is root, verify file really has user-writable bit.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
557 (not buffer-read-only)
|
593dadb4f287
(vc-mode-line): If user is root, verify file really has user-writable bit.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
558 (zerop (user-real-uid))
|
593dadb4f287
(vc-mode-line): If user is root, verify file really has user-writable bit.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
559 (zerop (logand (file-modes (buffer-file-name)) 128))
|
31382
|
560 (setq buffer-read-only t)))
|
|
561 (force-mode-line-update)
|
|
562 (vc-backend file))
|
|
563
|
|
564 (defun vc-default-mode-line-string (backend file)
|
|
565 "Return string for placement in modeline by `vc-mode-line' for FILE.
|
|
566 Format:
|
|
567
|
|
568 \"BACKEND-REV\" if the file is up-to-date
|
|
569 \"BACKEND:REV\" if the file is edited (or locked by the calling user)
|
|
570 \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
|
904
|
571
|
31382
|
572 This function assumes that the file is registered."
|
|
573 (setq backend (symbol-name backend))
|
|
574 (let ((state (vc-state file))
|
|
575 (rev (vc-workfile-version file)))
|
31404
|
576 (cond ((or (eq state 'up-to-date)
|
31382
|
577 (eq state 'needs-patch))
|
|
578 (concat backend "-" rev))
|
|
579 ((stringp state)
|
|
580 (concat backend ":" state ":" rev))
|
|
581 (t
|
|
582 ;; Not just for the 'edited state, but also a fallback
|
|
583 ;; for all other states. Think about different symbols
|
|
584 ;; for 'needs-patch and 'needs-merge.
|
|
585 (concat backend ":" rev)))))
|
11598
|
586
|
14647
|
587 (defun vc-follow-link ()
|
31382
|
588 "If current buffer visits a symbolic link, visit the real file.
|
|
589 If the real file is already visited in another buffer, make that buffer
|
|
590 current, and kill the buffer that visits the link."
|
15161
|
591 (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
|
14673
|
592 (true-buffer (find-buffer-visiting truename))
|
|
593 (this-buffer (current-buffer)))
|
|
594 (if (eq true-buffer this-buffer)
|
|
595 (progn
|
14674
|
596 (kill-buffer this-buffer)
|
14673
|
597 ;; In principle, we could do something like set-visited-file-name.
|
|
598 ;; However, it can't be exactly the same as set-visited-file-name.
|
|
599 ;; I'm not going to work out the details right now. -- rms.
|
14674
|
600 (set-buffer (find-file-noselect truename)))
|
14673
|
601 (set-buffer true-buffer)
|
|
602 (kill-buffer this-buffer))))
|
14647
|
603
|
904
|
604 (defun vc-find-file-hook ()
|
31382
|
605 "Function for `find-file-hooks' activating VC mode if appropriate."
|
2218
|
606 ;; Recompute whether file is version controlled,
|
|
607 ;; if user has killed the buffer and revisited.
|
31382
|
608 (when buffer-file-name
|
11598
|
609 (vc-file-clearprops buffer-file-name)
|
|
610 (cond
|
11604
|
611 ((vc-backend buffer-file-name)
|
11598
|
612 (vc-mode-line buffer-file-name)
|
|
613 (cond ((not vc-make-backup-files)
|
|
614 ;; Use this variable, not make-backup-files,
|
|
615 ;; because this is for things that depend on the file name.
|
|
616 (make-local-variable 'backup-inhibited)
|
12590
|
617 (setq backup-inhibited t))))
|
|
618 ((let* ((link (file-symlink-p buffer-file-name))
|
15196
|
619 (link-type (and link (vc-backend (file-chase-links link)))))
|
12590
|
620 (if link-type
|
14142
|
621 (cond ((eq vc-follow-symlinks nil)
|
|
622 (message
|
|
623 "Warning: symbolic link to %s-controlled source file" link-type))
|
15161
|
624 ((or (not (eq vc-follow-symlinks 'ask))
|
|
625 ;; If we already visited this file by following
|
|
626 ;; the link, don't ask again if we try to visit
|
|
627 ;; it again. GUD does that, and repeated questions
|
|
628 ;; are painful.
|
|
629 (get-file-buffer
|
31564
|
630 (abbreviate-file-name
|
31382
|
631 (file-chase-links buffer-file-name))))
|
15161
|
632
|
|
633 (vc-follow-link)
|
|
634 (message "Followed link to %s" buffer-file-name)
|
|
635 (vc-find-file-hook))
|
|
636 (t
|
14142
|
637 (if (yes-or-no-p (format
|
|
638 "Symbolic link to %s-controlled source file; follow link? " link-type))
|
14647
|
639 (progn (vc-follow-link)
|
14142
|
640 (message "Followed link to %s" buffer-file-name)
|
|
641 (vc-find-file-hook))
|
31382
|
642 (message
|
14142
|
643 "Warning: editing through the link bypasses version control")
|
31382
|
644 )))))))))
|
904
|
645
|
4655
604a401e05a4
(vc-find-file-hook, vc-file-not-found-hook): Use add-hook to install.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
646 (add-hook 'find-file-hooks 'vc-find-file-hook)
|
904
|
647
|
38373
|
648 ;; more hooks, this time for file-not-found
|
904
|
649 (defun vc-file-not-found-hook ()
|
31382
|
650 "When file is not found, try to check it out from version control.
|
|
651 Returns t if checkout was successful, nil otherwise.
|
|
652 Used in `find-file-not-found-hooks'."
|
22947
|
653 ;; When a file does not exist, ignore cached info about it
|
|
654 ;; from a previous visit.
|
|
655 (vc-file-clearprops buffer-file-name)
|
31382
|
656 (if (and (vc-backend buffer-file-name)
|
31564
|
657 (yes-or-no-p
|
31382
|
658 (format "File %s was lost; check out from version control? "
|
|
659 (file-name-nondirectory buffer-file-name))))
|
|
660 (save-excursion
|
|
661 (require 'vc)
|
|
662 (setq default-directory (file-name-directory buffer-file-name))
|
|
663 (not (vc-error-occurred (vc-checkout buffer-file-name))))))
|
904
|
664
|
4655
604a401e05a4
(vc-find-file-hook, vc-file-not-found-hook): Use add-hook to install.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
665 (add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
|
904
|
666
|
11598
|
667 (defun vc-kill-buffer-hook ()
|
31382
|
668 "Discard VC info about a file when we kill its buffer."
|
|
669 (if (buffer-file-name)
|
|
670 (vc-file-clearprops (buffer-file-name))))
|
11598
|
671
|
31382
|
672 ;; ??? DL: why is this not done?
|
11598
|
673 ;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
|
|
674
|
38373
|
675 ;; Now arrange for (autoloaded) bindings of the main package.
|
|
676 ;; Bindings for this have to go in the global map, as we'll often
|
|
677 ;; want to call them from random buffers.
|
904
|
678
|
38373
|
679 ;; Autoloading works fine, but it prevents shortcuts from appearing
|
|
680 ;; in the menu because they don't exist yet when the menu is built.
|
|
681 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
|
|
682 (defvar vc-prefix-map
|
|
683 (let ((map (make-sparse-keymap)))
|
|
684 (define-key map "a" 'vc-update-change-log)
|
|
685 (define-key map "b" 'vc-switch-backend)
|
|
686 (define-key map "c" 'vc-cancel-version)
|
|
687 (define-key map "d" 'vc-directory)
|
|
688 (define-key map "g" 'vc-annotate)
|
|
689 (define-key map "h" 'vc-insert-headers)
|
|
690 (define-key map "i" 'vc-register)
|
|
691 (define-key map "l" 'vc-print-log)
|
|
692 (define-key map "m" 'vc-merge)
|
|
693 (define-key map "r" 'vc-retrieve-snapshot)
|
|
694 (define-key map "s" 'vc-create-snapshot)
|
|
695 (define-key map "u" 'vc-revert-buffer)
|
|
696 (define-key map "v" 'vc-next-action)
|
|
697 (define-key map "=" 'vc-diff)
|
|
698 (define-key map "~" 'vc-version-other-window)
|
|
699 map))
|
|
700 (fset 'vc-prefix-map vc-prefix-map)
|
31382
|
701 (define-key global-map "\C-xv" 'vc-prefix-map)
|
8982
|
702
|
9869
|
703 (if (not (boundp 'vc-menu-map))
|
|
704 ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
|
|
705 ;; vc-menu-map.
|
|
706 ()
|
|
707 ;;(define-key vc-menu-map [show-files]
|
|
708 ;; '("Show Files under VC" . (vc-directory t)))
|
18403
bb63fa860267
(vc-menu-map): Add bindings for vc-retrieve-snapshot and vc-create-snapshot.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
709 (define-key vc-menu-map [vc-retrieve-snapshot]
|
bb63fa860267
(vc-menu-map): Add bindings for vc-retrieve-snapshot and vc-create-snapshot.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
710 '("Retrieve Snapshot" . vc-retrieve-snapshot))
|
bb63fa860267
(vc-menu-map): Add bindings for vc-retrieve-snapshot and vc-create-snapshot.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
711 (define-key vc-menu-map [vc-create-snapshot]
|
bb63fa860267
(vc-menu-map): Add bindings for vc-retrieve-snapshot and vc-create-snapshot.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
712 '("Create Snapshot" . vc-create-snapshot))
|
23255
|
713 (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
|
9869
|
714 (define-key vc-menu-map [separator1] '("----"))
|
18148
|
715 (define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
|
9869
|
716 (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
|
|
717 (define-key vc-menu-map [vc-version-other-window]
|
|
718 '("Show Other Version" . vc-version-other-window))
|
|
719 (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
|
|
720 (define-key vc-menu-map [vc-update-change-log]
|
|
721 '("Update ChangeLog" . vc-update-change-log))
|
|
722 (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
|
|
723 (define-key vc-menu-map [separator2] '("----"))
|
|
724 (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
|
|
725 (define-key vc-menu-map [vc-revert-buffer]
|
|
726 '("Revert to Last Version" . vc-revert-buffer))
|
|
727 (define-key vc-menu-map [vc-insert-header]
|
|
728 '("Insert Header" . vc-insert-headers))
|
19103
3a841692390c
(vc-menu-map): Replace entries for "Check In" and "Check Out" with
André Spiegel <spiegel@gnu.org>
diff
changeset
|
729 (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
|
14622
|
730 (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
|
|
731
|
38373
|
732 ;; These are not correct and it's not currently clear how doing it
|
|
733 ;; better (with more complicated expressions) might slow things down
|
|
734 ;; on older systems.
|
23255
|
735
|
38373
|
736 ;;(put 'vc-rename-file 'menu-enable 'vc-mode)
|
|
737 ;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
|
|
738 ;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
|
|
739 ;;(put 'vc-diff 'menu-enable 'vc-mode)
|
|
740 ;;(put 'vc-update-change-log 'menu-enable
|
|
741 ;; '(member (vc-buffer-backend) '(RCS CVS)))
|
|
742 ;;(put 'vc-print-log 'menu-enable 'vc-mode)
|
|
743 ;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
|
|
744 ;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)
|
|
745 ;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
|
|
746 ;;(put 'vc-next-action 'menu-enable 'vc-mode)
|
|
747 ;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
|
904
|
748
|
|
749 (provide 'vc-hooks)
|
|
750
|
|
751 ;;; vc-hooks.el ends here
|