X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/77c7bcb1157b405bde1227b20ef5f7ce9a90e689..4431e6d9b30062407a60897db58356a36cedf49f:/src/textprop.c?ds=sidebyside
diff --git a/src/textprop.c b/src/textprop.c
index 1ec1ab11d2..e5d4fe06c6 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1,5 +1,6 @@
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
+ Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
+ Inc.
This file is part of GNU Emacs.
@@ -17,7 +18,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see . */
#include
-#include
+
#include "lisp.h"
#include "intervals.h"
#include "character.h"
@@ -59,7 +60,14 @@ Lisp_Object Qinvisible, Qintangible, Qmouse_face;
static Lisp_Object Qread_only;
Lisp_Object Qminibuffer_prompt;
-/* Sticky properties */
+enum property_set_type
+{
+ TEXT_PROPERTY_REPLACE,
+ TEXT_PROPERTY_PREPEND,
+ TEXT_PROPERTY_APPEND
+};
+
+/* Sticky properties. */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
@@ -85,8 +93,26 @@ text_read_only (Lisp_Object propval)
xsignal0 (Qtext_read_only);
}
+/* Prepare to modify the region of BUFFER from START to END. */
+
+static void
+modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
+{
+ struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
+
+ set_buffer_internal (buf);
+ modify_region_1 (XINT (start), XINT (end), true);
+ set_buffer_internal (old);
+}
+
+/* Complain if object is not string or buffer type. */
+
+static void
+CHECK_STRING_OR_BUFFER (Lisp_Object x)
+{
+ CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
+}
-
/* Extract the interval at the position pointed to by BEGIN from
OBJECT, a string or buffer. Additionally, check that the positions
pointed to by BEGIN and END are within the bounds of OBJECT, and
@@ -114,9 +140,10 @@ text_read_only (Lisp_Object propval)
#define hard 1
INTERVAL
-validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
+validate_interval_range (Lisp_Object object, Lisp_Object *begin,
+ Lisp_Object *end, bool force)
{
- register INTERVAL i;
+ INTERVAL i;
ptrdiff_t searchpos;
CHECK_STRING_OR_BUFFER (object);
@@ -143,7 +170,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en
if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= BUF_ZV (b)))
args_out_of_range (*begin, *end);
- i = BUF_INTERVALS (b);
+ i = buffer_intervals (b);
/* If there's no text, there are no properties. */
if (BUF_BEGV (b) == BUF_ZV (b))
@@ -161,7 +188,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en
XSETFASTINT (*begin, XFASTINT (*begin));
if (begin != end)
XSETFASTINT (*end, XFASTINT (*end));
- i = STRING_INTERVALS (object);
+ i = string_intervals (object);
if (len == 0)
return NULL;
@@ -187,14 +214,14 @@ validate_plist (Lisp_Object list)
if (CONSP (list))
{
- register int i;
- register Lisp_Object tail;
- for (i = 0, tail = list; CONSP (tail); i++)
+ bool odd_length = 0;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- tail = XCDR (tail);
+ odd_length ^= 1;
QUIT;
}
- if (i & 1)
+ if (odd_length)
error ("Odd length text property list");
return list;
}
@@ -202,20 +229,19 @@ validate_plist (Lisp_Object list)
return Fcons (list, Fcons (Qnil, Qnil));
}
-/* Return nonzero if interval I has all the properties,
+/* Return true if interval I has all the properties,
with the same values, of list PLIST. */
-static int
+static bool
interval_has_all_properties (Lisp_Object plist, INTERVAL i)
{
- register Lisp_Object tail1, tail2, sym1;
- register int found;
+ Lisp_Object tail1, tail2;
/* Go through each element of PLIST. */
for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
{
- sym1 = XCAR (tail1);
- found = 0;
+ Lisp_Object sym1 = XCAR (tail1);
+ bool found = 0;
/* Go through I's plist, looking for sym1 */
for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
@@ -238,13 +264,13 @@ interval_has_all_properties (Lisp_Object plist, INTERVAL i)
return 1;
}
-/* Return nonzero if the plist of interval I has any of the
+/* Return true if the plist of interval I has any of the
properties of PLIST, regardless of their values. */
-static inline int
+static bool
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
{
- register Lisp_Object tail1, tail2, sym;
+ Lisp_Object tail1, tail2, sym;
/* Go through each element of PLIST. */
for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
@@ -263,10 +289,10 @@ interval_has_some_properties (Lisp_Object plist, INTERVAL i)
/* Return nonzero if the plist of interval I has any of the
property names in LIST, regardless of their values. */
-static inline int
+static bool
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
{
- register Lisp_Object tail1, tail2, sym;
+ Lisp_Object tail1, tail2, sym;
/* Go through each element of LIST. */
for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
@@ -338,7 +364,7 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
}
/* Store new properties. */
- interval_set_plist (interval, Fcopy_sequence (properties));
+ set_interval_plist (interval, Fcopy_sequence (properties));
}
/* Add the properties of PLIST to the interval I, or set
@@ -347,15 +373,15 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
OBJECT should be the string or buffer the interval is in.
- Return nonzero if this changes I (i.e., if any members of PLIST
+ Return true if this changes I (i.e., if any members of PLIST
are actually added to I's plist) */
-static int
-add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
+static bool
+add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
+ enum property_set_type set_type)
{
Lisp_Object tail1, tail2, sym1, val1;
- register int changed = 0;
- register int found;
+ bool changed = 0;
struct gcpro gcpro1, gcpro2, gcpro3;
tail1 = plist;
@@ -369,9 +395,9 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
/* Go through each element of PLIST. */
for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
{
+ bool found = 0;
sym1 = XCAR (tail1);
val1 = Fcar (XCDR (tail1));
- found = 0;
/* Go through I's plist, looking for sym1 */
for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
@@ -398,8 +424,31 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
}
/* I's property has a different value -- change it */
- Fsetcar (this_cdr, val1);
- changed++;
+ 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;
}
@@ -411,8 +460,8 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
record_property_change (i->position, LENGTH (i),
sym1, Qnil, object);
}
- interval_set_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
- changed++;
+ set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
+ changed = 1;
}
}
@@ -426,14 +475,14 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
(If PLIST is non-nil, use that, otherwise use LIST.)
OBJECT is the string or buffer containing I. */
-static int
+static bool
remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
{
- register Lisp_Object tail1, tail2, sym, current_plist;
- register int changed = 0;
+ Lisp_Object tail1, tail2, sym, current_plist;
+ bool changed = 0;
- /* Nonzero means tail1 is a plist, otherwise it is a list. */
- int use_plist;
+ /* True means tail1 is a plist, otherwise it is a list. */
+ bool use_plist;
current_plist = i->plist;
@@ -456,7 +505,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object
object);
current_plist = XCDR (XCDR (current_plist));
- changed++;
+ changed = 1;
}
/* Go through I's plist, looking for SYM. */
@@ -472,7 +521,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object
sym, XCAR (XCDR (this)), object);
Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
- changed++;
+ changed = 1;
}
tail2 = this;
}
@@ -484,7 +533,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object
}
if (changed)
- interval_set_plist (i, current_plist);
+ set_interval_plist (i, current_plist);
return changed;
}
@@ -510,13 +559,13 @@ interval_of (ptrdiff_t position, Lisp_Object object)
beg = BUF_BEGV (b);
end = BUF_ZV (b);
- i = BUF_INTERVALS (b);
+ i = buffer_intervals (b);
}
else
{
beg = 0;
end = SCHARS (object);
- i = STRING_INTERVALS (object);
+ i = string_intervals (object);
}
if (!(beg <= position && position <= end))
@@ -556,7 +605,8 @@ If POSITION is at the end of OBJECT, the value is nil. */)
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
doc: /* Return the value of POSITION's property PROP, in OBJECT.
-OBJECT is optional and defaults to the current buffer.
+OBJECT should be a buffer or a string; if omitted or nil, it defaults
+to the current buffer.
If POSITION is at the end of OBJECT, the value is nil. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object)
{
@@ -586,8 +636,9 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
if (WINDOWP (object))
{
+ CHECK_LIVE_WINDOW (object);
w = XWINDOW (object);
- object = w->buffer;
+ object = w->contents;
}
if (BUFFERP (object))
{
@@ -760,7 +811,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
@@ -843,7 +894,7 @@ position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
@@ -1104,23 +1155,17 @@ 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)
-{
- register INTERVAL i, unchanged;
- register ptrdiff_t s, len;
- register int modified = 0;
+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;
struct gcpro gcpro1;
+ bool first_time = 1;
properties = validate_plist (properties);
if (NILP (properties))
@@ -1129,6 +1174,7 @@ Return t if any property value actually changed, nil otherwise. */)
if (NILP (object))
XSETBUFFER (object, current_buffer);
+ retry:
i = validate_interval_range (object, &start, &end, hard);
if (!i)
return Qnil;
@@ -1140,31 +1186,50 @@ Return t if any property value actually changed, nil otherwise. */)
and live buffers are always protected. */
GCPRO1 (properties);
- /* If we're not starting on an interval boundary, we have to
- split this interval. */
- if (i->position != s)
+ /* If this interval already has the properties, we can skip it. */
+ if (interval_has_all_properties (properties, i))
{
- /* If this interval already has the properties, we can
- skip it. */
- if (interval_has_all_properties (properties, i))
+ ptrdiff_t got = LENGTH (i) - (s - i->position);
+
+ do
{
- ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
RETURN_UNGCPRO (Qnil);
len -= got;
i = next_interval (i);
+ got = LENGTH (i);
}
- else
+ while (interval_has_all_properties (properties, i));
+ }
+ else if (i->position != s)
+ {
+ /* If we're not starting on an interval boundary, we have to
+ split this interval. */
+ unchanged = i;
+ i = split_interval_right (unchanged, s - unchanged->position);
+ copy_properties (unchanged, i);
+ }
+
+ if (BUFFERP (object) && first_time)
+ {
+ ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
+ ptrdiff_t prev_pos = i->position;
+
+ modify_region (object, start, end);
+ /* If someone called us recursively as a side effect of
+ modify_region, and changed the intervals behind our back
+ (could happen if lock_file, called by prepare_to_modify_buffer,
+ triggers redisplay, and that calls add-text-properties again
+ in the same buffer), we cannot continue with I, because its
+ data changed. So we restart the interval analysis anew. */
+ if (TOTAL_LENGTH (i) != prev_total_length
+ || i->position != prev_pos)
{
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- copy_properties (unchanged, i);
+ first_time = 0;
+ goto retry;
}
}
- if (BUFFERP (object))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
-
/* We are at the beginning of interval I, with LEN chars to scan. */
for (;;)
{
@@ -1183,12 +1248,13 @@ Return t if any property value actually changed, nil otherwise. */)
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
- return modified ? Qt : Qnil;
+ eassert (modified);
+ return Qt;
}
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));
@@ -1199,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));
@@ -1207,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.
@@ -1245,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.
@@ -1274,10 +1381,10 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
&& XFASTINT (start) == 0
&& XFASTINT (end) == SCHARS (object))
{
- if (! STRING_INTERVALS (object))
+ if (!string_intervals (object))
return Qnil;
- STRING_SET_INTERVALS (object, NULL);
+ set_string_intervals (object, NULL);
return Qt;
}
@@ -1301,7 +1408,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
}
if (BUFFERP (object) && !NILP (coherent_change_p))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
+ modify_region (object, start, end);
set_text_properties_1 (start, end, properties, object, i);
@@ -1312,14 +1419,13 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
}
/* Replace properties of text from START to END with new list of
- properties PROPERTIES. BUFFER is the buffer containing
+ properties PROPERTIES. OBJECT is the buffer or string containing
the text. This does not obey any hooks.
- You can provide the interval that START is located in as I,
- or pass NULL for I and this function will find it.
+ You should provide the interval that START is located in as I.
START and END can be in any order. */
void
-set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i)
+set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
{
register INTERVAL prev_changed = NULL;
register ptrdiff_t s, len;
@@ -1338,8 +1444,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
else
return;
- if (i == 0)
- i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
+ eassert (i);
if (i->position != s)
{
@@ -1350,11 +1455,11 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
{
copy_properties (unchanged, i);
i = split_interval_left (i, len);
- set_properties (properties, i, buffer);
+ set_properties (properties, i, object);
return;
}
- set_properties (properties, i, buffer);
+ set_properties (properties, i, object);
if (LENGTH (i) == len)
return;
@@ -1377,7 +1482,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
/* We have to call set_properties even if we are going to
merge the intervals, so as to make the undo records
and cause redisplay to happen. */
- set_properties (properties, i, buffer);
+ set_properties (properties, i, object);
if (prev_changed)
merge_interval_left (i);
return;
@@ -1388,7 +1493,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
/* We have to call set_properties even if we are going to
merge the intervals, so as to make the undo records
and cause redisplay to happen. */
- set_properties (properties, i, buffer);
+ set_properties (properties, i, object);
if (!prev_changed)
prev_changed = i;
else
@@ -1413,13 +1518,15 @@ Return t if any property was actually removed, nil otherwise.
Use `set-text-properties' if you want to remove all text properties. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
- register INTERVAL i, unchanged;
- register ptrdiff_t s, len;
- register int modified = 0;
+ INTERVAL i, unchanged;
+ ptrdiff_t s, len;
+ bool modified = 0;
+ bool first_time = 1;
if (NILP (object))
XSETBUFFER (object, current_buffer);
+ retry:
i = validate_interval_range (object, &start, &end, soft);
if (!i)
return Qnil;
@@ -1427,31 +1534,50 @@ Use `set-text-properties' if you want to remove all text properties. */)
s = XINT (start);
len = XINT (end) - s;
- if (i->position != s)
+ /* If there are no properties on this entire interval, return. */
+ if (! interval_has_some_properties (properties, i))
{
- /* No properties on this first interval -- return if
- it covers the entire region. */
- if (! interval_has_some_properties (properties, i))
+ ptrdiff_t got = LENGTH (i) - (s - i->position);
+
+ do
{
- ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
i = next_interval (i);
+ got = LENGTH (i);
}
- /* Split away the beginning of this interval; what we don't
- want to modify. */
- else
+ while (! interval_has_some_properties (properties, i));
+ }
+ /* Split away the beginning of this interval; what we don't
+ want to modify. */
+ else if (i->position != s)
+ {
+ unchanged = i;
+ i = split_interval_right (unchanged, s - unchanged->position);
+ copy_properties (unchanged, i);
+ }
+
+ if (BUFFERP (object) && first_time)
+ {
+ ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
+ ptrdiff_t prev_pos = i->position;
+
+ modify_region (object, start, end);
+ /* If someone called us recursively as a side effect of
+ modify_region, and changed the intervals behind our back
+ (could happen if lock_file, called by prepare_to_modify_buffer,
+ triggers redisplay, and that calls add-text-properties again
+ in the same buffer), we cannot continue with I, because its
+ data changed. So we restart the interval analysis anew. */
+ if (TOTAL_LENGTH (i) != prev_total_length
+ || i->position != prev_pos)
{
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- copy_properties (unchanged, i);
+ first_time = 0;
+ goto retry;
}
}
- if (BUFFERP (object))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
-
/* We are at the beginning of an interval, with len to scan */
for (;;)
{
@@ -1460,7 +1586,13 @@ Use `set-text-properties' if you want to remove all text properties. */)
if (LENGTH (i) >= len)
{
if (! interval_has_some_properties (properties, i))
- return modified ? Qt : Qnil;
+ {
+ eassert (modified);
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
+ return Qt;
+ }
if (LENGTH (i) == len)
{
@@ -1483,7 +1615,7 @@ Use `set-text-properties' if you want to remove all text properties. */)
}
len -= LENGTH (i);
- modified += remove_properties (properties, Qnil, i, object);
+ modified |= remove_properties (properties, Qnil, i, object);
i = next_interval (i);
}
}
@@ -1498,9 +1630,9 @@ markers). If OBJECT is a string, START and END are 0-based indices into it.
Return t if any property was actually removed, nil otherwise. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
{
- register INTERVAL i, unchanged;
- register ptrdiff_t s, len;
- register int modified = 0;
+ INTERVAL i, unchanged;
+ ptrdiff_t s, len;
+ bool modified = 0;
Lisp_Object properties;
properties = list_of_properties;
@@ -1514,26 +1646,28 @@ Return t if any property was actually removed, nil otherwise. */)
s = XINT (start);
len = XINT (end) - s;
- if (i->position != s)
+ /* If there are no properties on the interval, return. */
+ if (! interval_has_some_properties_list (properties, i))
{
- /* No properties on this first interval -- return if
- it covers the entire region. */
- if (! interval_has_some_properties_list (properties, i))
+ ptrdiff_t got = LENGTH (i) - (s - i->position);
+
+ do
{
- ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
i = next_interval (i);
+ got = LENGTH (i);
}
- /* Split away the beginning of this interval; what we don't
- want to modify. */
- else
- {
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- copy_properties (unchanged, i);
- }
+ while (! interval_has_some_properties_list (properties, i));
+ }
+ /* Split away the beginning of this interval; what we don't
+ want to modify. */
+ else if (i->position != s)
+ {
+ unchanged = i;
+ i = split_interval_right (unchanged, s - unchanged->position);
+ copy_properties (unchanged, i);
}
/* We are at the beginning of an interval, with len to scan.
@@ -1564,7 +1698,7 @@ Return t if any property was actually removed, nil otherwise. */)
else if (LENGTH (i) == len)
{
if (!modified && BUFFERP (object))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
+ modify_region (object, start, end);
remove_properties (Qnil, properties, i, object);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
@@ -1577,7 +1711,7 @@ Return t if any property was actually removed, nil otherwise. */)
i = split_interval_left (i, len);
copy_properties (unchanged, i);
if (!modified && BUFFERP (object))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
+ modify_region (object, start, end);
remove_properties (Qnil, properties, i, object);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
@@ -1588,7 +1722,7 @@ Return t if any property was actually removed, nil otherwise. */)
if (interval_has_some_properties_list (properties, i))
{
if (!modified && BUFFERP (object))
- modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
+ modify_region (object, start, end);
remove_properties (Qnil, properties, i, object);
modified = 1;
}
@@ -1680,7 +1814,7 @@ int
text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
{
Lisp_Object prev_pos, front_sticky;
- int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
+ bool is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
if (NILP (buffer))
@@ -1755,7 +1889,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
Lisp_Object stuff;
Lisp_Object plist;
ptrdiff_t s, e, e2, p, len;
- int modified = 0;
+ bool modified = 0;
struct gcpro gcpro1, gcpro2;
i = validate_interval_range (src, &start, &end, soft);
@@ -1826,7 +1960,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
Fcar (Fcdr (Fcdr (res))), dest);
if (! NILP (res))
- modified++;
+ modified = 1;
stuff = Fcdr (stuff);
}
@@ -1897,33 +2031,28 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
/* Add text properties to OBJECT from LIST. LIST is a list of triples
(START END PLIST), where START and END are positions and PLIST is a
property list containing the text properties to add. Adjust START
- and END positions by DELTA before adding properties. Value is
- non-zero if OBJECT was modified. */
+ and END positions by DELTA before adding properties. */
-int
+void
add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
{
struct gcpro gcpro1, gcpro2;
- int modified_p = 0;
GCPRO2 (list, object);
for (; CONSP (list); list = XCDR (list))
{
- Lisp_Object item, start, end, plist, tem;
+ Lisp_Object item, start, end, plist;
item = XCAR (list);
start = make_number (XINT (XCAR (item)) + XINT (delta));
end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
plist = XCAR (XCDR (XCDR (item)));
- tem = Fadd_text_properties (start, end, plist, object);
- if (!NILP (tem))
- modified_p = 1;
+ Fadd_text_properties (start, end, plist, object);
}
UNGCPRO;
- return modified_p;
}
@@ -1993,10 +2122,10 @@ void
verify_interval_modification (struct buffer *buf,
ptrdiff_t start, ptrdiff_t end)
{
- register INTERVAL intervals = BUF_INTERVALS (buf);
- register INTERVAL i;
+ INTERVAL intervals = buffer_intervals (buf);
+ INTERVAL i;
Lisp_Object hooks;
- register Lisp_Object prev_mod_hooks;
+ Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
struct gcpro gcpro1;
@@ -2228,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");
@@ -2262,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);