Partially undo the dispatcher split, it needs to happen more gradually

to avoid breaking things.

2 files changed, 1393 insertions, 1401 deletions

diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el
index 765b8f58e2b..6afe2eeb8e5 100644
--- a/lisp/vc-dispatcher.el
+++ b/lisp/vc-dispatcher.el
@@ -76,52 +76,6 @@
 
 (provide 'vc-dispatcher)
 
-(eval-when-compile
-  (require 'cl)
-  (require 'dired)      ; for dired-map-over-marks macro
-  (require 'dired-aux)) ; for dired-kill-{line,tree}
-
-(defcustom vc-delete-logbuf-window t
-  "If non-nil, delete the *VC-log* buffer and window after each logical action.
-If nil, bury that buffer instead.
-This is most useful if you have multiple windows on a frame and would like to
-preserve the setting."
-  :type 'boolean
-  :group 'vc)
-
-(defcustom vc-command-messages nil
-  "If non-nil, display run messages from back-end commands."
-  :type 'boolean
-  :group 'vc)
-
-(defcustom vc-dired-listing-switches "-al"
-  "Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
-  :type 'string
-  :group 'vc
-  :version "21.1")
-
-(defcustom vc-dired-recurse t
-  "If non-nil, show directory trees recursively in VC Dired."
-  :type 'boolean
-  :group 'vc
-  :version "20.3")
-
-(defcustom vc-dired-terse-display t
-  "If non-nil, show only locked or locally modified files in VC Dired."
-  :type 'boolean
-  :group 'vc
-  :version "20.3")
-
-(defcustom vc-dir-mode-hook nil
-  "Normal hook run by `vc-dir-mode'.
-See `run-hooks'."
-  :type 'hook
-  :group 'vc)
-
-(defvar vc-log-fileset)
-(defvar vc-dired-mode nil)
-(make-variable-buffer-local 'vc-dired-mode)
-
 ;; Common command execution logic
 
 (defun vc-process-filter (p s)
@@ -273,7 +227,7 @@ that is inserted into the command line before the filename."
                   (and (stringp buffer)
                        (string= (buffer-name) buffer))
                   (eq buffer (current-buffer)))
-        (vc-setup-buffer buffer))
+        (vc-setup-buffer (or buffer "*vc*")))
       ;; If there's some previous async process still running, just kill it.
       (let ((oldproc (get-buffer-process (current-buffer))))
         ;; If we wanted to wait for oldproc to finish before doing
@@ -333,1356 +287,4 @@ that is inserted into the command line before the filename."
                               ',command ',file-or-list ',flags))
         status))))
 
-;; Context management
-
-(defun vc-position-context (posn)
-  "Save a bit of the text around POSN in the current buffer.
-Used to help us find the corresponding position again later
-if markers are destroyed or corrupted."
-  ;; A lot of this was shamelessly lifted from Sebastian Kremer's
-  ;; rcs.el mode.
-  (list posn
-        (buffer-size)
-        (buffer-substring posn
-                          (min (point-max) (+ posn 100)))))
-
-(defun vc-find-position-by-context (context)
-  "Return the position of CONTEXT in the current buffer.
-If CONTEXT cannot be found, return nil."
-  (let ((context-string (nth 2 context)))
-    (if (equal "" context-string)
-        (point-max)
-      (save-excursion
-        (let ((diff (- (nth 1 context) (buffer-size))))
-          (when (< diff 0) (setq diff (- diff)))
-          (goto-char (nth 0 context))
-          (if (or (search-forward context-string nil t)
-                  ;; Can't use search-backward since the match may continue
-                  ;; after point.
-                  (progn (goto-char (- (point) diff (length context-string)))
-                         ;; goto-char doesn't signal an error at
-                         ;; beginning of buffer like backward-char would
-                         (search-forward context-string nil t)))
-              ;; to beginning of OSTRING
-              (- (point) (length context-string))))))))
-
-(defun vc-context-matches-p (posn context)
-  "Return t if POSN matches CONTEXT, nil otherwise."
-  (let* ((context-string (nth 2 context))
-         (len (length context-string))
-         (end (+ posn len)))
-    (if (> end (1+ (buffer-size)))
-        nil
-      (string= context-string (buffer-substring posn end)))))
-
-(defun vc-buffer-context ()
-  "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
-Used by `vc-restore-buffer-context' to later restore the context."
-  (let ((point-context (vc-position-context (point)))
-        ;; Use mark-marker to avoid confusion in transient-mark-mode.
-        (mark-context  (when (eq (marker-buffer (mark-marker)) (current-buffer))
-                         (vc-position-context (mark-marker))))
-        ;; Make the right thing happen in transient-mark-mode.
-        (mark-active nil)
-        ;; The new compilation code does not use compilation-error-list any
-        ;; more, so the code below is now ineffective and might as well
-        ;; be disabled.  -- Stef
-        ;; ;; We may want to reparse the compilation buffer after revert
-        ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded
-        ;;            ;; Construct a list; each elt is nil or a buffer
-        ;;            ;; if that buffer is a compilation output buffer
-        ;;            ;; that contains markers into the current buffer.
-        ;;            (save-current-buffer
-        ;;              (mapcar (lambda (buffer)
-        ;;                        (set-buffer buffer)
-        ;;                        (let ((errors (or
-        ;;                                       compilation-old-error-list
-        ;;                                       compilation-error-list))
-        ;;                              (buffer-error-marked-p nil))
-        ;;                          (while (and (consp errors)
-        ;;                                      (not buffer-error-marked-p))
-        ;;                            (and (markerp (cdr (car errors)))
-        ;;                                 (eq buffer
-        ;;                                     (marker-buffer
-        ;;                                      (cdr (car errors))))
-        ;;                                 (setq buffer-error-marked-p t))
-        ;;                            (setq errors (cdr errors)))
-        ;;                          (if buffer-error-marked-p buffer)))
-        ;;                      (buffer-list)))))
-        (reparse nil))
-    (list point-context mark-context reparse)))
-
-(defun vc-restore-buffer-context (context)
-  "Restore point/mark, and reparse any affected compilation buffers.
-CONTEXT is that which `vc-buffer-context' returns."
-  (let ((point-context (nth 0 context))
-        (mark-context (nth 1 context))
-        ;; (reparse (nth 2 context))
-        )
-    ;; The new compilation code does not use compilation-error-list any
-    ;; more, so the code below is now ineffective and might as well
-    ;; be disabled.  -- Stef
-    ;; ;; Reparse affected compilation buffers.
-    ;; (while reparse
-    ;;   (if (car reparse)
-    ;;    (with-current-buffer (car reparse)
-    ;;      (let ((compilation-last-buffer (current-buffer)) ;select buffer
-    ;;            ;; Record the position in the compilation buffer of
-    ;;            ;; the last error next-error went to.
-    ;;            (error-pos (marker-position
-    ;;                        (car (car-safe compilation-error-list)))))
-    ;;        ;; Reparse the error messages as far as they were parsed before.
-    ;;        (compile-reinitialize-errors '(4) compilation-parsing-end)
-    ;;        ;; Move the pointer up to find the error we were at before
-    ;;        ;; reparsing.  Now next-error should properly go to the next one.
-    ;;        (while (and compilation-error-list
-    ;;                    (/= error-pos (car (car compilation-error-list))))
-    ;;          (setq compilation-error-list (cdr compilation-error-list))))))
-    ;;   (setq reparse (cdr reparse)))
-
-    ;; if necessary, restore point and mark
-    (if (not (vc-context-matches-p (point) point-context))
-        (let ((new-point (vc-find-position-by-context point-context)))
-          (when new-point (goto-char new-point))))
-    (and mark-active
-         mark-context
-         (not (vc-context-matches-p (mark) mark-context))
-         (let ((new-mark (vc-find-position-by-context mark-context)))
-           (when new-mark (set-mark new-mark))))))
-
-(defvar vc-dired-window-configuration)
-
-;; Command closures
-
-;; FIXME: The rev argument is VCS-specific and needs to be factored out   
-(defun vc-start-entry (files rev comment initial-contents msg action &optional after-hook)
-  "Accept a comment for an operation on FILES revision REV.
-If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
-action on close to ACTION.  If COMMENT is a string and
-INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
-contents of the log entry buffer.  If COMMENT is a string and
-INITIAL-CONTENTS is nil, do action immediately as if the user had
-entered COMMENT.  If COMMENT is t, also do action immediately with an
-empty comment.  Remember the file's buffer in `vc-parent-buffer'
-\(current one if no file).  AFTER-HOOK specifies the local value
-for `vc-log-after-operation-hook'."
-  (let ((parent
-         (if (or (eq major-mode 'vc-dired-mode) (eq major-mode 'vc-dir-mode))
-             ;; If we are called from VC dired, the parent buffer is
-             ;; the current buffer.
-             (current-buffer)
-           (if (and files (equal (length files) 1))
-               (get-file-buffer (car files))
-             (current-buffer)))))
-    (when vc-before-checkin-hook
-      (if files
-          (with-current-buffer parent
-            (run-hooks 'vc-before-checkin-hook))
-        (run-hooks 'vc-before-checkin-hook)))
-    (if (and comment (not initial-contents))
-        (set-buffer (get-buffer-create "*VC-log*"))
-      (pop-to-buffer (get-buffer-create "*VC-log*")))
-    (set (make-local-variable 'vc-parent-buffer) parent)
-    (set (make-local-variable 'vc-parent-buffer-name)
-         (concat " from " (buffer-name vc-parent-buffer)))
-    ;;(if file (vc-mode-line file))
-    (vc-log-edit files)
-    (make-local-variable 'vc-log-after-operation-hook)
-    (when after-hook
-      (setq vc-log-after-operation-hook after-hook))
-    (setq vc-log-operation action)
-    (setq vc-log-revision rev)
-    (when comment
-      (erase-buffer)
-      (when (stringp comment) (insert comment)))
-    (if (or (not comment) initial-contents)
-        (message "%s  Type C-c C-c when done" msg)
-      (vc-finish-logentry (eq comment t)))))
-
-(defun vc-finish-logentry (&optional nocomment)
-  "Complete the operation implied by the current log entry.
-Use the contents of the current buffer as a check-in or registration
-comment.  If the optional arg NOCOMMENT is non-nil, then don't check
-the buffer contents as a comment."
-  (interactive)
-  ;; Check and record the comment, if any.
-  (unless nocomment
-    (run-hooks 'vc-logentry-check-hook))
-  ;; Sync parent buffer in case the user modified it while editing the comment.
-  ;; But not if it is a vc-dired buffer.
-  (with-current-buffer vc-parent-buffer
-    (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
-  (unless vc-log-operation
-    (error "No log operation is pending"))
-  ;; save the parameters held in buffer-local variables
-  (let ((log-operation vc-log-operation)
-        (log-fileset vc-log-fileset)
-        (log-revision vc-log-revision)
-        (log-entry (buffer-string))
-        (after-hook vc-log-after-operation-hook)
-        (tmp-vc-parent-buffer vc-parent-buffer))
-    (pop-to-buffer vc-parent-buffer)
-    ;; OK, do it to it
-    (save-excursion
-      (funcall log-operation
-               log-fileset
-               log-revision
-               log-entry))
-    ;; Remove checkin window (after the checkin so that if that fails
-    ;; we don't zap the *VC-log* buffer and the typing therein).
-    ;; -- IMO this should be replaced with quit-window
-    (let ((logbuf (get-buffer "*VC-log*")))
-      (cond ((and logbuf vc-delete-logbuf-window)
-             (delete-windows-on logbuf (selected-frame))
-             ;; Kill buffer and delete any other dedicated windows/frames.
-             (kill-buffer logbuf))
-            (logbuf (pop-to-buffer "*VC-log*")
-                    (bury-buffer)
-                    (pop-to-buffer tmp-vc-parent-buffer))))
-    ;; Now make sure we see the expanded headers
-    (when log-fileset
-      (mapc
-       (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
-       log-fileset))
-    (when vc-dired-mode
-      (dired-move-to-filename))
-    (when (eq major-mode 'vc-dir-mode)
-      (vc-dir-move-to-goal-column))
-    (run-hooks after-hook 'vc-finish-logentry-hook)))
-
-;; The VC directory major mode.  Coopt Dired for this.
-;; All VC commands get mapped into logical equivalents.
-
-(defvar vc-dired-switches)
-(defvar vc-dired-terse-mode)
-
-(defvar vc-dired-mode-map
-  (let ((map (make-sparse-keymap))
-        (vmap (make-sparse-keymap)))
-    (define-key map "\C-xv" vmap)
-    (define-key map "v" vmap)
-    (set-keymap-parent vmap vc-prefix-map)
-    (define-key vmap "t" 'vc-dired-toggle-terse-mode)
-    map))
-
-(define-derived-mode vc-dired-mode dired-mode "Dired under "
-  "The major mode used in VC directory buffers.
-
-It works like Dired, but lists only files under version control, with
-the current VC state of each file being indicated in the place of the
-file's link count, owner, group and size.  Subdirectories are also
-listed, and you may insert them into the buffer as desired, like in
-Dired.
-
-All Dired commands operate normally, with the exception of `v', which
-is redefined as the version control prefix, so that you can type
-`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
-the file named in the current Dired buffer line.  `vv' invokes
-`vc-next-action' on this file, or on all files currently marked.
-There is a special command, `*l', to mark all files currently locked."
-  ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
-  ;; We do it here because dired might not be loaded yet
-  ;; when vc-dired-mode-map is initialized.
-  (set-keymap-parent vc-dired-mode-map dired-mode-map)
-  (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
-  ;; The following is slightly modified from files.el,
-  ;; because file lines look a bit different in vc-dired-mode
-  ;; (the column before the date does not end in a digit).
-  ;; albinus: It should be done in the original declaration.  Problem
-  ;; is the optional empty state-info; otherwise ")" would be good
-  ;; enough as delimeter.
-  (set (make-local-variable 'directory-listing-before-filename-regexp)
-  (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
-         ;; In some locales, month abbreviations are as short as 2 letters,
-         ;; and they can be followed by ".".
-         (month (concat l l "+\\.?"))
-         (s " ")
-         (yyyy "[0-9][0-9][0-9][0-9]")
-         (dd "[ 0-3][0-9]")
-         (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
-         (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
-         (zone "[-+][0-2][0-9][0-5][0-9]")
-         (iso-mm-dd "[01][0-9]-[0-3][0-9]")
-         (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
-         (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
-                      "\\|" yyyy "-" iso-mm-dd "\\)"))
-         (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
-                          s "+"
-                          "\\(" HH:MM "\\|" yyyy "\\)"))
-         (western-comma (concat month s "+" dd "," s "+" yyyy))
-         ;; Japanese MS-Windows ls-lisp has one-digit months, and
-         ;; omits the Kanji characters after month and day-of-month.
-         (mm "[ 0-1]?[0-9]")
-         (japanese
-          (concat mm l "?" s dd l "?" s "+"
-                  "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
-    ;; the .* below ensures that we find the last match on a line
-    (concat ".*" s
-            "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
-            s "+")))
-  (and (boundp 'vc-dired-switches)
-       vc-dired-switches
-       (set (make-local-variable 'dired-actual-switches)
-            vc-dired-switches))
-  (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
-  ;; FIXME: This needs to be factored out
-  (let ((backend-name (symbol-name (vc-responsible-backend
-                                    default-directory))))
-    (setq mode-name (concat mode-name backend-name))
-    ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
-    (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
-      (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
-        (cons backend-name vc-dire-menu-map) 'subdir)))
-  (setq vc-dired-mode t))
-
-(defun vc-dired-toggle-terse-mode ()
-  "Toggle terse display in VC Dired."
-  (interactive)
-  (if (not vc-dired-mode)
-      nil
-    (setq vc-dired-terse-mode (not vc-dired-terse-mode))
-    (if vc-dired-terse-mode
-        (vc-dired-hook)
-      (revert-buffer))))
-
-(defun vc-dired-mark-locked ()
-  "Mark all files currently locked."
-  (interactive)
-  (dired-mark-if (let ((f (dired-get-filename nil t)))
-                   (and f
-                        (not (file-directory-p f))
-                        (not (vc-up-to-date-p f))))
-                 "locked file"))
-
-(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
-
-(defun vc-dired-reformat-line (vc-info)
-  "Reformat a directory-listing line.
-Replace various columns with version control information, VC-INFO.
-This code, like dired, assumes UNIX -l format."
-  (beginning-of-line)
-  (when (re-search-forward
-         ;; Match link count, owner, group, size.  Group may be missing,
-         ;; and only the size is present in OS/2 -l format.
-         "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
-         (line-end-position) t)
-      (replace-match (substring (concat vc-info "          ") 0 10)
-                     t t nil 1)))
-
-;; FIXME: VCS-specific knowledge in here needs to be factored out
-(defun vc-dired-ignorable-p (filename)
-  "Should FILENAME be ignored in VC-Dired listings?"
-  (catch t
-    ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
-    (dolist (ignorable completion-ignored-extensions)
-      (let ((ext (substring filename
-                              (- (length filename)
-                                 (length ignorable)))))
-        (if (string= ignorable ext) (throw t t))))
-    ;; Ignore Makefiles derived from something else
-    (when (string= (file-name-nondirectory filename) "Makefile")
-      (let* ((dir (file-name-directory filename))
-            (peers (directory-files (or dir default-directory))))
-        (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
-           (throw t t))))
-    nil))
-
-(defun vc-dired-purge ()
-  "Remove empty subdirs."
-  (goto-char (point-min))
-  (while (dired-get-subdir)
-    (forward-line 2)
-    (if (dired-get-filename nil t)
-        (if (not (dired-next-subdir 1 t))
-            (goto-char (point-max)))
-      (forward-line -2)
-      (if (not (string= (dired-current-directory) default-directory))
-          (dired-do-kill-lines t "")
-        ;; We cannot remove the top level directory.
-        ;; Just make it look a little nicer.
-        (forward-line 1)
-        (or (eobp) (kill-line))
-        (if (not (dired-next-subdir 1 t))
-            (goto-char (point-max))))))
-  (goto-char (point-min)))
-
-(defun vc-dired-buffers-for-dir (dir)
-  "Return a list of all vc-dired buffers that currently display DIR."
-  (let (result)
-    ;; Check whether dired is loaded.
-    (when (fboundp 'dired-buffers-for-dir)
-      (dolist (buffer (dired-buffers-for-dir dir))
-        (with-current-buffer buffer
-          (when vc-dired-mode
-            (push buffer result)))))
-    (nreverse result)))
-
-(defun vc-directory-resynch-file (file)
-  "Update the entries for FILE in any VC Dired buffers that list it."
-  ;;FIXME This needs to be implemented so it works for vc-dir
-  (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
-    (when buffers
-      (mapcar (lambda (buffer)
-                (with-current-buffer buffer
-                  (when (dired-goto-file file)
-                    ;; bind vc-dired-terse-mode to nil so that
-                    ;; files won't vanish when they are checked in
-                    (let ((vc-dired-terse-mode nil))
-                      (dired-do-redisplay 1)))))
-              buffers))))
-
-;;;###autoload
-(defun vc-directory (dir read-switches)
-  "Create a buffer in VC Dired Mode for directory DIR.
-
-See Info node `VC Dired Mode'.
-
-With prefix arg READ-SWITCHES, specify a value to override
-`dired-listing-switches' when generating the listing."
-  (interactive "DDired under VC (directory): \nP")
-  (let ((vc-dired-switches (concat vc-dired-listing-switches
-                                   (if vc-dired-recurse "R" ""))))
-    (if read-switches
-        (setq vc-dired-switches
-              (read-string "Dired listing switches: "
-                           vc-dired-switches)))
-    (require 'dired)
-    (require 'dired-aux)
-    (switch-to-buffer
-     (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
-                              vc-dired-switches
-                              'vc-dired-mode))))
-
-;; VC status implementation
-
-;; Used to store information for the files displayed in the *VC status* buffer.
-;; Each item displayed corresponds to one of these defstructs.
-(defstruct (vc-dir-fileinfo
-            (:copier nil)
-            (:type list)            ;So we can use `member' on lists of FIs.
-            (:constructor
-             ;; We could define it as an alias for `list'.
-             vc-dir-create-fileinfo (name state &optional extra marked directory))
-            (:conc-name vc-dir-fileinfo->))
-  name                                  ;Keep it as first, for `member'.
-  state
-  ;; For storing backend specific information.
-  extra
-  marked
-  ;; To keep track of not updated files during a global refresh
-  needs-update
-  ;; To distinguish files and directories.
-  directory)
-
-(defvar vc-ewoc nil)
-
-(defun vc-default-status-extra-headers (backend dir)
-  ;; Be loud by default to remind people to add coded to display
-  ;; backend specific headers.
-  ;; XXX: change this to return nil before the release.
-  "Extra      : Add backend specific headers here")
-
-(defun vc-dir-headers (backend dir)
-  "Display the headers in the *VC status* buffer.
-It calls the `status-extra-headers' backend method to display backend
-specific headers."
-  (concat
-   (propertize "VC backend : " 'face 'font-lock-type-face)
-   (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
-   (propertize "Working dir: " 'face 'font-lock-type-face)
-   (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
-   (vc-call-backend backend 'status-extra-headers dir)
-   "\n"))
-
-(defun vc-default-status-printer (backend fileentry)
-  "Pretty print FILEENTRY."
-  ;; If you change the layout here, change vc-dir-move-to-goal-column.
-  (let ((state
-         (if (vc-dir-fileinfo->directory fileentry)
-             'DIRECTORY
-           (vc-dir-fileinfo->state fileentry))))
-    (insert
-     (propertize
-      (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
-      'face 'font-lock-type-face)
-     "   "
-     (propertize
-      (format "%-20s" state)
-      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
-                  ((memq state '(missing conflict)) 'font-lock-warning-face)
-                  (t 'font-lock-variable-name-face))
-      'mouse-face 'highlight)
-     " "
-     (propertize
-      (format "%s" (vc-dir-fileinfo->name fileentry))
-      'face 'font-lock-function-name-face
-      'mouse-face 'highlight))))
-
-(defun vc-dir-printer (fileentry)
-  (let ((backend (vc-responsible-backend default-directory)))
-    (vc-call-backend backend 'status-printer fileentry)))
-
-(defun vc-dir-move-to-goal-column ()
-  ;; Used to keep the cursor on the file name column.
-  (beginning-of-line)
-  ;; Must be in sync with vc-default-status-printer.
-  (forward-char 25))
-
-(defun vc-dir-prepare-status-buffer (dir &optional create-new)
-  "Find a *vc-dir* buffer showing DIR, or create a new one."
-  (setq dir (expand-file-name dir))
-  (let* ((bname "*vc-dir*")
-         ;; Look for another *vc-dir* buffer visiting the same directory.
-         (buf (save-excursion
-                (unless create-new
-                  (dolist (buffer (buffer-list))
-                    (set-buffer buffer)
-                    (when (and (eq major-mode 'vc-dir-mode)
-                               (string= (expand-file-name default-directory) dir))
-                      (return buffer)))))))
-    (or buf
-        ;; Create a new *vc-dir* buffer.
-        (with-current-buffer (create-file-buffer bname)
-          (cd dir)
-          (vc-setup-buffer (current-buffer))
-          ;; Reset the vc-parent-buffer-name so that it does not appear
-          ;; in the mode-line.
-          (setq vc-parent-buffer-name nil)
-          (current-buffer)))))
-
-;;;###autoload
-(defun vc-dir (dir)
-  "Show the VC status for DIR."
-  (interactive "DVC status for directory: ")
-  (pop-to-buffer (vc-dir-prepare-status-buffer dir))
-  (if (eq major-mode 'vc-dir-mode)
-      (vc-dir-refresh)
-    (vc-dir-mode)))
-
-(defvar vc-dir-menu-map
-  (let ((map (make-sparse-keymap "VC-dir")))
-    (define-key map [quit]
-      '(menu-item "Quit" quit-window
-                  :help "Quit"))
-    (define-key map [kill]
-      '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
-                  :enable (vc-dir-busy)
-                  :help "Kill the command that updates VC status buffer"))
-    (define-key map [refresh]
-      '(menu-item "Refresh" vc-dir-refresh
-                  :enable (not (vc-dir-busy))
-                  :help "Refresh the contents of the VC status buffer"))
-    (define-key map [remup]
-      '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
-                  :help "Hide up-to-date items from display"))
-    ;; Movement.
-    (define-key map [sepmv] '("--"))
-    (define-key map [next-line]
-      '(menu-item "Next line" vc-dir-next-line
-                  :help "Go to the next line" :keys "n"))
-    (define-key map [previous-line]
-      '(menu-item "Previous line" vc-dir-previous-line
-                  :help "Go to the previous line"))
-    ;; Marking.
-    (define-key map [sepmrk] '("--"))
-    (define-key map [unmark-all]
-      '(menu-item "Unmark All" vc-dir-unmark-all-files
-                  :help "Unmark all files that are in the same state as the current file\
-\nWith prefix argument unmark all files"))
-    (define-key map [unmark-previous]
-      '(menu-item "Unmark previous " vc-dir-unmark-file-up
-                  :help "Move to the previous line and unmark the file"))
-
-    (define-key map [mark-all]
-      '(menu-item "Mark All" vc-dir-mark-all-files
-                  :help "Mark all files that are in the same state as the current file\
-\nWith prefix argument mark all files"))
-    (define-key map [unmark]
-      '(menu-item "Unmark" vc-dir-unmark
-                  :help "Unmark the current file or all files in the region"))
-
-    (define-key map [mark]
-      '(menu-item "Mark" vc-dir-mark
-                  :help "Mark the current file or all files in the region"))
-
-    (define-key map [sepopn] '("--"))
-    (define-key map [open-other]
-      '(menu-item "Open in other window" vc-dir-find-file-other-window
-                  :help "Find the file on the current line, in another window"))
-    (define-key map [open]
-      '(menu-item "Open file" vc-dir-find-file
-                  :help "Find the file on the current line"))
-    ;; VC info details
-    (define-key map [sepvcdet] '("--"))
-    ;; FIXME: This needs a key binding.  And maybe a better name
-    ;; ("Insert" like PCL-CVS uses does not sound that great either)...
-    (define-key map [ins]
-      '(menu-item "Show File" vc-dir-show-fileentry
-                  :help "Show a file in the VC status listing even though it might be up to date"))
-    (define-key map [annotate]
-      '(menu-item "Annotate" vc-annotate
-                  :help "Display the edit history of the current file using colors"))
-    (define-key map [diff]
-      '(menu-item "Compare with Base Version" vc-diff
-                  :help "Compare file set with the base version"))
-    (define-key map [log]
-     '(menu-item "Show history" vc-print-log
-     :help "List the change log of the current file set in a window"))
-    ;; VC commands.
-    (define-key map [sepvccmd] '("--"))
-    (define-key map [update]
-      '(menu-item "Update to latest version" vc-update
-                  :help "Update the current fileset's files to their tip revisions"))
-    (define-key map [revert]
-      '(menu-item "Revert to base version" vc-revert
-                  :help "Revert working copies of the selected fileset to their repository contents."))
-    (define-key map [next-action]
-      ;; FIXME: This really really really needs a better name!
-      ;; And a key binding too.
-      '(menu-item "Check In/Out" vc-next-action
-                  :help "Do the next logical version control operation on the current fileset"))
-    (define-key map [register]
-      '(menu-item "Register" vc-dir-register
-                  :help "Register file set into the version control system"))
-    map)
-  "Menu for VC status")
-
-(defalias 'vc-dir-menu-map vc-dir-menu-map)
-
-(defvar vc-dir-mode-map
-  (let ((map (make-keymap)))
-    (suppress-keymap map)
-    ;; Marking.
-    (define-key map "m" 'vc-dir-mark)
-    (define-key map "M" 'vc-dir-mark-all-files)
-    (define-key map "u" 'vc-dir-unmark)
-    (define-key map "U" 'vc-dir-unmark-all-files)
-    (define-key map "\C-?" 'vc-dir-unmark-file-up)
-    (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
-    ;; Movement.
-    (define-key map "n" 'vc-dir-next-line)
-    (define-key map " " 'vc-dir-next-line)
-    (define-key map "\t" 'vc-dir-next-line)
-    (define-key map "p" 'vc-dir-previous-line)
-    (define-key map [backtab] 'vc-dir-previous-line)
-    ;; VC commands.
-    (define-key map "=" 'vc-diff)   ;; C-x v =
-    (define-key map "a" 'vc-dir-register)
-    (define-key map "+" 'vc-update) ;; C-x v +
-    (define-key map "R" 'vc-revert) ;; u is taken by unmark.
-
-    ;; Can't be "g" (as in vc map), so "A" for "Annotate".
-    (define-key map "A" 'vc-annotate)
-    (define-key map "l" 'vc-print-log) ;; C-x v l
-    ;; The remainder.
-    (define-key map "f" 'vc-dir-find-file)
-    (define-key map "\C-m" 'vc-dir-find-file)
-    (define-key map "o" 'vc-dir-find-file-other-window)
-    (define-key map "x" 'vc-dir-hide-up-to-date)
-    (define-key map "q" 'quit-window)
-    (define-key map "g" 'vc-dir-refresh)
-    (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
-    (define-key map [(down-mouse-3)] 'vc-dir-menu)
-    (define-key map [(mouse-2)] 'vc-dir-toggle-mark)
-
-    ;; Hook up the menu.
-    (define-key map [menu-bar vc-dir-mode]
-      '(menu-item
-        ;; This is used to that VC backends could add backend specific
-        ;; menu items to vc-dir-menu-map.
-        "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter))
-    map)
-  "Keymap for VC status")
-
-(defun vc-default-extra-status-menu (backend)
-  nil)
-
-;; This is used to that VC backends could add backend specific menu
-;; items to vc-dir-menu-map.
-(defun vc-dir-menu-map-filter (orig-binding)
-  (when (and (symbolp orig-binding) (fboundp orig-binding))
-    (setq orig-binding (indirect-function orig-binding)))
-  (let ((ext-binding
-         (vc-call-backend (vc-responsible-backend default-directory)
-                          'extra-status-menu)))
-    (if (null ext-binding)
-        orig-binding
-      (append orig-binding
-              '("----")
-              ext-binding))))
-
-(defmacro vc-at-event (event &rest body)
-  "Evaluate `body' wich point located at event-start of `event'.
-If `body' uses `event', it should be a variable,
- otherwise it will be evaluated twice."
-  (let ((posn (gensym "vc-at-event-posn")))
-    `(let ((,posn (event-start ,event)))
-       (save-excursion
-         (set-buffer (window-buffer (posn-window ,posn)))
-         (goto-char (posn-point ,posn))
-         ,@body))))
-
-(defun vc-dir-menu (e)
-  "Popup the VC status menu."
-  (interactive "e")
-  (vc-at-event e (popup-menu vc-dir-menu-map e)))
-
-(defvar vc-dir-tool-bar-map
-  (let ((map (make-sparse-keymap)))
-    (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item "bookmark_add"
-                         'vc-dir-toggle-mark 'vc-dir-toggle-mark map
-                         :help "Toggle mark on current item")
-    (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
-                                   map vc-dir-mode-map
-                                   :rtl "right-arrow")
-    (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
-                                   map vc-dir-mode-map
-                                   :rtl "left-arrow")
-    (tool-bar-local-item-from-menu 'vc-print-log "info"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item-from-menu 'nonincremental-search-forward
-                                   "search" map)
-    (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item-from-menu 'quit-window "exit"
-                                   map vc-dir-mode-map)
-    map))
-
-(defvar vc-dir-process-buffer nil
-  "The buffer used for the asynchronous call that computes the VC status.")
-
-(defun vc-dir-mode ()
-  "Major mode for showing the VC status for a directory.
-Marking/Unmarking key bindings and actions:
-m - marks a file/directory or ff the region is active, mark all the files
-     in region.
-    Restrictions: - a file cannot be marked if any parent directory is marked
-                  - a directory cannot be marked if any child file or
-                    directory is marked
-u - marks a file/directory or if the region is active, unmark all the files
-     in region.
-M - if the cursor is on a file: mark all the files with the same VC state as
-      the current file
-  - if the cursor is on a directory: mark all child files
-  - with a prefix argument: mark all files
-U - if the cursor is on a file: unmark all the files with the same VC state
-      as the current file
-  - if the cursor is on a directory: unmark all child files
-  - with a prefix argument: unmark all files
-
-
-\\{vc-dir-mode-map}"
-  (setq mode-name "VC Status")
-  (setq major-mode 'vc-dir-mode)
-  (setq buffer-read-only t)
-  (use-local-map vc-dir-mode-map)
-  (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)
-  (let ((buffer-read-only nil)
-        (backend (vc-responsible-backend default-directory))
-        entries)
-    (erase-buffer)
-    (set (make-local-variable 'vc-dir-process-buffer) nil)
-    (set (make-local-variable 'vc-ewoc)
-         (ewoc-create #'vc-dir-printer
-                      (vc-dir-headers backend default-directory)))
-    (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed)
-    ;; Make sure that if the VC status buffer is killed, the update
-    ;; process running in the background is also killed.
-    (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
-    (vc-dir-refresh))
-  (run-hooks 'vc-dir-mode-hook))
-
-(put 'vc-dir-mode 'mode-class 'special)
-
-;; t if directories should be shown in vc-dir.
-;; WORK IN PROGRESS!  DO NOT SET this! ONLY set it if you want to help
-;; write code for this feature.  This variable will likely disappear
-;; when the work is done.
-(defvar vc-dir-insert-directories nil)
-
-(defun vc-dir-update (entries buffer &optional noinsert)
-  "Update BUFFER's ewoc from the list of ENTRIES.
-If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
-  ;; Add ENTRIES to the vc-dir buffer BUFFER.
-  (with-current-buffer buffer
-    ;; Insert the entries sorted by name into the ewoc.
-    ;; We assume the ewoc is sorted too, which should be the
-    ;; case if we always add entries with vc-dir-update.
-    (setq entries
-          ;; Sort: first files and then subdirectories.
-          ;; XXX: this is VERY inefficient, it computes the directory
-          ;; names too many times
-          (sort entries
-                (lambda (entry1 entry2)
-                  (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
-                        (dir2 (file-name-directory (expand-file-name (car entry2)))))
-                    (cond
-                     ((string< dir1 dir2) t)
-                     ((not (string= dir1 dir2)) nil)
-                     ((string< (car entry1) (car entry2))))))))
-    (if (not vc-dir-insert-directories)
-        (let ((entry (car entries))
-              (node (ewoc-nth vc-ewoc 0)))
-          (while (and entry node)
-            (let ((entryfile (car entry))
-                  (nodefile (vc-dir-fileinfo->name (ewoc-data node))))
-              (cond
-               ((string-lessp nodefile entryfile)
-                (setq node (ewoc-next vc-ewoc node)))
-               ((string-lessp entryfile nodefile)
-                (unless noinsert
-                  (ewoc-enter-before vc-ewoc node
-                                     (apply 'vc-dir-create-fileinfo entry)))
-                (setq entries (cdr entries) entry (car entries)))
-               (t
-                (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
-                (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
-                (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
-                (ewoc-invalidate vc-ewoc node)
-                (setq entries (cdr entries) entry (car entries))
-                (setq node (ewoc-next vc-ewoc node))))))
-          (unless (or node noinsert)
-            ;; We're past the last node, all remaining entries go to the end.
-            (while entries
-              (ewoc-enter-last vc-ewoc
-                               (apply 'vc-dir-create-fileinfo (pop entries))))))
-  ;; Insert directory entries in the right places.
-  (let ((entry (car entries))
-        (node (ewoc-nth vc-ewoc 0)))
-    ;; Insert . if it is not present.
-    (unless node
-      (let ((rd (file-relative-name default-directory)))
-        (ewoc-enter-last
-         vc-ewoc (vc-dir-create-fileinfo
-                  rd nil nil nil (expand-file-name default-directory))))
-      (setq node (ewoc-nth vc-ewoc 0)))
-
-    (while (and entry node)
-      (let* ((entryfile (car entry))
-             (entrydir (file-name-directory (expand-file-name entryfile)))
-             (nodedir
-              (or (vc-dir-fileinfo->directory (ewoc-data node))
-                  (file-name-directory
-                       (expand-file-name
-                        (vc-dir-fileinfo->name (ewoc-data node)))))))
-        (cond
-         ;; First try to find the directory.
-         ((string-lessp nodedir entrydir)
-          (setq node (ewoc-next vc-ewoc node)))
-         ((string-equal nodedir entrydir)
-          ;; Found the directory, find the place for the file name.
-          (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
-            (cond
-             ((string-lessp nodefile entryfile)
-              (setq node (ewoc-next vc-ewoc node)))
-              ((string-equal nodefile entryfile)
-               (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
-               (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
-               (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
-               (ewoc-invalidate vc-ewoc node)
-               (setq entries (cdr entries) entry (car entries))
-               (setq node (ewoc-next vc-ewoc node)))
-              (t
-               (ewoc-enter-before vc-ewoc node
-                                  (apply 'vc-dir-create-fileinfo entry))
-               (setq entries (cdr entries) entry (car entries))))))
-         (t
-          ;; We need to insert a directory node
-          (let ((rd (file-relative-name entrydir)))
-            (ewoc-enter-last
-             vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))
-          ;; Now insert the node itself.
-          (ewoc-enter-before vc-ewoc node
-                             (apply 'vc-dir-create-fileinfo entry))
-          (setq entries (cdr entries) entry (car entries))))))
-    ;; We're past the last node, all remaining entries go to the end.
-    (unless (or node noinsert)
-      (let* ((lastnode (ewoc-nth vc-ewoc -1))
-             (lastdir
-              (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
-                  (file-name-directory
-                       (expand-file-name
-                        (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
-        (dolist (entry entries)
-          (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
-            ;; Insert a directory node if needed.
-            (unless (string-equal lastdir entrydir)
-              (setq lastdir entrydir)
-              (let ((rd (file-relative-name entrydir)))
-                (ewoc-enter-last
-                 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
-            ;; Now insert the node itself.
-            (ewoc-enter-last vc-ewoc
-                             (apply 'vc-dir-create-fileinfo entry))))))))))
-
-(defun vc-dir-busy ()
-  (and (buffer-live-p vc-dir-process-buffer)
-       (get-buffer-process vc-dir-process-buffer)))
-
-(defun vc-dir-refresh-files (files default-state)
-  "Refresh some files in the VC status buffer."
-  (let ((backend (vc-responsible-backend default-directory))
-        (status-buffer (current-buffer))
-        (def-dir default-directory))
-    (vc-set-mode-line-busy-indicator)
-    ;; Call the `dir-status-file' backend function.
-    ;; `dir-status-file' is supposed to be asynchronous.
-    ;; It should compute the results, and then call the function
-    ;; passed as an argument in order to update the vc-dir buffer
-    ;; with the results.
-    (unless (buffer-live-p vc-dir-process-buffer)
-      (setq vc-dir-process-buffer
-            (generate-new-buffer (format " *VC-%s* tmp status" backend))))
-    (lexical-let ((buffer (current-buffer)))
-      (with-current-buffer vc-dir-process-buffer
-        (cd def-dir)
-        (erase-buffer)
-        (vc-call-backend
-         backend 'dir-status-files def-dir files default-state
-         (lambda (entries &optional more-to-come)
-           ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
-           ;; If MORE-TO-COME is true, then more updates will come from
-           ;; the asynchronous process.
-           (with-current-buffer buffer
-             (vc-dir-update entries buffer)
-             (unless more-to-come
-               (setq mode-line-process nil)
-               ;; Remove the ones that haven't been updated at all.
-               ;; Those not-updated are those whose state is nil because the
-               ;; file/dir doesn't exist and isn't versioned.
-               (ewoc-filter vc-ewoc
-                            (lambda (info)
-                              (not (vc-dir-fileinfo->needs-update info))))))))))))
-
-(defun vc-dir-refresh ()
-  "Refresh the contents of the VC status buffer.
-Throw an error if another update process is in progress."
-  (interactive)
-  (if (vc-dir-busy)
-      (error "Another update process is in progress, cannot run two at a time")
-    (let ((backend (vc-responsible-backend default-directory))
-          (status-buffer (current-buffer))
-          (def-dir default-directory))
-      (vc-set-mode-line-busy-indicator)
-      ;; Call the `dir-status' backend function.
-      ;; `dir-status' is supposed to be asynchronous.
-      ;; It should compute the results, and then call the function
-      ;; passed as an argument in order to update the vc-dir buffer
-      ;; with the results.
-
-      ;; Create a buffer that can be used by `dir-status' and call
-      ;; `dir-status' with this buffer as the current buffer.  Use
-      ;; `vc-dir-process-buffer' to remember this buffer, so that
-      ;; it can be used later to kill the update process in case it
-      ;; takes too long.
-      (unless (buffer-live-p vc-dir-process-buffer)
-        (setq vc-dir-process-buffer
-              (generate-new-buffer (format " *VC-%s* tmp status" backend))))
-      ;; set the needs-update flag on all entries
-      (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
-                vc-ewoc)
-      (lexical-let ((buffer (current-buffer)))
-        (with-current-buffer vc-dir-process-buffer
-          (cd def-dir)
-          (erase-buffer)
-          (vc-call-backend
-           backend 'dir-status def-dir
-           (lambda (entries &optional more-to-come)
-             ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
-             ;; If MORE-TO-COME is true, then more updates will come from
-             ;; the asynchronous process.
-             (with-current-buffer buffer
-               (vc-dir-update entries buffer)
-               (unless more-to-come
-                 (let ((remaining
-                        (ewoc-collect
-                         vc-ewoc 'vc-dir-fileinfo->needs-update)))
-                   (if remaining
-                       (vc-dir-refresh-files
-                        (mapcar 'vc-dir-fileinfo->name remaining)
-                        'up-to-date)
-                     (setq mode-line-process nil))))))))))))
-
-(defun vc-dir-kill-dir-status-process ()
-  "Kill the temporary buffer and associated process."
-  (interactive)
-  (when (buffer-live-p vc-dir-process-buffer)
-    (let ((proc (get-buffer-process vc-dir-process-buffer)))
-      (when proc (delete-process proc))
-      (setq vc-dir-process-buffer nil)
-      (setq mode-line-process nil))))
-
-(defun vc-dir-kill-query ()
-  ;; Make sure that when the VC status buffer is killed the update
-  ;; process running in background is also killed.
-  (if (vc-dir-busy)
-    (when (y-or-n-p "Status update process running, really kill status buffer?")
-      (vc-dir-kill-dir-status-process)
-      t)
-    t))
-
-(defun vc-dir-next-line (arg)
-  "Go to the next line.
-If a prefix argument is given, move by that many lines."
-  (interactive "p")
-  (ewoc-goto-next vc-ewoc arg)
-  (vc-dir-move-to-goal-column))
-
-(defun vc-dir-previous-line (arg)
-  "Go to the previous line.
-If a prefix argument is given, move by that many lines."
-  (interactive "p")
-  (ewoc-goto-prev vc-ewoc arg)
-  (vc-dir-move-to-goal-column))
-
-(defun vc-dir-mark-unmark (mark-unmark-function)
-  (if (use-region-p)
-      (let ((firstl (line-number-at-pos (region-beginning)))
-            (lastl (line-number-at-pos (region-end))))
-        (save-excursion
-          (goto-char (region-beginning))
-          (while (<= (line-number-at-pos) lastl)
-            (funcall mark-unmark-function))))
-    (funcall mark-unmark-function)))
-
-(defun vc-dir-parent-marked-p (arg)
-  (when vc-dir-insert-directories
-    ;; Return nil if none of the parent directories of arg is marked.
-    (let* ((argdata (ewoc-data arg))
-           (argdir
-            (let ((crtdir (vc-dir-fileinfo->directory argdata)))
-              (if crtdir
-                  crtdir
-                (file-name-directory (expand-file-name
-                                      (vc-dir-fileinfo->name argdata))))))
-           (arglen (length argdir))
-           (crt arg)
-           data dir)
-      ;; Go through the predecessors, checking if any directory that is
-      ;; a parent is marked.
-      (while (setq crt (ewoc-prev vc-ewoc crt))
-        (setq data (ewoc-data crt))
-        (setq dir
-              (let ((crtdir (vc-dir-fileinfo->directory data)))
-                (if crtdir
-                    crtdir
-                  (file-name-directory (expand-file-name
-                                        (vc-dir-fileinfo->name data))))))
-
-        (when (and (vc-dir-fileinfo->directory data)
-                   (string-equal (substring argdir 0 (length dir)) dir))
-          (when (vc-dir-fileinfo->marked data)
-            (error "Cannot mark `%s', parent directory `%s' marked"
-                   (vc-dir-fileinfo->name argdata)
-                   (vc-dir-fileinfo->name data)))))
-      nil)))
-
-(defun vc-dir-children-marked-p (arg)
-  ;; Return nil if none of the children of arg is marked.
-  (when vc-dir-insert-directories
-    (let* ((argdata (ewoc-data arg))
-           (argdir (vc-dir-fileinfo->directory argdata))
-           (arglen (length argdir))
-           (is-child t)
-           (crt arg)
-           data dir)
-      (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
-        (setq data (ewoc-data crt))
-        (setq dir
-              (let ((crtdir (vc-dir-fileinfo->directory data)))
-                (if crtdir
-                    crtdir
-                  (file-name-directory (expand-file-name
-                                        (vc-dir-fileinfo->name data))))))
-        (if (string-equal argdir (substring dir 0 arglen))
-            (when (vc-dir-fileinfo->marked data)
-              (error "Cannot mark `%s', child `%s' marked"
-                     (vc-dir-fileinfo->name argdata)
-                     (vc-dir-fileinfo->name data)))
-          ;; We are done, we got to an entry that is not a child of `arg'.
-          (setq is-child nil)))
-      nil)))
-
-(defun vc-dir-mark-file (&optional arg)
-  ;; Mark ARG or the current file and move to the next line.
-  (let* ((crt (or arg (ewoc-locate vc-ewoc)))
-         (file (ewoc-data crt))
-         (isdir (vc-dir-fileinfo->directory file)))
-    (when (or (and isdir (not (vc-dir-children-marked-p crt)))
-              (and (not isdir) (not (vc-dir-parent-marked-p crt))))
-      (setf (vc-dir-fileinfo->marked file) t)
-      (ewoc-invalidate vc-ewoc crt)
-      (unless (or arg (mouse-event-p last-command-event))
-        (vc-dir-next-line 1)))))
-
-(defun vc-dir-mark ()
-  "Mark the current file or all files in the region.
-If the region is active, mark all the files in the region.
-Otherwise mark the file on the current line and move to the next
-line."
-  (interactive)
-  (vc-dir-mark-unmark 'vc-dir-mark-file))
-
-(defun vc-dir-mark-all-files (arg)
-  "Mark all files with the same state as the current one.
-With a prefix argument mark all files.
-If the current entry is a directory, mark all child files.
-
-The VC commands operate on files that are on the same state.
-This command is intended to make it easy to select all files that
-share the same state."
-  (interactive "P")
-  (if arg
-      ;; Mark all files.
-      (progn
-        ;; First check that no directory is marked, we can't mark
-        ;; files in that case.
-        (ewoc-map
-         (lambda (filearg)
-           (when (and (vc-dir-fileinfo->directory filearg)
-                      (vc-dir-fileinfo->directory filearg))
-             (error "Cannot mark all files, directory `%s' marked"
-                    (vc-dir-fileinfo->name filearg))))
-         vc-ewoc)
-        (ewoc-map
-         (lambda (filearg)
-           (unless (vc-dir-fileinfo->marked filearg)
-             (setf (vc-dir-fileinfo->marked filearg) t)
-             t))
-         vc-ewoc))
-    (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
-      (if (vc-dir-fileinfo->directory data)
-          ;; It's a directory, mark child files.
-          (let ((crt (ewoc-locate vc-ewoc)))
-            (unless (vc-dir-children-marked-p crt)
-              (while (setq crt (ewoc-next vc-ewoc crt))
-                (let ((crt-data (ewoc-data crt)))
-                  (unless (vc-dir-fileinfo->directory crt-data)
-                    (setf (vc-dir-fileinfo->marked crt-data) t)
-                    (ewoc-invalidate vc-ewoc crt))))))
-        ;; It's a file
-        (let ((state (vc-dir-fileinfo->state data))
-              (crt (ewoc-nth vc-ewoc 0)))
-          (while crt
-            (let ((crt-data (ewoc-data crt)))
-              (when (and (not (vc-dir-fileinfo->marked crt-data))
-                         (eq (vc-dir-fileinfo->state crt-data) state)
-                         (not (vc-dir-fileinfo->directory crt-data)))
-                (vc-dir-mark-file crt)))
-            (setq crt (ewoc-next vc-ewoc crt))))))))
-
-(defun vc-dir-unmark-file ()
-  ;; Unmark the current file and move to the next line.
-  (let* ((crt (ewoc-locate vc-ewoc))
-         (file (ewoc-data crt)))
-    (setf (vc-dir-fileinfo->marked file) nil)
-    (ewoc-invalidate vc-ewoc crt)
-    (unless (mouse-event-p last-command-event)
-      (vc-dir-next-line 1))))
-
-(defun vc-dir-unmark ()
-  "Unmark the current file or all files in the region.
-If the region is active, unmark all the files in the region.
-Otherwise mark the file on the current line and move to the next
-line."
-  (interactive)
-  (vc-dir-mark-unmark 'vc-dir-unmark-file))
-
-(defun vc-dir-unmark-file-up ()
-  "Move to the previous line and unmark the file."
-  (interactive)
-  ;; If we're on the first line, we won't move up, but we will still
-  ;; remove the mark.  This seems a bit odd but it is what buffer-menu
-  ;; does.
-  (let* ((prev (ewoc-goto-prev vc-ewoc 1))
-         (file (ewoc-data prev)))
-    (setf (vc-dir-fileinfo->marked file) nil)
-    (ewoc-invalidate vc-ewoc prev)
-    (vc-dir-move-to-goal-column)))
-
-(defun vc-dir-unmark-all-files (arg)
-  "Unmark all files with the same state as the current one.
-With a prefix argument unmark all files.
-If the current entry is a directory, unmark all the child files.
-
-The VC commands operate on files that are on the same state.
-This command is intended to make it easy to deselect all files
-that share the same state."
-  (interactive "P")
-  (if arg
-      (ewoc-map
-       (lambda (filearg)
-         (when (vc-dir-fileinfo->marked filearg)
-           (setf (vc-dir-fileinfo->marked filearg) nil)
-           t))
-       vc-ewoc)
-    (let* ((crt (ewoc-locate vc-ewoc))
-           (data (ewoc-data crt)))
-      (if (vc-dir-fileinfo->directory data)
-          ;; It's a directory, unmark child files.
-          (while (setq crt (ewoc-next vc-ewoc crt))
-            (let ((crt-data (ewoc-data crt)))
-              (unless (vc-dir-fileinfo->directory crt-data)
-                (setf (vc-dir-fileinfo->marked crt-data) nil)
-                (ewoc-invalidate vc-ewoc crt))))
-        ;; It's a file
-        (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
-          (ewoc-map
-           (lambda (filearg)
-             (when (and (vc-dir-fileinfo->marked filearg)
-                        (eq (vc-dir-fileinfo->state filearg) crt-state))
-               (setf (vc-dir-fileinfo->marked filearg) nil)
-               t))
-           vc-ewoc))))))
-
-(defun vc-dir-toggle-mark-file ()
-  (let* ((crt (ewoc-locate vc-ewoc))
-         (file (ewoc-data crt)))
-    (if (vc-dir-fileinfo->marked file)
-        (vc-dir-unmark-file)
-      (vc-dir-mark-file))))
-
-(defun vc-dir-toggle-mark (e)
-  (interactive "e")
-  (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
-
-(defun vc-dir-register ()
-  "Register the marked files, or the current file if no marks."
-  (interactive)
-  ;; FIXME: Just pass the fileset to vc-register.
-  (mapc (lambda (arg) (vc-register nil arg))
-        (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
-
-(defun vc-dir-delete-file ()
-  "Delete the marked files, or the current file if no marks."
-  (interactive)
-  (mapc 'vc-delete-file (or (vc-dir-marked-files)
-                            (list (vc-dir-current-file)))))
-
-(defun vc-dir-show-fileentry (file)
-  "Insert an entry for a specific file into the current VC status listing.
-This is typically used if the file is up-to-date (or has been added
-outside of VC) and one wants to do some operation on it."
-  (interactive "fShow file: ")
-  (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
-
-(defun vc-dir-find-file ()
-  "Find the file on the current line."
-  (interactive)
-  (find-file (vc-dir-current-file)))
-
-(defun vc-dir-find-file-other-window ()
-  "Find the file on the current line, in another window."
-  (interactive)
-  (find-file-other-window (vc-dir-current-file)))
-
-(defun vc-dir-current-file ()
-  (let ((node (ewoc-locate vc-ewoc)))
-    (unless node
-      (error "No file available."))
-    (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
-
-(defun vc-dir-marked-files ()
-  "Return the list of marked files."
-  (mapcar
-   (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
-   (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
-
-(defun vc-dir-marked-only-files ()
-  "Return the list of marked files, for marked directories, return child files."
-
-  (let ((crt (ewoc-nth vc-ewoc 0))
-        result)
-    (while crt
-      (let ((crt-data (ewoc-data crt)))
-        (if (vc-dir-fileinfo->marked crt-data)
-            (if (vc-dir-fileinfo->directory crt-data)
-                (let* ((dir (vc-dir-fileinfo->directory crt-data))
-                       (dirlen (length dir))
-                       data)
-                  (while
-                      (and (setq crt (ewoc-next vc-ewoc crt))
-                           (string-equal
-                            (substring
-                             (progn
-                               (setq data (ewoc-data crt))
-                               (let ((crtdir (vc-dir-fileinfo->directory data)))
-                                 (if crtdir
-                                     crtdir
-                                   (file-name-directory
-                                    (expand-file-name
-                                     (vc-dir-fileinfo->name data))))))
-                             0 dirlen)
-                            dir))
-                    (unless (vc-dir-fileinfo->directory data)
-                      (push (vc-dir-fileinfo->name data) result))))
-              (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
-              (setq crt (ewoc-next vc-ewoc crt)))
-          (setq crt (ewoc-next vc-ewoc crt)))))
-    result))
-
-(defun vc-dir-hide-up-to-date ()
-  "Hide up-to-date items from display."
-  (interactive)
-  (ewoc-filter
-   vc-ewoc
-   (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
-
-;; FIXME: VCS-specific concept of backend needs to be factored out
-(defun vc-default-status-fileinfo-extra (backend file)
-  nil)
-
-(defun vc-dir-mark-buffer-changed (&optional fname)
-  (let* ((file (or fname (expand-file-name buffer-file-name)))
-         (found-vc-dir-buf nil))
-    (save-excursion
-      (dolist (status-buf (buffer-list))
-        (set-buffer status-buf)
-        ;; look for a vc-dir buffer that might show this file.
-        (when (eq major-mode 'vc-dir-mode)
-          (setq found-vc-dir-buf t)
-          (let ((ddir (expand-file-name default-directory)))
-            ;; FIXME: VCS-specific stuff needs to be factored out.
-            ;; This test is cvs-string-prefix-p
-            (when (eq t (compare-strings file nil (length ddir) ddir nil nil))
-              (let*
-                  ((file-short (substring file (length ddir)))
-                   (backend (vc-backend file))
-                   (state (and backend (vc-state file)))
-                   (extra
-                    (and backend
-                         (vc-call-backend backend 'status-fileinfo-extra file)))
-                   (entry
-                    (list file-short (if state state 'unregistered) extra)))
-                (vc-dir-update (list entry) status-buf))))))
-      ;; We didn't find any vc-dir buffers, remove the hook, it is
-      ;; not needed.
-      (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-mark-buffer-changed)))))
-
-;; These things should probably be generally available
-
-(defun vc-file-tree-walk (dirname func &rest args)
-  "Walk recursively through DIRNAME.
-Invoke FUNC f ARGS on each VC-managed file f underneath it."
-  (vc-file-tree-walk-internal (expand-file-name dirname) func args)
-  (message "Traversing directory %s...done" dirname))
-
-(defun vc-file-tree-walk-internal (file func args)
-  (if (not (file-directory-p file))
-      (when (vc-backend file) (apply func file args))
-    (message "Traversing directory %s..." (abbreviate-file-name file))
-    (let ((dir (file-name-as-directory file)))
-      (mapcar
-       (lambda (f) (or
-               (string-equal f ".")
-               (string-equal f "..")
-               (member f vc-directory-exclusion-list)
-               (let ((dirf (expand-file-name f dir)))
-                 (or
-                  (file-symlink-p dirf) ;; Avoid possible loops.
-                  (vc-file-tree-walk-internal dirf func args)))))
-       (directory-files dir)))))
+;;; vc-dispatcher.el ends here
diff --git a/lisp/vc.el b/lisp/vc.el
index 283f714e935..e12af0cec90 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -693,6 +693,11 @@
 (require 'tool-bar)
 (require 'ewoc)
 
+(eval-when-compile
+  (require 'cl)
+  (require 'dired)      ; for dired-map-over-marks macro
+  (require 'dired-aux)) ; for dired-kill-{line,tree}
+
 (unless (assoc 'vc-parent-buffer minor-mode-alist)
   (setq minor-mode-alist
         (cons '(vc-parent-buffer vc-parent-buffer-name)
@@ -709,6 +714,14 @@
   :type 'boolean
   :group 'vc)
 
+(defcustom vc-delete-logbuf-window t
+  "If non-nil, delete the *VC-log* buffer and window after each logical action.
+If nil, bury that buffer instead.
+This is most useful if you have multiple windows on a frame and would like to
+preserve the setting."
+  :type 'boolean
+  :group 'vc)
+
 (defcustom vc-initial-comment nil
   "If non-nil, prompt for initial comment when a file is registered."
   :type 'boolean
@@ -722,6 +735,11 @@ can also be overridden by a particular VC backend."
   :group 'vc
   :version "20.3")
 
+(defcustom vc-command-messages nil
+  "If non-nil, display run messages from back-end commands."
+  :type 'boolean
+  :group 'vc)
+
 (defcustom vc-checkin-switches nil
   "A string or list of strings specifying extra switches for checkin.
 These are passed to the checkin program by \\[vc-checkin]."
@@ -752,6 +770,24 @@ These are passed to the checkin program by \\[vc-register]."
                          string))
   :group 'vc)
 
+(defcustom vc-dired-listing-switches "-al"
+  "Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
+  :type 'string
+  :group 'vc
+  :version "21.1")
+
+(defcustom vc-dired-recurse t
+  "If non-nil, show directory trees recursively in VC Dired."
+  :type 'boolean
+  :group 'vc
+  :version "20.3")
+
+(defcustom vc-dired-terse-display t
+  "If non-nil, show only locked or locally modified files in VC Dired."
+  :type 'boolean
+  :group 'vc
+  :version "20.3")
+
 (defcustom vc-diff-switches nil
   "A string or list of strings specifying switches for diff under VC.
 When running diff under a given BACKEND, VC concatenates the values of
@@ -822,6 +858,12 @@ version control backend imposes itself."
   :type 'hook
   :group 'vc)
 
+(defcustom vc-dir-mode-hook nil
+  "Normal hook run by `vc-dir-mode'.
+See `run-hooks'."
+  :type 'hook
+  :group 'vc)
+
 ;; Annotate customization
 (defcustom vc-annotate-color-map
   (if (and (tty-display-color-p) (<= (display-color-cells) 8))
@@ -965,8 +1007,12 @@ and that its contents match what the master file says."
 Backends that offer asynchronous diffs should respect this variable
 in their implementation of vc-BACKEND-diff.")
 
+(defvar vc-log-fileset)
 (defvar vc-log-revision)
 
+(defvar vc-dired-mode nil)
+(make-variable-buffer-local 'vc-dired-mode)
+
 ;; File property caching
 
 (defun vc-clear-context ()
@@ -1028,6 +1074,121 @@ However, before executing BODY, find FILE, and after BODY, save buffer."
         ,@body
         (save-buffer)))))
 
+(defun vc-position-context (posn)
+  "Save a bit of the text around POSN in the current buffer.
+Used to help us find the corresponding position again later
+if markers are destroyed or corrupted."
+  ;; A lot of this was shamelessly lifted from Sebastian Kremer's
+  ;; rcs.el mode.
+  (list posn
+        (buffer-size)
+        (buffer-substring posn
+                          (min (point-max) (+ posn 100)))))
+
+(defun vc-find-position-by-context (context)
+  "Return the position of CONTEXT in the current buffer.
+If CONTEXT cannot be found, return nil."
+  (let ((context-string (nth 2 context)))
+    (if (equal "" context-string)
+        (point-max)
+      (save-excursion
+        (let ((diff (- (nth 1 context) (buffer-size))))
+          (when (< diff 0) (setq diff (- diff)))
+          (goto-char (nth 0 context))
+          (if (or (search-forward context-string nil t)
+                  ;; Can't use search-backward since the match may continue
+                  ;; after point.
+                  (progn (goto-char (- (point) diff (length context-string)))
+                         ;; goto-char doesn't signal an error at
+                         ;; beginning of buffer like backward-char would
+                         (search-forward context-string nil t)))
+              ;; to beginning of OSTRING
+              (- (point) (length context-string))))))))
+
+(defun vc-context-matches-p (posn context)
+  "Return t if POSN matches CONTEXT, nil otherwise."
+  (let* ((context-string (nth 2 context))
+         (len (length context-string))
+         (end (+ posn len)))
+    (if (> end (1+ (buffer-size)))
+        nil
+      (string= context-string (buffer-substring posn end)))))
+
+(defun vc-buffer-context ()
+  "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
+Used by `vc-restore-buffer-context' to later restore the context."
+  (let ((point-context (vc-position-context (point)))
+        ;; Use mark-marker to avoid confusion in transient-mark-mode.
+        (mark-context  (when (eq (marker-buffer (mark-marker)) (current-buffer))
+                         (vc-position-context (mark-marker))))
+        ;; Make the right thing happen in transient-mark-mode.
+        (mark-active nil)
+        ;; The new compilation code does not use compilation-error-list any
+        ;; more, so the code below is now ineffective and might as well
+        ;; be disabled.  -- Stef
+        ;; ;; We may want to reparse the compilation buffer after revert
+        ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded
+        ;;            ;; Construct a list; each elt is nil or a buffer
+        ;;            ;; if that buffer is a compilation output buffer
+        ;;            ;; that contains markers into the current buffer.
+        ;;            (save-current-buffer
+        ;;              (mapcar (lambda (buffer)
+        ;;                        (set-buffer buffer)
+        ;;                        (let ((errors (or
+        ;;                                       compilation-old-error-list
+        ;;                                       compilation-error-list))
+        ;;                              (buffer-error-marked-p nil))
+        ;;                          (while (and (consp errors)
+        ;;                                      (not buffer-error-marked-p))
+        ;;                            (and (markerp (cdr (car errors)))
+        ;;                                 (eq buffer
+        ;;                                     (marker-buffer
+        ;;                                      (cdr (car errors))))
+        ;;                                 (setq buffer-error-marked-p t))
+        ;;                            (setq errors (cdr errors)))
+        ;;                          (if buffer-error-marked-p buffer)))
+        ;;                      (buffer-list)))))
+        (reparse nil))
+    (list point-context mark-context reparse)))
+
+(defun vc-restore-buffer-context (context)
+  "Restore point/mark, and reparse any affected compilation buffers.
+CONTEXT is that which `vc-buffer-context' returns."
+  (let ((point-context (nth 0 context))
+        (mark-context (nth 1 context))
+        ;; (reparse (nth 2 context))
+        )
+    ;; The new compilation code does not use compilation-error-list any
+    ;; more, so the code below is now ineffective and might as well
+    ;; be disabled.  -- Stef
+    ;; ;; Reparse affected compilation buffers.
+    ;; (while reparse
+    ;;   (if (car reparse)
+    ;;    (with-current-buffer (car reparse)
+    ;;      (let ((compilation-last-buffer (current-buffer)) ;select buffer
+    ;;            ;; Record the position in the compilation buffer of
+    ;;            ;; the last error next-error went to.
+    ;;            (error-pos (marker-position
+    ;;                        (car (car-safe compilation-error-list)))))
+    ;;        ;; Reparse the error messages as far as they were parsed before.
+    ;;        (compile-reinitialize-errors '(4) compilation-parsing-end)
+    ;;        ;; Move the pointer up to find the error we were at before
+    ;;        ;; reparsing.  Now next-error should properly go to the next one.
+    ;;        (while (and compilation-error-list
+    ;;                    (/= error-pos (car (car compilation-error-list))))
+    ;;          (setq compilation-error-list (cdr compilation-error-list))))))
+    ;;   (setq reparse (cdr reparse)))
+
+    ;; if necessary, restore point and mark
+    (if (not (vc-context-matches-p (point) point-context))
+        (let ((new-point (vc-find-position-by-context point-context)))
+          (when new-point (goto-char new-point))))
+    (and mark-active
+         mark-context
+         (not (vc-context-matches-p (mark) mark-context))
+         (let ((new-mark (vc-find-position-by-context mark-context)))
+           (when new-mark (set-mark new-mark))))))
+
 ;;; Code for deducing what fileset and backend to assume
 
 (defun vc-responsible-backend (file &optional register)
@@ -1205,6 +1366,8 @@ NOT-URGENT means it is ok to continue if the user says not to save."
       (unless not-urgent
         (error "Aborted")))))
 
+(defvar vc-dired-window-configuration)
+
 (defun vc-compatible-state (p q)
   "Controls which states can be in the same commit."
   (or
@@ -1536,6 +1699,51 @@ rather than user editing!"
     (let ((buffer (get-file-buffer file)))
       (vc-dir-mark-buffer-changed file))))
 
+
+(defun vc-start-entry (files rev comment initial-contents msg action &optional after-hook)
+  "Accept a comment for an operation on FILES revision REV.
+If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
+action on close to ACTION.  If COMMENT is a string and
+INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
+contents of the log entry buffer.  If COMMENT is a string and
+INITIAL-CONTENTS is nil, do action immediately as if the user had
+entered COMMENT.  If COMMENT is t, also do action immediately with an
+empty comment.  Remember the file's buffer in `vc-parent-buffer'
+\(current one if no file).  AFTER-HOOK specifies the local value
+for `vc-log-after-operation-hook'."
+  (let ((parent
+         (if (or (eq major-mode 'vc-dired-mode) (eq major-mode 'vc-dir-mode))
+             ;; If we are called from VC dired, the parent buffer is
+             ;; the current buffer.
+             (current-buffer)
+           (if (and files (equal (length files) 1))
+               (get-file-buffer (car files))
+             (current-buffer)))))
+    (when vc-before-checkin-hook
+      (if files
+          (with-current-buffer parent
+            (run-hooks 'vc-before-checkin-hook))
+        (run-hooks 'vc-before-checkin-hook)))
+    (if (and comment (not initial-contents))
+        (set-buffer (get-buffer-create "*VC-log*"))
+      (pop-to-buffer (get-buffer-create "*VC-log*")))
+    (set (make-local-variable 'vc-parent-buffer) parent)
+    (set (make-local-variable 'vc-parent-buffer-name)
+         (concat " from " (buffer-name vc-parent-buffer)))
+    ;;(if file (vc-mode-line file))
+    (vc-log-edit files)
+    (make-local-variable 'vc-log-after-operation-hook)
+    (when after-hook
+      (setq vc-log-after-operation-hook after-hook))
+    (setq vc-log-operation action)
+    (setq vc-log-revision rev)
+    (when comment
+      (erase-buffer)
+      (when (stringp comment) (insert comment)))
+    (if (or (not comment) initial-contents)
+        (message "%s  Type C-c C-c when done" msg)
+      (vc-finish-logentry (eq comment t)))))
+
 (defun vc-checkout (file &optional writable rev)
   "Retrieve a copy of the revision REV of FILE.
 If WRITABLE is non-nil, make sure the retrieved file is writable.
@@ -1635,6 +1843,57 @@ Runs the normal hook `vc-checkin-hook'."
      (message "Checking in %s...done" (vc-delistify files)))
    'vc-checkin-hook))
 
+(defun vc-finish-logentry (&optional nocomment)
+  "Complete the operation implied by the current log entry.
+Use the contents of the current buffer as a check-in or registration
+comment.  If the optional arg NOCOMMENT is non-nil, then don't check
+the buffer contents as a comment."
+  (interactive)
+  ;; Check and record the comment, if any.
+  (unless nocomment
+    (run-hooks 'vc-logentry-check-hook))
+  ;; Sync parent buffer in case the user modified it while editing the comment.
+  ;; But not if it is a vc-dired buffer.
+  (with-current-buffer vc-parent-buffer
+    (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
+  (unless vc-log-operation
+    (error "No log operation is pending"))
+  ;; save the parameters held in buffer-local variables
+  (let ((log-operation vc-log-operation)
+        (log-fileset vc-log-fileset)
+        (log-revision vc-log-revision)
+        (log-entry (buffer-string))
+        (after-hook vc-log-after-operation-hook)
+        (tmp-vc-parent-buffer vc-parent-buffer))
+    (pop-to-buffer vc-parent-buffer)
+    ;; OK, do it to it
+    (save-excursion
+      (funcall log-operation
+               log-fileset
+               log-revision
+               log-entry))
+    ;; Remove checkin window (after the checkin so that if that fails
+    ;; we don't zap the *VC-log* buffer and the typing therein).
+    ;; -- IMO this should be replaced with quit-window
+    (let ((logbuf (get-buffer "*VC-log*")))
+      (cond ((and logbuf vc-delete-logbuf-window)
+             (delete-windows-on logbuf (selected-frame))
+             ;; Kill buffer and delete any other dedicated windows/frames.
+             (kill-buffer logbuf))
+            (logbuf (pop-to-buffer "*VC-log*")
+                    (bury-buffer)
+                    (pop-to-buffer tmp-vc-parent-buffer))))
+    ;; Now make sure we see the expanded headers
+    (when log-fileset
+      (mapc
+       (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+       log-fileset))
+    (when vc-dired-mode
+      (dired-move-to-filename))
+    (when (eq major-mode 'vc-dir-mode)
+      (vc-dir-move-to-goal-column))
+    (run-hooks after-hook 'vc-finish-logentry-hook)))
+
 ;;; Additional entry points for examining version histories
 
 ;; (defun vc-default-diff-tree (backend dir rev1 rev2)
@@ -2020,7 +2279,140 @@ See Info node `Merging'."
 ;;;###autoload
 (defalias 'vc-resolve-conflicts 'smerge-ediff)
 
-;; Hooks to the dired code
+;; The VC directory major mode.  Coopt Dired for this.
+;; All VC commands get mapped into logical equivalents.
+
+(defvar vc-dired-switches)
+(defvar vc-dired-terse-mode)
+
+(defvar vc-dired-mode-map
+  (let ((map (make-sparse-keymap))
+        (vmap (make-sparse-keymap)))
+    (define-key map "\C-xv" vmap)
+    (define-key map "v" vmap)
+    (set-keymap-parent vmap vc-prefix-map)
+    (define-key vmap "t" 'vc-dired-toggle-terse-mode)
+    map))
+
+(define-derived-mode vc-dired-mode dired-mode "Dired under "
+  "The major mode used in VC directory buffers.
+
+It works like Dired, but lists only files under version control, with
+the current VC state of each file being indicated in the place of the
+file's link count, owner, group and size.  Subdirectories are also
+listed, and you may insert them into the buffer as desired, like in
+Dired.
+
+All Dired commands operate normally, with the exception of `v', which
+is redefined as the version control prefix, so that you can type
+`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
+the file named in the current Dired buffer line.  `vv' invokes
+`vc-next-action' on this file, or on all files currently marked.
+There is a special command, `*l', to mark all files currently locked."
+  ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
+  ;; We do it here because dired might not be loaded yet
+  ;; when vc-dired-mode-map is initialized.
+  (set-keymap-parent vc-dired-mode-map dired-mode-map)
+  (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+  ;; The following is slightly modified from files.el,
+  ;; because file lines look a bit different in vc-dired-mode
+  ;; (the column before the date does not end in a digit).
+  ;; albinus: It should be done in the original declaration.  Problem
+  ;; is the optional empty state-info; otherwise ")" would be good
+  ;; enough as delimeter.
+  (set (make-local-variable 'directory-listing-before-filename-regexp)
+  (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+         ;; In some locales, month abbreviations are as short as 2 letters,
+         ;; and they can be followed by ".".
+         (month (concat l l "+\\.?"))
+         (s " ")
+         (yyyy "[0-9][0-9][0-9][0-9]")
+         (dd "[ 0-3][0-9]")
+         (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+         (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
+         (zone "[-+][0-2][0-9][0-5][0-9]")
+         (iso-mm-dd "[01][0-9]-[0-3][0-9]")
+         (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
+         (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
+                      "\\|" yyyy "-" iso-mm-dd "\\)"))
+         (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
+                          s "+"
+                          "\\(" HH:MM "\\|" yyyy "\\)"))
+         (western-comma (concat month s "+" dd "," s "+" yyyy))
+         ;; Japanese MS-Windows ls-lisp has one-digit months, and
+         ;; omits the Kanji characters after month and day-of-month.
+         (mm "[ 0-1]?[0-9]")
+         (japanese
+          (concat mm l "?" s dd l "?" s "+"
+                  "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
+    ;; the .* below ensures that we find the last match on a line
+    (concat ".*" s
+            "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
+            s "+")))
+  (and (boundp 'vc-dired-switches)
+       vc-dired-switches
+       (set (make-local-variable 'dired-actual-switches)
+            vc-dired-switches))
+  (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
+  (let ((backend-name (symbol-name (vc-responsible-backend
+                                    default-directory))))
+    (setq mode-name (concat mode-name backend-name))
+    ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
+    (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
+      (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
+        (cons backend-name vc-dire-menu-map) 'subdir)))
+  (setq vc-dired-mode t))
+
+(defun vc-dired-toggle-terse-mode ()
+  "Toggle terse display in VC Dired."
+  (interactive)
+  (if (not vc-dired-mode)
+      nil
+    (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+    (if vc-dired-terse-mode
+        (vc-dired-hook)
+      (revert-buffer))))
+
+(defun vc-dired-mark-locked ()
+  "Mark all files currently locked."
+  (interactive)
+  (dired-mark-if (let ((f (dired-get-filename nil t)))
+                   (and f
+                        (not (file-directory-p f))
+                        (not (vc-up-to-date-p f))))
+                 "locked file"))
+
+(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
+
+(defun vc-dired-reformat-line (vc-info)
+  "Reformat a directory-listing line.
+Replace various columns with version control information, VC-INFO.
+This code, like dired, assumes UNIX -l format."
+  (beginning-of-line)
+  (when (re-search-forward
+         ;; Match link count, owner, group, size.  Group may be missing,
+         ;; and only the size is present in OS/2 -l format.
+         "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
+         (line-end-position) t)
+      (replace-match (substring (concat vc-info "          ") 0 10)
+                     t t nil 1)))
+
+(defun vc-dired-ignorable-p (filename)
+  "Should FILENAME be ignored in VC-Dired listings?"
+  (catch t
+    ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
+    (dolist (ignorable completion-ignored-extensions)
+      (let ((ext (substring filename
+                              (- (length filename)
+                                 (length ignorable)))))
+        (if (string= ignorable ext) (throw t t))))
+    ;; Ignore Makefiles derived from something else
+    (when (string= (file-name-nondirectory filename) "Makefile")
+      (let* ((dir (file-name-directory filename))
+            (peers (directory-files (or dir default-directory))))
+        (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
+           (throw t t))))
+    nil))
 
 (defun vc-dired-hook ()
   "Reformat the listing according to version control.
@@ -2098,6 +2490,980 @@ Called by dired after any portion of a vc-dired buffer has been read in."
            (goto-char (point-min))
            (message "No changes pending under %s" default-directory)))))
 
+(defun vc-dired-purge ()
+  "Remove empty subdirs."
+  (goto-char (point-min))
+  (while (dired-get-subdir)
+    (forward-line 2)
+    (if (dired-get-filename nil t)
+        (if (not (dired-next-subdir 1 t))
+            (goto-char (point-max)))
+      (forward-line -2)
+      (if (not (string= (dired-current-directory) default-directory))
+          (dired-do-kill-lines t "")
+        ;; We cannot remove the top level directory.
+        ;; Just make it look a little nicer.
+        (forward-line 1)
+        (or (eobp) (kill-line))
+        (if (not (dired-next-subdir 1 t))
+            (goto-char (point-max))))))
+  (goto-char (point-min)))
+
+(defun vc-dired-buffers-for-dir (dir)
+  "Return a list of all vc-dired buffers that currently display DIR."
+  (let (result)
+    ;; Check whether dired is loaded.
+    (when (fboundp 'dired-buffers-for-dir)
+      (dolist (buffer (dired-buffers-for-dir dir))
+        (with-current-buffer buffer
+          (when vc-dired-mode
+            (push buffer result)))))
+    (nreverse result)))
+
+(defun vc-directory-resynch-file (file)
+  "Update the entries for FILE in any VC Dired buffers that list it."
+  ;;FIXME This needs to be implemented so it works for vc-dir
+  (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
+    (when buffers
+      (mapcar (lambda (buffer)
+                (with-current-buffer buffer
+                  (when (dired-goto-file file)
+                    ;; bind vc-dired-terse-mode to nil so that
+                    ;; files won't vanish when they are checked in
+                    (let ((vc-dired-terse-mode nil))
+                      (dired-do-redisplay 1)))))
+              buffers))))
+
+;;;###autoload
+(defun vc-directory (dir read-switches)
+  "Create a buffer in VC Dired Mode for directory DIR.
+
+See Info node `VC Dired Mode'.
+
+With prefix arg READ-SWITCHES, specify a value to override
+`dired-listing-switches' when generating the listing."
+  (interactive "DDired under VC (directory): \nP")
+  (let ((vc-dired-switches (concat vc-dired-listing-switches
+                                   (if vc-dired-recurse "R" ""))))
+    (if read-switches
+        (setq vc-dired-switches
+              (read-string "Dired listing switches: "
+                           vc-dired-switches)))
+    (require 'dired)
+    (require 'dired-aux)
+    (switch-to-buffer
+     (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
+                              vc-dired-switches
+                              'vc-dired-mode))))
+
+;; VC status implementation
+
+;; Used to store information for the files displayed in the *VC status* buffer.
+;; Each item displayed corresponds to one of these defstructs.
+(defstruct (vc-dir-fileinfo
+            (:copier nil)
+            (:type list)            ;So we can use `member' on lists of FIs.
+            (:constructor
+             ;; We could define it as an alias for `list'.
+             vc-dir-create-fileinfo (name state &optional extra marked directory))
+            (:conc-name vc-dir-fileinfo->))
+  name                                  ;Keep it as first, for `member'.
+  state
+  ;; For storing backend specific information.
+  extra
+  marked
+  ;; To keep track of not updated files during a global refresh
+  needs-update
+  ;; To distinguish files and directories.
+  directory)
+
+(defvar vc-ewoc nil)
+
+(defun vc-default-status-extra-headers (backend dir)
+  ;; Be loud by default to remind people to add coded to display
+  ;; backend specific headers.
+  ;; XXX: change this to return nil before the release.
+  "Extra      : Add backend specific headers here")
+
+(defun vc-dir-headers (backend dir)
+  "Display the headers in the *VC status* buffer.
+It calls the `status-extra-headers' backend method to display backend
+specific headers."
+  (concat
+   (propertize "VC backend : " 'face 'font-lock-type-face)
+   (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
+   (propertize "Working dir: " 'face 'font-lock-type-face)
+   (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
+   (vc-call-backend backend 'status-extra-headers dir)
+   "\n"))
+
+(defun vc-default-status-printer (backend fileentry)
+  "Pretty print FILEENTRY."
+  ;; If you change the layout here, change vc-dir-move-to-goal-column.
+  (let ((state
+         (if (vc-dir-fileinfo->directory fileentry)
+             'DIRECTORY
+           (vc-dir-fileinfo->state fileentry))))
+    (insert
+     (propertize
+      (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
+      'face 'font-lock-type-face)
+     "   "
+     (propertize
+      (format "%-20s" state)
+      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
+                  ((memq state '(missing conflict)) 'font-lock-warning-face)
+                  (t 'font-lock-variable-name-face))
+      'mouse-face 'highlight)
+     " "
+     (propertize
+      (format "%s" (vc-dir-fileinfo->name fileentry))
+      'face 'font-lock-function-name-face
+      'mouse-face 'highlight))))
+
+(defun vc-dir-printer (fileentry)
+  (let ((backend (vc-responsible-backend default-directory)))
+    (vc-call-backend backend 'status-printer fileentry)))
+
+(defun vc-dir-move-to-goal-column ()
+  ;; Used to keep the cursor on the file name column.
+  (beginning-of-line)
+  ;; Must be in sync with vc-default-status-printer.
+  (forward-char 25))
+
+(defun vc-dir-prepare-status-buffer (dir &optional create-new)
+  "Find a *vc-dir* buffer showing DIR, or create a new one."
+  (setq dir (expand-file-name dir))
+  (let* ((bname "*vc-dir*")
+         ;; Look for another *vc-dir* buffer visiting the same directory.
+         (buf (save-excursion
+                (unless create-new
+                  (dolist (buffer (buffer-list))
+                    (set-buffer buffer)
+                    (when (and (eq major-mode 'vc-dir-mode)
+                               (string= (expand-file-name default-directory) dir))
+                      (return buffer)))))))
+    (or buf
+        ;; Create a new *vc-dir* buffer.
+        (with-current-buffer (create-file-buffer bname)
+          (cd dir)
+          (vc-setup-buffer (current-buffer))
+          ;; Reset the vc-parent-buffer-name so that it does not appear
+          ;; in the mode-line.
+          (setq vc-parent-buffer-name nil)
+          (current-buffer)))))
+
+;;;###autoload
+(defun vc-dir (dir)
+  "Show the VC status for DIR."
+  (interactive "DVC status for directory: ")
+  (pop-to-buffer (vc-dir-prepare-status-buffer dir))
+  (if (eq major-mode 'vc-dir-mode)
+      (vc-dir-refresh)
+    (vc-dir-mode)))
+
+(defvar vc-dir-menu-map
+  (let ((map (make-sparse-keymap "VC-dir")))
+    (define-key map [quit]
+      '(menu-item "Quit" quit-window
+                  :help "Quit"))
+    (define-key map [kill]
+      '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
+                  :enable (vc-dir-busy)
+                  :help "Kill the command that updates VC status buffer"))
+    (define-key map [refresh]
+      '(menu-item "Refresh" vc-dir-refresh
+                  :enable (not (vc-dir-busy))
+                  :help "Refresh the contents of the VC status buffer"))
+    (define-key map [remup]
+      '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
+                  :help "Hide up-to-date items from display"))
+    ;; Movement.
+    (define-key map [sepmv] '("--"))
+    (define-key map [next-line]
+      '(menu-item "Next line" vc-dir-next-line
+                  :help "Go to the next line" :keys "n"))
+    (define-key map [previous-line]
+      '(menu-item "Previous line" vc-dir-previous-line
+                  :help "Go to the previous line"))
+    ;; Marking.
+    (define-key map [sepmrk] '("--"))
+    (define-key map [unmark-all]
+      '(menu-item "Unmark All" vc-dir-unmark-all-files
+                  :help "Unmark all files that are in the same state as the current file\
+\nWith prefix argument unmark all files"))
+    (define-key map [unmark-previous]
+      '(menu-item "Unmark previous " vc-dir-unmark-file-up
+                  :help "Move to the previous line and unmark the file"))
+
+    (define-key map [mark-all]
+      '(menu-item "Mark All" vc-dir-mark-all-files
+                  :help "Mark all files that are in the same state as the current file\
+\nWith prefix argument mark all files"))
+    (define-key map [unmark]
+      '(menu-item "Unmark" vc-dir-unmark
+                  :help "Unmark the current file or all files in the region"))
+
+    (define-key map [mark]
+      '(menu-item "Mark" vc-dir-mark
+                  :help "Mark the current file or all files in the region"))
+
+    (define-key map [sepopn] '("--"))
+    (define-key map [open-other]
+      '(menu-item "Open in other window" vc-dir-find-file-other-window
+                  :help "Find the file on the current line, in another window"))
+    (define-key map [open]
+      '(menu-item "Open file" vc-dir-find-file
+                  :help "Find the file on the current line"))
+    ;; VC info details
+    (define-key map [sepvcdet] '("--"))
+    ;; FIXME: This needs a key binding.  And maybe a better name
+    ;; ("Insert" like PCL-CVS uses does not sound that great either)...
+    (define-key map [ins]
+      '(menu-item "Show File" vc-dir-show-fileentry
+                  :help "Show a file in the VC status listing even though it might be up to date"))
+    (define-key map [annotate]
+      '(menu-item "Annotate" vc-annotate
+                  :help "Display the edit history of the current file using colors"))
+    (define-key map [diff]
+      '(menu-item "Compare with Base Version" vc-diff
+                  :help "Compare file set with the base version"))
+    (define-key map [log]
+     '(menu-item "Show history" vc-print-log
+     :help "List the change log of the current file set in a window"))
+    ;; VC commands.
+    (define-key map [sepvccmd] '("--"))
+    (define-key map [update]
+      '(menu-item "Update to latest version" vc-update
+                  :help "Update the current fileset's files to their tip revisions"))
+    (define-key map [revert]
+      '(menu-item "Revert to base version" vc-revert
+                  :help "Revert working copies of the selected fileset to their repository contents."))
+    (define-key map [next-action]
+      ;; FIXME: This really really really needs a better name!
+      ;; And a key binding too.
+      '(menu-item "Check In/Out" vc-next-action
+                  :help "Do the next logical version control operation on the current fileset"))
+    (define-key map [register]
+      '(menu-item "Register" vc-dir-register
+                  :help "Register file set into the version control system"))
+    map)
+  "Menu for VC status")
+
+(defalias 'vc-dir-menu-map vc-dir-menu-map)
+
+(defvar vc-dir-mode-map
+  (let ((map (make-keymap)))
+    (suppress-keymap map)
+    ;; Marking.
+    (define-key map "m" 'vc-dir-mark)
+    (define-key map "M" 'vc-dir-mark-all-files)
+    (define-key map "u" 'vc-dir-unmark)
+    (define-key map "U" 'vc-dir-unmark-all-files)
+    (define-key map "\C-?" 'vc-dir-unmark-file-up)
+    (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
+    ;; Movement.
+    (define-key map "n" 'vc-dir-next-line)
+    (define-key map " " 'vc-dir-next-line)
+    (define-key map "\t" 'vc-dir-next-line)
+    (define-key map "p" 'vc-dir-previous-line)
+    (define-key map [backtab] 'vc-dir-previous-line)
+    ;; VC commands.
+    (define-key map "=" 'vc-diff)   ;; C-x v =
+    (define-key map "a" 'vc-dir-register)
+    (define-key map "+" 'vc-update) ;; C-x v +
+    (define-key map "R" 'vc-revert) ;; u is taken by unmark.
+
+    ;; Can't be "g" (as in vc map), so "A" for "Annotate".
+    (define-key map "A" 'vc-annotate)
+    (define-key map "l" 'vc-print-log) ;; C-x v l
+    ;; The remainder.
+    (define-key map "f" 'vc-dir-find-file)
+    (define-key map "\C-m" 'vc-dir-find-file)
+    (define-key map "o" 'vc-dir-find-file-other-window)
+    (define-key map "x" 'vc-dir-hide-up-to-date)
+    (define-key map "q" 'quit-window)
+    (define-key map "g" 'vc-dir-refresh)
+    (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
+    (define-key map [(down-mouse-3)] 'vc-dir-menu)
+    (define-key map [(mouse-2)] 'vc-dir-toggle-mark)
+
+    ;; Hook up the menu.
+    (define-key map [menu-bar vc-dir-mode]
+      '(menu-item
+        ;; This is used to that VC backends could add backend specific
+        ;; menu items to vc-dir-menu-map.
+        "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter))
+    map)
+  "Keymap for VC status")
+
+(defun vc-default-extra-status-menu (backend)
+  nil)
+
+;; This is used to that VC backends could add backend specific menu
+;; items to vc-dir-menu-map.
+(defun vc-dir-menu-map-filter (orig-binding)
+  (when (and (symbolp orig-binding) (fboundp orig-binding))
+    (setq orig-binding (indirect-function orig-binding)))
+  (let ((ext-binding
+         (vc-call-backend (vc-responsible-backend default-directory)
+                          'extra-status-menu)))
+    (if (null ext-binding)
+        orig-binding
+      (append orig-binding
+              '("----")
+              ext-binding))))
+
+(defmacro vc-at-event (event &rest body)
+  "Evaluate `body' wich point located at event-start of `event'.
+If `body' uses `event', it should be a variable,
+ otherwise it will be evaluated twice."
+  (let ((posn (gensym "vc-at-event-posn")))
+    `(let ((,posn (event-start ,event)))
+       (save-excursion
+         (set-buffer (window-buffer (posn-window ,posn)))
+         (goto-char (posn-point ,posn))
+         ,@body))))
+
+(defun vc-dir-menu (e)
+  "Popup the VC status menu."
+  (interactive "e")
+  (vc-at-event e (popup-menu vc-dir-menu-map e)))
+
+(defvar vc-dir-tool-bar-map
+  (let ((map (make-sparse-keymap)))
+    (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
+                                   map vc-dir-mode-map)
+    (tool-bar-local-item "bookmark_add"
+                         'vc-dir-toggle-mark 'vc-dir-toggle-mark map
+                         :help "Toggle mark on current item")
+    (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
+                                   map vc-dir-mode-map
+                                   :rtl "right-arrow")
+    (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
+                                   map vc-dir-mode-map
+                                   :rtl "left-arrow")
+    (tool-bar-local-item-from-menu 'vc-print-log "info"
+                                   map vc-dir-mode-map)
+    (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
+                                   map vc-dir-mode-map)
+    (tool-bar-local-item-from-menu 'nonincremental-search-forward
+                                   "search" map)
+    (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
+                                   map vc-dir-mode-map)
+    (tool-bar-local-item-from-menu 'quit-window "exit"
+                                   map vc-dir-mode-map)
+    map))
+
+(defvar vc-dir-process-buffer nil
+  "The buffer used for the asynchronous call that computes the VC status.")
+
+(defun vc-dir-mode ()
+  "Major mode for showing the VC status for a directory.
+Marking/Unmarking key bindings and actions:
+m - marks a file/directory or ff the region is active, mark all the files
+     in region.
+    Restrictions: - a file cannot be marked if any parent directory is marked
+                  - a directory cannot be marked if any child file or
+                    directory is marked
+u - marks a file/directory or if the region is active, unmark all the files
+     in region.
+M - if the cursor is on a file: mark all the files with the same VC state as
+      the current file
+  - if the cursor is on a directory: mark all child files
+  - with a prefix argument: mark all files
+U - if the cursor is on a file: unmark all the files with the same VC state
+      as the current file
+  - if the cursor is on a directory: unmark all child files
+  - with a prefix argument: unmark all files
+
+
+\\{vc-dir-mode-map}"
+  (setq mode-name "VC Status")
+  (setq major-mode 'vc-dir-mode)
+  (setq buffer-read-only t)
+  (use-local-map vc-dir-mode-map)
+  (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)
+  (let ((buffer-read-only nil)
+        (backend (vc-responsible-backend default-directory))
+        entries)
+    (erase-buffer)
+    (set (make-local-variable 'vc-dir-process-buffer) nil)
+    (set (make-local-variable 'vc-ewoc)
+         (ewoc-create #'vc-dir-printer
+                      (vc-dir-headers backend default-directory)))
+    (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed)
+    ;; Make sure that if the VC status buffer is killed, the update
+    ;; process running in the background is also killed.
+    (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
+    (vc-dir-refresh))
+  (run-hooks 'vc-dir-mode-hook))
+
+(put 'vc-dir-mode 'mode-class 'special)
+
+;; t if directories should be shown in vc-dir.
+;; WORK IN PROGRESS!  DO NOT SET this! ONLY set it if you want to help
+;; write code for this feature.  This variable will likely disappear
+;; when the work is done.
+(defvar vc-dir-insert-directories nil)
+
+(defun vc-dir-update (entries buffer &optional noinsert)
+  "Update BUFFER's ewoc from the list of ENTRIES.
+If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
+  ;; Add ENTRIES to the vc-dir buffer BUFFER.
+  (with-current-buffer buffer
+    ;; Insert the entries sorted by name into the ewoc.
+    ;; We assume the ewoc is sorted too, which should be the
+    ;; case if we always add entries with vc-dir-update.
+    (setq entries
+          ;; Sort: first files and then subdirectories.
+          ;; XXX: this is VERY inefficient, it computes the directory
+          ;; names too many times
+          (sort entries
+                (lambda (entry1 entry2)
+                  (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
+                        (dir2 (file-name-directory (expand-file-name (car entry2)))))
+                    (cond
+                     ((string< dir1 dir2) t)
+                     ((not (string= dir1 dir2)) nil)
+                     ((string< (car entry1) (car entry2))))))))
+    (if (not vc-dir-insert-directories)
+        (let ((entry (car entries))
+              (node (ewoc-nth vc-ewoc 0)))
+          (while (and entry node)
+            (let ((entryfile (car entry))
+                  (nodefile (vc-dir-fileinfo->name (ewoc-data node))))
+              (cond
+               ((string-lessp nodefile entryfile)
+                (setq node (ewoc-next vc-ewoc node)))
+               ((string-lessp entryfile nodefile)
+                (unless noinsert
+                  (ewoc-enter-before vc-ewoc node
+                                     (apply 'vc-dir-create-fileinfo entry)))
+                (setq entries (cdr entries) entry (car entries)))
+               (t
+                (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
+                (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
+                (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
+                (ewoc-invalidate vc-ewoc node)
+                (setq entries (cdr entries) entry (car entries))
+                (setq node (ewoc-next vc-ewoc node))))))
+          (unless (or node noinsert)
+            ;; We're past the last node, all remaining entries go to the end.
+            (while entries
+              (ewoc-enter-last vc-ewoc
+                               (apply 'vc-dir-create-fileinfo (pop entries))))))
+  ;; Insert directory entries in the right places.
+  (let ((entry (car entries))
+        (node (ewoc-nth vc-ewoc 0)))
+    ;; Insert . if it is not present.
+    (unless node
+      (let ((rd (file-relative-name default-directory)))
+        (ewoc-enter-last
+         vc-ewoc (vc-dir-create-fileinfo
+                  rd nil nil nil (expand-file-name default-directory))))
+      (setq node (ewoc-nth vc-ewoc 0)))
+
+    (while (and entry node)
+      (let* ((entryfile (car entry))
+             (entrydir (file-name-directory (expand-file-name entryfile)))
+             (nodedir
+              (or (vc-dir-fileinfo->directory (ewoc-data node))
+                  (file-name-directory
+                       (expand-file-name
+                        (vc-dir-fileinfo->name (ewoc-data node)))))))
+        (cond
+         ;; First try to find the directory.
+         ((string-lessp nodedir entrydir)
+          (setq node (ewoc-next vc-ewoc node)))
+         ((string-equal nodedir entrydir)
+          ;; Found the directory, find the place for the file name.
+          (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
+            (cond
+             ((string-lessp nodefile entryfile)
+              (setq node (ewoc-next vc-ewoc node)))
+              ((string-equal nodefile entryfile)
+               (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
+               (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
+               (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
+               (ewoc-invalidate vc-ewoc node)
+               (setq entries (cdr entries) entry (car entries))
+               (setq node (ewoc-next vc-ewoc node)))
+              (t
+               (ewoc-enter-before vc-ewoc node
+                                  (apply 'vc-dir-create-fileinfo entry))
+               (setq entries (cdr entries) entry (car entries))))))
+         (t
+          ;; We need to insert a directory node
+          (let ((rd (file-relative-name entrydir)))
+            (ewoc-enter-last
+             vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))
+          ;; Now insert the node itself.
+          (ewoc-enter-before vc-ewoc node
+                             (apply 'vc-dir-create-fileinfo entry))
+          (setq entries (cdr entries) entry (car entries))))))
+    ;; We're past the last node, all remaining entries go to the end.
+    (unless (or node noinsert)
+      (let* ((lastnode (ewoc-nth vc-ewoc -1))
+             (lastdir
+              (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
+                  (file-name-directory
+                       (expand-file-name
+                        (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
+        (dolist (entry entries)
+          (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
+            ;; Insert a directory node if needed.
+            (unless (string-equal lastdir entrydir)
+              (setq lastdir entrydir)
+              (let ((rd (file-relative-name entrydir)))
+                (ewoc-enter-last
+                 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
+            ;; Now insert the node itself.
+            (ewoc-enter-last vc-ewoc
+                             (apply 'vc-dir-create-fileinfo entry))))))))))
+
+(defun vc-dir-busy ()
+  (and (buffer-live-p vc-dir-process-buffer)
+       (get-buffer-process vc-dir-process-buffer)))
+
+(defun vc-dir-refresh-files (files default-state)
+  "Refresh some files in the VC status buffer."
+  (let ((backend (vc-responsible-backend default-directory))
+        (status-buffer (current-buffer))
+        (def-dir default-directory))
+    (vc-set-mode-line-busy-indicator)
+    ;; Call the `dir-status-file' backend function.
+    ;; `dir-status-file' is supposed to be asynchronous.
+    ;; It should compute the results, and then call the function
+    ;; passed as an argument in order to update the vc-dir buffer
+    ;; with the results.
+    (unless (buffer-live-p vc-dir-process-buffer)
+      (setq vc-dir-process-buffer
+            (generate-new-buffer (format " *VC-%s* tmp status" backend))))
+    (lexical-let ((buffer (current-buffer)))
+      (with-current-buffer vc-dir-process-buffer
+        (cd def-dir)
+        (erase-buffer)
+        (vc-call-backend
+         backend 'dir-status-files def-dir files default-state
+         (lambda (entries &optional more-to-come)
+           ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
+           ;; If MORE-TO-COME is true, then more updates will come from
+           ;; the asynchronous process.
+           (with-current-buffer buffer
+             (vc-dir-update entries buffer)
+             (unless more-to-come
+               (setq mode-line-process nil)
+               ;; Remove the ones that haven't been updated at all.
+               ;; Those not-updated are those whose state is nil because the
+               ;; file/dir doesn't exist and isn't versioned.
+               (ewoc-filter vc-ewoc
+                            (lambda (info)
+                              (not (vc-dir-fileinfo->needs-update info))))))))))))
+
+(defun vc-dir-refresh ()
+  "Refresh the contents of the VC status buffer.
+Throw an error if another update process is in progress."
+  (interactive)
+  (if (vc-dir-busy)
+      (error "Another update process is in progress, cannot run two at a time")
+    (let ((backend (vc-responsible-backend default-directory))
+          (status-buffer (current-buffer))
+          (def-dir default-directory))
+      (vc-set-mode-line-busy-indicator)
+      ;; Call the `dir-status' backend function.
+      ;; `dir-status' is supposed to be asynchronous.
+      ;; It should compute the results, and then call the function
+      ;; passed as an argument in order to update the vc-dir buffer
+      ;; with the results.
+
+      ;; Create a buffer that can be used by `dir-status' and call
+      ;; `dir-status' with this buffer as the current buffer.  Use
+      ;; `vc-dir-process-buffer' to remember this buffer, so that
+      ;; it can be used later to kill the update process in case it
+      ;; takes too long.
+      (unless (buffer-live-p vc-dir-process-buffer)
+        (setq vc-dir-process-buffer
+              (generate-new-buffer (format " *VC-%s* tmp status" backend))))
+      ;; set the needs-update flag on all entries
+      (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
+                vc-ewoc)
+      (lexical-let ((buffer (current-buffer)))
+        (with-current-buffer vc-dir-process-buffer
+          (cd def-dir)
+          (erase-buffer)
+          (vc-call-backend
+           backend 'dir-status def-dir
+           (lambda (entries &optional more-to-come)
+             ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
+             ;; If MORE-TO-COME is true, then more updates will come from
+             ;; the asynchronous process.
+             (with-current-buffer buffer
+               (vc-dir-update entries buffer)
+               (unless more-to-come
+                 (let ((remaining
+                        (ewoc-collect
+                         vc-ewoc 'vc-dir-fileinfo->needs-update)))
+                   (if remaining
+                       (vc-dir-refresh-files
+                        (mapcar 'vc-dir-fileinfo->name remaining)
+                        'up-to-date)
+                     (setq mode-line-process nil))))))))))))
+
+(defun vc-dir-kill-dir-status-process ()
+  "Kill the temporary buffer and associated process."
+  (interactive)
+  (when (buffer-live-p vc-dir-process-buffer)
+    (let ((proc (get-buffer-process vc-dir-process-buffer)))
+      (when proc (delete-process proc))
+      (setq vc-dir-process-buffer nil)
+      (setq mode-line-process nil))))
+
+(defun vc-dir-kill-query ()
+  ;; Make sure that when the VC status buffer is killed the update
+  ;; process running in background is also killed.
+  (if (vc-dir-busy)
+    (when (y-or-n-p "Status update process running, really kill status buffer?")
+      (vc-dir-kill-dir-status-process)
+      t)
+    t))
+
+(defun vc-dir-next-line (arg)
+  "Go to the next line.
+If a prefix argument is given, move by that many lines."
+  (interactive "p")
+  (ewoc-goto-next vc-ewoc arg)
+  (vc-dir-move-to-goal-column))
+
+(defun vc-dir-previous-line (arg)
+  "Go to the previous line.
+If a prefix argument is given, move by that many lines."
+  (interactive "p")
+  (ewoc-goto-prev vc-ewoc arg)
+  (vc-dir-move-to-goal-column))
+
+(defun vc-dir-mark-unmark (mark-unmark-function)
+  (if (use-region-p)
+      (let ((firstl (line-number-at-pos (region-beginning)))
+            (lastl (line-number-at-pos (region-end))))
+        (save-excursion
+          (goto-char (region-beginning))
+          (while (<= (line-number-at-pos) lastl)
+            (funcall mark-unmark-function))))
+    (funcall mark-unmark-function)))
+
+(defun vc-dir-parent-marked-p (arg)
+  (when vc-dir-insert-directories
+    ;; Return nil if none of the parent directories of arg is marked.
+    (let* ((argdata (ewoc-data arg))
+           (argdir
+            (let ((crtdir (vc-dir-fileinfo->directory argdata)))
+              (if crtdir
+                  crtdir
+                (file-name-directory (expand-file-name
+                                      (vc-dir-fileinfo->name argdata))))))
+           (arglen (length argdir))
+           (crt arg)
+           data dir)
+      ;; Go through the predecessors, checking if any directory that is
+      ;; a parent is marked.
+      (while (setq crt (ewoc-prev vc-ewoc crt))
+        (setq data (ewoc-data crt))
+        (setq dir
+              (let ((crtdir (vc-dir-fileinfo->directory data)))
+                (if crtdir
+                    crtdir
+                  (file-name-directory (expand-file-name
+                                        (vc-dir-fileinfo->name data))))))
+
+        (when (and (vc-dir-fileinfo->directory data)
+                   (string-equal (substring argdir 0 (length dir)) dir))
+          (when (vc-dir-fileinfo->marked data)
+            (error "Cannot mark `%s', parent directory `%s' marked"
+                   (vc-dir-fileinfo->name argdata)
+                   (vc-dir-fileinfo->name data)))))
+      nil)))
+
+(defun vc-dir-children-marked-p (arg)
+  ;; Return nil if none of the children of arg is marked.
+  (when vc-dir-insert-directories
+    (let* ((argdata (ewoc-data arg))
+           (argdir (vc-dir-fileinfo->directory argdata))
+           (arglen (length argdir))
+           (is-child t)
+           (crt arg)
+           data dir)
+      (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
+        (setq data (ewoc-data crt))
+        (setq dir
+              (let ((crtdir (vc-dir-fileinfo->directory data)))
+                (if crtdir
+                    crtdir
+                  (file-name-directory (expand-file-name
+                                        (vc-dir-fileinfo->name data))))))
+        (if (string-equal argdir (substring dir 0 arglen))
+            (when (vc-dir-fileinfo->marked data)
+              (error "Cannot mark `%s', child `%s' marked"
+                     (vc-dir-fileinfo->name argdata)
+                     (vc-dir-fileinfo->name data)))
+          ;; We are done, we got to an entry that is not a child of `arg'.
+          (setq is-child nil)))
+      nil)))
+
+(defun vc-dir-mark-file (&optional arg)
+  ;; Mark ARG or the current file and move to the next line.
+  (let* ((crt (or arg (ewoc-locate vc-ewoc)))
+         (file (ewoc-data crt))
+         (isdir (vc-dir-fileinfo->directory file)))
+    (when (or (and isdir (not (vc-dir-children-marked-p crt)))
+              (and (not isdir) (not (vc-dir-parent-marked-p crt))))
+      (setf (vc-dir-fileinfo->marked file) t)
+      (ewoc-invalidate vc-ewoc crt)
+      (unless (or arg (mouse-event-p last-command-event))
+        (vc-dir-next-line 1)))))
+
+(defun vc-dir-mark ()
+  "Mark the current file or all files in the region.
+If the region is active, mark all the files in the region.
+Otherwise mark the file on the current line and move to the next
+line."
+  (interactive)
+  (vc-dir-mark-unmark 'vc-dir-mark-file))
+
+(defun vc-dir-mark-all-files (arg)
+  "Mark all files with the same state as the current one.
+With a prefix argument mark all files.
+If the current entry is a directory, mark all child files.
+
+The VC commands operate on files that are on the same state.
+This command is intended to make it easy to select all files that
+share the same state."
+  (interactive "P")
+  (if arg
+      ;; Mark all files.
+      (progn
+        ;; First check that no directory is marked, we can't mark
+        ;; files in that case.
+        (ewoc-map
+         (lambda (filearg)
+           (when (and (vc-dir-fileinfo->directory filearg)
+                      (vc-dir-fileinfo->directory filearg))
+             (error "Cannot mark all files, directory `%s' marked"
+                    (vc-dir-fileinfo->name filearg))))
+         vc-ewoc)
+        (ewoc-map
+         (lambda (filearg)
+           (unless (vc-dir-fileinfo->marked filearg)
+             (setf (vc-dir-fileinfo->marked filearg) t)
+             t))
+         vc-ewoc))
+    (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
+      (if (vc-dir-fileinfo->directory data)
+          ;; It's a directory, mark child files.
+          (let ((crt (ewoc-locate vc-ewoc)))
+            (unless (vc-dir-children-marked-p crt)
+              (while (setq crt (ewoc-next vc-ewoc crt))
+                (let ((crt-data (ewoc-data crt)))
+                  (unless (vc-dir-fileinfo->directory crt-data)
+                    (setf (vc-dir-fileinfo->marked crt-data) t)
+                    (ewoc-invalidate vc-ewoc crt))))))
+        ;; It's a file
+        (let ((state (vc-dir-fileinfo->state data))
+              (crt (ewoc-nth vc-ewoc 0)))
+          (while crt
+            (let ((crt-data (ewoc-data crt)))
+              (when (and (not (vc-dir-fileinfo->marked crt-data))
+                         (eq (vc-dir-fileinfo->state crt-data) state)
+                         (not (vc-dir-fileinfo->directory crt-data)))
+                (vc-dir-mark-file crt)))
+            (setq crt (ewoc-next vc-ewoc crt))))))))
+
+(defun vc-dir-unmark-file ()
+  ;; Unmark the current file and move to the next line.
+  (let* ((crt (ewoc-locate vc-ewoc))
+         (file (ewoc-data crt)))
+    (setf (vc-dir-fileinfo->marked file) nil)
+    (ewoc-invalidate vc-ewoc crt)
+    (unless (mouse-event-p last-command-event)
+      (vc-dir-next-line 1))))
+
+(defun vc-dir-unmark ()
+  "Unmark the current file or all files in the region.
+If the region is active, unmark all the files in the region.
+Otherwise mark the file on the current line and move to the next
+line."
+  (interactive)
+  (vc-dir-mark-unmark 'vc-dir-unmark-file))
+
+(defun vc-dir-unmark-file-up ()
+  "Move to the previous line and unmark the file."
+  (interactive)
+  ;; If we're on the first line, we won't move up, but we will still
+  ;; remove the mark.  This seems a bit odd but it is what buffer-menu
+  ;; does.
+  (let* ((prev (ewoc-goto-prev vc-ewoc 1))
+         (file (ewoc-data prev)))
+    (setf (vc-dir-fileinfo->marked file) nil)
+    (ewoc-invalidate vc-ewoc prev)
+    (vc-dir-move-to-goal-column)))
+
+(defun vc-dir-unmark-all-files (arg)
+  "Unmark all files with the same state as the current one.
+With a prefix argument unmark all files.
+If the current entry is a directory, unmark all the child files.
+
+The VC commands operate on files that are on the same state.
+This command is intended to make it easy to deselect all files
+that share the same state."
+  (interactive "P")
+  (if arg
+      (ewoc-map
+       (lambda (filearg)
+         (when (vc-dir-fileinfo->marked filearg)
+           (setf (vc-dir-fileinfo->marked filearg) nil)
+           t))
+       vc-ewoc)
+    (let* ((crt (ewoc-locate vc-ewoc))
+           (data (ewoc-data crt)))
+      (if (vc-dir-fileinfo->directory data)
+          ;; It's a directory, unmark child files.
+          (while (setq crt (ewoc-next vc-ewoc crt))
+            (let ((crt-data (ewoc-data crt)))
+              (unless (vc-dir-fileinfo->directory crt-data)
+                (setf (vc-dir-fileinfo->marked crt-data) nil)
+                (ewoc-invalidate vc-ewoc crt))))
+        ;; It's a file
+        (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
+          (ewoc-map
+           (lambda (filearg)
+             (when (and (vc-dir-fileinfo->marked filearg)
+                        (eq (vc-dir-fileinfo->state filearg) crt-state))
+               (setf (vc-dir-fileinfo->marked filearg) nil)
+               t))
+           vc-ewoc))))))
+
+(defun vc-dir-toggle-mark-file ()
+  (let* ((crt (ewoc-locate vc-ewoc))
+         (file (ewoc-data crt)))
+    (if (vc-dir-fileinfo->marked file)
+        (vc-dir-unmark-file)
+      (vc-dir-mark-file))))
+
+(defun vc-dir-toggle-mark (e)
+  (interactive "e")
+  (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
+
+(defun vc-dir-register ()
+  "Register the marked files, or the current file if no marks."
+  (interactive)
+  ;; FIXME: Just pass the fileset to vc-register.
+  (mapc (lambda (arg) (vc-register nil arg))
+        (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
+
+(defun vc-dir-delete-file ()
+  "Delete the marked files, or the current file if no marks."
+  (interactive)
+  (mapc 'vc-delete-file (or (vc-dir-marked-files)
+                            (list (vc-dir-current-file)))))
+
+(defun vc-dir-show-fileentry (file)
+  "Insert an entry for a specific file into the current VC status listing.
+This is typically used if the file is up-to-date (or has been added
+outside of VC) and one wants to do some operation on it."
+  (interactive "fShow file: ")
+  (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
+
+(defun vc-dir-find-file ()
+  "Find the file on the current line."
+  (interactive)
+  (find-file (vc-dir-current-file)))
+
+(defun vc-dir-find-file-other-window ()
+  "Find the file on the current line, in another window."
+  (interactive)
+  (find-file-other-window (vc-dir-current-file)))
+
+(defun vc-dir-current-file ()
+  (let ((node (ewoc-locate vc-ewoc)))
+    (unless node
+      (error "No file available."))
+    (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
+
+(defun vc-dir-marked-files ()
+  "Return the list of marked files."
+  (mapcar
+   (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
+   (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
+
+(defun vc-dir-marked-only-files ()
+  "Return the list of marked files, for marked directories, return child files."
+
+  (let ((crt (ewoc-nth vc-ewoc 0))
+        result)
+    (while crt
+      (let ((crt-data (ewoc-data crt)))
+        (if (vc-dir-fileinfo->marked crt-data)
+            (if (vc-dir-fileinfo->directory crt-data)
+                (let* ((dir (vc-dir-fileinfo->directory crt-data))
+                       (dirlen (length dir))
+                       data)
+                  (while
+                      (and (setq crt (ewoc-next vc-ewoc crt))
+                           (string-equal
+                            (substring
+                             (progn
+                               (setq data (ewoc-data crt))
+                               (let ((crtdir (vc-dir-fileinfo->directory data)))
+                                 (if crtdir
+                                     crtdir
+                                   (file-name-directory
+                                    (expand-file-name
+                                     (vc-dir-fileinfo->name data))))))
+                             0 dirlen)
+                            dir))
+                    (unless (vc-dir-fileinfo->directory data)
+                      (push (vc-dir-fileinfo->name data) result))))
+              (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
+              (setq crt (ewoc-next vc-ewoc crt)))
+          (setq crt (ewoc-next vc-ewoc crt)))))
+    result))
+
+(defun vc-dir-hide-up-to-date ()
+  "Hide up-to-date items from display."
+  (interactive)
+  (ewoc-filter
+   vc-ewoc
+   (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
+
+(defun vc-default-status-fileinfo-extra (backend file)
+  nil)
+
+(defun vc-dir-mark-buffer-changed (&optional fname)
+  (let* ((file (or fname (expand-file-name buffer-file-name)))
+         (found-vc-dir-buf nil))
+    (save-excursion
+      (dolist (status-buf (buffer-list))
+        (set-buffer status-buf)
+        ;; look for a vc-dir buffer that might show this file.
+        (when (eq major-mode 'vc-dir-mode)
+          (setq found-vc-dir-buf t)
+          (let ((ddir (expand-file-name default-directory)))
+            ;; This test is cvs-string-prefix-p
+            (when (eq t (compare-strings file nil (length ddir) ddir nil nil))
+              (let*
+                  ((file-short (substring file (length ddir)))
+                   (backend (vc-backend file))
+                   (state (and backend (vc-state file)))
+                   (extra
+                    (and backend
+                         (vc-call-backend backend 'status-fileinfo-extra file)))
+                   (entry
+                    (list file-short (if state state 'unregistered) extra)))
+                (vc-dir-update (list entry) status-buf))))))
+      ;; We didn't find any vc-dir buffers, remove the hook, it is
+      ;; not needed.
+      (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-mark-buffer-changed)))))
+
 ;; Named-configuration entry points
 
 (defun vc-snapshot-precondition (dir)
@@ -3307,6 +4673,30 @@ The annotations are relative to the current time, unless overridden by OFFSET."
   (set-buffer-modified-p nil)
   (setq buffer-file-name nil))
 
+;; These things should probably be generally available
+
+(defun vc-file-tree-walk (dirname func &rest args)
+  "Walk recursively through DIRNAME.
+Invoke FUNC f ARGS on each VC-managed file f underneath it."
+  (vc-file-tree-walk-internal (expand-file-name dirname) func args)
+  (message "Traversing directory %s...done" dirname))
+
+(defun vc-file-tree-walk-internal (file func args)
+  (if (not (file-directory-p file))
+      (when (vc-backend file) (apply func file args))
+    (message "Traversing directory %s..." (abbreviate-file-name file))
+    (let ((dir (file-name-as-directory file)))
+      (mapcar
+       (lambda (f) (or
+               (string-equal f ".")
+               (string-equal f "..")
+               (member f vc-directory-exclusion-list)
+               (let ((dirf (expand-file-name f dir)))
+                 (or
+                  (file-symlink-p dirf) ;; Avoid possible loops.
+                  (vc-file-tree-walk-internal dirf func args)))))
+       (directory-files dir)))))
+
 (provide 'vc)
 
 ;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE