Re: vc-*-root finctions

[Thien-Thi Nguyen <ttn@gnuvola.org>]

[-- Attachment #1: Type: text/plain, Size: 3266 bytes --]

() Dan Nicolaescu <dann@ics.uci.edu>
() Wed, 20 Feb 2008 10:50:41 -0800

   Allowing the user to look at the status from the root of the VC tree
   seems like a good idea.  But is this the right UI for it?  It does not
   seem very intuitive to me...

It's just a shortcut for M-x vc-status RET <ROOT> RET.  In the following
updated patch, all subdirs from root downward are buttonized (not just root).

     > ! ;;   for the files in DIR.  This function is called twice,
                                                   ^^^^^^^^^^^^^^^^
   Can you please explain why?

     > ! ;;   time with KICKP t, the second time, with KICKP nil.

   What's the meaning of KICKP ? 

There is now a lengthy comment in vc-status-refresh that addresses
these questions.

     > ! ;;   If the backend workings are asynchronous,

   Why bother making the backend synchronous?

To support asynchronous behavior well, we wish to keep the user informed,
i.e, updating some visible status at the asynchronous boundaries (twice).
If the backend is very fast (completes below some threshold, say 0.5 sec),
this double update appears as a flickering, and is not only uninformative,
it may be downright bewildering.  Thus, a friendly backend may choose to
operate synchronously if it is confident that it can do its job under some
other reasonable threshold for user patience (say 3-5 seconds).  This is the
backend's business; vc.el should not presume to know.

You can see this consideration in play in vc-git-dir-status, which eschews
asynchronous operation completely, so confident it is.  On the other hand,
in vc-svn-dir-status, i have placed a TODO comment where someone who knows
subversion better can add code to dynamically determine how to DTRT there.

   The current API can be used by a synchronous backend too.  It just needs
   to call the UPDATE-FUNCTION when done processing.

Yes, but removing the need to specify UPDATE-FUNCTION is better.

   - (defun vc-status-headers (backend dir)
   -   (concat
   -    (format "VC backend : %s\n" backend)
   -    "Repository : The repository goes here\n"
   -    (format "Working dir: %s\n" dir)))
   - 

   Why remove this? 

For several reasons (w/ current patch):
 - For some backends, "working dir" and "repository" are one and the same.
 - Which backend is reflected in the mode line (re-using var vc-mode).
 - The vc-BACKEND-dir-status return value now allows the backend to
   include arbitrary backend- and/or dir-specific metainfo.
   See vc-svn-dir-status for an example.

     > !                    (format "  Updated: %s -- %s working...\n"

   Is this the time when vc-status was last run?  That might be confusing
   for the user, he might think that "Updated:" means the last time he
   updated the his sources from the VC system.

Good point.  I have modified vc-status-refresh to constrain itself to the
first line; second line and onward completely up to the backend.

   This function is much more complicated now, it's not obvious why.
   Can you please explain?

"It takes a tough man to get a tender chicken" (or something along those
lines ;--).  Please see comment in vc-status-refresh.

thi


______________________________________________________________
changelog entries same as before

full munging

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: full munging --]
[-- Type: text/x-diff, Size: 24230 bytes --]

--- vc.el.~1.538~	2008-02-21 10:48:20.000000000 +0100
+++ vc.el	2008-02-21 15:55:55.000000000 +0100
@@ -167,18 +167,24 @@
 ;;   in older versions this method was not required to recurse into
 ;;   subdirectories.)
 ;;
-;; - dir-status (dir update-function status-buffer)
+;; - dir-status (kickp)
 ;;
-;;   Produce RESULT: a list of conses of the form (file . vc-state)
-;;   for the files in DIR.  If a command needs to be run to compute
-;;   this list, it should be run asynchronously.  When RESULT is
-;;   computed, it should be passed back by doing:
-;;       (funcall UPDATE-FUNCTION RESULT STATUS-BUFFER)
 ;;   This function is used by vc-status, a replacement for vc-dired.
 ;;   vc-status is still under development, and is NOT feature
 ;;   complete.  As such, the requirements for this function might
-;;   change.
-;;   This is a replacement for dir-state.
+;;   change.  This is a replacement for dir-state.
+;;
+;;   Produce a list (BLURB RESULT).  BLURB is a possibly-multiline,
+;;   newline-terminated string (or the empty string "").  RESULT is a
+;;   list of conses of the form (file . vc-state) for the files in
+;;   DIR.  This function is called twice, the first time with KICKP t,
+;;   the second time, with KICKP nil.  In both calls, the current
+;;   buffer is a scratch buffer with `default-directory' set
+;;   appropriately.  If the backend workings are asynchronous, it must
+;;   start the subprocess when KICKP is t, using the current buffer as
+;;   its process buffer.  The return value of the second call is the
+;;   above-described list.  See comments in `vc-status-refresh' for
+;;   more info.
 ;;
 ;; * working-revision (file)
 ;;
@@ -606,6 +612,7 @@
 (eval-when-compile
   (require 'cl)
   (require 'compile)
+  (require 'button)
   (require 'dired)      ; for dired-map-over-marks macro
   (require 'dired-aux))	; for dired-kill-{line,tree}
 
@@ -918,6 +925,10 @@
 (defvar vc-dired-mode nil)
 (make-variable-buffer-local 'vc-dired-mode)
 
+(defsubst vc-overview-p ()
+  "Return non-nil if current buffer is in VC Dired or VC Status mode."
+  (memq major-mode '(vc-dired-mode vc-status-mode)))
+
 ;; File property caching
 
 (defun vc-clear-context ()
@@ -1794,9 +1805,7 @@
 \(current one if no file).  AFTER-HOOK specifies the local value
 for `vc-log-after-operation-hook'."
   (let ((parent
-         (if (eq major-mode 'vc-dired-mode)
-             ;; If we are called from VC dired, the parent buffer is
-             ;; the current buffer.
+         (if (vc-overview-p)
              (current-buffer)
            (if (and files (equal (length files) 1))
                (get-file-buffer (car files))
@@ -1934,7 +1943,7 @@
   ;; 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 (vc-buffer-sync)))
+    (unless (vc-overview-p) (vc-buffer-sync)))
   (if (not vc-log-operation)
       (error "No log operation is pending"))
   ;; save the parameters held in buffer-local variables
@@ -2641,12 +2650,7 @@
   name)
 
 (defvar vc-status nil)
-
-(defun vc-status-headers (backend dir)
-  (concat
-   (format "VC backend : %s\n" backend)
-   "Repository : The repository goes here\n"
-   (format "Working dir: %s\n" dir)))
+(defvar vc-status-overlay nil)
 
 (defun vc-status-printer (fileentry)
   "Pretty print FILEENTRY."
@@ -2673,12 +2677,27 @@
 
 ;;;###autoload
 (defun vc-status (dir)
-  "Show the VC status for DIR."
+  "Show the VC status for DIR in its own buffer.
+Reuse an existing buffer if possible, otherwise create a new one
+and place it in `vc-status-mode'.  Lastly, run `vc-status-refresh'."
   (interactive "DVC status for directory: ")
-  (vc-setup-buffer "*vc-status*")
-  (switch-to-buffer "*vc-status*")
-  (cd dir)
-  (vc-status-mode))
+  (setq dir (file-name-as-directory dir))
+  (let ((ls (buffer-list))
+        buf)
+    (while (and ls (not buf))
+      (with-current-buffer (car ls)
+        (when (and vc-status (string= dir default-directory))
+          (setq buf (car ls)))
+        (setq ls (cdr ls))))
+    (unless buf
+      (set-buffer (setq buf (get-buffer-create
+                             (generate-new-buffer-name
+                              (file-name-nondirectory
+                               (directory-file-name dir))))))
+      (setq default-directory dir)
+      (vc-status-mode))
+    (switch-to-buffer buf))
+  (vc-status-refresh))
 
 (defvar vc-status-mode-map
   (let ((map (make-keymap)))
@@ -2777,42 +2796,177 @@
 
 (defun vc-status-mode ()
   "Major mode for VC status.
+Prepare the buffer to begin with the line:
+
+Directory: DEFAULT-DIRECTORY
+
+In DEFAULT-DIRECTORY, all filename components starting from the
+project's \"root\" directory are displayed as buttons whose action
+is to run command `vc-status' in the respective directory.
+
+Keys do not self-insert; instead they do different things:
 \\{vc-status-mode-map}"
-  (setq mode-name "*VC Status*")
-  (setq major-mode 'vc-status-mode)
-  (setq buffer-read-only t)
-  (use-local-map vc-status-mode-map)
-  (let ((buffer-read-only nil)
-	(backend (vc-responsible-backend default-directory))
-	entries)
-    (erase-buffer)
+  (buffer-disable-undo)
+  (erase-buffer)
+  (let* ((backend (vc-responsible-backend default-directory))
+         (find-root (vc-find-backend-function backend 'root))
+         ;; Use `(or (when ...))' in case `find-root' => nil.
+         (root (or (when find-root
+                     (funcall find-root default-directory))
+                   default-directory)))
+    (setq major-mode 'vc-status-mode
+          mode-name "VC Status"
+          vc-mode (symbol-name backend))
+    (insert "Directory: ")
+    (let* ((parent (directory-file-name
+                    (file-name-directory
+                     (directory-file-name root))))
+           (p (point))
+           (components (split-string (substring default-directory
+                                                (length parent))
+                                     "/" t))
+           full)
+      (insert parent)
+      ;; Make buttons for each directory from root down.  Mice, feh.
+      ;; (For some backends, this degenerates to simply default dir.)
+      (dolist (name components)
+        (insert "/")
+        (setq full (concat (buffer-substring-no-properties p (point)) name))
+        (insert-text-button
+         name
+         'dir full
+         'action (lambda (button)
+                   (vc-status (button-get button 'dir)))
+         'follow-link t)))
+    ;; Add some whitespace and then a placeholder character that hosts
+    ;; the overlay for displaying refresh progress (timestamp, "working").
+    (insert "     -")
+    (set (make-local-variable 'vc-status-overlay)
+         (make-overlay (1- (point)) (point)))
+    (insert "\n")
     (set (make-local-variable 'vc-status)
-	 (ewoc-create #'vc-status-printer
-		      (vc-status-headers backend default-directory)))
-    (vc-status-refresh)))
+         (ewoc-create #'vc-status-printer))
+    (use-local-map vc-status-mode-map)
+    (setq buffer-read-only t)))
 
 (put 'vc-status-mode 'mode-class 'special)
 
-(defun vc-update-vc-status-buffer (entries buffer)
-  (with-current-buffer buffer
-    (dolist (entry entries)
-      (ewoc-enter-last vc-status
-		       (vc-status-create-fileinfo (cdr entry) (car entry))))
-    (ewoc-goto-node vc-status (ewoc-nth vc-status 0))))
-
 (defun vc-status-refresh ()
-  "Refresh the contents of the VC status buffer."
+  "Refresh the contents of the VC Status buffer.
+Display at end of first line the HH:MM:SS when the buffer was refreshed.
+Display backend-specific info starting from the second line.
+Lastly, display `fileinfo' entries, one per line.
+
+If the backend works asynchronously, display \"(BACKEND working)\"
+following the timestamp, and arrange for subsequent calls to
+`vc-status-refresh' (while still working) to signal error."
   (interactive)
-  ;; This is not very efficient; ewoc could use a new function here.
-  (ewoc-filter vc-status (lambda (node) nil))
-  (let ((backend (vc-responsible-backend default-directory)))
-    ;; Call the dir-status backend function. dir-status is supposed to
-    ;; be asynchronous.  It should compute the results and call the
-    ;; function passed as a an arg to update the vc-status buffer with
-    ;; the results.
-    (vc-call-backend
-     backend 'dir-status default-directory
-     #'vc-update-vc-status-buffer (current-buffer))))
+  (unless vc-status
+    (error "Not in a VC Status buffer"))
+  (when mode-line-process
+    (error "Refresh in progress (please wait, or kill buffer)"))
+  (let* ((backend (vc-responsible-backend default-directory))
+         (get-status (cond ((vc-find-backend-function backend 'dir-status))
+                           (t (kill-buffer nil)
+                              (error "No vc-status support for %s"
+                                     backend))))
+         (here (current-buffer))
+         ;; We manage the scratch buffer, instead of letting the backend
+         ;; handle it, for two reasons: (a) it's easy to extract process
+         ;; status from that buffer since we know about it; (b) reducing
+         ;; potential programming error in the backend is Good Planning.
+         (scratch (get-buffer-create (format " vc status: %s"
+                                             default-directory)))
+         notice)
+    ;; We used to do this: Call the backend function, passing it the
+    ;; default directory, a callback, and the buffer `here'; require
+    ;; that the backend call the callback with its result and (again)
+    ;; `here'; require that the callback do its thing in buffer `here';
+    ;; implement a callback that satisfied the requirement.
+    ;;
+    ;; This was very general, but proved suboptimal in practice:
+    ;; - There was only one function ever passed as the callback,
+    ;;   so that variability just introduced failure modes.
+    ;; - Likewise for the (lone) callback, there is only one family
+    ;;   of callers; to handle inappropriate calls would require
+    ;;   more arg checking, and "intention synchronization".
+    ;; - Each backend managed its own temporary process buffer,
+    ;;   sometimes buggily (eg, never discarding old buffers),
+    ;;   and there was no way to get process status info.
+    ;; - The default directory of buffer `here' can be computed from
+    ;;   `here', so that variability just introduced failure modes.
+    ;;
+    ;; These problems can all be lumped under the concept "unneeded
+    ;; exposure": More functions, more arguments, more "should call"
+    ;; sequences, more ways to shoot yourself in the foot.  To remedy
+    ;; this, we move (most of) the inherent (irreducible) complexity of
+    ;; an asynchronous-support architecture from the (call)stack to the
+    ;; buffer, a central and strongly-supported data structure in Emacs.
+    ;;
+    ;; Essentially the transformation is: "Stay put!"  That is, rather
+    ;; than passing location information around, establish fixed locations
+    ;; and arrange for the backend to be called "there".  More concretely,
+    ;; this means we manage the buffers -- including lifetime of scratch
+    ;; buffer -- in one function, using `with-current-buffer' and other
+    ;; available "current buffer" support, for specifying input (output is
+    ;; still returned on the stack).
+    ;;
+    ;; In exchange for this simplicity, the backend must conform to a
+    ;; "two-phase" calling sequence.  In the first phase, "kick", the
+    ;; backend starts the subprocess; in the second phase, "collect",
+    ;; it does the rest of the work to compute its result.  Thus, the
+    ;; only argument the backend needs is PHASE.
+    ;;
+    ;;  (defun vc-BACKEND-dir-status (phase)
+    ;;    (case phase (kick (START-ASYNC-SUBPROCESS))
+    ;;                (collect (let (result)
+    ;;                           (GROVEL-OVER-OUTPUT)
+    ;;                           result))))
+    ;;
+    ;; Furthermore, there are only two phases, so this can be
+    ;; represented by a boolean, KICKP.
+    ;;
+    ;;  (defun vc-BACKEND-dir-status (kickp)
+    ;;    (if kickp
+    ;;        (START-ASYNC-SUBPROCESS)
+    ;;      (let (result)
+    ;;        (GROVEL-OVER-OUTPUT)
+    ;;        result)))
+    ;;
+    ;; Note the backend is not required to work asynchronously.
+    ;; (This has not changed from before, comments notwithstanding. ;-)
+    ;;
+    ;; Call the backend function in two-phase style.  First, kick...
+    (with-current-buffer scratch
+      (erase-buffer)
+      (funcall get-status t))
+    ;; Clue in the user if things are working asynchronously.
+    (when (setq notice (buffer-local-value 'mode-line-process scratch))
+      (overlay-put vc-status-overlay 'display
+                   (format "%s (%s working)" (format-time-string "%T")
+                           backend))
+      (setq mode-line-process notice))
+    (with-current-buffer scratch
+      (vc-exec-after
+       ;; ... then collect.
+       `(let* ((tuple (,get-status nil))
+               (blurb (pop tuple))
+               (entries (pop tuple)))
+          (when (buffer-live-p ,here)
+            (with-current-buffer ,here
+              (ewoc-filter vc-status 'ignore)
+              (dolist (entry entries)
+                (ewoc-enter-last vc-status (vc-status-create-fileinfo
+                                            (cdr entry) (car entry))))
+              (let ((first (ewoc-nth vc-status 0)))
+                (when first
+                  (ewoc-goto-node vc-status first)
+                  (vc-status-move-to-goal-column))
+                (ewoc-set-hf vc-status blurb (if first "" "(no entries)"))
+                (overlay-put vc-status-overlay 'display
+                             (format-time-string "%T"))
+                (setq mode-line-process nil))))
+          (kill-buffer nil))))))
 
 (defun vc-status-next-line (arg)
   "Go to the next line.
--- vc-svn.el.~1.70~	2008-02-21 15:56:53.000000000 +0100
+++ vc-svn.el	2008-02-21 14:51:29.000000000 +0100
@@ -158,34 +158,32 @@
       (vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
       (vc-svn-parse-status))))
 
-(defun vc-svn-after-dir-status (callback buffer)
-  (let ((state-map '((?A . added)
-                    (?C . edited)
-                    (?D . removed)
-                    (?I . ignored)
-                    (?M . edited)
-                    (?R . removed)
-                    (?? . unregistered)
-                    ;; This is what vc-svn-parse-status does.
-                    (?~ . edited)))
-       result)
-    (goto-char (point-min))
-    (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
-      (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
-           (filename (match-string 2)))
-       (when state
-         (setq result (cons (cons filename state) result)))))
-    (funcall callback result buffer)))
-
-(defun vc-svn-dir-status (dir callback buffer)
-  "Run 'svn status' for DIR and update BUFFER via CALLBACK.
-CALLBACK is called as (CALLBACK RESULT BUFFER), where
-RESULT is a list of conses (FILE . STATE) for directory DIR."
-  (with-current-buffer (get-buffer-create
-                       (generate-new-buffer-name " *vc svn status*"))
-    (vc-svn-command (current-buffer) 'async nil "status")
-    (vc-exec-after
-     `(vc-svn-after-dir-status (quote ,callback) ,buffer))))
+(defun vc-svn-dir-status (kickp)
+  "Return a list of conses (FILE . STATE) for the default directory."
+  (if kickp
+      ;; TODO: Conditionally synchronous.
+      (vc-svn-command (current-buffer) 'async nil "status")
+    (let ((state-map '((?A . added)
+                       (?C . edited)
+                       (?D . removed)
+                       (?I . ignored)
+                       (?M . edited)
+                       (?R . removed)
+                       (?? . unregistered)
+                       ;; This is what vc-svn-parse-status does.
+                       (?~ . edited)))
+          result)
+      (goto-char (point-min))
+      (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
+        (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
+              (filename (match-string 2)))
+          (when state
+            (setq result (cons (cons filename state) result)))))
+      (list (shell-command-to-string
+             ;; TODO: Make customizable.
+             ;;"svn info . | sed '/Revision:/!d'"
+             "svn info . | sed '/Path:/d;/Node Kind:/d'")
+            result))))
 
 (defun vc-svn-working-revision (file)
   "SVN-specific version of `vc-working-revision'."
--- vc-hg.el.~1.50~	2008-02-21 10:30:55.000000000 +0100
+++ vc-hg.el	2008-02-21 11:19:01.000000000 +0100
@@ -483,42 +483,34 @@
 
 (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming")
 
-;; XXX Experimental function for the vc-dired replacement.
-(defun vc-hg-after-dir-status (update-function buff)
-  (let ((status-char nil)
-	(file nil)
-	(translation '((?= . up-to-date)
-		       (?C . up-to-date)
-		       (?A . added)
-		       (?R . removed)
-		       (?M . edited)
-		       (?I . ignored)
-		       (?! . deleted)
-		       (?? . unregistered)))
-	(translated nil)
-	  (result nil))
+(defun vc-hg-dir-status (kickp)
+  "Return a list of conses (FILE . STATE) for the default directory."
+  (if kickp
+      ;; TODO: Conditionally synchronous.
+      (vc-hg-command (current-buffer) 'async default-directory "status")
+    (let ((status-char nil)
+          (file nil)
+          (translation '((?= . up-to-date)
+                         (?C . up-to-date)
+                         (?A . added)
+                         (?R . removed)
+                         (?M . edited)
+                         (?I . ignored)
+                         (?! . deleted)
+                         (?? . unregistered)))
+          (translated nil)
+          (result nil))
       (goto-char (point-min))
       (while (not (eobp))
-	(setq status-char (char-after))
-	(setq file
-	      (buffer-substring-no-properties (+ (point) 2)
-					      (line-end-position)))
-	(setq translated (assoc status-char translation))
-	(when (and translated (not (eq (cdr translated) 'up-to-date)))
-	  (push (cons file (cdr translated)) result))
-	(forward-line))
-      (funcall update-function result buff)))
-
-;; XXX Experimental function for the vc-dired replacement.
-(defun vc-hg-dir-status (dir update-function status-buffer)
-  "Return a list of conses (file . state) for DIR."
-  (with-current-buffer
-      (get-buffer-create
-       (expand-file-name " *VC-hg* tmp status" dir))
-    (erase-buffer)
-    (vc-hg-command (current-buffer) 'async dir "status")
-    (vc-exec-after
-     `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer))))
+        (setq status-char (char-after))
+        (setq file
+              (buffer-substring-no-properties (+ (point) 2)
+                                              (line-end-position)))
+        (setq translated (assoc status-char translation))
+        (when (and translated (not (eq (cdr translated) 'up-to-date)))
+          (push (cons file (cdr translated)) result))
+        (forward-line))
+      (list "" result))))
 
 ;; XXX this adds another top level menu, instead figure out how to
 ;; replace the Log-View menu.
--- vc-git.el.~1.38~	2008-02-21 10:31:02.000000000 +0100
+++ vc-git.el	2008-02-21 15:46:21.000000000 +0100
@@ -207,52 +207,53 @@
       ;; fall back to the default VC representation
       (vc-default-dired-state-info 'Git file))))
 
-;;; vc-dir-status support (EXPERIMENTAL)
-;;; If vc-directory (which is not half bad under Git, w/ some tweaking)
-;;; is to go away, vc-dir-status must at least support the same operations.
-;;; At the moment, vc-dir-status design is still fluid (a kind way to say
-;;; half-baked, undocumented, and spottily-supported), so the following
-;;; should be considered likewise ripe for sudden unannounced change.
-;;; YHBW, HAND.  --ttn
-
-(defun vc-git-after-dir-status (callback buffer)
-  (sort-regexp-fields t "^. \\(.+\\)$" "\\1" (point-min) (point-max))
-  (let ((map '((?H . cached)
-               (?M . unmerged)
-               (?R . removed)
-               (?C . edited)
-               (?K . removed)           ; ??? "to be killed"
-               (?? . unregistered)))
-        status filename result)
-    (goto-char (point-min))
-    (while (> (point-max) (point))
-      (setq status (string-to-char (buffer-substring (point) (1+ (point))))
-            status (cdr (assq status map))
-            filename (buffer-substring (+ 2 (point)) (line-end-position)))
-      ;; TODO: Add dynamic selection of which status(es) to display, and
-      ;; bubble that up to vc-dir-status.  For now, we consider `cached'
-      ;; to be uninteresting, to mimic vc-directory (somewhat).
-      (unless (eq 'cached status)
+(defun vc-git-dir-status (kickp)
+  "Return a list of conses (FILE . STATE) for the default directory."
+  ;; Don't do it asynchronously; git is fast and always local.
+  ;; (vc-git-command (current-buffer) 'async default-directory "status")
+  (unless kickp
+    ;; Avoid "-a" so as to be able to distinguish "in index".
+    (call-process "git" nil t nil "status")
+    (let* ((root (vc-git-root default-directory))
+           (sub (file-relative-name default-directory root))
+           ;; If we are not in the project's root dir, discard
+           ;; lines that do not have the relative-dir prefix.
+           (keep-rx (concat "^#\t\\([^:]+\\): +"
+                            (if (member sub '("." "./"))
+                                ""
+                              (file-name-as-directory sub))))
+           (pair-rx (concat keep-rx "\\(.+\\)$"))
+           status filename result)
+      (goto-char (point-min))
+      ;; Encode "in index" in the state; eg: `modified' vs `modified/in'.
+      (when (search-forward "\n# Changes to be committed:\n" nil t)
+        (search-forward "#\t")
+        (forward-char -2)
+        (while (looking-at "#\t[^:]+\\(:\\)")
+          (replace-match "/in:" t t nil 1)
+          (forward-line 1)))
+      (when (search-forward "\n# Untracked files:\n" nil t)
+        (while (re-search-forward "^#\t" nil t)
+          (insert "untracked: ")))
+      (keep-lines keep-rx (point-min) (point-max))
+      ;; This sorting is purely cosmetic.  We will probably remove it a
+      ;; little further down the road, when VC Status learns to manage
+      ;; total ordering and all that jazz.  --ttn
+      (sort-regexp-fields t pair-rx "\\2" (point-min) (point-max))
+      (goto-char (point-min))
+      (while (re-search-forward pair-rx nil t)
+        (setq status (match-string 1)
+              status (if (string-match "new file" status)
+                         (replace-match "new" t t status)
+                       status)
+              status (intern status)
+              filename (match-string 2))
+        (when (memq status '(renamed renamed/in copied copied/in))
+          ;; Discard first name: "ONE -> TWO" becomes "TWO".
+          (setq filename (substring filename
+                                    (+ 4 (string-match " -> " filename)))))
         (push (cons filename status) result))
-      (forward-line 1))
-    (funcall callback result buffer)))
-
-(defun vc-git-dir-status (dir update-function status-buffer)
-  "Return a list of conses (file . state) for DIR."
-  (with-current-buffer
-      (get-buffer-create
-       (expand-file-name " *VC-Git* tmp status" dir))
-    (erase-buffer)
-    (vc-git-command (current-buffer) 'async dir "ls-files" "-t"
-                    "-c"                ; cached
-                    "-d"                ; deleted
-                    "-k"                ; killed
-                    "-m"                ; modified
-                    "-o"                ; others
-                    "--directory"
-                    "--exclude-per-directory=.gitignore")
-    (vc-exec-after
-     `(vc-git-after-dir-status (quote ,update-function) ,status-buffer))))
+      (list "" result))))
 
 ;;; STATE-CHANGING FUNCTIONS