X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f94ecad1f5d6e5a325ca1a749fd41f711ce84229..5883787cd6e7b35636ff9928c2c21022906bb8da:/src/intervals.c diff --git a/src/intervals.c b/src/intervals.c index cfdf892340..9ed2a651f5 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1,5 +1,5 @@ /* Code for doing intervals. - Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc. + Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -45,14 +45,13 @@ 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)); @@ -81,8 +80,8 @@ create_root_interval (parent) } else if (STRINGP (parent)) { - new->total_length = XSTRING (parent)->size; - XSTRING (parent)->intervals = new; + new->total_length = SCHARS (parent); + STRING_SET_INTERVALS (parent, new); new->position = 0; } @@ -189,24 +188,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_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 @@ -237,7 +259,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; } @@ -259,7 +281,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; } @@ -286,7 +308,7 @@ root_interval (interval) c c */ -static INTERVAL +static INLINE INTERVAL rotate_right (interval) INTERVAL interval; { @@ -332,7 +354,7 @@ rotate_right (interval) c c */ -static INTERVAL +static INLINE INTERVAL rotate_left (interval) INTERVAL interval; { @@ -430,7 +452,7 @@ balance_possible_root_interval (interval) if (BUFFERP (parent)) BUF_INTERVALS (XBUFFER (parent)) = interval; else if (STRINGP (parent)) - XSTRING (parent)->intervals = interval; + STRING_SET_INTERVALS (parent, interval); } return interval; @@ -612,7 +634,8 @@ find_interval (tree, position) 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) { @@ -720,7 +743,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; @@ -1110,7 +1135,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) @@ -1255,7 +1280,7 @@ delete_interval (i) if (BUFFERP (owner)) BUF_INTERVALS (XBUFFER (owner)) = parent; else if (STRINGP (owner)) - XSTRING (owner)->intervals = parent; + STRING_SET_INTERVALS (owner, parent); else abort (); @@ -1655,24 +1680,22 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit) { register INTERVAL under, over, this, prev; register INTERVAL tree; - int middle; tree = BUF_INTERVALS (buffer); - /* If the new text has no properties, it becomes part of whatever - interval it was inserted into. */ + /* If the new text has no properties, then with inheritance it + becomes part of whatever interval it was inserted into. + To prevent inheritance, we must clear out the properties + of the newly inserted text. */ if (NULL_INTERVAL_P (source)) { Lisp_Object buf; - if (!inherit && ! NULL_INTERVAL_P (tree)) + if (!inherit && !NULL_INTERVAL_P (tree) && length > 0) { - 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))) BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer)); @@ -1735,11 +1758,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 { @@ -1795,18 +1813,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); } @@ -1814,9 +1840,16 @@ 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)) + return tail; + tail = XCDR (tail); + for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail)) + fallback = Fplist_get (plist, XCAR (tail)); + if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties)) + fallback = Fplist_get (Vdefault_text_properties, prop); + return fallback; } @@ -1865,6 +1898,52 @@ 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)) + == (test_offs == 0 ? 1 : -1)) + /* Invisible property is from an overlay. */ + : (test_offs == 0 + ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0 + : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1))) + pos += adj; + + return pos; +} + /* Set point in BUFFER to CHARPOS, which corresponds to byte position BYTEPOS. If the target position is before an intangible character, move to an ok place. */ @@ -1957,41 +2036,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 preceeding 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); } @@ -2135,7 +2247,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 (); @@ -2161,18 +2273,16 @@ get_property_and_range (pos, prop, val, start, end, object) return 1; } -/* If TYPE is `keymap', return the map specified by the `keymap' - property at POSITION in BUFFER or nil. - - Otherwise 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, type) register int position; register struct buffer *buffer; - enum map_property type; + Lisp_Object type; { Lisp_Object prop, lispy_position, lispy_buffer; int old_begv, old_zv, old_begv_byte, old_zv_byte; @@ -2198,9 +2308,7 @@ get_local_map (position, buffer, type) --position; XSETFASTINT (lispy_position, position); XSETBUFFER (lispy_buffer, buffer); - prop = Fget_char_property (lispy_position, - type == keymap ? Qkeymap : Qlocal_map, - lispy_buffer); + prop = Fget_char_property (lispy_position, type, lispy_buffer); BUF_BEGV (buffer) = old_begv; BUF_ZV (buffer) = old_zv; @@ -2212,7 +2320,7 @@ get_local_map (position, buffer, type) if (CONSP (prop)) return prop; - if (type == keymap) + if (EQ (type, Qkeymap)) return Qnil; else return buffer->keymap; @@ -2276,7 +2384,7 @@ copy_intervals_to_string (string, buffer, position, length) return; SET_INTERVAL_OBJECT (interval_copy, string); - XSTRING (string)->intervals = interval_copy; + STRING_SET_INTERVALS (string, interval_copy); } /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise. @@ -2288,10 +2396,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) {