/* Code for doing intervals.
- Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
+#define min(x, y) ((x) < (y) ? (x) : (y))
+
Lisp_Object merge_properties_sticky ();
\f
/* Utility functions for intervals. */
{
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
- XBUFFER (parent)->intervals = new;
+ BUF_INTERVALS (XBUFFER (parent)) = new;
}
else if (STRINGP (parent))
{
interval = balance_an_interval (interval);
if (BUFFERP (parent))
- XBUFFER (parent)->intervals = interval;
+ BUF_INTERVALS (XBUFFER (parent)) = interval;
else if (STRINGP (parent))
XSTRING (parent)->intervals = interval;
parent->parent = (INTERVAL) owner;
if (BUFFERP (owner))
- XBUFFER (owner)->intervals = parent;
+ BUF_INTERVALS (XBUFFER (owner)) = parent;
else if (STRINGP (owner))
XSTRING (owner)->intervals = parent;
else
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))
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;
}
{
Lisp_Object buf;
XSETBUFFER (buf, buffer);
- buffer->intervals = reproduce_tree (source, buf);
+ BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
/* Explicitly free the old tree here. */
return;
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;
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)
}
}
- 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));
- }
-
+ 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 intangible character, move to an ok place. */
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);
+
+ 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.
if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
abort ();
- if (NULL_INTERVAL_P (buffer->intervals))
+ if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
{
- 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)
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))
/* Moving within an interval. */
if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
{
- buffer->text.pt = position;
+ BUF_PT (buffer) = position;
return;
}
- /* If the new position is between two intangible characters,
- move forward or backward across all such characters. */
+ /* 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))
{
if (backwards)
{
- /* Make sure the following character is intangible
- if the previous one is. */
- if (toprev == to
- || ! NILP (textget (to->plist, Qintangible)))
- /* Ok, that is so. Back up across intangible text. */
- while (! NULL_INTERVAL_P (toprev)
- && ! NILP (textget (toprev->plist, Qintangible)))
+ Lisp_Object intangible_propval;
+ intangible_propval = textget (to->plist, Qintangible);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (to == toprev
+ || ((! NULL_INTERVAL_P (toprev)
+ && EQ (textget (toprev->plist, Qintangible),
+ intangible_propval))))
{
to = toprev;
toprev = previous_interval (toprev);
}
else
{
- /* Make sure the previous character is intangible
- if the following one is. */
- if (toprev == to
- || ! NILP (textget (toprev->plist, Qintangible)))
- /* Ok, that is so. Advance across intangible text. */
- while (! NULL_INTERVAL_P (to)
- && ! NILP (textget (to->plist, Qintangible)))
+ Lisp_Object intangible_propval;
+ intangible_propval = textget (toprev->plist, Qintangible);
+
+ /* If previous char is intangible,
+ skip fwd over all chars with matching intangible property. */
+ if (! NILP (intangible_propval))
+ while (to == toprev
+ || ((! NULL_INTERVAL_P (to)
+ && EQ (textget (to->plist, Qintangible),
+ intangible_propval))))
{
toprev = to;
to = next_interval (to);
position = to->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. */
}
- 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
/* 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))
+ 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");
- }
- }
-
- 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 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");
-
- 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");
- }
- }
- }
-
- /* 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. */
Lisp_Object string, buffer;
int position, length;
{
- INTERVAL interval_copy = copy_intervals (XBUFFER (buffer)->intervals,
+ INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (XBUFFER (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 */