/* Interface code for dealing with text properties.
- Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Emacs.
only once on the list. Although some code i.e., remove_properties,
handles the more general case, the uniqueness of properties is
necessary for the system to remain consistent. This requirement
- is enforced by the subrs installing properties onto the intervals. */
+ is enforced by the subrs installing properties onto the intervals. */
/* The rest of the file is within this conditional */
#ifdef USE_TEXT_PROPERTIES
\f
-/* Types of hooks. */
+/* Types of hooks. */
Lisp_Object Qmouse_left;
Lisp_Object Qmouse_entered;
Lisp_Object Qpoint_left;
Lisp_Object Qcategory;
Lisp_Object Qlocal_map;
-/* Visual properties text (including strings) may have. */
+/* Visual properties text (including strings) may have. */
Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
Lisp_Object Qinvisible, Qread_only, Qintangible;
CHECK_NUMBER_COERCE_MARKER (*end, 0);
/* If we are asked for a point, but from a subr which operates
- on a range, then return nothing. */
+ on a range, then return nothing. */
if (EQ (*begin, *end) && begin != end)
return NULL_INTERVAL;
args_out_of_range (*begin, *end);
i = BUF_INTERVALS (b);
- /* If there's no text, there are no properties. */
+ /* If there's no text, there are no properties. */
if (BUF_BEGV (b) == BUF_ZV (b))
return NULL_INTERVAL;
/* Validate LIST as a property list. If LIST is not a list, then
make one consisting of (LIST nil). Otherwise, verify that LIST
- is even numbered and thus suitable as a plist. */
+ is even numbered and thus suitable as a plist. */
static Lisp_Object
validate_plist (list)
}
/* Return nonzero if interval I has all the properties,
- with the same values, of list PLIST. */
+ with the same values, of list PLIST. */
static int
interval_has_all_properties (plist, i)
register Lisp_Object tail1, tail2, sym1, sym2;
register int found;
- /* Go through each element of PLIST. */
+ /* Go through each element of PLIST. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
{
sym1 = Fcar (tail1);
if (EQ (sym1, Fcar (tail2)))
{
/* Found the same property on both lists. If the
- values are unequal, return zero. */
+ values are unequal, return zero. */
if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
return 0;
- /* Property has same value on both lists; go to next one. */
+ /* Property has same value on both lists; go to next one. */
found = 1;
break;
}
}
/* Return nonzero if the plist of interval I has any of the
- properties of PLIST, regardless of their values. */
+ properties of PLIST, regardless of their values. */
static INLINE int
interval_has_some_properties (plist, i)
{
register Lisp_Object tail1, tail2, sym;
- /* Go through each element of PLIST. */
+ /* Go through each element of PLIST. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
{
sym = Fcar (tail1);
I and its plist are also protected, via OBJECT. */
GCPRO3 (tail1, sym1, val1);
- /* Go through each element of PLIST. */
+ /* Go through each element of PLIST. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
{
sym1 = Fcar (tail1);
register Lisp_Object this_cdr;
this_cdr = Fcdr (tail2);
- /* Found the property. Now check its value. */
+ /* Found the property. Now check its value. */
found = 1;
/* The properties have the same value on both lists.
- Continue to the next property. */
+ Continue to the next property. */
if (EQ (val1, Fcar (this_cdr)))
break;
register int changed = 0;
current_plist = i->plist;
- /* Go through each element of plist. */
+ /* Go through each element of plist. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
{
sym = Fcar (tail1);
#if 0
/* Remove all properties from interval I. Return non-zero
- if this changes the interval. */
+ if this changes the interval. */
static INLINE int
erase_properties (i)
}
#endif
\f
+/* Returns the interval of the POSITION in OBJECT.
+ POSITION is BEG-based. */
+
+INTERVAL
+interval_of (position, object)
+ int position;
+ Lisp_Object object;
+{
+ register INTERVAL i;
+ int beg, end;
+
+ if (NILP (object))
+ XSETBUFFER (object, current_buffer);
+
+ CHECK_STRING_OR_BUFFER (object, 0);
+
+ if (BUFFERP (object))
+ {
+ register struct buffer *b = XBUFFER (object);
+
+ beg = BUF_BEGV (b);
+ end = BUF_ZV (b);
+ i = BUF_INTERVALS (b);
+ }
+ else
+ {
+ register struct Lisp_String *s = XSTRING (object);
+
+ /* We expect position to be 1-based. */
+ beg = BEG;
+ end = s->size + BEG;
+ i = s->intervals;
+ }
+
+ if (!(beg <= position && position <= end))
+ args_out_of_range (position, position);
+ if (beg == end || NULL_INTERVAL_P (i))
+ return NULL_INTERVAL;
+
+ return find_interval (i, position);
+}
+\f
DEFUN ("text-properties-at", Ftext_properties_at,
Stext_properties_at, 1, 2, 0,
"Return the list of properties held by the character at POSITION\n\
simpler case. */
return (Fget_text_property (position, prop, object));
}
+\f
+DEFUN ("next-char-property-change", Fnext_char_property_change,
+ Snext_char_property_change, 1, 2, 0,
+ "Return the position of next text property or overlay change.\n\
+This scans characters forward from POSITION in OBJECT till it finds\n\
+a change in some text property, or the beginning or end of an overlay,\n\
+and returns the position of that.\n\
+If none is found, the function returns (point-max).\n\
+\n\
+If the optional third argument LIMIT is non-nil, don't search\n\
+past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+ (position, limit)
+ Lisp_Object position, limit;
+{
+ Lisp_Object temp;
+ temp = Fnext_overlay_change (position);
+ if (! NILP (limit))
+ {
+ CHECK_NUMBER (limit, 2);
+ if (XINT (limit) < XINT (temp))
+ temp = limit;
+ }
+ return Fnext_property_change (position, Qnil, temp);
+}
+
+DEFUN ("previous-char-property-change", Fprevious_char_property_change,
+ Sprevious_char_property_change, 1, 2, 0,
+ "Return the position of previous text property or overlay change.\n\
+Scans characters backward from POSITION in OBJECT till it finds\n\
+a change in some text property, or the beginning or end of an overlay,\n\
+and returns the position of that.\n\
+If none is found, the function returns (point-max).\n\
+\n\
+If the optional third argument LIMIT is non-nil, don't search\n\
+past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+ (position, limit)
+ Lisp_Object position, limit;
+{
+ Lisp_Object temp;
+
+ temp = Fprevious_overlay_change (position);
+ if (! NILP (limit))
+ {
+ CHECK_NUMBER (limit, 2);
+ if (XINT (limit) > XINT (temp))
+ temp = limit;
+ }
+ return Fprevious_property_change (position, Qnil, temp);
+}
+\f
DEFUN ("next-property-change", Fnext_property_change,
Snext_property_change, 1, 3, 0,
"Return the position of next property change.\n\
- (STRINGP (object))));
return position;
}
-
+\f
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
DEFUN ("add-text-properties", Fadd_text_properties,
GCPRO1 (properties);
/* If we're not starting on an interval boundary, we have to
- split this interval. */
+ split this interval. */
if (i->position != s)
{
/* If this interval already has the properties, we can
- skip it. */
+ skip it. */
if (interval_has_all_properties (properties, i))
{
int got = (LENGTH (i) - (s - i->position));
}
}
- modify_region (XBUFFER (object), XINT (start), XINT (end));
+ if (BUFFERP (object))
+ modify_region (XBUFFER (object), XINT (start), XINT (end));
/* We are at the beginning of interval I, with LEN chars to scan. */
for (;;)
if (interval_has_all_properties (properties, i))
{
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return modified ? Qt : Qnil;
}
if (LENGTH (i) == len)
{
add_properties (properties, i, object);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
i = split_interval_left (unchanged, len);
copy_properties (unchanged, i);
add_properties (properties, i, object);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
if (! XSTRING (object)->intervals)
return Qt;
- modify_region (XBUFFER (object), XINT (start), XINT (end));
XSTRING (object)->intervals = 0;
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
return Qt;
}
s = XINT (start);
len = XINT (end) - s;
- modify_region (XBUFFER (object), XINT (start), XINT (end));
+ if (BUFFERP (object))
+ modify_region (XBUFFER (object), XINT (start), XINT (end));
if (i->position != s)
{
copy_properties (unchanged, i);
i = split_interval_left (i, len);
set_properties (properties, i, object);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
if (LENGTH (i) == len)
{
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
set_properties (properties, i, object);
if (!NULL_INTERVAL_P (prev_changed))
merge_interval_left (i);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
i = next_interval (i);
}
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
if (i->position != s)
{
/* No properties on this first interval -- return if
- it covers the entire region. */
+ it covers the entire region. */
if (! interval_has_some_properties (properties, i))
{
int got = (LENGTH (i) - (s - i->position));
}
}
- modify_region (XBUFFER (object), XINT (start), XINT (end));
+ 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 (LENGTH (i) == len)
{
remove_properties (properties, i, object);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
i = split_interval_left (i, len);
copy_properties (unchanged, i);
remove_properties (properties, i, object);
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
+ if (BUFFERP (object))
+ signal_after_change (XINT (start), XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
return Qt;
}
i = next_interval (i);
}
}
-
+\f
DEFUN ("text-property-any", Ftext_property_any,
Stext_property_any, 4, 5, 0,
"Check text from START to END for property PROPERTY equalling VALUE.\n\
}
return Qnil;
}
-
+\f
#if 0 /* You can use set-text-properties for this. */
DEFUN ("erase-text-properties", Ferase_text_properties,
register int got;
register INTERVAL unchanged = i;
- /* If there are properties here, then this text will be modified. */
+ /* If there are properties here, then this text will be modified. */
if (! NILP (i->plist))
{
i = split_interval_right (unchanged, s - unchanged->position);
else if (LENGTH (i) - (s - i->position) <= len)
return Qnil;
/* The amount of text to change extends past I, so just note
- how much we've gotten. */
+ how much we've gotten. */
else
got = LENGTH (i) - (s - i->position);
i = next_interval (i);
}
- /* We are starting at the beginning of an interval, I. */
+ /* We are starting at the beginning of an interval, I. */
while (len > 0)
{
if (LENGTH (i) >= len)
else
{
modified += ! NILP (i->plist);
- /* Merging I will give it the properties of PREV_CHANGED. */
+ /* Merging I will give it the properties of PREV_CHANGED. */
prev_changed = i = merge_interval_left (i);
}
Return t if any property value actually changed, nil otherwise. */
/* Note this can GC when DEST is a buffer. */
-
+\f
Lisp_Object
copy_text_properties (start, end, src, pos, dest, prop)
Lisp_Object start, end, src, pos, dest, prop;
if (! NILP (plist))
{
/* Must defer modifications to the interval tree in case src
- and dest refer to the same string or buffer. */
+ and dest refer to the same string or buffer. */
stuff = Fcons (Fcons (make_number (p),
Fcons (make_number (p + len),
Fcons (plist, Qnil))),
if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
{
/* If I and PREV differ we need to check for the read-only
- property together with its stickiness. If either I or
+ property together with its stickiness. If either I or
PREV are 0, this check is all we need.
We have to take special care, since read-only may be
indirectly defined via the category property. */
defsubr (&Stext_properties_at);
defsubr (&Sget_text_property);
defsubr (&Sget_char_property);
+ defsubr (&Snext_char_property_change);
+ defsubr (&Sprevious_char_property_change);
defsubr (&Snext_property_change);
defsubr (&Snext_single_property_change);
defsubr (&Sprevious_property_change);