9:58 a.m.
NOTE: This patch has been committed.
Here's a little present to put under the Christmas tree. The following
patch implements a new face property called "flush". This property
allows you to have text segments displayed as blocks instead of being
ragged right, which is visually nicer in many situations. See the
following blog entry for a more detailed explanation and a screenshot:
http://www.didierverna.com/sciblog/index.php?post/2011/12/22/XEmacs-now-h...
lisp/ChangeLog addition:
2011-12-23 Didier Verna <didier(a)xemacs.org>
* cl-macs.el (face-flush-p): New defsetf.
* faces.el (set-face-property): Document the flush property.
* faces.el (face-flush-p): New function.
* faces.el (set-face-flush-p): New function.
* faces.el (face-equal):
* cus-face.el (custom-face-attributes):
* x-faces.el (x-init-face-from-resources):
* x-faces.el (make-face-x-resource-internal): Handle the flush
property.
src/ChangeLog addition:
2011-12-23 Didier Verna <didier(a)xemacs.org>
* faces.h (struct Lisp_Face): New 'flush slot.
* faces.h (struct face_cachel): New 'flush and 'flush_specified
flags.
* faces.h (WINDOW_FACE_CACHEL_FLUSH_P):
* faces.h (FACE_FLUSH_P): New macros.
* faces.c: Declare Qflush.
* lisp.h: Externalize it.
* faces.c (syms_of_faces): Define it.
* faces.c (vars_of_faces): Update built-in face specifiers.
* faces.c (complex_vars_of_faces): Update specifier fallbacks.
* 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):
* fontcolor.c (face_boolean_validate): Handle the flush property.
* redisplay.h (struct display_line): Rename 'default_findex slot to
clearer name 'clear_findex.
* redisplay.h (DISPLAY_LINE_INIT): Update accordingly.
* redisplay-output.c (compare_display_blocks):
* redisplay-output.c (output_display_line):
* redisplay-output.c (redisplay_output_window):
* redisplay.c (regenerate_window_extents_only_changed):
* redisplay.c (regenerate_window_incrementally): Update the
comparison tests between the current and desired display lines to
cope for different 'clear_findex values.
* redisplay.c (create_text_block): Initialize the display line's
'clear_findex slot to DEFAULT_INDEX. Record a new 'clear_findex
value when we encounter a newline character displayed in a flushed
face.
* redisplay.c (create_string_text_block): Record a new
'clear_findex value when we encounter a newline character
displayed in a flushed face.
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-output.c src/redisplay.c
src/redisplay.h
diff --git a/lisp/cl-macs.el b/lisp/cl-macs.el
--- a/lisp/cl-macs.el
+++ b/lisp/cl-macs.el
＠＠ -2120,6 +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 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,6 +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)
(: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,6 +361,12 ＠＠ 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
+ a non default background.
+ For valid instantiators, see `make-face-boolean-specifier'.
+
inherit Face name or face object from which to inherit attributes,
or a list of such elements. Attributes from inherited
faces are merged into the face like an underlying face
＠＠ -897,6 +903,20 ＠＠ 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.
+See `face-property-instance' for the semantics of the DOMAIN argument."
+ (face-property-instance face 'flush 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
+ `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))
+
(defun face-property-equal (face1 face2 prop domain)
(equal (face-property-instance face1 prop domain)
＠＠ -916,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))
+ dim inherit flush))
(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
＠＠ -714,6 +714,10 ＠＠ Otherwise, it returns the next larger ve
(concat name ".attributeStrikethru")
"Face.AttributeStrikethru"
'boolean locale))
+ (fp (x-get-resource-and-maybe-bogosity-check
+ (concat name ".attributeFlush")
+ "Face.AttributeFlush"
+ '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
;; start up your XEmacs on an X display and later open some TTY
＠＠ -879,6 +883,22 ＠＠ Otherwise, it returns the next larger ve
(remove-specifier (face-property face 'reverse) locale
tty-tag-set nil))
(set-face-reverse-p face rp locale our-tag-set append))
+ (when fp
+ (cond (device-class
+ (remove-specifier-specs-matching-tag-set-cdrs (face-property
+ face 'flush)
+ locale
+ tty-tag-set)
+ (remove-specifier-specs-matching-tag-set-cdrs (face-property
+ face 'flush)
+ locale
+ x-tag-set))
+ (t
+ (remove-specifier (face-property face 'flush) locale
+ tty-tag-set nil)
+ (remove-specifier (face-property face 'flush) locale
+ x-tag-set nil)))
+ (set-face-flush-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, Q_name;
+Lisp_Object Qblinking, Qstrikethru, Qflush, Q_name;
Lisp_Object Qinit_face_from_resources;
Lisp_Object Qinit_frame_faces;
＠＠ -117,6 +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->charsets_warned_about);
＠＠ -171,6 +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)
&&
! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1, 0));
}
＠＠ -207,6 +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, Qdoc_string) ? f->doc_string :
external_plist_get (&f->plist, prop, 0, ERROR_ME));
}
＠＠ -227,7 +230,8 ＠＠ face_putprop (Lisp_Object obj, Lisp_Obje
EQ (prop, Qhighlight) ||
EQ (prop, Qdim) ||
EQ (prop, Qblinking) ||
- EQ (prop, Qreverse))
+ EQ (prop, Qreverse) ||
+ EQ (prop, Qflush))
return 0;
if (EQ (prop, Qdoc_string))
＠＠ -258,7 +262,8 ＠＠ face_remprop (Lisp_Object obj, Lisp_Obje
EQ (prop, Qhighlight) ||
EQ (prop, Qdim) ||
EQ (prop, Qblinking) ||
- EQ (prop, Qreverse))
+ EQ (prop, Qreverse) ||
+ EQ (prop, Qflush))
return -1;
if (EQ (prop, Qdoc_string))
＠＠ -276,6 +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 (Qreverse, face->reverse, result);
result = cons3 (Qblinking, face->blinking, result);
result = cons3 (Qdim, face->dim, result);
＠＠ -307,6 +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, plist) },
{ XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) },
{ XD_END }
＠＠ -400,6 +407,7 ＠＠ reset_face (Lisp_Face *f)
f->dim = Qnil;
f->blinking = Qnil;
f->reverse = Qnil;
+ f->flush = Qnil;
f->plist = Qnil;
f->charsets_warned_about = Qnil;
}
＠＠ -554,7 +562,8 ＠＠ update_face_inheritance_mapper (const vo
EQ (fcl->property, Qhighlight) ||
EQ (fcl->property, Qdim) ||
EQ (fcl->property, Qblinking) ||
- EQ (fcl->property, Qreverse))
+ EQ (fcl->property, Qreverse) ||
+ EQ (fcl->property, Qflush))
{
update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
＠＠ -562,6 +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);
}
return 0;
}
＠＠ -869,6 +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);
if (!NILP (Vdefault_face))
{
/* If the default face has already been created, set it as
＠＠ -901,6 +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));
}
/* Add the face to the appropriate list. */
＠＠ -1471,6 +1485,7 ＠＠ update_face_cachel_data (struct face_cac
FROB (highlight);
FROB (dim);
FROB (reverse);
+ FROB (flush);
FROB (blinking);
#undef FROB
}
＠＠ -1510,6 +1525,7 ＠＠ merge_face_cachel_data (struct window *w
FROB (highlight);
FROB (dim);
FROB (reverse);
+ FROB (flush);
FROB (blinking);
for (offs = 0; offs < NUM_LEADING_BYTES; ++offs)
＠＠ -2023,6 +2039,7 ＠＠ LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD
COPY_PROPERTY (dim);
COPY_PROPERTY (blinking);
COPY_PROPERTY (reverse);
+ COPY_PROPERTY (flush);
#undef COPY_PROPERTY
/* #### should it copy the individual specifiers, if they exist? */
fnew->plist = Fcopy_sequence (fold->plist);
＠＠ -2162,6 +2179,7 ＠＠ syms_of_faces (void)
/* Qhighlight, Qreverse defined in general.c */
DEFSYMBOL (Qdim);
DEFSYMBOL (Qblinking);
+ DEFSYMBOL (Qflush);
DEFSYMBOL (Qface_alias);
DEFERROR_STANDARD (Qcyclic_face_alias, Qinvalid_state);
＠＠ -2228,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, Qunbound);
+ Qblinking, Qreverse, Qflush, Qunbound);
staticpro (&Vbuilt_in_face_specifiers);
}
＠＠ -2484,6 +2502,8 ＠＠ 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),
+ list1 (Fcons (Qnil, Qnil)));
/* gui-element is the parent face of all gui elements such as
modeline, vertical divider and toolbar. */
diff --git a/src/faces.h b/src/faces.h
--- a/src/faces.h
+++ b/src/faces.h
＠＠ -54,6 +54,7 ＠＠ struct Lisp_Face
Lisp_Object dim;
Lisp_Object blinking;
Lisp_Object reverse;
+ Lisp_Object flush;
Lisp_Object plist;
＠＠ -180,6 +181,7 ＠＠ struct face_cachel
unsigned int dim :1;
unsigned int blinking :1;
unsigned int reverse :1;
+ unsigned int flush :1;
/* Used when merging to tell if the above field represents an actual
value of this face or a fallback value. */
＠＠ -197,6 +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;
/* The updated flag is set after we calculate the values for the
face cachel and cleared whenever a face changes, to indicate
＠＠ -356,6 +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 FACE_PROPERTY_SPECIFIER(face, property) Fget (face, property, Qnil)
＠＠ -417,5 +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)))
#endif /* INCLUDED_faces_h_ */
diff --git a/src/fontcolor.c b/src/fontcolor.c
--- a/src/fontcolor.c
+++ b/src/fontcolor.c
＠＠ -1159,7 +1159,8 ＠＠ face_boolean_validate (Lisp_Object insta
&& !EQ (field, Qhighlight)
&& !EQ (field, Qdim)
&& !EQ (field, Qblinking)
- && !EQ (field, Qreverse))
+ && !EQ (field, Qreverse)
+ && !EQ (field, Qflush))
invalid_constant ("Invalid face-boolean inheritance field",
field);
}
diff --git a/src/lisp.h b/src/lisp.h
--- a/src/lisp.h
+++ b/src/lisp.h
＠＠ -5144,6 +5144,7 ＠＠ extern Lisp_Object Qdim;
extern Lisp_Object Qdisplay_table;
extern Lisp_Object Qforeground;
extern Lisp_Object Qunderline;
+extern Lisp_Object Qflush;
/* Defined in file-coding.c */
EXFUN (Fcoding_category_list, 0);
diff --git a/src/redisplay-output.c b/src/redisplay-output.c
--- a/src/redisplay-output.c
+++ b/src/redisplay-output.c
＠＠ -556,6 +556,7 ＠＠ compare_display_blocks (struct window *w
cdl->ascent != ddl->ascent ||
cdl->descent != ddl->descent ||
cdl->clip != ddl->clip ||
+ cdl->clear_findex != ddl->clear_findex ||
force)
{
start_pos = 0;
＠＠ -788,7 +789,8 ＠＠ output_display_line (struct window *w, d
cdl->ascent != ddl->ascent ||
cdl->descent != ddl->descent ||
cdl->top_clip != ddl->top_clip ||
- cdl->clip != ddl->clip)))
+ cdl->clip != ddl->clip ||
+ cdl->clear_findex != ddl->clear_findex)))
{
int x, y, width, height;
face_index findex;
＠＠ -807,8 +809,8 ＠＠ output_display_line (struct window *w, d
}
else if (x < ddl->bounds.right_in)
{
- findex = (ddl->default_findex >= DEFAULT_INDEX) ?
- ddl->default_findex
+ findex = (ddl->clear_findex >= DEFAULT_INDEX) ?
+ ddl->clear_findex
: DEFAULT_INDEX;
}
else if (x < ddl->bounds.right_out)
＠＠ -2425,7 +2427,8 ＠＠ redisplay_output_window (struct window *
else if (cdl->ypos != ddl->ypos ||
cdl->ascent != ddl->ascent ||
cdl->descent != ddl->descent ||
- cdl->clip != ddl->clip)
+ cdl->clip != ddl->clip ||
+ cdl->clear_findex != ddl->clear_findex)
need_to_clear_bottom = 1;
/* #### This kludge is to make sure the modeline shadows get
diff --git a/src/redisplay.c b/src/redisplay.c
--- a/src/redisplay.c
+++ b/src/redisplay.c
＠＠ -2186,6 +2186,7 ＠＠ create_text_block (struct window *w, str
dl->used_prop_data = 0;
dl->num_chars = 0;
dl->line_continuation = 0;
+ dl->clear_findex = DEFAULT_INDEX;
xzero (data);
data.ef = extent_fragment_new (w->buffer, f);
＠＠ -2499,6 +2500,12 ＠＠ 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
+ set. -- dvl */
+ if ((data.findex > DEFAULT_INDEX)
+ && WINDOW_FACE_CACHEL_FLUSH_P (w, data.findex))
+ dl->clear_findex = data.findex;
+
/* We aren't going to be adding an end glyph so give its
space back in order to make sure that the cursor can
fit. */
＠＠ -4690,7 +4697,7 ＠＠ create_string_text_block (struct window
dl->line_continuation = 0;
/* Set up faces to use for clearing areas, used by output_display_line. */
- dl->default_findex = default_face;
+ dl->clear_findex = default_face;
if (default_face > DEFAULT_INDEX)
{
dl->left_margin_findex = default_face;
＠＠ -4931,6 +4938,12 ＠＠ 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
+ set. -- dvl */
+ if ((data.findex > DEFAULT_INDEX)
+ && WINDOW_FACE_CACHEL_FLUSH_P (w, data.findex))
+ dl->clear_findex = data.findex;
+
/* We aren't going to be adding an end glyph so give its
space back in order to make sure that the cursor can
fit. */
＠＠ -5871,7 +5884,8 ＠＠ regenerate_window_extents_only_changed (
|| (cdl->cursor_elt == -1 && ddl->cursor_elt != -1)
|| old_start != ddl->charpos
|| old_end != ddl->end_charpos
- || initial_size != Dynarr_length (db->runes))
+ || initial_size != Dynarr_length (db->runes)
+ || cdl->clear_findex != ddl->clear_findex)
{
return 0;
}
＠＠ -6020,7 +6034,8 ＠＠ regenerate_window_incrementally (struct
|| cdl->descent != ddl->descent
|| cdl->top_clip != ddl->top_clip
|| (cdl->cursor_elt != -1 && ddl->cursor_elt == -1)
- || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1))
+ || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1)
+ || cdl->clear_findex != ddl->clear_findex)
{
return 0;
}
diff --git a/src/redisplay.h b/src/redisplay.h
--- a/src/redisplay.h
+++ b/src/redisplay.h
＠＠ -322,17 +322,17 ＠＠ struct display_line
glyph_block_dynarr *left_glyphs;
glyph_block_dynarr *right_glyphs;
- face_index left_margin_findex;
- face_index right_margin_findex;
- face_index default_findex;
+ face_index left_margin_findex;
+ face_index right_margin_findex;
+ face_index clear_findex;
};
-#define DISPLAY_LINE_INIT(dl) \
- do \
- { \
- xzero (dl); \
- dl.default_findex = DEFAULT_INDEX; \
- } \
+#define DISPLAY_LINE_INIT(dl) \
+ do \
+ { \
+ xzero (dl); \
+ dl.clear_findex = DEFAULT_INDEX; \
+ } \
while (0)
#define DISPLAY_LINE_HEIGHT(dl) \
--
Resistance is futile. You will be jazzimilated.
Scientific site: http://www.lrde.epita.fr/~didier
Music (Jazz) site: http://www.didierverna.com
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches