[COMMIT] Re: [Q] New "flush" face property

NOTE: This patch has been committed. Stephen J. Turnbull wrote: Done, with a small difference. If we're to flush by default, then it's better to have a face property for /not/ flushing. I've called it 'shrink but other propositions are welcome. lisp/ChangeLog addition: 2011-12-26 Didier Verna <didier(a)xemacs.org&gt; * cl-macs.el (face-flush-p): Removed. * cl-macs.el (face-shrink-p): New. * faces.el (face-flush-p): Removed. * faces.el (face-shrink-p): New. * faces.el (set-face-flush-p): Removed. * faces.el (set-face-shrink-p): New. * cus-face.el (custom-face-attributes): * faces.el (set-face-property): * faces.el (face-equal): * x-faces.el (x-init-face-from-resources): * x-faces.el (make-face-x-resource-internal): Replace the 'flush property with the opposite 'shrink one. src/ChangeLog addition: 2011-12-26 Didier Verna <didier(a)xemacs.org&gt; * lisp.h: * faces.c (mark_face): * faces.c (face_equal): * faces.c (face_getprop): * faces.c (face_putprop): * faces.c (face_remprop): * faces.c (face_plist): * faces.c (reset_face): * faces.c (update_face_inheritance_mapper): * faces.c (Fmake_face): * faces.c (update_face_cachel_data): * faces.c (merge_face_cachel_data): * faces.c (Fcopy_face): * faces.c (syms_of_faces): * faces.c (vars_of_faces): * faces.c (complex_vars_of_faces): * faces.h (struct Lisp_Face): * faces.h (struct face_cachel): * faces.h (WINDOW_FACE_CACHEL_SHRINK_P): * faces.h (FACE_SHRINK_P): * fontcolor.c (face_boolean_validate): Replace the 'flush property with the opposite 'shrink one. * redisplay.c (create_text_block): * redisplay.c (create_string_text_block): Ditto. Invert the logic for storing a new clear_findex in the display lines. XEmacs 21.5 source patch: Diff command: hg diff --git --show-function Files affected: lisp/cl-macs.el lisp/cus-face.el lisp/faces.el lisp/x-faces.el src/faces.c src/faces.h src/fontcolor.c src/lisp.h src/redisplay.c diff --git a/lisp/cl-macs.el b/lisp/cl-macs.el --- a/lisp/cl-macs.el +++ b/lisp/cl-macs.el ＠＠ -2120,8 +2120,8 ＠＠ Example: (defsetf nth (n x) (v) (list 's (defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) (defsetf face-underline-p (f &optional s) (x) (list 'set-face-underline-p f x s)) -(defsetf face-flush-p (f &optional s) (x) - (list 'set-face-flush-p f x s)) +(defsetf face-shrink-p (f &optional s) (x) + (list 'set-face-shrink-p f x s)) (defsetf file-modes set-file-modes t) (defsetf frame-height (&optional f) (v) `(progn (set-frame-height ,f ,v) ,v)) diff --git a/lisp/cus-face.el b/lisp/cus-face.el --- a/lisp/cus-face.el +++ b/lisp/cus-face.el ＠＠ -126,10 +126,10 ＠＠ Control whether the text should be strik :help-echo "\ Control whether the text should be inverted. Works only on TTY-s") set-face-reverse-p face-reverse-p) - (:flush (toggle :format "%[Flush%]: %v\n" - :help-echo "\ -Control whether the face should flush to the right border.") - set-face-flush-p face-flush-p) + (:shrink (toggle :format "%[Shrink%]: %v\n" + :help-echo "\ +Control whether the face should shrink to the actual text on the line.") + set-face-shrink-p face-shrink-p) (:inherit (repeat :tag "Inherit" :help-echo "List of faces to inherit attributes from." diff --git a/lisp/faces.el b/lisp/faces.el --- a/lisp/faces.el +++ b/lisp/faces.el ＠＠ -361,9 +361,9 ＠＠ The following symbols have predefined me Only used by faces on TTY devices. For valid instantiators, see `make-face-boolean-specifier'. - flush When the end of line is reached in a flushing face, also - paint the rest of the line (up to the right border) with - that face. The effect will only be visible if the face has + shrink Shrink the face to the actual text on the line instead of + covering the whole line until the right border of the + window. The effect will only be visible if the face has a non default background. For valid instantiators, see `make-face-boolean-specifier'. ＠＠ -903,19 +903,19 ＠＠ See `set-face-property' for the semantic (interactive (face-interactive "reverse-p" "reversed")) (set-face-property face 'reverse reverse-p locale tag-set how-to-add)) -(defun face-flush-p (face &optional domain default no-fallback) - "Return t if FACE is flushed in DOMAIN. +(defun face-shrink-p (face &optional domain default no-fallback) + "Return t if FACE is shrinked in DOMAIN. See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'flush domain default no-fallback)) + (face-property-instance face 'shrink domain default no-fallback)) -(defun set-face-flush-p (face flush-p &optional locale tag-set how-to-add) - "Change whether FACE is flushed in LOCALE. -FLUSH-P is normally a face-boolean instantiator; see +(defun set-face-shrink-p (face shrink-p &optional locale tag-set how-to-add) + "Change whether FACE is shrinked in LOCALE. +SHRINK-P is normally a face-boolean instantiator; see `make-face-boolean-specifier'. See `set-face-property' for the semantics of the LOCALE, TAG-SET, and HOW-TO-ADD arguments." - (interactive (face-interactive "flush-p" "flushed")) - (set-face-property face 'flush flush-p locale tag-set how-to-add)) + (interactive (face-interactive "shrink-p" "shrinked")) + (set-face-property face 'shrink shrink-p locale tag-set how-to-add))  (defun face-property-equal (face1 face2 prop domain) ＠＠ -936,7 +936,7 ＠＠ See `face-property-instance' for the sem (error "Invalid specifier domain")) (let ((device (dfw-device domain)) (common-props '(foreground background font display-table underline - dim inherit flush)) + dim inherit shrink)) (win-props '(background-pixmap background-placement strikethru)) (tty-props '(highlight blinking reverse))) diff --git a/lisp/x-faces.el b/lisp/x-faces.el --- a/lisp/x-faces.el +++ b/lisp/x-faces.el ＠＠ -715,8 +715,8 ＠＠ Otherwise, it returns the next larger ve "Face.AttributeStrikethru" 'boolean locale)) (fp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeFlush") - "Face.AttributeFlush" + (concat name ".attributeShrink") + "Face.AttributeShrink" 'boolean locale)) ;; we still resource for these TTY-only resources so that you can ;; specify resources for TTY frames/devices. This is useful when you ＠＠ -886,19 +886,19 ＠＠ Otherwise, it returns the next larger ve (when fp (cond (device-class (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'flush) + face 'shrink) locale tty-tag-set) (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'flush) + face 'shrink) locale x-tag-set)) (t - (remove-specifier (face-property face 'flush) locale + (remove-specifier (face-property face 'shrink) locale tty-tag-set nil) - (remove-specifier (face-property face 'flush) locale + (remove-specifier (face-property face 'shrink) locale x-tag-set nil))) - (set-face-flush-p face fp locale our-tag-set append)) + (set-face-shrink-p face fp locale our-tag-set append)) )) ;; GNU Emacs compatibility. (move to obsolete.el?) diff --git a/src/faces.c b/src/faces.c --- a/src/faces.c +++ b/src/faces.c ＠＠ -42,7 +42,7 ＠＠ along with XEmacs. If not, see <http:// Lisp_Object Qfacep; Lisp_Object Qforeground, Qbackground, Qdisplay_table; Lisp_Object Qbackground_pixmap, Qbackground_placement, Qunderline, Qdim; -Lisp_Object Qblinking, Qstrikethru, Qflush, Q_name; +Lisp_Object Qblinking, Qstrikethru, Qshrink, Q_name; Lisp_Object Qinit_face_from_resources; Lisp_Object Qinit_frame_faces; ＠＠ -117,7 +117,7 ＠＠ mark_face (Lisp_Object obj) mark_object (face->dim); mark_object (face->blinking); mark_object (face->reverse); - mark_object (face->flush); + mark_object (face->shrink); mark_object (face->charsets_warned_about); ＠＠ -172,7 +172,7 ＠＠ face_equal (Lisp_Object obj1, Lisp_Objec internal_equal (f1->dim, f2->dim, depth) && internal_equal (f1->blinking, f2->blinking, depth) && internal_equal (f1->reverse, f2->reverse, depth) && - internal_equal (f1->flush, f2->flush, depth) && + internal_equal (f1->shrink, f2->shrink, depth) && ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1, 0)); } ＠＠ -209,7 +209,7 ＠＠ face_getprop (Lisp_Object obj, Lisp_Obje EQ (prop, Qdim) ? f->dim : EQ (prop, Qblinking) ? f->blinking : EQ (prop, Qreverse) ? f->reverse : - EQ (prop, Qflush) ? f->flush : + EQ (prop, Qshrink) ? f->shrink : EQ (prop, Qdoc_string) ? f->doc_string : external_plist_get (&f->plist, prop, 0, ERROR_ME)); } ＠＠ -231,7 +231,7 ＠＠ face_putprop (Lisp_Object obj, Lisp_Obje EQ (prop, Qdim) || EQ (prop, Qblinking) || EQ (prop, Qreverse) || - EQ (prop, Qflush)) + EQ (prop, Qshrink)) return 0; if (EQ (prop, Qdoc_string)) ＠＠ -263,7 +263,7 ＠＠ face_remprop (Lisp_Object obj, Lisp_Obje EQ (prop, Qdim) || EQ (prop, Qblinking) || EQ (prop, Qreverse) || - EQ (prop, Qflush)) + EQ (prop, Qshrink)) return -1; if (EQ (prop, Qdoc_string)) ＠＠ -281,7 +281,7 ＠＠ face_plist (Lisp_Object obj) Lisp_Face *face = XFACE (obj); Lisp_Object result = face->plist; - result = cons3 (Qflush, face->flush, result); + result = cons3 (Qshrink, face->shrink, result); result = cons3 (Qreverse, face->reverse, result); result = cons3 (Qblinking, face->blinking, result); result = cons3 (Qdim, face->dim, result); ＠＠ -313,7 +313,7 ＠＠ static const struct memory_description f { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) }, - { XD_LISP_OBJECT, offsetof (Lisp_Face, flush) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, shrink) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) }, { XD_END } ＠＠ -407,7 +407,7 ＠＠ reset_face (Lisp_Face *f) f->dim = Qnil; f->blinking = Qnil; f->reverse = Qnil; - f->flush = Qnil; + f->shrink = Qnil; f->plist = Qnil; f->charsets_warned_about = Qnil; } ＠＠ -563,7 +563,7 ＠＠ update_face_inheritance_mapper (const vo EQ (fcl->property, Qdim) || EQ (fcl->property, Qblinking) || EQ (fcl->property, Qreverse) || - EQ (fcl->property, Qflush)) + EQ (fcl->property, Qshrink)) { update_inheritance_mapper_internal (contents, fcl->face, Qunderline); update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru); ＠＠ -571,7 +571,7 ＠＠ update_face_inheritance_mapper (const vo 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, Qflush); + update_inheritance_mapper_internal (contents, fcl->face, Qshrink); } return 0; } ＠＠ -879,8 +879,8 ＠＠ If TEMPORARY is non-nil, this face will 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->flush = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->flush, face, Qflush); + f->shrink = Fmake_specifier (Qface_boolean); + set_face_boolean_attached_to (f->shrink, face, Qshrink); if (!NILP (Vdefault_face)) { /* If the default face has already been created, set it as ＠＠ -913,8 +913,8 ＠＠ If TEMPORARY is non-nil, this face will Fget (Vdefault_face, Qblinking, Qunbound)); set_specifier_fallback (f->reverse, Fget (Vdefault_face, Qreverse, Qunbound)); - set_specifier_fallback (f->flush, - Fget (Vdefault_face, Qflush, Qunbound)); + set_specifier_fallback (f->shrink, + Fget (Vdefault_face, Qshrink, Qunbound)); } /* Add the face to the appropriate list. */ ＠＠ -1485,7 +1485,7 ＠＠ update_face_cachel_data (struct face_cac FROB (highlight); FROB (dim); FROB (reverse); - FROB (flush); + FROB (shrink); FROB (blinking); #undef FROB } ＠＠ -1525,7 +1525,7 ＠＠ merge_face_cachel_data (struct window *w FROB (highlight); FROB (dim); FROB (reverse); - FROB (flush); + FROB (shrink); FROB (blinking); for (offs = 0; offs < NUM_LEADING_BYTES; ++offs) ＠＠ -2039,7 +2039,7 ＠＠ LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD COPY_PROPERTY (dim); COPY_PROPERTY (blinking); COPY_PROPERTY (reverse); - COPY_PROPERTY (flush); + COPY_PROPERTY (shrink); #undef COPY_PROPERTY /* #### should it copy the individual specifiers, if they exist? */ fnew->plist = Fcopy_sequence (fold->plist); ＠＠ -2179,7 +2179,7 ＠＠ syms_of_faces (void) /* Qhighlight, Qreverse defined in general.c */ DEFSYMBOL (Qdim); DEFSYMBOL (Qblinking); - DEFSYMBOL (Qflush); + DEFSYMBOL (Qshrink); DEFSYMBOL (Qface_alias); DEFERROR_STANDARD (Qcyclic_face_alias, Qinvalid_state); ＠＠ -2246,7 +2246,7 ＠＠ If non-zero, display debug information a Vbuilt_in_face_specifiers = listu (Qforeground, Qbackground, Qfont, Qdisplay_table, Qbackground_pixmap, Qbackground_placement, Qunderline, Qstrikethru, Qhighlight, Qdim, - Qblinking, Qreverse, Qflush, Qunbound); + Qblinking, Qreverse, Qshrink, Qunbound); staticpro (&Vbuilt_in_face_specifiers); } ＠＠ -2502,7 +2502,7 ＠＠ complex_vars_of_faces (void) list1 (Fcons (Qnil, Qnil))); set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil), list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qflush, Qnil), + set_specifier_fallback (Fget (Vdefault_face, Qshrink, Qnil), list1 (Fcons (Qnil, Qnil))); /* gui-element is the parent face of all gui elements such as diff --git a/src/faces.h b/src/faces.h --- a/src/faces.h +++ b/src/faces.h ＠＠ -54,7 +54,7 ＠＠ struct Lisp_Face Lisp_Object dim; Lisp_Object blinking; Lisp_Object reverse; - Lisp_Object flush; + Lisp_Object shrink; Lisp_Object plist; ＠＠ -181,7 +181,7 ＠＠ struct face_cachel unsigned int dim :1; unsigned int blinking :1; unsigned int reverse :1; - unsigned int flush :1; + unsigned int shrink :1; /* Used when merging to tell if the above field represents an actual value of this face or a fallback value. */ ＠＠ -199,7 +199,7 ＠＠ struct face_cachel unsigned int dim_specified :1; unsigned int blinking_specified :1; unsigned int reverse_specified :1; - unsigned int flush_specified :1; + unsigned int shrink_specified :1; /* The updated flag is set after we calculate the values for the face cachel and cleared whenever a face changes, to indicate ＠＠ -359,8 +359,8 ＠＠ void default_face_width_and_height (Lisp (WINDOW_FACE_CACHEL (window, index)->blinking) #define WINDOW_FACE_CACHEL_REVERSE_P(window, index) \ (WINDOW_FACE_CACHEL (window, index)->reverse) -#define WINDOW_FACE_CACHEL_FLUSH_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->flush) +#define WINDOW_FACE_CACHEL_SHRINK_P(window, index) \ + (WINDOW_FACE_CACHEL (window, index)->shrink) #define FACE_PROPERTY_SPECIFIER(face, property) Fget (face, property, Qnil) ＠＠ -422,7 +422,7 ＠＠ extern Lisp_Object Qbackground_placement (!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_FLUSH_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qflush, domain, 0, Qzero))) +#define FACE_SHRINK_P(face, domain) \ + (!NILP (FACE_PROPERTY_INSTANCE (face, Qshrink, domain, 0, Qzero))) #endif /* INCLUDED_faces_h_ */ diff --git a/src/fontcolor.c b/src/fontcolor.c --- a/src/fontcolor.c +++ b/src/fontcolor.c ＠＠ -1160,9 +1160,9 ＠＠ face_boolean_validate (Lisp_Object insta && !EQ (field, Qdim) && !EQ (field, Qblinking) && !EQ (field, Qreverse) - && !EQ (field, Qflush)) + && !EQ (field, Qshrink)) invalid_constant ("Invalid face-boolean inheritance field", - field); + field); } } else if (VECTORP (instantiator)) diff --git a/src/lisp.h b/src/lisp.h --- a/src/lisp.h +++ b/src/lisp.h ＠＠ -5144,7 +5144,7 ＠＠ extern Lisp_Object Qdim; extern Lisp_Object Qdisplay_table; extern Lisp_Object Qforeground; extern Lisp_Object Qunderline; -extern Lisp_Object Qflush; +extern Lisp_Object Qshrink; /* Defined in file-coding.c */ EXFUN (Fcoding_category_list, 0); diff --git a/src/redisplay.c b/src/redisplay.c --- a/src/redisplay.c +++ b/src/redisplay.c ＠＠ -2500,10 +2500,10 ＠＠ create_text_block (struct window *w, str to the line and end this loop. */ else if (data.ch == '\n') { - /* Update the clearing face index when the flush property is + /* Update the clearing face index unless the shrink property is set. -- dvl */ if ((data.findex > DEFAULT_INDEX) - && WINDOW_FACE_CACHEL_FLUSH_P (w, data.findex)) + && ! WINDOW_FACE_CACHEL_SHRINK_P (w, data.findex)) dl->clear_findex = data.findex; /* We aren't going to be adding an end glyph so give its ＠＠ -4938,10 +4938,10 ＠＠ create_string_text_block (struct window to the line and end this loop. */ else if (data.ch == '\n') { - /* Update the clearing face index when the flush property is + /* Update the clearing face index unless the shrink property is set. -- dvl */ if ((data.findex > DEFAULT_INDEX) - && WINDOW_FACE_CACHEL_FLUSH_P (w, data.findex)) + && ! WINDOW_FACE_CACHEL_SHRINK_P (w, data.findex)) dl->clear_findex = data.findex; /* We aren't going to be adding an end glyph so give its -- Resistance is futile. You will be jazzimilated. Scientific site: http://www.lrde.epita.fr/~didier Music (Jazz) site: http://www.didierverna.com _______________________________________________ XEmacs-Beta mailing list XEmacs-Beta(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-beta