1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2015 Free Software Foundation,
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include "intervals.h"
24 #include "character.h"
28 /* Test for membership, allowing for t (actually any non-cons) to mean the
31 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
34 /* NOTES: previous- and next- property change will have to skip
35 zero-length intervals if they are implemented. This could be done
36 inside next_interval and previous_interval.
38 set_properties needs to deal with the interval property cache.
40 It is assumed that for any interval plist, a property appears
41 only once on the list. Although some code i.e., remove_properties,
42 handles the more general case, the uniqueness of properties is
43 necessary for the system to remain consistent. This requirement
44 is enforced by the subrs installing properties onto the intervals. */
48 enum property_set_type
50 TEXT_PROPERTY_REPLACE
,
51 TEXT_PROPERTY_PREPEND
,
55 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
56 the o1's cdr. Otherwise, return zero. This is handy for
58 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
60 /* verify_interval_modification saves insertion hooks here
61 to be run later by report_interval_modification. */
62 static Lisp_Object interval_insert_behind_hooks
;
63 static Lisp_Object interval_insert_in_front_hooks
;
66 /* Signal a `text-read-only' error. This function makes it easier
67 to capture that error in GDB by putting a breakpoint on it. */
70 text_read_only (Lisp_Object propval
)
72 if (STRINGP (propval
))
73 xsignal1 (Qtext_read_only
, propval
);
75 xsignal0 (Qtext_read_only
);
78 /* Prepare to modify the text properties of BUFFER from START to END. */
81 modify_text_properties (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
83 ptrdiff_t b
= XINT (start
), e
= XINT (end
);
84 struct buffer
*buf
= XBUFFER (buffer
), *old
= current_buffer
;
86 set_buffer_internal (buf
);
88 prepare_to_modify_buffer_1 (b
, e
, NULL
);
90 BUF_COMPUTE_UNCHANGED (buf
, b
- 1, e
);
91 if (MODIFF
<= SAVE_MODIFF
)
92 record_first_change ();
95 bset_point_before_scroll (current_buffer
, Qnil
);
97 set_buffer_internal (old
);
100 /* Complain if object is not string or buffer type. */
103 CHECK_STRING_OR_BUFFER (Lisp_Object x
)
105 CHECK_TYPE (STRINGP (x
) || BUFFERP (x
), Qbuffer_or_string_p
, x
);
108 /* Extract the interval at the position pointed to by BEGIN from
109 OBJECT, a string or buffer. Additionally, check that the positions
110 pointed to by BEGIN and END are within the bounds of OBJECT, and
111 reverse them if *BEGIN is greater than *END. The objects pointed
112 to by BEGIN and END may be integers or markers; if the latter, they
113 are coerced to integers.
115 When OBJECT is a string, we increment *BEGIN and *END
116 to make them origin-one.
118 Note that buffer points don't correspond to interval indices.
119 For example, point-max is 1 greater than the index of the last
120 character. This difference is handled in the caller, which uses
121 the validated points to determine a length, and operates on that.
122 Exceptions are Ftext_properties_at, Fnext_property_change, and
123 Fprevious_property_change which call this function with BEGIN == END.
124 Handle this case specially.
126 If FORCE is soft (0), it's OK to return NULL. Otherwise,
127 create an interval tree for OBJECT if one doesn't exist, provided
128 the object actually contains text. In the current design, if there
129 is no text, there can be no text properties. */
135 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
,
136 Lisp_Object
*end
, bool force
)
141 CHECK_STRING_OR_BUFFER (object
);
142 CHECK_NUMBER_COERCE_MARKER (*begin
);
143 CHECK_NUMBER_COERCE_MARKER (*end
);
145 /* If we are asked for a point, but from a subr which operates
146 on a range, then return nothing. */
147 if (EQ (*begin
, *end
) && begin
!= end
)
150 if (XINT (*begin
) > XINT (*end
))
158 if (BUFFERP (object
))
160 register struct buffer
*b
= XBUFFER (object
);
162 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
163 && XINT (*end
) <= BUF_ZV (b
)))
164 args_out_of_range (*begin
, *end
);
165 i
= buffer_intervals (b
);
167 /* If there's no text, there are no properties. */
168 if (BUF_BEGV (b
) == BUF_ZV (b
))
171 searchpos
= XINT (*begin
);
175 ptrdiff_t len
= SCHARS (object
);
177 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
178 && XINT (*end
) <= len
))
179 args_out_of_range (*begin
, *end
);
180 XSETFASTINT (*begin
, XFASTINT (*begin
));
182 XSETFASTINT (*end
, XFASTINT (*end
));
183 i
= string_intervals (object
);
188 searchpos
= XINT (*begin
);
192 return (force
? create_root_interval (object
) : i
);
194 return find_interval (i
, searchpos
);
197 /* Validate LIST as a property list. If LIST is not a list, then
198 make one consisting of (LIST nil). Otherwise, verify that LIST
199 is even numbered and thus suitable as a plist. */
202 validate_plist (Lisp_Object list
)
211 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
217 error ("Odd length text property list");
221 return list2 (list
, Qnil
);
224 /* Return true if interval I has all the properties,
225 with the same values, of list PLIST. */
228 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
230 Lisp_Object tail1
, tail2
;
232 /* Go through each element of PLIST. */
233 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
235 Lisp_Object sym1
= XCAR (tail1
);
238 /* Go through I's plist, looking for sym1 */
239 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
240 if (EQ (sym1
, XCAR (tail2
)))
242 /* Found the same property on both lists. If the
243 values are unequal, return zero. */
244 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
247 /* Property has same value on both lists; go to next one. */
259 /* Return true if the plist of interval I has any of the
260 properties of PLIST, regardless of their values. */
263 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
265 Lisp_Object tail1
, tail2
, sym
;
267 /* Go through each element of PLIST. */
268 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
272 /* Go through i's plist, looking for tail1 */
273 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
274 if (EQ (sym
, XCAR (tail2
)))
281 /* Return nonzero if the plist of interval I has any of the
282 property names in LIST, regardless of their values. */
285 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
287 Lisp_Object tail1
, tail2
, sym
;
289 /* Go through each element of LIST. */
290 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
294 /* Go through i's plist, looking for tail1 */
295 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
296 if (EQ (sym
, XCAR (tail2
)))
303 /* Changing the plists of individual intervals. */
305 /* Return the value of PROP in property-list PLIST, or Qunbound if it
308 property_value (Lisp_Object plist
, Lisp_Object prop
)
312 while (PLIST_ELT_P (plist
, value
))
313 if (EQ (XCAR (plist
), prop
))
316 plist
= XCDR (value
);
321 /* Set the properties of INTERVAL to PROPERTIES,
322 and record undo info for the previous values.
323 OBJECT is the string or buffer that INTERVAL belongs to. */
326 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
328 Lisp_Object sym
, value
;
330 if (BUFFERP (object
))
332 /* For each property in the old plist which is missing from PROPERTIES,
333 or has a different value in PROPERTIES, make an undo record. */
334 for (sym
= interval
->plist
;
335 PLIST_ELT_P (sym
, value
);
337 if (! EQ (property_value (properties
, XCAR (sym
)),
340 record_property_change (interval
->position
, LENGTH (interval
),
341 XCAR (sym
), XCAR (value
),
345 /* For each new property that has no value at all in the old plist,
346 make an undo record binding it to nil, so it will be removed. */
347 for (sym
= properties
;
348 PLIST_ELT_P (sym
, value
);
350 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
352 record_property_change (interval
->position
, LENGTH (interval
),
358 /* Store new properties. */
359 set_interval_plist (interval
, Fcopy_sequence (properties
));
362 /* Add the properties of PLIST to the interval I, or set
363 the value of I's property to the value of the property on PLIST
364 if they are different.
366 OBJECT should be the string or buffer the interval is in.
368 Return true if this changes I (i.e., if any members of PLIST
369 are actually added to I's plist) */
372 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
,
373 enum property_set_type set_type
)
375 Lisp_Object tail1
, tail2
, sym1
, val1
;
377 struct gcpro gcpro1
, gcpro2
, gcpro3
;
382 /* No need to protect OBJECT, because we can GC only in the case
383 where it is a buffer, and live buffers are always protected.
384 I and its plist are also protected, via OBJECT. */
385 GCPRO3 (tail1
, sym1
, val1
);
387 /* Go through each element of PLIST. */
388 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
392 val1
= Fcar (XCDR (tail1
));
394 /* Go through I's plist, looking for sym1 */
395 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
396 if (EQ (sym1
, XCAR (tail2
)))
398 /* No need to gcpro, because tail2 protects this
399 and it must be a cons cell (we get an error otherwise). */
400 register Lisp_Object this_cdr
;
402 this_cdr
= XCDR (tail2
);
403 /* Found the property. Now check its value. */
406 /* The properties have the same value on both lists.
407 Continue to the next property. */
408 if (EQ (val1
, Fcar (this_cdr
)))
411 /* Record this change in the buffer, for undo purposes. */
412 if (BUFFERP (object
))
414 record_property_change (i
->position
, LENGTH (i
),
415 sym1
, Fcar (this_cdr
), object
);
418 /* I's property has a different value -- change it */
419 if (set_type
== TEXT_PROPERTY_REPLACE
)
420 Fsetcar (this_cdr
, val1
);
422 if (CONSP (Fcar (this_cdr
)) &&
423 /* Special-case anonymous face properties. */
424 (! EQ (sym1
, Qface
) ||
425 NILP (Fkeywordp (Fcar (Fcar (this_cdr
))))))
426 /* The previous value is a list, so prepend (or
427 append) the new value to this list. */
428 if (set_type
== TEXT_PROPERTY_PREPEND
)
429 Fsetcar (this_cdr
, Fcons (val1
, Fcar (this_cdr
)));
431 nconc2 (Fcar (this_cdr
), list1 (val1
));
433 /* The previous value is a single value, so make it
435 if (set_type
== TEXT_PROPERTY_PREPEND
)
436 Fsetcar (this_cdr
, list2 (val1
, Fcar (this_cdr
)));
438 Fsetcar (this_cdr
, list2 (Fcar (this_cdr
), val1
));
447 /* Record this change in the buffer, for undo purposes. */
448 if (BUFFERP (object
))
450 record_property_change (i
->position
, LENGTH (i
),
453 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
463 /* For any members of PLIST, or LIST,
464 which are properties of I, remove them from I's plist.
465 (If PLIST is non-nil, use that, otherwise use LIST.)
466 OBJECT is the string or buffer containing I. */
469 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
471 Lisp_Object tail1
, tail2
, sym
, current_plist
;
474 /* True means tail1 is a plist, otherwise it is a list. */
477 current_plist
= i
->plist
;
480 tail1
= plist
, use_plist
= 1;
482 tail1
= list
, use_plist
= 0;
484 /* Go through each element of LIST or PLIST. */
485 while (CONSP (tail1
))
489 /* First, remove the symbol if it's at the head of the list */
490 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
492 if (BUFFERP (object
))
493 record_property_change (i
->position
, LENGTH (i
),
494 sym
, XCAR (XCDR (current_plist
)),
497 current_plist
= XCDR (XCDR (current_plist
));
501 /* Go through I's plist, looking for SYM. */
502 tail2
= current_plist
;
503 while (! NILP (tail2
))
505 register Lisp_Object
this;
506 this = XCDR (XCDR (tail2
));
507 if (CONSP (this) && EQ (sym
, XCAR (this)))
509 if (BUFFERP (object
))
510 record_property_change (i
->position
, LENGTH (i
),
511 sym
, XCAR (XCDR (this)), object
);
513 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
519 /* Advance thru TAIL1 one way or the other. */
520 tail1
= XCDR (tail1
);
521 if (use_plist
&& CONSP (tail1
))
522 tail1
= XCDR (tail1
);
526 set_interval_plist (i
, current_plist
);
530 /* Returns the interval of POSITION in OBJECT.
531 POSITION is BEG-based. */
534 interval_of (ptrdiff_t position
, Lisp_Object object
)
540 XSETBUFFER (object
, current_buffer
);
541 else if (EQ (object
, Qt
))
544 CHECK_STRING_OR_BUFFER (object
);
546 if (BUFFERP (object
))
548 register struct buffer
*b
= XBUFFER (object
);
552 i
= buffer_intervals (b
);
557 end
= SCHARS (object
);
558 i
= string_intervals (object
);
561 if (!(beg
<= position
&& position
<= end
))
562 args_out_of_range (make_number (position
), make_number (position
));
563 if (beg
== end
|| !i
)
566 return find_interval (i
, position
);
569 DEFUN ("text-properties-at", Ftext_properties_at
,
570 Stext_properties_at
, 1, 2, 0,
571 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
572 If the optional second argument OBJECT is a buffer (or nil, which means
573 the current buffer), POSITION is a buffer position (integer or marker).
574 If OBJECT is a string, POSITION is a 0-based index into it.
575 If POSITION is at the end of OBJECT, the value is nil. */)
576 (Lisp_Object position
, Lisp_Object object
)
581 XSETBUFFER (object
, current_buffer
);
583 i
= validate_interval_range (object
, &position
, &position
, soft
);
586 /* If POSITION is at the end of the interval,
587 it means it's the end of OBJECT.
588 There are no properties at the very end,
589 since no character follows. */
590 if (XINT (position
) == LENGTH (i
) + i
->position
)
596 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
597 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
598 OBJECT should be a buffer or a string; if omitted or nil, it defaults
599 to the current buffer.
600 If POSITION is at the end of OBJECT, the value is nil. */)
601 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
603 return textget (Ftext_properties_at (position
, object
), prop
);
606 /* Return the value of char's property PROP, in OBJECT at POSITION.
607 OBJECT is optional and defaults to the current buffer.
608 If OVERLAY is non-0, then in the case that the returned property is from
609 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
610 returned in *OVERLAY.
611 If POSITION is at the end of OBJECT, the value is nil.
612 If OBJECT is a buffer, then overlay properties are considered as well as
614 If OBJECT is a window, then that window's buffer is used, but
615 window-specific overlays are considered only if they are associated
618 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
620 struct window
*w
= 0;
622 CHECK_NUMBER_COERCE_MARKER (position
);
625 XSETBUFFER (object
, current_buffer
);
627 if (WINDOWP (object
))
629 CHECK_LIVE_WINDOW (object
);
630 w
= XWINDOW (object
);
631 object
= w
->contents
;
633 if (BUFFERP (object
))
636 Lisp_Object
*overlay_vec
;
637 struct buffer
*obuf
= current_buffer
;
639 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
640 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
641 xsignal1 (Qargs_out_of_range
, position
);
643 set_buffer_temp (XBUFFER (object
));
646 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
647 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
649 set_buffer_temp (obuf
);
651 /* Now check the overlays in order of decreasing priority. */
652 while (--noverlays
>= 0)
654 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
658 /* Return the overlay we got the property from. */
659 *overlay
= overlay_vec
[noverlays
];
668 /* Indicate that the return value is not from an overlay. */
671 /* Not a buffer, or no appropriate overlay, so fall through to the
673 return Fget_text_property (position
, prop
, object
);
676 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
677 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
678 Both overlay properties and text properties are checked.
679 OBJECT is optional and defaults to the current buffer.
680 If POSITION is at the end of OBJECT, the value is nil.
681 If OBJECT is a buffer, then overlay properties are considered as well as
683 If OBJECT is a window, then that window's buffer is used, but window-specific
684 overlays are considered only if they are associated with OBJECT. */)
685 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
687 return get_char_property_and_overlay (position
, prop
, object
, 0);
690 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
691 Sget_char_property_and_overlay
, 2, 3, 0,
692 doc
: /* Like `get-char-property', but with extra overlay information.
693 The value is a cons cell. Its car is the return value of `get-char-property'
694 with the same arguments--that is, the value of POSITION's property
695 PROP in OBJECT. Its cdr is the overlay in which the property was
696 found, or nil, if it was found as a text property or not found at all.
698 OBJECT is optional and defaults to the current buffer. OBJECT may be
699 a string, a buffer or a window. For strings, the cdr of the return
700 value is always nil, since strings do not have overlays. If OBJECT is
701 a window, then that window's buffer is used, but window-specific
702 overlays are considered only if they are associated with OBJECT. If
703 POSITION is at the end of OBJECT, both car and cdr are nil. */)
704 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
708 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
709 return Fcons (val
, overlay
);
713 DEFUN ("next-char-property-change", Fnext_char_property_change
,
714 Snext_char_property_change
, 1, 2, 0,
715 doc
: /* Return the position of next text property or overlay change.
716 This scans characters forward in the current buffer from POSITION till
717 it finds a change in some text property, or the beginning or end of an
718 overlay, and returns the position of that.
719 If none is found up to (point-max), the function returns (point-max).
721 If the optional second argument LIMIT is non-nil, don't search
722 past position LIMIT; return LIMIT if nothing is found before LIMIT.
723 LIMIT is a no-op if it is greater than (point-max). */)
724 (Lisp_Object position
, Lisp_Object limit
)
728 temp
= Fnext_overlay_change (position
);
731 CHECK_NUMBER_COERCE_MARKER (limit
);
732 if (XINT (limit
) < XINT (temp
))
735 return Fnext_property_change (position
, Qnil
, temp
);
738 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
739 Sprevious_char_property_change
, 1, 2, 0,
740 doc
: /* Return the position of previous text property or overlay change.
741 Scans characters backward in the current buffer from POSITION till it
742 finds a change in some text property, or the beginning or end of an
743 overlay, and returns the position of that.
744 If none is found since (point-min), the function returns (point-min).
746 If the optional second argument LIMIT is non-nil, don't search
747 past position LIMIT; return LIMIT if nothing is found before LIMIT.
748 LIMIT is a no-op if it is less than (point-min). */)
749 (Lisp_Object position
, Lisp_Object limit
)
753 temp
= Fprevious_overlay_change (position
);
756 CHECK_NUMBER_COERCE_MARKER (limit
);
757 if (XINT (limit
) > XINT (temp
))
760 return Fprevious_property_change (position
, Qnil
, temp
);
764 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
765 Snext_single_char_property_change
, 2, 4, 0,
766 doc
: /* Return the position of next text property or overlay change for a specific property.
767 Scans characters forward from POSITION till it finds
768 a change in the PROP property, then returns the position of the change.
769 If the optional third argument OBJECT is a buffer (or nil, which means
770 the current buffer), POSITION is a buffer position (integer or marker).
771 If OBJECT is a string, POSITION is a 0-based index into it.
773 In a string, scan runs to the end of the string.
774 In a buffer, it runs to (point-max), and the value cannot exceed that.
776 The property values are compared with `eq'.
777 If the property is constant all the way to the end of OBJECT, return the
778 last valid position in OBJECT.
779 If the optional fourth argument LIMIT is non-nil, don't search
780 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
781 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
783 if (STRINGP (object
))
785 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
789 position
= make_number (SCHARS (object
));
792 CHECK_NUMBER (limit
);
799 Lisp_Object initial_value
, value
;
800 ptrdiff_t count
= SPECPDL_INDEX ();
803 CHECK_BUFFER (object
);
805 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
807 record_unwind_current_buffer ();
808 Fset_buffer (object
);
811 CHECK_NUMBER_COERCE_MARKER (position
);
813 initial_value
= Fget_char_property (position
, prop
, object
);
816 XSETFASTINT (limit
, ZV
);
818 CHECK_NUMBER_COERCE_MARKER (limit
);
820 if (XFASTINT (position
) >= XFASTINT (limit
))
823 if (XFASTINT (position
) > ZV
)
824 XSETFASTINT (position
, ZV
);
829 position
= Fnext_char_property_change (position
, limit
);
830 if (XFASTINT (position
) >= XFASTINT (limit
))
836 value
= Fget_char_property (position
, prop
, object
);
837 if (!EQ (value
, initial_value
))
841 unbind_to (count
, Qnil
);
847 DEFUN ("previous-single-char-property-change",
848 Fprevious_single_char_property_change
,
849 Sprevious_single_char_property_change
, 2, 4, 0,
850 doc
: /* Return the position of previous text property or overlay change for a specific property.
851 Scans characters backward from POSITION till it finds
852 a change in the PROP property, then returns the position of the change.
853 If the optional third argument OBJECT is a buffer (or nil, which means
854 the current buffer), POSITION is a buffer position (integer or marker).
855 If OBJECT is a string, POSITION is a 0-based index into it.
857 In a string, scan runs to the start of the string.
858 In a buffer, it runs to (point-min), and the value cannot be less than that.
860 The property values are compared with `eq'.
861 If the property is constant all the way to the start of OBJECT, return the
862 first valid position in OBJECT.
863 If the optional fourth argument LIMIT is non-nil, don't search back past
864 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
865 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
867 if (STRINGP (object
))
869 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
873 position
= make_number (0);
876 CHECK_NUMBER (limit
);
883 ptrdiff_t count
= SPECPDL_INDEX ();
886 CHECK_BUFFER (object
);
888 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
890 record_unwind_current_buffer ();
891 Fset_buffer (object
);
894 CHECK_NUMBER_COERCE_MARKER (position
);
897 XSETFASTINT (limit
, BEGV
);
899 CHECK_NUMBER_COERCE_MARKER (limit
);
901 if (XFASTINT (position
) <= XFASTINT (limit
))
904 if (XFASTINT (position
) < BEGV
)
905 XSETFASTINT (position
, BEGV
);
909 Lisp_Object initial_value
910 = Fget_char_property (make_number (XFASTINT (position
) - 1),
915 position
= Fprevious_char_property_change (position
, limit
);
917 if (XFASTINT (position
) <= XFASTINT (limit
))
925 = Fget_char_property (make_number (XFASTINT (position
) - 1),
928 if (!EQ (value
, initial_value
))
934 unbind_to (count
, Qnil
);
940 DEFUN ("next-property-change", Fnext_property_change
,
941 Snext_property_change
, 1, 3, 0,
942 doc
: /* Return the position of next property change.
943 Scans characters forward from POSITION in OBJECT till it finds
944 a change in some text property, then returns the position of the change.
945 If the optional second argument OBJECT is a buffer (or nil, which means
946 the current buffer), POSITION is a buffer position (integer or marker).
947 If OBJECT is a string, POSITION is a 0-based index into it.
948 Return nil if the property is constant all the way to the end of OBJECT.
949 If the value is non-nil, it is a position greater than POSITION, never equal.
951 If the optional third argument LIMIT is non-nil, don't search
952 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
953 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
955 register INTERVAL i
, next
;
958 XSETBUFFER (object
, current_buffer
);
960 if (!NILP (limit
) && !EQ (limit
, Qt
))
961 CHECK_NUMBER_COERCE_MARKER (limit
);
963 i
= validate_interval_range (object
, &position
, &position
, soft
);
965 /* If LIMIT is t, return start of next interval--don't
966 bother checking further intervals. */
972 next
= next_interval (i
);
975 XSETFASTINT (position
, (STRINGP (object
)
977 : BUF_ZV (XBUFFER (object
))));
979 XSETFASTINT (position
, next
->position
);
986 next
= next_interval (i
);
988 while (next
&& intervals_equal (i
, next
)
989 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
990 next
= next_interval (next
);
998 : BUF_ZV (XBUFFER (object
))))))
1001 return make_number (next
->position
);
1004 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1005 Snext_single_property_change
, 2, 4, 0,
1006 doc
: /* Return the position of next property change for a specific property.
1007 Scans characters forward from POSITION till it finds
1008 a change in the PROP property, then returns the position of the change.
1009 If the optional third argument OBJECT is a buffer (or nil, which means
1010 the current buffer), POSITION is a buffer position (integer or marker).
1011 If OBJECT is a string, POSITION is a 0-based index into it.
1012 The property values are compared with `eq'.
1013 Return nil if the property is constant all the way to the end of OBJECT.
1014 If the value is non-nil, it is a position greater than POSITION, never equal.
1016 If the optional fourth argument LIMIT is non-nil, don't search
1017 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1018 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1020 register INTERVAL i
, next
;
1021 register Lisp_Object here_val
;
1024 XSETBUFFER (object
, current_buffer
);
1027 CHECK_NUMBER_COERCE_MARKER (limit
);
1029 i
= validate_interval_range (object
, &position
, &position
, soft
);
1033 here_val
= textget (i
->plist
, prop
);
1034 next
= next_interval (i
);
1036 && EQ (here_val
, textget (next
->plist
, prop
))
1037 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1038 next
= next_interval (next
);
1042 >= (INTEGERP (limit
)
1046 : BUF_ZV (XBUFFER (object
))))))
1049 return make_number (next
->position
);
1052 DEFUN ("previous-property-change", Fprevious_property_change
,
1053 Sprevious_property_change
, 1, 3, 0,
1054 doc
: /* Return the position of previous property change.
1055 Scans characters backwards from POSITION in OBJECT till it finds
1056 a change in some text property, then returns the position of the change.
1057 If the optional second argument OBJECT is a buffer (or nil, which means
1058 the current buffer), POSITION is a buffer position (integer or marker).
1059 If OBJECT is a string, POSITION is a 0-based index into it.
1060 Return nil if the property is constant all the way to the start of OBJECT.
1061 If the value is non-nil, it is a position less than POSITION, never equal.
1063 If the optional third argument LIMIT is non-nil, don't search
1064 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1065 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1067 register INTERVAL i
, previous
;
1070 XSETBUFFER (object
, current_buffer
);
1073 CHECK_NUMBER_COERCE_MARKER (limit
);
1075 i
= validate_interval_range (object
, &position
, &position
, soft
);
1079 /* Start with the interval containing the char before point. */
1080 if (i
->position
== XFASTINT (position
))
1081 i
= previous_interval (i
);
1083 previous
= previous_interval (i
);
1084 while (previous
&& intervals_equal (previous
, i
)
1086 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1087 previous
= previous_interval (previous
);
1090 || (previous
->position
+ LENGTH (previous
)
1091 <= (INTEGERP (limit
)
1093 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1096 return make_number (previous
->position
+ LENGTH (previous
));
1099 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1100 Sprevious_single_property_change
, 2, 4, 0,
1101 doc
: /* Return the position of previous property change for a specific property.
1102 Scans characters backward from POSITION till it finds
1103 a change in the PROP property, then returns the position of the change.
1104 If the optional third argument OBJECT is a buffer (or nil, which means
1105 the current buffer), POSITION is a buffer position (integer or marker).
1106 If OBJECT is a string, POSITION is a 0-based index into it.
1107 The property values are compared with `eq'.
1108 Return nil if the property is constant all the way to the start of OBJECT.
1109 If the value is non-nil, it is a position less than POSITION, never equal.
1111 If the optional fourth argument LIMIT is non-nil, don't search
1112 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1113 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1115 register INTERVAL i
, previous
;
1116 register Lisp_Object here_val
;
1119 XSETBUFFER (object
, current_buffer
);
1122 CHECK_NUMBER_COERCE_MARKER (limit
);
1124 i
= validate_interval_range (object
, &position
, &position
, soft
);
1126 /* Start with the interval containing the char before point. */
1127 if (i
&& i
->position
== XFASTINT (position
))
1128 i
= previous_interval (i
);
1133 here_val
= textget (i
->plist
, prop
);
1134 previous
= previous_interval (i
);
1136 && EQ (here_val
, textget (previous
->plist
, prop
))
1138 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1139 previous
= previous_interval (previous
);
1142 || (previous
->position
+ LENGTH (previous
)
1143 <= (INTEGERP (limit
)
1145 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1148 return make_number (previous
->position
+ LENGTH (previous
));
1151 /* Used by add-text-properties and add-face-text-property. */
1154 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1155 Lisp_Object properties
, Lisp_Object object
,
1156 enum property_set_type set_type
) {
1157 INTERVAL i
, unchanged
;
1160 struct gcpro gcpro1
;
1161 bool first_time
= 1;
1163 properties
= validate_plist (properties
);
1164 if (NILP (properties
))
1168 XSETBUFFER (object
, current_buffer
);
1171 i
= validate_interval_range (object
, &start
, &end
, hard
);
1176 len
= XINT (end
) - s
;
1178 /* No need to protect OBJECT, because we GC only if it's a buffer,
1179 and live buffers are always protected. */
1180 GCPRO1 (properties
);
1182 /* If this interval already has the properties, we can skip it. */
1183 if (interval_has_all_properties (properties
, i
))
1185 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1190 RETURN_UNGCPRO (Qnil
);
1192 i
= next_interval (i
);
1195 while (interval_has_all_properties (properties
, i
));
1197 else if (i
->position
!= s
)
1199 /* If we're not starting on an interval boundary, we have to
1200 split this interval. */
1202 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1203 copy_properties (unchanged
, i
);
1206 if (BUFFERP (object
) && first_time
)
1208 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1209 ptrdiff_t prev_pos
= i
->position
;
1211 modify_text_properties (object
, start
, end
);
1212 /* If someone called us recursively as a side effect of
1213 modify_text_properties, and changed the intervals behind our back
1214 (could happen if lock_file, called by prepare_to_modify_buffer,
1215 triggers redisplay, and that calls add-text-properties again
1216 in the same buffer), we cannot continue with I, because its
1217 data changed. So we restart the interval analysis anew. */
1218 if (TOTAL_LENGTH (i
) != prev_total_length
1219 || i
->position
!= prev_pos
)
1226 /* We are at the beginning of interval I, with LEN chars to scan. */
1231 if (LENGTH (i
) >= len
)
1233 /* We can UNGCPRO safely here, because there will be just
1234 one more chance to gc, in the next call to add_properties,
1235 and after that we will not need PROPERTIES or OBJECT again. */
1238 if (interval_has_all_properties (properties
, i
))
1240 if (BUFFERP (object
))
1241 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1242 XINT (end
) - XINT (start
));
1248 if (LENGTH (i
) == len
)
1250 add_properties (properties
, i
, object
, set_type
);
1251 if (BUFFERP (object
))
1252 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1253 XINT (end
) - XINT (start
));
1257 /* i doesn't have the properties, and goes past the change limit */
1259 i
= split_interval_left (unchanged
, len
);
1260 copy_properties (unchanged
, i
);
1261 add_properties (properties
, i
, object
, set_type
);
1262 if (BUFFERP (object
))
1263 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1264 XINT (end
) - XINT (start
));
1269 modified
|= add_properties (properties
, i
, object
, set_type
);
1270 i
= next_interval (i
);
1274 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1276 DEFUN ("add-text-properties", Fadd_text_properties
,
1277 Sadd_text_properties
, 3, 4, 0,
1278 doc
: /* Add properties to the text from START to END.
1279 The third argument PROPERTIES is a property list
1280 specifying the property values to add. If the optional fourth argument
1281 OBJECT is a buffer (or nil, which means the current buffer),
1282 START and END are buffer positions (integers or markers).
1283 If OBJECT is a string, START and END are 0-based indices into it.
1284 Return t if any property value actually changed, nil otherwise. */)
1285 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1288 return add_text_properties_1 (start
, end
, properties
, object
,
1289 TEXT_PROPERTY_REPLACE
);
1292 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1294 DEFUN ("put-text-property", Fput_text_property
,
1295 Sput_text_property
, 4, 5, 0,
1296 doc
: /* Set one property of the text from START to END.
1297 The third and fourth arguments PROPERTY and VALUE
1298 specify the property to add.
1299 If the optional fifth argument OBJECT is a buffer (or nil, which means
1300 the current buffer), START and END are buffer positions (integers or
1301 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1302 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
,
1303 Lisp_Object value
, Lisp_Object object
)
1305 AUTO_LIST2 (properties
, property
, value
);
1306 Fadd_text_properties (start
, end
, properties
, object
);
1310 DEFUN ("set-text-properties", Fset_text_properties
,
1311 Sset_text_properties
, 3, 4, 0,
1312 doc
: /* Completely replace properties of text from START to END.
1313 The third argument PROPERTIES is the new property list.
1314 If the optional fourth argument OBJECT is a buffer (or nil, which means
1315 the current buffer), START and END are buffer positions (integers or
1316 markers). If OBJECT is a string, START and END are 0-based indices into it.
1317 If PROPERTIES is nil, the effect is to remove all properties from
1318 the designated part of OBJECT. */)
1319 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1321 return set_text_properties (start
, end
, properties
, object
, Qt
);
1325 DEFUN ("add-face-text-property", Fadd_face_text_property
,
1326 Sadd_face_text_property
, 3, 5, 0,
1327 doc
: /* Add the face property to the text from START to END.
1328 FACE specifies the face to add. It should be a valid value of the
1329 `face' property (typically a face name or a plist of face attributes
1332 If any text in the region already has a non-nil `face' property, those
1333 face(s) are retained. This is done by setting the `face' property to
1334 a list of faces, with FACE as the first element (by default) and the
1335 pre-existing faces as the remaining elements.
1337 If optional fourth argument APPEND is non-nil, append FACE to the end
1338 of the face list instead.
1340 If optional fifth argument OBJECT is a buffer (or nil, which means the
1341 current buffer), START and END are buffer positions (integers or
1342 markers). If OBJECT is a string, START and END are 0-based indices
1344 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1345 Lisp_Object append
, Lisp_Object object
)
1347 AUTO_LIST2 (properties
, Qface
, face
);
1348 add_text_properties_1 (start
, end
, properties
, object
,
1350 ? TEXT_PROPERTY_PREPEND
1351 : TEXT_PROPERTY_APPEND
));
1355 /* Replace properties of text from START to END with new list of
1356 properties PROPERTIES. OBJECT is the buffer or string containing
1357 the text. OBJECT nil means use the current buffer.
1358 COHERENT_CHANGE_P nil means this is being called as an internal
1359 subroutine, rather than as a change primitive with checking of
1360 read-only, invoking change hooks, etc.. Value is nil if the
1361 function _detected_ that it did not replace any properties, non-nil
1365 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1366 Lisp_Object object
, Lisp_Object coherent_change_p
)
1368 register INTERVAL i
;
1369 Lisp_Object ostart
, oend
;
1374 properties
= validate_plist (properties
);
1377 XSETBUFFER (object
, current_buffer
);
1379 /* If we want no properties for a whole string,
1380 get rid of its intervals. */
1381 if (NILP (properties
) && STRINGP (object
)
1382 && XFASTINT (start
) == 0
1383 && XFASTINT (end
) == SCHARS (object
))
1385 if (!string_intervals (object
))
1388 set_string_intervals (object
, NULL
);
1392 i
= validate_interval_range (object
, &start
, &end
, soft
);
1396 /* If buffer has no properties, and we want none, return now. */
1397 if (NILP (properties
))
1400 /* Restore the original START and END values
1401 because validate_interval_range increments them for strings. */
1405 i
= validate_interval_range (object
, &start
, &end
, hard
);
1406 /* This can return if start == end. */
1411 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1412 modify_text_properties (object
, start
, end
);
1414 set_text_properties_1 (start
, end
, properties
, object
, i
);
1416 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1417 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1418 XINT (end
) - XINT (start
));
1422 /* Replace properties of text from START to END with new list of
1423 properties PROPERTIES. OBJECT is the buffer or string containing
1424 the text. This does not obey any hooks.
1425 You should provide the interval that START is located in as I.
1426 START and END can be in any order. */
1429 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1431 register INTERVAL prev_changed
= NULL
;
1432 register ptrdiff_t s
, len
;
1435 if (XINT (start
) < XINT (end
))
1438 len
= XINT (end
) - s
;
1440 else if (XINT (end
) < XINT (start
))
1443 len
= XINT (start
) - s
;
1450 if (i
->position
!= s
)
1453 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1455 if (LENGTH (i
) > len
)
1457 copy_properties (unchanged
, i
);
1458 i
= split_interval_left (i
, len
);
1459 set_properties (properties
, i
, object
);
1463 set_properties (properties
, i
, object
);
1465 if (LENGTH (i
) == len
)
1470 i
= next_interval (i
);
1473 /* We are starting at the beginning of an interval I. LEN is positive. */
1478 if (LENGTH (i
) >= len
)
1480 if (LENGTH (i
) > len
)
1481 i
= split_interval_left (i
, len
);
1483 /* We have to call set_properties even if we are going to
1484 merge the intervals, so as to make the undo records
1485 and cause redisplay to happen. */
1486 set_properties (properties
, i
, object
);
1488 merge_interval_left (i
);
1494 /* We have to call set_properties even if we are going to
1495 merge the intervals, so as to make the undo records
1496 and cause redisplay to happen. */
1497 set_properties (properties
, i
, object
);
1501 prev_changed
= i
= merge_interval_left (i
);
1503 i
= next_interval (i
);
1508 DEFUN ("remove-text-properties", Fremove_text_properties
,
1509 Sremove_text_properties
, 3, 4, 0,
1510 doc
: /* Remove some properties from text from START to END.
1511 The third argument PROPERTIES is a property list
1512 whose property names specify the properties to remove.
1513 \(The values stored in PROPERTIES are ignored.)
1514 If the optional fourth argument OBJECT is a buffer (or nil, which means
1515 the current buffer), START and END are buffer positions (integers or
1516 markers). If OBJECT is a string, START and END are 0-based indices into it.
1517 Return t if any property was actually removed, nil otherwise.
1519 Use `set-text-properties' if you want to remove all text properties. */)
1520 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1522 INTERVAL i
, unchanged
;
1525 bool first_time
= 1;
1528 XSETBUFFER (object
, current_buffer
);
1531 i
= validate_interval_range (object
, &start
, &end
, soft
);
1536 len
= XINT (end
) - s
;
1538 /* If there are no properties on this entire interval, return. */
1539 if (! interval_has_some_properties (properties
, i
))
1541 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1548 i
= next_interval (i
);
1551 while (! interval_has_some_properties (properties
, i
));
1553 /* Split away the beginning of this interval; what we don't
1555 else if (i
->position
!= s
)
1558 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1559 copy_properties (unchanged
, i
);
1562 if (BUFFERP (object
) && first_time
)
1564 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1565 ptrdiff_t prev_pos
= i
->position
;
1567 modify_text_properties (object
, start
, end
);
1568 /* If someone called us recursively as a side effect of
1569 modify_text_properties, and changed the intervals behind our back
1570 (could happen if lock_file, called by prepare_to_modify_buffer,
1571 triggers redisplay, and that calls add-text-properties again
1572 in the same buffer), we cannot continue with I, because its
1573 data changed. So we restart the interval analysis anew. */
1574 if (TOTAL_LENGTH (i
) != prev_total_length
1575 || i
->position
!= prev_pos
)
1582 /* We are at the beginning of an interval, with len to scan */
1587 if (LENGTH (i
) >= len
)
1589 if (! interval_has_some_properties (properties
, i
))
1592 if (BUFFERP (object
))
1593 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1594 XINT (end
) - XINT (start
));
1598 if (LENGTH (i
) == len
)
1600 remove_properties (properties
, Qnil
, i
, object
);
1601 if (BUFFERP (object
))
1602 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1603 XINT (end
) - XINT (start
));
1607 /* i has the properties, and goes past the change limit */
1609 i
= split_interval_left (i
, len
);
1610 copy_properties (unchanged
, i
);
1611 remove_properties (properties
, Qnil
, i
, object
);
1612 if (BUFFERP (object
))
1613 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1614 XINT (end
) - XINT (start
));
1619 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1620 i
= next_interval (i
);
1624 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1625 Sremove_list_of_text_properties
, 3, 4, 0,
1626 doc
: /* Remove some properties from text from START to END.
1627 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1628 If the optional fourth argument OBJECT is a buffer (or nil, which means
1629 the current buffer), START and END are buffer positions (integers or
1630 markers). If OBJECT is a string, START and END are 0-based indices into it.
1631 Return t if any property was actually removed, nil otherwise. */)
1632 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1634 INTERVAL i
, unchanged
;
1637 Lisp_Object properties
;
1638 properties
= list_of_properties
;
1641 XSETBUFFER (object
, current_buffer
);
1643 i
= validate_interval_range (object
, &start
, &end
, soft
);
1648 len
= XINT (end
) - s
;
1650 /* If there are no properties on the interval, return. */
1651 if (! interval_has_some_properties_list (properties
, i
))
1653 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1660 i
= next_interval (i
);
1663 while (! interval_has_some_properties_list (properties
, i
));
1665 /* Split away the beginning of this interval; what we don't
1667 else if (i
->position
!= s
)
1670 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1671 copy_properties (unchanged
, i
);
1674 /* We are at the beginning of an interval, with len to scan.
1675 The flag `modified' records if changes have been made.
1676 When object is a buffer, we must call modify_text_properties
1677 before changes are made and signal_after_change when we are done.
1678 We call modify_text_properties before calling remove_properties if modified == 0,
1679 and we call signal_after_change before returning if modified != 0. */
1684 if (LENGTH (i
) >= len
)
1686 if (! interval_has_some_properties_list (properties
, i
))
1690 if (BUFFERP (object
))
1691 signal_after_change (XINT (start
),
1692 XINT (end
) - XINT (start
),
1693 XINT (end
) - XINT (start
));
1699 else if (LENGTH (i
) == len
)
1701 if (!modified
&& BUFFERP (object
))
1702 modify_text_properties (object
, start
, end
);
1703 remove_properties (Qnil
, properties
, i
, object
);
1704 if (BUFFERP (object
))
1705 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1706 XINT (end
) - XINT (start
));
1710 { /* i has the properties, and goes past the change limit. */
1712 i
= split_interval_left (i
, len
);
1713 copy_properties (unchanged
, i
);
1714 if (!modified
&& BUFFERP (object
))
1715 modify_text_properties (object
, start
, end
);
1716 remove_properties (Qnil
, properties
, i
, object
);
1717 if (BUFFERP (object
))
1718 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1719 XINT (end
) - XINT (start
));
1723 if (interval_has_some_properties_list (properties
, i
))
1725 if (!modified
&& BUFFERP (object
))
1726 modify_text_properties (object
, start
, end
);
1727 remove_properties (Qnil
, properties
, i
, object
);
1731 i
= next_interval (i
);
1736 if (BUFFERP (object
))
1737 signal_after_change (XINT (start
),
1738 XINT (end
) - XINT (start
),
1739 XINT (end
) - XINT (start
));
1748 DEFUN ("text-property-any", Ftext_property_any
,
1749 Stext_property_any
, 4, 5, 0,
1750 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1751 If so, return the position of the first character whose property PROPERTY
1752 is `eq' to VALUE. Otherwise return nil.
1753 If the optional fifth argument OBJECT is a buffer (or nil, which means
1754 the current buffer), START and END are buffer positions (integers or
1755 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1756 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1758 register INTERVAL i
;
1759 register ptrdiff_t e
, pos
;
1762 XSETBUFFER (object
, current_buffer
);
1763 i
= validate_interval_range (object
, &start
, &end
, soft
);
1765 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1770 if (i
->position
>= e
)
1772 if (EQ (textget (i
->plist
, property
), value
))
1775 if (pos
< XINT (start
))
1777 return make_number (pos
);
1779 i
= next_interval (i
);
1784 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1785 Stext_property_not_all
, 4, 5, 0,
1786 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1787 If so, return the position of the first character whose property PROPERTY
1788 is not `eq' to VALUE. Otherwise, return nil.
1789 If the optional fifth argument OBJECT is a buffer (or nil, which means
1790 the current buffer), START and END are buffer positions (integers or
1791 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1792 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1794 register INTERVAL i
;
1795 register ptrdiff_t s
, e
;
1798 XSETBUFFER (object
, current_buffer
);
1799 i
= validate_interval_range (object
, &start
, &end
, soft
);
1801 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1807 if (i
->position
>= e
)
1809 if (! EQ (textget (i
->plist
, property
), value
))
1811 if (i
->position
> s
)
1813 return make_number (s
);
1815 i
= next_interval (i
);
1821 /* Return the direction from which the text-property PROP would be
1822 inherited by any new text inserted at POS: 1 if it would be
1823 inherited from the char after POS, -1 if it would be inherited from
1824 the char before POS, and 0 if from neither.
1825 BUFFER can be either a buffer or nil (meaning current buffer). */
1828 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1830 bool ignore_previous_character
;
1831 Lisp_Object prev_pos
= make_number (XINT (pos
) - 1);
1832 Lisp_Object front_sticky
;
1833 bool is_rear_sticky
= true, is_front_sticky
= false; /* defaults */
1834 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1837 XSETBUFFER (buffer
, current_buffer
);
1839 ignore_previous_character
= XINT (pos
) <= BUF_BEGV (XBUFFER (buffer
));
1841 if (ignore_previous_character
|| (CONSP (defalt
) && !NILP (XCDR (defalt
))))
1842 is_rear_sticky
= false;
1845 Lisp_Object rear_non_sticky
1846 = Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1848 if (!NILP (CONSP (rear_non_sticky
)
1849 ? Fmemq (prop
, rear_non_sticky
)
1851 /* PROP is rear-non-sticky. */
1852 is_rear_sticky
= false;
1855 /* Consider following character. */
1856 /* This signals an arg-out-of-range error if pos is outside the
1857 buffer's accessible range. */
1858 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1860 if (EQ (front_sticky
, Qt
)
1861 || (CONSP (front_sticky
)
1862 && !NILP (Fmemq (prop
, front_sticky
))))
1863 /* PROP is inherited from after. */
1864 is_front_sticky
= true;
1866 /* Simple cases, where the properties are consistent. */
1867 if (is_rear_sticky
&& !is_front_sticky
)
1869 else if (!is_rear_sticky
&& is_front_sticky
)
1871 else if (!is_rear_sticky
&& !is_front_sticky
)
1874 /* The stickiness properties are inconsistent, so we have to
1875 disambiguate. Basically, rear-sticky wins, _except_ if the
1876 property that would be inherited has a value of nil, in which case
1877 front-sticky wins. */
1878 if (ignore_previous_character
1879 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1886 /* Copying properties between objects. */
1888 /* Add properties from START to END of SRC, starting at POS in DEST.
1889 SRC and DEST may each refer to strings or buffers.
1890 Optional sixth argument PROP causes only that property to be copied.
1891 Properties are copied to DEST as if by `add-text-properties'.
1892 Return t if any property value actually changed, nil otherwise. */
1894 /* Note this can GC when DEST is a buffer. */
1897 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
,
1898 Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1904 ptrdiff_t s
, e
, e2
, p
, len
;
1906 struct gcpro gcpro1
, gcpro2
;
1908 i
= validate_interval_range (src
, &start
, &end
, soft
);
1912 CHECK_NUMBER_COERCE_MARKER (pos
);
1914 Lisp_Object dest_start
, dest_end
;
1916 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1917 if (MOST_POSITIVE_FIXNUM
< e
)
1918 args_out_of_range (pos
, end
);
1920 XSETFASTINT (dest_end
, e
);
1921 /* Apply this to a copy of pos; it will try to increment its arguments,
1922 which we don't want. */
1923 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1934 e2
= i
->position
+ LENGTH (i
);
1941 while (! NILP (plist
))
1943 if (EQ (Fcar (plist
), prop
))
1945 plist
= list2 (prop
, Fcar (Fcdr (plist
)));
1948 plist
= Fcdr (Fcdr (plist
));
1951 /* Must defer modifications to the interval tree in case
1952 src and dest refer to the same string or buffer. */
1953 stuff
= Fcons (list3 (make_number (p
), make_number (p
+ len
), plist
),
1956 i
= next_interval (i
);
1964 GCPRO2 (stuff
, dest
);
1966 while (! NILP (stuff
))
1969 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1970 Fcar (Fcdr (Fcdr (res
))), dest
);
1973 stuff
= Fcdr (stuff
);
1978 return modified
? Qt
: Qnil
;
1982 /* Return a list representing the text properties of OBJECT between
1983 START and END. if PROP is non-nil, report only on that property.
1984 Each result list element has the form (S E PLIST), where S and E
1985 are positions in OBJECT and PLIST is a property list containing the
1986 text properties of OBJECT between S and E. Value is nil if OBJECT
1987 doesn't contain text properties between START and END. */
1990 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1997 i
= validate_interval_range (object
, &start
, &end
, soft
);
2000 ptrdiff_t s
= XINT (start
);
2001 ptrdiff_t e
= XINT (end
);
2005 ptrdiff_t interval_end
, len
;
2008 interval_end
= i
->position
+ LENGTH (i
);
2009 if (interval_end
> e
)
2011 len
= interval_end
- s
;
2016 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2017 if (EQ (XCAR (plist
), prop
))
2019 plist
= list2 (prop
, Fcar (XCDR (plist
)));
2024 result
= Fcons (list3 (make_number (s
), make_number (s
+ len
),
2028 i
= next_interval (i
);
2039 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2040 (START END PLIST), where START and END are positions and PLIST is a
2041 property list containing the text properties to add. Adjust START
2042 and END positions by DELTA before adding properties. */
2045 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2047 struct gcpro gcpro1
, gcpro2
;
2049 GCPRO2 (list
, object
);
2051 for (; CONSP (list
); list
= XCDR (list
))
2053 Lisp_Object item
, start
, end
, plist
;
2056 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2057 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2058 plist
= XCAR (XCDR (XCDR (item
)));
2060 Fadd_text_properties (start
, end
, plist
, object
);
2068 /* Modify end-points of ranges in LIST destructively, and return the
2069 new list. LIST is a list as returned from text_property_list.
2070 Discard properties that begin at or after NEW_END, and limit
2071 end-points to NEW_END. */
2074 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2076 Lisp_Object prev
= Qnil
, head
= list
;
2077 ptrdiff_t max
= XINT (new_end
);
2079 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2081 Lisp_Object item
, beg
, end
;
2085 end
= XCAR (XCDR (item
));
2087 if (XINT (beg
) >= max
)
2089 /* The start-point is past the end of the new string.
2090 Discard this property. */
2091 if (EQ (head
, list
))
2094 XSETCDR (prev
, XCDR (list
));
2096 else if (XINT (end
) > max
)
2097 /* The end-point is past the end of the new string. */
2098 XSETCAR (XCDR (item
), new_end
);
2106 /* Call the modification hook functions in LIST, each with START and END. */
2109 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2111 struct gcpro gcpro1
;
2113 while (!NILP (list
))
2115 call2 (Fcar (list
), start
, end
);
2121 /* Check for read-only intervals between character positions START ... END,
2122 in BUF, and signal an error if we find one.
2124 Then check for any modification hooks in the range.
2125 Create a list of all these hooks in lexicographic order,
2126 eliminating consecutive extra copies of the same hook. Then call
2127 those hooks in order, with START and END - 1 as arguments. */
2130 verify_interval_modification (struct buffer
*buf
,
2131 ptrdiff_t start
, ptrdiff_t end
)
2133 INTERVAL intervals
= buffer_intervals (buf
);
2136 Lisp_Object prev_mod_hooks
;
2137 Lisp_Object mod_hooks
;
2138 struct gcpro gcpro1
;
2141 prev_mod_hooks
= Qnil
;
2144 interval_insert_behind_hooks
= Qnil
;
2145 interval_insert_in_front_hooks
= Qnil
;
2152 ptrdiff_t temp
= start
;
2157 /* For an insert operation, check the two chars around the position. */
2160 INTERVAL prev
= NULL
;
2161 Lisp_Object before
, after
;
2163 /* Set I to the interval containing the char after START,
2164 and PREV to the interval containing the char before START.
2165 Either one may be null. They may be equal. */
2166 i
= find_interval (intervals
, start
);
2168 if (start
== BUF_BEGV (buf
))
2170 else if (i
->position
== start
)
2171 prev
= previous_interval (i
);
2172 else if (i
->position
< start
)
2174 if (start
== BUF_ZV (buf
))
2177 /* If Vinhibit_read_only is set and is not a list, we can
2178 skip the read_only checks. */
2179 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2181 /* If I and PREV differ we need to check for the read-only
2182 property together with its stickiness. If either I or
2183 PREV are 0, this check is all we need.
2184 We have to take special care, since read-only may be
2185 indirectly defined via the category property. */
2190 after
= textget (i
->plist
, Qread_only
);
2192 /* If interval I is read-only and read-only is
2193 front-sticky, inhibit insertion.
2194 Check for read-only as well as category. */
2196 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2200 tem
= textget (i
->plist
, Qfront_sticky
);
2201 if (TMEM (Qread_only
, tem
)
2202 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2203 && TMEM (Qcategory
, tem
)))
2204 text_read_only (after
);
2210 before
= textget (prev
->plist
, Qread_only
);
2212 /* If interval PREV is read-only and read-only isn't
2213 rear-nonsticky, inhibit insertion.
2214 Check for read-only as well as category. */
2216 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2220 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2221 if (! TMEM (Qread_only
, tem
)
2222 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2223 || ! TMEM (Qcategory
, tem
)))
2224 text_read_only (before
);
2230 after
= textget (i
->plist
, Qread_only
);
2232 /* If interval I is read-only and read-only is
2233 front-sticky, inhibit insertion.
2234 Check for read-only as well as category. */
2235 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2239 tem
= textget (i
->plist
, Qfront_sticky
);
2240 if (TMEM (Qread_only
, tem
)
2241 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2242 && TMEM (Qcategory
, tem
)))
2243 text_read_only (after
);
2245 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2246 if (! TMEM (Qread_only
, tem
)
2247 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2248 || ! TMEM (Qcategory
, tem
)))
2249 text_read_only (after
);
2254 /* Run both insert hooks (just once if they're the same). */
2256 interval_insert_behind_hooks
2257 = textget (prev
->plist
, Qinsert_behind_hooks
);
2259 interval_insert_in_front_hooks
2260 = textget (i
->plist
, Qinsert_in_front_hooks
);
2264 /* Loop over intervals on or next to START...END,
2265 collecting their hooks. */
2267 i
= find_interval (intervals
, start
);
2270 if (! INTERVAL_WRITABLE_P (i
))
2271 text_read_only (textget (i
->plist
, Qread_only
));
2273 if (!inhibit_modification_hooks
)
2275 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2276 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2278 hooks
= Fcons (mod_hooks
, hooks
);
2279 prev_mod_hooks
= mod_hooks
;
2283 if (i
->position
+ LENGTH (i
) < end
2284 && (!NILP (BVAR (current_buffer
, read_only
))
2285 && NILP (Vinhibit_read_only
)))
2286 xsignal1 (Qbuffer_read_only
, Fcurrent_buffer ());
2288 i
= next_interval (i
);
2290 /* Keep going thru the interval containing the char before END. */
2291 while (i
&& i
->position
< end
);
2293 if (!inhibit_modification_hooks
)
2296 hooks
= Fnreverse (hooks
);
2297 while (! EQ (hooks
, Qnil
))
2299 call_mod_hooks (Fcar (hooks
), make_number (start
),
2301 hooks
= Fcdr (hooks
);
2308 /* Run the interval hooks for an insertion on character range START ... END.
2309 verify_interval_modification chose which hooks to run;
2310 this function is called after the insertion happens
2311 so it can indicate the range of inserted text. */
2314 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2316 if (! NILP (interval_insert_behind_hooks
))
2317 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2318 if (! NILP (interval_insert_in_front_hooks
)
2319 && ! EQ (interval_insert_in_front_hooks
,
2320 interval_insert_behind_hooks
))
2321 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2325 syms_of_textprop (void)
2327 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2328 doc
: /* Property-list used as default values.
2329 The value of a property in this list is seen as the value for every
2330 character that does not have its own value for that property. */);
2331 Vdefault_text_properties
= Qnil
;
2333 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2334 doc
: /* Alist of alternative properties for properties without a value.
2335 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2336 If a piece of text has no direct value for a particular property, then
2337 this alist is consulted. If that property appears in the alist, then
2338 the first non-nil value from the associated alternative properties is
2340 Vchar_property_alias_alist
= Qnil
;
2342 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2343 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2344 This also inhibits the use of the `intangible' text property. */);
2345 Vinhibit_point_motion_hooks
= Qnil
;
2347 DEFVAR_LISP ("text-property-default-nonsticky",
2348 Vtext_property_default_nonsticky
,
2349 doc
: /* Alist of properties vs the corresponding non-stickiness.
2350 Each element has the form (PROPERTY . NONSTICKINESS).
2352 If a character in a buffer has PROPERTY, new text inserted adjacent to
2353 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2354 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2355 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2356 /* Text properties `syntax-table'and `display' should be nonsticky
2358 Vtext_property_default_nonsticky
2359 = list2 (Fcons (intern_c_string ("syntax-table"), Qt
),
2360 Fcons (intern_c_string ("display"), Qt
));
2362 staticpro (&interval_insert_behind_hooks
);
2363 staticpro (&interval_insert_in_front_hooks
);
2364 interval_insert_behind_hooks
= Qnil
;
2365 interval_insert_in_front_hooks
= Qnil
;
2368 /* Common attributes one might give text. */
2370 DEFSYM (Qforeground
, "foreground");
2371 DEFSYM (Qbackground
, "background");
2372 DEFSYM (Qfont
, "font");
2373 DEFSYM (Qface
, "face");
2374 DEFSYM (Qstipple
, "stipple");
2375 DEFSYM (Qunderline
, "underline");
2376 DEFSYM (Qread_only
, "read-only");
2377 DEFSYM (Qinvisible
, "invisible");
2378 DEFSYM (Qintangible
, "intangible");
2379 DEFSYM (Qcategory
, "category");
2380 DEFSYM (Qlocal_map
, "local-map");
2381 DEFSYM (Qfront_sticky
, "front-sticky");
2382 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2383 DEFSYM (Qmouse_face
, "mouse-face");
2384 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2386 /* Properties that text might use to specify certain actions. */
2388 DEFSYM (Qmouse_left
, "mouse-left");
2389 DEFSYM (Qmouse_entered
, "mouse-entered");
2390 DEFSYM (Qpoint_left
, "point-left");
2391 DEFSYM (Qpoint_entered
, "point-entered");
2393 defsubr (&Stext_properties_at
);
2394 defsubr (&Sget_text_property
);
2395 defsubr (&Sget_char_property
);
2396 defsubr (&Sget_char_property_and_overlay
);
2397 defsubr (&Snext_char_property_change
);
2398 defsubr (&Sprevious_char_property_change
);
2399 defsubr (&Snext_single_char_property_change
);
2400 defsubr (&Sprevious_single_char_property_change
);
2401 defsubr (&Snext_property_change
);
2402 defsubr (&Snext_single_property_change
);
2403 defsubr (&Sprevious_property_change
);
2404 defsubr (&Sprevious_single_property_change
);
2405 defsubr (&Sadd_text_properties
);
2406 defsubr (&Sput_text_property
);
2407 defsubr (&Sset_text_properties
);
2408 defsubr (&Sadd_face_text_property
);
2409 defsubr (&Sremove_text_properties
);
2410 defsubr (&Sremove_list_of_text_properties
);
2411 defsubr (&Stext_property_any
);
2412 defsubr (&Stext_property_not_all
);