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

From: Protesilaos Stavrou <[email-masked]>
Date: Sun, 07 Feb 2021 18:15:14 +0200

On 2021-02-07, 17:15 +0200, Eli Zaretskii <[email-masked]> wrote:

>> From: Protesilaos Stavrou <[email-masked]>
>> Date: Sun, 07 Feb 2021 13:42:09 +0200
>> 
>> In the attached patch, I do the following:
>> 
>> 1. Define new faces.  Each has semantic value in that it applies to
>>    constructs implied by its name.
>
> Thanks.  Would it be possible to use color names rather than #RRGGBB
> values?  The latter makes it very hard to figure out the color that
> will be used by the face.

I will keep this in mind for the next time.  For this case I removed all
color specifications (please find the revised patch attached to this
message).

>> 4. Use new color combinations which conform with the WCAG AAA standard
>>    for color contrast against pure white/black (this standard pertains
>>    to legibility and is the highest of its kind).
>
> Not sure what that means in practical terms: most Emacs users I've
> watched working (myself included) use some background color other than
> pure black or white.  Doesn't that change the contrast and the optimal
> colors?

You are right: I should have clarified that I meant the default white
background and its inverse.  Other themes would indeed have to adapt
things to their needs.

>> With regard to point 2, I only use Git and thus cannot test the other
>> backends with the requisite degree of confidence.  Do you think I should
>> try regardless?  Or should we just support the Git backend and hope that
>> someone else will work on [some of] the other backends?
>
> If you can easily try other backends, it will be appreciated.  But it
> is not mandatory, IMO.

I will inspect their code and try to identify whatever looks the same as
vc-git.  Then I will prepare a separate patch.

>> On point 4, please consider this a proposal: it is a highly opinionated
>> change.  If you feel we should in no way alienate existing users, I am
>> prepared to remove all colors and just :inherit from the faces that
>> applied before.
>
> Personally, I think inheriting from the existing faces will be less
> drastic, so it's probably better.

Very well!  I am doing just that in the revised patch.  So there should
be no visual difference between this and the prior state, except for one
case: the empty Git stash header, which will ultimately inherit from
'shadow' (before there was a "FIXME" to disambiguate it from other
header values).

-- 
Protesilaos Stavrou
protesilaos.com
>From 569437550fb0f04e2a271889467d25b773f57dca Mon Sep 17 00:00:00 2001
Message-Id: <[email-masked]>
From: Protesilaos Stavrou <[email-masked]>
Date: Sun, 7 Feb 2021 13:12:43 +0200
Subject: [PATCH] Add vc-dir faces; also apply them to vc-git

* etc/NEWS: Document the new faces.

* lisp/vc/vc-dir.el (vc-dir-header, vc-dir-header-value)
(vc-dir-directory, vc-dir-file, vc-dir-mark-indicator)
(vc-dir-status-warning, vc-dir-status-edited, vc-dir-status-up-to-date)
(vc-dir-ignored): Add new faces.

(vc-dir-headers, vc-default-dir-extra-headers)
(vc-default-dir-printer): Apply new faces.

* lisp/vc/vc-git.el (vc-git-permissions-as-string, vc-git-dir-printer)
(vc-git-dir-extra-headers): Apply new faces.
---
 etc/NEWS          |  6 ++++++
 lisp/vc/vc-dir.el | 49 ++++++++++++++++++++++++++++++++++++-----------
 lisp/vc/vc-git.el | 37 +++++++++++++++++------------------
 3 files changed, 62 insertions(+), 30 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index fb77688470..475b29b8f5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -587,6 +587,12 @@ their 'default-directory' under VC.
 This is used when expanding commit messages from 'vc-print-root-log'
 and similar commands.
 
+---
+*** New faces for 'vc-dir' buffers and their Git VC backend.
+Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
+'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
+'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'.
+
 ---
 *** The responsible VC backend is now the most specific one.
 'vc-responsible-backend' loops over the backends in
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9d0808c043..4f2de72afe 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -54,6 +54,33 @@ vc-dir-mode-hook
   :type 'hook
   :group 'vc)
 
+(defface vc-dir-header '((t :inherit font-lock-type-face))
+  "Face for headers in VC-dir buffers.")
+
+(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face))
+  "Face for header values in VC-dir buffers.")
+
+(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face))
+  "Face for directories in VC-dir buffers.")
+
+(defface vc-dir-file '((t :inherit font-lock-function-name-face))
+  "Face for files in VC-dir buffers.")
+
+(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face))
+  "Face for mark indicators in VC-dir buffers.")
+
+(defface vc-dir-status-warning '((t :inherit font-lock-warning-face))
+  "Face for warning status in VC-dir buffers.")
+
+(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face))
+  "Face for edited status in VC-dir buffers.")
+
+(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face))
+  "Face for up-to-date status in VC-dir buffers.")
+
+(defface vc-dir-ignored '((t :inherit shadow))
+  "Face for ignored or empty values in VC-dir buffers.")
+
 ;; Used to store information for the files displayed in the directory buffer.
 ;; Each item displayed corresponds to one of these defstructs.
 (cl-defstruct (vc-dir-fileinfo
@@ -1126,11 +1153,11 @@ vc-dir-headers
 specific headers."
   (concat
    ;; First layout the common headers.
-   (propertize "VC backend : " 'face 'font-lock-type-face)
-   (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
-   (propertize "Working dir: " 'face 'font-lock-type-face)
+   (propertize "VC backend : " 'face 'vc-dir-header)
+   (propertize (format "%s\n" backend) 'face 'vc-dir-header-value)
+   (propertize "Working dir: " 'face 'vc-dir-header)
    (propertize (format "%s\n" (abbreviate-file-name dir))
-               'face 'font-lock-variable-name-face)
+               'face 'vc-dir-header-value)
    ;; Then the backend specific ones.
    (vc-call-backend backend 'dir-extra-headers dir)
    "\n"))
@@ -1386,9 +1413,9 @@ vc-default-dir-extra-headers
   ;; backend specific headers.
   ;; XXX: change this to return nil before the release.
   (concat
-   (propertize "Extra      : " 'face 'font-lock-type-face)
+   (propertize "Extra      : " 'face 'vc-dir-header)
    (propertize "Please add backend specific headers here.  It's easy!"
-	       'face 'font-lock-warning-face)))
+	       'face 'vc-dir-status-warning)))
 
 (defvar vc-dir-status-mouse-map
   (let ((map (make-sparse-keymap)))
@@ -1414,21 +1441,21 @@ vc-default-dir-printer
     (insert
      (propertize
       (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
-      'face 'font-lock-type-face)
+      'face 'vc-dir-mark-indicator)
      "   "
      (propertize
       (format "%-20s" state)
-      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
-		  ((memq state '(missing conflict)) 'font-lock-warning-face)
+      '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 'font-lock-variable-name-face))
+		  (t 'vc-dir-header-value))
       'mouse-face 'highlight
       'keymap vc-dir-status-mouse-map)
      " "
      (propertize
       (format "%s" filename)
       'face
-      (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
+      (if isdir 'vc-dir-directory 'vc-dir-file)
       'help-echo
       (if isdir
 	  "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index d00c2c2133..e7306386fe 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -462,7 +462,7 @@ vc-git-permissions-as-string
            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
        "  "
      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
-  'face 'font-lock-type-face))
+  'face 'vc-dir-header))
 
 (defun vc-git-dir-printer (info)
   "Pretty-printer for the vc-dir-fileinfo structure."
@@ -474,20 +474,20 @@ vc-git-dir-printer
     (insert
      "  "
      (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
-                 'face 'font-lock-type-face)
+                 'face 'vc-dir-mark-indicator)
      "  "
      (propertize
       (format "%-12s" state)
-      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
-                  ((eq state '(missing conflict)) 'font-lock-warning-face)
-                  (t 'font-lock-variable-name-face))
+      'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
+                  ((eq state '(missing conflict)) 'vc-dir-status-warning)
+                  (t 'vc-dir-status-edited))
       'mouse-face 'highlight
       'keymap vc-dir-status-mouse-map)
      "  " (vc-git-permissions-as-string old-perm new-perm)
      "    "
      (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
-                 'face (if isdir 'font-lock-comment-delimiter-face
-                         'font-lock-function-name-face)
+                 'face (if isdir 'vc-dir-directory
+                         'vc-dir-file)
 		 'help-echo
 		 (if isdir
 		     "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
@@ -784,7 +784,7 @@ vc-git-dir-extra-headers
                   (mapconcat
                    (lambda (x)
                      (propertize x
-                                 'face 'font-lock-variable-name-face
+                                 'face 'vc-dir-header-value
                                  'mouse-face 'highlight
                                  'vc-git-hideable all-hideable
                                  'help-echo vc-git-stash-list-help
@@ -800,7 +800,7 @@ vc-git-dir-extra-headers
                   (mapconcat
                    (lambda (x)
                      (propertize x
-                                 'face 'font-lock-variable-name-face
+                                 'face 'vc-dir-header-value
                                  'mouse-face 'highlight
                                  'invisible t
                                  'vc-git-hideable t
@@ -810,33 +810,32 @@ vc-git-dir-extra-headers
                    (propertize "\n"
                                'invisible t
                                'vc-git-hideable t))))))))
-    ;; FIXME: maybe use a different face when nothing is stashed.
     (concat
-     (propertize "Branch     : " 'face 'font-lock-type-face)
+     (propertize "Branch     : " 'face 'vc-dir-header)
      (propertize branch
-		 'face 'font-lock-variable-name-face)
+		 'face 'vc-dir-header-value)
      (when remote-url
        (concat
 	"\n"
-	(propertize "Remote     : " 'face 'font-lock-type-face)
+	(propertize "Remote     : " 'face 'vc-dir-header)
 	(propertize remote-url
-		    'face 'font-lock-variable-name-face)))
+		    'face 'vc-dir-header-value)))
      ;; For now just a heading, key bindings can be added later for various bisect actions
      (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir)))
-       (propertize  "\nBisect     : in progress" 'face 'font-lock-warning-face))
+       (propertize  "\nBisect     : in progress" 'face 'vc-dir-status-warning))
      (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
-       (propertize  "\nRebase     : in progress" 'face 'font-lock-warning-face))
+       (propertize  "\nRebase     : in progress" 'face 'vc-dir-status-warning))
      (if stash-list
          (concat
-          (propertize "\nStash      : " 'face 'font-lock-type-face)
+          (propertize "\nStash      : " 'face 'vc-dir-header)
           stash-button
           stash-string)
        (concat
-	(propertize "\nStash      : " 'face 'font-lock-type-face)
+	(propertize "\nStash      : " 'face 'vc-dir-header)
 	(propertize "Nothing stashed"
 		    'help-echo vc-git-stash-shared-help
                     'keymap vc-git-stash-shared-map
-		    'face 'font-lock-variable-name-face))))))
+		    'face 'vc-dir-ignored))))))
 
 (defun vc-git-branches ()
   "Return the existing branches, as a list of strings.
-- 
2.30.0