/* 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.
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;
+}
\f
/* Changing the plists of individual intervals. */
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)
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);
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);
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);
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));
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))
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));
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;
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)
{
{
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);
/* 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);
/* 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
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,
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));
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));
}
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);
}
}
}
return Qnil;
}
+
+\f
+/* 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;
+}
+
\f
/* 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
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); */