[patch] add "underwave" face attribute

["Aurélien Aptel" <aurelien.aptel@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 698 bytes --]

Hi all,

I implemented a new face attribute "underwave". It does exactly what
this thread[1] asked for.
It only works on X11 currently. I don't have a windows/mac machine to
port this feature but it should be easy to do: just port the changes
made to xterm.c to other *term.c. I've basically followed whatever
"overline" was doing so it should be ok.

I've attached the diff and a screenshot of the splash screen with the
default and link face changed to use underwaving. Note that it looks
good on both X11 core fonts and Xft fonts.

I would love to this this merged in emacs so -- if everything's
alright -- what's the next step?

1: http://thread.gmane.org/gmane.emacs.devel/147873/focus=147905

[-- Attachment #2: underwave.diff --]
[-- Type: text/x-patch, Size: 18217 bytes --]

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 381eaf6..1aa8712 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2089,6 +2089,10 @@ value @code{nil} means do not underline.
 Whether or not characters should be overlined, and in what color.
 The value is used like that of @code{:underline}.
 
+@item :underwave
+Whether or not characters should be underwaved, and in what color.
+The value is used like that of @code{:underline}.
+
 @item :strike-through
 Whether or not characters should be strike-through, and in what
 color.  The value is used like that of @code{:underline}.
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index d725111..e7f2088 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -145,6 +145,13 @@
 	     (const :tag "On" t)
 	     (color :tag "Colored")))
 
+    (:underwave
+     (choice :tag "Underwave"
+	     :help-echo "Control text underwaving."
+	     (const :tag "Off" nil)
+	     (const :tag "On" t)
+	     (color :tag "Colored")))
+
     (:strike-through
      (choice :tag "Strike-through"
 	     :help-echo "Control text strike-through."
diff --git a/lisp/custom.el b/lisp/custom.el
index 132576a..deaaec5 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -368,7 +368,7 @@ ATTS is a list of face attributes followed by their values:
   (ATTR VALUE ATTR VALUE...)
 
 The possible attributes are `:family', `:width', `:height', `:weight',
-`:slant', `:underline', `:overline', `:strike-through', `:box',
+`:slant', `:underline', `:overline', `:underwave', `:strike-through', `:box',
 `:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'.
 
 DISPLAY can be `default' (only in the first element), the symbol
diff --git a/lisp/faces.el b/lisp/faces.el
index 5d406ad..a3b8309 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -272,6 +272,7 @@ If FRAME is omitted or nil, use the selected frame."
     (:foreground (".attributeForeground" . "Face.AttributeForeground"))
     (:background (".attributeBackground" . "Face.AttributeBackground"))
     (:overline (".attributeOverline" . "Face.AttributeOverline"))
+    (:underwave (".attributeUnderwave" . "Face.AttributeUnderwave"))
     (:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
     (:box (".attributeBox" . "Face.AttributeBox"))
     (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
@@ -628,6 +629,13 @@ VALUE is t, overline with foreground color of the face.  If VALUE is a
 string, overline with that color.  If VALUE is nil, explicitly don't
 overline.
 
+`:underwave'
+
+VALUE specifies whether characters in FACE should be underwaved.  If
+VALUE is t, underwave with foreground color of the face.  If VALUE is a
+string, underwave with that color.  If VALUE is nil, explicitly don't
+underwave.
+
 `:strike-through'
 
 VALUE specifies whether characters in FACE should be drawn with a line
@@ -992,7 +1000,7 @@ an integer value."
 	   (:inverse-video
 	    (mapcar #'(lambda (x) (cons (symbol-name x) x))
 		    (internal-lisp-face-attribute-values attribute)))
-           ((:underline :overline :strike-through :box)
+           ((:underline :overline :underwave :strike-through :box)
             (if (window-system frame)
                 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
                                (internal-lisp-face-attribute-values attribute))
@@ -1034,6 +1042,7 @@ an integer value."
     (:slant . "slant")
     (:underline . "underline")
     (:overline . "overline")
+    (:underwave . "underwave")
     (:strike-through . "strike-through")
     (:box . "box")
     (:inverse-video . "inverse-video display")
@@ -1323,6 +1332,7 @@ If FRAME is omitted or nil, use the selected frame."
 		  (:background . "Background")
 		  (:underline . "Underline")
 		  (:overline . "Overline")
+		  (:underwave . "Underwave")
 		  (:strike-through . "Strike-through")
 		  (:box . "Box")
 		  (:inverse-video . "Inverse")
diff --git a/src/dispextern.h b/src/dispextern.h
index 2c59f4f..7c93a11 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1484,6 +1484,7 @@ enum lface_attribute_index
   LFACE_BACKGROUND_INDEX,
   LFACE_STIPPLE_INDEX,
   LFACE_OVERLINE_INDEX,
+  LFACE_UNDERWAVE_INDEX,
   LFACE_STRIKE_THROUGH_INDEX,
   LFACE_BOX_INDEX,
   LFACE_FONT_INDEX,
@@ -1551,9 +1552,10 @@ struct face
   /* Pixel value or color index of underline color.  */
   unsigned long underline_color;
 
-  /* Pixel value or color index of overlined, strike-through, or box
-     color.  */
+  /* Pixel value or color index of overlined, underwaved,
+     strike-through, or box color.  */
   unsigned long overline_color;
+  unsigned long underwave_color;
   unsigned long strike_through_color;
   unsigned long box_color;
 
@@ -1586,9 +1588,10 @@ struct face
   unsigned use_box_color_for_shadows_p : 1;
 
   /* Non-zero if text in this face should be underlined, overlined,
-     strike-through or have a box drawn around it.  */
+     underwaved, strike-through or have a box drawn around it.  */
   unsigned underline_p : 1;
   unsigned overline_p : 1;
+  unsigned underwave_p : 1;
   unsigned strike_through_p : 1;
 
   /* 1 means that the colors specified for this face could not be
@@ -1606,6 +1609,7 @@ struct face
      attribute or that the specified color couldn't be loaded.
      Use the foreground color when drawing in that case. */
   unsigned overline_color_defaulted_p : 1;
+  unsigned underwave_color_defaulted_p : 1;
   unsigned strike_through_color_defaulted_p : 1;
   unsigned box_color_defaulted_p : 1;
 
diff --git a/src/xfaces.c b/src/xfaces.c
index 617097d..4cfb061 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -53,10 +53,13 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
    13. Whether or not characters should be strike-through, and in what
    color.
 
-   14. Whether or not a box should be drawn around characters, the box
+   14. Whether or not characters should be underwaved, and in what
+   color.
+
+   15. Whether or not a box should be drawn around characters, the box
    type, and, for simple boxes, in what color.
 
-   15. Font-spec, or nil.  This is a special attribute.
+   16. Font-spec, or nil.  This is a special attribute.
 
    A font-spec is a collection of font attributes (specs).
 
@@ -68,13 +71,13 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
    On the other hand, if one of the other font-related attributes are
    specified, the corresponding specs in this attribute is set to nil.
 
-   15. A face name or list of face names from which to inherit attributes.
+   17. A face name or list of face names from which to inherit attributes.
 
-   16. A specified average font width, which is invisible from Lisp,
+   18. A specified average font width, which is invisible from Lisp,
    and is used to ensure that a font specified on the command line,
    for example, can be matched exactly.
 
-   17. A fontset name.  This is another special attribute.
+   19. A fontset name.  This is another special attribute.
 
    A fontset is a mappings from characters to font-specs, and the
    specs overwrite the font-spec in the 14th attribute.
@@ -313,7 +316,7 @@ Lisp_Object QCforeground, QCbackground;
 Lisp_Object QCwidth;
 static Lisp_Object QCfont, QCbold, QCitalic;
 static Lisp_Object QCreverse_video;
-static Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
+static Lisp_Object QCoverline, QCunderwave, QCstrike_through, QCbox, QCinherit;
 static Lisp_Object QCfontset;
 
 /* Symbols used for attribute values.  */
@@ -1311,11 +1314,11 @@ COLOR must be a valid color name.  */)
 /* Load color with name NAME for use by face FACE on frame F.
    TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
    LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
-   LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX.  Value is the
-   pixel color.  If color cannot be loaded, display a message, and
-   return the foreground, background or underline color of F, but
-   record that fact in flags of the face so that we don't try to free
-   these colors.  */
+   LFACE_UNDERWAVE_INDEX, LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX.
+   Value is the pixel color.  If color cannot be loaded, display a
+   message, and return the foreground, background or underline color
+   of F, but record that fact in flags of the face so that we don't
+   try to free these colors.  */
 
 unsigned long
 load_color (struct frame *f, struct face *face, Lisp_Object name,
@@ -1328,6 +1331,7 @@ load_color (struct frame *f, struct face *face, Lisp_Object name,
 	   || target_index == LFACE_BACKGROUND_INDEX
 	   || target_index == LFACE_UNDERLINE_INDEX
 	   || target_index == LFACE_OVERLINE_INDEX
+	   || target_index == LFACE_UNDERWAVE_INDEX
 	   || target_index == LFACE_STRIKE_THROUGH_INDEX
 	   || target_index == LFACE_BOX_INDEX);
 
@@ -1359,6 +1363,11 @@ load_color (struct frame *f, struct face *face, Lisp_Object name,
 	  color.pixel = FRAME_FOREGROUND_PIXEL (f);
 	  break;
 
+	case LFACE_UNDERWAVE_INDEX:
+	  face->underwave_color_defaulted_p = 1;
+	  color.pixel = FRAME_FOREGROUND_PIXEL (f);
+	  break;
+
 	case LFACE_STRIKE_THROUGH_INDEX:
 	  face->strike_through_color_defaulted_p = 1;
 	  color.pixel = FRAME_FOREGROUND_PIXEL (f);
@@ -1477,6 +1486,13 @@ free_face_colors (struct frame *f, struct face *face)
       IF_DEBUG (--ncolors_allocated);
     }
 
+  if (face->underwave_p
+      && !face->underwave_color_defaulted_p)
+    {
+      x_free_colors (f, &face->underwave_color, 1);
+      IF_DEBUG (--ncolors_allocated);
+    }
+
   if (face->strike_through_p
       && !face->strike_through_color_defaulted_p)
     {
@@ -1842,6 +1858,7 @@ the WIDTH times as wide as FACE on FRAME.  */)
 #define LFACE_STIPPLE(LFACE)	    AREF ((LFACE), LFACE_STIPPLE_INDEX)
 #define LFACE_SWIDTH(LFACE)	    AREF ((LFACE), LFACE_SWIDTH_INDEX)
 #define LFACE_OVERLINE(LFACE)	    AREF ((LFACE), LFACE_OVERLINE_INDEX)
+#define LFACE_UNDERWAVE(LFACE)	    AREF ((LFACE), LFACE_UNDERWAVE_INDEX)
 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
 #define LFACE_BOX(LFACE)	    AREF ((LFACE), LFACE_BOX_INDEX)
 #define LFACE_FONT(LFACE)	    AREF ((LFACE), LFACE_FONT_INDEX)
@@ -1894,6 +1911,10 @@ check_lface_attrs (Lisp_Object *attrs)
 	   || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
 	   || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
 	   || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
+  xassert (UNSPECIFIEDP (attrs[LFACE_UNDERWAVE_INDEX])
+	   || IGNORE_DEFFACE_P (attrs[LFACE_UNDERWAVE_INDEX])
+	   || SYMBOLP (attrs[LFACE_UNDERWAVE_INDEX])
+	   || STRINGP (attrs[LFACE_UNDERWAVE_INDEX]));
   xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
 	   || IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
 	   || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
@@ -2534,6 +2555,15 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
 		  else
 		    err = 1;
 		}
+	      else if (EQ (keyword, QCunderwave))
+		{
+		  if (EQ (value, Qt)
+		      || NILP (value)
+		      || STRINGP (value))
+		    to[LFACE_UNDERWAVE_INDEX] = value;
+		  else
+		    err = 1;
+		}
 	      else if (EQ (keyword, QCstrike_through))
 		{
 		  if (EQ (value, Qt)
@@ -2970,6 +3000,20 @@ FRAME 0 means change the face on all frames, and change the default
       old_value = LFACE_OVERLINE (lface);
       LFACE_OVERLINE (lface) = value;
     }
+  else if (EQ (attr, QCunderwave))
+    {
+      if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+	if ((SYMBOLP (value)
+	     && !EQ (value, Qt)
+	     && !EQ (value, Qnil))
+	    /* Underwave color.  */
+	    || (STRINGP (value)
+		&& SCHARS (value) == 0))
+	  signal_error ("Invalid face underwave", value);
+
+      old_value = LFACE_UNDERWAVE (lface);
+      LFACE_UNDERWAVE (lface) = value;
+    }
   else if (EQ (attr, QCstrike_through))
     {
       if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
@@ -3511,6 +3555,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource",
     value = face_boolean_x_resource_value (value, 1);
   else if (EQ (attr, QCunderline)
 	   || EQ (attr, QCoverline)
+	   || EQ (attr, QCunderwave)
 	   || EQ (attr, QCstrike_through))
     {
       Lisp_Object boolean_value;
@@ -3720,6 +3765,8 @@ frames).  If FRAME is omitted or nil, use the selected frame.  */)
     value = LFACE_UNDERLINE (lface);
   else if (EQ (keyword, QCoverline))
     value = LFACE_OVERLINE (lface);
+  else if (EQ (keyword, QCunderwave))
+    value = LFACE_UNDERWAVE (lface);
   else if (EQ (keyword, QCstrike_through))
     value = LFACE_STRIKE_THROUGH (lface);
   else if (EQ (keyword, QCbox))
@@ -3766,6 +3813,8 @@ Value is nil if ATTR doesn't have a discrete set of valid values.  */)
     result = Fcons (Qt, Fcons (Qnil, Qnil));
   else if (EQ (attr, QCoverline))
     result = Fcons (Qt, Fcons (Qnil, Qnil));
+  else if (EQ (attr, QCunderwave))
+    result = Fcons (Qt, Fcons (Qnil, Qnil));
   else if (EQ (attr, QCstrike_through))
     result = Fcons (Qt, Fcons (Qnil, Qnil));
   else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
@@ -4800,6 +4849,9 @@ x_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
       || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
 	  && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX],
 				def_attrs[LFACE_OVERLINE_INDEX]))
+      || (!UNSPECIFIEDP (attrs[LFACE_UNDERWAVE_INDEX])
+	  && face_attr_equal_p (attrs[LFACE_UNDERWAVE_INDEX],
+				def_attrs[LFACE_UNDERWAVE_INDEX]))
       || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
 	  && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX],
 				def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
@@ -4902,6 +4954,7 @@ tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
       || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
       || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
       || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
+      || !UNSPECIFIEDP (attrs[LFACE_UNDERWAVE_INDEX])
       || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
       || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
       || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
@@ -5370,6 +5423,9 @@ realize_default_face (struct frame *f)
   if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
     LFACE_OVERLINE (lface) = Qnil;
 
+  if (UNSPECIFIEDP (LFACE_UNDERWAVE (lface)))
+    LFACE_UNDERWAVE (lface) = Qnil;
+
   if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
     LFACE_STRIKE_THROUGH (lface) = Qnil;
 
@@ -5563,7 +5619,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
 #ifdef HAVE_WINDOW_SYSTEM
   struct face *default_face;
   struct frame *f;
-  Lisp_Object stipple, overline, strike_through, box;
+  Lisp_Object stipple, overline, underwave, strike_through, box;
 
   xassert (FRAME_WINDOW_P (cache->f));
 
@@ -5694,7 +5750,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
 	}
     }
 
-  /* Text underline, overline, strike-through.  */
+  /* Text underline, overline, underwaved, strike-through.  */
 
   if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
     {
@@ -5734,6 +5790,21 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
       face->overline_p = 1;
     }
 
+  underwave = attrs[LFACE_UNDERWAVE_INDEX];
+  if (STRINGP (underwave))
+    {
+      face->underwave_color
+	= load_color (f, face, attrs[LFACE_UNDERWAVE_INDEX],
+		      LFACE_UNDERWAVE_INDEX);
+      face->underwave_p = 1;
+    }
+  else if (EQ (underwave, Qt))
+    {
+      face->underwave_color = face->foreground;
+      face->underwave_color_defaulted_p = 1;
+      face->underwave_p = 1;
+    }
+
   strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
   if (STRINGP (strike_through))
     {
@@ -6457,6 +6528,7 @@ syms_of_xfaces (void)
   DEFSYM (QCbold, ":bold");
   DEFSYM (QCitalic, ":italic");
   DEFSYM (QCoverline, ":overline");
+  DEFSYM (QCunderwave, ":underwave");
   DEFSYM (QCstrike_through, ":strike-through");
   DEFSYM (QCbox, ":box");
   DEFSYM (QCinherit, ":inherit");
diff --git a/src/xterm.c b/src/xterm.c
index 4b34d63..2e9afb4 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -2653,6 +2653,48 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
   s->background_filled_p = 1;
 }
 
+/*
+   Draw a wavy line. The wave fills wave_height pixels from y0.
+
+                    x0         wave_length = 2
+                                 --
+                y0   *   *   *   *   *
+                     |* * * * * * * * *
+    wave_height = 3  | *   *   *   *
+
+*/
+
+static void
+x_draw_underwave (Display *dpy, Window win, GC gc,
+                  unsigned long x0, unsigned long y0,
+                  unsigned long width,
+                  unsigned long wave_height, unsigned long wave_length)
+{
+  unsigned long dx = wave_length, dy = wave_height-1;
+  unsigned long x1, y1, x2, y2, i, times = width/dx;
+
+  for (i = 0; i < times; i++)
+    {
+      x1 = x0 + dx * i;
+      y1 = y0 + dy * (i%2);
+      x2 = x0 + dx * (i+1);
+      y2 = y0 + dy * ((i+1)%2);
+      XDrawLine(dpy, win, gc, x1, y1, x2, y2);
+    }
+
+  /* Draw remaining space */
+  if (x2 < x0+width)
+    {
+      unsigned long y = wave_height/(double)wave_length
+                        * (double)(x0 + width - x2);
+      x1 = x2;
+      y1 = y2;
+      x2 = x0 + width;
+      y2 = y0 + ((times % 2) ? wave_height - y : y);
+      XDrawLine(dpy, win, gc, x1, y1, x2, y2);
+    }
+}
+
 
 /* Draw glyph string S.  */
 
@@ -2836,6 +2878,25 @@ x_draw_glyph_string (struct glyph_string *s)
 	    }
 	}
 
+      /* Draw underwave.  */
+      if (s->face->underwave_p)
+	{
+          unsigned long h = 2, l = 3, y = s->ybase + 1;
+
+	  if (s->face->underwave_color_defaulted_p)
+	    x_draw_underwave (s->display, s->window, s->gc, s->x, y,
+                              s->width, h, l);
+	  else
+	    {
+	      XGCValues xgcv;
+	      XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+	      XSetForeground (s->display, s->gc, s->face->underwave_color);
+	      x_draw_underwave (s->display, s->window, s->gc, s->x, y,
+                                s->width, h, l);
+	      XSetForeground (s->display, s->gc, xgcv.foreground);
+	    }
+	}
+
       /* Draw strike-through.  */
       if (s->face->strike_through_p)
 	{

[-- Attachment #3: sample.png --]
[-- Type: image/png, Size: 53320 bytes --]