X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f56b42ac9e43c1f77ecd782ceab46a65c10604fe..204b78de1b66429250e18785a65392b5027ef103:/src/intervals.c diff --git a/src/intervals.c b/src/intervals.c index bba25d7de8..8bbab5a2a2 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1,5 +1,6 @@ /* Code for doing intervals. - Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc. + Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,8 +16,8 @@ GNU General Public License for more details. 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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* NOTES: @@ -45,15 +46,16 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "puresize.h" #include "keyboard.h" +#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)); /* Utility functions for intervals. */ @@ -74,17 +76,19 @@ create_root_interval (parent) { new->total_length = (BUF_Z (XBUFFER (parent)) - BUF_BEG (XBUFFER (parent))); + CHECK_TOTAL_LENGTH (new); BUF_INTERVALS (XBUFFER (parent)) = new; - new->position = 1; + 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) XFASTINT (parent); + SET_INTERVAL_OBJECT (new, parent); return new; } @@ -118,20 +122,21 @@ merge_properties (source, target) 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)); } } @@ -156,13 +161,13 @@ intervals_equal (i0, i1) 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. */ @@ -170,11 +175,12 @@ intervals_equal (i0, i1) 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--; } @@ -187,24 +193,47 @@ intervals_equal (i0, i1) /* 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) 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; + } } #if 0 @@ -235,7 +264,7 @@ search_for_interval (i, tree) 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; } @@ -257,7 +286,7 @@ count_intervals (i) 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; } @@ -269,7 +298,7 @@ root_interval (interval) register INTERVAL i = interval; while (! ROOT_INTERVAL_P (i)) - i = i->parent; + i = INTERVAL_PARENT (i); return i; } @@ -284,7 +313,7 @@ root_interval (interval) c c */ -static INTERVAL +static INLINE INTERVAL rotate_right (interval) INTERVAL interval; { @@ -296,41 +325,43 @@ rotate_right (interval) if (! ROOT_INTERVAL_P (interval)) { if (AM_LEFT_CHILD (interval)) - interval->parent->left = B; + INTERVAL_PARENT (interval)->left = B; else - interval->parent->right = B; + INTERVAL_PARENT (interval)->right = B; } - B->parent = interval->parent; + 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; { @@ -342,27 +373,29 @@ rotate_left (interval) if (! ROOT_INTERVAL_P (interval)) { if (AM_LEFT_CHILD (interval)) - interval->parent->left = B; + INTERVAL_PARENT (interval)->left = B; else - interval->parent->right = B; + INTERVAL_PARENT (interval)->right = B; } - B->parent = interval->parent; + 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; } @@ -381,6 +414,7 @@ balance_an_interval (i) 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) @@ -390,6 +424,7 @@ balance_an_interval (i) } 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) @@ -411,17 +446,25 @@ balance_possible_root_interval (interval) 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; - XSETFASTINT (parent, (EMACS_INT) 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; } @@ -476,23 +519,25 @@ split_interval_right (interval, offset) 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; + CHECK_TOTAL_LENGTH (new); } else { /* Insert the new node between INTERVAL and its right child. */ new->right = interval->right; - interval->right->parent = new; + 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); } - + balance_possible_root_interval (interval); return new; @@ -521,23 +566,25 @@ split_interval_left (interval, 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; + CHECK_TOTAL_LENGTH (new); } else { /* Insert the new node between INTERVAL and its left child. */ new->left = interval->left; - new->left->parent = new; + 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); } - + balance_possible_root_interval (interval); return new; @@ -560,7 +607,9 @@ interval_start_pos (source) if (NULL_INTERVAL_P (source)) return 0; - XSETFASTINT (parent, (EMACS_INT) source->parent); + if (! INTERVAL_HAS_OBJECT (source)) + return 0; + GET_INTERVAL_OBJECT (parent, source); if (BUFFERP (parent)) return BUF_BEG (XBUFFER (parent)); return 0; @@ -584,20 +633,24 @@ find_interval (tree, position) /* The distance from the left edge of the subtree at TREE to POSITION. */ register int relative_position; - Lisp_Object parent; if (NULL_INTERVAL_P (tree)) return NULL_INTERVAL; - XSETFASTINT (parent, (EMACS_INT) tree->parent); relative_position = position; - if (BUFFERP (parent)) - relative_position -= BUF_BEG (XBUFFER (parent)); + 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) { @@ -616,8 +669,8 @@ find_interval (tree, position) else { tree->position - = (position - relative_position /* the left edge of *tree */ - + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */ + = (position - relative_position /* left edge of *tree. */ + + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */ return tree; } @@ -653,12 +706,12 @@ next_interval (interval) { 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; @@ -692,12 +745,12 @@ previous_interval (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; @@ -705,7 +758,9 @@ previous_interval (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. */ + 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; @@ -714,39 +769,39 @@ update_interval (i, pos) if (NULL_INTERVAL_P (i)) return NULL_INTERVAL; - while (1) + while (1) { - if (pos < i->position) + if (pos < i->position) { /* Move left. */ - if (pos >= i->position - TOTAL_LENGTH (i->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)) + else if (NULL_PARENT (i)) error ("Point before start of properties"); - else - i = i->parent; + 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)) + if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right)) { - i->right->position = INTERVAL_LAST_POS (i) + - LEFT_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 = i->parent; + else if (NULL_PARENT (i)) + error ("Point %d after end of properties", pos); + else + i = INTERVAL_PARENT (i); continue; } - else + else return i; } } @@ -788,6 +843,7 @@ adjust_intervals_for_insertion (tree, position, length) 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) @@ -796,6 +852,7 @@ adjust_intervals_for_insertion (tree, position, length) relative_position -= (TOTAL_LENGTH (this) - RIGHT_TOTAL_LENGTH (this)); this->total_length += length; + CHECK_TOTAL_LENGTH (this); this = this->right; } else @@ -803,6 +860,7 @@ adjust_intervals_for_insertion (tree, position, length) /* 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; @@ -834,11 +892,11 @@ adjust_intervals_for_insertion (tree, position, length) int eobp = 0; Lisp_Object parent; int offset; - + if (TOTAL_LENGTH (tree) == 0) /* Paranoia */ abort (); - XSETFASTINT (parent, (EMACS_INT) tree->parent); + 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 @@ -944,12 +1002,13 @@ adjust_intervals_for_insertion (tree, position, length) /* 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) + 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 stickiness property by property. @@ -1000,13 +1059,14 @@ adjust_intervals_for_insertion (tree, position, length) /* 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; } @@ -1068,19 +1128,19 @@ merge_properties_sticky (pleft, pright) rrear = textget (pright, Qrear_nonsticky); /* Go through each element of PRIGHT. */ - for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (Fcdr (tail1))) + for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1))) { Lisp_Object tmp; - sym = Fcar (tail1); + 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; CONSP (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; /* Indicate whether the property is explicitly defined on the left. @@ -1095,7 +1155,7 @@ merge_properties_sticky (pleft, pright) tmp = Fassq (sym, Vtext_property_default_nonsticky); use_left = (lpresent && ! (TMEM (sym, lrear) - || CONSP (tmp) && ! NILP (XCDR (tmp)))); + || (CONSP (tmp) && ! NILP (XCDR (tmp))))); use_right = (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp)))); if (use_left && use_right) @@ -1126,24 +1186,24 @@ merge_properties_sticky (pleft, pright) } /* Now go through each element of PLEFT. */ - for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (Fcdr (tail2))) + for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) { Lisp_Object tmp; - sym = Fcar (tail2); + 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; CONSP (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 @@ -1172,7 +1232,7 @@ merge_properties_sticky (pleft, pright) 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) @@ -1182,7 +1242,7 @@ merge_properties_sticky (pleft, pright) } -/* 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. */ @@ -1207,8 +1267,9 @@ delete_node (i) 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; } @@ -1232,33 +1293,33 @@ delete_interval (i) if (ROOT_INTERVAL_P (i)) { Lisp_Object owner; - XSETFASTINT (owner, (EMACS_INT) i->parent); + GET_INTERVAL_OBJECT (owner, i); parent = delete_node (i); if (! NULL_INTERVAL_P (parent)) - parent->parent = (INTERVAL) XFASTINT (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); } } @@ -1291,6 +1352,7 @@ interval_deletion_adjustment (tree, from, amount) relative_position, amount); tree->total_length -= subtract; + CHECK_TOTAL_LENGTH (tree); return subtract; } /* Right branch */ @@ -1305,13 +1367,14 @@ interval_deletion_adjustment (tree, from, amount) 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); @@ -1319,9 +1382,10 @@ interval_deletion_adjustment (tree, from, amount) amount = my_amount; tree->total_length -= amount; + CHECK_TOTAL_LENGTH (tree); if (LENGTH (tree) == 0) delete_interval (tree); - + return amount; } @@ -1343,7 +1407,7 @@ adjust_intervals_for_deletion (buffer, start, length) Lisp_Object parent; int offset; - XSETFASTINT (parent, (EMACS_INT) tree->parent); + GET_INTERVAL_OBJECT (parent, tree); offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0); if (NULL_INTERVAL_P (tree)) @@ -1362,6 +1426,7 @@ adjust_intervals_for_deletion (buffer, start, length) if (ONLY_INTERVAL_P (tree)) { tree->total_length -= length; + CHECK_TOTAL_LENGTH (tree); return; } @@ -1417,6 +1482,7 @@ merge_interval_right (i) /* 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 @@ -1426,10 +1492,12 @@ merge_interval_right (i) 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; } @@ -1440,13 +1508,14 @@ merge_interval_right (i) { 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 @@ -1470,6 +1539,7 @@ merge_interval_left (i) /* 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, @@ -1479,10 +1549,12 @@ merge_interval_left (i) 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; } @@ -1493,13 +1565,14 @@ merge_interval_left (i) { 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 @@ -1520,7 +1593,25 @@ reproduce_tree (source, parent) 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)) @@ -1622,26 +1713,26 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) { register INTERVAL under, over, this, prev; register INTERVAL tree; - int middle; + int over_used; 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) { - int saved_inhibit_modification_hooks = inhibit_modification_hooks; XSETBUFFER (buf, buffer); - inhibit_modification_hooks = 1; - Fset_text_properties (make_number (position), - make_number (position + length), - Qnil, buf); - inhibit_modification_hooks = saved_inhibit_modification_hooks; + 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; } @@ -1654,8 +1745,9 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) { Lisp_Object buf; XSETBUFFER (buf, buffer); - BUF_INTERVALS (buffer) = reproduce_tree (source, buf); - BUF_INTERVALS (buffer)->position = 1; + BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf); + BUF_INTERVALS (buffer)->position = BEG; + BUF_INTERVALS (buffer)->up_obj = 1; /* Explicitly free the old tree here? */ @@ -1676,8 +1768,9 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) 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)->position = 1; + BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree)); + BUF_INTERVALS (buffer)->position = BEG; + BUF_INTERVALS (buffer)->up_obj = 1; /* Explicitly free the old tree here. */ return; @@ -1702,11 +1795,6 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) = split_interval_left (this, position - under->position); copy_properties (under, end_unchanged); under->position = position; -#if 0 - /* This code has no effect. */ - prev = 0; - middle = 1; -#endif /* 0 */ } else { @@ -1729,22 +1817,43 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) The properties of under are the result of adjust_intervals_for_insertion, so stickiness has already been taken care of. */ - + + /* OVER is the interval we are copying from next. + OVER_USED says how many characters' worth of OVER + have already been copied into target intervals. + UNDER is the next interval in the target. */ + over_used = 0; while (! NULL_INTERVAL_P (over)) { - if (LENGTH (over) < LENGTH (under)) + /* If UNDER is longer than OVER, split it. */ + if (LENGTH (over) - over_used < LENGTH (under)) { - this = split_interval_left (under, LENGTH (over)); + this = split_interval_left (under, LENGTH (over) - over_used); copy_properties (under, this); } else this = under; - copy_properties (over, this); + + /* THIS is now the interval to copy or merge into. + OVER covers all of it. */ if (inherit) merge_properties (over, this); else copy_properties (over, this); - over = next_interval (over); + + /* If THIS and OVER end at the same place, + advance OVER to a new source interval. */ + if (LENGTH (this) == LENGTH (over) - over_used) + { + over = next_interval (over); + over_used = 0; + } + else + /* Otherwise just record that more of OVER has been used. */ + over_used += LENGTH (this); + + /* Always advance to a new target interval. */ + under = next_interval (this); } if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer))) @@ -1754,7 +1863,7 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) /* 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, + We check for direct properties, for categories with property PROP, and for PROP appearing on the default-text-properties list. */ Lisp_Object @@ -1762,18 +1871,26 @@ textget (plist, prop) Lisp_Object plist; register Lisp_Object prop; { - register Lisp_Object tail, fallback; - fallback = Qnil; + return lookup_char_property (plist, prop, 1); +} + +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; !NILP (tail); tail = Fcdr (Fcdr (tail))) + 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); } @@ -1781,9 +1898,18 @@ textget (plist, prop) if (! NILP (fallback)) return fallback; - if (CONSP (Vdefault_text_properties)) - return Fplist_get (Vdefault_text_properties, prop); - return Qnil; + /* Check for alternative properties */ + tail = Fassq (prop, Vchar_property_alias_alist); + if (! NILP (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; } @@ -1821,7 +1947,7 @@ temp_set_point_both (buffer, charpos, bytepos) BUF_PT (buffer) = charpos; } -/* Set point in BUFFER to CHARPOS. 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 @@ -1832,8 +1958,54 @@ set_point (buffer, charpos) 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 + position BYTEPOS. If the target position is before an intangible character, move to an ok place. */ void @@ -1864,8 +2036,7 @@ set_point_both (buffer, charpos, bytepos) if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer)) abort (); - have_overlays = (! NILP (buffer->overlays_before) - || ! NILP (buffer->overlays_after)); + have_overlays = (buffer->overlays_before || buffer->overlays_after); /* If we have no text properties and overlays, then we can do it quickly. */ @@ -1924,41 +2095,74 @@ set_point_both (buffer, charpos, bytepos) or end of the buffer, so don't bother checking in that case. */ && charpos != BEGV && charpos != ZV) { - Lisp_Object intangible_propval; Lisp_Object pos; - - XSETINT (pos, charpos); + Lisp_Object intangible_propval; if (backwards) { - intangible_propval = Fget_char_property (make_number (charpos), - Qintangible, Qnil); + /* 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); + { + 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 { + /* 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 following char is intangible, - skip forward over all chars with matching intangible property. */ if (! NILP (intangible_propval)) - while (XINT (pos) < BUF_ZV (buffer) - && EQ (Fget_char_property (pos, Qintangible, Qnil), - intangible_propval)) - pos = Fnext_char_property_change (pos, Qnil); - + { + 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); + } } - charpos = XINT (pos); bytepos = buf_charpos_to_bytepos (buffer, charpos); } @@ -2072,8 +2276,12 @@ move_if_not_intangible (position) pos = Fnext_char_property_change (pos, Qnil); } + else if (position < BEGV) + position = BEGV; + else if (position > ZV) + position = ZV; - /* If the whole stretch between PT and POSITION isn't intangible, + /* 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). */ @@ -2102,7 +2310,7 @@ get_property_and_range (pos, prop, val, start, end, object) else if (BUFFERP (object)) i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos); else if (STRINGP (object)) - i = find_interval (XSTRING (object)->intervals, pos); + i = find_interval (STRING_INTERVALS (object), pos); else abort (); @@ -2120,7 +2328,7 @@ get_property_and_range (pos, prop, val, start, end, object) *start = i->position; next = next_interval (i); - while (! NULL_INTERVAL_P (next) + while (! NULL_INTERVAL_P (next) && EQ (*val, textget (next->plist, prop))) i = next, next = next_interval (next); *end = i->position + LENGTH (i); @@ -2128,16 +2336,18 @@ get_property_and_range (pos, prop, val, start, end, object) return 1; } -/* 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. */ +/* 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. */ Lisp_Object -get_local_map (position, buffer) +get_local_map (position, buffer, type) register int position; register struct buffer *buffer; + Lisp_Object type; { - Lisp_Object prop, tem, lispy_position, lispy_buffer; + Lisp_Object prop, lispy_position, lispy_buffer; int old_begv, old_zv, old_begv_byte, old_zv_byte; /* Perhaps we should just change `position' to the limit. */ @@ -2155,13 +2365,17 @@ get_local_map (position, buffer) BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer); BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (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); + /* 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); BUF_BEGV (buffer) = old_begv; BUF_ZV (buffer) = old_zv; @@ -2169,14 +2383,14 @@ get_local_map (position, buffer) BUF_ZV_BYTE (buffer) = old_zv_byte; /* Use the local map only if it is valid. */ - /* Do allow symbols that are defined as keymaps. */ - if (SYMBOLP (prop) && !NILP (prop)) - prop = indirect_function (prop); - if (!NILP (prop) - && (tem = Fkeymapp (prop), !NILP (tem))) + prop = get_keymap (prop, 0, 0); + if (CONSP (prop)) return prop; - return buffer->keymap; + if (EQ (type, Qkeymap)) + return Qnil; + else + return buffer->keymap; } /* Produce an interval tree reflecting the intervals in @@ -2207,6 +2421,7 @@ copy_intervals (tree, start, length) new->position = 0; got = (LENGTH (i) - (start - i->position)); new->total_length = length; + CHECK_TOTAL_LENGTH (new); copy_properties (i, new); t = new; @@ -2236,8 +2451,8 @@ copy_intervals_to_string (string, buffer, position, length) if (NULL_INTERVAL_P (interval_copy)) return; - interval_copy->parent = (INTERVAL) XFASTINT (string); - XSTRING (string)->intervals = interval_copy; + SET_INTERVAL_OBJECT (interval_copy, string); + STRING_SET_INTERVALS (string, interval_copy); } /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise. @@ -2249,10 +2464,10 @@ compare_string_intervals (s1, s2) { INTERVAL i1, i2; int pos = 0; - int end = XSTRING (s1)->size; + int end = SCHARS (s1); - i1 = find_interval (XSTRING (s1)->intervals, 0); - i2 = find_interval (XSTRING (s2)->intervals, 0); + i1 = find_interval (STRING_INTERVALS (s1), 0); + i2 = find_interval (STRING_INTERVALS (s2), 0); while (pos < end) { @@ -2293,6 +2508,13 @@ set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte) 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) @@ -2301,8 +2523,23 @@ set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, 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 { @@ -2319,8 +2556,24 @@ set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte) 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 { @@ -2332,6 +2585,25 @@ set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte) 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 @@ -2346,3 +2618,6 @@ set_intervals_multibyte (multi_flag) set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag, BEG, BEG_BYTE, Z, Z_BYTE); } + +/* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27 + (do not change this comment) */