commit 2d83de2ecf9274d3ab0469cabb968114d1d1bedb
from: Omar Polo <op@omarpolo.com>
date: Tue Jan 05 08:29:44 2021 UTC

implement vc-got-dir-printer

This way we can control how each file gets displayed in the *vc-dir*
buffer and display the staged information.

The advice around vc-dir-move-to-goal-column is needed otherwise `n'
and `p' moves the cursor to the wrong column.  vc-dir.el hardcodes
that value to 25.

commit - 93562d9b0682de5ff42145dc3d615cff3b0e9fab
commit + 2d83de2ecf9274d3ab0469cabb968114d1d1bedb
blob - 44219010d555bd885ac281c82a75b6163594b026
blob + 23070ec23d40140cdb02913577ae81d6b4faee6f
--- vc-got.el
+++ vc-got.el
@@ -35,7 +35,7 @@
 ;; * state                              DONE
 ;; - dir-status-files                   DONE
 ;; - dir-extra-headers                  DONE
-;; - dir-printer                        NOT IMPLEMENTED
+;; - dir-printer                        DONE
 ;; - status-fileinfo-extra              NOT IMPLEMENTED
 ;; * working-revision                   DONE
 ;; * checkout-model                     DONE
@@ -134,6 +134,10 @@
 (require 'vc)
 (require 'vc-annotate)
 
+;; FIXME: avoid loading this?  We only need it for
+;; vc-dir-filename-mouse-map in our custom printer.
+(require 'vc-dir)
+
 (require 'vc-got-stage)
 
 (defgroup vc-got nil
@@ -233,17 +237,19 @@ files)."
         (cl-loop until (eobp)
                  ;; the format of each line is
                  ;; <status-char> <stage-char> <spc> <filename> \n
-                 collect (let* ((file-status (prog1 (char-after)
+                 collect (let* ((file-status (prog1 (vc-got--parse-status-char
+                                                     (char-after))
                                                (forward-char)))
-                                (stage-status (prog1 (char-after)
+                                (stage-status (prog1 (vc-got--parse-stage-char
+                                                      (char-after))
                                                 (forward-char)))
                                 (filename (progn
                                             (forward-char)
                                             (buffer-substring (point)
                                                               (line-end-position)))))
                            (list filename
-                                 (vc-got--parse-status-char file-status)
-                                 (vc-got--parse-stage-char stage-status)))
+                                 (or file-status (and stage-status 'up-to-date))
+                                 stage-status))
                  do (forward-line))))))
 
 (defun vc-got--parse-status-char (c)
@@ -262,9 +268,9 @@ files)."
 (defun vc-got--parse-stage-char (c)
   "Parse the stage status char C into a symbol."
   (cl-case c
-    (?M 'edited)
-    (?A 'added)
-    (?D 'removed)))
+    (?M 'edit)
+    (?A 'add)
+    (?D 'remove)))
 
 (defun vc-got--tree-parse ()
   "Parse into an alist the output of got tree -i in the current buffer."
@@ -425,6 +431,44 @@ FILES is nil, consider all the files in DIR."
           (vc-got-repository-url dir) "\n"
           (propertize "Branch     : " 'face 'font-lock-type-face)
           (vc-got--current-branch)))
+
+(defun vc-got-dir-printer (info)
+  "Pretty-printer for the vc-dir-fileinfo structure INFO."
+  (let* ((isdir (vc-dir-fileinfo->directory info))
+	 (state (if isdir "" (vc-dir-fileinfo->state info)))
+	 (stage-state (vc-dir-fileinfo->extra info))
+	 (filename (vc-dir-fileinfo->name info)))
+    (insert
+     (propertize
+      (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
+      'face 'font-lock-type-face)
+     "   "
+     (propertize
+      (format "%-14s" state)
+      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
+		  ((memq state '(missing conflict)) 'font-lock-warning-face)
+		  ((eq state 'edited) 'font-lock-constant-face)
+		  (t 'font-lock-variable-name-face))
+      'mouse-face 'highlight)
+     " "
+     (propertize
+      (if stage-state
+	  (format "staged:%-7s" stage-state)
+	(format "%-14s" ""))
+      'face (cond ((memq stage-state '(add edit)) 'font-lock-constant-face)
+		  ((eq stage-state 'remove) 'font-lock-warning-face)
+		  (t 'font-lock-variable-name-face)))
+     " "
+     (propertize
+      (format "%s" filename)
+      'face
+      (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
+      'help-echo
+      (if isdir
+	  "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
+	"File\nmouse-3: Pop-up menu")
+      'mouse-face 'highlight
+      'keymap vc-dir-filename-mouse-map))))
 
 (defun vc-got-working-revision (file)
   "Return the id of the last commit that touched the FILE or \"0\" for a new (but added) file."
@@ -697,5 +741,17 @@ Value is returned as floating point fractional number 
             (forward-line))
           found)))))
 
+
+;; hacks
+(defun vc-got-fix-dir-move-to-goal-column (fn)
+  "Move the cursor on the file column.
+Adviced around vc-dir-move-to-goal-column because it hardcodes column 25."
+  (if (not (vc-find-root default-directory ".got"))
+      (funcall fn)
+    (beginning-of-line)
+    (unless (eolp)
+      (forward-char 34))))
+(advice-add 'vc-dir-move-to-goal-column :around #'vc-got-fix-dir-move-to-goal-column)
+
 (provide 'vc-got)
 ;;; vc-got.el ends here