From: Lars Magne Ingebrigtsen Date: Mon, 17 Jun 2013 15:28:22 +0000 (+0200) Subject: Implement new function `add-face-text-property' X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2016^2~73^2~28 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=708e05f6d1b39313a63e34a5b4e1a16ae809ae25;p=emacs.git Implement new function `add-face-text-property' * doc/lispref/text.texi (Changing Properties): Document `add-face-text-property'. * src/textprop.c (property_set_type): New enum. (add_properties): Allow appending/prepending text properties. (add_text_properties_1): Factored out of Fadd_text_properties. (Fadd_text_properties): Moved all the code into add_text_properties_1. (Fadd_face_text_property): New function that calls add_text_properties_1. --- diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index af9aa2919e9..6c945dd244e 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2013-06-17 Lars Magne Ingebrigtsen + + * text.texi (Changing Properties): Document `add-face-text-property'. + 2013-06-17 Kenichi Handa * display.texi (Face Attributes): Refer to "Low-Level font" (not diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 6d5a39d887a..fdfc16f3f64 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2803,6 +2803,28 @@ from the specified range of text. Here's an example: @end example Do not rely on the return value of this function. +@end defun + +@defun add-face-text-property start end face &optional appendp object +@code{face} text attributes can be combined. If you want to make a +section both italic and green, you can either define a new face that +have those attributes, or you can add both these attributes separately +to text: + +@example +(add-face-text-property @var{start} @var{end} 'italic) +(add-face-text-property @var{start} @var{end} '(:foreground "#00ff00")) +@end example + +The attribute is (by default) prepended to the list of face +attributes, and the first attribute of the same type takes +presedence. So if you have two @code{:foreground} specifications, the +first one will take effect. + +If you pass in @var{appendp}, the attribute will be appended instead +of prepended, which means that it will have no effect if there is +already an attribute of the same type. + @end defun The easiest way to make a string with text properties diff --git a/etc/NEWS b/etc/NEWS index d92c9cdec1b..a2ef1c4fdd0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -103,6 +103,9 @@ Available only on X, this option allows to control over-scrolling using the scroll bar (i.e. dragging the thumb down even when the end of the buffer is visible). +** New function `add-face-text-property' has been added, which can be +used to conveniently prepend/append new face attributes to text. + ** In compiled Lisp files, the header no longer includes a timestamp. ** Multi-monitor support has been added. diff --git a/src/ChangeLog b/src/ChangeLog index fc57bdaba26..0b3c45711dc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2013-06-17 Lars Magne Ingebrigtsen + + * textprop.c (property_set_type): New enum. + (add_properties): Allow appending/prepending text properties. + (add_text_properties_1): Factored out of Fadd_text_properties. + (Fadd_text_properties): Moved all the code into + add_text_properties_1. + (Fadd_face_text_property): New function that calls + add_text_properties_1. + 2013-06-17 Paul Eggert Move functions from lisp.h to individual modules when possible. diff --git a/src/textprop.c b/src/textprop.c index 03b8de120cd..e5d4fe06c60 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -60,6 +60,13 @@ Lisp_Object Qinvisible, Qintangible, Qmouse_face; static Lisp_Object Qread_only; Lisp_Object Qminibuffer_prompt; +enum property_set_type +{ + TEXT_PROPERTY_REPLACE, + TEXT_PROPERTY_PREPEND, + TEXT_PROPERTY_APPEND +}; + /* Sticky properties. */ Lisp_Object Qfront_sticky, Qrear_nonsticky; @@ -370,7 +377,8 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object) are actually added to I's plist) */ static bool -add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object) +add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, + enum property_set_type set_type) { Lisp_Object tail1, tail2, sym1, val1; bool changed = 0; @@ -416,7 +424,30 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object) } /* I's property has a different value -- change it */ - Fsetcar (this_cdr, val1); + if (set_type == TEXT_PROPERTY_REPLACE) + Fsetcar (this_cdr, val1); + else { + if (CONSP (Fcar (this_cdr)) && + /* Special-case anonymous face properties. */ + (! EQ (sym1, Qface) || + NILP (Fkeywordp (Fcar (Fcar (this_cdr)))))) + /* The previous value is a list, so prepend (or + append) the new value to this list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); + else + nconc2 (Fcar (this_cdr), Fcons (val1, Qnil)); + else { + /* The previous value is a single value, so make it + into a list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, + Fcons (val1, Fcons (Fcar (this_cdr), Qnil))); + else + Fsetcar (this_cdr, + Fcons (Fcar (this_cdr), Fcons (val1, Qnil))); + } + } changed = 1; break; } @@ -1124,19 +1155,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) return make_number (previous->position + LENGTH (previous)); } -/* Callers note, this can GC when OBJECT is a buffer (or nil). */ +/* Used by add-text-properties and add-face-text-property. */ -DEFUN ("add-text-properties", Fadd_text_properties, - Sadd_text_properties, 3, 4, 0, - doc: /* Add properties to the text from START to END. -The third argument PROPERTIES is a property list -specifying the property values to add. If the optional fourth argument -OBJECT is a buffer (or nil, which means the current buffer), -START and END are buffer positions (integers or markers). -If OBJECT is a string, START and END are 0-based indices into it. -Return t if any property value actually changed, nil otherwise. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) -{ +static Lisp_Object +add_text_properties_1 (Lisp_Object start, Lisp_Object end, + Lisp_Object properties, Lisp_Object object, + enum property_set_type set_type) { INTERVAL i, unchanged; ptrdiff_t s, len; bool modified = 0; @@ -1230,7 +1254,7 @@ Return t if any property value actually changed, nil otherwise. */) if (LENGTH (i) == len) { - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1241,7 +1265,7 @@ Return t if any property value actually changed, nil otherwise. */) unchanged = i; i = split_interval_left (unchanged, len); copy_properties (unchanged, i); - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1249,13 +1273,31 @@ Return t if any property value actually changed, nil otherwise. */) } len -= LENGTH (i); - modified |= add_properties (properties, i, object); + modified |= add_properties (properties, i, object, set_type); i = next_interval (i); } } /* Callers note, this can GC when OBJECT is a buffer (or nil). */ +DEFUN ("add-text-properties", Fadd_text_properties, + Sadd_text_properties, 3, 4, 0, + doc: /* Add properties to the text from START to END. +The third argument PROPERTIES is a property list +specifying the property values to add. If the optional fourth argument +OBJECT is a buffer (or nil, which means the current buffer), +START and END are buffer positions (integers or markers). +If OBJECT is a string, START and END are 0-based indices into it. +Return t if any property value actually changed, nil otherwise. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object properties, + Lisp_Object object) +{ + return add_text_properties_1 (start, end, properties, object, + TEXT_PROPERTY_REPLACE); +} + +/* Callers note, this can GC when OBJECT is a buffer (or nil). */ + DEFUN ("put-text-property", Fput_text_property, Sput_text_property, 4, 5, 0, doc: /* Set one property of the text from START to END. @@ -1287,6 +1329,29 @@ the designated part of OBJECT. */) } +DEFUN ("add-face-text-property", Fadd_face_text_property, + Sadd_face_text_property, 3, 5, 0, + doc: /* Add the face property to the text from START to END. +The third argument FACE specifies the face to add. +If any text in the region already has any face properties, this new +face property will be added to the front of the face property list. +If the optional fourth argument APPENDP is non-nil, append to the end +of the face property list instead. +If the optional fifth argument OBJECT is a buffer (or nil, which means +the current buffer), START and END are buffer positions (integers or +markers). If OBJECT is a string, START and END are 0-based indices +into it. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object face, + Lisp_Object appendp, Lisp_Object object) +{ + add_text_properties_1 (start, end, + Fcons (Qface, Fcons (face, Qnil)), + object, + NILP (appendp)? TEXT_PROPERTY_PREPEND: + TEXT_PROPERTY_APPEND); + return Qnil; +} + /* Replace properties of text from START to END with new list of properties PROPERTIES. OBJECT is the buffer or string containing the text. OBJECT nil means use the current buffer. @@ -2292,6 +2357,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and DEFSYM (Qforeground, "foreground"); DEFSYM (Qbackground, "background"); DEFSYM (Qfont, "font"); + DEFSYM (Qface, "face"); DEFSYM (Qstipple, "stipple"); DEFSYM (Qunderline, "underline"); DEFSYM (Qread_only, "read-only"); @@ -2326,6 +2392,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and defsubr (&Sadd_text_properties); defsubr (&Sput_text_property); defsubr (&Sset_text_properties); + defsubr (&Sadd_face_text_property); defsubr (&Sremove_text_properties); defsubr (&Sremove_list_of_text_properties); defsubr (&Stext_property_any);