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

[mohkale@kisara.moe]

From: Mohsin Kaleem <mohkale@kisara.moe>

* 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 d868ee773fd..73a15eb44a4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -421,20 +421,23 @@ respectively, in addition to the existing translations 'C-x 8 / e' and
 'C-x 8 / E'.
 
 ---
-** 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.
 
 \f
 * Changes in Specialized Modes and Packages in Emacs 30.1
diff --git a/src/term.c b/src/term.c
index 06dbb95171e..1ab6936db76 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2050,6 +2050,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);
+	}
     }
 }
 
@@ -4387,6 +4395,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 7fc1f347230..846cd3001cc 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 684e72bd897..4d860540cb9 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -5469,7 +5469,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) ||
@@ -6572,14 +6572,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;
@@ -6592,7 +6596,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.43.0