/src/textprop.c
C | 2380 lines | 1578 code | 335 blank | 467 comment | 386 complexity | 9d3d8d36db0a5cfd22763bee549656c3 MD5 | raw file
Possible License(s): GPL-3.0, LGPL-2.0, GPL-2.0, AGPL-3.0
Large files files are truncated, but you can click here to view the full file
- /* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2016 Free Software Foundation,
- Inc.
- This file is part of GNU Emacs.
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or (at
- your option) any later version.
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
- #include <config.h>
- #include "lisp.h"
- #include "intervals.h"
- #include "buffer.h"
- #include "window.h"
- /* Test for membership, allowing for t (actually any non-cons) to mean the
- universal set. */
- #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
- /* NOTES: previous- and next- property change will have to skip
- zero-length intervals if they are implemented. This could be done
- inside next_interval and previous_interval.
- set_properties needs to deal with the interval property cache.
- It is assumed that for any interval plist, a property appears
- 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. */
- enum property_set_type
- {
- TEXT_PROPERTY_REPLACE,
- TEXT_PROPERTY_PREPEND,
- TEXT_PROPERTY_APPEND
- };
- /* If o1 is a cons whose cdr is a cons, return true and set o2 to
- the o1's cdr. Otherwise, return false. This is handy for
- traversing plists. */
- #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
- /* verify_interval_modification saves insertion hooks here
- to be run later by report_interval_modification. */
- static Lisp_Object interval_insert_behind_hooks;
- static 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 _Noreturn void
- text_read_only (Lisp_Object propval)
- {
- if (STRINGP (propval))
- xsignal1 (Qtext_read_only, propval);
- xsignal0 (Qtext_read_only);
- }
- /* Prepare to modify the text properties of BUFFER from START to END. */
- static void
- modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
- {
- ptrdiff_t b = XINT (start), e = XINT (end);
- struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
- set_buffer_internal (buf);
- prepare_to_modify_buffer_1 (b, e, NULL);
- BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
- if (MODIFF <= SAVE_MODIFF)
- record_first_change ();
- MODIFF++;
- bset_point_before_scroll (current_buffer, Qnil);
- set_buffer_internal (old);
- }
- /* Complain if object is not string or buffer type. */
- static void
- CHECK_STRING_OR_BUFFER (Lisp_Object x)
- {
- CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
- }
- /* Extract the interval at the position pointed to by BEGIN from
- OBJECT, a string or buffer. Additionally, check that the positions
- pointed to by BEGIN and END are within the bounds of OBJECT, and
- reverse them if *BEGIN is greater than *END. The objects pointed
- to by BEGIN and END may be integers or markers; if the latter, they
- are coerced to integers.
- When OBJECT is a string, we increment *BEGIN and *END
- to make them origin-one.
- Note that buffer points don't correspond to interval indices.
- For example, point-max is 1 greater than the index of the last
- character. This difference is handled in the caller, which uses
- the validated points to determine a length, and operates on that.
- Exceptions are Ftext_properties_at, Fnext_property_change, and
- Fprevious_property_change which call this function with BEGIN == END.
- Handle this case specially.
- If FORCE is soft (false), it's OK to return NULL. Otherwise,
- create an interval tree for OBJECT if one doesn't exist, provided
- the object actually contains text. In the current design, if there
- is no text, there can be no text properties. */
- enum { soft = false, hard = true };
- INTERVAL
- validate_interval_range (Lisp_Object object, Lisp_Object *begin,
- Lisp_Object *end, bool force)
- {
- INTERVAL i;
- ptrdiff_t searchpos;
- CHECK_STRING_OR_BUFFER (object);
- CHECK_NUMBER_COERCE_MARKER (*begin);
- CHECK_NUMBER_COERCE_MARKER (*end);
- /* If we are asked for a point, but from a subr which operates
- on a range, then return nothing. */
- if (EQ (*begin, *end) && begin != end)
- return NULL;
- if (XINT (*begin) > XINT (*end))
- {
- Lisp_Object n;
- n = *begin;
- *begin = *end;
- *end = n;
- }
- if (BUFFERP (object))
- {
- register struct buffer *b = XBUFFER (object);
- if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
- && XINT (*end) <= BUF_ZV (b)))
- args_out_of_range (*begin, *end);
- i = buffer_intervals (b);
- /* If there's no text, there are no properties. */
- if (BUF_BEGV (b) == BUF_ZV (b))
- return NULL;
- searchpos = XINT (*begin);
- }
- else
- {
- ptrdiff_t len = SCHARS (object);
- if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
- && XINT (*end) <= len))
- args_out_of_range (*begin, *end);
- XSETFASTINT (*begin, XFASTINT (*begin));
- if (begin != end)
- XSETFASTINT (*end, XFASTINT (*end));
- i = string_intervals (object);
- if (len == 0)
- return NULL;
- searchpos = XINT (*begin);
- }
- if (!i)
- return (force ? create_root_interval (object) : i);
- return find_interval (i, searchpos);
- }
- /* 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. */
- static Lisp_Object
- validate_plist (Lisp_Object list)
- {
- if (NILP (list))
- return Qnil;
- if (CONSP (list))
- {
- Lisp_Object tail = list;
- do
- {
- tail = XCDR (tail);
- if (! CONSP (tail))
- error ("Odd length text property list");
- tail = XCDR (tail);
- QUIT;
- }
- while (CONSP (tail));
- return list;
- }
- return list2 (list, Qnil);
- }
- /* Return true if interval I has all the properties,
- with the same values, of list PLIST. */
- static bool
- interval_has_all_properties (Lisp_Object plist, INTERVAL i)
- {
- Lisp_Object tail1, tail2;
- /* Go through each element of PLIST. */
- for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
- {
- Lisp_Object sym1 = XCAR (tail1);
- bool found = false;
- /* Go through I's plist, looking for sym1 */
- for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
- if (EQ (sym1, XCAR (tail2)))
- {
- /* Found the same property on both lists. If the
- values are unequal, return false. */
- if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
- return false;
- /* Property has same value on both lists; go to next one. */
- found = true;
- break;
- }
- if (! found)
- return false;
- }
- return true;
- }
- /* Return true if the plist of interval I has any of the
- properties of PLIST, regardless of their values. */
- static bool
- interval_has_some_properties (Lisp_Object plist, INTERVAL i)
- {
- Lisp_Object tail1, tail2, sym;
- /* Go through each element of PLIST. */
- for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
- {
- sym = XCAR (tail1);
- /* Go through i's plist, looking for tail1 */
- for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
- if (EQ (sym, XCAR (tail2)))
- return true;
- }
- return false;
- }
- /* Return true if the plist of interval I has any of the
- property names in LIST, regardless of their values. */
- static bool
- interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
- {
- Lisp_Object tail1, tail2, sym;
- /* Go through each element of LIST. */
- for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
- {
- sym = XCAR (tail1);
- /* Go through i's plist, looking for tail1 */
- for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
- if (EQ (sym, XCAR (tail2)))
- return true;
- }
- return false;
- }
- /* Changing the plists of individual intervals. */
- /* Return the value of PROP in property-list PLIST, or Qunbound if it
- has none. */
- static Lisp_Object
- property_value (Lisp_Object plist, Lisp_Object prop)
- {
- Lisp_Object value;
- while (PLIST_ELT_P (plist, value))
- if (EQ (XCAR (plist), prop))
- return XCAR (value);
- else
- plist = XCDR (value);
- return Qunbound;
- }
- /* Set the properties of INTERVAL to PROPERTIES,
- and record undo info for the previous values.
- OBJECT is the string or buffer that INTERVAL belongs to. */
- static void
- set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
- {
- Lisp_Object sym, value;
- if (BUFFERP (object))
- {
- /* For each property in the old plist which is missing from PROPERTIES,
- or has a different value in PROPERTIES, make an undo record. */
- for (sym = interval->plist;
- PLIST_ELT_P (sym, value);
- sym = XCDR (value))
- if (! EQ (property_value (properties, XCAR (sym)),
- XCAR (value)))
- {
- record_property_change (interval->position, LENGTH (interval),
- XCAR (sym), XCAR (value),
- object);
- }
- /* For each new property that has no value at all in the old plist,
- make an undo record binding it to nil, so it will be removed. */
- for (sym = properties;
- PLIST_ELT_P (sym, value);
- sym = XCDR (value))
- if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
- {
- record_property_change (interval->position, LENGTH (interval),
- XCAR (sym), Qnil,
- object);
- }
- }
- /* Store new properties. */
- set_interval_plist (interval, Fcopy_sequence (properties));
- }
- /* Add the properties of PLIST to the interval I, or set
- the value of I's property to the value of the property on PLIST
- if they are different.
- OBJECT should be the string or buffer the interval is in.
- Return true if this changes I (i.e., if any members of PLIST
- are actually added to I's plist) */
- static bool
- add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
- enum property_set_type set_type)
- {
- Lisp_Object tail1, tail2, sym1, val1;
- bool changed = false;
- tail1 = plist;
- sym1 = Qnil;
- val1 = Qnil;
- /* Go through each element of PLIST. */
- for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
- {
- bool found = false;
- sym1 = XCAR (tail1);
- val1 = Fcar (XCDR (tail1));
- /* Go through I's plist, looking for sym1 */
- for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
- if (EQ (sym1, XCAR (tail2)))
- {
- Lisp_Object this_cdr;
- this_cdr = XCDR (tail2);
- /* Found the property. Now check its value. */
- found = true;
- /* The properties have the same value on both lists.
- Continue to the next property. */
- if (EQ (val1, Fcar (this_cdr)))
- break;
- /* Record this change in the buffer, for undo purposes. */
- if (BUFFERP (object))
- {
- record_property_change (i->position, LENGTH (i),
- sym1, Fcar (this_cdr), object);
- }
- /* I's property has a different value -- change it */
- if (set_type == TEXT_PROPERTY_REPLACE)
- Fsetcar (this_cdr, val1);
- else {
- if (CONSP (Fcar (this_cdr)) &&
- /* Special-case anonymous face properties. */
- (! EQ (sym1, Qface) ||
- NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
- /* The previous value is a list, so prepend (or
- append) the new value to this list. */
- if (set_type == TEXT_PROPERTY_PREPEND)
- Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
- else
- nconc2 (Fcar (this_cdr), list1 (val1));
- else {
- /* The previous value is a single value, so make it
- into a list. */
- if (set_type == TEXT_PROPERTY_PREPEND)
- Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
- else
- Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
- }
- }
- changed = true;
- break;
- }
- if (! found)
- {
- /* Record this change in the buffer, for undo purposes. */
- if (BUFFERP (object))
- {
- record_property_change (i->position, LENGTH (i),
- sym1, Qnil, object);
- }
- set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
- changed = true;
- }
- }
- return changed;
- }
- /* 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 bool
- remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
- {
- bool changed = false;
- /* True means tail1 is a plist, otherwise it is a list. */
- bool use_plist = ! NILP (plist);
- Lisp_Object tail1 = use_plist ? plist : list;
- Lisp_Object current_plist = i->plist;
- /* Go through each element of LIST or PLIST. */
- while (CONSP (tail1))
- {
- Lisp_Object sym = XCAR (tail1);
- /* 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, XCAR (XCDR (current_plist)),
- object);
- current_plist = XCDR (XCDR (current_plist));
- changed = true;
- }
- /* Go through I's plist, looking for SYM. */
- Lisp_Object tail2 = current_plist;
- while (! NILP (tail2))
- {
- Lisp_Object this = XCDR (XCDR (tail2));
- if (CONSP (this) && EQ (sym, XCAR (this)))
- {
- if (BUFFERP (object))
- record_property_change (i->position, LENGTH (i),
- sym, XCAR (XCDR (this)), object);
- Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
- changed = true;
- }
- tail2 = this;
- }
- /* Advance thru TAIL1 one way or the other. */
- tail1 = XCDR (tail1);
- if (use_plist && CONSP (tail1))
- tail1 = XCDR (tail1);
- }
- if (changed)
- set_interval_plist (i, current_plist);
- return changed;
- }
- /* Returns the interval of POSITION in OBJECT.
- POSITION is BEG-based. */
- INTERVAL
- interval_of (ptrdiff_t position, Lisp_Object object)
- {
- register INTERVAL i;
- ptrdiff_t beg, end;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- else if (EQ (object, Qt))
- return NULL;
- CHECK_STRING_OR_BUFFER (object);
- if (BUFFERP (object))
- {
- register struct buffer *b = XBUFFER (object);
- beg = BUF_BEGV (b);
- end = BUF_ZV (b);
- i = buffer_intervals (b);
- }
- else
- {
- beg = 0;
- end = SCHARS (object);
- i = string_intervals (object);
- }
- if (!(beg <= position && position <= end))
- args_out_of_range (make_number (position), make_number (position));
- if (beg == end || !i)
- return NULL;
- return find_interval (i, position);
- }
- DEFUN ("text-properties-at", Ftext_properties_at,
- Stext_properties_at, 1, 2, 0,
- doc: /* Return the list of properties of the character at POSITION in OBJECT.
- If the optional second argument OBJECT is a buffer (or nil, which means
- the current buffer), POSITION is a buffer position (integer or marker).
- If OBJECT is a string, POSITION is a 0-based index into it.
- If POSITION is at the end of OBJECT, the value is nil. */)
- (Lisp_Object position, Lisp_Object object)
- {
- register INTERVAL i;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- i = validate_interval_range (object, &position, &position, soft);
- if (!i)
- return Qnil;
- /* If POSITION is at the end of the interval,
- it means it's the end of OBJECT.
- There are no properties at the very end,
- since no character follows. */
- if (XINT (position) == LENGTH (i) + i->position)
- return Qnil;
- return i->plist;
- }
- DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
- doc: /* Return the value of POSITION's property PROP, in OBJECT.
- OBJECT should be a buffer or a string; if omitted or nil, it defaults
- to the current buffer.
- If POSITION is at the end of OBJECT, the value is nil. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
- {
- return textget (Ftext_properties_at (position, object), prop);
- }
- /* Return the value of char's property PROP, in OBJECT at POSITION.
- 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 (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
- {
- struct window *w = 0;
- CHECK_NUMBER_COERCE_MARKER (position);
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- if (WINDOWP (object))
- {
- CHECK_LIVE_WINDOW (object);
- w = XWINDOW (object);
- object = w->contents;
- }
- if (BUFFERP (object))
- {
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec;
- struct buffer *obuf = current_buffer;
- if (XINT (position) < BUF_BEGV (XBUFFER (object))
- || XINT (position) > BUF_ZV (XBUFFER (object)))
- xsignal1 (Qargs_out_of_range, position);
- set_buffer_temp (XBUFFER (object));
- USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, false);
- noverlays = sort_overlays (overlay_vec, noverlays, w);
- set_buffer_temp (obuf);
- /* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
- {
- Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
- if (!NILP (tem))
- {
- if (overlay)
- /* Return the overlay we got the property from. */
- *overlay = overlay_vec[noverlays];
- SAFE_FREE ();
- return tem;
- }
- }
- SAFE_FREE ();
- }
- 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);
- }
- DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
- doc: /* Return the value of POSITION's property PROP, in OBJECT.
- Both overlay properties and text properties are checked.
- OBJECT is optional and defaults to the current buffer.
- 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 position, Lisp_Object prop, Lisp_Object object)
- {
- return get_char_property_and_overlay (position, prop, object, 0);
- }
- 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.
- 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
- a window, then that window's buffer is used, but window-specific
- overlays are considered only if they are associated with OBJECT. If
- POSITION is at the end of OBJECT, both car and cdr are nil. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
- {
- Lisp_Object overlay;
- Lisp_Object val
- = get_char_property_and_overlay (position, prop, object, &overlay);
- return Fcons (val, overlay);
- }
- DEFUN ("next-char-property-change", Fnext_char_property_change,
- Snext_char_property_change, 1, 2, 0,
- doc: /* Return the position of next text property or overlay change.
- 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, and LIMIT is nil or omitted, the function
- returns (point-max).
- If the optional second argument LIMIT is non-nil, the function doesn't
- search past position LIMIT, and returns LIMIT if nothing is found
- before LIMIT. LIMIT is a no-op if it is greater than (point-max). */)
- (Lisp_Object position, Lisp_Object limit)
- {
- Lisp_Object temp;
- temp = Fnext_overlay_change (position);
- if (! NILP (limit))
- {
- CHECK_NUMBER_COERCE_MARKER (limit);
- 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,
- doc: /* Return the position of previous text property or overlay change.
- 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, and LIMIT is nil or omitted, the function
- returns (point-min).
- If the optional second argument LIMIT is non-nil, the function doesn't
- search before position LIMIT, and returns LIMIT if nothing is found
- before LIMIT. LIMIT is a no-op if it is less than (point-min). */)
- (Lisp_Object position, Lisp_Object limit)
- {
- Lisp_Object temp;
- temp = Fprevious_overlay_change (position);
- if (! NILP (limit))
- {
- CHECK_NUMBER_COERCE_MARKER (limit);
- if (XINT (limit) > XINT (temp))
- temp = limit;
- }
- return Fprevious_property_change (position, Qnil, temp);
- }
- DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
- Snext_single_char_property_change, 2, 4, 0,
- doc: /* Return the position of next text property or overlay change for a specific property.
- Scans characters forward from POSITION till it finds
- a change in the PROP property, then returns the position of the change.
- If the optional third argument OBJECT is a buffer (or nil, which means
- 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, unless LIMIT is non-nil.
- In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the
- value cannot exceed that.
- If the optional fourth argument LIMIT is non-nil, don't search
- past position LIMIT; return LIMIT if nothing is found before LIMIT.
- 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. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
- {
- if (STRINGP (object))
- {
- position = Fnext_single_property_change (position, prop, object, limit);
- if (NILP (position))
- {
- if (NILP (limit))
- position = make_number (SCHARS (object));
- else
- {
- CHECK_NUMBER (limit);
- position = limit;
- }
- }
- }
- else
- {
- Lisp_Object initial_value, value;
- ptrdiff_t count = SPECPDL_INDEX ();
- if (! NILP (object))
- CHECK_BUFFER (object);
- if (BUFFERP (object) && current_buffer != XBUFFER (object))
- {
- record_unwind_current_buffer ();
- Fset_buffer (object);
- }
- CHECK_NUMBER_COERCE_MARKER (position);
- initial_value = Fget_char_property (position, prop, object);
- if (NILP (limit))
- XSETFASTINT (limit, ZV);
- else
- CHECK_NUMBER_COERCE_MARKER (limit);
- if (XFASTINT (position) >= XFASTINT (limit))
- {
- position = limit;
- if (XFASTINT (position) > ZV)
- XSETFASTINT (position, ZV);
- }
- else
- while (true)
- {
- 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 position;
- }
- DEFUN ("previous-single-char-property-change",
- Fprevious_single_char_property_change,
- Sprevious_single_char_property_change, 2, 4, 0,
- doc: /* Return the position of previous text property or overlay change for a specific property.
- Scans characters backward from POSITION till it finds
- a change in the PROP property, then returns the position of the change.
- If the optional third argument OBJECT is a buffer (or nil, which means
- 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, unless LIMIT is non-nil.
- In a buffer, if LIMIT is nil or omitted, it runs to (point-min), and the
- value cannot be less than that.
- If the optional fourth argument LIMIT is non-nil, don't search back past
- position LIMIT; return LIMIT if nothing is found before reaching LIMIT.
- 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. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
- {
- if (STRINGP (object))
- {
- position = Fprevious_single_property_change (position, prop, object, limit);
- if (NILP (position))
- {
- if (NILP (limit))
- position = make_number (0);
- else
- {
- CHECK_NUMBER (limit);
- position = limit;
- }
- }
- }
- else
- {
- ptrdiff_t count = SPECPDL_INDEX ();
- if (! NILP (object))
- CHECK_BUFFER (object);
- if (BUFFERP (object) && current_buffer != XBUFFER (object))
- {
- record_unwind_current_buffer ();
- Fset_buffer (object);
- }
- CHECK_NUMBER_COERCE_MARKER (position);
- if (NILP (limit))
- XSETFASTINT (limit, BEGV);
- else
- CHECK_NUMBER_COERCE_MARKER (limit);
- if (XFASTINT (position) <= XFASTINT (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);
- while (true)
- {
- 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;
- }
- DEFUN ("next-property-change", Fnext_property_change,
- Snext_property_change, 1, 3, 0,
- doc: /* Return the position of next property change.
- Scans characters forward from POSITION in OBJECT till it finds
- a change in some text property, then returns the position of the change.
- If the optional second argument OBJECT is a buffer (or nil, which means
- the current buffer), POSITION is a buffer position (integer or marker).
- If OBJECT is a string, POSITION is a 0-based index into it.
- Return nil if LIMIT is nil or omitted, and the property is constant all
- the way to the end of OBJECT; if the value is non-nil, it is a position
- greater than POSITION, never equal.
- If the optional third argument LIMIT is non-nil, don't search
- past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
- (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
- {
- register INTERVAL i, next;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- if (!NILP (limit) && !EQ (limit, Qt))
- CHECK_NUMBER_COERCE_MARKER (limit);
- i = validate_interval_range (object, &position, &position, soft);
- /* If LIMIT is t, return start of next interval--don't
- bother checking further intervals. */
- if (EQ (limit, Qt))
- {
- if (!i)
- next = i;
- else
- next = next_interval (i);
- if (!next)
- XSETFASTINT (position, (STRINGP (object)
- ? SCHARS (object)
- : BUF_ZV (XBUFFER (object))));
- else
- XSETFASTINT (position, next->position);
- return position;
- }
- if (!i)
- return limit;
- next = next_interval (i);
- while (next && intervals_equal (i, next)
- && (NILP (limit) || next->position < XFASTINT (limit)))
- next = next_interval (next);
- if (!next
- || (next->position
- >= (INTEGERP (limit)
- ? XFASTINT (limit)
- : (STRINGP (object)
- ? SCHARS (object)
- : BUF_ZV (XBUFFER (object))))))
- return limit;
- else
- return make_number (next->position);
- }
- DEFUN ("next-single-property-change", Fnext_single_property_change,
- Snext_single_property_change, 2, 4, 0,
- doc: /* Return the position of next property change for a specific property.
- Scans characters forward from POSITION till it finds
- a change in the PROP property, then returns the position of the change.
- If the optional third argument OBJECT is a buffer (or nil, which means
- the current buffer), POSITION is a buffer position (integer or marker).
- If OBJECT is a string, POSITION is a 0-based index into it.
- The property values are compared with `eq'.
- Return nil if LIMIT is nil or omitted, and the property is constant all
- the way to the end of OBJECT; if the value is non-nil, it is a position
- greater than POSITION, never equal.
- If the optional fourth argument LIMIT is non-nil, don't search
- past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
- {
- register INTERVAL i, next;
- register Lisp_Object here_val;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- if (!NILP (limit))
- CHECK_NUMBER_COERCE_MARKER (limit);
- i = validate_interval_range (object, &position, &position, soft);
- if (!i)
- return limit;
- here_val = textget (i->plist, prop);
- next = next_interval (i);
- while (next
- && EQ (here_val, textget (next->plist, prop))
- && (NILP (limit) || next->position < XFASTINT (limit)))
- next = next_interval (next);
- if (!next
- || (next->position
- >= (INTEGERP (limit)
- ? XFASTINT (limit)
- : (STRINGP (object)
- ? SCHARS (object)
- : BUF_ZV (XBUFFER (object))))))
- return limit;
- else
- return make_number (next->position);
- }
- DEFUN ("previous-property-change", Fprevious_property_change,
- Sprevious_property_change, 1, 3, 0,
- doc: /* Return the position of previous property change.
- Scans characters backwards from POSITION in OBJECT till it finds
- a change in some text property, then returns the position of the change.
- If the optional second argument OBJECT is a buffer (or nil, which means
- the current buffer), POSITION is a buffer position (integer or marker).
- If OBJECT is a string, POSITION is a 0-based index into it.
- Return nil if LIMIT is nil or omitted, and the property is constant all
- the way to the start of OBJECT; if the value is non-nil, it is a position
- less than POSITION, never equal.
- If the optional third argument LIMIT is non-nil, don't search
- back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
- (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
- {
- register INTERVAL i, previous;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- if (!NILP (limit))
- CHECK_NUMBER_COERCE_MARKER (limit);
- i = validate_interval_range (object, &position, &position, soft);
- if (!i)
- return limit;
- /* Start with the interval containing the char before point. */
- if (i->position == XFASTINT (position))
- i = previous_interval (i);
- previous = previous_interval (i);
- while (previous && intervals_equal (previous, i)
- && (NILP (limit)
- || (previous->position + LENGTH (previous) > XFASTINT (limit))))
- previous = previous_interval (previous);
- if (!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,
- Sprevious_single_property_change, 2, 4, 0,
- doc: /* Return the position of previous property change for a specific property.
- Scans characters backward from POSITION till it finds
- a change in the PROP property, then returns the position of the change.
- If the optional third argument OBJECT is a buffer (or nil, which means
- the current buffer), POSITION is a buffer position (integer or marker).
- If OBJECT is a string, POSITION is a 0-based index into it.
- The property values are compared with `eq'.
- Return nil if LIMIT is nil or omitted, and the property is constant all
- the way to the start of OBJECT; if the value is non-nil, it is a position
- less than POSITION, never equal.
- If the optional fourth argument LIMIT is non-nil, don't search
- back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
- (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
- {
- register INTERVAL i, previous;
- register Lisp_Object here_val;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- if (!NILP (limit))
- CHECK_NUMBER_COERCE_MARKER (limit);
- i = validate_interval_range (object, &position, &position, soft);
- /* Start with the interval containing the char before point. */
- if (i && i->position == XFASTINT (position))
- i = previous_interval (i);
- if (!i)
- return limit;
- here_val = textget (i->plist, prop);
- previous = previous_interval (i);
- while (previous
- && EQ (here_val, textget (previous->plist, prop))
- && (NILP (limit)
- || (previous->position + LENGTH (previous) > XFASTINT (limit))))
- previous = previous_interval (previous);
- if (!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));
- }
- /* Used by add-text-properties and add-face-text-property. */
- static Lisp_Object
- add_text_properties_1 (Lisp_Object start, Lisp_Object end,
- Lisp_Object properties, Lisp_Object object,
- enum property_set_type set_type) {
- INTERVAL i, unchanged;
- ptrdiff_t s, len;
- bool modified = false;
- bool first_time = true;
- properties = validate_plist (properties);
- if (NILP (properties))
- return Qnil;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- retry:
- i = validate_interval_range (object, &start, &end, hard);
- if (!i)
- return Qnil;
- s = XINT (start);
- len = XINT (end) - s;
- /* If this interval already has the properties, we can skip it. */
- if (interval_has_all_properties (properties, i))
- {
- ptrdiff_t got = LENGTH (i) - (s - i->position);
- do
- {
- if (got >= len)
- return Qnil;
- len -= got;
- i = next_interval (i);
- got = LENGTH (i);
- }
- while (interval_has_all_properties (properties, i));
- }
- else if (i->position != s)
- {
- /* If we're not starting on an interval boundary, we have to
- split this interval. */
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- copy_properties (unchanged, i);
- }
- if (BUFFERP (object) && first_time)
- {
- ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
- ptrdiff_t prev_pos = i->position;
- modify_text_properties (object, start, end);
- /* If someone called us recursively as a side effect of
- modify_text_properties, and changed the intervals behind our back
- (could happen if lock_file, called by prepare_to_modify_buffer,
- triggers redisplay, and that calls add-text-properties again
- in the same buffer), we cannot continue with I, because its
- data changed. So we restart the interval analysis anew. */
- if (TOTAL_LENGTH (i) != prev_total_length
- || i->position != prev_pos)
- {
- first_time = false;
- goto retry;
- }
- }
- /* We are at the beginning of interval I, with LEN chars to scan. */
- for (;;)
- {
- eassert (i != 0);
- if (LENGTH (i) >= len)
- {
- if (interval_has_all_properties (properties, i))
- {
- if (BUFFERP (object))
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
- eassert (modified);
- return Qt;
- }
- if (LENGTH (i) == len)
- {
- add_properties (properties, i, object, set_type);
- if (BUFFERP (object))
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
- return Qt;
- }
- /* i doesn't have the properties, and goes past the change limit */
- unchanged = i;
- i = split_interval_left (unchanged, len);
- copy_properties (unchanged, i);
- add_properties (properties, i, object, set_type);
- if (BUFFERP (object))
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
- return Qt;
- }
- len -= LENGTH (i);
- modified |= add_properties (properties, i, object, set_type);
- i = next_interval (i);
- }
- }
- /* Callers note, this can GC when OBJECT is a buffer (or nil). */
- DEFUN ("add-text-properties", Fadd_text_properties,
- Sadd_text_properties, 3, 4, 0,
- doc: /* Add properties to the text from START to END.
- The third argument PROPERTIES is a property list
- specifying the property values to add. If the optional fourth argument
- OBJECT is a buffer (or nil, which means the current buffer),
- START and END are buffer positions (integers or markers).
- If OBJECT is a string, START and END are 0-based indices into it.
- Return t if any property value actually changed, nil otherwise. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
- Lisp_Object object)
- {
- return add_text_properties_1 (start, end, properties, object,
- TEXT_PROPERTY_REPLACE);
- }
- /* Callers note, this can GC when OBJECT is a buffer (or nil). */
- DEFUN ("put-text-property", Fput_text_property,
- Sput_text_property, 4, 5, 0,
- doc: /* Set one property of the text from START to END.
- The third and fourth arguments PROPERTY and VALUE
- specify the property to add.
- If the optional fifth argument OBJECT is a buffer (or nil, which means
- the current buffer), START and END are buffer positions (integers or
- markers). If OBJECT is a string, START and END are 0-based indices into it. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object property,
- Lisp_Object value, Lisp_Object object)
- {
- AUTO_LIST2 (properties, property, value);
- Fadd_text_properties (start, end, properties, object);
- return Qnil;
- }
- DEFUN ("set-text-properties", Fset_text_properties,
- Sset_text_properties, 3, 4, 0,
- doc: /* Completely replace properties of text from START to END.
- The third argument PROPERTIES is the new property list.
- If the optional fourth argument OBJECT is a buffer (or nil, which means
- the current buffer), START and END are buffer positions (integers or
- markers). If OBJECT is a string, START and END are 0-based indices into it.
- If PROPERTIES is nil, the effect is to remove all properties from
- the designated part of OBJECT. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
- {
- return set_text_properties (start, end, properties, object, Qt);
- }
- DEFUN ("add-face-text-property", Fadd_face_text_property,
- Sadd_face_text_property, 3, 5, 0,
- doc: /* Add the face property to the text from START to END.
- FACE specifies the face to add. It should be a valid value of the
- `face' property (typically a face name or a plist of face attributes
- and values).
- If any text in the region already has a non-nil `face' property, those
- face(s) are retained. This is done by setting the `face' property to
- a list of faces, with FACE as the first element (by default) and the
- pre-existing faces as the remaining elements.
- If optional fourth argument APPEND is non-nil, append FACE to the end
- of the face list instead.
- If optional fifth argument OBJECT is a buffer (or nil, which means the
- current buffer), START and END are buffer positions (integers or
- markers). If OBJECT is a string, START and END are 0-based indices
- into it. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object face,
- Lisp_Object append, Lisp_Object object)
- {
- AUTO_LIST2 (properties, Qface, face);
- add_text_properties_1 (start, end, properties, object,
- (NILP (append)
- ? TEXT_PROPERTY_PREPEND
- : TEXT_PROPERTY_APPEND));
- return Qnil;
- }
- /* 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.
- COHERENT_CHANGE_P nil means this is being called as an internal
- subroutine, rather than as a change primitive with checking of
- read-only, invoking change hooks, etc.. Value is nil if the
- function _detected_ that it did not replace any properties, non-nil
- otherwise. */
- Lisp_Object
- set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
- Lisp_Object object, Lisp_Object coherent_change_p)
- {
- register INTERVAL i;
- Lisp_Object ostart, oend;
- ostart = start;
- oend = end;
- properties = validate_plist (properties);
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- /* If we want no properties for a whole string,
- get rid of its intervals. */
- if (NILP (properties) && STRINGP (object)
- && XFASTINT (start) == 0
- && XFASTINT (end) == SCHARS (object))
- {
- if (!string_intervals (object))
- return Qnil;
- set_string_intervals (object, NULL);
- return Qt;
- }
- i = validate_interval_range (object, &start, &end, soft);
- if (!i)
- {
- /* If buffer has no properties, and we want none, return now. */
- if (NILP (properties))
- return Qnil;
- /* Restore the original START and END values
- because validate_interval_range increments them for strings. */
- start = ostart;
- end = oend;
- i = validate_interval_range (object, &start, &end, hard);
- /* This can return if start == end. */
- if (!i)
- return Qnil;
- }
- if (BUFFERP (object) && !NILP (coherent_change_p))
- modify_text_properties (object, start, end);
- set_text_properties_1 (start, end, properties, object, i);
- if (BUFFERP (object) && !NILP (coherent_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. OBJECT is the buffer or string containing
- the text. This does not obey any hooks.
- You should provide the interval that START is located in as I.
- START and END can be in any order. */
- void
- set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
- {
- register INTERVAL prev_changed = NULL;
- register ptrdiff_t s, len;
- INTERVAL unchanged;
- if (XINT (start) < XINT (end))
- {
- s = XINT (start);
- len = XINT (end) - s;
- }
- else if (XINT (end) < XINT (start))
- {
- s = XINT (end);
- len = XINT (start) - s;
- }
- else
- return;
- eassert (i);
- if (i->position != s)
- {
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- if (LENGTH (i) > len)
- {
- copy_properties (unchanged, i);
- i = split_interval_left (i, len);
- set_properties (properties, i, object);
- return;
- }
- set_properties (properties, i, object);
- if (LENGTH (i) == len)
- return;
- prev_changed = i;
- len -= LENGTH (i);
- i = next_interval (i);
- }
- /* We are starting at the beginning of an interval I. LEN is positive. */
- do
- {
- eassert (i != 0);
- if (LENGTH (i) >= len)
- {
- if (LENGTH (i) > len)
- i = split_interval_left (i, len);
- /* 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);
- if (prev_changed)
- merge_interval_left (i);
- 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);
- if (!prev_changed)
- prev_changed = i;
- else
- prev_changed = i = merge_interval_left (i);
- i = next_interval (i);
- }
- while (len > 0);
- }
- DEFUN ("remove-text-properties", Fremove_text_properties,
- Sremove_text_properties, 3, 4, 0,
- doc: /* Remove some properties from text from START to END.
- The third argument PROPERTIES is a property list
- whose property names specify the properties to remove.
- \(The values stored in PROPERTIES are ignored.)
- If the optional fourth argument OBJECT is a buffer (or nil, which means
- the current buffer), START and END are buffer positions (integers or
- markers). If OBJECT is a string, START and END are 0-based indices into it.
- Return t if any property was actually removed, nil otherwise.
- Use `set-text-properties' if you want to remove all text properties. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
- {
- INTERVAL i, unchanged;
- ptrdiff_t s, len;
- bool modified = false;
- bool first_time = true;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- retry:
- i = validate_interval_range (object, &start, &end, soft);
- if (!i)
- return Qnil;
- s = XINT (start);
- len = XINT (end) - s;
- /* If there are no properties on this entire interval, return. */
- if (! interval_has_some_properties (properties, i))
- {
- ptrdiff_t got = LENGTH (i) - (s - i->position);
- do
- {
- if (got >= len)
- return Qnil;
- len -= got;
- i = next_interval (i);
- got = LENGTH (i);
- }
- while (! interval_has_some_properties (properties, i));
- }
- /* Split away the beginning of this interval; what we don't
- want to modify. */
- else if (i->position != s)
- {
- unchanged = i;
- i = split_interval_right (unchanged, s - unchanged->position);
- copy_properties (unchanged, i);
- }
- if (BUFFERP (object) && first_time)
- {
- ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
- ptrdiff_t prev_pos = i->position;
- modify_text_properties (object, start, end);
- /* If someone called us recursively as a side effect of
- modify_text_properties, and changed the intervals behind our back
- (could happen if lock_file, called by prepare_to_modify_buffer,
- triggers redisplay, and that calls add-text-properties again
- in the same buffer), we cannot continue with I, because its
- data changed. So we restart the interval analysis anew. */
- if (TOTAL_LENGTH (i) != prev_total_length
- || i->position != prev_pos)
- {
- first_time = false;
- goto retry;
- }
- }
- /* We are at the beginning of an interval, with len to scan */
- for (;;)
- {
- eassert (i != 0);
- if (LENGTH (i) >= len)
- {
- if (! interval_has_some_properties (properties, i))
- {
- eassert (modified);
- if (BUFFERP (object))
- signal_after_change (XINT (start), XINT (end) - XINT (start),
- XINT (end) - XINT (start));
- return Qt;
- }
- if (LENGTH (i) == len)
- {
- remove_properties (properties, Qnil, 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 (properties, Qnil, 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 (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.
- If the optional fourth argument OBJECT is a buffer (or nil, which means
- the current buffer), START and END are buffer positions (integers or
- markers). If OBJECT is a string, START and END are 0-based indices into it.
- Return t if any property was actually removed, nil otherwise. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
- {
- INTERVAL i, unchanged;
- ptrdiff_t s, len;
- bool modified = false;
- Lisp_Object properties;
- properties = list_of_properties;
- if (NILP (object))
- XSETBUFFER (object, current_buffer);
- i = validate_interval_range (object, &start, &end, soft);
- if (!i)
- return Qnil;
- s = XINT (start);
- len = XINT (end) - s;
- /* If there are no properties on the interval, return. */
- if (! interval_has_some_properties_list (properties, i))
- {
- ptrdiff_t got = LENGTH (i) - (s - i->position);
- do
- {
- if (got >= len)
- return Qnil;
- len -= got;
- i = next_inte…
Large files files are truncated, but you can click here to view the full file