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.
This commit is contained in:
Lars Magne Ingebrigtsen 2013-06-17 17:28:22 +02:00
parent 2c149f93b4
commit 708e05f6d1
5 changed files with 123 additions and 17 deletions

View file

@ -1,3 +1,7 @@
2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
* text.texi (Changing Properties): Document `add-face-text-property'.
2013-06-17 Kenichi Handa <handa@gnu.org>
* display.texi (Face Attributes): Refer to "Low-Level font" (not

View file

@ -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

View file

@ -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.

View file

@ -1,3 +1,13 @@
2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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 <eggert@cs.ucla.edu>
Move functions from lisp.h to individual modules when possible.

View file

@ -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);