From 17b409e08a995a6f7569d08d71467d0007231dc1 Mon Sep 17 00:00:00 2001 From: =?utf8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sun, 9 Jun 2024 19:41:41 +0200 Subject: [PATCH] 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) --- lisp/vc/vc-git.el | 253 ++++++++++++++++++++++++---------------------- 1 file changed, 131 insertions(+), 122 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e8257c5dbd0..4d631c7e032 100644 --- 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." -- 2.39.5