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

[mohkale@kisara.moe]

From: Mohsin Kaleem <mohkale@kisara.moe>

* src/dispextern.h (face): Convert tty_underline_p from bool to a
face_underline_type enumeration. Add a flag to check whether styled
underlines are available.
* src/termchar.c (tty_display_info): Add an entry for the escape
sequence to set the underline style on terminal frames.
* src/term.c (init_tty, tty_capable_p, turn_on_face): Read and save the
underline style escape sequence from the Smulx termcap (alternatively if
the Su flag is set use a default sequence). Allow checking for support
of styled underlines in the current terminal frame. Output the necessary
escape sequences to activate a styled underline on turn_on_face; this is
currently only used for the new special underline styles, a default
straight underline will still use the "us" termcap.
* src/xfaces.c (tty_supports_face_attributes_p, realize_tty_face):
Assert whether styled underlines are supported by the current terminal
on display-supports-face-attributes-p checks. Populate the correct
underline style in the face spec when realizing a face.
---
 etc/NEWS         | 16 +++++++++++++
 src/dispextern.h |  3 ++-
 src/term.c       | 35 ++++++++++++++++++++++++----
 src/termchar.h   |  4 ++++
 src/xfaces.c     | 60 ++++++++++++++++++++++++++++++++++++++++++++----
 5 files changed, 109 insertions(+), 9 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 5ee1509859b..d868ee773fd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -420,6 +420,22 @@ These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E',
 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
+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'.
+
+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'.
+
 \f
 * Changes in Specialized Modes and Packages in Emacs 30.1
 
diff --git a/src/dispextern.h b/src/dispextern.h
index 470d2eea3ae..31e946c387a 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1812,7 +1812,7 @@ #define FONT_TOO_HIGH(ft)						\
      string meaning the default color of the TTY.  */
   bool_bf tty_bold_p : 1;
   bool_bf tty_italic_p : 1;
-  bool_bf tty_underline_p : 1;
+  ENUM_BF (face_underline_type) tty_underline : 3;
   bool_bf tty_reverse_p : 1;
   bool_bf tty_strike_through_p : 1;
 
@@ -3425,6 +3425,7 @@ #define TTY_CAP_BOLD		0x04
 #define TTY_CAP_DIM		0x08
 #define TTY_CAP_ITALIC  	0x10
 #define TTY_CAP_STRIKE_THROUGH	0x20
+#define TTY_CAP_UNDERLINE_STYLED	0x32 & TTY_CAP_UNDERLINE
 
 \f
 /***********************************************************************
diff --git a/src/term.c b/src/term.c
index 3fa244be824..06dbb95171e 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2014,8 +2014,17 @@ turn_on_face (struct frame *f, int face_id)
 	OUTPUT1 (tty, tty->TS_enter_dim_mode);
     }
 
-  if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
-    OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+  if (face->tty_underline && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE)) {
+    if (face->tty_underline == FACE_UNDER_LINE ||
+        !tty->TF_set_underline_style) {
+      OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+    } else if (tty->TF_set_underline_style) {
+      char *p;
+      p = tparam(tty->TF_set_underline_style, NULL, 0, face->tty_underline, 0, 0, 0);
+      OUTPUT (tty, p);
+      xfree (p);
+    }
+  }
 
   if (face->tty_strike_through_p
       && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
@@ -2061,7 +2070,7 @@ turn_off_face (struct frame *f, int face_id)
       if (face->tty_bold_p
 	  || face->tty_italic_p
 	  || face->tty_reverse_p
-	  || face->tty_underline_p
+	  || face->tty_underline
 	  || face->tty_strike_through_p)
 	{
 	  OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
@@ -2073,7 +2082,7 @@ turn_off_face (struct frame *f, int face_id)
     {
       /* If we don't have "me" we can only have those appearances
 	 that have exit sequences defined.  */
-      if (face->tty_underline_p)
+      if (face->tty_underline)
 	OUTPUT_IF (tty, tty->TS_exit_underline_mode);
     }
 
@@ -2104,6 +2113,9 @@ #define TTY_CAPABLE_P_TRY(tty, cap, TS, NC_bit)				\
   TTY_CAPABLE_P_TRY (tty,
 		     TTY_CAP_UNDERLINE,	  tty->TS_enter_underline_mode,
 		     NC_UNDERLINE);
+  TTY_CAPABLE_P_TRY (tty,
+		     TTY_CAP_UNDERLINE_STYLED,	  tty->TF_set_underline_style,
+             NC_UNDERLINE);
   TTY_CAPABLE_P_TRY (tty,
 		     TTY_CAP_BOLD,	  tty->TS_enter_bold_mode, NC_BOLD);
   TTY_CAPABLE_P_TRY (tty,
@@ -4360,6 +4372,21 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
   tty->TF_underscore = tgetflag ("ul");
   tty->TF_teleray = tgetflag ("xt");
 
+  // Styled underlines.
+  //
+  // Support for this is provided either by the escape sequence in
+  // Smulx or the Su flag. The latter results in a common default
+  // escape sequence and is not recommended.
+#ifdef TERMINFO
+  tty->TF_set_underline_style = tigetstr("Smulx");
+  if (tty->TF_set_underline_style == (char *) (intptr_t) -1)
+    tty->TF_set_underline_style = NULL;
+#else
+  tty->TF_set_underline_style = tgetstr("Smulx", address);
+#endif
+  if (!tty->TF_set_underline_style && tgetflag("Su"))
+    tty->TF_set_underline_style = "\x1b[4:%p1%dm";
+
 #else /* DOS_NT */
 #ifdef WINDOWSNT
   {
diff --git a/src/termchar.h b/src/termchar.h
index 2d845107e11..7fc1f347230 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -171,6 +171,10 @@ #define EMACS_TERMCHAR_H
                                    non-blank position.  Must clear before writing _.  */
   int TF_teleray;               /* termcap xt flag: many weird consequences.
                                    For t1061. */
+  const char *TF_set_underline_style;   /* termcap Smulx entry: Switches the underline
+                                           style based on the parameter. Param should
+                                           be one of: 0 (none), 1 (straight), 2 (double),
+                                           3 (wave), 4 (dotted), or 5 (dashed). */
 
   int RPov;                     /* # chars to start a TS_repeat */
 
diff --git a/src/xfaces.c b/src/xfaces.c
index a76a9365b8a..684e72bd897 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -5470,8 +5470,18 @@ tty_supports_face_attributes_p (struct frame *f,
     {
       if (STRINGP (val))
 	return false;		/* ttys can't use colored underlines */
-      else if (EQ (CAR_SAFE (val), QCstyle) && EQ (CAR_SAFE (CDR_SAFE (val)), Qwave))
-	return false;		/* ttys can't use wave underlines */
+      else if (EQ (CAR_SAFE (val), QCstyle))
+    {
+        if (!(EQ (CAR_SAFE (CDR_SAFE (val)), Qline) ||
+              EQ (CAR_SAFE (CDR_SAFE (val)), Qdouble) ||
+              EQ (CAR_SAFE (CDR_SAFE (val)), Qwave) ||
+              EQ (CAR_SAFE (CDR_SAFE (val)), Qdotted) ||
+              EQ (CAR_SAFE (CDR_SAFE (val)), Qdashed))) {
+            return false; /* Unsupported underline style */
+        }
+
+	    test_caps |= TTY_CAP_UNDERLINE_STYLED;
+    }
       else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
 	return false;		/* same as default */
       else
@@ -6397,6 +6407,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
                 face->underline = FACE_UNDER_LINE;
               else if (EQ (value, Qwave))
                 face->underline = FACE_UNDER_WAVE;
+              else
+                face->underline = FACE_UNDER_LINE;
             }
 	  else if (EQ (keyword, QCposition))
 	    {
@@ -6531,6 +6543,7 @@ realize_tty_face (struct face_cache *cache,
 {
   struct face *face;
   int weight, slant;
+  Lisp_Object underline;
   bool face_colors_defaulted = false;
   struct frame *f = cache->f;
 
@@ -6550,13 +6563,52 @@ realize_tty_face (struct face_cache *cache,
     face->tty_bold_p = true;
   if (slant != 100)
     face->tty_italic_p = true;
-  if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
-    face->tty_underline_p = true;
   if (!NILP (attrs[LFACE_INVERSE_INDEX]))
     face->tty_reverse_p = true;
   if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX]))
     face->tty_strike_through_p = true;
 
+  /* Text underline.  */
+  underline = attrs[LFACE_UNDERLINE_INDEX];
+  if (NILP (underline)) {
+    face->tty_underline = FACE_NO_UNDERLINE;
+  } else if (EQ (underline, Qt)) {
+    face->tty_underline = FACE_UNDER_LINE;
+  } else if (STRINGP (underline)) {
+    face->tty_underline = FACE_UNDER_LINE;
+  } else if (CONSP (underline)) {
+    /* `(:style STYLE)'.
+       STYLE being one of `line', `double', `wave', `dotted' or `dashed'. */
+    face->tty_underline = FACE_UNDER_LINE;
+
+    while (CONSP (underline)) {
+      Lisp_Object keyword, value;
+
+      keyword = XCAR (underline);
+      underline = XCDR (underline);
+
+      if (!CONSP (underline))
+        break;
+      value = XCAR (underline);
+      underline = XCDR (underline);
+
+      if (EQ (keyword, QCstyle)) {
+        if (EQ (value, Qline))
+          face->tty_underline = FACE_UNDER_LINE;
+        else if (EQ (value, Qdouble))
+          face->tty_underline = FACE_DOUBLE_UNDER_LINE;
+        else if (EQ (value, Qwave))
+          face->tty_underline = FACE_UNDER_WAVE;
+        else if (EQ (value, Qdotted))
+          face->tty_underline = FACE_DOTTED_UNDER_LINE;
+        else if (EQ (value, Qdashed))
+          face->tty_underline = FACE_DASHED_UNDER_LINE;
+        else
+          face->tty_underline = FACE_UNDER_LINE;
+      }
+    }
+  }
+
   /* Map color names to color indices.  */
   map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
   map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
-- 
2.43.0