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"))))