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}.
address@hidden :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 . */
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 . */
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)
{