Subject: Re: bug#46358: 28.0.50; [PATCH] Add vc-dir faces; also apply them to vc-git

From: Protesilaos Stavrou <[email-masked]>
Date: Tue, 09 Feb 2021 19:46:41 +0200

On 2021-02-09, 18:30 +0200, Protesilaos Stavrou <[email-masked]> wrote:

> I will now use this information, as well as what Dmitry shared in the
> other comment to prepare a new patch that covers everything.  You can
> all test it before it gets applied.  I will share it in this thread
> either later in the day or tomorrow.
>
> Thank you!

Hello again!

I have prepared a new patch.

1. Incorporate the feedback received thus far:

   + Do not apply special treatment to the Git stash header.  It now
     looks the same as all other headers.

   + Rename 'vc-dir-ignored' to 'vc-dir-status-ignored'.

   + Apply 'vc-dir-status-ignored' to gitignored files.

2. Implement the new faces in all backends, while ensuring that every
   value documented for 'vc-state' is taken into account.

   + Please double check that the 'rev-and-lock' state is correct: it is
     the only one I could infer from the context of what the USER of
     'vc-state' is.

If you think there is something else that remains to be done, please let
me know.

Thank you for your time!

--
Protesilaos Stavrou
protesilaos.com
>From 052eec0c4d838e6d98ae165b0664cf428463fbdb Mon Sep 17 00:00:00 2001
Message-Id: <[email-masked]>
From: Protesilaos Stavrou <[email-masked]>
Date: Tue, 9 Feb 2021 06:49:05 +0200
Subject: [PATCH] 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.
---
 lisp/vc/vc-bzr.el | 24 ++++++++++++------------
 lisp/vc/vc-cvs.el | 18 +++++++++---------
 lisp/vc/vc-dir.el | 12 +++++++-----
 lisp/vc/vc-git.el |  5 +++--
 lisp/vc/vc-hg.el  |  4 ++--
 lisp/vc/vc-svn.el |  4 ++--
 6 files changed, 35 insertions(+), 32 deletions(-)

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index c495afb6ec..d1385ea778 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1076,49 +1076,49 @@ vc-bzr-dir-extra-headers
 	  (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 a595cc9778..0adb5328bc 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1047,29 +1047,29 @@ vc-cvs-dir-extra-headers
 	   (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 14c81578b7..d86b89bf80 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -86,7 +86,7 @@ vc-dir-status-up-to-date
   "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 @@ vc-default-dir-printer
      "   "
      (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 rev-and-lock))
+              '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 e7306386fe..25ae26d746 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -479,7 +479,8 @@ vc-git-dir-printer
      (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 @@ vc-git-dir-extra-headers
 	(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 1d163a64ab..adb0fce875 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1403,8 +1403,8 @@ vc-hg-dir-extra-headers
                              (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 da5471107d..22becc91cd 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -239,8 +239,8 @@ vc-svn-dir-extra-headers
     (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)
-- 
2.30.0