/* Interface code for dealing with text properties.
- Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "intervals.h"
#include "buffer.h"
#include "window.h"
+
+#ifndef NULL
+#define NULL (void *)0
+#endif
+
+/* Test for membership, allowing for t (actually any non-cons) to mean the
+ universal set. */
+
+#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
\f
/* NOTES: previous- and next- property change will have to skip
/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
the o1's cdr. Otherwise, return zero. This is handy for
traversing plists. */
-#define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr))
+#define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCONS (o1)->cdr, CONSP (o2)))
Lisp_Object Vinhibit_point_motion_hooks;
+Lisp_Object Vdefault_text_properties;
+/* verify_interval_modification saves insertion hooks here
+ to be run later by report_interval_modification. */
+Lisp_Object interval_insert_behind_hooks;
+Lisp_Object interval_insert_in_front_hooks;
\f
/* Extract the interval at the position pointed to by BEGIN from
OBJECT, a string or buffer. Additionally, check that the positions
/* If we are asked for a point, but from a subr which operates
on a range, then return nothing. */
- if (*begin == *end && begin != end)
+ if (EQ (*begin, *end) && begin != end)
return NULL_INTERVAL;
if (XINT (*begin) > XINT (*end))
*end = n;
}
- if (XTYPE (object) == Lisp_Buffer)
+ if (BUFFERP (object))
{
register struct buffer *b = XBUFFER (object);
if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= BUF_ZV (b)))
args_out_of_range (*begin, *end);
- i = b->intervals;
+ i = BUF_INTERVALS (b);
/* If there's no text, there are no properties. */
if (BUF_BEGV (b) == BUF_ZV (b))
args_out_of_range (*begin, *end);
/* User-level Positions in strings start with 0,
but the interval code always wants positions starting with 1. */
- XFASTINT (*begin) += 1;
+ XSETFASTINT (*begin, XFASTINT (*begin) + 1);
if (begin != end)
- XFASTINT (*end) += 1;
+ XSETFASTINT (*end, XFASTINT (*end) + 1);
i = s->intervals;
if (s->size == 0)
/* Return the value of PROP in property-list PLIST, or Qunbound if it
has none. */
-static int
+static Lisp_Object
property_value (plist, prop)
+ Lisp_Object plist, prop;
{
Lisp_Object value;
record_property_change (interval->position, LENGTH (interval),
XCONS (sym)->car, XCONS (value)->car,
object);
+ signal_after_change (interval->position, LENGTH (interval),
+ LENGTH (interval));
}
/* For each new property that has no value at all in the old plist,
record_property_change (interval->position, LENGTH (interval),
XCONS (sym)->car, Qnil,
object);
+ signal_after_change (interval->position, LENGTH (interval),
+ LENGTH (interval));
}
}
INTERVAL i;
Lisp_Object object;
{
- register Lisp_Object tail1, tail2, sym1, val1;
+ Lisp_Object tail1, tail2, sym1, val1;
register int changed = 0;
register int found;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ tail1 = plist;
+ sym1 = Qnil;
+ val1 = Qnil;
+ /* No need to protect OBJECT, because we can GC only in the case
+ where it is a buffer, and live buffers are always protected.
+ I and its plist are also protected, via OBJECT. */
+ GCPRO3 (tail1, sym1, val1);
/* Go through each element of PLIST. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
if (EQ (sym1, Fcar (tail2)))
{
+ /* No need to gcpro, because tail2 protects this
+ and it must be a cons cell (we get an error otherwise). */
register Lisp_Object this_cdr;
this_cdr = Fcdr (tail2);
break;
/* Record this change in the buffer, for undo purposes. */
- if (XTYPE (object) == Lisp_Buffer)
+ if (BUFFERP (object))
{
modify_region (XBUFFER (object),
make_number (i->position),
make_number (i->position + LENGTH (i)));
record_property_change (i->position, LENGTH (i),
sym1, Fcar (this_cdr), object);
+ signal_after_change (i->position, LENGTH (i), LENGTH (i));
}
/* I's property has a different value -- change it */
if (! found)
{
/* Record this change in the buffer, for undo purposes. */
- if (XTYPE (object) == Lisp_Buffer)
+ if (BUFFERP (object))
{
modify_region (XBUFFER (object),
make_number (i->position),
make_number (i->position + LENGTH (i)));
record_property_change (i->position, LENGTH (i),
sym1, Qnil, object);
+ signal_after_change (i->position, LENGTH (i), LENGTH (i));
}
i->plist = Fcons (sym1, Fcons (val1, i->plist));
changed++;
}
}
+ UNGCPRO;
+
return changed;
}
/* First, remove the symbol if its at the head of the list */
while (! NILP (current_plist) && EQ (sym, Fcar (current_plist)))
{
- if (XTYPE (object) == Lisp_Buffer)
+ if (BUFFERP (object))
{
modify_region (XBUFFER (object),
make_number (i->position),
record_property_change (i->position, LENGTH (i),
sym, Fcar (Fcdr (current_plist)),
object);
+ signal_after_change (i->position, LENGTH (i), LENGTH (i));
}
current_plist = Fcdr (Fcdr (current_plist));
this = Fcdr (Fcdr (tail2));
if (EQ (sym, Fcar (this)))
{
- if (XTYPE (object) == Lisp_Buffer)
+ if (BUFFERP (object))
{
modify_region (XBUFFER (object),
make_number (i->position),
make_number (i->position + LENGTH (i)));
record_property_change (i->position, LENGTH (i),
sym, Fcar (Fcdr (this)), object);
+ signal_after_change (i->position, LENGTH (i), LENGTH (i));
}
Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this)));
register INTERVAL i;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i))
If POSITION is at the end of OBJECT, the value is nil.")
(pos, prop, object)
Lisp_Object pos, object;
- register Lisp_Object prop;
+ Lisp_Object prop;
{
- register INTERVAL i;
- register Lisp_Object tail;
-
- if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
- i = validate_interval_range (object, &pos, &pos, soft);
- if (NULL_INTERVAL_P (i))
- return Qnil;
-
- /* If POS is at the end of the interval,
- it means it's the end of OBJECT.
- There are no properties at the very end,
- since no character follows. */
- if (XINT (pos) == LENGTH (i) + i->position)
- return Qnil;
-
- return textget (i->plist, prop);
+ return textget (Ftext_properties_at (pos, object), prop);
}
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
CHECK_NUMBER_COERCE_MARKER (pos, 0);
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
if (WINDOWP (object))
{
w = XWINDOW (object);
- XSET (object, Lisp_Buffer, w->buffer);
+ object = w->buffer;
}
if (BUFFERP (object))
{
Lisp_Object *overlay_vec, tem;
int next_overlay;
int len;
+ struct buffer *obuf = current_buffer;
+
+ set_buffer_temp (XBUFFER (object));
/* First try with room for 40 overlays. */
len = 40;
overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay);
+ noverlays = overlays_at (posn, 0, &overlay_vec, &len,
+ &next_overlay, NULL);
/* If there are more than 40,
make enough space for all, and try again. */
{
len = noverlays;
overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay);
+ noverlays = overlays_at (posn, 0, &overlay_vec, &len,
+ &next_overlay, NULL);
}
noverlays = sort_overlays (overlay_vec, noverlays, w);
+ set_buffer_temp (obuf);
+
/* Now check the overlays in order of decreasing priority. */
while (--noverlays >= 0)
{
register INTERVAL i, next;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
- if (!NILP (limit))
+ if (! NILP (limit) && ! EQ (limit, Qt))
CHECK_NUMBER_COERCE_MARKER (limit, 0);
i = validate_interval_range (object, &pos, &pos, soft);
+
+ /* If LIMIT is t, return start of next interval--don't
+ bother checking further intervals. */
+ if (EQ (limit, Qt))
+ {
+ if (NULL_INTERVAL_P (i))
+ next = i;
+ else
+ next = next_interval (i);
+
+ if (NULL_INTERVAL_P (next))
+ XSETFASTINT (pos, (STRINGP (object)
+ ? XSTRING (object)->size
+ : BUF_ZV (XBUFFER (object))));
+ else
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
+ return pos;
+ }
+
if (NULL_INTERVAL_P (i))
return limit;
next = next_interval (i);
+
while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
&& (NILP (limit) || next->position < XFASTINT (limit)))
next = next_interval (next);
if (! NILP (limit) && !(next->position < XFASTINT (limit)))
return limit;
- return next->position - (XTYPE (object) == Lisp_String);
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
+ return pos;
}
/* Return 1 if there's a change in some property between BEG and END. */
register INTERVAL i, next;
Lisp_Object object, pos;
- XSET (object, Lisp_Buffer, current_buffer);
- XFASTINT (pos) = beg;
+ XSETBUFFER (object, current_buffer);
+ XSETFASTINT (pos, beg);
i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i))
register Lisp_Object here_val;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
if (!NILP (limit))
CHECK_NUMBER_COERCE_MARKER (limit, 0);
if (! NILP (limit) && !(next->position < XFASTINT (limit)))
return limit;
- return next->position - (XTYPE (object) == Lisp_String);
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
+ return pos;
}
DEFUN ("previous-property-change", Fprevious_property_change,
register INTERVAL i, previous;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
if (!NILP (limit))
CHECK_NUMBER_COERCE_MARKER (limit, 0);
&& !(previous->position + LENGTH (previous) > XFASTINT (limit)))
return limit;
- return (previous->position + LENGTH (previous)
- - (XTYPE (object) == Lisp_String));
+ XSETFASTINT (pos, (previous->position + LENGTH (previous)
+ - (STRINGP (object))));
+ return pos;
}
DEFUN ("previous-single-property-change", Fprevious_single_property_change,
register Lisp_Object here_val;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
if (!NILP (limit))
CHECK_NUMBER_COERCE_MARKER (limit, 0);
i = validate_interval_range (object, &pos, &pos, soft);
- if (NULL_INTERVAL_P (i))
- return limit;
/* Start with the interval containing the char before point. */
- if (i->position == XFASTINT (pos))
+ if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (pos))
i = previous_interval (i);
+ if (NULL_INTERVAL_P (i))
+ return limit;
+
here_val = textget (i->plist, prop);
previous = previous_interval (i);
while (! NULL_INTERVAL_P (previous)
&& !(previous->position + LENGTH (previous) > XFASTINT (limit)))
return limit;
- return (previous->position + LENGTH (previous)
- - (XTYPE (object) == Lisp_String));
+ XSETFASTINT (pos, (previous->position + LENGTH (previous)
+ - (STRINGP (object))));
+ return pos;
}
+/* 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,
"Add properties to the text from START to END.\n\
{
register INTERVAL i, unchanged;
register int s, len, modified = 0;
+ struct gcpro gcpro1;
properties = validate_plist (properties);
if (NILP (properties))
return Qnil;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, hard);
if (NULL_INTERVAL_P (i))
s = XINT (start);
len = XINT (end) - s;
+ /* No need to protect OBJECT, because we GC only if it's a buffer,
+ 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 (LENGTH (i) >= len)
{
+ /* We can UNGCPRO safely here, because there will be just
+ one more chance to gc, in the next call to add_properties,
+ and after that we will not need PROPERTIES or OBJECT again. */
+ UNGCPRO;
+
if (interval_has_all_properties (properties, i))
return modified ? Qt : Qnil;
}
}
+/* 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,
"Set one property of the text from START to END.\n\
register INTERVAL i, unchanged;
register INTERVAL prev_changed = NULL_INTERVAL;
register int s, len;
+ Lisp_Object ostart, oend;
+
+ ostart = start;
+ oend = end;
props = validate_plist (props);
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
+
+ /* If we want no properties for a whole string,
+ get rid of its intervals. */
+ if (NILP (props) && STRINGP (object)
+ && XFASTINT (start) == 0
+ && XFASTINT (end) == XSTRING (object)->size)
+ {
+ XSTRING (object)->intervals = 0;
+ return Qt;
+ }
+
+ i = validate_interval_range (object, &start, &end, soft);
- i = validate_interval_range (object, &start, &end, hard);
if (NULL_INTERVAL_P (i))
- return Qnil;
+ {
+ /* If buffer has no props, and we want none, return now. */
+ if (NILP (props))
+ return Qnil;
+
+ /* Restore the original START and END values
+ because validate_interval_range increments them for strings. */
+ start = ostart;
+ end = oend;
+
+ i = validate_interval_range (object, &start, &end, hard);
+ /* This can return if start == end. */
+ if (NULL_INTERVAL_P (i))
+ return Qnil;
+ }
s = XINT (start);
len = XINT (end) - s;
if (LENGTH (i) > len)
i = split_interval_left (i, len);
- if (NULL_INTERVAL_P (prev_changed))
- set_properties (props, i, object);
- else
+ /* 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 (props, i, object);
+ if (!NULL_INTERVAL_P (prev_changed))
merge_interval_left (i);
return Qt;
}
len -= LENGTH (i);
+
+ /* 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 (props, i, object);
if (NULL_INTERVAL_P (prev_changed))
- {
- set_properties (props, i, object);
- prev_changed = i;
- }
+ prev_changed = i;
else
prev_changed = i = merge_interval_left (i);
register int s, len, modified = 0;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
if (NULL_INTERVAL_P (i))
register int e, pos;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
+ if (NULL_INTERVAL_P (i))
+ return (!NILP (value) || EQ (start, end) ? Qnil : start);
e = XINT (end);
while (! NULL_INTERVAL_P (i))
pos = i->position;
if (pos < XINT (start))
pos = XINT (start);
- return make_number (pos - (XTYPE (object) == Lisp_String));
+ return make_number (pos - (STRINGP (object)));
}
i = next_interval (i);
}
register int s, e;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
if (NULL_INTERVAL_P (i))
return (NILP (value) || EQ (start, end)) ? Qnil : start;
{
if (i->position > s)
s = i->position;
- return make_number (s - (XTYPE (object) == Lisp_String));
+ return make_number (s - (STRINGP (object)));
}
i = next_interval (i);
}
register int s, len, modified;
if (NILP (object))
- XSET (object, Lisp_Buffer, current_buffer);
+ XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
if (NULL_INTERVAL_P (i))
returns the text properties of a region as a list of ranges and
plists, and another which applies such a list to another object. */
-/* DEFUN ("copy-text-properties", Fcopy_text_properties,
- Scopy_text_properties, 5, 6, 0,
- "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
-SRC and DEST may each refer to strings or buffers.\n\
-Optional sixth argument PROP causes only that property to be copied.\n\
-Properties are copied to DEST as if by `add-text-properties'.\n\
-Return t if any property value actually changed, nil otherwise.") */
+/* Add properties from SRC to SRC of SRC, starting at POS in DEST.
+ SRC and DEST may each refer to strings or buffers.
+ Optional sixth argument PROP causes only that property to be copied.
+ Properties are copied to DEST as if by `add-text-properties'.
+ Return t if any property value actually changed, nil otherwise. */
+
+/* Note this can GC when DEST is a buffer. */
Lisp_Object
copy_text_properties (start, end, src, pos, dest, prop)
Lisp_Object stuff;
Lisp_Object plist;
int s, e, e2, p, len, modified = 0;
+ struct gcpro gcpro1, gcpro2;
i = validate_interval_range (src, &start, &end, soft);
if (NULL_INTERVAL_P (i))
Lisp_Object dest_start, dest_end;
dest_start = pos;
- XFASTINT (dest_end) = XINT (dest_start) + (XINT (end) - XINT (start));
+ XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
/* Apply this to a copy of pos; it will try to increment its arguments,
which we don't want. */
validate_interval_range (dest, &dest_start, &dest_end, soft);
s = i->position;
}
+ GCPRO2 (stuff, dest);
+
while (! NILP (stuff))
{
res = Fcar (stuff);
stuff = Fcdr (stuff);
}
+ UNGCPRO;
+
return modified ? Qt : Qnil;
}
+\f
+/* Call the modification hook functions in LIST, each with START and END. */
+
+static void
+call_mod_hooks (list, start, end)
+ Lisp_Object list, start, end;
+{
+ struct gcpro gcpro1;
+ GCPRO1 (list);
+ while (!NILP (list))
+ {
+ call2 (Fcar (list), start, end);
+ list = Fcdr (list);
+ }
+ UNGCPRO;
+}
+
+/* Check for read-only intervals and signal an error if we find one.
+ Then check for any modification hooks in the range START up to
+ (but not including) END. Create a list of all these hooks in
+ lexicographic order, eliminating consecutive extra copies of the
+ same hook. Then call those hooks in order, with START and END - 1
+ as arguments. */
+
+void
+verify_interval_modification (buf, start, end)
+ struct buffer *buf;
+ int start, end;
+{
+ register INTERVAL intervals = BUF_INTERVALS (buf);
+ register INTERVAL i, prev;
+ Lisp_Object hooks;
+ register Lisp_Object prev_mod_hooks;
+ Lisp_Object mod_hooks;
+ struct gcpro gcpro1;
+
+ hooks = Qnil;
+ prev_mod_hooks = Qnil;
+ mod_hooks = Qnil;
+
+ interval_insert_behind_hooks = Qnil;
+ interval_insert_in_front_hooks = Qnil;
+
+ if (NULL_INTERVAL_P (intervals))
+ return;
+
+ if (start > end)
+ {
+ int temp = start;
+ start = end;
+ end = temp;
+ }
+
+ /* For an insert operation, check the two chars around the position. */
+ if (start == end)
+ {
+ INTERVAL prev;
+ Lisp_Object before, after;
+
+ /* Set I to the interval containing the char after START,
+ and PREV to the interval containing the char before START.
+ Either one may be null. They may be equal. */
+ i = find_interval (intervals, start);
+
+ if (start == BUF_BEGV (buf))
+ prev = 0;
+ else if (i->position == start)
+ prev = previous_interval (i);
+ else if (i->position < start)
+ prev = i;
+ if (start == BUF_ZV (buf))
+ i = 0;
+
+ /* If Vinhibit_read_only is set and is not a list, we can
+ skip the read_only checks. */
+ if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
+ {
+ /* If I and PREV differ we need to check for the read-only
+ property together with its stickiness. If either I or
+ PREV are 0, this check is all we need.
+ We have to take special care, since read-only may be
+ indirectly defined via the category property. */
+ if (i != prev)
+ {
+ if (! NULL_INTERVAL_P (i))
+ {
+ after = textget (i->plist, Qread_only);
+
+ /* If interval I is read-only and read-only is
+ front-sticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (after)
+ && NILP (Fmemq (after, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (i->plist, Qfront_sticky);
+ if (TMEM (Qread_only, tem)
+ || (NILP (Fplist_get (i->plist, Qread_only))
+ && TMEM (Qcategory, tem)))
+ error ("Attempt to insert within read-only text");
+ }
+ }
+
+ if (! NULL_INTERVAL_P (prev))
+ {
+ before = textget (prev->plist, Qread_only);
+
+ /* If interval PREV is read-only and read-only isn't
+ rear-nonsticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (before)
+ && NILP (Fmemq (before, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (prev->plist, Qrear_nonsticky);
+ if (! TMEM (Qread_only, tem)
+ && (! NILP (Fplist_get (prev->plist,Qread_only))
+ || ! TMEM (Qcategory, tem)))
+ error ("Attempt to insert within read-only text");
+ }
+ }
+ }
+ else if (! NULL_INTERVAL_P (i))
+ {
+ after = textget (i->plist, Qread_only);
+
+ /* If interval I is read-only and read-only is
+ front-sticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (i->plist, Qfront_sticky);
+ if (TMEM (Qread_only, tem)
+ || (NILP (Fplist_get (i->plist, Qread_only))
+ && TMEM (Qcategory, tem)))
+ error ("Attempt to insert within read-only text");
+
+ tem = textget (prev->plist, Qrear_nonsticky);
+ if (! TMEM (Qread_only, tem)
+ && (! NILP (Fplist_get (prev->plist, Qread_only))
+ || ! TMEM (Qcategory, tem)))
+ error ("Attempt to insert within read-only text");
+ }
+ }
+ }
+
+ /* Run both insert hooks (just once if they're the same). */
+ if (!NULL_INTERVAL_P (prev))
+ interval_insert_behind_hooks
+ = textget (prev->plist, Qinsert_behind_hooks);
+ if (!NULL_INTERVAL_P (i))
+ interval_insert_in_front_hooks
+ = textget (i->plist, Qinsert_in_front_hooks);
+ }
+ else
+ {
+ /* Loop over intervals on or next to START...END,
+ collecting their hooks. */
+
+ i = find_interval (intervals, start);
+ do
+ {
+ if (! INTERVAL_WRITABLE_P (i))
+ error ("Attempt to modify read-only text");
+
+ mod_hooks = textget (i->plist, Qmodification_hooks);
+ if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
+ {
+ hooks = Fcons (mod_hooks, hooks);
+ prev_mod_hooks = mod_hooks;
+ }
+
+ i = next_interval (i);
+ }
+ /* Keep going thru the interval containing the char before END. */
+ while (! NULL_INTERVAL_P (i) && i->position < end);
+
+ GCPRO1 (hooks);
+ hooks = Fnreverse (hooks);
+ while (! EQ (hooks, Qnil))
+ {
+ call_mod_hooks (Fcar (hooks), make_number (start),
+ make_number (end));
+ hooks = Fcdr (hooks);
+ }
+ UNGCPRO;
+ }
+}
+
+/* Run the interval hooks for an insertion.
+ verify_interval_modification chose which hooks to run;
+ this function is called after the insertion happens
+ so it can indicate the range of inserted text. */
+void
+report_interval_modification (start, end)
+ Lisp_Object start, end;
+{
+ if (! NILP (interval_insert_behind_hooks))
+ call_mod_hooks (interval_insert_behind_hooks,
+ make_number (start), make_number (end));
+ if (! NILP (interval_insert_in_front_hooks)
+ && ! EQ (interval_insert_in_front_hooks,
+ interval_insert_behind_hooks))
+ call_mod_hooks (interval_insert_in_front_hooks,
+ make_number (start), make_number (end));
+}
+\f
void
syms_of_textprop ()
{
- DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold,
- "Threshold for rebalancing interval trees, expressed as the\n\
-percentage by which the left interval tree should not differ from the right.");
- interval_balance_threshold = 8;
+ DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
+ "Property-list used as default values.\n\
+The value of a property in this list is seen as the value for every\n\
+character that does not have its own value for that property.");
+ Vdefault_text_properties = Qnil;
DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
- "If non-nil, don't call the text property values of\n\
-`point-left' and `point-entered'.");
+ "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
+This also inhibits the use of the `intangible' text property.");
Vinhibit_point_motion_hooks = Qnil;
+
+ staticpro (&interval_insert_behind_hooks);
+ staticpro (&interval_insert_in_front_hooks);
+ interval_insert_behind_hooks = Qnil;
+ interval_insert_in_front_hooks = Qnil;
+
/* Common attributes one might give text */