/* 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.
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 <config.h>
#include "lisp.h"
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. */
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);
}
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.
-Return a cons whose car is the return value of `get-char-property'
-with the same arguments, that is, the value of POSITION's property
-PROP in OBJECT, and whose cdr is the overlay in which the property was
+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
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;
{
temp = Fnext_overlay_change (position);
if (! NILP (limit))
{
- CHECK_NUMBER (limit);
+ CHECK_NUMBER_COERCE_MARKER (limit);
if (XINT (limit) < XINT (temp))
temp = limit;
}
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;
{
temp = Fprevious_overlay_change (position);
if (! NILP (limit))
{
- CHECK_NUMBER (limit);
+ CHECK_NUMBER_COERCE_MARKER (limit);
if (XINT (limit) > XINT (temp))
temp = limit;
}
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.
if (NILP (limit))
position = make_number (SCHARS (object));
else
- position = limit;
+ {
+ CHECK_NUMBER (limit);
+ position = limit;
+ }
}
}
else
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);
}
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.
if (NILP (limit))
position = make_number (SCHARS (object));
else
- position = limit;
+ {
+ CHECK_NUMBER (limit);
+ position = limit;
+ }
}
}
else
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);
}
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;
&& (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. */
&& (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,
&& (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,
&& (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));
}
\f
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
}
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 (;;)
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)
&& XFASTINT (end) == SCHARS (object))
{
if (! STRING_INTERVALS (object))
- return Qt;
+ return Qnil;
STRING_SET_INTERVALS (object, NULL_INTERVAL);
return Qt;
}
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);
}
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 (;;)
}
}
- 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)
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),
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),
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);
}
}
/* 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)
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);