bug#62994: [PATCH v2 1/1] Add support for colored and styled underlines on tty frames

[mohkale@kisara.moe]

From: Mohsin Kaleem <mohkale@kisara.moe>

* src/dispextern.h (face, face_underline_type, syms_of_xfacse,
internal-set-lisp-face-attribute, gui_supports_face_attributes_p):
Add definitions for new underline styles of Double, Dotted and Dashed.
Delete tty_underline_p from the face struct and use just underline going
forward.  Add a flag to check whether styled underlines are available.
* lisp/cus-face.el (custom-face-attributes): Add entries for Double,
Dotted and Dashed so they can be set through `customize'.
* src/termchar.c (tty_display_info): Add an entry for the escape
sequence to set the underline style and color 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.  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/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 and color in the face spec when realizing a face.
---
 etc/NEWS         |  12 +++++
 lisp/cus-face.el |   5 +-
 src/dispextern.h |  10 ++--
 src/term.c       |  54 +++++++++++++++++++--
 src/termchar.h   |   7 +++
 src/xfaces.c     | 121 ++++++++++++++++++++++++++++++++++++++++++-----
 6 files changed, 189 insertions(+), 20 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 62d2fdcd3a4..e0798687bf4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1916,6 +1916,18 @@ This command switches to the "*scratch*" buffer.  If "*scratch*" doesn't
 exist, the command creates it first.  You can use this command if you
 inadvertently delete the "*scratch*" buffer.
 
+---
+** 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 or a color other than the foreground-color.
+The available underline styles for TTY frames are 'double', 'wave',
+'dotted', and 'dashed'.
+
 ** Debugging
 
 ---
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index ec89b4f7ff6..2d6e6c7b73e 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -141,7 +141,10 @@ custom-face-attributes
 		   (const :format "" :value :style)
 		   (choice :tag "Style"
 			   (const :tag "Line" line)
-			   (const :tag "Wave" wave))
+			   (const :tag "Double" double)
+			   (const :tag "Wave" wave)
+			   (const :tag "Dotted" dotted)
+			   (const :tag "Dashed" dashed))
                    (const :format "" :value :position)
                    (choice :tag "Position"
                            (const :tag "At Default Position" nil)
diff --git a/src/dispextern.h b/src/dispextern.h
index 4dcab113ea2..753bee446f1 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1653,9 +1653,13 @@ #define FONT_TOO_HIGH(ft)						\
 
 enum face_underline_type
 {
+	/* Note: Order matches the order of the Smulx terminfo extension. */
   FACE_NO_UNDERLINE = 0,
   FACE_UNDER_LINE,
-  FACE_UNDER_WAVE
+  FACE_DOUBLE_UNDER_LINE,
+  FACE_UNDER_WAVE,
+  FACE_DOTTED_UNDER_LINE,
+  FACE_DASHED_UNDER_LINE,
 };
 
 /* Structure describing a realized face.
@@ -1737,7 +1741,7 @@ #define FONT_TOO_HIGH(ft)						\
   ENUM_BF (face_box_type) box : 2;
 
   /* Style of underlining. */
-  ENUM_BF (face_underline_type) underline : 2;
+  ENUM_BF (face_underline_type) underline : 3;
 
   /* If `box' above specifies a 3D type, true means use box_color for
      drawing shadows.  */
@@ -1769,7 +1773,6 @@ #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;
   bool_bf tty_reverse_p : 1;
   bool_bf tty_strike_through_p : 1;
 
@@ -3361,6 +3364,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 53ba2a231e4..2c1d44bff7a 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1948,8 +1948,19 @@ 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->underline && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
+    {
+	if (face->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->underline, 0, 0, 0);
+		OUTPUT (tty, p);
+		xfree (p);
+	  }
+    }
 
   if (face->tty_strike_through_p
       && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
@@ -1975,6 +1986,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);
+	}
     }
 }
 
@@ -1995,7 +2014,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->underline
 	  || face->tty_strike_through_p)
 	{
 	  OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
@@ -2007,7 +2026,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->underline)
 	OUTPUT_IF (tty, tty->TS_exit_underline_mode);
     }
 
@@ -2036,6 +2055,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,
@@ -4250,6 +4272,30 @@ 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"))
+		/* Default to the kitty escape sequence.  See
+		   https://sw.kovidgoyal.net/kitty/underlines/ */
+		tty->TF_set_underline_style = "\x1b[4:%p1%dm";
+
+	if (tty->TF_set_underline_style)
+		/* This escape sequence for setting the underline color is
+		   consistent with the one described in kitty (see above) and
+		   adapted from the one used by neovim.  This sequence has
+		   been altered from the neovim sequence at
+		   https://github.com/neovim/neovim/blob/42f492ac99058bd1cd56c3c7871e7e464b2a5e24/src/nvim/tui/tui.c
+		   to require only a single parameter, the color index.  */
+		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 5c47679a994..946ffb344d9 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -171,6 +171,13 @@ #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).  */
+  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 37b703984be..65118ff020e 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3255,7 +3255,11 @@ DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
                 }
 
               else if (EQ (key, QCstyle)
-                       && !(EQ (val, Qline) || EQ (val, Qwave)))
+                       && !(EQ (val, Qline)
+                            || EQ (val, Qdouble)
+                            || EQ (val, Qwave)
+                            || EQ (val, Qdotted)
+                            || EQ (val, Qdashed)))
                 {
                   valid_p = false;
                   break;
@@ -5204,6 +5208,7 @@ gui_supports_face_attributes_p (struct frame *f,
                                 Lisp_Object attrs[LFACE_VECTOR_SIZE],
                                 struct face *def_face)
 {
+  Lisp_Object val;
   Lisp_Object *def_attrs = def_face->lface;
   Lisp_Object lattrs[LFACE_VECTOR_SIZE];
 
@@ -5298,6 +5303,20 @@ gui_supports_face_attributes_p (struct frame *f,
       return false;
     }
 
+  /* Check supported underline styles. */
+  val = attrs[LFACE_UNDERLINE_INDEX];
+  if (!UNSPECIFIEDP (val))
+    {
+	if (EQ (CAR_SAFE (val), QCstyle))
+	  {
+		if (!(EQ (CAR_SAFE (CDR_SAFE (val)), Qline)
+		      || EQ (CAR_SAFE (CDR_SAFE (val)), Qwave)))
+		  {
+			return false; /* Unsupported underline style */
+		  }
+	  }
+    }
+
   /* Everything checks out, this face is supported.  */
   return true;
 }
@@ -5390,15 +5409,26 @@ tty_supports_face_attributes_p (struct frame *f,
   val = attrs[LFACE_UNDERLINE_INDEX];
   if (!UNSPECIFIEDP (val))
     {
-      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 (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
-	return false;		/* same as default */
-      else
-	test_caps |= TTY_CAP_UNDERLINE;
-    }
+	if (STRINGP (val))
+		test_caps |= TTY_CAP_UNDERLINE_STYLED;
+	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; /* Face uses an 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
+		test_caps |= TTY_CAP_UNDERLINE;
+  }
 
   /* inverse video */
   val = attrs[LFACE_INVERSE_INDEX];
@@ -6319,6 +6349,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))
 	    {
@@ -6453,6 +6485,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;
 
@@ -6472,13 +6505,74 @@ 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->underline = FACE_NO_UNDERLINE;
+	face->underline_color = 0;
+    }
+  else if (EQ (underline, Qt))
+    {
+	face->underline = FACE_UNDER_LINE;
+	face->underline_color = 0;
+    }
+  else if (STRINGP (underline))
+    {
+	face->underline = FACE_UNDER_LINE;
+	face->underline_color = load_color (f, face, underline, LFACE_UNDERLINE_INDEX);
+    }
+  else if (CONSP (underline))
+    {
+	/* `(:color COLOR :style STYLE)'.
+	   STYLE being one of `line', `double', `wave', `dotted' or `dashed'.  */
+	face->underline = FACE_UNDER_LINE;
+	face->underline_color = 0;
+
+	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, 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->underline = FACE_UNDER_LINE;
+			else if (EQ (value, Qdouble))
+				face->underline = FACE_DOUBLE_UNDER_LINE;
+			else if (EQ (value, Qwave))
+				face->underline = FACE_UNDER_WAVE;
+			else if (EQ (value, Qdotted))
+				face->underline = FACE_DOTTED_UNDER_LINE;
+			else if (EQ (value, Qdashed))
+				face->underline = FACE_DASHED_UNDER_LINE;
+			else
+				face->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);
@@ -7165,6 +7259,9 @@ syms_of_xfaces (void)
   DEFSYM (QCposition, ":position");
   DEFSYM (Qline, "line");
   DEFSYM (Qwave, "wave");
+  DEFSYM (Qdouble, "double");
+  DEFSYM (Qdotted, "dotted");
+  DEFSYM (Qdashed, "dashed");
   DEFSYM (Qreleased_button, "released-button");
   DEFSYM (Qpressed_button, "pressed-button");
   DEFSYM (Qflat_button, "flat-button");
-- 
2.40.0