]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-hooks.el
(dired-mode-map): Fix menu text of image-dired-display-thumbs.
[gnu-emacs] / lisp / vc-hooks.el
index e28a01d35e6f4a07e392b88fd4f77db16be3df8e..2ccbdcc56715c8688dd53041d97d4eb190414da3 100644 (file)
@@ -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 Free Software Foundation, Inc.
+;;   2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
-;; $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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 (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.
@@ -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).
@@ -76,10 +74,16 @@ An empty list disables VC altogether."
   :version "23.1"
   :group 'vc)
 
-(defcustom vc-path
-  (if (file-directory-p "/usr/sccs")
-      '("/usr/sccs")
-    nil)
+;; 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}")
+  "List of directory names to be ignored when walking directory trees."
+  :type '(repeat string)
+  :group 'vc)
+
+(defcustom vc-path nil
   "List of extra directories to search for version control commands."
   :type '(repeat directory)
   :group 'vc)
@@ -282,8 +286,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))
 \f
 (defsubst vc-parse-buffer (pattern i)
@@ -304,30 +308,35 @@ 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)
+(defun vc-find-root (file witness &optional invert)
   "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."
+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)
-        (user (nth 2 (file-attributes file))))
+        (prev-file file)
+        ;; `user' is not initialized outside the loop because
+        ;; `file' may not exist, so we may have to walk up part of the
+        ;; hierarchy before we find the "initial UID".
+        (user nil)
+        try)
     (while (not (or root
                     (null file)
                     ;; As a heuristic, we stop looking up the hierarchy of
@@ -335,19 +344,27 @@ If WITNESS if not found, return nil, otherwise return the root."
                     ;; 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))))
+                    (let ((prev-user user))
+                      (setq user (nth 2 (file-attributes file)))
+                      (and prev-user (not (equal user prev-user))))
                     (string-match vc-ignore-dir-regexp file)))
-      (if (file-exists-p (expand-file-name witness file))
-          (setq root file)
-        (if (equal file
-                   (setq file (file-name-directory (directory-file-name file))))
-            (setq file nil))))
+      (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))
 
 ;; 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.)
 
@@ -422,26 +439,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 writeable, 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."
@@ -476,7 +490,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.
 
@@ -485,35 +499,58 @@ For registered files, the value returned is one of:
                      the master file.  This state can only occur if locking
                      is not used for the file.
 
-  'unlocked-changes  The current version of the working file is not locked,
+  'unlocked-changes  The working version of the file is not locked,
                      but the working file has been changed with respect
                      to that version.  This state can only occur for files
                      with locking; it represents an erroneous condition that
                      should be resolved by the user (vc-next-action will
-                     prompt the user to do it)."
+                     prompt the user to do it).
+
+  'added             Scheduled to go into the repository on the next commit.
+                     Often represented by vc-working-revision = \"0\" in VCSes
+                     with monotonic IDs like Subversion and Mercurial.
+
+  'removed           Scheduled to be deleted from the repository on next commit.
+
+  '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 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.
+
   ;; FIXME: New (sub)states needed (?):
-  ;; - `added' (i.e. `edited' but with no base version yet,
-  ;;            typically represented by vc-working-revision = "0")
-  ;; - `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))
@@ -536,29 +573,32 @@ 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")
+(define-obsolete-function-alias
+  'vc-previous-version 'vc-previous-revision "23.1")
 (defun vc-default-working-revision (backend file)
   (message
    "`working-revision' not found: using the old `workfile-version' instead")
@@ -615,17 +655,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))))
 
@@ -633,19 +673,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)
@@ -698,20 +736,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-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
@@ -720,13 +763,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
@@ -751,7 +794,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
@@ -761,7 +804,7 @@ visiting FILE."
                  (propertize
                   ml-string
                   'mouse-face 'mode-line-highlight
-                  'help-echo 
+                  'help-echo
                   (concat (or ml-echo
                               (format "File under the %s version control system"
                                       backend))
@@ -776,9 +819,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)))
@@ -800,16 +843,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
@@ -843,6 +898,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.
@@ -892,7 +948,7 @@ Used in `find-file-not-found-functions'."
   ;; 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))))
+    (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
@@ -903,8 +959,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)
 
@@ -920,14 +975,14 @@ 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)
@@ -941,40 +996,70 @@ 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]
-      '("Retrieve Snapshot" . vc-retrieve-snapshot))
-    (define-key map [vc-create-snapshot]
-      '("Create Snapshot" . vc-create-snapshot))
-    (define-key map [vc-directory] '("VC Directory Listing" . vc-directory))
+    (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] '("Annotate" . vc-annotate))
-    (define-key map [vc-rename-file] '("Rename File" . vc-rename-file))
+    (define-key map [vc-annotate]
+      '(menu-item "Annotate" vc-annotate
+                 :help "Display the edit history of the current file using colors"))
+    (define-key map [vc-rename-file]
+      '(menu-item "Rename File" vc-rename-file
+                 :help "Rename file"))
     (define-key map [vc-revision-other-window]
-      '("Show Other Version" . vc-revision-other-window))
-    (define-key map [vc-diff] '("Compare with Base Version" . vc-diff))
+      '(menu-item "Show Other Version" vc-revision-other-window
+                 :help "Visit another version of the current file in another window"))
+    (define-key map [vc-diff]
+      '(menu-item "Compare with Base Version" vc-diff
+                 :help "Compare file set with the base version"))
     (define-key map [vc-update-change-log]
-      '("Update ChangeLog" . vc-update-change-log))
-    (define-key map [vc-print-log] '("Show History" . vc-print-log))
+      '(menu-item "Update ChangeLog" vc-update-change-log
+                 :help "Find change log file and add entries from recent version control logs"))
+    (define-key map [vc-print-log]
+      '(menu-item "Show History" vc-print-log
+                 :help "List the change log of the current file set in a window"))
     (define-key map [separator2] '("----"))
     (define-key map [vc-insert-header]
-      '("Insert Header" . vc-insert-headers))
-    (define-key map [undo] '("Undo Last Check-In" . vc-rollback))
+      '(menu-item "Insert Header" vc-insert-headers
+                 :help "Insert headers into a file for use with a version control system.
+"))
+    (define-key map [undo]
+      '(menu-item "Undo Last Check-In" vc-rollback
+                 :help "Remove the most recent changeset committed to the repository"))
     (define-key map [vc-revert]
-      '("Revert to Base Version" . vc-revert))
+      '(menu-item "Revert to Base Version" vc-revert
+                 :help "Revert working copies of the selected file set to their repository contents"))
     (define-key map [vc-update]
-      '("Update to Latest Version" . vc-update))
-    (define-key map [vc-next-action] '("Check In/Out" . vc-next-action))
-    (define-key map [vc-register] '("Register" . vc-register))
+      '(menu-item "Update to Latest Version" vc-update
+                 :help "Update the current fileset's files to their tip revisions"))
+    (define-key map [vc-next-action]
+      '(menu-item "Check In/Out"  vc-next-action
+                 :help "Do the next logical version control operation on the current fileset"))
+    (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)