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

[Po Lu via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

mohkale@kisara.moe writes:

> ++++

Where's the documentation for this change?

> +*** Support for 'styled' and 'colored' underline face attributes on TTY frames

We prefer to punctuate sentences within NEWS headings.

> +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'.  These are currently supported by Kitty,
> +libvte, and st (through the undercurl patch) among other terminals.

What about GUI frames?  I don't want to see a display feature installed
before it is also implemented for the likes of X.

>  \f
>  * Editing Changes in Emacs 30.1
>  
> diff --git a/lisp/cus-face.el b/lisp/cus-face.el
> index 47afa841f5e..12551e37785 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 5387cb45603..574798fc547 100644
> --- a/src/dispextern.h
> +++ b/src/dispextern.h
> @@ -1690,9 +1690,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.
> @@ -1776,7 +1780,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.  */
> @@ -1808,7 +1812,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;
>  
> @@ -3421,6 +3424,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

#define TTY_CAP_UNDERLINE_STYLED (0x32 & TTY_CAP_UNDERLINE)

> +  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);
> +	  }
> +	}

In Emacs, we format code with a mixture of tabs and spaces, using tabs
to indent by whole tab stops and spaces to indent to the desired column,
which is a multiple of 2 columns for most statements or the column after
the opening paren where applicable.  Please also insert a space between
function identifiers and argument lists, and confine all text to 80
columns.

>    if (face->tty_strike_through_p
>        && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
> @@ -2041,6 +2052,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);
> +	}
>      }
>  }

Likewise.

> @@ -2061,7 +2080,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);
> @@ -2073,7 +2092,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);
>      }
>  
> @@ -2104,6 +2123,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 +4382,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.	 */

Here you have evidently typed `M-x tabify' with a comment selected.  Do
not insert tabs by whatever means within the body of a comment, although
it is best to indent the body itself with them, whenever possible.

> +#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#L1932
> +		   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";

More indentation problems.  Please don't link to Github, and explain
instead the reasoning behind the sequence itself.

>  #else /* DOS_NT */
>  #ifdef WINDOWSNT
>    {
> diff --git a/src/termchar.h b/src/termchar.h
> index 2d845107e11..de9009d32f1 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.	 */

Egregious indentation error.

>    int RPov;                     /* # chars to start a TS_repeat */
>  
> diff --git a/src/xfaces.c b/src/xfaces.c
> index a558e7328c0..a39e2bb6781 100644
> --- a/src/xfaces.c
> +++ b/src/xfaces.c
> @@ -3311,7 +3311,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;
> @@ -5266,6 +5270,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];
>  
> @@ -5360,6 +5365,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;
>  }
> @@ -5452,15 +5471,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;
> +  }

Ditto.  Please also avoid inserting redundant braces in if statements.

>  static void
> -map_tty_color (struct frame *f, struct face *face,
> +map_tty_color (struct frame *f, struct face *face, Lisp_Object color,
>  	       enum lface_attribute_index idx, bool *defaulted)
>  {
> -  Lisp_Object frame, color, def;
> -  bool foreground_p = idx == LFACE_FOREGROUND_INDEX;
> +  Lisp_Object frame, def;
> +  bool foreground_p = idx != LFACE_BACKGROUND_INDEX;
>    unsigned long default_pixel =
>      foreground_p ? FACE_TTY_DEFAULT_FG_COLOR : FACE_TTY_DEFAULT_BG_COLOR;
>    unsigned long pixel = default_pixel;
> @@ -6450,10 +6483,11 @@ map_tty_color (struct frame *f, struct face *face,
>      foreground_p ? FACE_TTY_DEFAULT_BG_COLOR : FACE_TTY_DEFAULT_FG_COLOR;
>  #endif
>  
> -  eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
> +  eassert (idx == LFACE_FOREGROUND_INDEX
> +	   || idx == LFACE_BACKGROUND_INDEX
> +	   || idx == LFACE_UNDERLINE_INDEX);
>  
>    XSETFRAME (frame, f);
> -  color = face->lface[idx];
>  
>    if (STRINGP (color)
>        && SCHARS (color)
> @@ -6498,10 +6532,28 @@ map_tty_color (struct frame *f, struct face *face,
>  #endif /* MSDOS */
>      }
>  
> -  if (foreground_p)
> -    face->foreground = pixel;
> -  else
> -    face->background = pixel;
> +  switch (idx)
> +	{
> +	case LFACE_FOREGROUND_INDEX:
> +	  face->foreground = pixel;
> +	  break;
> +	case LFACE_BACKGROUND_INDEX:
> +	  face->background = pixel;
> +	  break;
> +	case LFACE_UNDERLINE_INDEX:
> +	  face->underline_color = pixel;
> +	  break;
> +	default:
> +	  emacs_abort ();
> +	}
> +}
> +
> +static void
> +map_tty_color2 (struct frame *f, struct face *face, Lisp_Object color,
> +		enum lface_attribute_index idx)
> +{
> +	bool face_colors_defaulted = false;
> +	map_tty_color (f, face, color, idx, &face_colors_defaulted);
>  }

Ditto.

> @@ -6515,6 +6567,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;
>  
> @@ -6534,16 +6587,77 @@ 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;
> +	map_tty_color2 (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))
> +				map_tty_color2 (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;
> +		  }
> +	  }
> +    }

And ditto.  Thanks.