Refactor 'vc-default-mode-line-string' (bug#66464)

* lisp/vc/vc-hooks.el (vc-mode-line-state): New function with code moved from
'vc-default-mode-line-string'.
(vc-default-mode-line-string): Use 'vc-mode-line-state'.

* lisp/vc/vc-git.el (vc-git-mode-line-string): Use
'vc-mode-line-state' instead of hacking the string returned from
'vc-default-mode-line-string'.

* lisp/vc/vc-hg.el (vc-hg-mode-line-string): Use
'vc-mode-line-state' instead of duplicating code from
'vc-default-mode-line-string'.

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 5c21a5b884e87aaa1fcb9bbbeedd7c10ba41cdc6..9ec45c598936d95334d1d196aab8e4977a45e61a 100644 (file)
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -416,15 +416,18 @@ in the order given by `git status'."
 
 (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))
-         (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))))
+  (pcase-let* ((backend-name "Git")
+               (state (vc-state file))
+               (`(,state-echo ,face ,indicator)
+                (vc-mode-line-state state))
+               (rev (vc-working-revision file 'Git))
+               (disp-rev (or (vc-git--symbolic-ref file)
+                             (and rev (substring rev 0 7))))
+               (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 f2ee9ef35e404b0cbb2219fd2aed58fdecdfbae1..89b2814a0a30cd0eb47ea0cc98796cc601587d6f 100644 (file)
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -352,47 +352,22 @@ specific file to query."
 
 (defun vc-hg-mode-line-string (file)
   "Hg-specific version of `vc-mode-line-string'."
-  (let* ((backend-name "Hg")
-         (truename (file-truename file))
-         (state (vc-state truename))
-         (state-echo nil)
-         (face nil)
-         (rev (and state
-                   (let ((default-directory
-                          (expand-file-name (vc-hg-root truename))))
-                     (vc-hg--symbolic-revision
-                      "."
-                      (and vc-hg-use-file-version-for-mode-line-version
-                           truename)))))
-         (rev (or 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)))
-     'face face
-     'help-echo (concat state-echo " under the " backend-name
+  (pcase-let* ((backend-name "Hg")
+               (truename (file-truename file))
+               (state (vc-state truename))
+               (`(,state-echo ,face ,indicator)
+                (vc-mode-line-state state))
+               (rev (and state
+                         (let ((default-directory
+                                (expand-file-name (vc-hg-root truename))))
+                           (vc-hg--symbolic-revision
+                            "."
+                            (and vc-hg-use-file-version-for-mode-line-version
+                                 truename)))))
+               (rev (or rev "???"))
+               (state-string (concat backend-name indicator rev)))
+    (propertize state-string 'face face 'help-echo
+                (concat state-echo " under the " backend-name
                         " version control system"))))
 
 ;;; History functions

diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index a4de0a6e791f9084b66914d01ed363623496852b..c16fb63b2ff71d83f6de95090cef21a8011c6f1d 100644 (file)
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -705,6 +705,50 @@ If BACKEND is passed use it as the VC backend when computing the result."
   (force-mode-line-update)
   backend)
 
+(defun vc-mode-line-state (state)
+  "Return a list of data to display on the mode line.
+The argument STATE should contain the version control state returned
+from `vc-state'.  The returned list includes three elements: the echo
+string, the face name, and the indicator that usually is one character."
+  (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:
@@ -717,51 +761,15 @@ Format:
   \"BACKEND?REV\"        if the file is under VC, but is missing
 
 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)))
-    (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)))
-     'face face
-     'help-echo (concat state-echo " under the " backend-name
-                       " version control system"))))
+  (pcase-let* ((backend-name (symbol-name backend))
+               (state (vc-state file backend))
+               (rev (vc-working-revision file backend))
+               (`(,state-echo ,face ,indicator)
+                (vc-mode-line-state state))
+               (state-string (concat backend-name indicator rev)))
+    (propertize state-string 'face face 'help-echo
+                (concat state-echo " under the " backend-name
+                        " version control system"))))
 
 (defun vc-follow-link ()
   "If current buffer visits a symbolic link, visit the real file.