X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2189766e34598fedf6d84b53bc78568b42c58306..48abdb63bfcc329482d9ceb0ce9a965085d16c86:/src/intervals.c diff --git a/src/intervals.c b/src/intervals.c index f52e6ea472..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,18 +46,16 @@ Boston, MA 02111-1307, USA. */ #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)); /* Utility functions for intervals. */ @@ -77,16 +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 = 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); - new->position = 1; + SET_INTERVAL_OBJECT (new, parent); return new; } @@ -120,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)); } } @@ -145,7 +148,7 @@ intervals_equal (i0, i1) 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; @@ -158,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. */ @@ -172,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,32 +191,57 @@ intervals_equal (i0, i1) return 1; } -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) 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_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); +/* Traverse an interval tree TREE, performing FUNCTION on each node. + Pass FUNCTION two args: an interval, and 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 + +static int icount; +static int idepth; +static int zero_length; + /* These functions are temporary, for debugging purposes only. */ INTERVAL search_interval, found_interval; @@ -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; { @@ -294,41 +323,45 @@ rotate_right (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; { @@ -338,27 +371,31 @@ rotate_left (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; } @@ -377,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) @@ -386,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) @@ -407,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; } @@ -472,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; @@ -513,37 +562,64 @@ split_interval_left (interval, offset) 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; + 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; } +/* 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) @@ -556,15 +632,25 @@ find_interval (tree, 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) { @@ -582,9 +668,9 @@ 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 */ + tree->position + = (position - relative_position /* left edge of *tree. */ + + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */ return tree; } @@ -620,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; @@ -640,7 +726,6 @@ previous_interval (interval) register INTERVAL interval; { register INTERVAL i; - register position_of_previous; if (NULL_INTERVAL_P (interval)) return NULL_INTERVAL; @@ -660,19 +745,22 @@ 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; } /* Find the interval containing POS given some non-NULL INTERVAL - in the same tree. */ + 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; @@ -681,30 +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)) - i = i->left; /* Move to the left child */ - else if (NULL_PARENT (i)) + { + 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 = 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)) - i = i->right; /* Move to the right child */ - else if (NULL_PARENT (i)) - error ("Point after end of properties"); - else - i = i->parent; + { + 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 %d after end of properties", pos); + else + i = INTERVAL_PARENT (i); continue; } - else + else return i; } } @@ -746,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) @@ -754,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 @@ -761,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; @@ -790,54 +890,90 @@ adjust_intervals_for_insertion (tree, position, length) 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_NONSTICKY_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)) { Lisp_Object tail; Lisp_Object front, rear; - front = textget (i->plist, Qfront_sticky); - rear = textget (i->plist, Qrear_nonsticky); + tail = i->plist; - /* Does any actual property pose an actual problem? */ - for (tail = i->plist; ! NILP (tail); tail = Fcdr (Fcdr (tail))) + /* 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)) { - Lisp_Object prop; - prop = XCONS (tail)->car; + /* 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; + } - /* Is this particular property rear-sticky? - Note, if REAR isn't a cons, it must be non-nil, - which means that all properties are rear-nonsticky. */ - if (CONSP (rear) && NILP (Fmemq (prop, rear))) - continue; + /* 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? - Note, if FRONT isn't a cons, it must be nil, - which means that all properties are front-nonsticky. */ + /* Is this particular property front-sticky? */ if (CONSP (front) && ! NILP (Fmemq (prop, front))) continue; - /* PROP isn't sticky on either side => it is a real problem. */ - break; + /* 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)) { @@ -866,15 +1002,24 @@ 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. */ - 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; @@ -914,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; } @@ -982,17 +1128,19 @@ merge_properties_sticky (pleft, pright) 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; /* Indicate whether the property is explicitly defined on the left. @@ -1001,8 +1149,15 @@ merge_properties_sticky (pleft, pright) lpresent = ! NILP (tail2); lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2))); - use_left = ! TMEM (sym, lrear) && lpresent; - use_right = TMEM (sym, rfront); + /* 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) { if (NILP (lval)) @@ -1031,31 +1186,38 @@ merge_properties_sticky (pleft, pright) } /* 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))))) { 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. */ @@ -1070,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) @@ -1080,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. */ @@ -1105,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; } @@ -1130,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); } } @@ -1189,6 +1352,7 @@ interval_deletion_adjustment (tree, from, amount) relative_position, amount); tree->total_length -= subtract; + CHECK_TOTAL_LENGTH (tree); return subtract; } /* Right branch */ @@ -1203,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); @@ -1217,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; } @@ -1238,13 +1404,17 @@ adjust_intervals_for_deletion (buffer, start, length) { 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)) @@ -1256,14 +1426,15 @@ adjust_intervals_for_deletion (buffer, start, length) 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) @@ -1311,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 @@ -1320,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; } @@ -1334,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 @@ -1364,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, @@ -1373,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; } @@ -1387,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 @@ -1414,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)) @@ -1471,6 +1668,11 @@ make_new_interval (intervals, start, length) /* 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 @@ -1511,23 +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) { 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; } @@ -1540,8 +1745,11 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) { 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; + BUF_INTERVALS (buffer)->up_obj = 1; + + /* Explicitly free the old tree here? */ return; } @@ -1560,7 +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) = reproduce_tree (source, INTERVAL_PARENT (tree)); + BUF_INTERVALS (buffer)->position = BEG; + BUF_INTERVALS (buffer)->up_obj = 1; /* Explicitly free the old tree here. */ return; @@ -1573,7 +1783,7 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) 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, @@ -1585,14 +1795,19 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) = 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. */ @@ -1602,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))) @@ -1627,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 @@ -1635,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); +} - 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); } @@ -1654,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; } @@ -1694,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 @@ -1705,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 @@ -1714,9 +2013,8 @@ set_point_both (buffer, charpos, bytepos) register struct buffer *buffer; register int charpos, bytepos; { - register INTERVAL to, from, toprev, fromprev, target; + register INTERVAL to, from, toprev, fromprev; int buffer_point; - register Lisp_Object obj; int old_position = BUF_PT (buffer); int backwards = (charpos < old_position ? 1 : 0); int have_overlays; @@ -1738,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. */ @@ -1798,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 back over all chars with matching intangible property. */ if (! NILP (intangible_propval)) - while (XINT (pos) < BUF_ZV (buffer) - && EQ (Fget_char_property (pos, Qintangible, Qnil), - intangible_propval)) - pos = Fnext_char_property_change (pos, Qnil); - + { + 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); } @@ -1938,7 +2268,7 @@ move_if_not_intangible (position) Qintangible, Qnil); /* If following char is intangible, - skip back over all chars with matching intangible property. */ + skip forward over all chars with matching intangible property. */ if (! NILP (intangible_propval)) while (XINT (pos) < ZV && EQ (Fget_char_property (pos, Qintangible, Qnil), @@ -1946,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). */ @@ -1955,16 +2289,65 @@ move_if_not_intangible (position) SET_PT (position); } -/* 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. */ +/* 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. + + OBJECT is the string or buffer to look for the property in; + nil means the current buffer. */ + +int +get_property_and_range (pos, prop, val, start, end, object) + int pos; + Lisp_Object prop, *val; + int *start, *end; + Lisp_Object object; +{ + 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 (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos)) + return 0; + *val = textget (i->plist, prop); + if (NILP (*val)) + return 0; + + 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; + + 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); + + return 1; +} + +/* 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. */ @@ -1982,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; @@ -1996,18 +2383,19 @@ 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 = Findirect_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 - 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) @@ -2030,9 +2418,10 @@ 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; @@ -2062,11 +2451,11 @@ 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 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 @@ -2074,13 +2463,11 @@ compare_string_intervals (s1, s2) 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) { @@ -2105,21 +2492,6 @@ compare_string_intervals (s1, s2) return 1; } -static void set_intervals_multibyte_1 (INTERVAL, int, int, int, int, int); - -/* 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). */ - -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); -} - /* 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, @@ -2131,13 +2503,18 @@ set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte) int multi_flag; int start, start_byte, end, end_byte; { - INTERVAL left, right; - /* 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) @@ -2146,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 { @@ -2164,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 { @@ -2177,6 +2585,39 @@ 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 + to fit the contents as multibyte (if MULTI_FLAG is 1) + or to fit them as non-multibyte (if MULTI_FLAG is 0). */ + +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); } -#endif /* USE_TEXT_PROPERTIES */ +/* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27 + (do not change this comment) */