/* Code for doing intervals.
- Copyright (C) 1991, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
*/
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
-#include "screen.h"
+#include "puresize.h"
+#include "keyboard.h"
-/* Factor for weight-balancing interval trees. */
-Lisp_Object interval_balance_threshold;
+/* The rest of the file is within this conditional. */
+#ifdef USE_TEXT_PROPERTIES
+
+/* 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))
+
+#define min(x, y) ((x) < (y) ? (x) : (y))
+
+Lisp_Object merge_properties_sticky ();
\f
-/* Utility functions for intervals. */
+/* Utility functions for intervals. */
-/* Create the root interval of some object, a buffer or string. */
+/* Create the root interval of some object, a buffer or string. */
INTERVAL
create_root_interval (parent)
Lisp_Object parent;
{
- INTERVAL new = make_interval ();
+ INTERVAL new;
+
+ CHECK_IMPURE (parent);
- if (XTYPE (parent) == Lisp_Buffer)
+ new = make_interval ();
+
+ if (BUFFERP (parent))
{
- new->total_length = BUF_Z (XBUFFER (parent)) - 1;
- XBUFFER (parent)->intervals = new;
+ new->total_length = (BUF_Z (XBUFFER (parent))
+ - BUF_BEG (XBUFFER (parent)));
+ 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;
}
/* Merge the properties of interval SOURCE into the properties
- of interval TARGET. */
+ of interval TARGET. That is to say, each property in SOURCE
+ is added to TARGET if TARGET has no such property as yet. */
static void
merge_properties (source, target)
}
/* Return 1 if the two intervals have the same properties,
- 0 otherwise. */
+ 0 otherwise. */
int
intervals_equal (i0, i1)
if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
return 1;
+ if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
+ return 0;
+
i1_len = XFASTINT (Flength (i1->plist));
if (i1_len & 0x1) /* Paranoia -- plists are always even */
abort ();
i0_cdr = i0->plist;
while (!NILP (i0_cdr))
{
- /* Lengths of the two plists were unequal */
+ /* Lengths of the two plists were unequal. */
if (i1_len == 0)
return 0;
i0_sym = Fcar (i0_cdr);
i1_val = Fmemq (i0_sym, i1->plist);
- /* i0 has something i1 doesn't */
+ /* i0 has something i1 doesn't. */
if (EQ (i1_val, Qnil))
return 0;
- /* i0 and i1 both have sym, but it has different values in each */
+ /* i0 and i1 both have sym, but it has different values in each. */
i0_cdr = Fcdr (i0_cdr);
- if (! Fequal (i1_val, Fcar (i0_cdr)))
+ if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
return 0;
i0_cdr = Fcdr (i0_cdr);
i1_len--;
}
- /* Lengths of the two plists were unequal */
+ /* Lengths of the two plists were unequal. */
if (i1_len > 0)
return 0;
static int idepth;
static int zero_length;
-static int depth;
-
/* Traverse an interval tree TREE, performing FUNCTION on each node.
-
- Perhaps we should pass the depth as an argument. */
+ Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals (tree, position, function)
+traverse_intervals (tree, position, depth, function, arg)
INTERVAL tree;
- int position;
+ int position, depth;
void (* function) ();
+ Lisp_Object arg;
{
if (NULL_INTERVAL_P (tree))
return;
- depth++;
- traverse_intervals (tree->left, position, function);
+ traverse_intervals (tree->left, position, depth + 1, function, arg);
position += LEFT_TOTAL_LENGTH (tree);
tree->position = position;
- (*function) (tree);
+ (*function) (tree, arg);
position += LENGTH (tree);
- traverse_intervals (tree->right, position, function);
- depth--;
+ traverse_intervals (tree->right, position, depth + 1, function, arg);
}
\f
#if 0
-/* These functions are temporary, for debugging purposes only. */
+/* These functions are temporary, for debugging purposes only. */
INTERVAL search_interval, found_interval;
icount = 0;
search_interval = i;
found_interval = NULL_INTERVAL;
- traverse_intervals (tree, 1, &check_for_interval);
+ traverse_intervals (tree, 1, 0, &check_for_interval, Qnil);
return found_interval;
}
icount = 0;
idepth = 0;
zero_length = 0;
- traverse_intervals (i, 1, &inc_interval_count);
+ traverse_intervals (i, 1, 0, &inc_interval_count, Qnil);
return icount;
}
{
INTERVAL i;
INTERVAL B = interval->left;
- int len = LENGTH (interval);
+ int old_total = interval->total_length;
- /* Deal with any Parent of A; make it point to B. */
+ /* Deal with any Parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
if (AM_LEFT_CHILD (interval))
- interval->parent->left = interval->left;
+ interval->parent->left = B;
else
- interval->parent->right = interval->left;
- interval->left->parent = interval->parent;
+ interval->parent->right = B;
+ B->parent = interval->parent;
- /* B gets the same length as A, since it get A's position in the tree. */
- interval->left->total_length = interval->total_length;
-
- /* B becomes the parent of A. */
- i = interval->left->right;
- interval->left->right = interval;
- interval->parent = interval->left;
+ /* Make B the parent of A */
+ i = B->right;
+ B->right = interval;
+ interval->parent = B;
- /* A gets c as left child. */
+ /* Make A point to c */
interval->left = i;
if (! NULL_INTERVAL_P (i))
i->parent = interval;
- interval->total_length = (len + LEFT_TOTAL_LENGTH (interval)
- + RIGHT_TOTAL_LENGTH (interval));
+
+ /* A's total length is decreased by the length of B and its left child. */
+ interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
+
+ /* B must have the same total length of A. */
+ B->total_length = old_total;
return B;
}
-\f
+
/* Assuming that a right child exists, perform the following operation:
A B
{
INTERVAL i;
INTERVAL B = interval->right;
- int len = LENGTH (interval);
+ int old_total = interval->total_length;
- /* Deal with the parent of A. */
+ /* Deal with any parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
if (AM_LEFT_CHILD (interval))
- interval->parent->left = interval->right;
+ interval->parent->left = B;
else
- interval->parent->right = interval->right;
- interval->right->parent = interval->parent;
-
- /* B must have the same total length of A. */
- interval->right->total_length = interval->total_length;
+ interval->parent->right = B;
+ B->parent = interval->parent;
/* Make B the parent of A */
- i = interval->right->left;
- interval->right->left = interval;
- interval->parent = interval->right;
+ i = B->left;
+ B->left = interval;
+ interval->parent = B;
/* Make A point to c */
interval->right = i;
if (! NULL_INTERVAL_P (i))
i->parent = interval;
- interval->total_length = (len + LEFT_TOTAL_LENGTH (interval)
- + RIGHT_TOTAL_LENGTH (interval));
+
+ /* A's total length is decreased by the length of B and its right child. */
+ interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
+
+ /* B must have the same total length of A. */
+ B->total_length = old_total;
return B;
}
\f
-/* Split an interval into two. The second (RIGHT) half is returned as
- the new interval. The size and position of the interval being split are
- stored within it, having been found by find_interval (). The properties
- are reset; it is up to the caller to do the right thing.
+/* Balance an interval tree with the assumption that the subtrees
+ themselves are already balanced. */
+
+static INTERVAL
+balance_an_interval (i)
+ INTERVAL i;
+{
+ register int old_diff, new_diff;
+
+ while (1)
+ {
+ old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
+ if (old_diff > 0)
+ {
+ new_diff = i->total_length - i->left->total_length
+ + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
+ if (abs (new_diff) >= old_diff)
+ break;
+ i = rotate_right (i);
+ balance_an_interval (i->right);
+ }
+ else if (old_diff < 0)
+ {
+ new_diff = i->total_length - i->right->total_length
+ + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
+ if (abs (new_diff) >= -old_diff)
+ break;
+ i = rotate_left (i);
+ balance_an_interval (i->left);
+ }
+ else
+ break;
+ }
+ return i;
+}
+
+/* Balance INTERVAL, potentially stuffing it back into its parent
+ Lisp Object. */
+
+static INLINE INTERVAL
+balance_possible_root_interval (interval)
+ register INTERVAL interval;
+{
+ Lisp_Object parent;
+
+ if (interval->parent == NULL_INTERVAL)
+ return interval;
+
+ parent = (Lisp_Object) (interval->parent);
+ interval = balance_an_interval (interval);
+
+ if (BUFFERP (parent))
+ BUF_INTERVALS (XBUFFER (parent)) = interval;
+ else if (STRINGP (parent))
+ XSTRING (parent)->intervals = interval;
+
+ return interval;
+}
+
+/* Balance the interval tree TREE. Balancing is by weight
+ (the amount of text). */
+
+static INTERVAL
+balance_intervals_internal (tree)
+ register INTERVAL tree;
+{
+ /* Balance within each side. */
+ if (tree->left)
+ balance_intervals (tree->left);
+ if (tree->right)
+ balance_intervals (tree->right);
+ return balance_an_interval (tree);
+}
+
+/* Advertised interface to balance intervals. */
+
+INTERVAL
+balance_intervals (tree)
+ INTERVAL tree;
+{
+ if (tree == NULL_INTERVAL)
+ return NULL_INTERVAL;
+
+ return balance_intervals_internal (tree);
+}
+\f
+/* Split INTERVAL into two pieces, starting the second piece at
+ character position OFFSET (counting from 0), relative to INTERVAL.
+ INTERVAL becomes the left-hand piece, and the right-hand piece
+ (second, lexicographically) is returned.
+
+ The size and position fields of the two intervals are set based upon
+ those of the original interval. The property list of the new interval
+ is reset, thus it is up to the caller to do the right thing with the
+ result.
Note that this does not change the position of INTERVAL; if it is a root,
- it is still a root after this operation. */
+ it is still a root after this operation. */
INTERVAL
-split_interval_right (interval, relative_position)
+split_interval_right (interval, offset)
INTERVAL interval;
- int relative_position;
+ int offset;
{
INTERVAL new = make_interval ();
int position = interval->position;
- int new_length = LENGTH (interval) - relative_position + 1;
+ int new_length = LENGTH (interval) - offset;
- new->position = position + relative_position - 1;
+ new->position = position + offset;
new->parent = interval;
-#if 0
- copy_properties (interval, new);
-#endif
- if (LEAF_INTERVAL_P (interval) || NULL_RIGHT_CHILD (interval))
+ if (NULL_RIGHT_CHILD (interval))
{
interval->right = new;
new->total_length = new_length;
return new;
}
- /* Insert the new node between INTERVAL and its right child. */
+ /* Insert the new node between INTERVAL and its right child. */
new->right = interval->right;
interval->right->parent = new;
interval->right = new;
-
new->total_length = new_length + new->right->total_length;
+ balance_an_interval (new);
+ balance_possible_root_interval (interval);
+
return new;
}
-/* Split an interval into two. The first (LEFT) half is returned as
- the new interval. The size and position of the interval being split
- are stored within it, having been found by find_interval (). The
- properties are reset; it is up to the caller to do the right thing.
+/* Split INTERVAL into two pieces, starting the second piece at
+ character position OFFSET (counting from 0), relative to INTERVAL.
+ INTERVAL becomes the right-hand piece, and the left-hand piece
+ (first, lexicographically) is returned.
+
+ The size and position fields of the two intervals are set based upon
+ those of the original interval. The property list of the new interval
+ is reset, thus it is up to the caller to do the right thing with the
+ result.
- Note that this does not change the position of INTERVAL in the tree; if it
- is a root, it is still a root after this operation. */
+ Note that this does not change the position of INTERVAL; if it is a root,
+ it is still a root after this operation. */
INTERVAL
-split_interval_left (interval, relative_position)
+split_interval_left (interval, offset)
INTERVAL interval;
- int relative_position;
+ int offset;
{
INTERVAL new = make_interval ();
int position = interval->position;
- int new_length = relative_position - 1;
-
-#if 0
- copy_properties (interval, new);
-#endif
+ int new_length = offset;
new->position = interval->position;
-
- interval->position = interval->position + relative_position - 1;
+ interval->position = interval->position + offset;
new->parent = interval;
if (NULL_LEFT_CHILD (interval))
return new;
}
- /* Insert the new node between INTERVAL and its left child. */
+ /* Insert the new node between INTERVAL and its left child. */
new->left = interval->left;
new->left->parent = new;
interval->left = new;
- new->total_length = LENGTH (new) + LEFT_TOTAL_LENGTH (new);
+ new->total_length = new_length + new->left->total_length;
+
+ balance_an_interval (new);
+ balance_possible_root_interval (interval);
return new;
}
\f
-/* Find the interval containing POSITION in TREE. POSITION is relative
- to the start of TREE. */
+/* Find the interval containing text position POSITION in the text
+ represented by the interval tree TREE. POSITION is a buffer
+ position; the earliest position is 1. If POSITION is at the end of
+ the buffer, return the interval containing the last character.
-INTERVAL
+ The `position' field, which is a cache of an interval's position,
+ 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
find_interval (tree, position)
register INTERVAL tree;
register int position;
{
- register int relative_position = position;
+ /* The distance from the left edge of the subtree at TREE
+ to POSITION. */
+ register int relative_position = position - BEG;
if (NULL_INTERVAL_P (tree))
return NULL_INTERVAL;
- if (position > TOTAL_LENGTH (tree))
+ if (relative_position > TOTAL_LENGTH (tree))
abort (); /* Paranoia */
-#if 0
- position = TOTAL_LENGTH (tree);
-#endif
+
+ tree = balance_possible_root_interval (tree);
while (1)
{
- if (relative_position <= LEFT_TOTAL_LENGTH (tree))
+ if (relative_position < LEFT_TOTAL_LENGTH (tree))
{
tree = tree->left;
}
- else if (relative_position > (TOTAL_LENGTH (tree)
- - RIGHT_TOTAL_LENGTH (tree)))
+ else if (! NULL_RIGHT_CHILD (tree)
+ && relative_position >= (TOTAL_LENGTH (tree)
+ - RIGHT_TOTAL_LENGTH (tree)))
{
relative_position -= (TOTAL_LENGTH (tree)
- RIGHT_TOTAL_LENGTH (tree));
}
else
{
- tree->position = LEFT_TOTAL_LENGTH (tree)
- + position - relative_position + 1;
+ tree->position =
+ (position - relative_position /* the left edge of *tree */
+ + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
+
return tree;
}
}
}
\f
/* Find the succeeding interval (lexicographically) to INTERVAL.
- Sets the `position' field based on that of INTERVAL.
-
- Note that those values are only correct if they were also correct
- in INTERVAL. */
+ Sets the `position' field based on that of INTERVAL (see
+ find_interval). */
INTERVAL
next_interval (interval)
}
/* Find the preceding interval (lexicographically) to INTERVAL.
- Sets the `position' field based on that of INTERVAL.
-
- Note that those values are only correct if they were also correct
- in INTERVAL. */
+ Sets the `position' field based on that of INTERVAL (see
+ find_interval). */
INTERVAL
previous_interval (interval)
return NULL_INTERVAL;
}
\f
+#if 0
/* Traverse a path down the interval tree TREE to the interval
containing POSITION, adjusting all nodes on the path for
an addition of LENGTH characters. Insertion between two intervals
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
- to the root. */
+ and check the hungry bits of both. Then add the length going back up
+ to the root. */
static INTERVAL
adjust_intervals_for_insertion (tree, position, length)
else
{
/* If we are to use zero-length intervals as buffer pointers,
- then this code will have to change. */
+ then this code will have to change. */
this->total_length += length;
this->position = LEFT_TOTAL_LENGTH (this)
+ position - relative_position + 1;
}
}
}
-\f
-/* Merge interval I with its lexicographic successor. Note that
- this does not deal with the properties, or delete I. */
+#endif
-INTERVAL
-merge_interval_right (i)
- register INTERVAL i;
+/* Effect an adjustment corresponding to the addition of LENGTH characters
+ of text. Do this by finding the interval containing POSITION in the
+ interval tree TREE, and then adjusting all of its ancestors by adding
+ LENGTH to them.
+
+ If POSITION is the first character of an interval, meaning that point
+ is actually between the two intervals, make the new text belong to
+ the interval which is "sticky".
+
+ If both intervals are "sticky", then make them belong to the left-most
+ interval. Another possibility would be to create a new interval for
+ this text, and make it have the merged properties of both ends. */
+
+static INTERVAL
+adjust_intervals_for_insertion (tree, position, length)
+ INTERVAL tree;
+ int position, length;
{
- register int absorb = LENGTH (i);
+ register INTERVAL i;
+ register INTERVAL temp;
+ int eobp = 0;
+
+ if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
+ abort ();
- /* Zero out this interval. */
- i->total_length -= absorb;
+ /* If inserting at point-max of a buffer, that position will be out
+ of range. Remember that buffer positions are 1-based. */
+ if (position >= BEG + TOTAL_LENGTH (tree)){
+ position = BEG + TOTAL_LENGTH (tree);
+ eobp = 1;
+ }
+
+ i = find_interval (tree, position);
+
+ /* If in middle of an interval which is not sticky either way,
+ we must not just give its properties to the insertion.
+ So split this interval at the insertion point. */
+ if (! (position == i->position || eobp)
+ && END_NONSTICKY_P (i)
+ && ! FRONT_STICKY_P (i))
+ {
+ temp = split_interval_right (i, position - i->position);
+ copy_properties (i, temp);
+ i = temp;
+ }
- /* Find the succeeding interval. */
- if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
- as we descend. */
+ /* If we are positioned between intervals, check the stickiness of
+ both of them. We have to do this too, if we are at BEG or Z. */
+ if (position == i->position || eobp)
{
- i = i->right;
- while (! NULL_LEFT_CHILD (i))
+ register INTERVAL prev;
+
+ if (position == BEG)
+ prev = 0;
+ else if (eobp)
{
- i->total_length += absorb;
- i = i->left;
+ prev = i;
+ i = 0;
}
+ else
+ prev = previous_interval (i);
- i->total_length += absorb;
- return i;
+ /* 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 stickiness demands it. */
+ for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
+ {
+ temp->total_length += length;
+ temp = balance_possible_root_interval (temp);
+ }
+
+ /* If at least one interval has sticky properties,
+ we check the stickiness property by property. */
+ if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
+ {
+ Lisp_Object pleft, pright;
+ struct interval newi;
+
+ pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
+ pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
+ newi.plist = merge_properties_sticky (pleft, pright);
+
+ if(! prev) /* i.e. position == BEG */
+ {
+ if (! intervals_equal (i, &newi))
+ {
+ i = split_interval_left (i, length);
+ i->plist = newi.plist;
+ }
+ }
+ else if (! intervals_equal (prev, &newi))
+ {
+ prev = split_interval_right (prev,
+ position - prev->position);
+ prev->plist = newi.plist;
+ if (! NULL_INTERVAL_P (i)
+ && intervals_equal (prev, i))
+ merge_interval_right (prev);
+ }
+
+ /* We will need to update the cache here later. */
+ }
+ else if (! prev && ! NILP (i->plist))
+ {
+ /* Just split off a new interval at the left.
+ Since I wasn't front-sticky, the empty plist is ok. */
+ i = split_interval_left (i, length);
+ }
}
- while (! NULL_PARENT (i)) /* It's above us. Subtract as
- we ascend. */
+ /* Otherwise just extend the interval. */
+ else
{
- if (AM_LEFT_CHILD (i))
+ for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent)
{
- i = i->parent;
- return i;
+ temp->total_length += length;
+ temp = balance_possible_root_interval (temp);
}
-
- i = i->parent;
- i->total_length -= absorb;
}
-
- return NULL_INTERVAL;
+
+ return tree;
}
-\f
-/* Merge interval I with its lexicographic predecessor. Note that
- this does not deal with the properties, or delete I.*/
-INTERVAL
-merge_interval_left (i)
- register INTERVAL i;
+/* Any property might be front-sticky on the left, rear-sticky on the left,
+ front-sticky on the right, or rear-sticky on the right; the 16 combinations
+ can be arranged in a matrix with rows denoting the left conditions and
+ columns denoting the right conditions:
+ _ __ _
+_ FR FR FR FR
+FR__ 0 1 2 3
+ _FR 4 5 6 7
+FR 8 9 A B
+ FR C D E F
+
+ left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
+ rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
+ p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
+ p8 L p9 L pa L pb L pc L pd L pe L pf L)
+ right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
+ rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
+ p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
+ p8 R p9 R pa R pb R pc R pd R pe R pf R)
+
+ We inherit from whoever has a sticky side facing us. If both sides
+ do (cases 2, 3, E, and F), then we inherit from whichever side has a
+ non-nil value for the current property. If both sides do, then we take
+ from the left.
+
+ When we inherit a property, we get its stickiness as well as its value.
+ So, when we merge the above two lists, we expect to get this:
+
+ result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
+ rear-nonsticky (p6 pa)
+ p0 L p1 L p2 L p3 L p6 R p7 R
+ pa R pb R pc L pd L pe L pf L)
+
+ The optimizable special cases are:
+ left rear-nonsticky = nil, right front-sticky = nil (inherit left)
+ left rear-nonsticky = t, right front-sticky = t (inherit right)
+ left rear-nonsticky = t, right front-sticky = nil (inherit none)
+*/
+
+Lisp_Object
+merge_properties_sticky (pleft, pright)
+ Lisp_Object pleft, pright;
{
- register int absorb = LENGTH (i);
+ register Lisp_Object props, front, rear;
+ Lisp_Object lfront, lrear, rfront, rrear;
+ register Lisp_Object tail1, tail2, sym, lval, rval;
+ int use_left, use_right;
+
+ props = Qnil;
+ front = Qnil;
+ rear = Qnil;
+ lfront = textget (pleft, Qfront_sticky);
+ lrear = textget (pleft, Qrear_nonsticky);
+ rfront = textget (pright, Qfront_sticky);
+ rrear = textget (pright, Qrear_nonsticky);
+
+ /* Go through each element of PRIGHT. */
+ for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+ {
+ sym = Fcar (tail1);
- /* Zero out this interval. */
- i->total_length -= absorb;
+ /* Sticky properties get special treatment. */
+ if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
+ continue;
- /* Find the preceding interval. */
- if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
- adding ABSORB as we go. */
- {
- i = i->left;
- while (! NULL_RIGHT_CHILD (i))
+ rval = Fcar (Fcdr (tail1));
+ 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);
+ use_right = TMEM (sym, rfront);
+ if (use_left && use_right)
{
- i->total_length += absorb;
- i = i->right;
+ use_left = ! NILP (lval);
+ use_right = ! NILP (rval);
+ }
+ 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));
+ if (TMEM (sym, lfront))
+ front = Fcons (sym, front);
+ if (TMEM (sym, lrear))
+ rear = Fcons (sym, rear);
+ }
+ else if (use_right)
+ {
+ if (! NILP (rval))
+ props = Fcons (rval, Fcons (sym, props));
+ if (TMEM (sym, rfront))
+ front = Fcons (sym, front);
+ if (TMEM (sym, rrear))
+ rear = Fcons (sym, rear);
}
-
- i->total_length += absorb;
- return i;
}
- while (! NULL_PARENT (i)) /* It's above us. Go up,
- subtracting ABSORB. */
+ /* Now go through each element of PLEFT. */
+ for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
{
- if (AM_RIGHT_CHILD (i))
+ sym = Fcar (tail2);
+
+ /* Sticky properties get special treatment. */
+ if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
+ continue;
+
+ /* If sym is in PRIGHT, we've already considered it. */
+ for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+ if (EQ (sym, Fcar (tail1)))
+ break;
+ if (! NILP (tail1))
+ continue;
+
+ lval = Fcar (Fcdr (tail2));
+
+ /* Since rval is known to be nil in this loop, the test simplifies. */
+ if (! TMEM (sym, lrear))
{
- i = i->parent;
- return i;
+ if (! NILP (lval))
+ props = Fcons (lval, Fcons (sym, props));
+ if (TMEM (sym, lfront))
+ front = Fcons (sym, front);
+ }
+ else if (TMEM (sym, rfront))
+ {
+ /* The value is nil, but we still inherit the stickiness
+ from the right. */
+ front = Fcons (sym, front);
+ if (TMEM (sym, rrear))
+ rear = Fcons (sym, rear);
}
-
- i = i->parent;
- i->total_length -= absorb;
}
-
- return NULL_INTERVAL;
+ props = Fnreverse (props);
+ if (! NILP (rear))
+ props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
+ if (! NILP (front))
+ props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
+ return props;
}
+
\f
-/* Delete an interval node from its btree by merging its subtrees
- into one subtree which is returned. Caller is responsible for
- storing the resulting subtree into its parent. */
+/* Delete an node I from its interval tree by merging its subtrees
+ into one subtree which is then returned. Caller is responsible for
+ storing the resulting subtree into its parent. */
static INTERVAL
delete_node (i)
and properly connecting the resultant subtree.
I is presumed to be empty; that is, no adjustments are made
- for the length of I. */
+ for the length of I. */
void
delete_interval (i)
register INTERVAL parent;
int amt = LENGTH (i);
- if (amt > 0) /* Only used on zero-length intervals now. */
+ if (amt > 0) /* Only used on zero-length intervals now. */
abort ();
if (ROOT_INTERVAL_P (i))
{
- Lisp_Object owner = (Lisp_Object) i->parent;
+ Lisp_Object owner;
+ owner = (Lisp_Object) i->parent;
parent = delete_node (i);
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 ();
}
}
\f
-/* Recurse down to the interval containing FROM. Then delete as much
- as possible (up to AMOUNT) from that interval, adjusting parental
- intervals on the way up. If an interval is zeroed out, then
- it is deleted.
+/* Find the interval in TREE corresponding to the relative position
+ FROM and delete as much as possible of AMOUNT from that interval.
+ Return the amount actually deleted, and if the interval was
+ zeroed-out, delete that interval node from the tree.
- Returns the amount deleted. */
+ Note that FROM is actually origin zero, aka relative to the
+ leftmost edge of tree. This is appropriate since we call ourselves
+ recursively on subtrees.
+
+ Do this by recursing down TREE to the interval in question, and
+ deleting the appropriate amount of text. */
static int
interval_deletion_adjustment (tree, from, amount)
return 0;
/* Left branch */
- if (relative_position <= LEFT_TOTAL_LENGTH (tree))
+ if (relative_position < LEFT_TOTAL_LENGTH (tree))
{
int subtract = interval_deletion_adjustment (tree->left,
relative_position,
return subtract;
}
/* Right branch */
- else if (relative_position > (TOTAL_LENGTH (tree)
- - RIGHT_TOTAL_LENGTH (tree)))
+ else if (relative_position >= (TOTAL_LENGTH (tree)
+ - RIGHT_TOTAL_LENGTH (tree)))
{
int subtract;
tree->total_length -= subtract;
return subtract;
}
- /* Here -- this node */
+ /* Here -- this node. */
else
{
- /* If this is a zero-length, marker interval, then
- we must skip it. */
-
- if (relative_position == LEFT_TOTAL_LENGTH (tree) + 1)
- {
- /* This means we're deleting from the beginning of this interval. */
- register int my_amount = LENGTH (tree);
-
- if (amount < my_amount)
- {
- tree->total_length -= amount;
- return amount;
- }
- else
- {
- tree->total_length -= my_amount;
- if (LENGTH (tree) != 0)
- abort (); /* Paranoia */
-
- delete_interval (tree);
- return my_amount;
- }
- }
- else /* Deleting starting in the middle. */
- {
- register int my_amount = ((tree->total_length
- - RIGHT_TOTAL_LENGTH (tree))
- - relative_position + 1);
-
- if (amount <= my_amount)
- {
- tree->total_length -= amount;
- return amount;
- }
- else
- {
- tree->total_length -= my_amount;
- return my_amount;
- }
- }
+ /* How much can we delete from this interval? */
+ int my_amount = ((tree->total_length
+ - RIGHT_TOTAL_LENGTH (tree))
+ - relative_position);
+
+ if (amount > my_amount)
+ amount = my_amount;
+
+ tree->total_length -= amount;
+ if (LENGTH (tree) == 0)
+ delete_interval (tree);
+
+ return amount;
}
- abort ();
+ /* Never reach here. */
}
+/* Effect the adjustments necessary to the interval tree of BUFFER to
+ correspond to the deletion of LENGTH characters from that buffer
+ text. The deletion is effected at position START (which is a
+ buffer position, i.e. origin 1). */
+
static void
adjust_intervals_for_deletion (buffer, start, length)
struct buffer *buffer;
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))
return;
+ if (start > BEG + TOTAL_LENGTH (tree)
+ || start + length > BEG + TOTAL_LENGTH (tree))
+ abort ();
+
if (length == TOTAL_LENGTH (tree))
{
- buffer->intervals = NULL_INTERVAL;
+ BUF_INTERVALS (buffer) = NULL_INTERVAL;
return;
}
return;
}
- if (start > TOTAL_LENGTH (tree))
- start = TOTAL_LENGTH (tree);
+ if (start > BEG + TOTAL_LENGTH (tree))
+ start = BEG + TOTAL_LENGTH (tree);
while (left_to_delete > 0)
{
- left_to_delete -= interval_deletion_adjustment (tree, start,
+ 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;
}
}
}
\f
-/* Note that all intervals in OBJECT after START have slid by LENGTH. */
+/* Make the adjustments necessary to the interval tree of BUFFER to
+ represent an addition or deletion of LENGTH characters starting
+ at position START. Addition or deletion is indicated by the sign
+ of LENGTH. */
INLINE void
offset_intervals (buffer, start, length)
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);
}
+\f
+/* Merge interval I with its lexicographic successor. The resulting
+ interval is returned, and has the properties of the original
+ successor. The properties of I are lost. I is removed from the
+ interval tree.
+
+ IMPORTANT:
+ The caller must verify that this is not the last (rightmost)
+ interval. */
+
+INTERVAL
+merge_interval_right (i)
+ register INTERVAL i;
+{
+ register int absorb = LENGTH (i);
+ register INTERVAL successor;
+
+ /* Zero out this interval. */
+ i->total_length -= absorb;
+
+ /* Find the succeeding interval. */
+ if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
+ as we descend. */
+ {
+ successor = i->right;
+ while (! NULL_LEFT_CHILD (successor))
+ {
+ successor->total_length += absorb;
+ successor = successor->left;
+ }
+
+ successor->total_length += absorb;
+ delete_interval (i);
+ return successor;
+ }
+
+ successor = i;
+ while (! NULL_PARENT (successor)) /* It's above us. Subtract as
+ we ascend. */
+ {
+ if (AM_LEFT_CHILD (successor))
+ {
+ successor = successor->parent;
+ delete_interval (i);
+ return successor;
+ }
+
+ successor = successor->parent;
+ successor->total_length -= absorb;
+ }
+
+ /* This must be the rightmost or last interval and cannot
+ be merged right. The caller should have known. */
+ abort ();
+}
+\f
+/* Merge interval I with its lexicographic predecessor. The resulting
+ interval is returned, and has the properties of the original predecessor.
+ The properties of I are lost. Interval node I is removed from the tree.
+
+ IMPORTANT:
+ The caller must verify that this is not the first (leftmost) interval. */
+
+INTERVAL
+merge_interval_left (i)
+ register INTERVAL i;
+{
+ register int absorb = LENGTH (i);
+ register INTERVAL predecessor;
+
+ /* Zero out this interval. */
+ i->total_length -= absorb;
+
+ /* Find the preceding interval. */
+ if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
+ adding ABSORB as we go. */
+ {
+ predecessor = i->left;
+ while (! NULL_RIGHT_CHILD (predecessor))
+ {
+ predecessor->total_length += absorb;
+ predecessor = predecessor->right;
+ }
+
+ predecessor->total_length += absorb;
+ delete_interval (i);
+ return predecessor;
+ }
+
+ predecessor = i;
+ while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
+ subtracting ABSORB. */
+ {
+ if (AM_RIGHT_CHILD (predecessor))
+ {
+ predecessor = predecessor->parent;
+ delete_interval (i);
+ return predecessor;
+ }
+
+ predecessor = predecessor->parent;
+ predecessor->total_length -= absorb;
+ }
+
+ /* This must be the leftmost or first interval and cannot
+ be merged left. The caller should have known. */
+ abort ();
+}
+\f
+/* Make an exact copy of interval tree SOURCE which descends from
+ PARENT. This is done by recursing through SOURCE, copying
+ the current interval and its properties, and then adjusting
+ the pointers of the copy. */
static INTERVAL
reproduce_tree (source, parent)
return t;
}
+#if 0
+/* Nobody calls this. Perhaps it's a vestige of an earlier design. */
+
+/* Make a new interval of length LENGTH starting at START in the
+ group of intervals INTERVALS, which is actually an interval tree.
+ Returns the new interval.
+
+ Generate an error if the new positions would overlap an existing
+ interval. */
+
static INTERVAL
make_new_interval (intervals, start, length)
INTERVAL intervals;
if (slot->position == start)
{
- /* New right node. */
- split_interval_right (slot, length + 1);
+ /* New right node. */
+ split_interval_right (slot, length);
return slot;
}
if (slot->position + LENGTH (slot) == start + length)
{
- /* New left node. */
- split_interval_left (slot, LENGTH (slot) - length + 1);
+ /* New left node. */
+ split_interval_left (slot, LENGTH (slot) - length);
return slot;
}
- /* Convert interval SLOT into three intervals. */
- split_interval_left (slot, start - slot->position + 1);
- split_interval_right (slot, length + 1);
+ /* Convert interval SLOT into three intervals. */
+ split_interval_left (slot, start - slot->position);
+ split_interval_right (slot, length);
return slot;
}
+#endif
+\f
+/* Insert the intervals of SOURCE into BUFFER at POSITION.
+ LENGTH is the length of the text in SOURCE.
-void
-map_intervals (source, destination, position)
- INTERVAL source, destination;
- int position;
-{
- register INTERVAL i, t;
-
- if (NULL_INTERVAL_P (source))
- return;
- i = find_interval (destination, position);
- if (NULL_INTERVAL_P (i))
- return;
-
- t = find_interval (source, 1);
- while (! NULL_INTERVAL_P (t))
- {
- i = make_new_interval (destination, position, LENGTH (t));
- position += LENGTH (t);
- copy_properties (t, i);
- t = next_interval (t);
- }
-}
-
-/* Insert the intervals of NEW_TREE into BUFFER at POSITION.
-
- This is used in insdel.c when inserting Lisp_Strings into
- the buffer. The text corresponding to NEW_TREE is already in
- the buffer when this is called. The intervals of new tree are
- those belonging to the string being inserted; a copy is not made.
+ This is used in insdel.c when inserting Lisp_Strings into the
+ buffer. The text corresponding to SOURCE is already in the buffer
+ when this is called. The intervals of new tree are a copy of those
+ belonging to the string being inserted; intervals are never
+ shared.
- If the inserted text had no intervals associated, this function
+ If the inserted text had no intervals associated, and we don't
+ want to inherit the surrounding text's properties, this function
simply returns -- offset_intervals should handle placing the
- text in the correct interval, depending on the hungry bits.
+ text in the correct interval, depending on the sticky bits.
If the inserted text had properties (intervals), then there are two
cases -- either insertion happened in the middle of some interval,
of the text into which it was inserted.
If the text goes between two intervals, then if neither interval
- had its appropriate hungry property set (front_hungry, rear_hungry),
- the new text has only its properties. If one of the hungry properties
+ had its appropriate sticky property set (front_sticky, rear_sticky),
+ the new text has only its properties. If one of the sticky properties
is set, then the new text "sticks" to that region and its properties
- depend on merging as above. If both the preceding and succeding
- intervals to the new text are "hungry", then the new text retains
- only its properties, as if neither hungry property were set. Perhaps
+ depend on merging as above. If both the preceding and succeeding
+ intervals to the new text are "sticky", then the new text retains
+ only its properties, as if neither sticky property were set. Perhaps
we should consider merging all three sets of properties onto the new
- text... */
+ text... */
void
-graft_intervals_into_buffer (new_tree, position, b)
- INTERVAL new_tree;
- int position;
- struct buffer *b;
+graft_intervals_into_buffer (source, position, length, buffer, inherit)
+ INTERVAL source;
+ int position, length;
+ struct buffer *buffer;
+ int inherit;
{
- register INTERVAL under, over, this;
- register INTERVAL tree = b->intervals;
+ register INTERVAL under, over, this, prev;
+ register INTERVAL tree;
+ int middle;
- /* If the new text has no properties, it becomes part of whatever
- interval it was inserted into. */
- if (NULL_INTERVAL_P (new_tree))
- return;
+ tree = BUF_INTERVALS (buffer);
- /* Paranoia -- the text has already been added, so this buffer
- should be of non-zero length. */
- if (TOTAL_LENGTH (tree) == 0)
- abort ();
+ /* 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))
+ {
+ XSETBUFFER (buf, buffer);
+ Fset_text_properties (make_number (position),
+ make_number (position + length),
+ Qnil, buf);
+ }
+ if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
+ return;
+ }
if (NULL_INTERVAL_P (tree))
{
/* The inserted text constitutes the whole buffer, so
- simply copy over the interval structure. */
- if (BUF_Z (b) == TOTAL_LENGTH (new_tree))
+ simply copy over the interval structure. */
+ if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
{
- b->intervals = reproduce_tree (new_tree, tree->parent);
- /* Explicitly free the old tree here. */
+ Lisp_Object buf;
+ XSETBUFFER (buf, buffer);
+ BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
+ /* Explicitly free the old tree here. */
return;
}
/* Create an interval tree in which to place a copy
- of the intervals of the inserted string. */
+ of the intervals of the inserted string. */
{
- Lisp_Object buffer;
- XSET (buffer, Lisp_Buffer, b);
- create_root_interval (buffer);
+ Lisp_Object buf;
+ XSETBUFFER (buf, buffer);
+ tree = create_root_interval (buf);
}
}
- else
- if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (new_tree))
-
+ else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
/* If the buffer contains only the new string, but
there was already some interval tree there, then it may be
some zero length intervals. Eventually, do something clever
- about inserting properly. For now, just waste the old intervals. */
+ about inserting properly. For now, just waste the old intervals. */
{
- b->intervals = reproduce_tree (new_tree, tree->parent);
- /* Explicitly free the old tree here. */
+ BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
+ /* Explicitly free the old tree here. */
return;
}
+ /* Paranoia -- the text has already been added, so this buffer
+ should be of non-zero length. */
+ else if (TOTAL_LENGTH (tree) == 0)
+ abort ();
this = under = find_interval (tree, position);
if (NULL_INTERVAL_P (under)) /* Paranoia */
abort ();
- over = find_interval (new_tree, 1);
+ over = find_interval (source, 1);
- /* Insertion between intervals */
- if (position == under->position)
- {
- /* First interval -- none precede it. */
- if (position == 1)
- {
- if (! under->front_hungry)
- /* The inserted string keeps its own properties. */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (over, this);
- over = next_interval (over);
- }
- else
- /* This string sticks to under */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (under, this);
- if (MERGE_INSERTIONS (under))
- merge_properties (over, this);
- over = next_interval (over);
- }
- }
- else
- {
- INTERVAL prev = previous_interval (under);
- if (NULL_INTERVAL_P (prev))
- abort ();
-
- if (prev->rear_hungry)
- {
- if (under->front_hungry)
- /* The intervals go inbetween as the two hungry
- properties cancel each other. Should we change
- this policy? */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (over, this);
- over = next_interval (over);
- }
- else
- /* The intervals stick to prev */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (prev, this);
- if (MERGE_INSERTIONS (prev))
- merge_properties (over, this);
- over = next_interval (over);
- }
- }
- else
- {
- if (under->front_hungry)
- /* The intervals stick to under */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (under, this);
- if (MERGE_INSERTIONS (under))
- merge_properties (over, this);
- over = next_interval (over);
- }
- else
- /* The intervals go inbetween */
- while (! NULL_INTERVAL_P (over))
- {
- position = LENGTH (over) + 1;
- this = split_interval_left (this, position);
- copy_properties (over, this);
- over = next_interval (over);
- }
- }
- }
+ /* Here for insertion in the middle of an interval.
+ Split off an equivalent interval to the right,
+ then don't bother with it any more. */
- b->intervals = balance_intervals (b->intervals);
- return;
- }
-
- /* Here for insertion in the middle of an interval. */
-
- if (TOTAL_LENGTH (new_tree) < LENGTH (this))
+ if (position > under->position)
{
INTERVAL end_unchanged
- = split_interval_right (this, TOTAL_LENGTH (new_tree) + 1);
+ = split_interval_left (this, position - under->position);
copy_properties (under, end_unchanged);
+ under->position = position;
+ prev = 0;
+ middle = 1;
}
+ else
+ {
+ prev = previous_interval (under);
+ if (prev && !END_NONSTICKY_P (prev))
+ prev = 0;
+ }
+
+ /* Insertion is now at beginning of UNDER. */
- position = position - tree->position + 1;
+ /* 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 stickiness has
+ already been taken care of. */
+
while (! NULL_INTERVAL_P (over))
{
- this = split_interval_right (under, position);
+ if (LENGTH (over) < LENGTH (under))
+ {
+ this = split_interval_left (under, LENGTH (over));
+ copy_properties (under, this);
+ }
+ else
+ this = under;
copy_properties (over, this);
- if (MERGE_INSERTIONS (under))
- merge_properties (under, this);
-
- position = LENGTH (over) + 1;
+ if (inherit)
+ merge_properties (over, this);
+ else
+ copy_properties (over, this);
over = next_interval (over);
}
- b->intervals = balance_intervals (b->intervals);
+ if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
return;
}
-/* Intervals can have properties which are hooks to call. Look for
- the property HOOK on interval I, and if found, call its value as
- a function.*/
+/* Get the value of property PROP from PLIST,
+ which is the plist of an interval.
+ We check for direct properties, for categories with property PROP,
+ and for PROP appearing on the default-text-properties list. */
-void
-run_hooks (i, hook)
- INTERVAL i;
- Lisp_Object hook;
+Lisp_Object
+textget (plist, prop)
+ Lisp_Object plist;
+ register Lisp_Object prop;
{
- register Lisp_Object tail = i->plist;
- register Lisp_Object sym, val;
+ register Lisp_Object tail, fallback;
+ fallback = Qnil;
- while (! NILP (tail))
+ for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
{
- sym = Fcar (tail);
- if (EQ (sym, hook))
+ register Lisp_Object tem;
+ tem = Fcar (tail);
+ if (EQ (prop, tem))
+ return Fcar (Fcdr (tail));
+ if (EQ (tem, Qcategory))
{
- Lisp_Object begin, end;
- XFASTINT (begin) = i->position;
- XFASTINT (end) = i->position + LENGTH (i) - 1;
- val = Fcar (Fcdr (tail));
- call2 (val, begin, end);
- return;
+ tem = Fcar (Fcdr (tail));
+ if (SYMBOLP (tem))
+ fallback = Fget (tem, prop);
}
-
- tail = Fcdr (Fcdr (tail));
}
-}
-/* Set point in BUFFER to POSITION. If the target position is in
- an invisible interval which is not displayed with a special glyph,
- skip intervals until we find one. Point may be at the first
- position of an invisible interval, if it is displayed with a
- special glyph.
+ if (! NILP (fallback))
+ return fallback;
+ if (CONSP (Vdefault_text_properties))
+ return Fplist_get (Vdefault_text_properties, prop);
+ return Qnil;
+}
- This is the only place `PT' is an lvalue in all of emacs. */
+\f
+/* Set point in BUFFER to POSITION. If the target position is
+ before an intangible character, move to an ok place. */
void
set_point (position, buffer)
register int position;
register struct buffer *buffer;
{
- register INTERVAL to, from, target;
- register int iposition = position;
+ 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 = BUF_PT (buffer);
- if (position == buffer->text.pt)
- return;
+ buffer->point_before_scroll = Qnil;
- if (NULL_INTERVAL_P (buffer->intervals))
- {
- buffer->text.pt = position;
- return;
- }
+ if (position == BUF_PT (buffer))
+ return;
- /* Perhaps we should just change `position' to the limit. */
+ /* 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))
abort ();
- /* Position Z is really one past the last char in the buffer. */
- if (position == BUF_Z (buffer))
- iposition = position - 1;
-
- to = find_interval (buffer->intervals, iposition);
- buffer_point =(BUF_PT (buffer) == BUF_Z (buffer)
- ? BUF_Z (buffer) - 1
- : BUF_PT (buffer));
- from = find_interval (buffer->intervals, buffer_point);
- if (NULL_INTERVAL_P (to) || NULL_INTERVAL_P (from))
- abort (); /* Paranoia */
-
- /* Moving within an interval */
- if (to == from && INTERVAL_VISIBLE_P (to))
+ if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
{
- buffer->text.pt = position;
+
+ BUF_PT (buffer) = position;
return;
}
- /* Here for the case of moving into another interval. */
+ /* 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->position == position)
+ toprev = previous_interval (to);
+ else
+ toprev = to;
+
+ buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
+ ? BUF_ZV (buffer) - 1
+ : BUF_PT (buffer));
+
+ /* Set FROM to the interval containing the char after PT,
+ 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 (BUF_INTERVALS (buffer), buffer_point);
+ if (buffer_point == BUF_BEGV (buffer))
+ fromprev = 0;
+ else if (from->position == BUF_PT (buffer))
+ fromprev = previous_interval (from);
+ else if (buffer_point != BUF_PT (buffer))
+ fromprev = from, from = 0;
+ else
+ fromprev = from;
- target = to;
- while (! INTERVAL_VISIBLE_P (to) && ! DISPLAY_INVISIBLE_GLYPH (to)
- && ! NULL_INTERVAL_P (to))
- to = (backwards ? previous_interval (to) : next_interval (to));
- if (NULL_INTERVAL_P (to))
- return;
+ /* Moving within an interval. */
+ if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
+ {
+ BUF_PT (buffer) = position;
+ return;
+ }
- /* Here we know we are actually moving to another interval. */
- if (INTERVAL_VISIBLE_P (to))
+ /* 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 we skipped some intervals, go to the closest point
- in the interval we've stopped at. */
- if (to != target)
- buffer->text.pt = (backwards
- ? to->position + LENGTH (to) - 1
- : to->position);
+ if (backwards)
+ {
+ 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);
+ if (NULL_INTERVAL_P (toprev))
+ position = BUF_BEGV (buffer);
+ else
+ /* This is the only line that's not
+ dual to the following loop.
+ That's because we want the position
+ at the end of TOPREV. */
+ position = to->position;
+ }
+ }
else
- buffer->text.pt = position;
+ {
+ 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);
+ if (NULL_INTERVAL_P (to))
+ position = BUF_ZV (buffer);
+ else
+ position = to->position;
+ }
+ }
}
- else
- buffer->text.pt = to->position;
-
- /* We should run point-left and point-entered hooks here, iff the
- two intervals are not equivalent. */
-}
-/* Check for read-only intervals. Call the modification hooks if any.
- Check for the range START up to (but not including) TO.
-
- First all intervals of the region are checked that they are
- modifiable, then all the modification hooks are called in
- lexicographic order. */
-
-void
-verify_interval_modification (buf, start, end)
- struct buffer *buf;
- int start, end;
-{
- register INTERVAL intervals = buf->intervals;
- register INTERVAL i;
- register Lisp_Object hooks = Qnil;
+ /* 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. */
- if (NULL_INTERVAL_P (intervals))
- return;
+ BUF_PT (buffer) = position;
- if (start > end)
+ /* We run point-left and point-entered hooks here, iff the
+ two intervals are not equivalent. These hooks take
+ (old_point, new_point) as arguments. */
+ if (NILP (Vinhibit_point_motion_hooks)
+ && (! intervals_equal (from, to)
+ || ! intervals_equal (fromprev, toprev)))
{
- int temp = start;
- start = end;
- end = temp;
- }
+ Lisp_Object leave_after, leave_before, enter_after, enter_before;
- if (start == BUF_Z (buf))
- {
- if (BUF_Z (buf) == 1)
- abort ();
+ if (fromprev)
+ leave_after = textget (fromprev->plist, Qpoint_left);
+ else
+ leave_after = Qnil;
+ if (from)
+ leave_before = textget (from->plist, Qpoint_left);
+ else
+ leave_before = Qnil;
- i = find_interval (intervals, start - 1);
- if (! END_HUNGRY_P (i))
- return;
- }
- else
- i = find_interval (intervals, start);
+ if (toprev)
+ enter_after = textget (toprev->plist, Qpoint_entered);
+ else
+ enter_after = Qnil;
+ if (to)
+ enter_before = textget (to->plist, Qpoint_entered);
+ else
+ enter_before = Qnil;
- do
- {
- register Lisp_Object mod_hook;
- if (! INTERVAL_WRITABLE_P (i))
- error ("Attempt to write in a protected interval");
- mod_hook = Fget (Qmodification, i->plist);
- if (! EQ (mod_hook, Qnil))
- hooks = Fcons (mod_hook, hooks);
- i = next_interval (i);
- }
- while (! NULL_INTERVAL_P (i) && i->position <= end);
+ if (! EQ (leave_before, enter_before) && !NILP (leave_before))
+ call2 (leave_before, old_position, position);
+ if (! EQ (leave_after, enter_after) && !NILP (leave_after))
+ call2 (leave_after, old_position, position);
- hooks = Fnreverse (hooks);
- while (! EQ (hooks, Qnil))
- call2 (Fcar (hooks), i->position, i->position + LENGTH (i) - 1);
+ if (! EQ (enter_before, leave_before) && !NILP (enter_before))
+ call2 (enter_before, old_position, position);
+ if (! EQ (enter_after, leave_after) && !NILP (enter_after))
+ call2 (enter_after, old_position, position);
+ }
}
-/* Balance an interval node if the amount of text in its left and right
- subtrees differs by more than the percentage specified by
- `interval-balance-threshold'. */
+/* Set point temporarily, without checking any text properties. */
-static INTERVAL
-balance_an_interval (i)
- INTERVAL i;
+INLINE void
+temp_set_point (position, buffer)
+ int position;
+ struct buffer *buffer;
{
- register int total_children_size = (LEFT_TOTAL_LENGTH (i)
- + RIGHT_TOTAL_LENGTH (i));
- register int threshold = (XFASTINT (interval_balance_threshold)
- * (total_children_size / 100));
-
- if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i)
- && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold)
- return rotate_right (i);
-
- if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i)
- && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold)
- return rotate_right (i);
-
-#if 0
- if (LEFT_TOTAL_LENGTH (i) >
- (RIGHT_TOTAL_LENGTH (i) + XINT (interval_balance_threshold)))
- return rotate_right (i);
-
- if (RIGHT_TOTAL_LENGTH (i) >
- (LEFT_TOTAL_LENGTH (i) + XINT (interval_balance_threshold)))
- return rotate_left (i);
-#endif
-
- return i;
+ BUF_PT (buffer) = position;
}
+\f
+/* Return the proper local map for position POSITION in BUFFER.
+ Use the map specified by the local-map property, if any.
+ Otherwise, use BUFFER's local map. */
-/* Balance the interval tree TREE. Balancing is by weight
- (the amount of text). */
-
-INTERVAL
-balance_intervals (tree)
- register INTERVAL tree;
+Lisp_Object
+get_local_map (position, buffer)
+ register int position;
+ register struct buffer *buffer;
{
- register INTERVAL new_tree;
-
- if (NULL_INTERVAL_P (tree))
- return NULL_INTERVAL;
+ Lisp_Object prop, tem, lispy_position, lispy_buffer;
+ int old_begv, old_zv;
- new_tree = tree;
- do
- {
- tree = new_tree;
- new_tree = balance_an_interval (new_tree);
- }
- while (new_tree != tree);
+ /* Perhaps we should just change `position' to the limit. */
+ if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
+ abort ();
- return new_tree;
+ /* 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. */
+ if (!NILP (prop)
+ && (tem = Fkeymapp (prop), !NILP (tem)))
+ return prop;
+
+ return buffer->keymap;
}
+\f
+/* Produce an interval tree reflecting the intervals in
+ TREE from START to START + LENGTH. */
-/* Produce an interval tree reflecting the interval structure in
- TREE from START to START + LENGTH. */
-
-static INTERVAL
+INTERVAL
copy_intervals (tree, start, length)
INTERVAL tree;
int start, length;
{
register INTERVAL i, new, t;
- register int got;
+ register int got, prevlen;
if (NULL_INTERVAL_P (tree) || length <= 0)
return NULL_INTERVAL;
if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
abort ();
- /* If there is only one interval and it's the default, return nil. */
+ /* If there is only one interval and it's the default, return nil. */
if ((start - i->position + 1 + length) < LENGTH (i)
&& DEFAULT_INTERVAL_P (i))
return NULL_INTERVAL;
new = make_interval ();
new->position = 1;
got = (LENGTH (i) - (start - i->position));
- new->total_length = got;
+ new->total_length = length;
copy_properties (i, new);
t = new;
+ prevlen = got;
while (got < length)
{
i = next_interval (i);
- t->right = make_interval ();
- t->right->parent = t;
- t->right->position = t->position + got - 1;
-
- t = t->right;
- t->total_length = length - got;
+ t = split_interval_right (t, prevlen);
copy_properties (i, t);
- got += LENGTH (i);
+ prevlen = LENGTH (i);
+ got += prevlen;
}
- if (got > length)
- t->total_length -= (got - length);
-
- return balance_intervals (new);
+ return balance_an_interval (new);
}
-/* Give buffer SINK the properties of buffer SOURCE from POSITION
- to END. The properties are attached to SINK starting at position AT.
-
- No range checking is done. */
+/* Give STRING the properties of BUFFER from POSITION to LENGTH. */
-void
-insert_interval_copy (source, position, end, sink, at)
- struct buffer *source, *sink;
- register int position, end, at;
-{
- INTERVAL interval_copy = copy_intervals (source->intervals,
- position, end - position);
- graft_intervals_into_buffer (interval_copy, at, sink);
-}
-
-/* Give STRING the properties of BUFFER from POSITION to LENGTH. */
-
-void
+INLINE void
copy_intervals_to_string (string, buffer, position, 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. */
-INTERVAL
-make_string_interval (string, start, length)
- struct Lisp_String *string;
- int start, length;
+int
+compare_string_intervals (s1, s2)
+ Lisp_Object s1, s2;
{
- if (start < 1 || start > string->size)
- error ("Interval index out of range");
- if (length < 1 || length > string->size - start + 1)
- error ("Interval won't fit");
+ INTERVAL i1, i2;
+ int pos = 1;
+ int end = XSTRING (s1)->size + 1;
- if (length == 0)
- return NULL_INTERVAL;
+ /* 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);
- return make_new_interval (string->intervals, start, length);
-}
-
-/* Create an interval of length LENGTH in buffer BUF at position START. */
-
-INTERVAL
-make_buffer_interval (buf, start, length)
- struct buffer *buf;
- int start, length;
-{
- if (start < BUF_BEG (buf) || start > BUF_Z (buf))
- error ("Interval index out of range");
- if (length < 1 || length > BUF_Z (buf) - start)
- error ("Interval won't fit");
-
- if (length == 0)
- return NULL_INTERVAL;
+ 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;
- return make_new_interval (buf->intervals, start, length);
+ /* 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 */