procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

vc-git-dir-extra-headers: Improve detection of rebases

Browse source 
* lisp/vc/vc-git.el (vc-git--cmds-in-progress): New function.
(vc-git-dir-extra-headers): Use it.
This commit is contained in:
Sean Whitton 2022-12-31 22:55:42 -07:00
parent e4669e0f77
commit 7822fcbebd
1 changed files with 22 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/vc/vc-git.el
View file

@ -776,13 +776,32 @@ 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-extra-headers (dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list))
(default-directory dir)
(gitdir (vc-git--git-path))
(in-progress (vc-git--cmds-in-progress))
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@ -857,9 +876,9 @@ or an empty string if none."
(propertize remote-url
'face 'vc-dir-header-value)))
;; For now just a heading, key bindings can be added later for various bisect actions
(when (file-exists-p (expand-file-name "BISECT_START" gitdir))
(when (memq 'bisect in-progress)
(propertize "\nBisect : in progress" 'face 'vc-dir-status-warning))
(when (file-exists-p (expand-file-name "rebase-apply" gitdir))
(when (memq 'rebase in-progress)
(propertize "\nRebase : in progress" 'face 'vc-dir-status-warning))
(if stash-list
(concat