[PATCH for 21.2] New face property

SL Baur <steve(a)xemacs.org&gt; writes: 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&gt; * 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&gt; * 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;