From: Juri Linkov <juri@linkov.net>
To: 66464@debbugs.gnu.org
Subject: bug#66464: Vc mode-line
Date: Wed, 11 Oct 2023 19:29:25 +0300 [thread overview]
Message-ID: <86a5spm8be.fsf@mail.linkov.net> (raw)
[-- Attachment #1: Type: text/plain, Size: 240 bytes --]
In order to prepare for making the vc mode-line more customizable,
here is refactoring that helps to avoid code duplication in
vc-hg-mode-line-string, and at the same time makes
vc-git-mode-line-string less hackish while keeping it short.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: vc-mode-line-string.patch --]
[-- Type: text/x-diff, Size: 8104 bytes --]
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 5c21a5b884e..80c79db93ca 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -416,15 +416,22 @@ vc-git--symbolic-ref
(defun vc-git-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
- (let* ((rev (vc-working-revision file 'Git))
+ (let* ((backend-name "Git")
+ (state (vc-state file))
+ (status (vc-mode-line-status state))
+ (state-echo (nth 0 status))
+ (face (nth 1 status))
+ (indicator (nth 2 status))
+ (rev (vc-working-revision file 'Git))
(disp-rev (or (vc-git--symbolic-ref file)
(and rev (substring rev 0 7))))
- (def-ml (vc-default-mode-line-string 'Git file))
- (help-echo (get-text-property 0 'help-echo def-ml))
- (face (get-text-property 0 'face def-ml)))
- (propertize (concat (substring def-ml 0 4) disp-rev)
- 'face face
- 'help-echo (concat help-echo "\nCurrent revision: " rev))))
+ (state-string (concat backend-name indicator disp-rev)))
+ (propertize
+ state-string
+ 'face face
+ 'help-echo (concat state-echo " under the " backend-name
+ " version control system"
+ "\nCurrent revision: " rev))))
(cl-defstruct (vc-git-extra-fileinfo
(:copier nil)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c3e563a1f10..a749a4b02f7 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -354,8 +354,10 @@ vc-hg-mode-line-string
(let* ((backend-name "Hg")
(truename (file-truename file))
(state (vc-state truename))
- (state-echo nil)
- (face nil)
+ (status (vc-mode-line-status state))
+ (state-echo (nth 0 status))
+ (face (nth 1 status))
+ (indicator (nth 2 status))
(rev (and state
(let ((default-directory
(expand-file-name (vc-hg-root truename))))
@@ -363,33 +365,10 @@ vc-hg-mode-line-string
"."
(and vc-hg-use-file-version-for-mode-line-version
truename)))))
- (rev (or rev "???")))
+ (rev (or rev "???"))
+ (state-string (concat backend-name indicator rev)))
(propertize
- (cond ((or (eq state 'up-to-date)
- (eq state 'needs-update))
- (setq state-echo "Up to date file")
- (setq face 'vc-up-to-date-state)
- (concat backend-name "-" rev))
- ((eq state 'added)
- (setq state-echo "Locally added file")
- (setq face 'vc-locally-added-state)
- (concat backend-name "@" rev))
- ((eq state 'conflict)
- (setq state-echo "File contains conflicts after the last merge")
- (setq face 'vc-conflict-state)
- (concat backend-name "!" rev))
- ((eq state 'removed)
- (setq state-echo "File removed from the VC system")
- (setq face 'vc-removed-state)
- (concat backend-name "!" rev))
- ((eq state 'missing)
- (setq state-echo "File tracked by the VC system, but missing from the file system")
- (setq face 'vc-missing-state)
- (concat backend-name "?" rev))
- (t
- (setq state-echo "Locally modified file")
- (setq face 'vc-edited-state)
- (concat backend-name ":" rev)))
+ state-string
'face face
'help-echo (concat state-echo " under the " backend-name
" version control system"))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index a4de0a6e791..94c3682b4aa 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -705,6 +733,46 @@ vc-mode-line
(force-mode-line-update)
backend)
+(defun vc-mode-line-status (state)
+ (let (state-echo face indicator)
+ (cond ((or (eq state 'up-to-date)
+ (eq state 'needs-update))
+ (setq state-echo "Up to date file")
+ (setq face 'vc-up-to-date-state)
+ (setq indicator "-"))
+ ((stringp state)
+ (setq state-echo (concat "File locked by" state))
+ (setq face 'vc-locked-state)
+ (setq indicator (concat ":" state ":")))
+ ((eq state 'added)
+ (setq state-echo "Locally added file")
+ (setq face 'vc-locally-added-state)
+ (setq indicator "@"))
+ ((eq state 'conflict)
+ (setq state-echo "File contains conflicts after the last merge")
+ (setq face 'vc-conflict-state)
+ (setq indicator "!"))
+ ((eq state 'removed)
+ (setq state-echo "File removed from the VC system")
+ (setq face 'vc-removed-state)
+ (setq indicator "!"))
+ ((eq state 'missing)
+ (setq state-echo "File tracked by the VC system, but missing from the file system")
+ (setq face 'vc-missing-state)
+ (setq indicator "?"))
+ ((eq state 'ignored)
+ (setq state-echo "File tracked by the VC system, but ignored")
+ (setq face 'vc-ignored-state)
+ (setq indicator "!"))
+ (t
+ ;; Not just for the 'edited state, but also a fallback
+ ;; for all other states. Think about different symbols
+ ;; for 'needs-update and 'needs-merge.
+ (setq state-echo "Locally modified file")
+ (setq face 'vc-edited-state)
+ (setq indicator ":")))
+ (list state-echo face indicator)))
+
(defun vc-default-mode-line-string (backend file)
"Return a string for `vc-mode-line' to put in the mode line for FILE.
Format:
@@ -718,47 +786,15 @@ vc-default-mode-line-string
This function assumes that the file is registered."
(let* ((backend-name (symbol-name backend))
- (state (vc-state file backend))
- (state-echo nil)
- (face nil)
- (rev (vc-working-revision file backend)))
+ (state (vc-state file backend))
+ (rev (vc-working-revision file backend))
+ (status (vc-mode-line-status state))
+ (state-echo (nth 0 status))
+ (face (nth 1 status))
+ (indicator (nth 2 status))
+ (state-string (concat backend-name indicator rev)))
(propertize
- (cond ((or (eq state 'up-to-date)
- (eq state 'needs-update))
- (setq state-echo "Up to date file")
- (setq face 'vc-up-to-date-state)
- (concat backend-name "-" rev))
- ((stringp state)
- (setq state-echo (concat "File locked by" state))
- (setq face 'vc-locked-state)
- (concat backend-name ":" state ":" rev))
- ((eq state 'added)
- (setq state-echo "Locally added file")
- (setq face 'vc-locally-added-state)
- (concat backend-name "@" rev))
- ((eq state 'conflict)
- (setq state-echo "File contains conflicts after the last merge")
- (setq face 'vc-conflict-state)
- (concat backend-name "!" rev))
- ((eq state 'removed)
- (setq state-echo "File removed from the VC system")
- (setq face 'vc-removed-state)
- (concat backend-name "!" rev))
- ((eq state 'missing)
- (setq state-echo "File tracked by the VC system, but missing from the file system")
- (setq face 'vc-missing-state)
- (concat backend-name "?" rev))
- ((eq state 'ignored)
- (setq state-echo "File tracked by the VC system, but ignored")
- (setq face 'vc-ignored-state)
- (concat backend-name "!" rev))
- (t
- ;; Not just for the 'edited state, but also a fallback
- ;; for all other states. Think about different symbols
- ;; for 'needs-update and 'needs-merge.
- (setq state-echo "Locally modified file")
- (setq face 'vc-edited-state)
- (concat backend-name ":" rev)))
+ state-string
'face face
'help-echo (concat state-echo " under the " backend-name
" version control system"))))
next reply other threads:[~2023-10-11 16:29 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-10-11 16:29 Juri Linkov [this message]
2023-10-16 1:11 ` bug#66464: Vc mode-line Dmitry Gutov
2023-10-16 17:14 ` Juri Linkov
2023-10-31 7:40 ` Juri Linkov
2023-11-09 16:41 ` Juri Linkov
2023-11-10 2:04 ` Dmitry Gutov
2023-11-10 7:33 ` Juri Linkov
2023-11-10 23:54 ` Dmitry Gutov
2023-11-11 18:50 ` Juri Linkov
2023-11-11 22:05 ` Dmitry Gutov
2023-11-12 8:07 ` Juri Linkov
2023-11-12 10:59 ` Dmitry Gutov
2023-11-13 7:11 ` Juri Linkov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=86a5spm8be.fsf@mail.linkov.net \
--to=juri@linkov.net \
--cc=66464@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.