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