/* Interface code for dealing with text properties.
- Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object Vinhibit_point_motion_hooks;
Lisp_Object Vdefault_text_properties;
+Lisp_Object Vtext_property_default_nonsticky;
/* verify_interval_modification saves insertion hooks here
to be run later by report_interval_modification. */
Lisp_Object interval_insert_behind_hooks;
Lisp_Object interval_insert_in_front_hooks;
+
+
+/* Signal a `text-read-only' error. This function makes it easier
+ to capture that error in GDB by putting a breakpoint on it. */
+
+static void
+text_read_only ()
+{
+ Fsignal (Qtext_read_only, Qnil);
+}
+
+
\f
/* Extract the interval at the position pointed to by BEGIN from
OBJECT, a string or buffer. Additionally, check that the positions
return textget (Ftext_properties_at (position, object), prop);
}
-DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
- "Return the value of POSITION's property PROP, in OBJECT.\n\
-OBJECT is optional and defaults to the current buffer.\n\
-If POSITION is at the end of OBJECT, the value is nil.\n\
-If OBJECT is a buffer, then overlay properties are considered as well as\n\
-text properties.\n\
-If OBJECT is a window, then that window's buffer is used, but window-specific\n\
-overlays are considered only if they are associated with OBJECT.")
- (position, prop, object)
+/* Return the value of POSITION's property PROP, in OBJECT.
+ OBJECT is optional and defaults to the current buffer.
+ If OVERLAY is non-0, then in the case that the returned property is from
+ an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
+ returned in *OVERLAY.
+ If POSITION is at the end of OBJECT, the value is nil.
+ If OBJECT is a buffer, then overlay properties are considered as well as
+ text properties.
+ 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. */
+Lisp_Object
+get_char_property_and_overlay (position, prop, object, overlay)
Lisp_Object position, object;
register Lisp_Object prop;
+ Lisp_Object *overlay;
{
struct window *w = 0;
overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
noverlays = overlays_at (posn, 0, &overlay_vec, &len,
- &next_overlay, NULL);
+ &next_overlay, NULL, 0);
/* If there are more than 40,
make enough space for all, and try again. */
len = noverlays;
overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
noverlays = overlays_at (posn, 0, &overlay_vec, &len,
- &next_overlay, NULL);
+ &next_overlay, NULL, 0);
}
noverlays = sort_overlays (overlay_vec, noverlays, w);
{
tem = Foverlay_get (overlay_vec[noverlays], prop);
if (!NILP (tem))
- return (tem);
+ {
+ if (overlay)
+ /* Return the overlay we got the property from. */
+ *overlay = overlay_vec[noverlays];
+ return tem;
+ }
}
}
+
+ if (overlay)
+ /* Indicate that the return value is not from an overlay. */
+ *overlay = Qnil;
+
/* Not a buffer, or no appropriate overlay, so fall through to the
simpler case. */
- return (Fget_text_property (position, prop, object));
+ return Fget_text_property (position, prop, object);
+}
+
+DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
+ "Return the value of POSITION's property PROP, in OBJECT.\n\
+OBJECT is optional and defaults to the current buffer.\n\
+If POSITION is at the end of OBJECT, the value is nil.\n\
+If OBJECT is a buffer, then overlay properties are considered as well as\n\
+text properties.\n\
+If OBJECT is a window, then that window's buffer is used, but window-specific\n\
+overlays are considered only if they are associated with OBJECT.")
+ (position, prop, object)
+ Lisp_Object position, object;
+ register Lisp_Object prop;
+{
+ return get_char_property_and_overlay (position, prop, object, 0);
}
\f
DEFUN ("next-char-property-change", Fnext_char_property_change,
}
-/* Value is the position in OBJECT after POS where the value of
- property PROP changes. OBJECT must be a string or buffer. If
- OBJECT is nil, use the current buffer. LIMIT if not nil limits the
- search. */
-
-Lisp_Object
-next_single_char_property_change (pos, prop, object, limit)
- Lisp_Object prop, pos, object, limit;
+DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
+ Snext_single_char_property_change, 2, 4, 0,
+ "Return the position of next text property or overlay change for a specific property.\n\
+Scans characters forward from POSITION till it finds\n\
+a change in the PROP property, then returns the position of the change.\n\
+The optional third argument OBJECT is the string or buffer to scan.\n\
+The property values are compared with `eq'.\n\
+Return nil if the property is constant all the way to the end of OBJECT.\n\
+If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
+If the optional fourth argument LIMIT is non-nil, don't search\n\
+past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+ (position, prop, object, limit)
+ Lisp_Object prop, position, object, limit;
{
if (STRINGP (object))
{
- pos = Fnext_single_property_change (pos, prop, object, limit);
- if (NILP (pos))
+ position = Fnext_single_property_change (position, prop, object, limit);
+ if (NILP (position))
{
if (NILP (limit))
- pos = make_number (XSTRING (object)->size);
+ position = make_number (XSTRING (object)->size);
else
- pos = limit;
+ position = limit;
}
}
else
{
Lisp_Object initial_value, value;
- struct buffer *old_current_buffer = NULL;
int count = specpdl_ptr - specpdl;
- if (!NILP (object))
+ if (! NILP (object))
CHECK_BUFFER (object, 0);
if (BUFFERP (object) && current_buffer != XBUFFER (object))
Fset_buffer (object);
}
- initial_value = Fget_char_property (pos, prop, object);
+ initial_value = Fget_char_property (position, prop, object);
- while (XFASTINT (pos) < XFASTINT (limit))
+ if (NILP (limit))
+ XSETFASTINT (limit, BUF_ZV (current_buffer));
+ else
+ CHECK_NUMBER_COERCE_MARKER (limit, 0);
+
+ for (;;)
{
- pos = Fnext_char_property_change (pos, limit);
- value = Fget_char_property (pos, prop, object);
+ 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);
}
- return pos;
+ return position;
}
+DEFUN ("previous-single-char-property-change",
+ Fprevious_single_char_property_change,
+ Sprevious_single_char_property_change, 2, 4, 0,
+ "Return the position of previous text property or overlay change for a specific property.\n\
+Scans characters backward from POSITION till it finds\n\
+a change in the PROP property, then returns the position of the change.\n\
+The optional third argument OBJECT is the string or buffer to scan.\n\
+The property values are compared with `eq'.\n\
+Return nil if the property is constant all the way to the start of OBJECT.\n\
+If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
+If the optional fourth argument LIMIT is non-nil, don't search\n\
+back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+ (position, prop, object, limit)
+ Lisp_Object prop, position, object, limit;
+{
+ if (STRINGP (object))
+ {
+ position = Fprevious_single_property_change (position, prop, object, limit);
+ if (NILP (position))
+ {
+ if (NILP (limit))
+ position = make_number (XSTRING (object)->size);
+ else
+ position = limit;
+ }
+ }
+ else
+ {
+ int count = specpdl_ptr - specpdl;
+
+ if (! NILP (object))
+ CHECK_BUFFER (object, 0);
+
+ if (BUFFERP (object) && current_buffer != XBUFFER (object))
+ {
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ Fset_buffer (object);
+ }
+
+ if (NILP (limit))
+ XSETFASTINT (limit, BUF_BEGV (current_buffer));
+ else
+ CHECK_NUMBER_COERCE_MARKER (limit, 0);
+
+ if (XFASTINT (position) <= XFASTINT (limit))
+ position = limit;
+ else
+ {
+ Lisp_Object initial_value =
+ Fget_char_property (make_number (XFASTINT (position) - 1),
+ prop, object);
+
+ for (;;)
+ {
+ position = Fprevious_char_property_change (position, limit);
+
+ if (XFASTINT (position) <= XFASTINT (limit))
+ {
+ position = limit;
+ break;
+ }
+ else
+ {
+ Lisp_Object value =
+ Fget_char_property (make_number (XFASTINT (position) - 1),
+ prop, object);
+
+ if (!EQ (value, initial_value))
+ break;
+ }
+ }
+ }
+
+ unbind_to (count, Qnil);
+ }
+ return position;
+}
\f
DEFUN ("next-property-change", Fnext_property_change,
Snext_property_change, 1, 3, 0,
is the string or buffer containing the text.")
(start, end, properties, object)
Lisp_Object start, end, properties, object;
+{
+ return set_text_properties (start, end, properties, object, Qt);
+}
+
+
+/* Replace properties of text from START to END with new list of
+ 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. */
+
+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;
copy_properties (unchanged, i);
i = split_interval_left (i, len);
set_properties (properties, i, object);
- if (BUFFERP (object))
+ if (BUFFERP (object) && !NILP (signal_after_change_p))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
if (LENGTH (i) == len)
{
- if (BUFFERP (object))
+ if (BUFFERP (object) && !NILP (signal_after_change_p))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
set_properties (properties, i, object);
if (!NULL_INTERVAL_P (prev_changed))
merge_interval_left (i);
- if (BUFFERP (object))
+ if (BUFFERP (object) && !NILP (signal_after_change_p))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
return Qt;
i = next_interval (i);
}
- if (BUFFERP (object))
+ if (BUFFERP (object) && !NILP (signal_after_change_p))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
return Qt;
/* For an insert operation, check the two chars around the position. */
if (start == end)
{
- INTERVAL prev;
+ INTERVAL prev = NULL;
Lisp_Object before, after;
/* Set I to the interval containing the char after START,
if (TMEM (Qread_only, tem)
|| (NILP (Fplist_get (i->plist, Qread_only))
&& TMEM (Qcategory, tem)))
- Fsignal (Qtext_read_only, Qnil);
+ text_read_only ();
}
}
if (! TMEM (Qread_only, tem)
&& (! NILP (Fplist_get (prev->plist,Qread_only))
|| ! TMEM (Qcategory, tem)))
- Fsignal (Qtext_read_only, Qnil);
+ text_read_only ();
}
}
}
if (TMEM (Qread_only, tem)
|| (NILP (Fplist_get (i->plist, Qread_only))
&& TMEM (Qcategory, tem)))
- Fsignal (Qtext_read_only, Qnil);
+ text_read_only ();
tem = textget (prev->plist, Qrear_nonsticky);
if (! TMEM (Qread_only, tem)
&& (! NILP (Fplist_get (prev->plist, Qread_only))
|| ! TMEM (Qcategory, tem)))
- Fsignal (Qtext_read_only, Qnil);
+ text_read_only ();
}
}
}
do
{
if (! INTERVAL_WRITABLE_P (i))
- Fsignal (Qtext_read_only, Qnil);
+ text_read_only ();
mod_hooks = textget (i->plist, Qmodification_hooks);
if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
This also inhibits the use of the `intangible' text property.");
Vinhibit_point_motion_hooks = Qnil;
+ DEFVAR_LISP ("text-property-default-nonsticky",
+ &Vtext_property_default_nonsticky,
+ "Alist of properties vs the corresponding non-stickinesses.\n\
+Each element has the form (PROPERTY . NONSTICKINESS).\n\
+\n\
+If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
+the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
+inherits it if NONSTICKINESS is nil. The front-sticky and\n\
+rear-nonsticky properties of the character overrides NONSTICKINESS.");
+ Vtext_property_default_nonsticky = Qnil;
+
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);
interval_insert_behind_hooks = Qnil;
defsubr (&Sget_char_property);
defsubr (&Snext_char_property_change);
defsubr (&Sprevious_char_property_change);
+ defsubr (&Snext_single_char_property_change);
+ defsubr (&Sprevious_single_char_property_change);
defsubr (&Snext_property_change);
defsubr (&Snext_single_property_change);
defsubr (&Sprevious_property_change);
HCoop / bpt / emacs.git / blobdiff