X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b038f9fb955989de99795504c8facfac21e5fbd9..58cb49d471bbe4e9f08145b5909e91f1bdd8142e:/lisp/vc-hooks.el diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 4f26a2e7e7..0d482f01e9 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -1,19 +1,17 @@ ;;; vc-hooks.el --- resident support for version-control ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id$ - ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,20 +37,22 @@ (defvar vc-ignore-vc-files nil) (make-obsolete-variable 'vc-ignore-vc-files - "set `vc-handled-backends' to nil to disable VC.") + "set `vc-handled-backends' to nil to disable VC." + "21.1") (defvar vc-master-templates ()) (make-obsolete-variable 'vc-master-templates "to define master templates for a given BACKEND, use vc-BACKEND-master-templates. To enable or disable VC for a given -BACKEND, use `vc-handled-backends'.") +BACKEND, use `vc-handled-backends'." + "21.1") (defvar vc-header-alist ()) -(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header) +(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header "21.1") (defcustom vc-ignore-dir-regexp ;; Stop SMB, automounter, AFS, and DFS host lookups. - "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\\.\\.\\)/\\)\\'" + locate-dominating-stop-dir-regexp "Regexp matching directory names that are not under VC's control. The default regexp prevents fruitless and time-consuming attempts to determine the VC status in directories in which filenames are @@ -62,7 +60,7 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch MCVS) +(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch) ;; RCS, CVS, SVN and SCCS come first because they are per-dir ;; rather than per-tree. RCS comes first because of the multibackend ;; support intended to use RCS for local commits (with a remote CVS server). @@ -77,6 +75,7 @@ An empty list disables VC altogether." :group 'vc) ;; Note: we don't actually have a darcs back end yet. +;; Also, Meta-CVS (corresponsding to MCVS) is unsupported. (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" ".git" ".hg" ".bzr" "_MTN" "_darcs" "{arch}") @@ -84,10 +83,7 @@ An empty list disables VC altogether." :type '(repeat string) :group 'vc) -(defcustom vc-path - (if (file-directory-p "/usr/sccs") - '("/usr/sccs") - nil) +(defcustom vc-path nil "List of extra directories to search for version control commands." :type '(repeat directory) :group 'vc) @@ -146,24 +142,30 @@ See also variable `vc-consult-headers'." (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file))))) -(defcustom vc-stay-local t +(defcustom vc-stay-local 'only-file "Non-nil means use local operations when possible for remote repositories. This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. +If value is the symbol `only-file' `vc-dir' will connect to the +server, but heuristics will be used to determine the status for +all other VC operations. + The value can also be a regular expression or list of regular expressions to match against the host name of a repository; then VC only stays local for hosts that match it. Alternatively, the value can be a list of regular expressions where the first element is the symbol `except'; then VC always stays local except for hosts matched by these regular expressions." - :type '(choice (const :tag "Always stay local" t) + :type '(choice + (const :tag "Always stay local" t) + (const :tag "Only for file operations" only-file) (const :tag "Don't stay local" nil) (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) (regexp :format " stay local,\n%t: %v" :tag "if it matches") (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) - :version "22.1" + :version "23.1" :group 'vc) (defun vc-stay-local-p (file) @@ -290,8 +292,8 @@ It is usually called via the `vc-call' macro." (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. Functions called by this macro must accept FILE as the first argument. -ARGS specifies any additional arguments. FUN should be unquoted. -BEWARE!! `file' is evaluated twice!!" +ARGS specifies any additional arguments. FUN should be unquoted. +BEWARE!! FILE is evaluated twice!!" `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args)) (defsubst vc-parse-buffer (pattern i) @@ -312,60 +314,31 @@ non-nil if FILE exists and its contents were successfully inserted." (when (file-exists-p file) (if (not limit) (insert-file-contents file) - (if (not blocksize) (setq blocksize 8192)) + (unless blocksize (setq blocksize 8192)) (let ((filepos 0)) (while (and (< 0 (cadr (insert-file-contents file nil filepos (incf filepos blocksize)))) (progn (beginning-of-line) (let ((pos (re-search-forward limit nil 'move))) - (if pos (delete-region (match-beginning 0) - (point-max))) + (when pos (delete-region (match-beginning 0) + (point-max))) (not pos))))))) (set-buffer-modified-p nil) t)) -(defun vc-find-root (file witness &optional invert) +(defun vc-find-root (file witness) "Find the root of a checked out project. The function walks up the directory tree from FILE looking for WITNESS. -If WITNESS if not found, return nil, otherwise return the root. -Optional arg INVERT non-nil reverses the sense of the check; -the root is the last directory for which WITNESS *is* found." - ;; Represent /home/luser/foo as ~/foo so that we don't try to look for - ;; witnesses in /home or in /. - (while (not (file-directory-p file)) - (setq file (file-name-directory (directory-file-name file)))) - (setq file (abbreviate-file-name file)) - (let ((root nil) - (prev-file file) - (user (nth 2 (file-attributes file))) - try) - (while (not (or root - (null file) - ;; As a heuristic, we stop looking up the hierarchy of - ;; directories as soon as we find a directory belonging - ;; to another user. This should save us from looking in - ;; things like /net and /afs. This assumes that all the - ;; files inside a project belong to the same user. - (not (equal user (nth 2 (file-attributes file)))) - (string-match vc-ignore-dir-regexp file))) - (setq try (file-exists-p (expand-file-name witness file))) - (cond ((and invert (not try)) (setq root prev-file)) - ((and (not invert) try) (setq root file)) - ((equal file (setq prev-file file - file (file-name-directory - (directory-file-name file)))) - (setq file nil)))) - ;; Handle the case where ~/WITNESS exists and the original FILE is "~". - ;; (This occurs, for example, when placing dotfiles under RCS.) - (when (and (not root) invert prev-file) - (setq root prev-file)) - root)) +If WITNESS if not found, return nil, otherwise return the root." + (let ((locate-dominating-stop-dir-regexp + (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp))) + (locate-dominating-file file witness))) ;; Access functions to file properties ;; (Properties should be _set_ using vc-file-setprop, but ;; _retrieved_ only through these functions, which decide -;; if the property is already known or not. A property should +;; if the property is already known or not. A property should ;; only be retrieved by vc-file-getprop if there is no ;; access function.) @@ -380,7 +353,8 @@ file was previously registered under a certain backend, then that backend is tried first." (let (handler) (cond - ((and (file-name-directory file) (string-match vc-ignore-dir-regexp (file-name-directory file))) + ((and (file-name-directory file) + (string-match vc-ignore-dir-regexp (file-name-directory file))) nil) ((and (boundp 'file-name-handler-alist) (setq handler (find-file-name-handler file 'vc-registered))) @@ -440,26 +414,23 @@ If the file is not registered, or the master name is not known, return nil." (vc-call-backend (vc-backend file) 'registered file)) (vc-file-getprop file 'vc-name)))) -(defun vc-checkout-model (file) - "Indicate how FILE is checked out. +(defun vc-checkout-model (backend files) + "Indicate how FILES are checked out. -If FILE is not registered, this function always returns nil. +If FILES are not registered, this function always returns nil. For registered files, the possible values are: - 'implicit FILE is always writeable, and checked out `implicitly' + 'implicit FILES are always writable, and checked out `implicitly' when the user saves the first changes to the file. - 'locking FILE is read-only if up-to-date; user must type + 'locking FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. Strict locking is assumed. - 'announce FILE is read-only if up-to-date; user must type + 'announce FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. But other users may be editing at the same time." - (or (vc-file-getprop file 'vc-checkout-model) - (if (vc-backend file) - (vc-file-setprop file 'vc-checkout-model - (vc-call checkout-model file))))) + (vc-call-backend backend 'checkout-model files)) (defun vc-user-login-name (file) "Return the name under which the user accesses the given FILE." @@ -494,7 +465,7 @@ For registered files, the value returned is one of: USER The current version of the working file is locked by some other USER (a string). - 'needs-patch The file has not been edited by the user, but there is + 'needs-update The file has not been edited by the user, but there is a more recent version on the current branch stored in the master file. @@ -516,47 +487,45 @@ For registered files, the value returned is one of: 'removed Scheduled to be deleted from the repository on next commit. - 'ignored The file showed up in a dir-state listing with a flag + 'conflict The file contains conflicts as the result of a merge. + For now the conflicts are text conflicts. In the + future this might be extended to deal with metadata + conflicts too. + + 'missing The file is not present in the file system, but the VC + system still tracks it. + + 'ignored The file showed up in a dir-status listing with a flag indicating the version-control system is ignoring it, Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume that any file with vc-state nil might be ignorable without VC knowing it. - 'unregistered The file showed up in a dir-state listing with a flag - indicating that it is not under version control. - Note: This property is not set reliably (some VCSes - don't have useful directory-status commands) so assume - that any file with vc-state nil might be unregistered - without VC knowing it. + 'unregistered The file is not under version control. A return of nil from this function means we have no information on the -status of this file. -" - ;; Note: in Emacs 22 and older, return of nil meant the file was unregistered. - ;; This is potentially a source of backward-compatibility bugs. +status of this file." + ;; Note: in Emacs 22 and older, return of nil meant the file was + ;; unregistered. This is potentially a source of + ;; backward-compatibility bugs. ;; FIXME: New (sub)states needed (?): - ;; - `conflict' (i.e. `edited' with conflict markers) - ;; - `removed' ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) - (if (and (> (length file) 0) (vc-backend file)) - (vc-file-setprop file 'vc-state - (vc-call state-heuristic file))))) - -(defun vc-recompute-state (file) - "Recompute the version control state of FILE, and return it. -This calls the possibly expensive function vc-BACKEND-state, -rather than the heuristic." - (vc-file-setprop file 'vc-state (vc-call state file))) + (when (> (length file) 0) + (let ((backend (vc-backend file))) + (when backend + (vc-file-setprop + file 'vc-state + (vc-call-backend backend 'state-heuristic file))))))) (defsubst vc-up-to-date-p (file) "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." (eq (vc-state file) 'up-to-date)) (defun vc-default-state-heuristic (backend file) - "Default implementation of vc-state-heuristic. + "Default implementation of vc-BACKEND-state-heuristic. It simply calls the real state computation function `vc-BACKEND-state' and does not employ any heuristic at all." (vc-call-backend backend 'state file)) @@ -565,13 +534,16 @@ and does not employ any heuristic at all." "Return non-nil if FILE has not changed since the last checkout." (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (nth 5 (file-attributes file)))) + ;; This is a shortcut for determining when the workfile is + ;; unchanged. It can fail under some circumstances; see the + ;; discussion in bug#694. (if (and checkout-time - ;; Tramp and Ange-FTP return this when they don't know the time. - (not (equal lastmod '(0 0)))) - (equal checkout-time lastmod) + ;; Tramp and Ange-FTP return this when they don't know the time. + (not (equal lastmod '(0 0)))) + (equal checkout-time lastmod) (let ((unchanged (vc-call workfile-unchanged-p file))) - (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) - unchanged)))) + (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) + unchanged)))) (defun vc-default-workfile-unchanged-p (backend file) "Check if FILE is unchanged by diffing against the master version. @@ -579,26 +551,27 @@ Return non-nil if FILE is unchanged." (zerop (condition-case err ;; If the implementation supports it, let the output ;; go to *vc*, not *vc-diff*, since this is an internal call. - (vc-call diff (list file) nil nil "*vc*") + (vc-call-backend backend 'diff (list file) nil nil "*vc*") (wrong-number-of-arguments ;; If this error came from the above call to vc-BACKEND-diff, ;; try again without the optional buffer argument (for ;; backward compatibility). Otherwise, resignal. (if (or (not (eq (cadr err) (indirect-function - (vc-find-backend-function (vc-backend file) - 'diff)))) + (vc-find-backend-function backend 'diff)))) (not (eq (caddr err) 4))) (signal (car err) (cdr err)) - (vc-call diff (list file))))))) + (vc-call-backend backend 'diff (list file))))))) (defun vc-working-revision (file) "Return the repository version from which FILE was checked out. If FILE is not registered, this function always returns nil." (or (vc-file-getprop file 'vc-working-revision) - (if (vc-backend file) + (let ((backend (vc-backend file))) + (when backend (vc-file-setprop file 'vc-working-revision - (vc-call working-revision file))))) + (vc-call-backend backend 'working-revision file)))))) + ;; Backward compatibility. (define-obsolete-function-alias 'vc-workfile-version 'vc-working-revision "23.1") @@ -658,17 +631,17 @@ this function." (mapcar (lambda (s) (let ((trial (vc-possible-master s dirname basename))) - (if (and trial (file-exists-p trial) - ;; Make sure the file we found with name - ;; TRIAL is not the source file itself. - ;; That can happen with RCS-style names if - ;; the file name is truncated (e.g. to 14 - ;; chars). See if either directory or - ;; attributes differ. - (or (not (string= dirname - (file-name-directory trial))) - (not (equal (file-attributes file) - (file-attributes trial))))) + (when (and trial (file-exists-p trial) + ;; Make sure the file we found with name + ;; TRIAL is not the source file itself. + ;; That can happen with RCS-style names if + ;; the file name is truncated (e.g. to 14 + ;; chars). See if either directory or + ;; attributes differ. + (or (not (string= dirname + (file-name-directory trial))) + (not (equal (file-attributes file) + (file-attributes trial))))) (throw 'found trial)))) templates)))) @@ -676,19 +649,17 @@ this function." "Change read-only status of current buffer, perhaps via version control. If the buffer is visiting a file registered with version control, -then check the file in or out. Otherwise, just change the read-only flag -of the buffer. -With prefix argument, ask for version number to check in or check out. -Check-out of a specified version number does not lock the file; -to do that, use this command a second time with no argument. - -If you bind this function to \\[toggle-read-only], then Emacs checks files -in or out whenever you toggle the read-only flag." +throw an error, because this is not a safe or really meaningful operation +on any version-control system newer than RCS. + +Otherwise, just change the read-only flag of the buffer. + +If you bind this function to \\[toggle-read-only], then Emacs +will properly intercept all attempts to toggle the read-only flag +on version-controlled buffer." (interactive "P") - (if (or (and (boundp 'vc-dired-mode) vc-dired-mode) - ;; use boundp because vc.el might not be loaded - (vc-backend buffer-file-name)) - (vc-next-action verbose) + (if (vc-backend buffer-file-name) + (error "Toggling the readability of a version controlled file is likely to wreak havoc.") (toggle-read-only))) (defun vc-default-make-version-backups-p (backend file) @@ -741,22 +712,25 @@ Before doing that, check if there are any old backups and get rid of them." ;; If the file on disk is still in sync with the repository, ;; and version backups should be made, copy the file to ;; another name. This enables local diffs and local reverting. - (let ((file buffer-file-name)) - (and (vc-backend file) - (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) - (vc-call make-version-backups-p file) - (vc-make-version-backup file)))) + (let ((file buffer-file-name) + backend) + (ignore-errors ;Be careful not to prevent saving the file. + (and (setq backend (vc-backend file)) + (vc-up-to-date-p file) + (eq (vc-checkout-model backend (list file)) 'implicit) + (vc-call-backend backend 'make-version-backups-p file) + (vc-make-version-backup file))))) -(declare-function vc-dired-resynch-file "vc" (file)) +(declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) (defun vc-after-save () "Function to be called by `basic-save-buffer' (in files.el)." ;; If the file in the current buffer is under version control, ;; up-to-date, and locking is not used for the file, set ;; the state to 'edited and redisplay the mode line. - (let ((file buffer-file-name)) - (and (vc-backend file) + (let* ((file buffer-file-name) + (backend (vc-backend file))) + (and backend (or (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) ;; File has been saved in the same second in which @@ -765,13 +739,13 @@ Before doing that, check if there are any old backups and get rid of them." (vc-file-setprop file 'vc-checkout-time nil)) t) (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) + (eq (vc-checkout-model backend (list file)) 'implicit) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file) - (if (featurep 'vc) - ;; If VC is not loaded, then there can't be - ;; any VC Dired buffer to synchronize. - (vc-dired-resynch-file file))))) + ;; Try to avoid unnecessary work, a *vc-dir* buffer is only + ;; present if this is true. + (when (memq 'vc-dir-resynch-file after-save-hook) + (vc-dir-resynch-file file))))) (defvar vc-menu-entry '(menu-item "Version Control" vc-menu-map @@ -796,7 +770,7 @@ visiting FILE." (let ((backend (vc-backend file))) (if (not backend) (setq vc-mode nil) - (let* ((ml-string (vc-call mode-line-string file)) + (let* ((ml-string (vc-call-backend backend 'mode-line-string file)) (ml-echo (get-text-property 0 'help-echo ml-string))) (setq vc-mode (concat @@ -821,9 +795,9 @@ visiting FILE." ;; If the user is root, and the file is not owner-writable, ;; then pretend that we can't write it ;; even though we can (because root can write anything). - ;; This way, even root cannot modify a file that isn't locked. - (and (equal file buffer-file-name) - (not buffer-read-only) + ;; This way, even root cannot modify a file that isn't locked. + (and (equal file buffer-file-name) + (not buffer-read-only) (zerop (user-real-uid)) (zerop (logand (file-modes buffer-file-name) 128)) (setq buffer-read-only t))) @@ -845,16 +819,28 @@ This function assumes that the file is registered." (rev (vc-working-revision file))) (propertize (cond ((or (eq state 'up-to-date) - (eq state 'needs-patch)) + (eq state 'needs-update)) (setq state-echo "Up to date file") (concat backend "-" rev)) ((stringp state) (setq state-echo (concat "File locked by" state)) (concat backend ":" state ":" rev)) + ((eq state 'added) + (setq state-echo "Locally added file") + (concat backend "@" rev)) + ((eq state 'conflict) + (setq state-echo "File contains conflicts after the last merge") + (concat backend "!" rev)) + ((eq state 'removed) + (setq state-echo "File removed from the VC system") + (concat backend "!" rev)) + ((eq state 'missing) + (setq state-echo "File tracked by the VC system, but missing from the file system") + (concat backend "?" rev)) (t ;; Not just for the 'edited state, but also a fallback ;; for all other states. Think about different symbols - ;; for 'needs-patch and 'needs-merge. + ;; for 'needs-update and 'needs-merge. (setq state-echo "Locally modified file") (concat backend ":" rev))) 'help-echo (concat state-echo " under the " backend @@ -864,11 +850,10 @@ This function assumes that the file is registered." "If current buffer visits a symbolic link, visit the real file. If the real file is already visited in another buffer, make that buffer current, and kill the buffer that visits the link." - (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name))) - (true-buffer (find-buffer-visiting truename)) + (let* ((true-buffer (find-buffer-visiting buffer-file-truename)) (this-buffer (current-buffer))) (if (eq true-buffer this-buffer) - (progn + (let ((truename buffer-file-truename)) (kill-buffer this-buffer) ;; In principle, we could do something like set-visited-file-name. ;; However, it can't be exactly the same as set-visited-file-name. @@ -888,6 +873,7 @@ current, and kill the buffer that visits the link." (setq vc-mode nil)) (when buffer-file-name (vc-file-clearprops buffer-file-name) + (add-hook 'mode-line-hook 'vc-mode-line nil t) (cond ((with-demoted-errors (vc-backend buffer-file-name)) ;; Compute the state and put it in the modeline. @@ -898,8 +884,8 @@ current, and kill the buffer that visits the link." (set (make-local-variable 'backup-inhibited) t)) ;; Let the backend setup any buffer-local things he needs. (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook)) - ((let ((link-type (and (file-symlink-p buffer-file-name) - (vc-backend (file-chase-links buffer-file-name))))) + ((let ((link-type (and (not (equal buffer-file-name buffer-file-truename)) + (vc-backend buffer-file-truename)))) (cond ((not link-type) nil) ;Nothing to do. ((eq vc-follow-symlinks nil) (message @@ -935,9 +921,12 @@ Returns t if checkout was successful, nil otherwise. Used in `find-file-not-found-functions'." ;; When a file does not exist, ignore cached info about it ;; from a previous visit. - (vc-file-clearprops buffer-file-name) - (let ((backend (vc-backend buffer-file-name))) - (if backend (vc-call-backend backend 'find-file-not-found-hook)))) + ;; We check that `buffer-file-name' is non-nil. It should be always + ;; the case, but in conjunction with Tramp, it might be nil. M. Albinus. + (when buffer-file-name + (vc-file-clearprops buffer-file-name) + (let ((backend (vc-backend buffer-file-name))) + (when backend (vc-call-backend backend 'find-file-not-found-hook))))) (defun vc-default-find-file-not-found-hook (backend) ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only @@ -948,8 +937,7 @@ Used in `find-file-not-found-functions'." (defun vc-kill-buffer-hook () "Discard VC info about a file when we kill its buffer." - (if buffer-file-name - (vc-file-clearprops buffer-file-name))) + (when buffer-file-name (vc-file-clearprops buffer-file-name))) (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) @@ -965,21 +953,19 @@ Used in `find-file-not-found-functions'." (define-key map "a" 'vc-update-change-log) (define-key map "b" 'vc-switch-backend) (define-key map "c" 'vc-rollback) - (define-key map "d" 'vc-directory) + (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) (define-key map "h" 'vc-insert-headers) (define-key map "i" 'vc-register) (define-key map "l" 'vc-print-log) (define-key map "m" 'vc-merge) - (define-key map "r" 'vc-retrieve-snapshot) - (define-key map "s" 'vc-create-snapshot) + (define-key map "r" 'vc-retrieve-tag) + (define-key map "s" 'vc-create-tag) (define-key map "u" 'vc-revert) (define-key map "v" 'vc-next-action) (define-key map "+" 'vc-update) (define-key map "=" 'vc-diff) (define-key map "~" 'vc-revision-other-window) - ;; `vc-status' is a not-quite-ready replacement for `vc-directory' - ;; (define-key map "?" 'vc-status) map)) (fset 'vc-prefix-map vc-prefix-map) (define-key global-map "\C-xv" 'vc-prefix-map) @@ -988,17 +974,12 @@ Used in `find-file-not-found-functions'." (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] ;; '("Show Files under VC" . (vc-directory t))) - (define-key map [vc-retrieve-snapshot] - '(menu-item "Retrieve Snapshot" vc-retrieve-snapshot - :help "Retrieve snapshot")) - (define-key map [vc-create-snapshot] - '(menu-item "Create Snapshot" vc-create-snapshot - :help "Create Snapshot")) - (define-key map [vc-directory] - '(menu-item "VC Directory Listing" vc-directory - :help "Show the VC status of files in a directory")) - ;; `vc-status' is a not-quite-ready replacement for `vc-directory' - ;; (define-key map [vc-status] '("VC Status" . vc-status)) + (define-key map [vc-retrieve-tag] + '(menu-item "Retrieve Tag" vc-retrieve-tag + :help "Retrieve tagged version or branch")) + (define-key map [vc-create-tag] + '(menu-item "Create Tag" vc-create-tag + :help "Create version tag")) (define-key map [separator1] '("----")) (define-key map [vc-annotate] '(menu-item "Annotate" vc-annotate @@ -1038,16 +1019,25 @@ Used in `find-file-not-found-functions'." (define-key map [vc-register] '(menu-item "Register" vc-register :help "Register file set into a version control system")) + (define-key map [vc-dir] + '(menu-item "VC Dir" vc-dir + :help "Show the VC status of files in a directory")) map)) (defalias 'vc-menu-map vc-menu-map) +(declare-function vc-responsible-backend "vc" (file &optional register)) + (defun vc-menu-map-filter (orig-binding) (if (and (symbolp orig-binding) (fboundp orig-binding)) (setq orig-binding (indirect-function orig-binding))) (let ((ext-binding - (if vc-mode (vc-call-backend (vc-backend buffer-file-name) - 'extra-menu)))) + (when vc-mode + (vc-call-backend + (if buffer-file-name + (vc-backend buffer-file-name) + (vc-responsible-backend default-directory)) + 'extra-menu)))) ;; Give the VC backend a chance to add menu entries ;; specific for that backend. (if (null ext-binding) @@ -1059,23 +1049,6 @@ Used in `find-file-not-found-functions'." (defun vc-default-extra-menu (backend) nil) -;; These are not correct and it's not currently clear how doing it -;; better (with more complicated expressions) might slow things down -;; on older systems. - -;;(put 'vc-rename-file 'menu-enable 'vc-mode) -;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS)) -;;(put 'vc-revision-other-window 'menu-enable 'vc-mode) -;;(put 'vc-diff 'menu-enable 'vc-mode) -;;(put 'vc-update-change-log 'menu-enable -;; '(member (vc-buffer-backend) '(RCS CVS))) -;;(put 'vc-print-log 'menu-enable 'vc-mode) -;;(put 'vc-rollback 'menu-enable 'vc-mode) -;;(put 'vc-revert 'menu-enable 'vc-mode) -;;(put 'vc-insert-headers 'menu-enable 'vc-mode) -;;(put 'vc-next-action 'menu-enable 'vc-mode) -;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) - (provide 'vc-hooks) ;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32