RFC Patch: add tty face attributes

[Matthew Leach]

Hello,

Please see the attached patch that allows one to define a different face
to be shown when being displayed on the tty rather than with a windowing
system.

Some background: I use hl-sexp-mode when editing lisp code and I
frequently edit through ssh as well as on the console; naturally I use
the Emacs daemon to achieve this.  However, the color schemes that I use
on the tty and the windowing system are quite different and I find
myself flip-flopping between colors for the background face of
hl-sexp-face as it is unreadable when switching to a tty editing session
form the windowing-system session.

To overcome this I decided it would be a good idea to create a second
set of 'tty' face attributes that, when defined, overwrite the windowing
system colors but only when displayed on a tty.

Any comments are welcome.

Thanks,
-- 
Matt

>From b5a3e0022074c42e31c5f08a687506ddf3d8ba4a Mon Sep 17 00:00:00 2001
From: Matthew Leach <address@hidden>
Date: Sun, 2 Nov 2014 00:04:07 +0000
Subject: [PATCH] add tty face attributes.

src/ChangeLog:

2014-11-02  Matthew Leach  <address@hidden>

        * xfaces.c: New Lisp Objects QCtty_foreground and
        QCtty_background.
        (LFACE_TTY_FOREGROUND): New.
        (LFACE_TTY_BACKGROUND): New.
        (Finternal_set_lisp_face_attribute): Add setter code for
        tty_background and tty_foreground lisp faces.
        (Finternal_get_lisp_face_attribute): Add getter code for
        tty_background and tty_foreground lisp faces.
        (map_tty_color): Make the tty faces take precedent if not
        Qundefined.
        (syms_of_xfaces): Define symbols for tty_foreground and
        tty_background.

        * dispextern.h (lface_attribute_index): Add
        LFACE_TTY_FOREGROUND_INDEX and LFACE_TTY_BACKGROUND_INDEX.

lisp/ChangeLog:

2014-11-02  Matthew Leach  <address@hidden>

        * faces.el (set-face-tty-background): New.
        (set-face-tty-foreground): New.
        (face-valid-attribute-values): Add tty_foreground and
        tty_background.
        (face-attribute-name-alist): Add descriptive names for
        tty_foreground and tty_background.
---
 lisp/faces.el    | 21 ++++++++++++++++++++-
 src/dispextern.h |  2 ++
 src/xfaces.c     | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 1 deletion(-)

diff --git a/lisp/faces.el b/lisp/faces.el
index d7b330e..5a225e6 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -845,6 +845,15 @@ When called interactively, prompts for the face and color."
   (interactive (read-face-and-attribute :background))
   (set-face-attribute face frame :background (or color 'unspecified)))
 
+(defun set-face-tty-background (face color &optional frame)
+  "Change the tty background color of face FACE to COLOR (a string).
+FRAME nil or not specified means change face on all frames.
+COLOR can be a system-defined color name (see
+`list-colors-display') or a hex spec of the form #RRGGBB.  When
+called interactively, prompts for the face and color."
+  (interactive (read-face-and-attribute :tty_background))
+  (set-face-attribute face frame :tty_background (or color 'unspecified)))
+
 
 (defun set-face-foreground (face color &optional frame)
   "Change the foreground color of face FACE to COLOR (a string).
@@ -855,6 +864,14 @@ When called interactively, prompts for the face and color."
   (interactive (read-face-and-attribute :foreground))
   (set-face-attribute face frame :foreground (or color 'unspecified)))
 
+(defun set-face-tty-foreground (face color &optional frame)
+  "Change the tty foreground color of face FACE to COLOR (a string).
+FRAME nil or not specified means change face on all frames.
+COLOR can be a system-defined color name (see
+`list-colors-display') or a hex spec of the form #RRGGBB.  When
+called interactively, prompts for the face and color."
+  (interactive (read-face-and-attribute :tty_foreground))
+  (set-face-attribute face frame :tty_foreground (or color 'unspecified)))
 
 (defun set-face-stipple (face stipple &optional frame)
   "Change the stipple pixmap of face FACE to STIPPLE.
@@ -1052,7 +1069,7 @@ an integer value."
                                (defined-colors frame)))
              (mapcar #'(lambda (x) (cons (symbol-name x) x))
                      (internal-lisp-face-attribute-values attribute))))
-           ((or `:foreground `:background)
+           ((or `:foreground `:background `:tty_foreground `:tty_background)
             (mapcar #'(lambda (c) (cons c c))
                     (defined-colors frame)))
            (`:height
@@ -1091,6 +1108,8 @@ an integer value."
     (:inverse-video . "inverse-video display")
     (:foreground . "foreground color")
     (:background . "background color")
+    (:tty_foreground . "tty foreground color")
+    (:tty_background . "tty background color")
     (:stipple . "background stipple")
     (:inherit . "inheritance"))
   "An alist of descriptive names for face attributes.
diff --git a/src/dispextern.h b/src/dispextern.h
index 0dd0887..c5d8e4c 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1550,6 +1550,8 @@ enum lface_attribute_index
   LFACE_INVERSE_INDEX,
   LFACE_FOREGROUND_INDEX,
   LFACE_BACKGROUND_INDEX,
+  LFACE_TTY_FOREGROUND_INDEX,
+  LFACE_TTY_BACKGROUND_INDEX,
   LFACE_STIPPLE_INDEX,
   LFACE_OVERLINE_INDEX,
   LFACE_STRIKE_THROUGH_INDEX,
diff --git a/src/xfaces.c b/src/xfaces.c
index 446107e..9366fc1 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -284,6 +284,7 @@ Lisp_Object QCfamily, QCheight, QCweight, QCslant;
 static Lisp_Object QCunderline;
 static Lisp_Object QCinverse_video, QCstipple;
 Lisp_Object QCforeground, QCbackground;
+Lisp_Object QCtty_foreground, QCtty_background;
 Lisp_Object QCwidth;
 static Lisp_Object QCfont, QCbold, QCitalic;
 static Lisp_Object QCreverse_video;
@@ -1720,6 +1721,8 @@ the WIDTH times as wide as FACE on FRAME.  */)
 #define LFACE_INVERSE(LFACE)       AREF ((LFACE), LFACE_INVERSE_INDEX)
 #define LFACE_FOREGROUND(LFACE)     AREF ((LFACE), LFACE_FOREGROUND_INDEX)
 #define LFACE_BACKGROUND(LFACE)     AREF ((LFACE), LFACE_BACKGROUND_INDEX)
+#define LFACE_TTY_FOREGROUND(LFACE) AREF ((LFACE), LFACE_TTY_FOREGROUND_INDEX)
+#define LFACE_TTY_BACKGROUND(LFACE) AREF ((LFACE), LFACE_TTY_BACKGROUND_INDEX)
 #define LFACE_STIPPLE(LFACE)       AREF ((LFACE), LFACE_STIPPLE_INDEX)
 #define LFACE_SWIDTH(LFACE)        AREF ((LFACE), LFACE_SWIDTH_INDEX)
 #define LFACE_OVERLINE(LFACE)      AREF ((LFACE), LFACE_OVERLINE_INDEX)
@@ -3059,6 +3062,40 @@ FRAME 0 means change the face on all frames, and change 
the default
       old_value = LFACE_BACKGROUND (lface);
       ASET (lface, LFACE_BACKGROUND_INDEX, value);
     }
+  else if (EQ (attr, QCtty_foreground))
+    {
+      /* Compatibility with 20.x.  */
+      if (NILP (value))
+       value = Qunspecified;
+      if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+       {
+         /* Don't check for valid color names here because it depends
+            on the frame (display) whether the color will be valid
+            when the face is realized.  */
+         CHECK_STRING (value);
+         if (SCHARS (value) == 0)
+           signal_error ("Empty foreground tty color value", value);
+       }
+      old_value = LFACE_TTY_FOREGROUND (lface);
+      ASET (lface, LFACE_TTY_FOREGROUND_INDEX, value);
+    }
+  else if (EQ (attr, QCtty_background))
+    {
+      /* Compatibility with 20.x.  */
+      if (NILP (value))
+       value = Qunspecified;
+      if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+       {
+         /* Don't check for valid color names here because it depends
+            on the frame (display) whether the color will be valid
+            when the face is realized.  */
+         CHECK_STRING (value);
+         if (SCHARS (value) == 0)
+           signal_error ("Empty background terminal color value", value);
+       }
+      old_value = LFACE_TTY_BACKGROUND (lface);
+      ASET (lface, LFACE_TTY_BACKGROUND_INDEX, value);
+    }
   else if (EQ (attr, QCstipple))
     {
 #if defined (HAVE_WINDOW_SYSTEM)
@@ -3700,6 +3737,10 @@ frames).  If FRAME is omitted or nil, use the selected 
frame.  */)
     value = LFACE_DISTANT_FOREGROUND (lface);
   else if (EQ (keyword, QCbackground))
     value = LFACE_BACKGROUND (lface);
+  else if (EQ (keyword, QCtty_foreground))
+    value = LFACE_TTY_FOREGROUND (lface);
+  else if (EQ (keyword, QCtty_background))
+    value = LFACE_TTY_BACKGROUND (lface);
   else if (EQ (keyword, QCstipple))
     value = LFACE_STIPPLE (lface);
   else if (EQ (keyword, QCwidth))
@@ -5784,6 +5825,14 @@ map_tty_color (struct frame *f, struct face *face,
 
   eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
 
+  /* Check whether tty colors take precedence. */
+  if (foreground_p &&
+      !UNSPECIFIEDP (face->lface[LFACE_TTY_FOREGROUND_INDEX]))
+    idx = LFACE_TTY_FOREGROUND_INDEX;
+  else if (!foreground_p &&
+           !UNSPECIFIEDP (face->lface[LFACE_TTY_BACKGROUND_INDEX]))
+    idx = LFACE_TTY_BACKGROUND_INDEX;
+
   XSETFRAME (frame, f);
   color = face->lface[idx];
 
@@ -6412,6 +6461,8 @@ syms_of_xfaces (void)
   DEFSYM (QCreverse_video, ":reverse-video");
   DEFSYM (QCforeground, ":foreground");
   DEFSYM (QCbackground, ":background");
+  DEFSYM (QCtty_foreground, ":tty_foreground");
+  DEFSYM (QCtty_background, ":tty_background");
   DEFSYM (QCstipple, ":stipple");
   DEFSYM (QCwidth, ":width");
   DEFSYM (QCfont, ":font");
-- 
2.1.3