SL Baur <steve(a)xemacs.org> writes:
> In the meantime, I've got places to put future patches to XEmacs that
> are not suitable for the current release and I encourage developers
> to continue on with new features if they wish. Please mark your
> patches "for XEmacs 21.2" so there won't be any confusion.
Cool. So let's open the festival :-) I've got a new face property for
the kiddy. It's been some time since I wrote it, I was keeping it in the
fridge waiting for the version fork.
This new face property is called `stippled', and gives text, well, a
stippled look, like text displayed in Motif-like insensitive widgets. This
works only under X. Here's a picture of what you get when applying it to the
widget-inactive face:
I've also updated Custom.
Lisp changelog:
==============
1998-07-17 Didier Verna <verna(a)inf.enst.fr>
* faces.el (set-face-property): updated the doc string for the
stippled property.
(face-stippled-p): new function.
(set-face-stippled-p): ditto.
(face-equal): handle the new stippled property.
* cus-face.el (custom-face-attributes): New face attribute: `stippled'
Renamed the `stipple' attribute to `background-pixmap'.
(custom-face-background-pixmap): make custom-face-stipple an
obsolete alias for this.
C changelog:
===========
1998-07-17 Didier Verna <verna(a)inf.enst.fr>
* lisp.h: declare the lisp symbol `Qstippled'
* redisplay-x.c (x_get_gc): returns a GC with a FillStipple fill
style as foreground GC for faces that have the `stippled' property.
(x_output_string): when the `stippled' face property is set,
ensure the gray pixmap has been created, and get a proper
foreground GC to draw the text.
* faces.c (mark_face): update for the `stippled' field
(face_equal): ditto.
(face_getprop): ditto.
(face_putprop): ditto.
(face_remprop): ditto.
(face_plist): ditto.
(reset_face): ditto.
(update_face_inheritance_mapper): ditto.
(Fmake_face): ditto.
(update_face_cachel_data): ditto.
(merge_face_cachel_data): ditto.
(Fcopy_face): ditto.
(complex_vars_of_faces): ditto.
(syms_of_faces): define lisp symbol `Qstippled'
(vars_of_faces): add Qstippled to the built-in face specifiers
* faces.h (struct Lisp_Face): new field `stippled'.
(struct face_cachel): new fields `stippled' and `stippled specified'
plus some convenience macros.
--- lisp/cus-face.el.orig Fri Jul 17 13:33:51 1998
+++ lisp/cus-face.el Fri Jul 17 14:04:50 1998
＠＠ -67,13 +67,15 ＠＠
:help-echo "\
Text size (e.g. 9pt or 2mm).")
custom-set-face-font-size custom-face-font-size)
- (:stipple (editable-field :format "Stipple: %v"
- :help-echo "Name of background bitmap file.")
- set-face-stipple custom-face-stipple)
(:family (editable-field :format "Font Family: %v"
:help-echo "\
Name of font family to use (e.g. times).")
custom-set-face-font-family custom-face-font-family)
+ (:background-pixmap (editable-field
+ :format "Background pixmap: %v"
+ :help-echo "Name of background pixmap file.")
+ set-face-background-pixmap
+ custom-face-background-pixmap)
(:bold (toggle :format "%[Bold%]: %v\n"
:help-echo "Control whether a bold font should be used.")
custom-set-face-bold custom-face-bold)
＠＠ -81,6 +83,10 ＠＠
:help-echo "\
Control whether an italic font should be used.")
custom-set-face-italic custom-face-italic)
+ (:stippled (toggle :format "%[Stippled%]: %v\n"
+ :help-echo "\
+Control whether the text should appear stippled.")
+ set-face-stippled-p face-stippled-p)
(:underline (toggle :format "%[Underline%]: %v\n"
:help-echo "\
Control whether the text should be underlined.")
＠＠ -178,12 +184,14 ＠＠
(fontobj (font-create-object font)))
(font-italic-p fontobj)))
-(defun custom-face-stipple (face &rest args)
- "Return the name of the stipple file used for FACE."
+(defun custom-face-background-pixmap (face &rest args)
+ "Return the name of the background pixmap file used for FACE."
(let ((image (apply 'specifier-instance
(face-background-pixmap face) args)))
(and image
(image-instance-file-name image))))
+(define-obsolete-function-alias 'custom-face-stipple
+ 'custom-face-background-pixmap)
(defun custom-set-face-font-size (face size &rest args)
"Set the font of FACE to SIZE"
--- src/faces.c.orig Fri Jul 17 13:22:26 1998
+++ src/faces.c Fri Jul 17 13:22:27 1998
＠＠ -44,7 +44,7 ＠＠
Lisp_Object Qfacep;
Lisp_Object Qforeground, Qbackground, Qdisplay_table;
Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
-Lisp_Object Qblinking, Qstrikethru;
+Lisp_Object Qblinking, Qstrikethru, Qstippled;
Lisp_Object Qinit_face_from_resources;
Lisp_Object Qinit_frame_faces;
＠＠ -92,6 +92,7 ＠＠
((markobj) (face->dim));
((markobj) (face->blinking));
((markobj) (face->reverse));
+ ((markobj) (face->stippled));
((markobj) (face->charsets_warned_about));
＠＠ -148,6 +149,7 ＠＠
internal_equal (f1->dim, f2->dim, depth) &&
internal_equal (f1->blinking, f2->blinking, depth) &&
internal_equal (f1->reverse, f2->reverse, depth) &&
+ internal_equal (f1->stippled, f2->stippled, depth) &&
! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
}
＠＠ -183,6 +185,7 ＠＠
(EQ (prop, Qdim)) ? f->dim :
(EQ (prop, Qblinking)) ? f->blinking :
(EQ (prop, Qreverse)) ? f->reverse :
+ (EQ (prop, Qstippled)) ? f->stippled :
(EQ (prop, Qdoc_string)) ? f->doc_string :
external_plist_get (&f->plist, prop, 0, ERROR_ME));
}
＠＠ -202,7 +205,8 ＠＠
EQ (prop, Qhighlight) ||
EQ (prop, Qdim) ||
EQ (prop, Qblinking) ||
- EQ (prop, Qreverse))
+ EQ (prop, Qreverse) ||
+ EQ (prop, Qstippled))
return 0;
if (EQ (prop, Qdoc_string))
＠＠ -232,7 +236,8 ＠＠
EQ (prop, Qhighlight) ||
EQ (prop, Qdim) ||
EQ (prop, Qblinking) ||
- EQ (prop, Qreverse))
+ EQ (prop, Qreverse) ||
+ EQ (prop, Qstippled))
return -1;
if (EQ (prop, Qdoc_string))
＠＠ -250,6 +255,7 ＠＠
struct Lisp_Face *face = XFACE (obj);
Lisp_Object result = face->plist;
+ result = cons3 (Qstippled, face->stippled, result);
result = cons3 (Qreverse, face->reverse, result);
result = cons3 (Qblinking, face->blinking, result);
result = cons3 (Qdim, face->dim, result);
＠＠ -351,6 +357,7 ＠＠
f->dim = Qnil;
f->blinking = Qnil;
f->reverse = Qnil;
+ f->stippled = Qnil;
f->plist = Qnil;
f->charsets_warned_about = Qnil;
}
＠＠ -513,7 +520,8 ＠＠
EQ (fcl->property, Qhighlight) ||
EQ (fcl->property, Qdim) ||
EQ (fcl->property, Qblinking) ||
- EQ (fcl->property, Qreverse))
+ EQ (fcl->property, Qreverse) ||
+ EQ (fcl->property, Qstippled))
{
update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
＠＠ -521,6 +529,7 ＠＠
update_inheritance_mapper_internal (contents, fcl->face, Qdim);
update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
+ update_inheritance_mapper_internal (contents, fcl->face, Qstippled);
}
return 0;
}
＠＠ -799,6 +808,8 ＠＠
set_face_boolean_attached_to (f->blinking, face, Qblinking);
f->reverse = Fmake_specifier (Qface_boolean);
set_face_boolean_attached_to (f->reverse, face, Qreverse);
+ f->stippled = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->stippled, face, Qstippled);
if (!NILP (Vdefault_face))
{
/* If the default face has already been created, set it as
＠＠ -828,6 +839,8 ＠＠
Fget (Vdefault_face, Qblinking, Qunbound));
set_specifier_fallback (f->reverse,
Fget (Vdefault_face, Qreverse, Qunbound));
+ set_specifier_fallback (f->stippled,
+ Fget (Vdefault_face, Qstippled, Qunbound));
}
/* Add the face to the appropriate list. */
＠＠ -1234,6 +1247,7 ＠＠
FROB (highlight);
FROB (dim);
FROB (reverse);
+ FROB (stippled);
FROB (blinking);
#undef FROB
}
＠＠ -1270,6 +1284,7 ＠＠
FROB (highlight);
FROB (dim);
FROB (reverse);
+ FROB (stippled);
FROB (blinking);
/* And do ASCII, of course. */
{
＠＠ -1736,6 +1751,7 ＠＠
COPY_PROPERTY (dim);
COPY_PROPERTY (blinking);
COPY_PROPERTY (reverse);
+ COPY_PROPERTY (stippled);
#undef COPY_PROPERTY
/* #### should it copy the individual specifiers, if they exist? */
fnew->plist = Fcopy_sequence (fold->plist);
＠＠ -1775,6 +1791,7 ＠＠
defsymbol (&Qunderline, "underline");
defsymbol (&Qstrikethru, "strikethru");
/* Qhighlight, Qreverse defined in general.c */
+ defsymbol (&Qstippled, "stippled");
defsymbol (&Qdim, "dim");
defsymbol (&Qblinking, "blinking");
＠＠ -1837,6 +1854,7 ＠＠
syms[n++] = Qdim;
syms[n++] = Qblinking;
syms[n++] = Qreverse;
+ syms[n++] = Qstippled;
Vbuilt_in_face_specifiers = pure_list (n, syms);
staticpro (&Vbuilt_in_face_specifiers);
＠＠ -1937,7 +1955,9 ＠＠
list1 (Fcons (Qnil, Qnil)));
set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
list1 (Fcons (Qnil, Qnil)));
-
+ set_specifier_fallback (Fget (Vdefault_face, Qstippled, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+
/* gui-element is the parent face of all gui elements such as
modeline, vertical divider and toolbar. */
Vgui_element_face = Fmake_face (Qgui_element,
--- lisp/faces.el.orig Fri Jul 17 13:22:26 1998
+++ lisp/faces.el Fri Jul 17 13:22:27 1998
＠＠ -329,6 +329,10 ＠＠
Only used by faces on TTY devices.
For valid instantiators, see `face-boolean-specifier-p'.
+ stippled Give text in this face an 'stippled' look.
+ Only used by faces on X devices.
+ For valid instantiators, see `face-boolean-specifier-p'.
+
doc-string Description of what the face's normal use is.
NOTE: This is not a specifier, unlike all
the other built-in properties, and cannot
＠＠ -732,6 +736,20 ＠＠
(interactive (face-interactive "reverse-p" "reversed"))
(set-face-property face 'reverse reverse-p locale tag-set how-to-add))
+(defun face-stippled-p (face &optional domain default no-fallback)
+ "Return t if FACE has the stippled property in DOMAIN (X domains only).
+See `face-property-instance' for the semantics of the DOMAIN argument."
+ (face-property-instance face 'stippled domain default no-fallback))
+
+(defun set-face-stippled-p (face stippled-p &optional locale tag-set how-to-add)
+ "Change whether FACE has the stippled property in LOCALE (X locales only).
+STIPPLED-P is normally a face-boolean instantiator; see
+ `face-boolean-specifier-p'.
+See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
+ HOW-TO-ADD arguments."
+ (interactive (face-interactive "stippled-p" "stippled"))
+ (set-face-property face 'stippled stippled-p locale tag-set how-to-add))
+
(defun face-property-equal (face1 face2 prop domain)
(equal (face-property-instance face1 prop domain)
＠＠ -751,7 +769,7 ＠＠
(error "Invalid specifier domain"))
(let ((device (dfw-device domain))
(common-props '(foreground background font display-table underline))
- (win-props '(background-pixmap strikethru))
+ (win-props '(background-pixmap strikethru stippled))
(tty-props '(highlight dim blinking reverse)))
;; First check the properties which are used in common between the
--- src/faces.h.orig Fri Jul 17 13:22:27 1998
+++ src/faces.h Fri Jul 17 13:22:27 1998
＠＠ -53,6 +53,7 ＠＠
Lisp_Object dim;
Lisp_Object blinking;
Lisp_Object reverse;
+ Lisp_Object stippled;
Lisp_Object plist;
＠＠ -173,6 +174,7 ＠＠
unsigned int dim :1;
unsigned int blinking :1;
unsigned int reverse :1;
+ unsigned int stippled :1;
/* Used when merging to tell if the above field represents an actual
value of this face or a fallback value. */
＠＠ -189,6 +191,7 ＠＠
unsigned int dim_specified :1;
unsigned int blinking_specified :1;
unsigned int reverse_specified :1;
+ unsigned int stippled_specified :1;
/* The updated flag is set after we calculate the values for the
face cachel and cleared whenever a face changes, to indicate
＠＠ -321,6 +324,8 ＠＠
(WINDOW_FACE_CACHEL (window, index)->blinking)
#define WINDOW_FACE_CACHEL_REVERSE_P(window, index) \
(WINDOW_FACE_CACHEL (window, index)->reverse)
+#define WINDOW_FACE_CACHEL_STIPPLED_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->stippled)
#define FACE_PROPERTY_SPECIFIER(face, property) Fget (face, property, Qnil)
＠＠ -368,5 +373,7 ＠＠
(!NILP (FACE_PROPERTY_INSTANCE (face, Qblinking, domain, 0, Qzero)))
#define FACE_REVERSE_P(face, domain) \
(!NILP (FACE_PROPERTY_INSTANCE (face, Qreverse, domain, 0, Qzero)))
+#define FACE_STIPPLED_P(face, domain) \
+ (!NILP (FACE_PROPERTY_INSTANCE (face, Qstippled, domain, 0, Qzero)))
#endif /* _XEMACS_FACES_H_ */
--- src/redisplay-x.c.orig Fri Jul 17 13:22:27 1998
+++ src/redisplay-x.c Fri Jul 17 13:22:27 1998
＠＠ -693,8 +693,18 ＠＠
mask |= GCBackground;
}
- if (IMAGE_INSTANCEP (bg_pmap)
- && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ /* This special case comes from a request to draw text with a face which has
+ the stippled property */
+ if (EQ (bg_pmap, Qstippled))
+ {
+ assert (DEVICE_X_GRAY_PIXMAP (d) != None);
+
+ gcv.fill_style = FillStippled;
+ gcv.stipple = DEVICE_X_GRAY_PIXMAP (d);
+ mask |= (GCFillStyle | GCStipple);
+ }
+ else if (IMAGE_INSTANCEP (bg_pmap)
+ && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
{
if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0)
{
＠＠ -915,6 +925,16 ＠＠
if (cursor && cursor_cachel && focus && NILP (bar_cursor_value))
gc = x_get_gc (d, font, cursor_cachel->foreground,
cursor_cachel->background, Qnil, Qnil);
+ else if (cachel->stippled)
+ {
+ if (DEVICE_X_GRAY_PIXMAP (d) == None)
+ DEVICE_X_GRAY_PIXMAP (d) =
+ XCreateBitmapFromData (dpy, x_win, (char *)gray_bits,
+ gray_width, gray_height);
+
+ gc = x_get_gc (d, font, cachel->foreground, cachel->background,
+ Qstippled, Qnil);
+ }
else
gc = x_get_gc (d, font, cachel->foreground, cachel->background,
Qnil, Qnil);
--- src/lisp.h.orig Fri Jul 17 13:22:27 1998
+++ src/lisp.h Fri Jul 17 13:22:27 1998
＠＠ -2729,6 +2729,7 ＠＠
extern Lisp_Object Qdoc_string, Qdomain_error, Qdynarr_overhead;
extern Lisp_Object Qempty, Qencode, Qend_of_buffer, Qend_of_file, Qend_open;
extern Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf, Qeol_type, Qeq, Qeql, Qequal;
+extern Lisp_Object Qstippled;
extern Lisp_Object Qerror, Qerror_conditions, Qerror_message, Qescape_quoted;
extern Lisp_Object Qeval, Qevent_live_p, Qexit, Qextent_live_p, Qextents;
extern Lisp_Object Qexternal_debugging_output, Qface, Qfeaturep, Qfile_error;
