Split vc-git-dir-extra-headers into more manageable chunks

The current code requires a lot of eyeballing back-and-forth
to:

- check where variables are actually used, what impact changing
them can have: in actuality, there are three distinct "groups"
of headers we compute, each with their own independent state;
- understand formatting details such as "who's in charge of the
newlines".

To solve both issues, split that function into smaller ones,
each handling a "group" of headers.

The only expected "functional" change is that, by propertizing
"\nHeader: " strings, the original code sometimes applied the
vc-dir-header face to the newline preceding a header; the new
code applies no faces to these newlines.

This change would be visible to users with themes adding an
:extended background to vc-dir-header.  In practice, no in-tree
theme is impacted.

For bug#68183.

* lisp/vc/vc-git.el (vc-git-dir--branch-headers): New function
to compute "Branch", "Tracking" and "Remote".
(vc-git--cmds-in-progress): Rename to...
(vc-git-dir--in-progress-headers): ... this, and compute
headers.
(vc-git-dir--stash-headers): New function to compute the
"Stash" header.
(vc-git-dir-extra-headers): Boil down to just setting
default-directory and assembling the headers from these new
helpers.
(vc-git--out-match): New function to call 'git' and capture
specific bits of output.

(cherry picked from commit 88ac5d03586a81cc8644e75adbdb3cab9b56a1b9)

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e8257c5dbd016cea8929cbed6510d86c4a0dcf1a..4d631c7e032e403a20cdb4e60af13e14441ff9f0 100644 (file)
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -717,6 +717,63 @@ or an empty string if none."
                                  :files files
                                  :update-function update-function)))
 
+(defun vc-git-dir--branch-headers ()
+  "Return headers for branch-related information."
+  (let ((branch (vc-git--out-match
+                 '("symbolic-ref" "HEAD")
+                 "^\\(refs/heads/\\)?\\(.+\\)$" 2))
+        tracking remote-url)
+    (if branch
+        (when-let ((branch-merge
+                    (vc-git--out-match
+                     `("config" ,(concat "branch." branch ".merge"))
+                     "^\\(refs/heads/\\)?\\(.+\\)$" 2))
+                   (branch-remote
+                    (vc-git--out-match
+                     `("config" ,(concat "branch." branch ".remote"))
+                     "\\([^\n]+\\)" 1)))
+          (if (string= branch-remote ".")
+              (setq tracking branch-merge
+                    remote-url "none (tracking local branch)")
+            (setq tracking (concat branch-remote "/" branch-merge)
+                  remote-url (vc-git-repository-url
+                              default-directory branch-remote))))
+      (setq branch "none (detached HEAD)"))
+    (cl-flet ((fmt (key value)
+                (concat
+                 (propertize (format "% -11s: " key) 'face 'vc-dir-header)
+                 (propertize value 'face 'vc-dir-header-value))))
+      (remove nil (list
+                   (fmt "Branch" branch)
+                   (and tracking (fmt "Tracking" tracking))
+                   (and remote-url (fmt "Remote" remote-url)))))))
+
+(defun vc-git-dir--in-progress-headers ()
+  "Return headers for Git commands in progress in this worktree."
+  (let ((gitdir (vc-git--git-path))
+        cmds)
+    ;; See contrib/completion/git-prompt.sh in git.git.
+    (when (or (file-directory-p
+              (expand-file-name "rebase-merge" gitdir))
+             (file-exists-p
+              (expand-file-name "rebase-apply/rebasing" gitdir)))
+      (push 'rebase cmds))
+    (when (file-exists-p
+          (expand-file-name "rebase-apply/applying" gitdir))
+      (push 'am cmds))
+    (when (file-exists-p (expand-file-name "MERGE_HEAD" gitdir))
+      (push 'merge cmds))
+    (when (file-exists-p (expand-file-name "BISECT_START" gitdir))
+      (push 'bisect cmds))
+    (cl-flet ((fmt (cmd name)
+                (when (memq cmd cmds)
+                  ;; For now just a heading, key bindings can be added
+                  ;; later for various bisect actions.
+                  (propertize (format "% -11s: in progress" name)
+                              'face 'vc-dir-status-warning))))
+      (remove nil (list (fmt 'bisect "Bisect")
+                        (fmt 'rebase "Rebase"))))))
+
 (defvar-keymap vc-git-stash-shared-map
   "S" #'vc-git-stash-snapshot
   "C" #'vc-git-stash)
@@ -797,130 +854,75 @@ or an empty string if none."
                  :help "Show the contents of the current stash"))
     map))
 
-(defun vc-git--cmds-in-progress ()
-  "Return a list of Git commands in progress in this worktree."
-  (let ((gitdir (vc-git--git-path))
-        cmds)
-    ;; See contrib/completion/git-prompt.sh in git.git.
-    (when (or (file-directory-p
-              (expand-file-name "rebase-merge" gitdir))
-             (file-exists-p
-              (expand-file-name "rebase-apply/rebasing" gitdir)))
-      (push 'rebase cmds))
-    (when (file-exists-p
-          (expand-file-name "rebase-apply/applying" gitdir))
-      (push 'am cmds))
-    (when (file-exists-p (expand-file-name "MERGE_HEAD" gitdir))
-      (push 'merge cmds))
-    (when (file-exists-p (expand-file-name "BISECT_START" gitdir))
-      (push 'bisect cmds))
-    cmds))
+(defun vc-git-dir--stash-headers ()
+  "Return headers describing the current stashes."
+  (list
+   (concat
+    (propertize "Stash      : " 'face 'vc-dir-header)
+    (if-let ((stash-list (vc-git-stash-list)))
+        (let* ((len (length stash-list))
+               (limit
+                (if (integerp vc-git-show-stash)
+                    (min vc-git-show-stash len)
+                  len))
+               (shown-stashes (cl-subseq stash-list 0 limit))
+               (hidden-stashes (cl-subseq stash-list limit))
+               (all-hideable (or (eq vc-git-show-stash t)
+                                 (<= len vc-git-show-stash))))
+          (concat
+           ;; Button to toggle visibility.
+           (if all-hideable
+               (vc-git-make-stash-button nil limit limit)
+             (vc-git-make-stash-button t vc-git-show-stash len))
+           ;; Stash list.
+           (when shown-stashes
+             (concat
+              (propertize "\n"
+                          'vc-git-hideable all-hideable)
+              (mapconcat
+               (lambda (x)
+                 (propertize x
+                             'face 'vc-dir-header-value
+                             'mouse-face 'highlight
+                             'vc-git-hideable all-hideable
+                             'help-echo vc-git-stash-list-help
+                             'keymap vc-git-stash-map))
+               shown-stashes
+               (propertize "\n"
+                           'vc-git-hideable all-hideable))))
+           (when hidden-stashes
+             (concat
+              (propertize "\n"
+                          'invisible t
+                          'vc-git-hideable t)
+              (mapconcat
+               (lambda (x)
+                 (propertize x
+                             'face 'vc-dir-header-value
+                             'mouse-face 'highlight
+                             'invisible t
+                             'vc-git-hideable t
+                             'help-echo vc-git-stash-list-help
+                             'keymap vc-git-stash-map))
+               hidden-stashes
+               (propertize "\n"
+                           'invisible t
+                           'vc-git-hideable t))))))
+      (propertize "Nothing stashed"
+                 'help-echo vc-git-stash-shared-help
+                  'keymap vc-git-stash-shared-map
+                 'face 'vc-dir-header-value)))))
 
 (defun vc-git-dir-extra-headers (dir)
-  (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
-       (stash-list (vc-git-stash-list))
-        (default-directory dir)
-        (in-progress (vc-git--cmds-in-progress))
-
-       branch remote-url stash-button stash-string tracking-branch)
-    (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
-       (progn
-         (setq branch (match-string 2 str))
-          (let ((remote (vc-git--out-str
-                         "config" (concat "branch." branch ".remote")))
-                (merge (vc-git--out-str
-                        "config" (concat "branch." branch ".merge"))))
-            (when (string-match "\\([^\n]+\\)" remote)
-             (setq remote (match-string 1 remote)))
-            (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
-              (setq tracking-branch (match-string 2 merge)))
-            (pcase remote
-              ("."
-               (setq remote-url "none (tracking local branch)"))
-              ((pred (not string-empty-p))
-               (setq
-                remote-url (vc-git-repository-url dir remote)
-                tracking-branch (concat remote "/" tracking-branch))))))
-      (setq branch "none (detached HEAD)"))
-    (when stash-list
-      (let* ((len (length stash-list))
-             (limit
-              (if (integerp vc-git-show-stash)
-                  (min vc-git-show-stash len)
-                len))
-             (shown-stashes (cl-subseq stash-list 0 limit))
-             (hidden-stashes (cl-subseq stash-list limit))
-             (all-hideable (or (eq vc-git-show-stash t)
-                               (<= len vc-git-show-stash))))
-        (setq stash-button (if all-hideable
-                               (vc-git-make-stash-button nil limit limit)
-                             (vc-git-make-stash-button t vc-git-show-stash len))
-              stash-string
-              (concat
-               (when shown-stashes
-                 (concat
-                  (propertize "\n"
-                              'vc-git-hideable all-hideable)
-                  (mapconcat
-                   (lambda (x)
-                     (propertize x
-                                 'face 'vc-dir-header-value
-                                 'mouse-face 'highlight
-                                 'vc-git-hideable all-hideable
-                                 'help-echo vc-git-stash-list-help
-                                 'keymap vc-git-stash-map))
-                   shown-stashes
-                   (propertize "\n"
-                               'vc-git-hideable all-hideable))))
-               (when hidden-stashes
-                 (concat
-                  (propertize "\n"
-                              'invisible t
-                              'vc-git-hideable t)
-                  (mapconcat
-                   (lambda (x)
-                     (propertize x
-                                 'face 'vc-dir-header-value
-                                 'mouse-face 'highlight
-                                 'invisible t
-                                 'vc-git-hideable t
-                                 'help-echo vc-git-stash-list-help
-                                 'keymap vc-git-stash-map))
-                   hidden-stashes
-                   (propertize "\n"
-                               'invisible t
-                               'vc-git-hideable t))))))))
-    (concat
-     (propertize "Branch     : " 'face 'vc-dir-header)
-     (propertize branch
-                'face 'vc-dir-header-value)
-     (when tracking-branch
-       (concat
-        "\n"
-        (propertize "Tracking   : " 'face 'vc-dir-header)
-        (propertize tracking-branch 'face 'vc-dir-header-value)))
-     (when remote-url
-       (concat
-       "\n"
-       (propertize "Remote     : " 'face 'vc-dir-header)
-       (propertize remote-url
-                   'face 'vc-dir-header-value)))
-     ;; For now just a heading, key bindings can be added later for various bisect actions
-     (when (memq 'bisect in-progress)
-       (propertize  "\nBisect     : in progress" 'face 'vc-dir-status-warning))
-     (when (memq 'rebase in-progress)
-       (propertize  "\nRebase     : in progress" 'face 'vc-dir-status-warning))
-     (if stash-list
-         (concat
-          (propertize "\nStash      : " 'face 'vc-dir-header)
-          stash-button
-          stash-string)
-       (concat
-       (propertize "\nStash      : " 'face 'vc-dir-header)
-       (propertize "Nothing stashed"
-                   'help-echo vc-git-stash-shared-help
-                    'keymap vc-git-stash-shared-map
-                   'face 'vc-dir-header-value))))))
+  (let ((default-directory dir))
+    (string-join
+     (append
+      ;; Each helper returns a list of headers.  Each header must be a
+      ;; propertized string with no final newline.
+      (vc-git-dir--branch-headers)
+      (vc-git-dir--in-progress-headers)
+      (vc-git-dir--stash-headers))
+     "\n")))
 
 (defun vc-git-branches ()
   "Return the existing branches, as a list of strings.
@@ -2246,6 +2248,13 @@ The exit status is ignored."
     (with-current-buffer standard-output
       (apply #'vc-git--out-ok command args))))
 
+(defun vc-git--out-match (args regexp group)
+  "Run `git ARGS...' and return match for group number GROUP of REGEXP.
+Return nil if the output does not match.  The exit status is ignored."
+  (let ((out (apply #'vc-git--out-str args)))
+    (when (string-match regexp out)
+      (match-string group out))))
+
 (defun vc-git--run-command-string (file &rest args)
   "Run a git command on FILE and return its output as string.
 FILE can be nil."