/* Code for doing intervals.
- Copyright (C) 1993 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
/* NOTES:
#include "intervals.h"
#include "buffer.h"
#include "puresize.h"
+#include "keyboard.h"
/* The rest of the file is within this conditional. */
#ifdef USE_TEXT_PROPERTIES
#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
-/* Factor for weight-balancing interval trees. */
-Lisp_Object interval_balance_threshold;
+#define min(x, y) ((x) < (y) ? (x) : (y))
Lisp_Object merge_properties_sticky ();
\f
new = make_interval ();
- if (XTYPE (parent) == Lisp_Buffer)
+ if (BUFFERP (parent))
{
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
- XBUFFER (parent)->intervals = new;
+ BUF_INTERVALS (XBUFFER (parent)) = new;
}
- else if (XTYPE (parent) == Lisp_String)
+ else if (STRINGP (parent))
{
new->total_length = XSTRING (parent)->size;
XSTRING (parent)->intervals = new;
parent = (Lisp_Object) (interval->parent);
interval = balance_an_interval (interval);
- if (XTYPE (parent) == Lisp_Buffer)
- XBUFFER (parent)->intervals = interval;
- else if (XTYPE (parent) == Lisp_String)
+ if (BUFFERP (parent))
+ BUF_INTERVALS (XBUFFER (parent)) = interval;
+ else if (STRINGP (parent))
XSTRING (parent)->intervals = interval;
return interval;
{
/* Balance within each side. */
if (tree->left)
- balance_intervals (tree->left);
+ balance_intervals_internal (tree->left);
if (tree->right)
- balance_intervals (tree->right);
+ balance_intervals_internal (tree->right);
return balance_an_interval (tree);
}
is updated in the interval found. Other functions (e.g., next_interval)
will update this cache based on the result of find_interval. */
-INLINE INTERVAL
+INTERVAL
find_interval (tree, position)
register INTERVAL tree;
register int position;
return NULL_INTERVAL;
}
+
+/* Find the interval containing POS given some non-NULL INTERVAL
+ in the same tree. */
+INTERVAL
+update_interval (i, pos)
+ register INTERVAL i;
+ int pos;
+{
+ if (NULL_INTERVAL_P (i))
+ return NULL_INTERVAL;
+
+ while (1)
+ {
+ if (pos < i->position)
+ {
+ /* Move left. */
+ if (pos >= i->position - TOTAL_LENGTH (i->left))
+ i = i->left; /* Move to the left child */
+ else if (NULL_PARENT (i))
+ error ("Point before start of properties");
+ else i = i->parent;
+ continue;
+ }
+ else if (pos >= INTERVAL_LAST_POS (i))
+ {
+ /* Move right. */
+ if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
+ i = i->right; /* Move to the right child */
+ else if (NULL_PARENT (i))
+ error ("Point after end of properties");
+ else
+ i = i->parent;
+ continue;
+ }
+ else
+ return i;
+ }
+}
+
\f
#if 0
/* Traverse a path down the interval tree TREE to the interval
Modifications are needed to handle the hungry bits -- after simply
finding the interval at position (don't add length going down),
if it's the beginning of the interval, get the previous interval
- and check the hugry bits of both. Then add the length going back up
+ and check the hungry bits of both. Then add the length going back up
to the root. */
static INTERVAL
So split this interval at the insertion point. */
if (! (position == i->position || eobp)
&& END_NONSTICKY_P (i)
- && ! FRONT_STICKY_P (i))
+ && FRONT_NONSTICKY_P (i))
{
- temp = split_interval_right (i, position - i->position);
- copy_properties (i, temp);
- i = temp;
+ Lisp_Object tail;
+ Lisp_Object front, rear;
+
+ front = textget (i->plist, Qfront_sticky);
+ rear = textget (i->plist, Qrear_nonsticky);
+
+ /* Does any actual property pose an actual problem? */
+ for (tail = i->plist; ! NILP (tail); tail = Fcdr (Fcdr (tail)))
+ {
+ Lisp_Object prop;
+ prop = XCONS (tail)->car;
+
+ /* Is this particular property rear-sticky?
+ Note, if REAR isn't a cons, it must be non-nil,
+ which means that all properties are rear-nonsticky. */
+ if (CONSP (rear) && NILP (Fmemq (prop, rear)))
+ continue;
+
+ /* Is this particular property front-sticky?
+ Note, if FRONT isn't a cons, it must be nil,
+ which means that all properties are front-nonsticky. */
+ if (CONSP (front) && ! NILP (Fmemq (prop, front)))
+ continue;
+
+ /* PROP isn't sticky on either side => it is a real problem. */
+ break;
+ }
+
+ /* If any property is a real problem, split the interval. */
+ if (! NILP (tail))
+ {
+ temp = split_interval_right (i, position - i->position);
+ copy_properties (i, temp);
+ i = temp;
+ }
}
/* If we are positioned between intervals, check the stickiness of
/* Even if we are positioned between intervals, we default
to the left one if it exists. We extend it now and split
- off a part later, if stickyness demands it. */
+ off a part later, if stickiness demands it. */
for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
{
temp->total_length += length;
}
/* If at least one interval has sticky properties,
- we check the stickyness property by property. */
+ we check the stickiness property by property. */
if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
{
Lisp_Object pleft, pright;
{
register Lisp_Object props, front, rear;
Lisp_Object lfront, lrear, rfront, rrear;
- register Lisp_Object tail1, tail2, sym, lval, rval;
+ register Lisp_Object tail1, tail2, sym, lval, rval, cat;
int use_left, use_right;
+ int lpresent;
props = Qnil;
front = Qnil;
for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
if (EQ (sym, Fcar (tail2)))
break;
- lval = (NILP (tail2) ? Qnil : Fcar( Fcdr (tail2)));
- use_left = ! TMEM (sym, lrear);
+ /* Indicate whether the property is explicitly defined on the left.
+ (We know it is defined explicitly on the right
+ because otherwise we don't get here.) */
+ lpresent = ! NILP (tail2);
+ lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
+
+ use_left = ! TMEM (sym, lrear) && lpresent;
use_right = TMEM (sym, rfront);
if (use_left && use_right)
{
- use_left = ! NILP (lval);
- use_right = ! NILP (rval);
+ if (NILP (lval))
+ use_left = 0;
+ else if (NILP (rval))
+ use_right = 0;
}
if (use_left)
{
/* We build props as (value sym ...) rather than (sym value ...)
because we plan to nreverse it when we're done. */
- if (! NILP (lval))
- props = Fcons (lval, Fcons (sym, props));
+ props = Fcons (lval, Fcons (sym, props));
if (TMEM (sym, lfront))
front = Fcons (sym, front);
if (TMEM (sym, lrear))
}
else if (use_right)
{
- if (! NILP (rval))
- props = Fcons (rval, Fcons (sym, props));
+ props = Fcons (rval, Fcons (sym, props));
if (TMEM (sym, rfront))
front = Fcons (sym, front);
if (TMEM (sym, rrear))
/* Since rval is known to be nil in this loop, the test simplifies. */
if (! TMEM (sym, lrear))
{
- if (! NILP (lval))
- props = Fcons (lval, Fcons (sym, props));
+ props = Fcons (lval, Fcons (sym, props));
if (TMEM (sym, lfront))
front = Fcons (sym, front);
}
props = Fnreverse (props);
if (! NILP (rear))
props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
- if (! NILP (front))
+
+ cat = textget (props, Qcategory);
+ if (! NILP (front)
+ &&
+ /* If we have inherited a front-stick category property that is t,
+ we don't need to set up a detailed one. */
+ ! (! NILP (cat) && SYMBOLP (cat)
+ && EQ (Fget (cat, Qfront_sticky), Qt)))
props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
return props;
}
if (! NULL_INTERVAL_P (parent))
parent->parent = (INTERVAL) owner;
- if (XTYPE (owner) == Lisp_Buffer)
- XBUFFER (owner)->intervals = parent;
- else if (XTYPE (owner) == Lisp_String)
+ if (BUFFERP (owner))
+ BUF_INTERVALS (XBUFFER (owner)) = parent;
+ else if (STRINGP (owner))
XSTRING (owner)->intervals = parent;
else
abort ();
int start, length;
{
register int left_to_delete = length;
- register INTERVAL tree = buffer->intervals;
+ register INTERVAL tree = BUF_INTERVALS (buffer);
register int deleted;
if (NULL_INTERVAL_P (tree))
if (length == TOTAL_LENGTH (tree))
{
- buffer->intervals = NULL_INTERVAL;
+ BUF_INTERVALS (buffer) = NULL_INTERVAL;
return;
}
{
left_to_delete -= interval_deletion_adjustment (tree, start - 1,
left_to_delete);
- tree = buffer->intervals;
+ tree = BUF_INTERVALS (buffer);
if (left_to_delete == tree->total_length)
{
- buffer->intervals = NULL_INTERVAL;
+ BUF_INTERVALS (buffer) = NULL_INTERVAL;
return;
}
}
struct buffer *buffer;
int start, length;
{
- if (NULL_INTERVAL_P (buffer->intervals) || length == 0)
+ if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
return;
if (length > 0)
- adjust_intervals_for_insertion (buffer->intervals, start, length);
+ adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
else
adjust_intervals_for_deletion (buffer, start, -length);
}
int inherit;
{
register INTERVAL under, over, this, prev;
- register INTERVAL tree = buffer->intervals;
+ register INTERVAL tree;
int middle;
+ tree = BUF_INTERVALS (buffer);
+
/* If the new text has no properties, it becomes part of whatever
interval it was inserted into. */
if (NULL_INTERVAL_P (source))
Lisp_Object buf;
if (!inherit && ! NULL_INTERVAL_P (tree))
{
- XSET (buf, Lisp_Buffer, buffer);
+ XSETBUFFER (buf, buffer);
Fset_text_properties (make_number (position),
make_number (position + length),
Qnil, buf);
}
- if (! NULL_INTERVAL_P (buffer->intervals))
- buffer->intervals = balance_an_interval (buffer->intervals);
+ if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
return;
}
if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
{
Lisp_Object buf;
- XSET (buf, Lisp_Buffer, buffer);
- buffer->intervals = reproduce_tree (source, buf);
+ XSETBUFFER (buf, buffer);
+ BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
/* Explicitly free the old tree here. */
return;
of the intervals of the inserted string. */
{
Lisp_Object buf;
- XSET (buf, Lisp_Buffer, buffer);
+ XSETBUFFER (buf, buffer);
tree = create_root_interval (buf);
}
}
some zero length intervals. Eventually, do something clever
about inserting properly. For now, just waste the old intervals. */
{
- buffer->intervals = reproduce_tree (source, tree->parent);
+ BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
/* Explicitly free the old tree here. */
return;
/* The inserted text "sticks" to the interval `under',
which means it gets those properties.
The properties of under are the result of
- adjust_intervals_for_insertion, so stickyness has
+ adjust_intervals_for_insertion, so stickiness has
already been taken care of. */
while (! NULL_INTERVAL_P (over))
over = next_interval (over);
}
- if (! NULL_INTERVAL_P (buffer->intervals))
- buffer->intervals = balance_an_interval (buffer->intervals);
+ if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
return;
}
/* Get the value of property PROP from PLIST,
which is the plist of an interval.
- We check for direct properties and for categories with property PROP. */
+ We check for direct properties, for categories with property PROP,
+ and for PROP appearing on the default-text-properties list. */
Lisp_Object
textget (plist, prop)
if (EQ (prop, tem))
return Fcar (Fcdr (tail));
if (EQ (tem, Qcategory))
- fallback = Fget (Fcar (Fcdr (tail)), prop);
- }
-
- return fallback;
-}
-
-/* Get the value of property PROP from PLIST,
- which is the plist of an interval.
- We check for direct properties only! */
-
-Lisp_Object
-textget_direct (plist, prop)
- Lisp_Object plist;
- register Lisp_Object prop;
-{
- register Lisp_Object tail;
-
- for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
- {
- if (EQ (prop, Fcar (tail)))
- return Fcar (Fcdr (tail));
+ {
+ tem = Fcar (Fcdr (tail));
+ if (SYMBOLP (tem))
+ fallback = Fget (tem, prop);
+ }
}
+ if (! NILP (fallback))
+ return fallback;
+ if (CONSP (Vdefault_text_properties))
+ return Fplist_get (Vdefault_text_properties, prop);
return Qnil;
}
+
\f
/* Set point in BUFFER to POSITION. If the target position is
- before an invisible character which is not displayed with a special glyph,
- move back to an ok place to display. */
+ before an intangible character, move to an ok place. */
void
set_point (position, buffer)
register INTERVAL to, from, toprev, fromprev, target;
int buffer_point;
register Lisp_Object obj;
- int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
- int old_position = buffer->text.pt;
+ int old_position = BUF_PT (buffer);
+ int backwards = (position < old_position ? 1 : 0);
+ int have_overlays;
+ int original_position;
+
+ buffer->point_before_scroll = Qnil;
- if (position == buffer->text.pt)
+ if (position == BUF_PT (buffer))
return;
/* Check this now, before checking if the buffer has any intervals.
That way, we can catch conditions which break this sanity check
whether or not there are intervals in the buffer. */
- if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
+ if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
abort ();
- if (NULL_INTERVAL_P (buffer->intervals))
+ have_overlays = (! NILP (buffer->overlays_before)
+ || ! NILP (buffer->overlays_after));
+
+ /* If we have no text properties and overlays,
+ then we can do it quickly. */
+ if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) && ! have_overlays)
{
- buffer->text.pt = position;
+ BUF_PT (buffer) = position;
return;
}
/* Set TO to the interval containing the char after POSITION,
and TOPREV to the interval containing the char before POSITION.
Either one may be null. They may be equal. */
- to = find_interval (buffer->intervals, position);
+ to = find_interval (BUF_INTERVALS (buffer), position);
if (position == BUF_BEGV (buffer))
toprev = 0;
- else if (to->position == position)
+ else if (to && to->position == position)
toprev = previous_interval (to);
else
toprev = to;
and FROMPREV to the interval containing the char before PT.
Either one may be null. They may be equal. */
/* We could cache this and save time. */
- from = find_interval (buffer->intervals, buffer_point);
+ from = find_interval (BUF_INTERVALS (buffer), buffer_point);
if (buffer_point == BUF_BEGV (buffer))
fromprev = 0;
- else if (from->position == BUF_PT (buffer))
+ else if (from && from->position == BUF_PT (buffer))
fromprev = previous_interval (from);
else if (buffer_point != BUF_PT (buffer))
fromprev = from, from = 0;
fromprev = from;
/* Moving within an interval. */
- if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
+ if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
+ && ! have_overlays)
{
- buffer->text.pt = position;
+ BUF_PT (buffer) = position;
return;
}
- /* If the new position is before an invisible character
- that has an `invisible' property of value `hidden',
- move forward over all such. */
- while (! NULL_INTERVAL_P (to)
- && EQ (textget (to->plist, Qinvisible), Qhidden)
- && ! DISPLAY_INVISIBLE_GLYPH (to))
+ original_position = position;
+
+ /* If the new position is between two intangible characters
+ with the same intangible property value,
+ move forward or backward until a change in that property. */
+ if (NILP (Vinhibit_point_motion_hooks)
+ && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
+ || have_overlays)
+ /* Intangibility never stops us from positioning at the beginning
+ or end of the buffer, so don't bother checking in that case. */
+ && position != BEGV && position != ZV)
+ {
+ Lisp_Object intangible_propval;
+ Lisp_Object pos;
+
+ XSETINT (pos, position);
+
+ if (backwards)
+ {
+ intangible_propval = Fget_char_property (make_number (position),
+ Qintangible, Qnil);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (XINT (pos) > BUF_BEGV (buffer)
+ && EQ (Fget_char_property (make_number (XINT (pos) - 1),
+ Qintangible, Qnil),
+ intangible_propval))
+ pos = Fprevious_char_property_change (pos, Qnil);
+ }
+ else
+ {
+ intangible_propval = Fget_char_property (make_number (position - 1),
+ Qintangible, Qnil);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (XINT (pos) < BUF_ZV (buffer)
+ && EQ (Fget_char_property (pos, Qintangible, Qnil),
+ intangible_propval))
+ pos = Fnext_char_property_change (pos, Qnil);
+
+ }
+
+ position = XINT (pos);
+ }
+
+ if (position != original_position)
{
- toprev = to;
- to = next_interval (to);
- if (NULL_INTERVAL_P (to))
- position = BUF_ZV (buffer);
+ /* Set TO to the interval containing the char after POSITION,
+ and TOPREV to the interval containing the char before POSITION.
+ Either one may be null. They may be equal. */
+ to = find_interval (BUF_INTERVALS (buffer), position);
+ if (position == BUF_BEGV (buffer))
+ toprev = 0;
+ else if (to && to->position == position)
+ toprev = previous_interval (to);
else
- position = to->position;
+ toprev = to;
}
- buffer->text.pt = position;
+ /* Here TO is the interval after the stopping point
+ and TOPREV is the interval before the stopping point.
+ One or the other may be null. */
+
+ BUF_PT (buffer) = position;
/* We run point-left and point-entered hooks here, iff the
two intervals are not equivalent. These hooks take
int position;
struct buffer *buffer;
{
- buffer->text.pt = position;
+ BUF_PT (buffer) = position;
+}
+\f
+/* Move point to POSITION, unless POSITION is inside an intangible
+ segment that reaches all the way to point. */
+
+void
+move_if_not_intangible (position)
+ int position;
+{
+ Lisp_Object pos;
+ Lisp_Object intangible_propval;
+
+ XSETINT (pos, position);
+
+ if (! NILP (Vinhibit_point_motion_hooks))
+ /* If intangible is inhibited, always move point to POSITION. */
+ ;
+ else if (PT < position && pos < ZV)
+ {
+ /* We want to move forward, so check the text before POSITION. */
+
+ intangible_propval = Fget_char_property (pos,
+ Qintangible, Qnil);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (XINT (pos) > BEGV
+ && EQ (Fget_char_property (make_number (XINT (pos) - 1),
+ Qintangible, Qnil),
+ intangible_propval))
+ pos = Fprevious_char_property_change (pos, Qnil);
+ }
+ else if (pos > BEGV)
+ {
+ /* We want to move backward, so check the text after POSITION. */
+
+ intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
+ Qintangible, Qnil);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (XINT (pos) < ZV
+ && EQ (Fget_char_property (pos, Qintangible, Qnil),
+ intangible_propval))
+ pos = Fnext_char_property_change (pos, Qnil);
+
+ }
+
+ /* If the whole stretch between PT and POSITION isn't intangible,
+ try moving to POSITION (which means we actually move farther
+ if POSITION is inside of intangible text). */
+
+ if (XINT (pos) != PT)
+ SET_PT (position);
}
\f
/* Return the proper local map for position POSITION in BUFFER.
register int position;
register struct buffer *buffer;
{
- register INTERVAL interval;
- Lisp_Object prop, tem;
-
- if (NULL_INTERVAL_P (buffer->intervals))
- return current_buffer->keymap;
+ Lisp_Object prop, tem, lispy_position, lispy_buffer;
+ int old_begv, old_zv;
/* Perhaps we should just change `position' to the limit. */
if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
abort ();
- interval = find_interval (buffer->intervals, position);
- prop = textget (interval->plist, Qlocal_map);
- if (NILP (prop))
- return current_buffer->keymap;
+ /* Ignore narrowing, so that a local map continues to be valid even if
+ the visible region contains no characters and hence no properties. */
+ old_begv = BUF_BEGV (buffer);
+ old_zv = BUF_ZV (buffer);
+ BUF_BEGV (buffer) = BUF_BEG (buffer);
+ BUF_ZV (buffer) = BUF_Z (buffer);
+
+ /* There are no properties at the end of the buffer, so in that case
+ check for a local map on the last character of the buffer instead. */
+ if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer))
+ --position;
+ XSETFASTINT (lispy_position, position);
+ XSETBUFFER (lispy_buffer, buffer);
+ prop = Fget_char_property (lispy_position, Qlocal_map, lispy_buffer);
+
+ BUF_BEGV (buffer) = old_begv;
+ BUF_ZV (buffer) = old_zv;
/* Use the local map only if it is valid. */
- tem = Fkeymapp (prop);
- if (!NILP (tem))
+ /* Do allow symbols that are defined as keymaps. */
+ if (SYMBOLP (prop) && !NILP (prop))
+ prop = Findirect_function (prop);
+ if (!NILP (prop)
+ && (tem = Fkeymapp (prop), !NILP (tem)))
return prop;
- return current_buffer->keymap;
+ return buffer->keymap;
}
\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) TO. 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;
- 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;
-
- 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 stickyness. 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 (textget_direct (i->plist, Qread_only))
- && TMEM (Qcategory, tem)))
- error ("Attempt to insert within read-only text");
- }
- }
- else
- after = Qnil;
- 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 (textget_direct (prev->plist,Qread_only))
- || ! TMEM (Qcategory, tem)))
- error ("Attempt to insert within read-only text");
- }
- }
- else
- before = Qnil;
- }
- else if (! NULL_INTERVAL_P (i))
- before = after = textget (i->plist, Qread_only);
- if (! NULL_INTERVAL_P (i) && ! NULL_INTERVAL_P (prev))
- {
- /* If I and PREV differ, neither of them has a sticky
- read-only property. It only remains to check, whether
- they have a common read-only property. */
- if (! NILP (before) && EQ (before, after))
- error ("Attempt to insert within read-only text");
- }
- }
-
- /* Run both insert hooks (just once if they're the same). */
- if (!NULL_INTERVAL_P (prev))
- prev_mod_hooks = textget (prev->plist, Qinsert_behind_hooks);
- if (!NULL_INTERVAL_P (i))
- mod_hooks = textget (i->plist, Qinsert_in_front_hooks);
- GCPRO1 (mod_hooks);
- if (! NILP (prev_mod_hooks))
- call_mod_hooks (prev_mod_hooks, make_number (start),
- make_number (end));
- UNGCPRO;
- if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
- call_mod_hooks (mod_hooks, make_number (start), make_number (end));
- }
- 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;
- }
-}
-
/* Produce an interval tree reflecting the intervals in
TREE from START to START + LENGTH. */
INLINE void
copy_intervals_to_string (string, buffer, position, length)
- Lisp_Object string, buffer;
+ Lisp_Object string;
+ struct buffer *buffer;
int position, length;
{
- INTERVAL interval_copy = copy_intervals (XBUFFER (buffer)->intervals,
+ INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
position, length);
if (NULL_INTERVAL_P (interval_copy))
return;
interval_copy->parent = (INTERVAL) string;
XSTRING (string)->intervals = interval_copy;
}
+\f
+/* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
+ Assume they have identical characters. */
+
+int
+compare_string_intervals (s1, s2)
+ Lisp_Object s1, s2;
+{
+ INTERVAL i1, i2;
+ int pos = 1;
+ int end = XSTRING (s1)->size + 1;
+
+ /* We specify 1 as position because the interval functions
+ always use positions starting at 1. */
+ i1 = find_interval (XSTRING (s1)->intervals, 1);
+ i2 = find_interval (XSTRING (s2)->intervals, 1);
+
+ while (pos < end)
+ {
+ /* Determine how far we can go before we reach the end of I1 or I2. */
+ int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
+ int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
+ int distance = min (len1, len2);
+
+ /* If we ever find a mismatch between the strings,
+ they differ. */
+ if (! intervals_equal (i1, i2))
+ return 0;
+
+ /* Advance POS till the end of the shorter interval,
+ and advance one or both interval pointers for the new position. */
+ pos += distance;
+ if (len1 == distance)
+ i1 = next_interval (i1);
+ if (len2 == distance)
+ i2 = next_interval (i2);
+ }
+ return 1;
+}
#endif /* USE_TEXT_PROPERTIES */
HCoop / bpt / emacs.git / blobdiff