/* Code for doing intervals.
- Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002, 2003 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 "buffer.h"
#include "puresize.h"
#include "keyboard.h"
-
-/* The rest of the file is within this conditional. */
-#ifdef USE_TEXT_PROPERTIES
+#include "keymap.h"
/* 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 ();
+static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
+static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
\f
/* Utility functions for intervals. */
{
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
+ CHECK_TOTAL_LENGTH (new);
BUF_INTERVALS (XBUFFER (parent)) = new;
+ new->position = BEG;
}
else if (STRINGP (parent))
{
- new->total_length = XSTRING (parent)->size;
- XSTRING (parent)->intervals = new;
+ new->total_length = SCHARS (parent);
+ CHECK_TOTAL_LENGTH (new);
+ STRING_SET_INTERVALS (parent, new);
+ new->position = 0;
}
- new->parent = (INTERVAL) parent;
- new->position = 1;
+ SET_INTERVAL_OBJECT (new, parent);
return new;
}
MERGE_INTERVAL_CACHE (source, target);
o = source->plist;
- while (! EQ (o, Qnil))
+ while (CONSP (o))
{
- sym = Fcar (o);
+ sym = XCAR (o);
val = Fmemq (sym, target->plist);
if (NILP (val))
{
- o = Fcdr (o);
- val = Fcar (o);
+ o = XCDR (o);
+ CHECK_CONS (o);
+ val = XCAR (o);
target->plist = Fcons (sym, Fcons (val, target->plist));
- o = Fcdr (o);
+ o = XCDR (o);
}
else
- o = Fcdr (Fcdr (o));
+ o = Fcdr (XCDR (o));
}
}
INTERVAL i0, i1;
{
register Lisp_Object i0_cdr, i0_sym, i1_val;
- register i1_len;
+ register int i1_len;
if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
return 1;
abort ();
i1_len /= 2;
i0_cdr = i0->plist;
- while (!NILP (i0_cdr))
+ while (CONSP (i0_cdr))
{
/* Lengths of the two plists were unequal. */
if (i1_len == 0)
return 0;
- i0_sym = Fcar (i0_cdr);
+ i0_sym = XCAR (i0_cdr);
i1_val = Fmemq (i0_sym, i1->plist);
/* i0 has something i1 doesn't. */
return 0;
/* i0 and i1 both have sym, but it has different values in each. */
- i0_cdr = Fcdr (i0_cdr);
- if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
+ i0_cdr = XCDR (i0_cdr);
+ CHECK_CONS (i0_cdr);
+ if (!EQ (Fcar (Fcdr (i1_val)), XCAR (i0_cdr)))
return 0;
- i0_cdr = Fcdr (i0_cdr);
+ i0_cdr = XCDR (i0_cdr);
i1_len--;
}
return 1;
}
\f
-static int icount;
-static int idepth;
-static int zero_length;
/* Traverse an interval tree TREE, performing FUNCTION on each node.
+ No guarantee is made about the order of traversal.
Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals (tree, position, depth, function, arg)
+traverse_intervals_noorder (tree, function, arg)
INTERVAL tree;
- int position, depth;
- void (* function) ();
+ void (* function) P_ ((INTERVAL, Lisp_Object));
Lisp_Object arg;
{
- if (NULL_INTERVAL_P (tree))
- return;
+ /* Minimize stack usage. */
+ while (!NULL_INTERVAL_P (tree))
+ {
+ (*function) (tree, arg);
+ if (NULL_INTERVAL_P (tree->right))
+ tree = tree->left;
+ else
+ {
+ traverse_intervals_noorder (tree->left, function, arg);
+ tree = tree->right;
+ }
+ }
+}
+
+/* Traverse an interval tree TREE, performing FUNCTION on each node.
+ Pass FUNCTION two args: an interval, and ARG. */
- traverse_intervals (tree->left, position, depth + 1, function, arg);
- position += LEFT_TOTAL_LENGTH (tree);
- tree->position = position;
- (*function) (tree, arg);
- position += LENGTH (tree);
- traverse_intervals (tree->right, position, depth + 1, function, arg);
+void
+traverse_intervals (tree, position, function, arg)
+ INTERVAL tree;
+ int position;
+ void (* function) P_ ((INTERVAL, Lisp_Object));
+ Lisp_Object arg;
+{
+ while (!NULL_INTERVAL_P (tree))
+ {
+ traverse_intervals (tree->left, position, function, arg);
+ position += LEFT_TOTAL_LENGTH (tree);
+ tree->position = position;
+ (*function) (tree, arg);
+ position += LENGTH (tree); tree = tree->right;
+ }
}
\f
#if 0
+
+static int icount;
+static int idepth;
+static int zero_length;
+
/* 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, 0, &check_for_interval, Qnil);
+ traverse_intervals_noorder (tree, &check_for_interval, Qnil);
return found_interval;
}
icount = 0;
idepth = 0;
zero_length = 0;
- traverse_intervals (i, 1, 0, &inc_interval_count, Qnil);
+ traverse_intervals_noorder (i, &inc_interval_count, Qnil);
return icount;
}
register INTERVAL i = interval;
while (! ROOT_INTERVAL_P (i))
- i = i->parent;
+ i = INTERVAL_PARENT (i);
return i;
}
c c
*/
-static INTERVAL
+static INLINE INTERVAL
rotate_right (interval)
INTERVAL interval;
{
/* Deal with any Parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
- if (AM_LEFT_CHILD (interval))
- interval->parent->left = B;
- else
- interval->parent->right = B;
- B->parent = interval->parent;
+ {
+ if (AM_LEFT_CHILD (interval))
+ INTERVAL_PARENT (interval)->left = B;
+ else
+ INTERVAL_PARENT (interval)->right = B;
+ }
+ COPY_INTERVAL_PARENT (B, interval);
/* Make B the parent of A */
i = B->right;
B->right = interval;
- interval->parent = B;
+ SET_INTERVAL_PARENT (interval, B);
/* Make A point to c */
interval->left = i;
if (! NULL_INTERVAL_P (i))
- i->parent = interval;
+ SET_INTERVAL_PARENT (i, 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);
+ CHECK_TOTAL_LENGTH (interval);
/* B must have the same total length of A. */
B->total_length = old_total;
+ CHECK_TOTAL_LENGTH (B);
return B;
}
/* Assuming that a right child exists, perform the following operation:
- A B
- / \ / \
+ A B
+ / \ / \
B => A
- / \ / \
+ / \ / \
c c
*/
-static INTERVAL
+static INLINE INTERVAL
rotate_left (interval)
INTERVAL interval;
{
/* Deal with any parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
- if (AM_LEFT_CHILD (interval))
- interval->parent->left = B;
- else
- interval->parent->right = B;
- B->parent = interval->parent;
+ {
+ if (AM_LEFT_CHILD (interval))
+ INTERVAL_PARENT (interval)->left = B;
+ else
+ INTERVAL_PARENT (interval)->right = B;
+ }
+ COPY_INTERVAL_PARENT (B, interval);
/* Make B the parent of A */
i = B->left;
B->left = interval;
- interval->parent = B;
+ SET_INTERVAL_PARENT (interval, B);
/* Make A point to c */
interval->right = i;
if (! NULL_INTERVAL_P (i))
- i->parent = interval;
+ SET_INTERVAL_PARENT (i, 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);
+ CHECK_TOTAL_LENGTH (interval);
/* B must have the same total length of A. */
B->total_length = old_total;
+ CHECK_TOTAL_LENGTH (B);
return B;
}
old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
if (old_diff > 0)
{
+ /* Since the left child is longer, there must be one. */
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)
}
else if (old_diff < 0)
{
+ /* Since the right child is longer, there must be one. */
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)
register INTERVAL interval;
{
Lisp_Object parent;
+ int have_parent = 0;
- if (interval->parent == NULL_INTERVAL)
+ if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
return interval;
- parent = (Lisp_Object) (interval->parent);
+ if (INTERVAL_HAS_OBJECT (interval))
+ {
+ have_parent = 1;
+ GET_INTERVAL_OBJECT (parent, interval);
+ }
interval = balance_an_interval (interval);
- if (BUFFERP (parent))
- BUF_INTERVALS (XBUFFER (parent)) = interval;
- else if (STRINGP (parent))
- XSTRING (parent)->intervals = interval;
+ if (have_parent)
+ {
+ if (BUFFERP (parent))
+ BUF_INTERVALS (XBUFFER (parent)) = interval;
+ else if (STRINGP (parent))
+ STRING_SET_INTERVALS (parent, 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);
}
int new_length = LENGTH (interval) - offset;
new->position = position + offset;
- new->parent = interval;
+ SET_INTERVAL_PARENT (new, interval);
if (NULL_RIGHT_CHILD (interval))
{
interval->right = new;
new->total_length = new_length;
-
- return new;
+ CHECK_TOTAL_LENGTH (new);
+ }
+ else
+ {
+ /* Insert the new node between INTERVAL and its right child. */
+ new->right = interval->right;
+ SET_INTERVAL_PARENT (interval->right, new);
+ interval->right = new;
+ new->total_length = new_length + new->right->total_length;
+ CHECK_TOTAL_LENGTH (new);
+ balance_an_interval (new);
}
- /* 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;
int offset;
{
INTERVAL new = make_interval ();
- int position = interval->position;
int new_length = offset;
new->position = interval->position;
interval->position = interval->position + offset;
- new->parent = interval;
+ SET_INTERVAL_PARENT (new, interval);
if (NULL_LEFT_CHILD (interval))
{
interval->left = new;
new->total_length = new_length;
-
- return new;
+ CHECK_TOTAL_LENGTH (new);
+ }
+ else
+ {
+ /* Insert the new node between INTERVAL and its left child. */
+ new->left = interval->left;
+ SET_INTERVAL_PARENT (new->left, new);
+ interval->left = new;
+ new->total_length = new_length + new->left->total_length;
+ CHECK_TOTAL_LENGTH (new);
+ balance_an_interval (new);
}
- /* Insert the new node between INTERVAL and its left child. */
- new->left = interval->left;
- new->left->parent = new;
- interval->left = new;
- new->total_length = new_length + new->left->total_length;
-
- balance_an_interval (new);
balance_possible_root_interval (interval);
return new;
}
\f
+/* Return the proper position for the first character
+ described by the interval tree SOURCE.
+ This is 1 if the parent is a buffer,
+ 0 if the parent is a string or if there is no parent.
+
+ Don't use this function on an interval which is the child
+ of another interval! */
+
+int
+interval_start_pos (source)
+ INTERVAL source;
+{
+ Lisp_Object parent;
+
+ if (NULL_INTERVAL_P (source))
+ return 0;
+
+ if (! INTERVAL_HAS_OBJECT (source))
+ return 0;
+ GET_INTERVAL_OBJECT (parent, source);
+ if (BUFFERP (parent))
+ return BUF_BEG (XBUFFER (parent));
+ return 0;
+}
+
/* 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.
+ position (starting from 1) or a string index (starting from 0).
+ If POSITION is at the end of the buffer or string,
+ return the interval containing the last character.
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
+INTERVAL
find_interval (tree, position)
register INTERVAL tree;
register int position;
{
/* The distance from the left edge of the subtree at TREE
to POSITION. */
- register int relative_position = position - BEG;
+ register int relative_position;
if (NULL_INTERVAL_P (tree))
return NULL_INTERVAL;
+ relative_position = position;
+ if (INTERVAL_HAS_OBJECT (tree))
+ {
+ Lisp_Object parent;
+ GET_INTERVAL_OBJECT (parent, tree);
+ if (BUFFERP (parent))
+ relative_position -= BUF_BEG (XBUFFER (parent));
+ }
+
if (relative_position > TOTAL_LENGTH (tree))
abort (); /* Paranoia */
- tree = balance_possible_root_interval (tree);
+ if (!handling_signal)
+ tree = balance_possible_root_interval (tree);
while (1)
{
}
else
{
- tree->position =
- (position - relative_position /* the left edge of *tree */
- + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
+ tree->position
+ = (position - relative_position /* left edge of *tree. */
+ + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
return tree;
}
{
if (AM_LEFT_CHILD (i))
{
- i = i->parent;
+ i = INTERVAL_PARENT (i);
i->position = next_position;
return i;
}
- i = i->parent;
+ i = INTERVAL_PARENT (i);
}
return NULL_INTERVAL;
register INTERVAL interval;
{
register INTERVAL i;
- register position_of_previous;
if (NULL_INTERVAL_P (interval))
return NULL_INTERVAL;
{
if (AM_RIGHT_CHILD (i))
{
- i = i->parent;
+ i = INTERVAL_PARENT (i);
i->position = interval->position - LENGTH (i);
return i;
}
- i = i->parent;
+ i = INTERVAL_PARENT (i);
}
return NULL_INTERVAL;
}
+
+/* Find the interval containing POS given some non-NULL INTERVAL
+ in the same tree. Note that we need to update interval->position
+ if we go down the tree.
+ To speed up the process, we assume that the ->position of
+ I and all its parents is already uptodate. */
+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->left->position = i->position - TOTAL_LENGTH (i->left)
+ + LEFT_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 = INTERVAL_PARENT (i);
+ continue;
+ }
+ else if (pos >= INTERVAL_LAST_POS (i))
+ {
+ /* Move right. */
+ if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
+ {
+ i->right->position = INTERVAL_LAST_POS (i) +
+ LEFT_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 = INTERVAL_PARENT (i);
+ 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
if (relative_position <= LEFT_TOTAL_LENGTH (this))
{
this->total_length += length;
+ CHECK_TOTAL_LENGTH (this);
this = this->left;
}
else if (relative_position > (TOTAL_LENGTH (this)
relative_position -= (TOTAL_LENGTH (this)
- RIGHT_TOTAL_LENGTH (this));
this->total_length += length;
+ CHECK_TOTAL_LENGTH (this);
this = this->right;
}
else
/* If we are to use zero-length intervals as buffer pointers,
then this code will have to change. */
this->total_length += length;
+ CHECK_TOTAL_LENGTH (this);
this->position = LEFT_TOTAL_LENGTH (this)
+ position - relative_position + 1;
return tree;
register INTERVAL i;
register INTERVAL temp;
int eobp = 0;
-
+ Lisp_Object parent;
+ int offset;
+
if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
abort ();
+ GET_INTERVAL_OBJECT (parent, tree);
+ offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
+
/* 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;
- }
+ if (position >= TOTAL_LENGTH (tree) + offset)
+ {
+ position = TOTAL_LENGTH (tree) + offset;
+ 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))
+ So split this interval at the insertion point.
+
+ Originally, the if condition here was this:
+ (! (position == i->position || eobp)
+ && END_NONSTICKY_P (i)
+ && FRONT_NONSTICKY_P (i))
+ But, these macros are now unreliable because of introduction of
+ Vtext_property_default_nonsticky. So, we always check properties
+ one by one if POSITION is in middle of an interval. */
+ if (! (position == i->position || eobp))
{
- temp = split_interval_right (i, position - i->position);
- copy_properties (i, temp);
- i = temp;
+ Lisp_Object tail;
+ Lisp_Object front, rear;
+
+ tail = i->plist;
+
+ /* Properties font-sticky and rear-nonsticky override
+ Vtext_property_default_nonsticky. So, if they are t, we can
+ skip one by one checking of properties. */
+ rear = textget (i->plist, Qrear_nonsticky);
+ if (! CONSP (rear) && ! NILP (rear))
+ {
+ /* All properties are nonsticky. We split the interval. */
+ goto check_done;
+ }
+ front = textget (i->plist, Qfront_sticky);
+ if (! CONSP (front) && ! NILP (front))
+ {
+ /* All properties are sticky. We don't split the interval. */
+ tail = Qnil;
+ goto check_done;
+ }
+
+ /* Does any actual property pose an actual problem? We break
+ the loop if we find a nonsticky property. */
+ for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
+ {
+ Lisp_Object prop, tmp;
+ prop = XCAR (tail);
+
+ /* Is this particular property front-sticky? */
+ if (CONSP (front) && ! NILP (Fmemq (prop, front)))
+ continue;
+
+ /* Is this particular property rear-nonsticky? */
+ if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
+ break;
+
+ /* Is this particular property recorded as sticky or
+ nonsticky in Vtext_property_default_nonsticky? */
+ tmp = Fassq (prop, Vtext_property_default_nonsticky);
+ if (CONSP (tmp))
+ {
+ if (NILP (tmp))
+ continue;
+ break;
+ }
+
+ /* By default, a text property is rear-sticky, thus we
+ continue the loop. */
+ }
+
+ check_done:
+ /* 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. */
- for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
+ off a part later, if stickiness demands it. */
+ for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
{
temp->total_length += length;
+ CHECK_TOTAL_LENGTH (temp);
temp = balance_possible_root_interval (temp);
}
-
+
/* If at least one interval has sticky properties,
- we check the stickyness property by property. */
- if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
+ we check the stickiness property by property.
+
+ Originally, the if condition here was this:
+ (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
+ But, these macros are now unreliable because of introduction
+ of Vtext_property_default_nonsticky. So, we always have to
+ check stickiness of properties one by one. If cache of
+ stickiness is implemented in the future, we may be able to
+ use those macros again. */
+ if (1)
{
Lisp_Object pleft, pright;
struct interval newi;
pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
newi.plist = merge_properties_sticky (pleft, pright);
- if(! prev) /* i.e. position == BEG */
+ if (! prev) /* i.e. position == BEG */
{
if (! intervals_equal (i, &newi))
{
/* Otherwise just extend the interval. */
else
{
- for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent)
+ for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
{
temp->total_length += length;
+ CHECK_TOTAL_LENGTH (temp);
temp = balance_possible_root_interval (temp);
}
}
-
+
return tree;
}
{
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;
rrear = textget (pright, Qrear_nonsticky);
/* Go through each element of PRIGHT. */
- for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+ for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
{
- sym = Fcar (tail1);
+ Lisp_Object tmp;
+
+ sym = XCAR (tail1);
/* Sticky properties get special treatment. */
if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
continue;
- rval = Fcar (Fcdr (tail1));
- for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
- if (EQ (sym, Fcar (tail2)))
+ rval = Fcar (XCDR (tail1));
+ for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
+ if (EQ (sym, XCAR (tail2)))
break;
- lval = (NILP (tail2) ? Qnil : Fcar( Fcdr (tail2)));
- use_left = ! TMEM (sym, lrear);
- use_right = TMEM (sym, rfront);
+ /* 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)));
+
+ /* Even if lrear or rfront say nothing about the stickiness of
+ SYM, Vtext_property_default_nonsticky may give default
+ stickiness to SYM. */
+ tmp = Fassq (sym, Vtext_property_default_nonsticky);
+ use_left = (lpresent
+ && ! (TMEM (sym, lrear)
+ || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
+ use_right = (TMEM (sym, rfront)
+ || (CONSP (tmp) && NILP (XCDR (tmp))));
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))
}
/* Now go through each element of PLEFT. */
- for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
+ for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
{
- sym = Fcar (tail2);
+ Lisp_Object tmp;
+
+ sym = XCAR (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)))
+ for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
+ if (EQ (sym, XCAR (tail1)))
break;
if (! NILP (tail1))
continue;
- lval = Fcar (Fcdr (tail2));
+ lval = Fcar (XCDR (tail2));
+
+ /* Even if lrear or rfront say nothing about the stickiness of
+ SYM, Vtext_property_default_nonsticky may give default
+ stickiness to SYM. */
+ tmp = Fassq (sym, Vtext_property_default_nonsticky);
/* Since rval is known to be nil in this loop, the test simplifies. */
- if (! TMEM (sym, lrear))
+ if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
{
- if (! NILP (lval))
- props = Fcons (lval, Fcons (sym, props));
+ props = Fcons (lval, Fcons (sym, props));
if (TMEM (sym, lfront))
front = Fcons (sym, front);
}
- else if (TMEM (sym, rfront))
+ else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
{
/* The value is nil, but we still inherit the stickiness
from the right. */
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;
}
\f
-/* Delete an node I from its interval tree by merging its subtrees
+/* Delete a 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. */
this = this->left;
this->total_length += migrate_amt;
}
+ CHECK_TOTAL_LENGTH (this);
this->left = migrate;
- migrate->parent = this;
+ SET_INTERVAL_PARENT (migrate, this);
return i->right;
}
if (ROOT_INTERVAL_P (i))
{
Lisp_Object owner;
- owner = (Lisp_Object) i->parent;
+ GET_INTERVAL_OBJECT (owner, i);
parent = delete_node (i);
if (! NULL_INTERVAL_P (parent))
- parent->parent = (INTERVAL) owner;
+ SET_INTERVAL_OBJECT (parent, owner);
if (BUFFERP (owner))
BUF_INTERVALS (XBUFFER (owner)) = parent;
else if (STRINGP (owner))
- XSTRING (owner)->intervals = parent;
+ STRING_SET_INTERVALS (owner, parent);
else
abort ();
return;
}
- parent = i->parent;
+ parent = INTERVAL_PARENT (i);
if (AM_LEFT_CHILD (i))
{
parent->left = delete_node (i);
if (! NULL_INTERVAL_P (parent->left))
- parent->left->parent = parent;
+ SET_INTERVAL_PARENT (parent->left, parent);
}
else
{
parent->right = delete_node (i);
if (! NULL_INTERVAL_P (parent->right))
- parent->right->parent = parent;
+ SET_INTERVAL_PARENT (parent->right, parent);
}
}
\f
relative_position,
amount);
tree->total_length -= subtract;
+ CHECK_TOTAL_LENGTH (tree);
return subtract;
}
/* Right branch */
relative_position,
amount);
tree->total_length -= subtract;
+ CHECK_TOTAL_LENGTH (tree);
return subtract;
}
/* Here -- this node. */
else
{
/* How much can we delete from this interval? */
- int my_amount = ((tree->total_length
+ int my_amount = ((tree->total_length
- RIGHT_TOTAL_LENGTH (tree))
- relative_position);
amount = my_amount;
tree->total_length -= amount;
+ CHECK_TOTAL_LENGTH (tree);
if (LENGTH (tree) == 0)
delete_interval (tree);
-
+
return amount;
}
{
register int left_to_delete = length;
register INTERVAL tree = BUF_INTERVALS (buffer);
- register int deleted;
+ Lisp_Object parent;
+ int offset;
+
+ GET_INTERVAL_OBJECT (parent, tree);
+ offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
if (NULL_INTERVAL_P (tree))
return;
- if (start > BEG + TOTAL_LENGTH (tree)
- || start + length > BEG + TOTAL_LENGTH (tree))
+ if (start > offset + TOTAL_LENGTH (tree)
+ || start + length > offset + TOTAL_LENGTH (tree))
abort ();
if (length == TOTAL_LENGTH (tree))
if (ONLY_INTERVAL_P (tree))
{
tree->total_length -= length;
+ CHECK_TOTAL_LENGTH (tree);
return;
}
- if (start > BEG + TOTAL_LENGTH (tree))
- start = BEG + TOTAL_LENGTH (tree);
+ if (start > offset + TOTAL_LENGTH (tree))
+ start = offset + TOTAL_LENGTH (tree);
while (left_to_delete > 0)
{
- left_to_delete -= interval_deletion_adjustment (tree, start - 1,
+ left_to_delete -= interval_deletion_adjustment (tree, start - offset,
left_to_delete);
tree = BUF_INTERVALS (buffer);
if (left_to_delete == tree->total_length)
/* Zero out this interval. */
i->total_length -= absorb;
+ CHECK_TOTAL_LENGTH (i);
/* Find the succeeding interval. */
if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
while (! NULL_LEFT_CHILD (successor))
{
successor->total_length += absorb;
+ CHECK_TOTAL_LENGTH (successor);
successor = successor->left;
}
successor->total_length += absorb;
+ CHECK_TOTAL_LENGTH (successor);
delete_interval (i);
return successor;
}
{
if (AM_LEFT_CHILD (successor))
{
- successor = successor->parent;
+ successor = INTERVAL_PARENT (successor);
delete_interval (i);
return successor;
}
- successor = successor->parent;
+ successor = INTERVAL_PARENT (successor);
successor->total_length -= absorb;
+ CHECK_TOTAL_LENGTH (successor);
}
/* This must be the rightmost or last interval and cannot
/* Zero out this interval. */
i->total_length -= absorb;
+ CHECK_TOTAL_LENGTH (i);
/* Find the preceding interval. */
if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
while (! NULL_RIGHT_CHILD (predecessor))
{
predecessor->total_length += absorb;
+ CHECK_TOTAL_LENGTH (predecessor);
predecessor = predecessor->right;
}
predecessor->total_length += absorb;
+ CHECK_TOTAL_LENGTH (predecessor);
delete_interval (i);
return predecessor;
}
{
if (AM_RIGHT_CHILD (predecessor))
{
- predecessor = predecessor->parent;
+ predecessor = INTERVAL_PARENT (predecessor);
delete_interval (i);
return predecessor;
}
- predecessor = predecessor->parent;
+ predecessor = INTERVAL_PARENT (predecessor);
predecessor->total_length -= absorb;
+ CHECK_TOTAL_LENGTH (predecessor);
}
/* This must be the leftmost or first interval and cannot
bcopy (source, t, INTERVAL_SIZE);
copy_properties (source, t);
- t->parent = parent;
+ SET_INTERVAL_PARENT (t, parent);
+ if (! NULL_LEFT_CHILD (source))
+ t->left = reproduce_tree (source->left, t);
+ if (! NULL_RIGHT_CHILD (source))
+ t->right = reproduce_tree (source->right, t);
+
+ return t;
+}
+
+static INTERVAL
+reproduce_tree_obj (source, parent)
+ INTERVAL source;
+ Lisp_Object parent;
+{
+ register INTERVAL t = make_interval ();
+
+ bcopy (source, t, INTERVAL_SIZE);
+ copy_properties (source, t);
+ SET_INTERVAL_OBJECT (t, parent);
if (! NULL_LEFT_CHILD (source))
t->left = reproduce_tree (source->left, t);
if (! NULL_RIGHT_CHILD (source))
/* Insert the intervals of SOURCE into BUFFER at POSITION.
LENGTH is the length of the text in SOURCE.
+ The `position' field of the SOURCE intervals is assumed to be
+ consistent with its parent; therefore, SOURCE must be an
+ interval tree made with copy_interval or must be the whole
+ tree of a buffer or a string.
+
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
{
register INTERVAL under, over, this, prev;
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 the new text has no properties, then with inheritance it
+ becomes part of whatever interval it was inserted into.
+ To prevent inheritance, we must clear out the properties
+ of the newly inserted text. */
if (NULL_INTERVAL_P (source))
{
Lisp_Object buf;
- if (!inherit && ! NULL_INTERVAL_P (tree))
+ if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
{
XSETBUFFER (buf, buffer);
- Fset_text_properties (make_number (position),
- make_number (position + length),
- Qnil, buf);
+ set_text_properties_1 (make_number (position),
+ make_number (position + length),
+ Qnil, buf, 0);
}
if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ /* Shouldn't be necessary. -stef */
BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
return;
}
{
Lisp_Object buf;
XSETBUFFER (buf, buffer);
- BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
- /* Explicitly free the old tree here. */
+ BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
+ BUF_INTERVALS (buffer)->position = BEG;
+
+ /* 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. */
{
- BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
+ BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
+ BUF_INTERVALS (buffer)->position = BEG;
/* Explicitly free the old tree here. */
return;
this = under = find_interval (tree, position);
if (NULL_INTERVAL_P (under)) /* Paranoia */
abort ();
- over = find_interval (source, 1);
+ over = find_interval (source, interval_start_pos (source));
/* Here for insertion in the middle of an interval.
Split off an equivalent interval to the right,
= split_interval_left (this, position - under->position);
copy_properties (under, end_unchanged);
under->position = position;
- prev = 0;
- middle = 1;
}
else
{
+ /* This call may have some effect because previous_interval may
+ update `position' fields of intervals. Thus, don't ignore it
+ for the moment. Someone please tell me the truth (K.Handa). */
prev = previous_interval (under);
+#if 0
+ /* But, this code surely has no effect. And, anyway,
+ END_NONSTICKY_P is unreliable now. */
if (prev && !END_NONSTICKY_P (prev))
prev = 0;
+#endif /* 0 */
}
/* Insertion is now at beginning of UNDER. */
/* 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))
{
if (LENGTH (over) < LENGTH (under))
/* 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)
Lisp_Object plist;
register Lisp_Object prop;
{
- register Lisp_Object tail, fallback;
- fallback = Qnil;
+ return lookup_char_property (plist, prop, 1);
+}
- for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
+Lisp_Object
+lookup_char_property (plist, prop, textprop)
+ Lisp_Object plist;
+ register Lisp_Object prop;
+ int textprop;
+{
+ register Lisp_Object tail, fallback = Qnil;
+
+ for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
{
register Lisp_Object tem;
- tem = Fcar (tail);
+ tem = XCAR (tail);
if (EQ (prop, tem))
- return Fcar (Fcdr (tail));
+ return Fcar (XCDR (tail));
if (EQ (tem, Qcategory))
{
- tem = Fcar (Fcdr (tail));
+ tem = Fcar (XCDR (tail));
if (SYMBOLP (tem))
fallback = Fget (tem, prop);
}
}
+ if (! NILP (fallback))
+ return fallback;
+ /* Check for alternative properties */
+ tail = Fassq (prop, Vchar_property_alias_alist);
+ if (NILP (tail))
+ return tail;
+ tail = XCDR (tail);
+ for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
+ fallback = Fplist_get (plist, XCAR (tail));
+ if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
+ fallback = Fplist_get (Vdefault_text_properties, prop);
return fallback;
}
-/* Get the value of property PROP from PLIST,
- which is the plist of an interval.
- We check for direct properties only! */
+\f
+/* Set point "temporarily", without checking any text properties. */
-Lisp_Object
-textget_direct (plist, prop)
- Lisp_Object plist;
- register Lisp_Object prop;
+INLINE void
+temp_set_point (buffer, charpos)
+ struct buffer *buffer;
+ int charpos;
{
- register Lisp_Object tail;
+ temp_set_point_both (buffer, charpos,
+ buf_charpos_to_bytepos (buffer, charpos));
+}
- for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
- {
- if (EQ (prop, Fcar (tail)))
- return Fcar (Fcdr (tail));
- }
+/* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
+ byte position BYTEPOS. */
+
+INLINE void
+temp_set_point_both (buffer, charpos, bytepos)
+ int charpos, bytepos;
+ struct buffer *buffer;
+{
+ /* In a single-byte buffer, the two positions must be equal. */
+ if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
+ && charpos != bytepos)
+ abort ();
+
+ if (charpos > bytepos)
+ abort ();
- return Qnil;
+ if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
+ abort ();
+
+ BUF_PT_BYTE (buffer) = bytepos;
+ BUF_PT (buffer) = charpos;
}
-\f
-/* Set point in BUFFER to POSITION. If the target position is
+
+/* Set point in BUFFER to CHARPOS. If the target position is
before an intangible character, move to an ok place. */
void
-set_point (position, buffer)
- register int position;
+set_point (buffer, charpos)
register struct buffer *buffer;
+ register int charpos;
{
- register INTERVAL to, from, toprev, fromprev, target;
+ set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
+}
+
+/* If there's an invisible character at position POS + TEST_OFFS in the
+ current buffer, and the invisible property has a `stickiness' such that
+ inserting a character at position POS would inherit the property it,
+ return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
+ then intangibility is required as well as invisibleness.
+
+ TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
+
+ Note that `stickiness' is determined by overlay marker insertion types,
+ if the invisible property comes from an overlay. */
+
+static int
+adjust_for_invis_intang (pos, test_offs, adj, test_intang)
+ int pos, test_offs, adj, test_intang;
+{
+ Lisp_Object invis_propval, invis_overlay;
+ Lisp_Object test_pos;
+
+ if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
+ /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
+ return pos;
+
+ test_pos = make_number (pos + test_offs);
+
+ invis_propval
+ = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
+ &invis_overlay);
+
+ if ((!test_intang
+ || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
+ && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
+ /* This next test is true if the invisible property has a stickiness
+ such that an insertion at POS would inherit it. */
+ && (NILP (invis_overlay)
+ /* Invisible property is from a text-property. */
+ ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
+ == (test_offs == 0 ? 1 : -1))
+ /* Invisible property is from an overlay. */
+ : (test_offs == 0
+ ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
+ : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
+ pos += adj;
+
+ return pos;
+}
+
+/* Set point in BUFFER to CHARPOS, which corresponds to byte
+ position BYTEPOS. If the target position is
+ before an intangible character, move to an ok place. */
+
+void
+set_point_both (buffer, charpos, bytepos)
+ register struct buffer *buffer;
+ register int charpos, bytepos;
+{
+ register INTERVAL to, from, toprev, fromprev;
int buffer_point;
- register Lisp_Object obj;
- int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
int old_position = BUF_PT (buffer);
+ int backwards = (charpos < old_position ? 1 : 0);
+ int have_overlays;
+ int original_position;
+
+ buffer->point_before_scroll = Qnil;
- if (position == BUF_PT (buffer))
+ if (charpos == BUF_PT (buffer))
return;
+ /* In a single-byte buffer, the two positions must be equal. */
+ if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
+ && charpos != bytepos)
+ abort ();
+
/* 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 (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
abort ();
- if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+ 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)
{
-
- BUF_PT (buffer) = position;
+ temp_set_point_both (buffer, charpos, bytepos);
return;
}
- /* Set TO to the interval containing the char after POSITION,
- and TOPREV to the interval containing the char before POSITION.
+ /* Set TO to the interval containing the char after CHARPOS,
+ and TOPREV to the interval containing the char before CHARPOS.
Either one may be null. They may be equal. */
- to = find_interval (BUF_INTERVALS (buffer), position);
- if (position == BUF_BEGV (buffer))
+ to = find_interval (BUF_INTERVALS (buffer), charpos);
+ if (charpos == BUF_BEGV (buffer))
toprev = 0;
- else if (to->position == position)
+ else if (to && to->position == charpos)
toprev = previous_interval (to);
else
toprev = to;
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)
{
- BUF_PT (buffer) = position;
+ temp_set_point_both (buffer, charpos, bytepos);
return;
}
- /* If the new position is between two intangible characters,
- move forward or backward across all such characters. */
- if (NILP (Vinhibit_point_motion_hooks) && ! NULL_INTERVAL_P (to)
- && ! NULL_INTERVAL_P (toprev))
+ original_position = charpos;
+
+ /* 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. */
+ && charpos != BEGV && charpos != ZV)
{
+ Lisp_Object pos;
+ Lisp_Object intangible_propval;
+
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)))
- {
- 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;
- }
+ /* If the preceding character is both intangible and invisible,
+ and the invisible property is `rear-sticky', perturb it so
+ that the search starts one character earlier -- this ensures
+ that point can never move to the end of an invisible/
+ intangible/rear-sticky region. */
+ charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
+
+ XSETINT (pos, charpos);
+
+ /* If following char is intangible,
+ skip back over all chars with matching intangible property. */
+
+ intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
+
+ 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);
+
+ /* Set CHARPOS from POS, and if the final intangible character
+ that we skipped over is also invisible, and the invisible
+ property is `front-sticky', perturb it to be one character
+ earlier -- this ensures that point can never move to the
+ beginning of an invisible/intangible/front-sticky region. */
+ charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
+ }
}
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)))
- {
- toprev = to;
- to = next_interval (to);
- if (NULL_INTERVAL_P (to))
- position = BUF_ZV (buffer);
- else
- position = to->position;
- }
+ /* If the following character is both intangible and invisible,
+ and the invisible property is `front-sticky', perturb it so
+ that the search starts one character later -- this ensures
+ that point can never move to the beginning of an
+ invisible/intangible/front-sticky region. */
+ charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
+
+ XSETINT (pos, charpos);
+
+ /* If preceding char is intangible,
+ skip forward over all chars with matching intangible property. */
+
+ intangible_propval = Fget_char_property (make_number (charpos - 1),
+ Qintangible, Qnil);
+
+ 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);
+
+ /* Set CHARPOS from POS, and if the final intangible character
+ that we skipped over is also invisible, and the invisible
+ property is `rear-sticky', perturb it to be one character
+ later -- this ensures that point can never move to the
+ end of an invisible/intangible/rear-sticky region. */
+ charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
+ }
}
- /* 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. */
+
+ bytepos = buf_charpos_to_bytepos (buffer, charpos);
+ }
+
+ if (charpos != original_position)
+ {
+ /* Set TO to the interval containing the char after CHARPOS,
+ and TOPREV to the interval containing the char before CHARPOS.
+ Either one may be null. They may be equal. */
+ to = find_interval (BUF_INTERVALS (buffer), charpos);
+ if (charpos == BUF_BEGV (buffer))
+ toprev = 0;
+ else if (to && to->position == charpos)
+ toprev = previous_interval (to);
+ else
+ toprev = to;
}
- BUF_PT (buffer) = 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. */
+
+ temp_set_point_both (buffer, charpos, bytepos);
/* We run point-left and point-entered hooks here, iff the
two intervals are not equivalent. These hooks take
enter_before = Qnil;
if (! EQ (leave_before, enter_before) && !NILP (leave_before))
- call2 (leave_before, old_position, position);
+ call2 (leave_before, make_number (old_position),
+ make_number (charpos));
if (! EQ (leave_after, enter_after) && !NILP (leave_after))
- call2 (leave_after, old_position, position);
+ call2 (leave_after, make_number (old_position),
+ make_number (charpos));
if (! EQ (enter_before, leave_before) && !NILP (enter_before))
- call2 (enter_before, old_position, position);
+ call2 (enter_before, make_number (old_position),
+ make_number (charpos));
if (! EQ (enter_after, leave_after) && !NILP (enter_after))
- call2 (enter_after, old_position, position);
+ call2 (enter_after, make_number (old_position),
+ make_number (charpos));
}
}
+\f
+/* Move point to POSITION, unless POSITION is inside an intangible
+ segment that reaches all the way to point. */
-/* Set point temporarily, without checking any text properties. */
-
-INLINE void
-temp_set_point (position, buffer)
+void
+move_if_not_intangible (position)
int position;
- struct buffer *buffer;
{
- 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. */
+ Lisp_Object pos;
+ Lisp_Object intangible_propval;
-Lisp_Object
-get_local_map (position, buffer)
- register int position;
- register struct buffer *buffer;
-{
- register INTERVAL interval;
- Lisp_Object prop, tem;
+ XSETINT (pos, position);
- if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
- return buffer->keymap;
+ if (! NILP (Vinhibit_point_motion_hooks))
+ /* If intangible is inhibited, always move point to POSITION. */
+ ;
+ else if (PT < position && XINT (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 (XINT (pos) > BEGV)
+ {
+ /* We want to move backward, so check the text after POSITION. */
- /* Perhaps we should just change `position' to the limit. */
- if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
- abort ();
+ intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
+ Qintangible, Qnil);
- interval = find_interval (BUF_INTERVALS (buffer), position);
- prop = textget (interval->plist, Qlocal_map);
- if (NILP (prop))
- return buffer->keymap;
+ /* If following char is intangible,
+ skip forward 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);
- /* Use the local map only if it is valid. */
- tem = Fkeymapp (prop);
- if (!NILP (tem))
- return prop;
+ }
- return buffer->keymap;
-}
-\f
-/* Call the modification hook functions in LIST, each with START and END. */
+ /* 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). */
-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;
+ if (XINT (pos) != PT)
+ SET_PT (position);
}
+\f
+/* If text at position POS has property PROP, set *VAL to the property
+ value, *START and *END to the beginning and end of a region that
+ has the same property, and return 1. Otherwise return 0.
-/* Check for read-only intervals and signal an error if we find one.
- Then check for any modification hooks in the range START up to
- (but not including) END. Create a list of all these hooks in
- lexicographic order, eliminating consecutive extra copies of the
- same hook. Then call those hooks in order, with START and END - 1
- as arguments. */
+ OBJECT is the string or buffer to look for the property in;
+ nil means the current buffer. */
-void
-verify_interval_modification (buf, start, end)
- struct buffer *buf;
- int start, end;
+int
+get_property_and_range (pos, prop, val, start, end, object)
+ int pos;
+ Lisp_Object prop, *val;
+ int *start, *end;
+ Lisp_Object object;
{
- register INTERVAL intervals = BUF_INTERVALS (buf);
- register INTERVAL i, prev;
- Lisp_Object hooks;
- register Lisp_Object prev_mod_hooks;
- Lisp_Object mod_hooks;
- struct gcpro gcpro1;
-
- hooks = Qnil;
- prev_mod_hooks = Qnil;
- mod_hooks = Qnil;
-
- if (NULL_INTERVAL_P (intervals))
- return;
+ INTERVAL i, prev, next;
+
+ if (NILP (object))
+ i = find_interval (BUF_INTERVALS (current_buffer), pos);
+ else if (BUFFERP (object))
+ i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
+ else if (STRINGP (object))
+ i = find_interval (STRING_INTERVALS (object), pos);
+ else
+ abort ();
- if (start > end)
- {
- int temp = start;
- start = end;
- end = temp;
- }
+ if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
+ return 0;
+ *val = textget (i->plist, prop);
+ if (NILP (*val))
+ return 0;
- /* For an insert operation, check the two chars around the position. */
- if (start == end)
- {
- INTERVAL prev;
- Lisp_Object before, after;
+ next = i; /* remember it in advance */
+ prev = previous_interval (i);
+ while (! NULL_INTERVAL_P (prev)
+ && EQ (*val, textget (prev->plist, prop)))
+ i = prev, prev = previous_interval (prev);
+ *start = i->position;
- /* 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);
+ next = next_interval (i);
+ while (! NULL_INTERVAL_P (next)
+ && EQ (*val, textget (next->plist, prop)))
+ i = next, next = next_interval (next);
+ *end = i->position + LENGTH (i);
- 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");
- }
- }
+ return 1;
+}
+\f
+/* Return the proper local keymap TYPE for position POSITION in
+ BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
+ specified by the PROP property, if any. Otherwise, if TYPE is
+ `local-map' use BUFFER's local map. */
- 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");
- }
- }
- }
+Lisp_Object
+get_local_map (position, buffer, type)
+ register int position;
+ register struct buffer *buffer;
+ Lisp_Object type;
+{
+ Lisp_Object prop, lispy_position, lispy_buffer;
+ int old_begv, old_zv, old_begv_byte, old_zv_byte;
- /* 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. */
+ /* Perhaps we should just change `position' to the limit. */
+ if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
+ abort ();
- i = find_interval (intervals, start);
- do
- {
- if (! INTERVAL_WRITABLE_P (i))
- error ("Attempt to modify read-only text");
+ /* 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);
+ old_begv_byte = BUF_BEGV_BYTE (buffer);
+ old_zv_byte = BUF_ZV_BYTE (buffer);
+ BUF_BEGV (buffer) = BUF_BEG (buffer);
+ BUF_ZV (buffer) = BUF_Z (buffer);
+ BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
+ BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
+
+ XSETFASTINT (lispy_position, position);
+ XSETBUFFER (lispy_buffer, buffer);
+ /* First check if the CHAR has any property. This is because when
+ we click with the mouse, the mouse pointer is really pointing
+ to the CHAR after POS. */
+ prop = Fget_char_property (lispy_position, type, lispy_buffer);
+ /* If not, look at the POS's properties. This is necessary because when
+ editing a field with a `local-map' property, we want insertion at the end
+ to obey the `local-map' property. */
+ if (NILP (prop))
+ prop = get_pos_property (lispy_position, type, lispy_buffer);
- 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;
- }
+ BUF_BEGV (buffer) = old_begv;
+ BUF_ZV (buffer) = old_zv;
+ BUF_BEGV_BYTE (buffer) = old_begv_byte;
+ BUF_ZV_BYTE (buffer) = old_zv_byte;
- i = next_interval (i);
- }
- /* Keep going thru the interval containing the char before END. */
- while (! NULL_INTERVAL_P (i) && i->position < end);
+ /* Use the local map only if it is valid. */
+ prop = get_keymap (prop, 0, 0);
+ if (CONSP (prop))
+ return prop;
- GCPRO1 (hooks);
- hooks = Fnreverse (hooks);
- while (! EQ (hooks, Qnil))
- {
- call_mod_hooks (Fcar (hooks), make_number (start),
- make_number (end));
- hooks = Fcdr (hooks);
- }
- UNGCPRO;
- }
+ if (EQ (type, Qkeymap))
+ return Qnil;
+ else
+ return buffer->keymap;
}
-
+\f
/* Produce an interval tree reflecting the intervals in
- TREE from START to START + LENGTH. */
+ TREE from START to START + LENGTH.
+ The new interval tree has no parent and has a starting-position of 0. */
INTERVAL
copy_intervals (tree, start, length)
return NULL_INTERVAL;
new = make_interval ();
- new->position = 1;
+ new->position = 0;
got = (LENGTH (i) - (start - i->position));
new->total_length = length;
+ CHECK_TOTAL_LENGTH (new);
copy_properties (i, new);
t = new;
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 (BUF_INTERVALS (XBUFFER (buffer)),
+ 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;
+ SET_INTERVAL_OBJECT (interval_copy, string);
+ STRING_SET_INTERVALS (string, interval_copy);
}
\f
-/* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
+/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
Assume they have identical characters. */
int
Lisp_Object s1, s2;
{
INTERVAL i1, i2;
- int pos = 1;
- int end = XSTRING (s1)->size + 1;
+ int pos = 0;
+ int end = SCHARS (s1);
- /* 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);
+ i1 = find_interval (STRING_INTERVALS (s1), 0);
+ i2 = find_interval (STRING_INTERVALS (s2), 0);
while (pos < end)
{
}
return 1;
}
+\f
+/* Recursively adjust interval I in the current buffer
+ for setting enable_multibyte_characters to MULTI_FLAG.
+ The range of interval I is START ... END in characters,
+ START_BYTE ... END_BYTE in bytes. */
+
+static void
+set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
+ INTERVAL i;
+ int multi_flag;
+ int start, start_byte, end, end_byte;
+{
+ /* Fix the length of this interval. */
+ if (multi_flag)
+ i->total_length = end - start;
+ else
+ i->total_length = end_byte - start_byte;
+ CHECK_TOTAL_LENGTH (i);
+
+ if (TOTAL_LENGTH (i) == 0)
+ {
+ delete_interval (i);
+ return;
+ }
+
+ /* Recursively fix the length of the subintervals. */
+ if (i->left)
+ {
+ int left_end, left_end_byte;
+
+ if (multi_flag)
+ {
+ int temp;
+ left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
+ left_end = BYTE_TO_CHAR (left_end_byte);
+
+ temp = CHAR_TO_BYTE (left_end);
+
+ /* If LEFT_END_BYTE is in the middle of a character,
+ adjust it and LEFT_END to a char boundary. */
+ if (left_end_byte > temp)
+ {
+ left_end_byte = temp;
+ }
+ if (left_end_byte < temp)
+ {
+ left_end--;
+ left_end_byte = CHAR_TO_BYTE (left_end);
+ }
+ }
+ else
+ {
+ left_end = start + LEFT_TOTAL_LENGTH (i);
+ left_end_byte = CHAR_TO_BYTE (left_end);
+ }
+
+ set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
+ left_end, left_end_byte);
+ }
+ if (i->right)
+ {
+ int right_start_byte, right_start;
+
+ if (multi_flag)
+ {
+ int temp;
+
+ right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
+ right_start = BYTE_TO_CHAR (right_start_byte);
+
+ /* If RIGHT_START_BYTE is in the middle of a character,
+ adjust it and RIGHT_START to a char boundary. */
+ temp = CHAR_TO_BYTE (right_start);
+
+ if (right_start_byte < temp)
+ {
+ right_start_byte = temp;
+ }
+ if (right_start_byte > temp)
+ {
+ right_start++;
+ right_start_byte = CHAR_TO_BYTE (right_start);
+ }
+ }
+ else
+ {
+ right_start = end - RIGHT_TOTAL_LENGTH (i);
+ right_start_byte = CHAR_TO_BYTE (right_start);
+ }
+
+ set_intervals_multibyte_1 (i->right, multi_flag,
+ right_start, right_start_byte,
+ end, end_byte);
+ }
+
+ /* Rounding to char boundaries can theoretically ake this interval
+ spurious. If so, delete one child, and copy its property list
+ to this interval. */
+ if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
+ {
+ if ((i)->left)
+ {
+ (i)->plist = (i)->left->plist;
+ (i)->left->total_length = 0;
+ delete_interval ((i)->left);
+ }
+ else
+ {
+ (i)->plist = (i)->right->plist;
+ (i)->right->total_length = 0;
+ delete_interval ((i)->right);
+ }
+ }
+}
+
+/* Update the intervals of the current buffer
+ to fit the contents as multibyte (if MULTI_FLAG is 1)
+ or to fit them as non-multibyte (if MULTI_FLAG is 0). */
-#endif /* USE_TEXT_PROPERTIES */
+void
+set_intervals_multibyte (multi_flag)
+ int multi_flag;
+{
+ if (BUF_INTERVALS (current_buffer))
+ set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
+ BEG, BEG_BYTE, Z, Z_BYTE);
+}