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 true and set o2 to
56 the o1's cdr. Otherwise, return false. 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 (false), 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. */
131 enum { soft
= false, hard
= true };
134 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
,
135 Lisp_Object
*end
, bool force
)
140 CHECK_STRING_OR_BUFFER (object
);
141 CHECK_NUMBER_COERCE_MARKER (*begin
);
142 CHECK_NUMBER_COERCE_MARKER (*end
);
144 /* If we are asked for a point, but from a subr which operates
145 on a range, then return nothing. */
146 if (EQ (*begin
, *end
) && begin
!= end
)
149 if (XINT (*begin
) > XINT (*end
))
157 if (BUFFERP (object
))
159 register struct buffer
*b
= XBUFFER (object
);
161 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
162 && XINT (*end
) <= BUF_ZV (b
)))
163 args_out_of_range (*begin
, *end
);
164 i
= buffer_intervals (b
);
166 /* If there's no text, there are no properties. */
167 if (BUF_BEGV (b
) == BUF_ZV (b
))
170 searchpos
= XINT (*begin
);
174 ptrdiff_t len
= SCHARS (object
);
176 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
177 && XINT (*end
) <= len
))
178 args_out_of_range (*begin
, *end
);
179 XSETFASTINT (*begin
, XFASTINT (*begin
));
181 XSETFASTINT (*end
, XFASTINT (*end
));
182 i
= string_intervals (object
);
187 searchpos
= XINT (*begin
);
191 return (force
? create_root_interval (object
) : i
);
193 return find_interval (i
, searchpos
);
196 /* Validate LIST as a property list. If LIST is not a list, then
197 make one consisting of (LIST nil). Otherwise, verify that LIST
198 is even numbered and thus suitable as a plist. */
201 validate_plist (Lisp_Object list
)
208 Lisp_Object tail
= list
;
213 error ("Odd length text property list");
217 while (CONSP (tail
));
222 return list2 (list
, Qnil
);
225 /* Return true if interval I has all the properties,
226 with the same values, of list PLIST. */
229 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
231 Lisp_Object tail1
, tail2
;
233 /* Go through each element of PLIST. */
234 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
236 Lisp_Object sym1
= XCAR (tail1
);
239 /* Go through I's plist, looking for sym1 */
240 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
241 if (EQ (sym1
, XCAR (tail2
)))
243 /* Found the same property on both lists. If the
244 values are unequal, return false. */
245 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
248 /* Property has same value on both lists; go to next one. */
260 /* Return true if the plist of interval I has any of the
261 properties of PLIST, regardless of their values. */
264 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
266 Lisp_Object tail1
, tail2
, sym
;
268 /* Go through each element of PLIST. */
269 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
273 /* Go through i's plist, looking for tail1 */
274 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
275 if (EQ (sym
, XCAR (tail2
)))
282 /* Return true if the plist of interval I has any of the
283 property names in LIST, regardless of their values. */
286 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
288 Lisp_Object tail1
, tail2
, sym
;
290 /* Go through each element of LIST. */
291 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
295 /* Go through i's plist, looking for tail1 */
296 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
297 if (EQ (sym
, XCAR (tail2
)))
304 /* Changing the plists of individual intervals. */
306 /* Return the value of PROP in property-list PLIST, or Qunbound if it
309 property_value (Lisp_Object plist
, Lisp_Object prop
)
313 while (PLIST_ELT_P (plist
, value
))
314 if (EQ (XCAR (plist
), prop
))
317 plist
= XCDR (value
);
322 /* Set the properties of INTERVAL to PROPERTIES,
323 and record undo info for the previous values.
324 OBJECT is the string or buffer that INTERVAL belongs to. */
327 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
329 Lisp_Object sym
, value
;
331 if (BUFFERP (object
))
333 /* For each property in the old plist which is missing from PROPERTIES,
334 or has a different value in PROPERTIES, make an undo record. */
335 for (sym
= interval
->plist
;
336 PLIST_ELT_P (sym
, value
);
338 if (! EQ (property_value (properties
, XCAR (sym
)),
341 record_property_change (interval
->position
, LENGTH (interval
),
342 XCAR (sym
), XCAR (value
),
346 /* For each new property that has no value at all in the old plist,
347 make an undo record binding it to nil, so it will be removed. */
348 for (sym
= properties
;
349 PLIST_ELT_P (sym
, value
);
351 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
353 record_property_change (interval
->position
, LENGTH (interval
),
359 /* Store new properties. */
360 set_interval_plist (interval
, Fcopy_sequence (properties
));
363 /* Add the properties of PLIST to the interval I, or set
364 the value of I's property to the value of the property on PLIST
365 if they are different.
367 OBJECT should be the string or buffer the interval is in.
369 Return true if this changes I (i.e., if any members of PLIST
370 are actually added to I's plist) */
373 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
,
374 enum property_set_type set_type
)
376 Lisp_Object tail1
, tail2
, sym1
, val1
;
377 bool changed
= false;
378 struct gcpro gcpro1
, gcpro2
, gcpro3
;
383 /* No need to protect OBJECT, because we can GC only in the case
384 where it is a buffer, and live buffers are always protected.
385 I and its plist are also protected, via OBJECT. */
386 GCPRO3 (tail1
, sym1
, val1
);
388 /* Go through each element of PLIST. */
389 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
393 val1
= Fcar (XCDR (tail1
));
395 /* Go through I's plist, looking for sym1 */
396 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
397 if (EQ (sym1
, XCAR (tail2
)))
399 /* No need to gcpro, because tail2 protects this
400 and it must be a cons cell (we get an error otherwise). */
401 register Lisp_Object this_cdr
;
403 this_cdr
= XCDR (tail2
);
404 /* Found the property. Now check its value. */
407 /* The properties have the same value on both lists.
408 Continue to the next property. */
409 if (EQ (val1
, Fcar (this_cdr
)))
412 /* Record this change in the buffer, for undo purposes. */
413 if (BUFFERP (object
))
415 record_property_change (i
->position
, LENGTH (i
),
416 sym1
, Fcar (this_cdr
), object
);
419 /* I's property has a different value -- change it */
420 if (set_type
== TEXT_PROPERTY_REPLACE
)
421 Fsetcar (this_cdr
, val1
);
423 if (CONSP (Fcar (this_cdr
)) &&
424 /* Special-case anonymous face properties. */
425 (! EQ (sym1
, Qface
) ||
426 NILP (Fkeywordp (Fcar (Fcar (this_cdr
))))))
427 /* The previous value is a list, so prepend (or
428 append) the new value to this list. */
429 if (set_type
== TEXT_PROPERTY_PREPEND
)
430 Fsetcar (this_cdr
, Fcons (val1
, Fcar (this_cdr
)));
432 nconc2 (Fcar (this_cdr
), list1 (val1
));
434 /* The previous value is a single value, so make it
436 if (set_type
== TEXT_PROPERTY_PREPEND
)
437 Fsetcar (this_cdr
, list2 (val1
, Fcar (this_cdr
)));
439 Fsetcar (this_cdr
, list2 (Fcar (this_cdr
), val1
));
448 /* Record this change in the buffer, for undo purposes. */
449 if (BUFFERP (object
))
451 record_property_change (i
->position
, LENGTH (i
),
454 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
464 /* For any members of PLIST, or LIST,
465 which are properties of I, remove them from I's plist.
466 (If PLIST is non-nil, use that, otherwise use LIST.)
467 OBJECT is the string or buffer containing I. */
470 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
472 bool changed
= false;
474 /* True means tail1 is a plist, otherwise it is a list. */
475 bool use_plist
= ! NILP (plist
);
476 Lisp_Object tail1
= use_plist
? plist
: list
;
478 Lisp_Object current_plist
= i
->plist
;
480 /* Go through each element of LIST or PLIST. */
481 while (CONSP (tail1
))
483 Lisp_Object sym
= XCAR (tail1
);
485 /* First, remove the symbol if it's at the head of the list */
486 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
488 if (BUFFERP (object
))
489 record_property_change (i
->position
, LENGTH (i
),
490 sym
, XCAR (XCDR (current_plist
)),
493 current_plist
= XCDR (XCDR (current_plist
));
497 /* Go through I's plist, looking for SYM. */
498 Lisp_Object tail2
= current_plist
;
499 while (! NILP (tail2
))
501 Lisp_Object
this = XCDR (XCDR (tail2
));
502 if (CONSP (this) && EQ (sym
, XCAR (this)))
504 if (BUFFERP (object
))
505 record_property_change (i
->position
, LENGTH (i
),
506 sym
, XCAR (XCDR (this)), object
);
508 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
514 /* Advance thru TAIL1 one way or the other. */
515 tail1
= XCDR (tail1
);
516 if (use_plist
&& CONSP (tail1
))
517 tail1
= XCDR (tail1
);
521 set_interval_plist (i
, current_plist
);
525 /* Returns the interval of POSITION in OBJECT.
526 POSITION is BEG-based. */
529 interval_of (ptrdiff_t position
, Lisp_Object object
)
535 XSETBUFFER (object
, current_buffer
);
536 else if (EQ (object
, Qt
))
539 CHECK_STRING_OR_BUFFER (object
);
541 if (BUFFERP (object
))
543 register struct buffer
*b
= XBUFFER (object
);
547 i
= buffer_intervals (b
);
552 end
= SCHARS (object
);
553 i
= string_intervals (object
);
556 if (!(beg
<= position
&& position
<= end
))
557 args_out_of_range (make_number (position
), make_number (position
));
558 if (beg
== end
|| !i
)
561 return find_interval (i
, position
);
564 DEFUN ("text-properties-at", Ftext_properties_at
,
565 Stext_properties_at
, 1, 2, 0,
566 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
567 If the optional second argument OBJECT is a buffer (or nil, which means
568 the current buffer), POSITION is a buffer position (integer or marker).
569 If OBJECT is a string, POSITION is a 0-based index into it.
570 If POSITION is at the end of OBJECT, the value is nil. */)
571 (Lisp_Object position
, Lisp_Object object
)
576 XSETBUFFER (object
, current_buffer
);
578 i
= validate_interval_range (object
, &position
, &position
, soft
);
581 /* If POSITION is at the end of the interval,
582 it means it's the end of OBJECT.
583 There are no properties at the very end,
584 since no character follows. */
585 if (XINT (position
) == LENGTH (i
) + i
->position
)
591 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
592 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
593 OBJECT should be a buffer or a string; if omitted or nil, it defaults
594 to the current buffer.
595 If POSITION is at the end of OBJECT, the value is nil. */)
596 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
598 return textget (Ftext_properties_at (position
, object
), prop
);
601 /* Return the value of char's property PROP, in OBJECT at POSITION.
602 OBJECT is optional and defaults to the current buffer.
603 If OVERLAY is non-0, then in the case that the returned property is from
604 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
605 returned in *OVERLAY.
606 If POSITION is at the end of OBJECT, the value is nil.
607 If OBJECT is a buffer, then overlay properties are considered as well as
609 If OBJECT is a window, then that window's buffer is used, but
610 window-specific overlays are considered only if they are associated
613 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
615 struct window
*w
= 0;
617 CHECK_NUMBER_COERCE_MARKER (position
);
620 XSETBUFFER (object
, current_buffer
);
622 if (WINDOWP (object
))
624 CHECK_LIVE_WINDOW (object
);
625 w
= XWINDOW (object
);
626 object
= w
->contents
;
628 if (BUFFERP (object
))
631 Lisp_Object
*overlay_vec
;
632 struct buffer
*obuf
= current_buffer
;
634 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
635 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
636 xsignal1 (Qargs_out_of_range
, position
);
638 set_buffer_temp (XBUFFER (object
));
641 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, false);
642 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
644 set_buffer_temp (obuf
);
646 /* Now check the overlays in order of decreasing priority. */
647 while (--noverlays
>= 0)
649 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
653 /* Return the overlay we got the property from. */
654 *overlay
= overlay_vec
[noverlays
];
663 /* Indicate that the return value is not from an overlay. */
666 /* Not a buffer, or no appropriate overlay, so fall through to the
668 return Fget_text_property (position
, prop
, object
);
671 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
672 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
673 Both overlay properties and text properties are checked.
674 OBJECT is optional and defaults to the current buffer.
675 If POSITION is at the end of OBJECT, the value is nil.
676 If OBJECT is a buffer, then overlay properties are considered as well as
678 If OBJECT is a window, then that window's buffer is used, but window-specific
679 overlays are considered only if they are associated with OBJECT. */)
680 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
682 return get_char_property_and_overlay (position
, prop
, object
, 0);
685 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
686 Sget_char_property_and_overlay
, 2, 3, 0,
687 doc
: /* Like `get-char-property', but with extra overlay information.
688 The value is a cons cell. Its car is the return value of `get-char-property'
689 with the same arguments--that is, the value of POSITION's property
690 PROP in OBJECT. Its cdr is the overlay in which the property was
691 found, or nil, if it was found as a text property or not found at all.
693 OBJECT is optional and defaults to the current buffer. OBJECT may be
694 a string, a buffer or a window. For strings, the cdr of the return
695 value is always nil, since strings do not have overlays. If OBJECT is
696 a window, then that window's buffer is used, but window-specific
697 overlays are considered only if they are associated with OBJECT. If
698 POSITION is at the end of OBJECT, both car and cdr are nil. */)
699 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
703 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
704 return Fcons (val
, overlay
);
708 DEFUN ("next-char-property-change", Fnext_char_property_change
,
709 Snext_char_property_change
, 1, 2, 0,
710 doc
: /* Return the position of next text property or overlay change.
711 This scans characters forward in the current buffer from POSITION till
712 it finds a change in some text property, or the beginning or end of an
713 overlay, and returns the position of that.
714 If none is found up to (point-max), the function returns (point-max).
716 If the optional second argument LIMIT is non-nil, don't search
717 past position LIMIT; return LIMIT if nothing is found before LIMIT.
718 LIMIT is a no-op if it is greater than (point-max). */)
719 (Lisp_Object position
, Lisp_Object limit
)
723 temp
= Fnext_overlay_change (position
);
726 CHECK_NUMBER_COERCE_MARKER (limit
);
727 if (XINT (limit
) < XINT (temp
))
730 return Fnext_property_change (position
, Qnil
, temp
);
733 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
734 Sprevious_char_property_change
, 1, 2, 0,
735 doc
: /* Return the position of previous text property or overlay change.
736 Scans characters backward in the current buffer from POSITION till it
737 finds a change in some text property, or the beginning or end of an
738 overlay, and returns the position of that.
739 If none is found since (point-min), the function returns (point-min).
741 If the optional second argument LIMIT is non-nil, don't search
742 past position LIMIT; return LIMIT if nothing is found before LIMIT.
743 LIMIT is a no-op if it is less than (point-min). */)
744 (Lisp_Object position
, Lisp_Object limit
)
748 temp
= Fprevious_overlay_change (position
);
751 CHECK_NUMBER_COERCE_MARKER (limit
);
752 if (XINT (limit
) > XINT (temp
))
755 return Fprevious_property_change (position
, Qnil
, temp
);
759 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
760 Snext_single_char_property_change
, 2, 4, 0,
761 doc
: /* Return the position of next text property or overlay change for a specific property.
762 Scans characters forward from POSITION till it finds
763 a change in the PROP property, then returns the position of the change.
764 If the optional third argument OBJECT is a buffer (or nil, which means
765 the current buffer), POSITION is a buffer position (integer or marker).
766 If OBJECT is a string, POSITION is a 0-based index into it.
768 In a string, scan runs to the end of the string.
769 In a buffer, it runs to (point-max), and the value cannot exceed that.
771 The property values are compared with `eq'.
772 If the property is constant all the way to the end of OBJECT, return the
773 last valid position in OBJECT.
774 If the optional fourth argument LIMIT is non-nil, don't search
775 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
776 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
778 if (STRINGP (object
))
780 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
784 position
= make_number (SCHARS (object
));
787 CHECK_NUMBER (limit
);
794 Lisp_Object initial_value
, value
;
795 ptrdiff_t count
= SPECPDL_INDEX ();
798 CHECK_BUFFER (object
);
800 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
802 record_unwind_current_buffer ();
803 Fset_buffer (object
);
806 CHECK_NUMBER_COERCE_MARKER (position
);
808 initial_value
= Fget_char_property (position
, prop
, object
);
811 XSETFASTINT (limit
, ZV
);
813 CHECK_NUMBER_COERCE_MARKER (limit
);
815 if (XFASTINT (position
) >= XFASTINT (limit
))
818 if (XFASTINT (position
) > ZV
)
819 XSETFASTINT (position
, ZV
);
824 position
= Fnext_char_property_change (position
, limit
);
825 if (XFASTINT (position
) >= XFASTINT (limit
))
831 value
= Fget_char_property (position
, prop
, object
);
832 if (!EQ (value
, initial_value
))
836 unbind_to (count
, Qnil
);
842 DEFUN ("previous-single-char-property-change",
843 Fprevious_single_char_property_change
,
844 Sprevious_single_char_property_change
, 2, 4, 0,
845 doc
: /* Return the position of previous text property or overlay change for a specific property.
846 Scans characters backward from POSITION till it finds
847 a change in the PROP property, then returns the position of the change.
848 If the optional third argument OBJECT is a buffer (or nil, which means
849 the current buffer), POSITION is a buffer position (integer or marker).
850 If OBJECT is a string, POSITION is a 0-based index into it.
852 In a string, scan runs to the start of the string.
853 In a buffer, it runs to (point-min), and the value cannot be less than that.
855 The property values are compared with `eq'.
856 If the property is constant all the way to the start of OBJECT, return the
857 first valid position in OBJECT.
858 If the optional fourth argument LIMIT is non-nil, don't search back past
859 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
860 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
862 if (STRINGP (object
))
864 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
868 position
= make_number (0);
871 CHECK_NUMBER (limit
);
878 ptrdiff_t count
= SPECPDL_INDEX ();
881 CHECK_BUFFER (object
);
883 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
885 record_unwind_current_buffer ();
886 Fset_buffer (object
);
889 CHECK_NUMBER_COERCE_MARKER (position
);
892 XSETFASTINT (limit
, BEGV
);
894 CHECK_NUMBER_COERCE_MARKER (limit
);
896 if (XFASTINT (position
) <= XFASTINT (limit
))
899 if (XFASTINT (position
) < BEGV
)
900 XSETFASTINT (position
, BEGV
);
904 Lisp_Object initial_value
905 = Fget_char_property (make_number (XFASTINT (position
) - 1),
910 position
= Fprevious_char_property_change (position
, limit
);
912 if (XFASTINT (position
) <= XFASTINT (limit
))
920 = Fget_char_property (make_number (XFASTINT (position
) - 1),
923 if (!EQ (value
, initial_value
))
929 unbind_to (count
, Qnil
);
935 DEFUN ("next-property-change", Fnext_property_change
,
936 Snext_property_change
, 1, 3, 0,
937 doc
: /* Return the position of next property change.
938 Scans characters forward from POSITION in OBJECT till it finds
939 a change in some text property, then returns the position of the change.
940 If the optional second argument OBJECT is a buffer (or nil, which means
941 the current buffer), POSITION is a buffer position (integer or marker).
942 If OBJECT is a string, POSITION is a 0-based index into it.
943 Return nil if the property is constant all the way to the end of OBJECT.
944 If the value is non-nil, it is a position greater than POSITION, never equal.
946 If the optional third argument LIMIT is non-nil, don't search
947 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
948 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
950 register INTERVAL i
, next
;
953 XSETBUFFER (object
, current_buffer
);
955 if (!NILP (limit
) && !EQ (limit
, Qt
))
956 CHECK_NUMBER_COERCE_MARKER (limit
);
958 i
= validate_interval_range (object
, &position
, &position
, soft
);
960 /* If LIMIT is t, return start of next interval--don't
961 bother checking further intervals. */
967 next
= next_interval (i
);
970 XSETFASTINT (position
, (STRINGP (object
)
972 : BUF_ZV (XBUFFER (object
))));
974 XSETFASTINT (position
, next
->position
);
981 next
= next_interval (i
);
983 while (next
&& intervals_equal (i
, next
)
984 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
985 next
= next_interval (next
);
993 : BUF_ZV (XBUFFER (object
))))))
996 return make_number (next
->position
);
999 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1000 Snext_single_property_change
, 2, 4, 0,
1001 doc
: /* Return the position of next property change for a specific property.
1002 Scans characters forward from POSITION till it finds
1003 a change in the PROP property, then returns the position of the change.
1004 If the optional third argument OBJECT is a buffer (or nil, which means
1005 the current buffer), POSITION is a buffer position (integer or marker).
1006 If OBJECT is a string, POSITION is a 0-based index into it.
1007 The property values are compared with `eq'.
1008 Return nil if the property is constant all the way to the end of OBJECT.
1009 If the value is non-nil, it is a position greater than POSITION, never equal.
1011 If the optional fourth argument LIMIT is non-nil, don't search
1012 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1013 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1015 register INTERVAL i
, next
;
1016 register Lisp_Object here_val
;
1019 XSETBUFFER (object
, current_buffer
);
1022 CHECK_NUMBER_COERCE_MARKER (limit
);
1024 i
= validate_interval_range (object
, &position
, &position
, soft
);
1028 here_val
= textget (i
->plist
, prop
);
1029 next
= next_interval (i
);
1031 && EQ (here_val
, textget (next
->plist
, prop
))
1032 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1033 next
= next_interval (next
);
1037 >= (INTEGERP (limit
)
1041 : BUF_ZV (XBUFFER (object
))))))
1044 return make_number (next
->position
);
1047 DEFUN ("previous-property-change", Fprevious_property_change
,
1048 Sprevious_property_change
, 1, 3, 0,
1049 doc
: /* Return the position of previous property change.
1050 Scans characters backwards from POSITION in OBJECT till it finds
1051 a change in some text property, then returns the position of the change.
1052 If the optional second argument OBJECT is a buffer (or nil, which means
1053 the current buffer), POSITION is a buffer position (integer or marker).
1054 If OBJECT is a string, POSITION is a 0-based index into it.
1055 Return nil if the property is constant all the way to the start of OBJECT.
1056 If the value is non-nil, it is a position less than POSITION, never equal.
1058 If the optional third argument LIMIT is non-nil, don't search
1059 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1060 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1062 register INTERVAL i
, previous
;
1065 XSETBUFFER (object
, current_buffer
);
1068 CHECK_NUMBER_COERCE_MARKER (limit
);
1070 i
= validate_interval_range (object
, &position
, &position
, soft
);
1074 /* Start with the interval containing the char before point. */
1075 if (i
->position
== XFASTINT (position
))
1076 i
= previous_interval (i
);
1078 previous
= previous_interval (i
);
1079 while (previous
&& intervals_equal (previous
, i
)
1081 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1082 previous
= previous_interval (previous
);
1085 || (previous
->position
+ LENGTH (previous
)
1086 <= (INTEGERP (limit
)
1088 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1091 return make_number (previous
->position
+ LENGTH (previous
));
1094 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1095 Sprevious_single_property_change
, 2, 4, 0,
1096 doc
: /* Return the position of previous property change for a specific property.
1097 Scans characters backward from POSITION till it finds
1098 a change in the PROP property, then returns the position of the change.
1099 If the optional third argument OBJECT is a buffer (or nil, which means
1100 the current buffer), POSITION is a buffer position (integer or marker).
1101 If OBJECT is a string, POSITION is a 0-based index into it.
1102 The property values are compared with `eq'.
1103 Return nil if the property is constant all the way to the start of OBJECT.
1104 If the value is non-nil, it is a position less than POSITION, never equal.
1106 If the optional fourth argument LIMIT is non-nil, don't search
1107 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1108 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1110 register INTERVAL i
, previous
;
1111 register Lisp_Object here_val
;
1114 XSETBUFFER (object
, current_buffer
);
1117 CHECK_NUMBER_COERCE_MARKER (limit
);
1119 i
= validate_interval_range (object
, &position
, &position
, soft
);
1121 /* Start with the interval containing the char before point. */
1122 if (i
&& i
->position
== XFASTINT (position
))
1123 i
= previous_interval (i
);
1128 here_val
= textget (i
->plist
, prop
);
1129 previous
= previous_interval (i
);
1131 && EQ (here_val
, textget (previous
->plist
, prop
))
1133 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1134 previous
= previous_interval (previous
);
1137 || (previous
->position
+ LENGTH (previous
)
1138 <= (INTEGERP (limit
)
1140 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1143 return make_number (previous
->position
+ LENGTH (previous
));
1146 /* Used by add-text-properties and add-face-text-property. */
1149 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1150 Lisp_Object properties
, Lisp_Object object
,
1151 enum property_set_type set_type
) {
1152 INTERVAL i
, unchanged
;
1154 bool modified
= false;
1155 struct gcpro gcpro1
;
1156 bool first_time
= true;
1158 properties
= validate_plist (properties
);
1159 if (NILP (properties
))
1163 XSETBUFFER (object
, current_buffer
);
1166 i
= validate_interval_range (object
, &start
, &end
, hard
);
1171 len
= XINT (end
) - s
;
1173 /* No need to protect OBJECT, because we GC only if it's a buffer,
1174 and live buffers are always protected. */
1175 GCPRO1 (properties
);
1177 /* If this interval already has the properties, we can skip it. */
1178 if (interval_has_all_properties (properties
, i
))
1180 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1185 RETURN_UNGCPRO (Qnil
);
1187 i
= next_interval (i
);
1190 while (interval_has_all_properties (properties
, i
));
1192 else if (i
->position
!= s
)
1194 /* If we're not starting on an interval boundary, we have to
1195 split this interval. */
1197 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1198 copy_properties (unchanged
, i
);
1201 if (BUFFERP (object
) && first_time
)
1203 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1204 ptrdiff_t prev_pos
= i
->position
;
1206 modify_text_properties (object
, start
, end
);
1207 /* If someone called us recursively as a side effect of
1208 modify_text_properties, and changed the intervals behind our back
1209 (could happen if lock_file, called by prepare_to_modify_buffer,
1210 triggers redisplay, and that calls add-text-properties again
1211 in the same buffer), we cannot continue with I, because its
1212 data changed. So we restart the interval analysis anew. */
1213 if (TOTAL_LENGTH (i
) != prev_total_length
1214 || i
->position
!= prev_pos
)
1221 /* We are at the beginning of interval I, with LEN chars to scan. */
1226 if (LENGTH (i
) >= len
)
1228 /* We can UNGCPRO safely here, because there will be just
1229 one more chance to gc, in the next call to add_properties,
1230 and after that we will not need PROPERTIES or OBJECT again. */
1233 if (interval_has_all_properties (properties
, i
))
1235 if (BUFFERP (object
))
1236 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1237 XINT (end
) - XINT (start
));
1243 if (LENGTH (i
) == len
)
1245 add_properties (properties
, i
, object
, set_type
);
1246 if (BUFFERP (object
))
1247 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1248 XINT (end
) - XINT (start
));
1252 /* i doesn't have the properties, and goes past the change limit */
1254 i
= split_interval_left (unchanged
, len
);
1255 copy_properties (unchanged
, i
);
1256 add_properties (properties
, i
, object
, set_type
);
1257 if (BUFFERP (object
))
1258 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1259 XINT (end
) - XINT (start
));
1264 modified
|= add_properties (properties
, i
, object
, set_type
);
1265 i
= next_interval (i
);
1269 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1271 DEFUN ("add-text-properties", Fadd_text_properties
,
1272 Sadd_text_properties
, 3, 4, 0,
1273 doc
: /* Add properties to the text from START to END.
1274 The third argument PROPERTIES is a property list
1275 specifying the property values to add. If the optional fourth argument
1276 OBJECT is a buffer (or nil, which means the current buffer),
1277 START and END are buffer positions (integers or markers).
1278 If OBJECT is a string, START and END are 0-based indices into it.
1279 Return t if any property value actually changed, nil otherwise. */)
1280 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1283 return add_text_properties_1 (start
, end
, properties
, object
,
1284 TEXT_PROPERTY_REPLACE
);
1287 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1289 DEFUN ("put-text-property", Fput_text_property
,
1290 Sput_text_property
, 4, 5, 0,
1291 doc
: /* Set one property of the text from START to END.
1292 The third and fourth arguments PROPERTY and VALUE
1293 specify the property to add.
1294 If the optional fifth argument OBJECT is a buffer (or nil, which means
1295 the current buffer), START and END are buffer positions (integers or
1296 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1297 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
,
1298 Lisp_Object value
, Lisp_Object object
)
1300 AUTO_LIST2 (properties
, property
, value
);
1301 Fadd_text_properties (start
, end
, properties
, object
);
1305 DEFUN ("set-text-properties", Fset_text_properties
,
1306 Sset_text_properties
, 3, 4, 0,
1307 doc
: /* Completely replace properties of text from START to END.
1308 The third argument PROPERTIES is the new property list.
1309 If the optional fourth argument OBJECT is a buffer (or nil, which means
1310 the current buffer), START and END are buffer positions (integers or
1311 markers). If OBJECT is a string, START and END are 0-based indices into it.
1312 If PROPERTIES is nil, the effect is to remove all properties from
1313 the designated part of OBJECT. */)
1314 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1316 return set_text_properties (start
, end
, properties
, object
, Qt
);
1320 DEFUN ("add-face-text-property", Fadd_face_text_property
,
1321 Sadd_face_text_property
, 3, 5, 0,
1322 doc
: /* Add the face property to the text from START to END.
1323 FACE specifies the face to add. It should be a valid value of the
1324 `face' property (typically a face name or a plist of face attributes
1327 If any text in the region already has a non-nil `face' property, those
1328 face(s) are retained. This is done by setting the `face' property to
1329 a list of faces, with FACE as the first element (by default) and the
1330 pre-existing faces as the remaining elements.
1332 If optional fourth argument APPEND is non-nil, append FACE to the end
1333 of the face list instead.
1335 If optional fifth argument OBJECT is a buffer (or nil, which means the
1336 current buffer), START and END are buffer positions (integers or
1337 markers). If OBJECT is a string, START and END are 0-based indices
1339 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1340 Lisp_Object append
, Lisp_Object object
)
1342 AUTO_LIST2 (properties
, Qface
, face
);
1343 add_text_properties_1 (start
, end
, properties
, object
,
1345 ? TEXT_PROPERTY_PREPEND
1346 : TEXT_PROPERTY_APPEND
));
1350 /* Replace properties of text from START to END with new list of
1351 properties PROPERTIES. OBJECT is the buffer or string containing
1352 the text. OBJECT nil means use the current buffer.
1353 COHERENT_CHANGE_P nil means this is being called as an internal
1354 subroutine, rather than as a change primitive with checking of
1355 read-only, invoking change hooks, etc.. Value is nil if the
1356 function _detected_ that it did not replace any properties, non-nil
1360 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1361 Lisp_Object object
, Lisp_Object coherent_change_p
)
1363 register INTERVAL i
;
1364 Lisp_Object ostart
, oend
;
1369 properties
= validate_plist (properties
);
1372 XSETBUFFER (object
, current_buffer
);
1374 /* If we want no properties for a whole string,
1375 get rid of its intervals. */
1376 if (NILP (properties
) && STRINGP (object
)
1377 && XFASTINT (start
) == 0
1378 && XFASTINT (end
) == SCHARS (object
))
1380 if (!string_intervals (object
))
1383 set_string_intervals (object
, NULL
);
1387 i
= validate_interval_range (object
, &start
, &end
, soft
);
1391 /* If buffer has no properties, and we want none, return now. */
1392 if (NILP (properties
))
1395 /* Restore the original START and END values
1396 because validate_interval_range increments them for strings. */
1400 i
= validate_interval_range (object
, &start
, &end
, hard
);
1401 /* This can return if start == end. */
1406 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1407 modify_text_properties (object
, start
, end
);
1409 set_text_properties_1 (start
, end
, properties
, object
, i
);
1411 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1412 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1413 XINT (end
) - XINT (start
));
1417 /* Replace properties of text from START to END with new list of
1418 properties PROPERTIES. OBJECT is the buffer or string containing
1419 the text. This does not obey any hooks.
1420 You should provide the interval that START is located in as I.
1421 START and END can be in any order. */
1424 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1426 register INTERVAL prev_changed
= NULL
;
1427 register ptrdiff_t s
, len
;
1430 if (XINT (start
) < XINT (end
))
1433 len
= XINT (end
) - s
;
1435 else if (XINT (end
) < XINT (start
))
1438 len
= XINT (start
) - s
;
1445 if (i
->position
!= s
)
1448 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1450 if (LENGTH (i
) > len
)
1452 copy_properties (unchanged
, i
);
1453 i
= split_interval_left (i
, len
);
1454 set_properties (properties
, i
, object
);
1458 set_properties (properties
, i
, object
);
1460 if (LENGTH (i
) == len
)
1465 i
= next_interval (i
);
1468 /* We are starting at the beginning of an interval I. LEN is positive. */
1473 if (LENGTH (i
) >= len
)
1475 if (LENGTH (i
) > len
)
1476 i
= split_interval_left (i
, len
);
1478 /* We have to call set_properties even if we are going to
1479 merge the intervals, so as to make the undo records
1480 and cause redisplay to happen. */
1481 set_properties (properties
, i
, object
);
1483 merge_interval_left (i
);
1489 /* We have to call set_properties even if we are going to
1490 merge the intervals, so as to make the undo records
1491 and cause redisplay to happen. */
1492 set_properties (properties
, i
, object
);
1496 prev_changed
= i
= merge_interval_left (i
);
1498 i
= next_interval (i
);
1503 DEFUN ("remove-text-properties", Fremove_text_properties
,
1504 Sremove_text_properties
, 3, 4, 0,
1505 doc
: /* Remove some properties from text from START to END.
1506 The third argument PROPERTIES is a property list
1507 whose property names specify the properties to remove.
1508 \(The values stored in PROPERTIES are ignored.)
1509 If the optional fourth argument OBJECT is a buffer (or nil, which means
1510 the current buffer), START and END are buffer positions (integers or
1511 markers). If OBJECT is a string, START and END are 0-based indices into it.
1512 Return t if any property was actually removed, nil otherwise.
1514 Use `set-text-properties' if you want to remove all text properties. */)
1515 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1517 INTERVAL i
, unchanged
;
1519 bool modified
= false;
1520 bool first_time
= true;
1523 XSETBUFFER (object
, current_buffer
);
1526 i
= validate_interval_range (object
, &start
, &end
, soft
);
1531 len
= XINT (end
) - s
;
1533 /* If there are no properties on this entire interval, return. */
1534 if (! interval_has_some_properties (properties
, i
))
1536 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1543 i
= next_interval (i
);
1546 while (! interval_has_some_properties (properties
, i
));
1548 /* Split away the beginning of this interval; what we don't
1550 else if (i
->position
!= s
)
1553 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1554 copy_properties (unchanged
, i
);
1557 if (BUFFERP (object
) && first_time
)
1559 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1560 ptrdiff_t prev_pos
= i
->position
;
1562 modify_text_properties (object
, start
, end
);
1563 /* If someone called us recursively as a side effect of
1564 modify_text_properties, and changed the intervals behind our back
1565 (could happen if lock_file, called by prepare_to_modify_buffer,
1566 triggers redisplay, and that calls add-text-properties again
1567 in the same buffer), we cannot continue with I, because its
1568 data changed. So we restart the interval analysis anew. */
1569 if (TOTAL_LENGTH (i
) != prev_total_length
1570 || i
->position
!= prev_pos
)
1577 /* We are at the beginning of an interval, with len to scan */
1582 if (LENGTH (i
) >= len
)
1584 if (! interval_has_some_properties (properties
, i
))
1587 if (BUFFERP (object
))
1588 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1589 XINT (end
) - XINT (start
));
1593 if (LENGTH (i
) == len
)
1595 remove_properties (properties
, Qnil
, i
, object
);
1596 if (BUFFERP (object
))
1597 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1598 XINT (end
) - XINT (start
));
1602 /* i has the properties, and goes past the change limit */
1604 i
= split_interval_left (i
, len
);
1605 copy_properties (unchanged
, i
);
1606 remove_properties (properties
, Qnil
, i
, object
);
1607 if (BUFFERP (object
))
1608 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1609 XINT (end
) - XINT (start
));
1614 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1615 i
= next_interval (i
);
1619 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1620 Sremove_list_of_text_properties
, 3, 4, 0,
1621 doc
: /* Remove some properties from text from START to END.
1622 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1623 If the optional fourth argument OBJECT is a buffer (or nil, which means
1624 the current buffer), START and END are buffer positions (integers or
1625 markers). If OBJECT is a string, START and END are 0-based indices into it.
1626 Return t if any property was actually removed, nil otherwise. */)
1627 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1629 INTERVAL i
, unchanged
;
1631 bool modified
= false;
1632 Lisp_Object properties
;
1633 properties
= list_of_properties
;
1636 XSETBUFFER (object
, current_buffer
);
1638 i
= validate_interval_range (object
, &start
, &end
, soft
);
1643 len
= XINT (end
) - s
;
1645 /* If there are no properties on the interval, return. */
1646 if (! interval_has_some_properties_list (properties
, i
))
1648 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1655 i
= next_interval (i
);
1658 while (! interval_has_some_properties_list (properties
, i
));
1660 /* Split away the beginning of this interval; what we don't
1662 else if (i
->position
!= s
)
1665 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1666 copy_properties (unchanged
, i
);
1669 /* We are at the beginning of an interval, with len to scan.
1670 The flag MODIFIED records if changes have been made.
1671 When object is a buffer, we must call modify_text_properties
1672 before changes are made and signal_after_change when we are done.
1673 Call modify_text_properties before calling remove_properties if !MODIFIED,
1674 and call signal_after_change before returning if MODIFIED. */
1679 if (LENGTH (i
) >= len
)
1681 if (! interval_has_some_properties_list (properties
, i
))
1685 if (BUFFERP (object
))
1686 signal_after_change (XINT (start
),
1687 XINT (end
) - XINT (start
),
1688 XINT (end
) - XINT (start
));
1694 else if (LENGTH (i
) == len
)
1696 if (!modified
&& BUFFERP (object
))
1697 modify_text_properties (object
, start
, end
);
1698 remove_properties (Qnil
, properties
, i
, object
);
1699 if (BUFFERP (object
))
1700 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1701 XINT (end
) - XINT (start
));
1705 { /* i has the properties, and goes past the change limit. */
1707 i
= split_interval_left (i
, len
);
1708 copy_properties (unchanged
, i
);
1709 if (!modified
&& BUFFERP (object
))
1710 modify_text_properties (object
, start
, end
);
1711 remove_properties (Qnil
, properties
, i
, object
);
1712 if (BUFFERP (object
))
1713 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1714 XINT (end
) - XINT (start
));
1718 if (interval_has_some_properties_list (properties
, i
))
1720 if (!modified
&& BUFFERP (object
))
1721 modify_text_properties (object
, start
, end
);
1722 remove_properties (Qnil
, properties
, i
, object
);
1726 i
= next_interval (i
);
1731 if (BUFFERP (object
))
1732 signal_after_change (XINT (start
),
1733 XINT (end
) - XINT (start
),
1734 XINT (end
) - XINT (start
));
1743 DEFUN ("text-property-any", Ftext_property_any
,
1744 Stext_property_any
, 4, 5, 0,
1745 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1746 If so, return the position of the first character whose property PROPERTY
1747 is `eq' to VALUE. Otherwise return nil.
1748 If the optional fifth argument OBJECT is a buffer (or nil, which means
1749 the current buffer), START and END are buffer positions (integers or
1750 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1751 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1753 register INTERVAL i
;
1754 register ptrdiff_t e
, pos
;
1757 XSETBUFFER (object
, current_buffer
);
1758 i
= validate_interval_range (object
, &start
, &end
, soft
);
1760 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1765 if (i
->position
>= e
)
1767 if (EQ (textget (i
->plist
, property
), value
))
1770 if (pos
< XINT (start
))
1772 return make_number (pos
);
1774 i
= next_interval (i
);
1779 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1780 Stext_property_not_all
, 4, 5, 0,
1781 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1782 If so, return the position of the first character whose property PROPERTY
1783 is not `eq' to VALUE. Otherwise, return nil.
1784 If the optional fifth argument OBJECT is a buffer (or nil, which means
1785 the current buffer), START and END are buffer positions (integers or
1786 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1787 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1789 register INTERVAL i
;
1790 register ptrdiff_t s
, e
;
1793 XSETBUFFER (object
, current_buffer
);
1794 i
= validate_interval_range (object
, &start
, &end
, soft
);
1796 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1802 if (i
->position
>= e
)
1804 if (! EQ (textget (i
->plist
, property
), value
))
1806 if (i
->position
> s
)
1808 return make_number (s
);
1810 i
= next_interval (i
);
1816 /* Return the direction from which the text-property PROP would be
1817 inherited by any new text inserted at POS: 1 if it would be
1818 inherited from the char after POS, -1 if it would be inherited from
1819 the char before POS, and 0 if from neither.
1820 BUFFER can be either a buffer or nil (meaning current buffer). */
1823 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1825 bool ignore_previous_character
;
1826 Lisp_Object prev_pos
= make_number (XINT (pos
) - 1);
1827 Lisp_Object front_sticky
;
1828 bool is_rear_sticky
= true, is_front_sticky
= false; /* defaults */
1829 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1832 XSETBUFFER (buffer
, current_buffer
);
1834 ignore_previous_character
= XINT (pos
) <= BUF_BEGV (XBUFFER (buffer
));
1836 if (ignore_previous_character
|| (CONSP (defalt
) && !NILP (XCDR (defalt
))))
1837 is_rear_sticky
= false;
1840 Lisp_Object rear_non_sticky
1841 = Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1843 if (!NILP (CONSP (rear_non_sticky
)
1844 ? Fmemq (prop
, rear_non_sticky
)
1846 /* PROP is rear-non-sticky. */
1847 is_rear_sticky
= false;
1850 /* Consider following character. */
1851 /* This signals an arg-out-of-range error if pos is outside the
1852 buffer's accessible range. */
1853 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1855 if (EQ (front_sticky
, Qt
)
1856 || (CONSP (front_sticky
)
1857 && !NILP (Fmemq (prop
, front_sticky
))))
1858 /* PROP is inherited from after. */
1859 is_front_sticky
= true;
1861 /* Simple cases, where the properties are consistent. */
1862 if (is_rear_sticky
&& !is_front_sticky
)
1864 else if (!is_rear_sticky
&& is_front_sticky
)
1866 else if (!is_rear_sticky
&& !is_front_sticky
)
1869 /* The stickiness properties are inconsistent, so we have to
1870 disambiguate. Basically, rear-sticky wins, _except_ if the
1871 property that would be inherited has a value of nil, in which case
1872 front-sticky wins. */
1873 if (ignore_previous_character
1874 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1881 /* Copying properties between objects. */
1883 /* Add properties from START to END of SRC, starting at POS in DEST.
1884 SRC and DEST may each refer to strings or buffers.
1885 Optional sixth argument PROP causes only that property to be copied.
1886 Properties are copied to DEST as if by `add-text-properties'.
1887 Return t if any property value actually changed, nil otherwise. */
1889 /* Note this can GC when DEST is a buffer. */
1892 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
,
1893 Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1899 ptrdiff_t s
, e
, e2
, p
, len
;
1900 bool modified
= false;
1901 struct gcpro gcpro1
, gcpro2
;
1903 i
= validate_interval_range (src
, &start
, &end
, soft
);
1907 CHECK_NUMBER_COERCE_MARKER (pos
);
1909 Lisp_Object dest_start
, dest_end
;
1911 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1912 if (MOST_POSITIVE_FIXNUM
< e
)
1913 args_out_of_range (pos
, end
);
1915 XSETFASTINT (dest_end
, e
);
1916 /* Apply this to a copy of pos; it will try to increment its arguments,
1917 which we don't want. */
1918 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1929 e2
= i
->position
+ LENGTH (i
);
1936 while (! NILP (plist
))
1938 if (EQ (Fcar (plist
), prop
))
1940 plist
= list2 (prop
, Fcar (Fcdr (plist
)));
1943 plist
= Fcdr (Fcdr (plist
));
1946 /* Must defer modifications to the interval tree in case
1947 src and dest refer to the same string or buffer. */
1948 stuff
= Fcons (list3 (make_number (p
), make_number (p
+ len
), plist
),
1951 i
= next_interval (i
);
1959 GCPRO2 (stuff
, dest
);
1961 while (! NILP (stuff
))
1964 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1965 Fcar (Fcdr (Fcdr (res
))), dest
);
1968 stuff
= Fcdr (stuff
);
1973 return modified
? Qt
: Qnil
;
1977 /* Return a list representing the text properties of OBJECT between
1978 START and END. if PROP is non-nil, report only on that property.
1979 Each result list element has the form (S E PLIST), where S and E
1980 are positions in OBJECT and PLIST is a property list containing the
1981 text properties of OBJECT between S and E. Value is nil if OBJECT
1982 doesn't contain text properties between START and END. */
1985 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1992 i
= validate_interval_range (object
, &start
, &end
, soft
);
1995 ptrdiff_t s
= XINT (start
);
1996 ptrdiff_t e
= XINT (end
);
2000 ptrdiff_t interval_end
, len
;
2003 interval_end
= i
->position
+ LENGTH (i
);
2004 if (interval_end
> e
)
2006 len
= interval_end
- s
;
2011 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2012 if (EQ (XCAR (plist
), prop
))
2014 plist
= list2 (prop
, Fcar (XCDR (plist
)));
2019 result
= Fcons (list3 (make_number (s
), make_number (s
+ len
),
2023 i
= next_interval (i
);
2034 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2035 (START END PLIST), where START and END are positions and PLIST is a
2036 property list containing the text properties to add. Adjust START
2037 and END positions by DELTA before adding properties. */
2040 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2042 struct gcpro gcpro1
, gcpro2
;
2044 GCPRO2 (list
, object
);
2046 for (; CONSP (list
); list
= XCDR (list
))
2048 Lisp_Object item
, start
, end
, plist
;
2051 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2052 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2053 plist
= XCAR (XCDR (XCDR (item
)));
2055 Fadd_text_properties (start
, end
, plist
, object
);
2063 /* Modify end-points of ranges in LIST destructively, and return the
2064 new list. LIST is a list as returned from text_property_list.
2065 Discard properties that begin at or after NEW_END, and limit
2066 end-points to NEW_END. */
2069 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2071 Lisp_Object prev
= Qnil
, head
= list
;
2072 ptrdiff_t max
= XINT (new_end
);
2074 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2076 Lisp_Object item
, beg
, end
;
2080 end
= XCAR (XCDR (item
));
2082 if (XINT (beg
) >= max
)
2084 /* The start-point is past the end of the new string.
2085 Discard this property. */
2086 if (EQ (head
, list
))
2089 XSETCDR (prev
, XCDR (list
));
2091 else if (XINT (end
) > max
)
2092 /* The end-point is past the end of the new string. */
2093 XSETCAR (XCDR (item
), new_end
);
2101 /* Call the modification hook functions in LIST, each with START and END. */
2104 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2106 struct gcpro gcpro1
;
2108 while (!NILP (list
))
2110 call2 (Fcar (list
), start
, end
);
2116 /* Check for read-only intervals between character positions START ... END,
2117 in BUF, and signal an error if we find one.
2119 Then check for any modification hooks in the range.
2120 Create a list of all these hooks in lexicographic order,
2121 eliminating consecutive extra copies of the same hook. Then call
2122 those hooks in order, with START and END - 1 as arguments. */
2125 verify_interval_modification (struct buffer
*buf
,
2126 ptrdiff_t start
, ptrdiff_t end
)
2128 INTERVAL intervals
= buffer_intervals (buf
);
2131 Lisp_Object prev_mod_hooks
;
2132 Lisp_Object mod_hooks
;
2133 struct gcpro gcpro1
;
2136 prev_mod_hooks
= Qnil
;
2139 interval_insert_behind_hooks
= Qnil
;
2140 interval_insert_in_front_hooks
= Qnil
;
2147 ptrdiff_t temp
= start
;
2152 /* For an insert operation, check the two chars around the position. */
2155 INTERVAL prev
= NULL
;
2156 Lisp_Object before
, after
;
2158 /* Set I to the interval containing the char after START,
2159 and PREV to the interval containing the char before START.
2160 Either one may be null. They may be equal. */
2161 i
= find_interval (intervals
, start
);
2163 if (start
== BUF_BEGV (buf
))
2165 else if (i
->position
== start
)
2166 prev
= previous_interval (i
);
2167 else if (i
->position
< start
)
2169 if (start
== BUF_ZV (buf
))
2172 /* If Vinhibit_read_only is set and is not a list, we can
2173 skip the read_only checks. */
2174 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2176 /* If I and PREV differ we need to check for the read-only
2177 property together with its stickiness. If either I or
2178 PREV are 0, this check is all we need.
2179 We have to take special care, since read-only may be
2180 indirectly defined via the category property. */
2185 after
= textget (i
->plist
, Qread_only
);
2187 /* If interval I is read-only and read-only is
2188 front-sticky, inhibit insertion.
2189 Check for read-only as well as category. */
2191 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2195 tem
= textget (i
->plist
, Qfront_sticky
);
2196 if (TMEM (Qread_only
, tem
)
2197 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2198 && TMEM (Qcategory
, tem
)))
2199 text_read_only (after
);
2205 before
= textget (prev
->plist
, Qread_only
);
2207 /* If interval PREV is read-only and read-only isn't
2208 rear-nonsticky, inhibit insertion.
2209 Check for read-only as well as category. */
2211 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2215 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2216 if (! TMEM (Qread_only
, tem
)
2217 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2218 || ! TMEM (Qcategory
, tem
)))
2219 text_read_only (before
);
2225 after
= textget (i
->plist
, Qread_only
);
2227 /* If interval I is read-only and read-only is
2228 front-sticky, inhibit insertion.
2229 Check for read-only as well as category. */
2230 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2234 tem
= textget (i
->plist
, Qfront_sticky
);
2235 if (TMEM (Qread_only
, tem
)
2236 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2237 && TMEM (Qcategory
, tem
)))
2238 text_read_only (after
);
2240 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2241 if (! TMEM (Qread_only
, tem
)
2242 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2243 || ! TMEM (Qcategory
, tem
)))
2244 text_read_only (after
);
2249 /* Run both insert hooks (just once if they're the same). */
2251 interval_insert_behind_hooks
2252 = textget (prev
->plist
, Qinsert_behind_hooks
);
2254 interval_insert_in_front_hooks
2255 = textget (i
->plist
, Qinsert_in_front_hooks
);
2259 /* Loop over intervals on or next to START...END,
2260 collecting their hooks. */
2262 i
= find_interval (intervals
, start
);
2265 if (! INTERVAL_WRITABLE_P (i
))
2266 text_read_only (textget (i
->plist
, Qread_only
));
2268 if (!inhibit_modification_hooks
)
2270 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2271 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2273 hooks
= Fcons (mod_hooks
, hooks
);
2274 prev_mod_hooks
= mod_hooks
;
2278 if (i
->position
+ LENGTH (i
) < end
2279 && (!NILP (BVAR (current_buffer
, read_only
))
2280 && NILP (Vinhibit_read_only
)))
2281 xsignal1 (Qbuffer_read_only
, Fcurrent_buffer ());
2283 i
= next_interval (i
);
2285 /* Keep going thru the interval containing the char before END. */
2286 while (i
&& i
->position
< end
);
2288 if (!inhibit_modification_hooks
)
2291 hooks
= Fnreverse (hooks
);
2292 while (! EQ (hooks
, Qnil
))
2294 call_mod_hooks (Fcar (hooks
), make_number (start
),
2296 hooks
= Fcdr (hooks
);
2303 /* Run the interval hooks for an insertion on character range START ... END.
2304 verify_interval_modification chose which hooks to run;
2305 this function is called after the insertion happens
2306 so it can indicate the range of inserted text. */
2309 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2311 if (! NILP (interval_insert_behind_hooks
))
2312 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2313 if (! NILP (interval_insert_in_front_hooks
)
2314 && ! EQ (interval_insert_in_front_hooks
,
2315 interval_insert_behind_hooks
))
2316 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2320 syms_of_textprop (void)
2322 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2323 doc
: /* Property-list used as default values.
2324 The value of a property in this list is seen as the value for every
2325 character that does not have its own value for that property. */);
2326 Vdefault_text_properties
= Qnil
;
2328 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2329 doc
: /* Alist of alternative properties for properties without a value.
2330 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2331 If a piece of text has no direct value for a particular property, then
2332 this alist is consulted. If that property appears in the alist, then
2333 the first non-nil value from the associated alternative properties is
2335 Vchar_property_alias_alist
= Qnil
;
2337 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2338 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2339 This also inhibits the use of the `intangible' text property. */);
2340 Vinhibit_point_motion_hooks
= Qnil
;
2342 DEFVAR_LISP ("text-property-default-nonsticky",
2343 Vtext_property_default_nonsticky
,
2344 doc
: /* Alist of properties vs the corresponding non-stickiness.
2345 Each element has the form (PROPERTY . NONSTICKINESS).
2347 If a character in a buffer has PROPERTY, new text inserted adjacent to
2348 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2349 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2350 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2351 /* Text properties `syntax-table'and `display' should be nonsticky
2353 Vtext_property_default_nonsticky
2354 = list2 (Fcons (Qsyntax_table
, Qt
), Fcons (Qdisplay
, Qt
));
2356 staticpro (&interval_insert_behind_hooks
);
2357 staticpro (&interval_insert_in_front_hooks
);
2358 interval_insert_behind_hooks
= Qnil
;
2359 interval_insert_in_front_hooks
= Qnil
;
2362 /* Common attributes one might give text. */
2364 DEFSYM (Qforeground
, "foreground");
2365 DEFSYM (Qbackground
, "background");
2366 DEFSYM (Qfont
, "font");
2367 DEFSYM (Qface
, "face");
2368 DEFSYM (Qstipple
, "stipple");
2369 DEFSYM (Qunderline
, "underline");
2370 DEFSYM (Qread_only
, "read-only");
2371 DEFSYM (Qinvisible
, "invisible");
2372 DEFSYM (Qintangible
, "intangible");
2373 DEFSYM (Qcategory
, "category");
2374 DEFSYM (Qlocal_map
, "local-map");
2375 DEFSYM (Qfront_sticky
, "front-sticky");
2376 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2377 DEFSYM (Qmouse_face
, "mouse-face");
2378 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2380 /* Properties that text might use to specify certain actions. */
2382 DEFSYM (Qmouse_left
, "mouse-left");
2383 DEFSYM (Qmouse_entered
, "mouse-entered");
2384 DEFSYM (Qpoint_left
, "point-left");
2385 DEFSYM (Qpoint_entered
, "point-entered");
2387 defsubr (&Stext_properties_at
);
2388 defsubr (&Sget_text_property
);
2389 defsubr (&Sget_char_property
);
2390 defsubr (&Sget_char_property_and_overlay
);
2391 defsubr (&Snext_char_property_change
);
2392 defsubr (&Sprevious_char_property_change
);
2393 defsubr (&Snext_single_char_property_change
);
2394 defsubr (&Sprevious_single_char_property_change
);
2395 defsubr (&Snext_property_change
);
2396 defsubr (&Snext_single_property_change
);
2397 defsubr (&Sprevious_property_change
);
2398 defsubr (&Sprevious_single_property_change
);
2399 defsubr (&Sadd_text_properties
);
2400 defsubr (&Sput_text_property
);
2401 defsubr (&Sset_text_properties
);
2402 defsubr (&Sadd_face_text_property
);
2403 defsubr (&Sremove_text_properties
);
2404 defsubr (&Sremove_list_of_text_properties
);
2405 defsubr (&Stext_property_any
);
2406 defsubr (&Stext_property_not_all
);