X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..7fdb5d54391088703953fcb22a06339531c36281:/src/textprop.c diff --git a/src/textprop.c b/src/textprop.c index a243eb6c91..a039c17ae6 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1,6 +1,6 @@ /* Interface code for dealing with text properties. - Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003 - Free Software Foundation, Inc. + Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, + 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,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. */ #include #include "lisp.h" @@ -78,6 +78,8 @@ Lisp_Object Vtext_property_default_nonsticky; Lisp_Object interval_insert_behind_hooks; Lisp_Object interval_insert_in_front_hooks; +static void text_read_only P_ ((Lisp_Object)) NO_RETURN; + /* Signal a `text-read-only' error. This function makes it easier to capture that error in GDB by putting a breakpoint on it. */ @@ -86,7 +88,10 @@ static void text_read_only (propval) Lisp_Object propval; { - Fsignal (Qtext_read_only, STRINGP (propval) ? Fcons (propval, Qnil) : Qnil); + if (STRINGP (propval)) + xsignal1 (Qtext_read_only, propval); + + xsignal0 (Qtext_read_only); } @@ -637,30 +642,13 @@ get_char_property_and_overlay (position, prop, object, overlay) } if (BUFFERP (object)) { - int posn = XINT (position); int noverlays; - Lisp_Object *overlay_vec, tem; - int len; + Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; set_buffer_temp (XBUFFER (object)); - /* First try with room for 40 overlays. */ - len = 40; - overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - - noverlays = overlays_at (posn, 0, &overlay_vec, &len, - NULL, NULL, 0); - - /* If there are more than 40, - make enough space for all, and try again. */ - if (noverlays > len) - { - len = noverlays; - overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - noverlays = overlays_at (posn, 0, &overlay_vec, &len, - NULL, NULL, 0); - } + GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0); noverlays = sort_overlays (overlay_vec, noverlays, w); set_buffer_temp (obuf); @@ -668,7 +656,7 @@ get_char_property_and_overlay (position, prop, object, overlay) /* Now check the overlays in order of decreasing priority. */ while (--noverlays >= 0) { - tem = Foverlay_get (overlay_vec[noverlays], prop); + Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop); if (!NILP (tem)) { if (overlay) @@ -703,6 +691,31 @@ overlays are considered only if they are associated with OBJECT. */) { return get_char_property_and_overlay (position, prop, object, 0); } + +DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay, + Sget_char_property_and_overlay, 2, 3, 0, + doc: /* Like `get-char-property', but with extra overlay information. +The value is a cons cell. Its car is the return value of `get-char-property' +with the same arguments--that is, the value of POSITION's property +PROP in OBJECT. Its cdr is the overlay in which the property was +found, or nil, if it was found as a text property or not found at all. + +OBJECT is optional and defaults to the current buffer. OBJECT may be +a string, a buffer or a window. For strings, the cdr of the return +value is always nil, since strings do not have overlays. If OBJECT is +a window, then that window's buffer is used, but window-specific +overlays are considered only if they are associated with OBJECT. If +POSITION is at the end of OBJECT, both car and cdr are nil. */) + (position, prop, object) + Lisp_Object position, object; + register Lisp_Object prop; +{ + Lisp_Object overlay; + Lisp_Object val + = get_char_property_and_overlay (position, prop, object, &overlay); + return Fcons(val, overlay); +} + DEFUN ("next-char-property-change", Fnext_char_property_change, Snext_char_property_change, 1, 2, 0, @@ -710,10 +723,11 @@ DEFUN ("next-char-property-change", Fnext_char_property_change, This scans characters forward in the current buffer from POSITION till it finds a change in some text property, or the beginning or end of an overlay, and returns the position of that. -If none is found, the function returns (point-max). +If none is found up to (point-max), the function returns (point-max). -If the optional third argument LIMIT is non-nil, don't search -past position LIMIT; return LIMIT if nothing is found before LIMIT. */) +If the optional second argument LIMIT is non-nil, don't search +past position LIMIT; return LIMIT if nothing is found before LIMIT. +LIMIT is a no-op if it is greater than (point-max). */) (position, limit) Lisp_Object position, limit; { @@ -722,7 +736,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) temp = Fnext_overlay_change (position); if (! NILP (limit)) { - CHECK_NUMBER (limit); + CHECK_NUMBER_COERCE_MARKER (limit); if (XINT (limit) < XINT (temp)) temp = limit; } @@ -735,10 +749,11 @@ DEFUN ("previous-char-property-change", Fprevious_char_property_change, Scans characters backward in the current buffer from POSITION till it finds a change in some text property, or the beginning or end of an overlay, and returns the position of that. -If none is found, the function returns (point-max). +If none is found since (point-min), the function returns (point-min). -If the optional third argument LIMIT is non-nil, don't search -past position LIMIT; return LIMIT if nothing is found before LIMIT. */) +If the optional second argument LIMIT is non-nil, don't search +past position LIMIT; return LIMIT if nothing is found before LIMIT. +LIMIT is a no-op if it is less than (point-min). */) (position, limit) Lisp_Object position, limit; { @@ -747,7 +762,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) temp = Fprevious_overlay_change (position); if (! NILP (limit)) { - CHECK_NUMBER (limit); + CHECK_NUMBER_COERCE_MARKER (limit); if (XINT (limit) > XINT (temp)) temp = limit; } @@ -764,6 +779,9 @@ If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. +In a string, scan runs to the end of the string. +In a buffer, it runs to (point-max), and the value cannot exceed that. + The property values are compared with `eq'. If the property is constant all the way to the end of OBJECT, return the last valid position in OBJECT. @@ -780,7 +798,10 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (NILP (limit)) position = make_number (SCHARS (object)); else - position = limit; + { + CHECK_NUMBER (limit); + position = limit; + } } } else @@ -797,25 +818,35 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) Fset_buffer (object); } + CHECK_NUMBER_COERCE_MARKER (position); + initial_value = Fget_char_property (position, prop, object); if (NILP (limit)) - XSETFASTINT (limit, BUF_ZV (current_buffer)); + XSETFASTINT (limit, ZV); else CHECK_NUMBER_COERCE_MARKER (limit); - for (;;) + if (XFASTINT (position) >= XFASTINT (limit)) { - position = Fnext_char_property_change (position, limit); - if (XFASTINT (position) >= XFASTINT (limit)) { - position = limit; - break; - } - - value = Fget_char_property (position, prop, object); - if (!EQ (value, initial_value)) - break; + position = limit; + if (XFASTINT (position) > ZV) + XSETFASTINT (position, ZV); } + else + while (1) + { + position = Fnext_char_property_change (position, limit); + if (XFASTINT (position) >= XFASTINT (limit)) + { + position = limit; + break; + } + + value = Fget_char_property (position, prop, object); + if (!EQ (value, initial_value)) + break; + } unbind_to (count, Qnil); } @@ -833,6 +864,9 @@ If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. +In a string, scan runs to the start of the string. +In a buffer, it runs to (point-min), and the value cannot be less than that. + The property values are compared with `eq'. If the property is constant all the way to the start of OBJECT, return the first valid position in OBJECT. @@ -849,7 +883,10 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (NILP (limit)) position = make_number (SCHARS (object)); else - position = limit; + { + CHECK_NUMBER (limit); + position = limit; + } } } else @@ -865,20 +902,26 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT. */) Fset_buffer (object); } + CHECK_NUMBER_COERCE_MARKER (position); + if (NILP (limit)) - XSETFASTINT (limit, BUF_BEGV (current_buffer)); + XSETFASTINT (limit, BEGV); else CHECK_NUMBER_COERCE_MARKER (limit); if (XFASTINT (position) <= XFASTINT (limit)) - position = limit; + { + position = limit; + if (XFASTINT (position) < BEGV) + XSETFASTINT (position, BEGV); + } else { - Lisp_Object initial_value = - Fget_char_property (make_number (XFASTINT (position) - 1), - prop, object); + Lisp_Object initial_value + = Fget_char_property (make_number (XFASTINT (position) - 1), + prop, object); - for (;;) + while (1) { position = Fprevious_char_property_change (position, limit); @@ -889,9 +932,9 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT. */) } else { - Lisp_Object value = - Fget_char_property (make_number (XFASTINT (position) - 1), - prop, object); + Lisp_Object value + = Fget_char_property (make_number (XFASTINT (position) - 1), + prop, object); if (!EQ (value, initial_value)) break; @@ -958,17 +1001,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); - if (NULL_INTERVAL_P (next)) - return limit; - if (NILP (limit)) - XSETFASTINT (limit, (STRINGP (object) - ? SCHARS (object) - : BUF_ZV (XBUFFER (object)))); - if (!(next->position < XFASTINT (limit))) + if (NULL_INTERVAL_P (next) + || (next->position + >= (INTEGERP (limit) + ? XFASTINT (limit) + : (STRINGP (object) + ? SCHARS (object) + : BUF_ZV (XBUFFER (object)))))) return limit; - - XSETFASTINT (position, next->position); - return position; + else + return make_number (next->position); } /* Return 1 if there's a change in some property between BEG and END. */ @@ -1040,16 +1082,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); - if (NULL_INTERVAL_P (next)) + if (NULL_INTERVAL_P (next) + || (next->position + >= (INTEGERP (limit) + ? XFASTINT (limit) + : (STRINGP (object) + ? SCHARS (object) + : BUF_ZV (XBUFFER (object)))))) return limit; - if (NILP (limit)) - XSETFASTINT (limit, (STRINGP (object) - ? SCHARS (object) - : BUF_ZV (XBUFFER (object)))); - if (!(next->position < XFASTINT (limit))) - return limit; - - return make_number (next->position); + else + return make_number (next->position); } DEFUN ("previous-property-change", Fprevious_property_change, @@ -1089,14 +1131,15 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); - if (NULL_INTERVAL_P (previous)) - return limit; - if (NILP (limit)) - XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))); - if (!(previous->position + LENGTH (previous) > XFASTINT (limit))) - return limit; - return make_number (previous->position + LENGTH (previous)); + if (NULL_INTERVAL_P (previous) + || (previous->position + LENGTH (previous) + <= (INTEGERP (limit) + ? XFASTINT (limit) + : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) + return limit; + else + return make_number (previous->position + LENGTH (previous)); } DEFUN ("previous-single-property-change", Fprevious_single_property_change, @@ -1141,14 +1184,15 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); - if (NULL_INTERVAL_P (previous)) - return limit; - if (NILP (limit)) - XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))); - if (!(previous->position + LENGTH (previous) > XFASTINT (limit))) - return limit; - return make_number (previous->position + LENGTH (previous)); + if (NULL_INTERVAL_P (previous) + || (previous->position + LENGTH (previous) + <= (INTEGERP (limit) + ? XFASTINT (limit) + : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) + return limit; + else + return make_number (previous->position + LENGTH (previous)); } /* Callers note, this can GC when OBJECT is a buffer (or nil). */ @@ -1210,7 +1254,7 @@ Return t if any property value actually changed, nil otherwise. */) } if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); /* We are at the beginning of interval I, with LEN chars to scan. */ for (;;) @@ -1299,8 +1343,8 @@ the designated part of OBJECT. */) properties PROPERTIES. OBJECT is the buffer or string containing the text. OBJECT nil means use the current buffer. SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value - is non-nil if properties were replaced; it is nil if there weren't - any properties to replace. */ + is nil if the function _detected_ that it did not replace any + properties, non-nil otherwise. */ Lisp_Object set_text_properties (start, end, properties, object, signal_after_change_p) @@ -1324,7 +1368,7 @@ set_text_properties (start, end, properties, object, signal_after_change_p) && XFASTINT (end) == SCHARS (object)) { if (! STRING_INTERVALS (object)) - return Qt; + return Qnil; STRING_SET_INTERVALS (object, NULL_INTERVAL); return Qt; @@ -1350,7 +1394,7 @@ set_text_properties (start, end, properties, object, signal_after_change_p) } if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); set_text_properties_1 (start, end, properties, object, i); @@ -1498,7 +1542,7 @@ Use set-text-properties if you want to remove all text properties. */) } if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); /* We are at the beginning of an interval, with len to scan */ for (;;) @@ -1585,10 +1629,12 @@ Return t if any property was actually removed, nil otherwise. */) } } - if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); - - /* We are at the beginning of an interval, with len to scan */ + /* We are at the beginning of an interval, with len to scan. + The flag `modified' records if changes have been made. + When object is a buffer, we must call modify_region before changes are + made and signal_after_change when we are done. + We call modify_region before calling remove_properties iff modified == 0, + and we call signal_after_change before returning iff modified != 0. */ for (;;) { if (i == 0) @@ -1597,10 +1643,20 @@ Return t if any property was actually removed, nil otherwise. */) if (LENGTH (i) >= len) { if (! interval_has_some_properties_list (properties, i)) - return modified ? Qt : Qnil; + if (modified) + { + if (BUFFERP (object)) + signal_after_change (XINT (start), XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; + } + else + return Qnil; if (LENGTH (i) == len) { + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1612,6 +1668,8 @@ Return t if any property was actually removed, nil otherwise. */) unchanged = i; i = split_interval_left (i, len); copy_properties (unchanged, i); + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1619,8 +1677,14 @@ Return t if any property was actually removed, nil otherwise. */) return Qt; } + if (interval_has_some_properties_list (properties, i)) + { + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end), 1); + remove_properties (Qnil, properties, i, object); + modified = 1; + } len -= LENGTH (i); - modified += remove_properties (Qnil, properties, i, object); i = next_interval (i); } } @@ -1730,8 +1794,12 @@ text_property_stickiness (prop, pos, buffer) /* PROP is rear-non-sticky. */ is_rear_sticky = 0; } + else + return 0; /* Consider following character. */ + /* This signals an arg-out-of-range error if pos is outside the + buffer's accessible range. */ front_sticky = Fget_text_property (pos, Qfront_sticky, buffer); if (EQ (front_sticky, Qt) @@ -2226,7 +2294,9 @@ If a character in a buffer has PROPERTY, new text inserted adjacent to the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil, inherits it if NONSTICKINESS is nil. The front-sticky and rear-nonsticky properties of the character overrides NONSTICKINESS. */); - Vtext_property_default_nonsticky = Qnil; + /* Text property `syntax-table' should be nonsticky by default. */ + Vtext_property_default_nonsticky + = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil); staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks); @@ -2277,6 +2347,7 @@ rear-nonsticky properties of the character overrides NONSTICKINESS. */); defsubr (&Stext_properties_at); defsubr (&Sget_text_property); defsubr (&Sget_char_property); + defsubr (&Sget_char_property_and_overlay); defsubr (&Snext_char_property_change); defsubr (&Sprevious_char_property_change); defsubr (&Snext_single_char_property_change);