From: Protesilaos Stavrou Date: Tue, 9 Feb 2021 04:49:05 +0000 (+0200) Subject: Refine use of vc-dir faces; apply to all backends X-Git-Tag: emacs-28.0.90~3843 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ff16c897eadab9bebc58bd0ca0fb5c8e1c237a15;p=emacs.git Refine use of vc-dir faces; apply to all backends * lisp/vc/vc-dir.el (vc-default-dir-printer): Add check for the "ignored" status and make 'vc-dir-status-edited' the default face. Also extend condition for more states that qualify as "warnings". (vc-dir-ignored, vc-dir-status-ignored): Rename face for consistency. * lisp/vc/vc-git.el (vc-git-dir-printer): Use the 'vc-dir-status-edited' as the default for the Git backend. And reference the renamed face. Also stop treating the empty stash differently from other header values. * lisp/vc/vc-bzr.el (vc-bzr-dir-extra-headers): Implement new faces. * lisp/vc/vc-cvs.el (vc-cvs-dir-extra-headers): Same. * lisp/vc/vc-hg.el (vc-hg-dir-extra-headers): Same. * lisp/vc/vc-svn.el (vc-svn-dir-extra-headers): Same. This follows from the discussion in bug#46358. --- diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index c495afb6ec5..d1385ea7784 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1076,49 +1076,49 @@ stream. Standard error output is discarded." (when (string-match ".+checkout of branch: \\(.+\\)$" str) (match-string 1 str))))) (concat - (propertize "Parent branch : " 'face 'font-lock-type-face) + (propertize "Parent branch : " 'face 'vc-dir-header) (propertize (if (string-match "parent branch: \\(.+\\)$" str) (match-string 1 str) "None") - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) "\n" (when light-checkout (concat - (propertize "Light checkout root: " 'face 'font-lock-type-face) - (propertize light-checkout 'face 'font-lock-variable-name-face) + (propertize "Light checkout root: " 'face 'vc-dir-header) + (propertize light-checkout 'face 'vc-dir-header-value) "\n")) (when light-checkout-branch (concat - (propertize "Checkout of branch : " 'face 'font-lock-type-face) - (propertize light-checkout-branch 'face 'font-lock-variable-name-face) + (propertize "Checkout of branch : " 'face 'vc-dir-header) + (propertize light-checkout-branch 'face 'vc-dir-header-value) "\n")) (when pending-merge (concat - (propertize "Warning : " 'face 'font-lock-warning-face + (propertize "Warning : " 'face 'vc-dir-status-warning 'help-echo pending-merge-help-echo) (propertize "Pending merges, commit recommended before any other action" 'help-echo pending-merge-help-echo - 'face 'font-lock-warning-face) + 'face 'vc-dir-status-warning) "\n")) (if shelve (concat - (propertize "Shelves :\n" 'face 'font-lock-type-face + (propertize "Shelves :\n" 'face 'vc-dir-header 'help-echo shelve-help-echo) (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf" 'keymap vc-bzr-shelve-map)) shelve "\n")) (concat - (propertize "Shelves : " 'face 'font-lock-type-face + (propertize "Shelves : " 'face 'vc-dir-header 'help-echo shelve-help-echo) (propertize "No shelved changes" 'help-echo shelve-help-echo - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-header-value)))))) ;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher. (declare-function vc-resynch-buffer "vc-dispatcher" diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index a595cc9778b..0adb5328bc2 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil." (file-error nil)))) (concat (cond (repo - (concat (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (concat (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t "")) (cond (module - (concat (propertize "Module : " 'face 'font-lock-type-face) - (propertize module 'face 'font-lock-variable-name-face))) + (concat (propertize "Module : " 'face 'vc-dir-header) + (propertize module 'face 'vc-dir-header-value))) (t "")) (if (file-readable-p "CVS/Tag") (let ((tag (vc-cvs-file-to-string "CVS/Tag"))) (cond ((string-match "\\`T" tag) - (concat (propertize "Tag : " 'face 'font-lock-type-face) + (concat (propertize "Tag : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ((string-match "\\`D" tag) - (concat (propertize "Date : " 'face 'font-lock-type-face) + (concat (propertize "Date : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) (t "")))) ;; In CVS, branch is a per-file property, not a per-directory property. ;; We can't really do this here without making dangerous assumptions. - ;;(propertize "Branch: " 'face 'font-lock-type-face) + ;;(propertize "Branch: " 'face 'vc-dir-header) ;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n" ;; 'face 'font-lock-warning-face) ))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 14c81578b79..a416474e16d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -86,7 +86,7 @@ See `run-hooks'." "Face for up-to-date status in VC-dir buffers." :group 'vc) -(defface vc-dir-ignored '((t :inherit shadow)) +(defface vc-dir-status-ignored '((t :inherit shadow)) "Face for ignored or empty values in VC-dir buffers." :group 'vc) @@ -1454,10 +1454,12 @@ These are the commands available for use in the file status buffer: " " (propertize (format "%-20s" state) - 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) - ((memq state '(missing conflict)) 'vc-dir-status-warning) - ((eq state 'edited) 'font-lock-constant-face) - (t 'vc-dir-header-value)) + 'face (cond + ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict needs-update unlocked-changes)) + 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e7306386fea..25ae26d746a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -479,7 +479,8 @@ or an empty string if none." (propertize (format "%-12s" state) 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) - ((eq state '(missing conflict)) 'vc-dir-status-warning) + ((memq state '(missing conflict)) 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) @@ -835,7 +836,7 @@ or an empty string if none." (propertize "Nothing stashed" 'help-echo vc-git-stash-shared-help 'keymap vc-git-stash-shared-map - 'face 'vc-dir-ignored)))))) + 'face 'vc-dir-header-value)))))) (defun vc-git-branches () "Return the existing branches, as a list of strings. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 1d163a64ab2..adb0fce8759 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"." (cons (capitalize (match-string 1)) (match-string 2)) (cons "" (buffer-substring (point) (line-end-position)))))) (concat - (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) - (propertize (cdr entry) 'face 'font-lock-variable-name-face))) + (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header) + (propertize (cdr entry) 'face 'vc-dir-header-value))) result) (forward-line)) (nreverse result)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index da5471107d2..22becc91cd1 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (concat (cond (repo (concat - (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t ""))))) (defun vc-svn-working-revision (file)