X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b78265036088d5d0eac2a03b929adb50aa59b45c..75728599a0bc6903eaa538c049d96a178ba85150:/src/textprop.c diff --git a/src/textprop.c b/src/textprop.c index 76600728d1..401e26f1a3 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1,5 +1,5 @@ /* Interface code for dealing with text properties. - Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001 + Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -268,6 +268,30 @@ interval_has_some_properties (plist, i) return 0; } + +/* Return nonzero if the plist of interval I has any of the + property names in LIST, regardless of their values. */ + +static INLINE int +interval_has_some_properties_list (list, i) + Lisp_Object list; + INTERVAL i; +{ + register Lisp_Object tail1, tail2, sym; + + /* Go through each element of LIST. */ + for (tail1 = list; ! NILP (tail1); tail1 = XCDR (tail1)) + { + sym = Fcar (tail1); + + /* Go through i's plist, looking for tail1 */ + for (tail2 = i->plist; ! NILP (tail2); tail2 = XCDR (XCDR (tail2))) + if (EQ (sym, XCAR (tail2))) + return 1; + } + + return 0; +} /* Changing the plists of individual intervals. */ @@ -414,58 +438,69 @@ add_properties (plist, i, object) return changed; } -/* For any members of PLIST which are properties of I, remove them - from I's plist. +/* For any members of PLIST, or LIST, + which are properties of I, remove them from I's plist. + (If PLIST is non-nil, use that, otherwise use LIST.) OBJECT is the string or buffer containing I. */ static int -remove_properties (plist, i, object) - Lisp_Object plist; +remove_properties (plist, list, i, object) + Lisp_Object plist, list; INTERVAL i; Lisp_Object object; { register Lisp_Object tail1, tail2, sym, current_plist; register int changed = 0; + /* Nonzero means tail1 is a plist, otherwise it is a list. */ + int use_plist; + current_plist = i->plist; - /* Go through each element of plist. */ - for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) + + if (! NILP (plist)) + tail1 = plist, use_plist = 1; + else + tail1 = list, use_plist = 0; + + /* Go through each element of LIST or PLIST. */ + while (CONSP (tail1)) { - sym = Fcar (tail1); + sym = XCAR (tail1); - /* First, remove the symbol if its at the head of the list */ - while (! NILP (current_plist) && EQ (sym, Fcar (current_plist))) + /* First, remove the symbol if it's at the head of the list */ + while (CONSP (current_plist) && EQ (sym, XCAR (current_plist))) { if (BUFFERP (object)) - { - record_property_change (i->position, LENGTH (i), - sym, Fcar (Fcdr (current_plist)), - object); - } + record_property_change (i->position, LENGTH (i), + sym, XCAR (XCDR (current_plist)), + object); - current_plist = Fcdr (Fcdr (current_plist)); + current_plist = XCDR (XCDR (current_plist)); changed++; } - /* Go through i's plist, looking for sym */ + /* Go through I's plist, looking for SYM. */ tail2 = current_plist; while (! NILP (tail2)) { register Lisp_Object this; - this = Fcdr (Fcdr (tail2)); - if (EQ (sym, Fcar (this))) + this = XCDR (XCDR (tail2)); + if (CONSP (this) && EQ (sym, XCAR (this))) { if (BUFFERP (object)) - { - record_property_change (i->position, LENGTH (i), - sym, Fcar (Fcdr (this)), object); - } + record_property_change (i->position, LENGTH (i), + sym, XCAR (XCDR (this)), object); - Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this))); + Fsetcdr (XCDR (tail2), XCDR (XCDR (this))); changed++; } tail2 = this; } + + /* Advance thru TAIL1 one way or the other. */ + tail1 = XCDR (tail1); + if (use_plist && CONSP (tail1)) + tail1 = XCDR (tail1); } if (changed) @@ -883,7 +918,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (NILP (object)) XSETBUFFER (object, current_buffer); - if (! NILP (limit) && ! EQ (limit, Qt)) + if (!NILP (limit) && !EQ (limit, Qt)) CHECK_NUMBER_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); @@ -911,13 +946,17 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) next = next_interval (i); - while (! NULL_INTERVAL_P (next) && intervals_equal (i, next) + while (!NULL_INTERVAL_P (next) && intervals_equal (i, next) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); if (NULL_INTERVAL_P (next)) return limit; - if (! NILP (limit) && !(next->position < XFASTINT (limit))) + if (NILP (limit)) + XSETFASTINT (limit, (STRINGP (object) + ? XSTRING (object)->size + : BUF_ZV (XBUFFER (object)))); + if (!(next->position < XFASTINT (limit))) return limit; XSETFASTINT (position, next->position); @@ -993,7 +1032,11 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) if (NULL_INTERVAL_P (next)) return limit; - if (! NILP (limit) && !(next->position < XFASTINT (limit))) + if (NILP (limit)) + XSETFASTINT (limit, (STRINGP (object) + ? XSTRING (object)->size + : BUF_ZV (XBUFFER (object)))); + if (!(next->position < XFASTINT (limit))) return limit; return make_number (next->position); @@ -1030,14 +1073,15 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) i = previous_interval (i); previous = previous_interval (i); - while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i) + while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); if (NULL_INTERVAL_P (previous)) return limit; - if (!NILP (limit) - && !(previous->position + LENGTH (previous) > XFASTINT (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)); @@ -1070,7 +1114,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) i = validate_interval_range (object, &position, &position, soft); /* Start with the interval containing the char before point. */ - if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (position)) + if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position)) i = previous_interval (i); if (NULL_INTERVAL_P (i)) @@ -1078,15 +1122,16 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) here_val = textget (i->plist, prop); previous = previous_interval (i); - while (! NULL_INTERVAL_P (previous) + while (!NULL_INTERVAL_P (previous) && EQ (here_val, textget (previous->plist, prop)) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); if (NULL_INTERVAL_P (previous)) return limit; - if (!NILP (limit) - && !(previous->position + LENGTH (previous) > XFASTINT (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)); @@ -1245,9 +1290,7 @@ Lisp_Object set_text_properties (start, end, properties, object, signal_after_change_p) Lisp_Object start, end, properties, object, signal_after_change_p; { - register INTERVAL i, unchanged; - register INTERVAL prev_changed = NULL_INTERVAL; - register int s, len; + register INTERVAL i; Lisp_Object ostart, oend; ostart = start; @@ -1290,11 +1333,45 @@ set_text_properties (start, end, properties, object, signal_after_change_p) return Qnil; } + if (BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end)); + + set_text_properties_1 (start, end, properties, object, i); + + if (BUFFERP (object) && !NILP (signal_after_change_p)) + signal_after_change (XINT (start), XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; +} + +/* Replace properties of text from START to END with new list of + properties PROPERTIES. BUFFER is the buffer containing + the text. This does not obey any hooks. + You can provide the interval that START is located in as I, + or pass NULL for I and this function will find it. + START and END can be in any order. */ + +void +set_text_properties_1 (start, end, properties, buffer, i) + Lisp_Object start, end, properties, buffer; + INTERVAL i; +{ + register INTERVAL prev_changed = NULL_INTERVAL; + register int s, len; + INTERVAL unchanged; + s = XINT (start); len = XINT (end) - s; + if (len == 0) + return; + if (len < 0) + { + s = s + len; + len = - len; + } - if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); + if (i == 0) + i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s); if (i->position != s) { @@ -1305,24 +1382,14 @@ set_text_properties (start, end, properties, object, signal_after_change_p) { copy_properties (unchanged, i); i = split_interval_left (i, len); - set_properties (properties, i, object); - if (BUFFERP (object) && !NILP (signal_after_change_p)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); - - return Qt; + set_properties (properties, i, buffer); + return; } - set_properties (properties, i, object); + set_properties (properties, i, buffer); if (LENGTH (i) == len) - { - if (BUFFERP (object) && !NILP (signal_after_change_p)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); - - return Qt; - } + return; prev_changed = i; len -= LENGTH (i); @@ -1343,13 +1410,10 @@ set_text_properties (start, end, properties, object, signal_after_change_p) /* We have to call set_properties even if we are going to merge the intervals, so as to make the undo records and cause redisplay to happen. */ - set_properties (properties, i, object); + set_properties (properties, i, buffer); if (!NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); - if (BUFFERP (object) && !NILP (signal_after_change_p)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); - return Qt; + return; } len -= LENGTH (i); @@ -1357,7 +1421,7 @@ set_text_properties (start, end, properties, object, signal_after_change_p) /* We have to call set_properties even if we are going to merge the intervals, so as to make the undo records and cause redisplay to happen. */ - set_properties (properties, i, object); + set_properties (properties, i, buffer); if (NULL_INTERVAL_P (prev_changed)) prev_changed = i; else @@ -1365,11 +1429,6 @@ set_text_properties (start, end, properties, object, signal_after_change_p) i = next_interval (i); } - - if (BUFFERP (object) && !NILP (signal_after_change_p)) - signal_after_change (XINT (start), XINT (end) - XINT (start), - XINT (end) - XINT (start)); - return Qt; } DEFUN ("remove-text-properties", Fremove_text_properties, @@ -1435,7 +1494,7 @@ Return t if any property was actually removed, nil otherwise. */) if (LENGTH (i) == len) { - remove_properties (properties, i, object); + remove_properties (properties, Qnil, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1446,7 +1505,7 @@ Return t if any property was actually removed, nil otherwise. */) unchanged = i; i = split_interval_left (i, len); copy_properties (unchanged, i); - remove_properties (properties, i, object); + remove_properties (properties, Qnil, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1454,7 +1513,94 @@ Return t if any property was actually removed, nil otherwise. */) } len -= LENGTH (i); - modified += remove_properties (properties, i, object); + modified += remove_properties (properties, Qnil, i, object); + i = next_interval (i); + } +} + +DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties, + Sremove_list_of_text_properties, 3, 4, 0, + doc: /* Remove some properties from text from START to END. +The third argument LIST-OF-PROPERTIES is a list of property names to remove. +The optional fourth argument, OBJECT, +is the string or buffer containing the text, defaulting to the current buffer. +Return t if any property was actually removed, nil otherwise. */) + (start, end, list_of_properties, object) + Lisp_Object start, end, list_of_properties, object; +{ + register INTERVAL i, unchanged; + register int s, len, modified = 0; + Lisp_Object properties; + properties = list_of_properties; + + if (NILP (object)) + XSETBUFFER (object, current_buffer); + + i = validate_interval_range (object, &start, &end, soft); + if (NULL_INTERVAL_P (i)) + return Qnil; + + s = XINT (start); + len = XINT (end) - s; + + if (i->position != s) + { + /* No properties on this first interval -- return if + it covers the entire region. */ + if (! interval_has_some_properties_list (properties, i)) + { + int got = (LENGTH (i) - (s - i->position)); + if (got >= len) + return Qnil; + len -= got; + i = next_interval (i); + } + /* Split away the beginning of this interval; what we don't + want to modify. */ + else + { + unchanged = i; + i = split_interval_right (unchanged, s - unchanged->position); + copy_properties (unchanged, i); + } + } + + if (BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end)); + + /* We are at the beginning of an interval, with len to scan */ + for (;;) + { + if (i == 0) + abort (); + + if (LENGTH (i) >= len) + { + if (! interval_has_some_properties_list (properties, i)) + return modified ? Qt : Qnil; + + if (LENGTH (i) == len) + { + remove_properties (Qnil, properties, i, object); + if (BUFFERP (object)) + signal_after_change (XINT (start), XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; + } + + /* i has the properties, and goes past the change limit */ + unchanged = i; + i = split_interval_left (i, len); + copy_properties (unchanged, i); + remove_properties (Qnil, properties, i, object); + if (BUFFERP (object)) + signal_after_change (XINT (start), XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; + } + + len -= LENGTH (i); + modified += remove_properties (Qnil, properties, i, object); i = next_interval (i); } } @@ -1530,6 +1676,63 @@ containing the text. */) } return Qnil; } + + +/* Return the direction from which the text-property PROP would be + inherited by any new text inserted at POS: 1 if it would be + inherited from the char after POS, -1 if it would be inherited from + the char before POS, and 0 if from neither. */ + +int +text_property_stickiness (prop, pos) + Lisp_Object prop; + Lisp_Object pos; +{ + Lisp_Object prev_pos, front_sticky; + int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */ + + if (XINT (pos) > BEGV) + /* Consider previous character. */ + { + Lisp_Object rear_non_sticky; + + prev_pos = make_number (XINT (pos) - 1); + rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, Qnil); + + if (!NILP (CONSP (rear_non_sticky) + ? Fmemq (prop, rear_non_sticky) + : rear_non_sticky)) + /* PROP is rear-non-sticky. */ + is_rear_sticky = 0; + } + + /* Consider following character. */ + front_sticky = Fget_text_property (pos, Qfront_sticky, Qnil); + + if (EQ (front_sticky, Qt) + || (CONSP (front_sticky) + && !NILP (Fmemq (prop, front_sticky)))) + /* PROP is inherited from after. */ + is_front_sticky = 1; + + /* Simple cases, where the properties are consistent. */ + if (is_rear_sticky && !is_front_sticky) + return -1; + else if (!is_rear_sticky && is_front_sticky) + return 1; + else if (!is_rear_sticky && !is_front_sticky) + return 0; + + /* The stickiness properties are inconsistent, so we have to + disambiguate. Basically, rear-sticky wins, _except_ if the + property that would be inherited has a value of nil, in which case + front-sticky wins. */ + if (XINT (pos) == BEGV || NILP (Fget_text_property (prev_pos, prop, Qnil))) + return 1; + else + return -1; +} + /* I don't think this is the right interface to export; how often do you want to do something like this, other than when you're copying objects @@ -2051,6 +2254,7 @@ rear-nonsticky properties of the character overrides NONSTICKINESS. */); defsubr (&Sput_text_property); defsubr (&Sset_text_properties); defsubr (&Sremove_text_properties); + defsubr (&Sremove_list_of_text_properties); defsubr (&Stext_property_any); defsubr (&Stext_property_not_all); /* defsubr (&Serase_text_properties); */