summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen <larsi@gnus.org>2013-06-17 17:28:22 +0200
committerLars Magne Ingebrigtsen <larsi@gnus.org>2013-06-17 17:28:22 +0200
commit708e05f6d1b39313a63e34a5b4e1a16ae809ae25 (patch)
tree406e73905374997269b8d123e5c0ec98dcbd872e
parent2c149f93b425ffbb2de02e9b41e1aa98ae40e0e7 (diff)
downloademacs-708e05f6d1b39313a63e34a5b4e1a16ae809ae25.tar.gz
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.
-rw-r--r--doc/lispref/ChangeLog4
-rw-r--r--doc/lispref/text.texi22
-rw-r--r--etc/NEWS3
-rw-r--r--src/ChangeLog10
-rw-r--r--src/textprop.c101
5 files changed, 123 insertions, 17 deletions
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 <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
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
@@ -2805,6 +2805,28 @@ from the specified range of text. Here's an 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
is with @code{propertize}:
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 <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.
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);