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, and LIMIT is nil or omitted, the function
717 If the optional second argument LIMIT is non-nil, the function doesn't
718 search past position LIMIT, and returns LIMIT if nothing is found
719 before LIMIT. LIMIT is a no-op if it is greater than (point-max). */)
720 (Lisp_Object position
, Lisp_Object limit
)
724 temp
= Fnext_overlay_change (position
);
727 CHECK_NUMBER_COERCE_MARKER (limit
);
728 if (XINT (limit
) < XINT (temp
))
731 return Fnext_property_change (position
, Qnil
, temp
);
734 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
735 Sprevious_char_property_change
, 1, 2, 0,
736 doc
: /* Return the position of previous text property or overlay change.
737 Scans characters backward in the current buffer from POSITION till it
738 finds a change in some text property, or the beginning or end of an
739 overlay, and returns the position of that.
740 If none is found, and LIMIT is nil or omitted, the function
743 If the optional second argument LIMIT is non-nil, the function doesn't
744 search before position LIMIT, and returns LIMIT if nothing is found
745 before LIMIT. LIMIT is a no-op if it is less than (point-min). */)
746 (Lisp_Object position
, Lisp_Object limit
)
750 temp
= Fprevious_overlay_change (position
);
753 CHECK_NUMBER_COERCE_MARKER (limit
);
754 if (XINT (limit
) > XINT (temp
))
757 return Fprevious_property_change (position
, Qnil
, temp
);
761 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
762 Snext_single_char_property_change
, 2, 4, 0,
763 doc
: /* Return the position of next text property or overlay change for a specific property.
764 Scans characters forward from POSITION till it finds
765 a change in the PROP property, then returns the position of the change.
766 If the optional third argument OBJECT is a buffer (or nil, which means
767 the current buffer), POSITION is a buffer position (integer or marker).
768 If OBJECT is a string, POSITION is a 0-based index into it.
770 In a string, scan runs to the end of the string, unless LIMIT is non-nil.
771 In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the
772 value cannot exceed that.
773 If the optional fourth argument LIMIT is non-nil, don't search
774 past position LIMIT; return LIMIT if nothing is found before LIMIT.
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 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
781 if (STRINGP (object
))
783 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
787 position
= make_number (SCHARS (object
));
790 CHECK_NUMBER (limit
);
797 Lisp_Object initial_value
, value
;
798 ptrdiff_t count
= SPECPDL_INDEX ();
801 CHECK_BUFFER (object
);
803 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
805 record_unwind_current_buffer ();
806 Fset_buffer (object
);
809 CHECK_NUMBER_COERCE_MARKER (position
);
811 initial_value
= Fget_char_property (position
, prop
, object
);
814 XSETFASTINT (limit
, ZV
);
816 CHECK_NUMBER_COERCE_MARKER (limit
);
818 if (XFASTINT (position
) >= XFASTINT (limit
))
821 if (XFASTINT (position
) > ZV
)
822 XSETFASTINT (position
, ZV
);
827 position
= Fnext_char_property_change (position
, limit
);
828 if (XFASTINT (position
) >= XFASTINT (limit
))
834 value
= Fget_char_property (position
, prop
, object
);
835 if (!EQ (value
, initial_value
))
839 unbind_to (count
, Qnil
);
845 DEFUN ("previous-single-char-property-change",
846 Fprevious_single_char_property_change
,
847 Sprevious_single_char_property_change
, 2, 4, 0,
848 doc
: /* Return the position of previous text property or overlay change for a specific property.
849 Scans characters backward from POSITION till it finds
850 a change in the PROP property, then returns the position of the change.
851 If the optional third argument OBJECT is a buffer (or nil, which means
852 the current buffer), POSITION is a buffer position (integer or marker).
853 If OBJECT is a string, POSITION is a 0-based index into it.
855 In a string, scan runs to the start of the string, unless LIMIT is non-nil.
856 In a buffer, if LIMIT is nil or omitted, it runs to (point-min), and the
857 value cannot be less than that.
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.
861 The property values are compared with `eq'.
862 If the property is constant all the way to the start of OBJECT, return the
863 first valid position in OBJECT. */)
864 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
866 if (STRINGP (object
))
868 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
872 position
= make_number (0);
875 CHECK_NUMBER (limit
);
882 ptrdiff_t count
= SPECPDL_INDEX ();
885 CHECK_BUFFER (object
);
887 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
889 record_unwind_current_buffer ();
890 Fset_buffer (object
);
893 CHECK_NUMBER_COERCE_MARKER (position
);
896 XSETFASTINT (limit
, BEGV
);
898 CHECK_NUMBER_COERCE_MARKER (limit
);
900 if (XFASTINT (position
) <= XFASTINT (limit
))
903 if (XFASTINT (position
) < BEGV
)
904 XSETFASTINT (position
, BEGV
);
908 Lisp_Object initial_value
909 = Fget_char_property (make_number (XFASTINT (position
) - 1),
914 position
= Fprevious_char_property_change (position
, limit
);
916 if (XFASTINT (position
) <= XFASTINT (limit
))
924 = Fget_char_property (make_number (XFASTINT (position
) - 1),
927 if (!EQ (value
, initial_value
))
933 unbind_to (count
, Qnil
);
939 DEFUN ("next-property-change", Fnext_property_change
,
940 Snext_property_change
, 1, 3, 0,
941 doc
: /* Return the position of next property change.
942 Scans characters forward from POSITION in OBJECT till it finds
943 a change in some text property, then returns the position of the change.
944 If the optional second argument OBJECT is a buffer (or nil, which means
945 the current buffer), POSITION is a buffer position (integer or marker).
946 If OBJECT is a string, POSITION is a 0-based index into it.
947 Return nil if LIMIT is nil or omitted, and the property is constant all
948 the way to the end of OBJECT; if the value is non-nil, it is a position
949 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 LIMIT is nil or omitted, and the property is constant all
1014 the way to the end of OBJECT; if the value is non-nil, it is a position
1015 greater than POSITION, never equal.
1017 If the optional fourth argument LIMIT is non-nil, don't search
1018 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1019 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1021 register INTERVAL i
, next
;
1022 register Lisp_Object here_val
;
1025 XSETBUFFER (object
, current_buffer
);
1028 CHECK_NUMBER_COERCE_MARKER (limit
);
1030 i
= validate_interval_range (object
, &position
, &position
, soft
);
1034 here_val
= textget (i
->plist
, prop
);
1035 next
= next_interval (i
);
1037 && EQ (here_val
, textget (next
->plist
, prop
))
1038 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1039 next
= next_interval (next
);
1043 >= (INTEGERP (limit
)
1047 : BUF_ZV (XBUFFER (object
))))))
1050 return make_number (next
->position
);
1053 DEFUN ("previous-property-change", Fprevious_property_change
,
1054 Sprevious_property_change
, 1, 3, 0,
1055 doc
: /* Return the position of previous property change.
1056 Scans characters backwards from POSITION in OBJECT till it finds
1057 a change in some text property, then returns the position of the change.
1058 If the optional second argument OBJECT is a buffer (or nil, which means
1059 the current buffer), POSITION is a buffer position (integer or marker).
1060 If OBJECT is a string, POSITION is a 0-based index into it.
1061 Return nil if LIMIT is nil or omitted, and the property is constant all
1062 the way to the start of OBJECT; if the value is non-nil, it is a position
1063 less than POSITION, never equal.
1065 If the optional third argument LIMIT is non-nil, don't search
1066 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1067 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1069 register INTERVAL i
, previous
;
1072 XSETBUFFER (object
, current_buffer
);
1075 CHECK_NUMBER_COERCE_MARKER (limit
);
1077 i
= validate_interval_range (object
, &position
, &position
, soft
);
1081 /* Start with the interval containing the char before point. */
1082 if (i
->position
== XFASTINT (position
))
1083 i
= previous_interval (i
);
1085 previous
= previous_interval (i
);
1086 while (previous
&& intervals_equal (previous
, i
)
1088 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1089 previous
= previous_interval (previous
);
1092 || (previous
->position
+ LENGTH (previous
)
1093 <= (INTEGERP (limit
)
1095 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1098 return make_number (previous
->position
+ LENGTH (previous
));
1101 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1102 Sprevious_single_property_change
, 2, 4, 0,
1103 doc
: /* Return the position of previous property change for a specific property.
1104 Scans characters backward from POSITION till it finds
1105 a change in the PROP property, then returns the position of the change.
1106 If the optional third argument OBJECT is a buffer (or nil, which means
1107 the current buffer), POSITION is a buffer position (integer or marker).
1108 If OBJECT is a string, POSITION is a 0-based index into it.
1109 The property values are compared with `eq'.
1110 Return nil if LIMIT is nil or omitted, and the property is constant all
1111 the way to the start of OBJECT; if the value is non-nil, it is a position
1112 less than POSITION, never equal.
1114 If the optional fourth argument LIMIT is non-nil, don't search
1115 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1116 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1118 register INTERVAL i
, previous
;
1119 register Lisp_Object here_val
;
1122 XSETBUFFER (object
, current_buffer
);
1125 CHECK_NUMBER_COERCE_MARKER (limit
);
1127 i
= validate_interval_range (object
, &position
, &position
, soft
);
1129 /* Start with the interval containing the char before point. */
1130 if (i
&& i
->position
== XFASTINT (position
))
1131 i
= previous_interval (i
);
1136 here_val
= textget (i
->plist
, prop
);
1137 previous
= previous_interval (i
);
1139 && EQ (here_val
, textget (previous
->plist
, prop
))
1141 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1142 previous
= previous_interval (previous
);
1145 || (previous
->position
+ LENGTH (previous
)
1146 <= (INTEGERP (limit
)
1148 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1151 return make_number (previous
->position
+ LENGTH (previous
));
1154 /* Used by add-text-properties and add-face-text-property. */
1157 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1158 Lisp_Object properties
, Lisp_Object object
,
1159 enum property_set_type set_type
) {
1160 INTERVAL i
, unchanged
;
1162 bool modified
= false;
1163 struct gcpro gcpro1
;
1164 bool first_time
= true;
1166 properties
= validate_plist (properties
);
1167 if (NILP (properties
))
1171 XSETBUFFER (object
, current_buffer
);
1174 i
= validate_interval_range (object
, &start
, &end
, hard
);
1179 len
= XINT (end
) - s
;
1181 /* No need to protect OBJECT, because we GC only if it's a buffer,
1182 and live buffers are always protected. */
1183 GCPRO1 (properties
);
1185 /* If this interval already has the properties, we can skip it. */
1186 if (interval_has_all_properties (properties
, i
))
1188 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1193 RETURN_UNGCPRO (Qnil
);
1195 i
= next_interval (i
);
1198 while (interval_has_all_properties (properties
, i
));
1200 else if (i
->position
!= s
)
1202 /* If we're not starting on an interval boundary, we have to
1203 split this interval. */
1205 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1206 copy_properties (unchanged
, i
);
1209 if (BUFFERP (object
) && first_time
)
1211 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1212 ptrdiff_t prev_pos
= i
->position
;
1214 modify_text_properties (object
, start
, end
);
1215 /* If someone called us recursively as a side effect of
1216 modify_text_properties, and changed the intervals behind our back
1217 (could happen if lock_file, called by prepare_to_modify_buffer,
1218 triggers redisplay, and that calls add-text-properties again
1219 in the same buffer), we cannot continue with I, because its
1220 data changed. So we restart the interval analysis anew. */
1221 if (TOTAL_LENGTH (i
) != prev_total_length
1222 || i
->position
!= prev_pos
)
1229 /* We are at the beginning of interval I, with LEN chars to scan. */
1234 if (LENGTH (i
) >= len
)
1236 /* We can UNGCPRO safely here, because there will be just
1237 one more chance to gc, in the next call to add_properties,
1238 and after that we will not need PROPERTIES or OBJECT again. */
1241 if (interval_has_all_properties (properties
, i
))
1243 if (BUFFERP (object
))
1244 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1245 XINT (end
) - XINT (start
));
1251 if (LENGTH (i
) == len
)
1253 add_properties (properties
, i
, object
, set_type
);
1254 if (BUFFERP (object
))
1255 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1256 XINT (end
) - XINT (start
));
1260 /* i doesn't have the properties, and goes past the change limit */
1262 i
= split_interval_left (unchanged
, len
);
1263 copy_properties (unchanged
, i
);
1264 add_properties (properties
, i
, object
, set_type
);
1265 if (BUFFERP (object
))
1266 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1267 XINT (end
) - XINT (start
));
1272 modified
|= add_properties (properties
, i
, object
, set_type
);
1273 i
= next_interval (i
);
1277 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1279 DEFUN ("add-text-properties", Fadd_text_properties
,
1280 Sadd_text_properties
, 3, 4, 0,
1281 doc
: /* Add properties to the text from START to END.
1282 The third argument PROPERTIES is a property list
1283 specifying the property values to add. If the optional fourth argument
1284 OBJECT is a buffer (or nil, which means the current buffer),
1285 START and END are buffer positions (integers or markers).
1286 If OBJECT is a string, START and END are 0-based indices into it.
1287 Return t if any property value actually changed, nil otherwise. */)
1288 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1291 return add_text_properties_1 (start
, end
, properties
, object
,
1292 TEXT_PROPERTY_REPLACE
);
1295 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1297 DEFUN ("put-text-property", Fput_text_property
,
1298 Sput_text_property
, 4, 5, 0,
1299 doc
: /* Set one property of the text from START to END.
1300 The third and fourth arguments PROPERTY and VALUE
1301 specify the property to add.
1302 If the optional fifth argument OBJECT is a buffer (or nil, which means
1303 the current buffer), START and END are buffer positions (integers or
1304 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1305 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
,
1306 Lisp_Object value
, Lisp_Object object
)
1308 AUTO_LIST2 (properties
, property
, value
);
1309 Fadd_text_properties (start
, end
, properties
, object
);
1313 DEFUN ("set-text-properties", Fset_text_properties
,
1314 Sset_text_properties
, 3, 4, 0,
1315 doc
: /* Completely replace properties of text from START to END.
1316 The third argument PROPERTIES is the new property list.
1317 If the optional fourth argument OBJECT is a buffer (or nil, which means
1318 the current buffer), START and END are buffer positions (integers or
1319 markers). If OBJECT is a string, START and END are 0-based indices into it.
1320 If PROPERTIES is nil, the effect is to remove all properties from
1321 the designated part of OBJECT. */)
1322 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1324 return set_text_properties (start
, end
, properties
, object
, Qt
);
1328 DEFUN ("add-face-text-property", Fadd_face_text_property
,
1329 Sadd_face_text_property
, 3, 5, 0,
1330 doc
: /* Add the face property to the text from START to END.
1331 FACE specifies the face to add. It should be a valid value of the
1332 `face' property (typically a face name or a plist of face attributes
1335 If any text in the region already has a non-nil `face' property, those
1336 face(s) are retained. This is done by setting the `face' property to
1337 a list of faces, with FACE as the first element (by default) and the
1338 pre-existing faces as the remaining elements.
1340 If optional fourth argument APPEND is non-nil, append FACE to the end
1341 of the face list instead.
1343 If optional fifth argument OBJECT is a buffer (or nil, which means the
1344 current buffer), START and END are buffer positions (integers or
1345 markers). If OBJECT is a string, START and END are 0-based indices
1347 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1348 Lisp_Object append
, Lisp_Object object
)
1350 AUTO_LIST2 (properties
, Qface
, face
);
1351 add_text_properties_1 (start
, end
, properties
, object
,
1353 ? TEXT_PROPERTY_PREPEND
1354 : TEXT_PROPERTY_APPEND
));
1358 /* Replace properties of text from START to END with new list of
1359 properties PROPERTIES. OBJECT is the buffer or string containing
1360 the text. OBJECT nil means use the current buffer.
1361 COHERENT_CHANGE_P nil means this is being called as an internal
1362 subroutine, rather than as a change primitive with checking of
1363 read-only, invoking change hooks, etc.. Value is nil if the
1364 function _detected_ that it did not replace any properties, non-nil
1368 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1369 Lisp_Object object
, Lisp_Object coherent_change_p
)
1371 register INTERVAL i
;
1372 Lisp_Object ostart
, oend
;
1377 properties
= validate_plist (properties
);
1380 XSETBUFFER (object
, current_buffer
);
1382 /* If we want no properties for a whole string,
1383 get rid of its intervals. */
1384 if (NILP (properties
) && STRINGP (object
)
1385 && XFASTINT (start
) == 0
1386 && XFASTINT (end
) == SCHARS (object
))
1388 if (!string_intervals (object
))
1391 set_string_intervals (object
, NULL
);
1395 i
= validate_interval_range (object
, &start
, &end
, soft
);
1399 /* If buffer has no properties, and we want none, return now. */
1400 if (NILP (properties
))
1403 /* Restore the original START and END values
1404 because validate_interval_range increments them for strings. */
1408 i
= validate_interval_range (object
, &start
, &end
, hard
);
1409 /* This can return if start == end. */
1414 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1415 modify_text_properties (object
, start
, end
);
1417 set_text_properties_1 (start
, end
, properties
, object
, i
);
1419 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1420 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1421 XINT (end
) - XINT (start
));
1425 /* Replace properties of text from START to END with new list of
1426 properties PROPERTIES. OBJECT is the buffer or string containing
1427 the text. This does not obey any hooks.
1428 You should provide the interval that START is located in as I.
1429 START and END can be in any order. */
1432 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1434 register INTERVAL prev_changed
= NULL
;
1435 register ptrdiff_t s
, len
;
1438 if (XINT (start
) < XINT (end
))
1441 len
= XINT (end
) - s
;
1443 else if (XINT (end
) < XINT (start
))
1446 len
= XINT (start
) - s
;
1453 if (i
->position
!= s
)
1456 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1458 if (LENGTH (i
) > len
)
1460 copy_properties (unchanged
, i
);
1461 i
= split_interval_left (i
, len
);
1462 set_properties (properties
, i
, object
);
1466 set_properties (properties
, i
, object
);
1468 if (LENGTH (i
) == len
)
1473 i
= next_interval (i
);
1476 /* We are starting at the beginning of an interval I. LEN is positive. */
1481 if (LENGTH (i
) >= len
)
1483 if (LENGTH (i
) > len
)
1484 i
= split_interval_left (i
, len
);
1486 /* We have to call set_properties even if we are going to
1487 merge the intervals, so as to make the undo records
1488 and cause redisplay to happen. */
1489 set_properties (properties
, i
, object
);
1491 merge_interval_left (i
);
1497 /* We have to call set_properties even if we are going to
1498 merge the intervals, so as to make the undo records
1499 and cause redisplay to happen. */
1500 set_properties (properties
, i
, object
);
1504 prev_changed
= i
= merge_interval_left (i
);
1506 i
= next_interval (i
);
1511 DEFUN ("remove-text-properties", Fremove_text_properties
,
1512 Sremove_text_properties
, 3, 4, 0,
1513 doc
: /* Remove some properties from text from START to END.
1514 The third argument PROPERTIES is a property list
1515 whose property names specify the properties to remove.
1516 \(The values stored in PROPERTIES are ignored.)
1517 If the optional fourth argument OBJECT is a buffer (or nil, which means
1518 the current buffer), START and END are buffer positions (integers or
1519 markers). If OBJECT is a string, START and END are 0-based indices into it.
1520 Return t if any property was actually removed, nil otherwise.
1522 Use `set-text-properties' if you want to remove all text properties. */)
1523 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1525 INTERVAL i
, unchanged
;
1527 bool modified
= false;
1528 bool first_time
= true;
1531 XSETBUFFER (object
, current_buffer
);
1534 i
= validate_interval_range (object
, &start
, &end
, soft
);
1539 len
= XINT (end
) - s
;
1541 /* If there are no properties on this entire interval, return. */
1542 if (! interval_has_some_properties (properties
, i
))
1544 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1551 i
= next_interval (i
);
1554 while (! interval_has_some_properties (properties
, i
));
1556 /* Split away the beginning of this interval; what we don't
1558 else if (i
->position
!= s
)
1561 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1562 copy_properties (unchanged
, i
);
1565 if (BUFFERP (object
) && first_time
)
1567 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1568 ptrdiff_t prev_pos
= i
->position
;
1570 modify_text_properties (object
, start
, end
);
1571 /* If someone called us recursively as a side effect of
1572 modify_text_properties, and changed the intervals behind our back
1573 (could happen if lock_file, called by prepare_to_modify_buffer,
1574 triggers redisplay, and that calls add-text-properties again
1575 in the same buffer), we cannot continue with I, because its
1576 data changed. So we restart the interval analysis anew. */
1577 if (TOTAL_LENGTH (i
) != prev_total_length
1578 || i
->position
!= prev_pos
)
1585 /* We are at the beginning of an interval, with len to scan */
1590 if (LENGTH (i
) >= len
)
1592 if (! interval_has_some_properties (properties
, i
))
1595 if (BUFFERP (object
))
1596 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1597 XINT (end
) - XINT (start
));
1601 if (LENGTH (i
) == len
)
1603 remove_properties (properties
, Qnil
, i
, object
);
1604 if (BUFFERP (object
))
1605 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1606 XINT (end
) - XINT (start
));
1610 /* i has the properties, and goes past the change limit */
1612 i
= split_interval_left (i
, len
);
1613 copy_properties (unchanged
, i
);
1614 remove_properties (properties
, Qnil
, i
, object
);
1615 if (BUFFERP (object
))
1616 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1617 XINT (end
) - XINT (start
));
1622 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1623 i
= next_interval (i
);
1627 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1628 Sremove_list_of_text_properties
, 3, 4, 0,
1629 doc
: /* Remove some properties from text from START to END.
1630 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1631 If the optional fourth argument OBJECT is a buffer (or nil, which means
1632 the current buffer), START and END are buffer positions (integers or
1633 markers). If OBJECT is a string, START and END are 0-based indices into it.
1634 Return t if any property was actually removed, nil otherwise. */)
1635 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1637 INTERVAL i
, unchanged
;
1639 bool modified
= false;
1640 Lisp_Object properties
;
1641 properties
= list_of_properties
;
1644 XSETBUFFER (object
, current_buffer
);
1646 i
= validate_interval_range (object
, &start
, &end
, soft
);
1651 len
= XINT (end
) - s
;
1653 /* If there are no properties on the interval, return. */
1654 if (! interval_has_some_properties_list (properties
, i
))
1656 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1663 i
= next_interval (i
);
1666 while (! interval_has_some_properties_list (properties
, i
));
1668 /* Split away the beginning of this interval; what we don't
1670 else if (i
->position
!= s
)
1673 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1674 copy_properties (unchanged
, i
);
1677 /* We are at the beginning of an interval, with len to scan.
1678 The flag MODIFIED records if changes have been made.
1679 When object is a buffer, we must call modify_text_properties
1680 before changes are made and signal_after_change when we are done.
1681 Call modify_text_properties before calling remove_properties if !MODIFIED,
1682 and call signal_after_change before returning if MODIFIED. */
1687 if (LENGTH (i
) >= len
)
1689 if (! interval_has_some_properties_list (properties
, i
))
1693 if (BUFFERP (object
))
1694 signal_after_change (XINT (start
),
1695 XINT (end
) - XINT (start
),
1696 XINT (end
) - XINT (start
));
1702 else if (LENGTH (i
) == len
)
1704 if (!modified
&& BUFFERP (object
))
1705 modify_text_properties (object
, start
, end
);
1706 remove_properties (Qnil
, properties
, i
, object
);
1707 if (BUFFERP (object
))
1708 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1709 XINT (end
) - XINT (start
));
1713 { /* i has the properties, and goes past the change limit. */
1715 i
= split_interval_left (i
, len
);
1716 copy_properties (unchanged
, i
);
1717 if (!modified
&& BUFFERP (object
))
1718 modify_text_properties (object
, start
, end
);
1719 remove_properties (Qnil
, properties
, i
, object
);
1720 if (BUFFERP (object
))
1721 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1722 XINT (end
) - XINT (start
));
1726 if (interval_has_some_properties_list (properties
, i
))
1728 if (!modified
&& BUFFERP (object
))
1729 modify_text_properties (object
, start
, end
);
1730 remove_properties (Qnil
, properties
, i
, object
);
1734 i
= next_interval (i
);
1739 if (BUFFERP (object
))
1740 signal_after_change (XINT (start
),
1741 XINT (end
) - XINT (start
),
1742 XINT (end
) - XINT (start
));
1751 DEFUN ("text-property-any", Ftext_property_any
,
1752 Stext_property_any
, 4, 5, 0,
1753 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1754 If so, return the position of the first character whose property PROPERTY
1755 is `eq' to VALUE. Otherwise return nil.
1756 If the optional fifth argument OBJECT is a buffer (or nil, which means
1757 the current buffer), START and END are buffer positions (integers or
1758 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1759 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1761 register INTERVAL i
;
1762 register ptrdiff_t e
, pos
;
1765 XSETBUFFER (object
, current_buffer
);
1766 i
= validate_interval_range (object
, &start
, &end
, soft
);
1768 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1773 if (i
->position
>= e
)
1775 if (EQ (textget (i
->plist
, property
), value
))
1778 if (pos
< XINT (start
))
1780 return make_number (pos
);
1782 i
= next_interval (i
);
1787 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1788 Stext_property_not_all
, 4, 5, 0,
1789 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1790 If so, return the position of the first character whose property PROPERTY
1791 is not `eq' to VALUE. Otherwise, return nil.
1792 If the optional fifth argument OBJECT is a buffer (or nil, which means
1793 the current buffer), START and END are buffer positions (integers or
1794 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1795 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1797 register INTERVAL i
;
1798 register ptrdiff_t s
, e
;
1801 XSETBUFFER (object
, current_buffer
);
1802 i
= validate_interval_range (object
, &start
, &end
, soft
);
1804 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1810 if (i
->position
>= e
)
1812 if (! EQ (textget (i
->plist
, property
), value
))
1814 if (i
->position
> s
)
1816 return make_number (s
);
1818 i
= next_interval (i
);
1824 /* Return the direction from which the text-property PROP would be
1825 inherited by any new text inserted at POS: 1 if it would be
1826 inherited from the char after POS, -1 if it would be inherited from
1827 the char before POS, and 0 if from neither.
1828 BUFFER can be either a buffer or nil (meaning current buffer). */
1831 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1833 bool ignore_previous_character
;
1834 Lisp_Object prev_pos
= make_number (XINT (pos
) - 1);
1835 Lisp_Object front_sticky
;
1836 bool is_rear_sticky
= true, is_front_sticky
= false; /* defaults */
1837 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1840 XSETBUFFER (buffer
, current_buffer
);
1842 ignore_previous_character
= XINT (pos
) <= BUF_BEGV (XBUFFER (buffer
));
1844 if (ignore_previous_character
|| (CONSP (defalt
) && !NILP (XCDR (defalt
))))
1845 is_rear_sticky
= false;
1848 Lisp_Object rear_non_sticky
1849 = Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1851 if (!NILP (CONSP (rear_non_sticky
)
1852 ? Fmemq (prop
, rear_non_sticky
)
1854 /* PROP is rear-non-sticky. */
1855 is_rear_sticky
= false;
1858 /* Consider following character. */
1859 /* This signals an arg-out-of-range error if pos is outside the
1860 buffer's accessible range. */
1861 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1863 if (EQ (front_sticky
, Qt
)
1864 || (CONSP (front_sticky
)
1865 && !NILP (Fmemq (prop
, front_sticky
))))
1866 /* PROP is inherited from after. */
1867 is_front_sticky
= true;
1869 /* Simple cases, where the properties are consistent. */
1870 if (is_rear_sticky
&& !is_front_sticky
)
1872 else if (!is_rear_sticky
&& is_front_sticky
)
1874 else if (!is_rear_sticky
&& !is_front_sticky
)
1877 /* The stickiness properties are inconsistent, so we have to
1878 disambiguate. Basically, rear-sticky wins, _except_ if the
1879 property that would be inherited has a value of nil, in which case
1880 front-sticky wins. */
1881 if (ignore_previous_character
1882 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1889 /* Copying properties between objects. */
1891 /* Add properties from START to END of SRC, starting at POS in DEST.
1892 SRC and DEST may each refer to strings or buffers.
1893 Optional sixth argument PROP causes only that property to be copied.
1894 Properties are copied to DEST as if by `add-text-properties'.
1895 Return t if any property value actually changed, nil otherwise. */
1897 /* Note this can GC when DEST is a buffer. */
1900 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
,
1901 Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1907 ptrdiff_t s
, e
, e2
, p
, len
;
1908 bool modified
= false;
1909 struct gcpro gcpro1
, gcpro2
;
1911 i
= validate_interval_range (src
, &start
, &end
, soft
);
1915 CHECK_NUMBER_COERCE_MARKER (pos
);
1917 Lisp_Object dest_start
, dest_end
;
1919 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1920 if (MOST_POSITIVE_FIXNUM
< e
)
1921 args_out_of_range (pos
, end
);
1923 XSETFASTINT (dest_end
, e
);
1924 /* Apply this to a copy of pos; it will try to increment its arguments,
1925 which we don't want. */
1926 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1937 e2
= i
->position
+ LENGTH (i
);
1944 while (! NILP (plist
))
1946 if (EQ (Fcar (plist
), prop
))
1948 plist
= list2 (prop
, Fcar (Fcdr (plist
)));
1951 plist
= Fcdr (Fcdr (plist
));
1954 /* Must defer modifications to the interval tree in case
1955 src and dest refer to the same string or buffer. */
1956 stuff
= Fcons (list3 (make_number (p
), make_number (p
+ len
), plist
),
1959 i
= next_interval (i
);
1967 GCPRO2 (stuff
, dest
);
1969 while (! NILP (stuff
))
1972 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1973 Fcar (Fcdr (Fcdr (res
))), dest
);
1976 stuff
= Fcdr (stuff
);
1981 return modified
? Qt
: Qnil
;
1985 /* Return a list representing the text properties of OBJECT between
1986 START and END. if PROP is non-nil, report only on that property.
1987 Each result list element has the form (S E PLIST), where S and E
1988 are positions in OBJECT and PLIST is a property list containing the
1989 text properties of OBJECT between S and E. Value is nil if OBJECT
1990 doesn't contain text properties between START and END. */
1993 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
2000 i
= validate_interval_range (object
, &start
, &end
, soft
);
2003 ptrdiff_t s
= XINT (start
);
2004 ptrdiff_t e
= XINT (end
);
2008 ptrdiff_t interval_end
, len
;
2011 interval_end
= i
->position
+ LENGTH (i
);
2012 if (interval_end
> e
)
2014 len
= interval_end
- s
;
2019 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2020 if (EQ (XCAR (plist
), prop
))
2022 plist
= list2 (prop
, Fcar (XCDR (plist
)));
2027 result
= Fcons (list3 (make_number (s
), make_number (s
+ len
),
2031 i
= next_interval (i
);
2042 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2043 (START END PLIST), where START and END are positions and PLIST is a
2044 property list containing the text properties to add. Adjust START
2045 and END positions by DELTA before adding properties. */
2048 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2050 struct gcpro gcpro1
, gcpro2
;
2052 GCPRO2 (list
, object
);
2054 for (; CONSP (list
); list
= XCDR (list
))
2056 Lisp_Object item
, start
, end
, plist
;
2059 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2060 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2061 plist
= XCAR (XCDR (XCDR (item
)));
2063 Fadd_text_properties (start
, end
, plist
, object
);
2071 /* Modify end-points of ranges in LIST destructively, and return the
2072 new list. LIST is a list as returned from text_property_list.
2073 Discard properties that begin at or after NEW_END, and limit
2074 end-points to NEW_END. */
2077 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2079 Lisp_Object prev
= Qnil
, head
= list
;
2080 ptrdiff_t max
= XINT (new_end
);
2082 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2084 Lisp_Object item
, beg
, end
;
2088 end
= XCAR (XCDR (item
));
2090 if (XINT (beg
) >= max
)
2092 /* The start-point is past the end of the new string.
2093 Discard this property. */
2094 if (EQ (head
, list
))
2097 XSETCDR (prev
, XCDR (list
));
2099 else if (XINT (end
) > max
)
2100 /* The end-point is past the end of the new string. */
2101 XSETCAR (XCDR (item
), new_end
);
2109 /* Call the modification hook functions in LIST, each with START and END. */
2112 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2114 struct gcpro gcpro1
;
2116 while (!NILP (list
))
2118 call2 (Fcar (list
), start
, end
);
2124 /* Check for read-only intervals between character positions START ... END,
2125 in BUF, and signal an error if we find one.
2127 Then check for any modification hooks in the range.
2128 Create a list of all these hooks in lexicographic order,
2129 eliminating consecutive extra copies of the same hook. Then call
2130 those hooks in order, with START and END - 1 as arguments. */
2133 verify_interval_modification (struct buffer
*buf
,
2134 ptrdiff_t start
, ptrdiff_t end
)
2136 INTERVAL intervals
= buffer_intervals (buf
);
2139 Lisp_Object prev_mod_hooks
;
2140 Lisp_Object mod_hooks
;
2141 struct gcpro gcpro1
;
2144 prev_mod_hooks
= Qnil
;
2147 interval_insert_behind_hooks
= Qnil
;
2148 interval_insert_in_front_hooks
= Qnil
;
2155 ptrdiff_t temp
= start
;
2160 /* For an insert operation, check the two chars around the position. */
2163 INTERVAL prev
= NULL
;
2164 Lisp_Object before
, after
;
2166 /* Set I to the interval containing the char after START,
2167 and PREV to the interval containing the char before START.
2168 Either one may be null. They may be equal. */
2169 i
= find_interval (intervals
, start
);
2171 if (start
== BUF_BEGV (buf
))
2173 else if (i
->position
== start
)
2174 prev
= previous_interval (i
);
2175 else if (i
->position
< start
)
2177 if (start
== BUF_ZV (buf
))
2180 /* If Vinhibit_read_only is set and is not a list, we can
2181 skip the read_only checks. */
2182 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2184 /* If I and PREV differ we need to check for the read-only
2185 property together with its stickiness. If either I or
2186 PREV are 0, this check is all we need.
2187 We have to take special care, since read-only may be
2188 indirectly defined via the category property. */
2193 after
= textget (i
->plist
, Qread_only
);
2195 /* If interval I is read-only and read-only is
2196 front-sticky, inhibit insertion.
2197 Check for read-only as well as category. */
2199 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2203 tem
= textget (i
->plist
, Qfront_sticky
);
2204 if (TMEM (Qread_only
, tem
)
2205 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2206 && TMEM (Qcategory
, tem
)))
2207 text_read_only (after
);
2213 before
= textget (prev
->plist
, Qread_only
);
2215 /* If interval PREV is read-only and read-only isn't
2216 rear-nonsticky, inhibit insertion.
2217 Check for read-only as well as category. */
2219 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2223 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2224 if (! TMEM (Qread_only
, tem
)
2225 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2226 || ! TMEM (Qcategory
, tem
)))
2227 text_read_only (before
);
2233 after
= textget (i
->plist
, Qread_only
);
2235 /* If interval I is read-only and read-only is
2236 front-sticky, inhibit insertion.
2237 Check for read-only as well as category. */
2238 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2242 tem
= textget (i
->plist
, Qfront_sticky
);
2243 if (TMEM (Qread_only
, tem
)
2244 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2245 && TMEM (Qcategory
, tem
)))
2246 text_read_only (after
);
2248 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2249 if (! TMEM (Qread_only
, tem
)
2250 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2251 || ! TMEM (Qcategory
, tem
)))
2252 text_read_only (after
);
2257 /* Run both insert hooks (just once if they're the same). */
2259 interval_insert_behind_hooks
2260 = textget (prev
->plist
, Qinsert_behind_hooks
);
2262 interval_insert_in_front_hooks
2263 = textget (i
->plist
, Qinsert_in_front_hooks
);
2267 /* Loop over intervals on or next to START...END,
2268 collecting their hooks. */
2270 i
= find_interval (intervals
, start
);
2273 if (! INTERVAL_WRITABLE_P (i
))
2274 text_read_only (textget (i
->plist
, Qread_only
));
2276 if (!inhibit_modification_hooks
)
2278 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2279 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2281 hooks
= Fcons (mod_hooks
, hooks
);
2282 prev_mod_hooks
= mod_hooks
;
2286 if (i
->position
+ LENGTH (i
) < end
2287 && (!NILP (BVAR (current_buffer
, read_only
))
2288 && NILP (Vinhibit_read_only
)))
2289 xsignal1 (Qbuffer_read_only
, Fcurrent_buffer ());
2291 i
= next_interval (i
);
2293 /* Keep going thru the interval containing the char before END. */
2294 while (i
&& i
->position
< end
);
2296 if (!inhibit_modification_hooks
)
2299 hooks
= Fnreverse (hooks
);
2300 while (! EQ (hooks
, Qnil
))
2302 call_mod_hooks (Fcar (hooks
), make_number (start
),
2304 hooks
= Fcdr (hooks
);
2311 /* Run the interval hooks for an insertion on character range START ... END.
2312 verify_interval_modification chose which hooks to run;
2313 this function is called after the insertion happens
2314 so it can indicate the range of inserted text. */
2317 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2319 if (! NILP (interval_insert_behind_hooks
))
2320 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2321 if (! NILP (interval_insert_in_front_hooks
)
2322 && ! EQ (interval_insert_in_front_hooks
,
2323 interval_insert_behind_hooks
))
2324 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2328 syms_of_textprop (void)
2330 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2331 doc
: /* Property-list used as default values.
2332 The value of a property in this list is seen as the value for every
2333 character that does not have its own value for that property. */);
2334 Vdefault_text_properties
= Qnil
;
2336 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2337 doc
: /* Alist of alternative properties for properties without a value.
2338 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2339 If a piece of text has no direct value for a particular property, then
2340 this alist is consulted. If that property appears in the alist, then
2341 the first non-nil value from the associated alternative properties is
2343 Vchar_property_alias_alist
= Qnil
;
2345 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2346 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2347 This also inhibits the use of the `intangible' text property. */);
2348 Vinhibit_point_motion_hooks
= Qnil
;
2350 DEFVAR_LISP ("text-property-default-nonsticky",
2351 Vtext_property_default_nonsticky
,
2352 doc
: /* Alist of properties vs the corresponding non-stickiness.
2353 Each element has the form (PROPERTY . NONSTICKINESS).
2355 If a character in a buffer has PROPERTY, new text inserted adjacent to
2356 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2357 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2358 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2359 /* Text properties `syntax-table'and `display' should be nonsticky
2361 Vtext_property_default_nonsticky
2362 = list2 (Fcons (Qsyntax_table
, Qt
), Fcons (Qdisplay
, Qt
));
2364 staticpro (&interval_insert_behind_hooks
);
2365 staticpro (&interval_insert_in_front_hooks
);
2366 interval_insert_behind_hooks
= Qnil
;
2367 interval_insert_in_front_hooks
= Qnil
;
2370 /* Common attributes one might give text. */
2372 DEFSYM (Qforeground
, "foreground");
2373 DEFSYM (Qbackground
, "background");
2374 DEFSYM (Qfont
, "font");
2375 DEFSYM (Qface
, "face");
2376 DEFSYM (Qstipple
, "stipple");
2377 DEFSYM (Qunderline
, "underline");
2378 DEFSYM (Qread_only
, "read-only");
2379 DEFSYM (Qinvisible
, "invisible");
2380 DEFSYM (Qintangible
, "intangible");
2381 DEFSYM (Qcategory
, "category");
2382 DEFSYM (Qlocal_map
, "local-map");
2383 DEFSYM (Qfront_sticky
, "front-sticky");
2384 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2385 DEFSYM (Qmouse_face
, "mouse-face");
2386 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2388 /* Properties that text might use to specify certain actions. */
2390 DEFSYM (Qmouse_left
, "mouse-left");
2391 DEFSYM (Qmouse_entered
, "mouse-entered");
2392 DEFSYM (Qpoint_left
, "point-left");
2393 DEFSYM (Qpoint_entered
, "point-entered");
2395 defsubr (&Stext_properties_at
);
2396 defsubr (&Sget_text_property
);
2397 defsubr (&Sget_char_property
);
2398 defsubr (&Sget_char_property_and_overlay
);
2399 defsubr (&Snext_char_property_change
);
2400 defsubr (&Sprevious_char_property_change
);
2401 defsubr (&Snext_single_char_property_change
);
2402 defsubr (&Sprevious_single_char_property_change
);
2403 defsubr (&Snext_property_change
);
2404 defsubr (&Snext_single_property_change
);
2405 defsubr (&Sprevious_property_change
);
2406 defsubr (&Sprevious_single_property_change
);
2407 defsubr (&Sadd_text_properties
);
2408 defsubr (&Sput_text_property
);
2409 defsubr (&Sset_text_properties
);
2410 defsubr (&Sadd_face_text_property
);
2411 defsubr (&Sremove_text_properties
);
2412 defsubr (&Sremove_list_of_text_properties
);
2413 defsubr (&Stext_property_any
);
2414 defsubr (&Stext_property_not_all
);