Subject: bug#62994: [PATCH 3/3] Add support for colored underlines on tty frames

From: [email-masked]
Date: Fri, 21 Apr 2023 15:34:48 +0100

From: Mohsin Kaleem <[email-masked]>

* src/term.c (turn_on_face, init_tty): Output escape sequence to set
underline color when set in the face and supported by the tty. Save
a default value for this sequence on init_tty when styled underlines
are supported.
* src/termchar.c (tty_display_info): Add an entry for the escape
sequence to set the underline color on terminal frames.
* src/xfaces.c (tty_supports_face_attributes_p, realize_tty_face):
Assert whether colored underlines are supported by the current terminal
on display-supports-face-attributes-p checks. Load and save the color
of the underline from the face spec when realizing a face.
---
 etc/NEWS       | 11 +++++++----
 src/term.c     | 11 +++++++++++
 src/termchar.h |  3 +++
 src/xfaces.c   | 16 +++++++++++++---
 4 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 9f34927dfad..46b2b0e25c5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1917,20 +1917,23 @@ exist, the command creates it first.  You can use this command if you
 inadvertently delete the "*scratch*" buffer.
 
 ---
-** Support for 'styled-underline' face attributes on TTY frames
+** Support for 'styled' and 'colored' underline face attributes on TTY frames
 If your terminals termcap or terminfo database entry has the 'Su' or
 'Smulx' capability defined, Emacs will now emit the prescribed escape
 sequence necessary to render faces with styled underlines on TTY
 frames.
 
 Styled underlines are any underlines containing a non-default
-underline style.  The available underline styles for TTY frames are
-'double', 'wave', 'dotted', and 'dashed'.
+underline style or a color other than the foreground-color.
+The available underline styles for TTY frames are 'double', 'wave',
+'dotted', and 'dashed'.
 
 The 'Smulx' capability should define the actual sequence needed to
 render styled underlines. If ommitted, but the 'Su' flag is defined,
 then a default sequence will be used. It's recommended to use 'Smulx'
-instead of 'Su', with priority being given to 'Smulx'.
+instead of 'Su', with priority being given to 'Smulx'.  Support for
+colored underlines is automatically enabled with a default escape
+sequence when styled underline are supported.
 
 ** Debugging
 
diff --git a/src/term.c b/src/term.c
index 0f0393780eb..a1eb1961fad 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1984,6 +1984,14 @@ turn_on_face (struct frame *f, int face_id)
 	  OUTPUT (tty, p);
 	  xfree (p);
 	}
+
+      ts = tty->TF_set_underline_color;
+      if (ts && face->underline_color)
+	{
+          p = tparam (ts, NULL, 0, face->underline_color, 0, 0, 0);
+	  OUTPUT (tty, p);
+	  xfree (p);
+	}
     }
 }
 
@@ -4277,6 +4285,9 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
   if (!tty->TF_set_underline_style && tgetflag("Su"))
     tty->TF_set_underline_style = "\x1b[4:%p1%dm";
 
+  if (tty->TF_set_underline_style)
+    tty->TF_set_underline_color = "\x1b[58:2::%p1%{65536}%/%d:%p1%{256}%/%{255}%&%d:%p1%{255}%&%dm";
+
 #else /* DOS_NT */
 #ifdef WINDOWSNT
   {
diff --git a/src/termchar.h b/src/termchar.h
index 319c2319fba..563cde715ec 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -175,6 +175,9 @@ #define EMACS_TERMCHAR_H
                                            style based on the parameter. Param should
                                            be one of: 0 (none), 1 (straight), 2 (double),
                                            3 (wave), 4 (dotted), or 5 (dashed). */
+  const char *TF_set_underline_color;   /* Enabled when TF_set_underline_style is set:
+                                           Sets the color of the underline. Accepts a
+                                           single parameter, the color index. */
 
   int RPov;                     /* # chars to start a TS_repeat */
 
diff --git a/src/xfaces.c b/src/xfaces.c
index 2c6c554d01d..c547a0b92f3 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -5407,7 +5407,7 @@ tty_supports_face_attributes_p (struct frame *f,
   if (!UNSPECIFIEDP (val))
     {
       if (STRINGP (val))
-	return false;		/* ttys can't use colored underlines */
+	test_caps |= TTY_CAP_UNDERLINE_STYLED;
       else if (EQ (CAR_SAFE (val), QCstyle))
     {
         if (!(EQ (CAR_SAFE (CDR_SAFE (val)), Qline) ||
@@ -6510,14 +6510,18 @@ realize_tty_face (struct face_cache *cache,
   underline = attrs[LFACE_UNDERLINE_INDEX];
   if (NILP (underline)) {
     face->tty_underline = FACE_NO_UNDERLINE;
+    face->underline_color = 0;
   } else if (EQ (underline, Qt)) {
     face->tty_underline = FACE_UNDER_LINE;
+    face->underline_color = 0;
   } else if (STRINGP (underline)) {
     face->tty_underline = FACE_UNDER_LINE;
+	face->underline_color = load_color (f, face, underline, LFACE_UNDERLINE_INDEX);
   } else if (CONSP (underline)) {
-    /* `(:style STYLE)'.
+    /* `(:color COLOR :style STYLE)'.
        STYLE being one of `line', `double', `wave', `dotted' or `dashed'. */
     face->tty_underline = FACE_UNDER_LINE;
+    face->underline_color = 0;
 
     while (CONSP (underline)) {
       Lisp_Object keyword, value;
@@ -6530,7 +6534,13 @@ realize_tty_face (struct face_cache *cache,
       value = XCAR (underline);
       underline = XCDR (underline);
 
-      if (EQ (keyword, QCstyle)) {
+      if (EQ (keyword, QCcolor)) {
+        if (EQ (value, Qforeground_color))
+          face->underline_color = 0;
+        else if (STRINGP (value))
+          face->underline_color = load_color (f, face, value, LFACE_UNDERLINE_INDEX);
+      }
+      else if (EQ (keyword, QCstyle)) {
         if (EQ (value, Qline))
           face->tty_underline = FACE_UNDER_LINE;
         else if (EQ (value, Qdouble))
-- 
2.40.0