1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2013 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 static Lisp_Object Qmouse_left
;
49 static Lisp_Object Qmouse_entered
;
50 Lisp_Object Qpoint_left
;
51 Lisp_Object Qpoint_entered
;
52 Lisp_Object Qcategory
;
53 Lisp_Object Qlocal_map
;
55 /* Visual properties text (including strings) may have. */
56 static Lisp_Object Qforeground
, Qbackground
, Qunderline
;
58 static Lisp_Object Qstipple
;
59 Lisp_Object Qinvisible
, Qintangible
, Qmouse_face
;
60 static Lisp_Object Qread_only
;
61 Lisp_Object Qminibuffer_prompt
;
63 enum property_set_type
65 TEXT_PROPERTY_REPLACE
,
66 TEXT_PROPERTY_PREPEND
,
70 /* Sticky properties. */
71 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
73 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
74 the o1's cdr. Otherwise, return zero. This is handy for
76 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
78 /* verify_interval_modification saves insertion hooks here
79 to be run later by report_interval_modification. */
80 static Lisp_Object interval_insert_behind_hooks
;
81 static Lisp_Object interval_insert_in_front_hooks
;
84 /* Signal a `text-read-only' error. This function makes it easier
85 to capture that error in GDB by putting a breakpoint on it. */
88 text_read_only (Lisp_Object propval
)
90 if (STRINGP (propval
))
91 xsignal1 (Qtext_read_only
, propval
);
93 xsignal0 (Qtext_read_only
);
96 /* Prepare to modify the region of BUFFER from START to END. */
99 modify_region (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
101 struct buffer
*buf
= XBUFFER (buffer
), *old
= current_buffer
;
103 set_buffer_internal (buf
);
104 modify_region_1 (XINT (start
), XINT (end
), true);
105 set_buffer_internal (old
);
108 /* Complain if object is not string or buffer type. */
111 CHECK_STRING_OR_BUFFER (Lisp_Object x
)
113 CHECK_TYPE (STRINGP (x
) || BUFFERP (x
), Qbuffer_or_string_p
, x
);
116 /* Extract the interval at the position pointed to by BEGIN from
117 OBJECT, a string or buffer. Additionally, check that the positions
118 pointed to by BEGIN and END are within the bounds of OBJECT, and
119 reverse them if *BEGIN is greater than *END. The objects pointed
120 to by BEGIN and END may be integers or markers; if the latter, they
121 are coerced to integers.
123 When OBJECT is a string, we increment *BEGIN and *END
124 to make them origin-one.
126 Note that buffer points don't correspond to interval indices.
127 For example, point-max is 1 greater than the index of the last
128 character. This difference is handled in the caller, which uses
129 the validated points to determine a length, and operates on that.
130 Exceptions are Ftext_properties_at, Fnext_property_change, and
131 Fprevious_property_change which call this function with BEGIN == END.
132 Handle this case specially.
134 If FORCE is soft (0), it's OK to return NULL. Otherwise,
135 create an interval tree for OBJECT if one doesn't exist, provided
136 the object actually contains text. In the current design, if there
137 is no text, there can be no text properties. */
143 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
,
144 Lisp_Object
*end
, bool force
)
149 CHECK_STRING_OR_BUFFER (object
);
150 CHECK_NUMBER_COERCE_MARKER (*begin
);
151 CHECK_NUMBER_COERCE_MARKER (*end
);
153 /* If we are asked for a point, but from a subr which operates
154 on a range, then return nothing. */
155 if (EQ (*begin
, *end
) && begin
!= end
)
158 if (XINT (*begin
) > XINT (*end
))
166 if (BUFFERP (object
))
168 register struct buffer
*b
= XBUFFER (object
);
170 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
171 && XINT (*end
) <= BUF_ZV (b
)))
172 args_out_of_range (*begin
, *end
);
173 i
= buffer_intervals (b
);
175 /* If there's no text, there are no properties. */
176 if (BUF_BEGV (b
) == BUF_ZV (b
))
179 searchpos
= XINT (*begin
);
183 ptrdiff_t len
= SCHARS (object
);
185 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
186 && XINT (*end
) <= len
))
187 args_out_of_range (*begin
, *end
);
188 XSETFASTINT (*begin
, XFASTINT (*begin
));
190 XSETFASTINT (*end
, XFASTINT (*end
));
191 i
= string_intervals (object
);
196 searchpos
= XINT (*begin
);
200 return (force
? create_root_interval (object
) : i
);
202 return find_interval (i
, searchpos
);
205 /* Validate LIST as a property list. If LIST is not a list, then
206 make one consisting of (LIST nil). Otherwise, verify that LIST
207 is even numbered and thus suitable as a plist. */
210 validate_plist (Lisp_Object list
)
219 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
225 error ("Odd length text property list");
229 return list2 (list
, Qnil
);
232 /* Return true if interval I has all the properties,
233 with the same values, of list PLIST. */
236 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
238 Lisp_Object tail1
, tail2
;
240 /* Go through each element of PLIST. */
241 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
243 Lisp_Object sym1
= XCAR (tail1
);
246 /* Go through I's plist, looking for sym1 */
247 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
248 if (EQ (sym1
, XCAR (tail2
)))
250 /* Found the same property on both lists. If the
251 values are unequal, return zero. */
252 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
255 /* Property has same value on both lists; go to next one. */
267 /* Return true if the plist of interval I has any of the
268 properties of PLIST, regardless of their values. */
271 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
273 Lisp_Object tail1
, tail2
, sym
;
275 /* Go through each element of PLIST. */
276 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
280 /* Go through i's plist, looking for tail1 */
281 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
282 if (EQ (sym
, XCAR (tail2
)))
289 /* Return nonzero if the plist of interval I has any of the
290 property names in LIST, regardless of their values. */
293 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
295 Lisp_Object tail1
, tail2
, sym
;
297 /* Go through each element of LIST. */
298 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
302 /* Go through i's plist, looking for tail1 */
303 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
304 if (EQ (sym
, XCAR (tail2
)))
311 /* Changing the plists of individual intervals. */
313 /* Return the value of PROP in property-list PLIST, or Qunbound if it
316 property_value (Lisp_Object plist
, Lisp_Object prop
)
320 while (PLIST_ELT_P (plist
, value
))
321 if (EQ (XCAR (plist
), prop
))
324 plist
= XCDR (value
);
329 /* Set the properties of INTERVAL to PROPERTIES,
330 and record undo info for the previous values.
331 OBJECT is the string or buffer that INTERVAL belongs to. */
334 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
336 Lisp_Object sym
, value
;
338 if (BUFFERP (object
))
340 /* For each property in the old plist which is missing from PROPERTIES,
341 or has a different value in PROPERTIES, make an undo record. */
342 for (sym
= interval
->plist
;
343 PLIST_ELT_P (sym
, value
);
345 if (! EQ (property_value (properties
, XCAR (sym
)),
348 record_property_change (interval
->position
, LENGTH (interval
),
349 XCAR (sym
), XCAR (value
),
353 /* For each new property that has no value at all in the old plist,
354 make an undo record binding it to nil, so it will be removed. */
355 for (sym
= properties
;
356 PLIST_ELT_P (sym
, value
);
358 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
360 record_property_change (interval
->position
, LENGTH (interval
),
366 /* Store new properties. */
367 set_interval_plist (interval
, Fcopy_sequence (properties
));
370 /* Add the properties of PLIST to the interval I, or set
371 the value of I's property to the value of the property on PLIST
372 if they are different.
374 OBJECT should be the string or buffer the interval is in.
376 Return true if this changes I (i.e., if any members of PLIST
377 are actually added to I's plist) */
380 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
,
381 enum property_set_type set_type
)
383 Lisp_Object tail1
, tail2
, sym1
, val1
;
385 struct gcpro gcpro1
, gcpro2
, gcpro3
;
390 /* No need to protect OBJECT, because we can GC only in the case
391 where it is a buffer, and live buffers are always protected.
392 I and its plist are also protected, via OBJECT. */
393 GCPRO3 (tail1
, sym1
, val1
);
395 /* Go through each element of PLIST. */
396 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
400 val1
= Fcar (XCDR (tail1
));
402 /* Go through I's plist, looking for sym1 */
403 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
404 if (EQ (sym1
, XCAR (tail2
)))
406 /* No need to gcpro, because tail2 protects this
407 and it must be a cons cell (we get an error otherwise). */
408 register Lisp_Object this_cdr
;
410 this_cdr
= XCDR (tail2
);
411 /* Found the property. Now check its value. */
414 /* The properties have the same value on both lists.
415 Continue to the next property. */
416 if (EQ (val1
, Fcar (this_cdr
)))
419 /* Record this change in the buffer, for undo purposes. */
420 if (BUFFERP (object
))
422 record_property_change (i
->position
, LENGTH (i
),
423 sym1
, Fcar (this_cdr
), object
);
426 /* I's property has a different value -- change it */
427 if (set_type
== TEXT_PROPERTY_REPLACE
)
428 Fsetcar (this_cdr
, val1
);
430 if (CONSP (Fcar (this_cdr
)) &&
431 /* Special-case anonymous face properties. */
432 (! EQ (sym1
, Qface
) ||
433 NILP (Fkeywordp (Fcar (Fcar (this_cdr
))))))
434 /* The previous value is a list, so prepend (or
435 append) the new value to this list. */
436 if (set_type
== TEXT_PROPERTY_PREPEND
)
437 Fsetcar (this_cdr
, Fcons (val1
, Fcar (this_cdr
)));
439 nconc2 (Fcar (this_cdr
), list1 (val1
));
441 /* The previous value is a single value, so make it
443 if (set_type
== TEXT_PROPERTY_PREPEND
)
444 Fsetcar (this_cdr
, list2 (val1
, Fcar (this_cdr
)));
446 Fsetcar (this_cdr
, list2 (Fcar (this_cdr
), val1
));
455 /* Record this change in the buffer, for undo purposes. */
456 if (BUFFERP (object
))
458 record_property_change (i
->position
, LENGTH (i
),
461 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
471 /* For any members of PLIST, or LIST,
472 which are properties of I, remove them from I's plist.
473 (If PLIST is non-nil, use that, otherwise use LIST.)
474 OBJECT is the string or buffer containing I. */
477 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
479 Lisp_Object tail1
, tail2
, sym
, current_plist
;
482 /* True means tail1 is a plist, otherwise it is a list. */
485 current_plist
= i
->plist
;
488 tail1
= plist
, use_plist
= 1;
490 tail1
= list
, use_plist
= 0;
492 /* Go through each element of LIST or PLIST. */
493 while (CONSP (tail1
))
497 /* First, remove the symbol if it's at the head of the list */
498 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
500 if (BUFFERP (object
))
501 record_property_change (i
->position
, LENGTH (i
),
502 sym
, XCAR (XCDR (current_plist
)),
505 current_plist
= XCDR (XCDR (current_plist
));
509 /* Go through I's plist, looking for SYM. */
510 tail2
= current_plist
;
511 while (! NILP (tail2
))
513 register Lisp_Object
this;
514 this = XCDR (XCDR (tail2
));
515 if (CONSP (this) && EQ (sym
, XCAR (this)))
517 if (BUFFERP (object
))
518 record_property_change (i
->position
, LENGTH (i
),
519 sym
, XCAR (XCDR (this)), object
);
521 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
527 /* Advance thru TAIL1 one way or the other. */
528 tail1
= XCDR (tail1
);
529 if (use_plist
&& CONSP (tail1
))
530 tail1
= XCDR (tail1
);
534 set_interval_plist (i
, current_plist
);
538 /* Returns the interval of POSITION in OBJECT.
539 POSITION is BEG-based. */
542 interval_of (ptrdiff_t position
, Lisp_Object object
)
548 XSETBUFFER (object
, current_buffer
);
549 else if (EQ (object
, Qt
))
552 CHECK_STRING_OR_BUFFER (object
);
554 if (BUFFERP (object
))
556 register struct buffer
*b
= XBUFFER (object
);
560 i
= buffer_intervals (b
);
565 end
= SCHARS (object
);
566 i
= string_intervals (object
);
569 if (!(beg
<= position
&& position
<= end
))
570 args_out_of_range (make_number (position
), make_number (position
));
571 if (beg
== end
|| !i
)
574 return find_interval (i
, position
);
577 DEFUN ("text-properties-at", Ftext_properties_at
,
578 Stext_properties_at
, 1, 2, 0,
579 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
580 If the optional second argument OBJECT is a buffer (or nil, which means
581 the current buffer), POSITION is a buffer position (integer or marker).
582 If OBJECT is a string, POSITION is a 0-based index into it.
583 If POSITION is at the end of OBJECT, the value is nil. */)
584 (Lisp_Object position
, Lisp_Object object
)
589 XSETBUFFER (object
, current_buffer
);
591 i
= validate_interval_range (object
, &position
, &position
, soft
);
594 /* If POSITION is at the end of the interval,
595 it means it's the end of OBJECT.
596 There are no properties at the very end,
597 since no character follows. */
598 if (XINT (position
) == LENGTH (i
) + i
->position
)
604 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
605 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
606 OBJECT should be a buffer or a string; if omitted or nil, it defaults
607 to the current buffer.
608 If POSITION is at the end of OBJECT, the value is nil. */)
609 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
611 return textget (Ftext_properties_at (position
, object
), prop
);
614 /* Return the value of char's property PROP, in OBJECT at POSITION.
615 OBJECT is optional and defaults to the current buffer.
616 If OVERLAY is non-0, then in the case that the returned property is from
617 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
618 returned in *OVERLAY.
619 If POSITION is at the end of OBJECT, the value is nil.
620 If OBJECT is a buffer, then overlay properties are considered as well as
622 If OBJECT is a window, then that window's buffer is used, but
623 window-specific overlays are considered only if they are associated
626 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
628 struct window
*w
= 0;
630 CHECK_NUMBER_COERCE_MARKER (position
);
633 XSETBUFFER (object
, current_buffer
);
635 if (WINDOWP (object
))
637 CHECK_LIVE_WINDOW (object
);
638 w
= XWINDOW (object
);
639 object
= w
->contents
;
641 if (BUFFERP (object
))
644 Lisp_Object
*overlay_vec
;
645 struct buffer
*obuf
= current_buffer
;
647 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
648 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
649 xsignal1 (Qargs_out_of_range
, position
);
651 set_buffer_temp (XBUFFER (object
));
653 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
654 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
656 set_buffer_temp (obuf
);
658 /* Now check the overlays in order of decreasing priority. */
659 while (--noverlays
>= 0)
661 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
665 /* Return the overlay we got the property from. */
666 *overlay
= overlay_vec
[noverlays
];
673 /* Indicate that the return value is not from an overlay. */
676 /* Not a buffer, or no appropriate overlay, so fall through to the
678 return Fget_text_property (position
, prop
, object
);
681 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
682 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
683 Both overlay properties and text properties are checked.
684 OBJECT is optional and defaults to the current buffer.
685 If POSITION is at the end of OBJECT, the value is nil.
686 If OBJECT is a buffer, then overlay properties are considered as well as
688 If OBJECT is a window, then that window's buffer is used, but window-specific
689 overlays are considered only if they are associated with OBJECT. */)
690 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
692 return get_char_property_and_overlay (position
, prop
, object
, 0);
695 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
696 Sget_char_property_and_overlay
, 2, 3, 0,
697 doc
: /* Like `get-char-property', but with extra overlay information.
698 The value is a cons cell. Its car is the return value of `get-char-property'
699 with the same arguments--that is, the value of POSITION's property
700 PROP in OBJECT. Its cdr is the overlay in which the property was
701 found, or nil, if it was found as a text property or not found at all.
703 OBJECT is optional and defaults to the current buffer. OBJECT may be
704 a string, a buffer or a window. For strings, the cdr of the return
705 value is always nil, since strings do not have overlays. If OBJECT is
706 a window, then that window's buffer is used, but window-specific
707 overlays are considered only if they are associated with OBJECT. If
708 POSITION is at the end of OBJECT, both car and cdr are nil. */)
709 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
713 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
714 return Fcons (val
, overlay
);
718 DEFUN ("next-char-property-change", Fnext_char_property_change
,
719 Snext_char_property_change
, 1, 2, 0,
720 doc
: /* Return the position of next text property or overlay change.
721 This scans characters forward in the current buffer from POSITION till
722 it finds a change in some text property, or the beginning or end of an
723 overlay, and returns the position of that.
724 If none is found up to (point-max), the function returns (point-max).
726 If the optional second argument LIMIT is non-nil, don't search
727 past position LIMIT; return LIMIT if nothing is found before LIMIT.
728 LIMIT is a no-op if it is greater than (point-max). */)
729 (Lisp_Object position
, Lisp_Object limit
)
733 temp
= Fnext_overlay_change (position
);
736 CHECK_NUMBER_COERCE_MARKER (limit
);
737 if (XINT (limit
) < XINT (temp
))
740 return Fnext_property_change (position
, Qnil
, temp
);
743 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
744 Sprevious_char_property_change
, 1, 2, 0,
745 doc
: /* Return the position of previous text property or overlay change.
746 Scans characters backward in the current buffer from POSITION till it
747 finds a change in some text property, or the beginning or end of an
748 overlay, and returns the position of that.
749 If none is found since (point-min), the function returns (point-min).
751 If the optional second argument LIMIT is non-nil, don't search
752 past position LIMIT; return LIMIT if nothing is found before LIMIT.
753 LIMIT is a no-op if it is less than (point-min). */)
754 (Lisp_Object position
, Lisp_Object limit
)
758 temp
= Fprevious_overlay_change (position
);
761 CHECK_NUMBER_COERCE_MARKER (limit
);
762 if (XINT (limit
) > XINT (temp
))
765 return Fprevious_property_change (position
, Qnil
, temp
);
769 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
770 Snext_single_char_property_change
, 2, 4, 0,
771 doc
: /* Return the position of next text property or overlay change for a specific property.
772 Scans characters forward from POSITION till it finds
773 a change in the PROP property, then returns the position of the change.
774 If the optional third argument OBJECT is a buffer (or nil, which means
775 the current buffer), POSITION is a buffer position (integer or marker).
776 If OBJECT is a string, POSITION is a 0-based index into it.
778 In a string, scan runs to the end of the string.
779 In a buffer, it runs to (point-max), and the value cannot exceed that.
781 The property values are compared with `eq'.
782 If the property is constant all the way to the end of OBJECT, return the
783 last valid position in OBJECT.
784 If the optional fourth argument LIMIT is non-nil, don't search
785 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
786 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
788 if (STRINGP (object
))
790 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
794 position
= make_number (SCHARS (object
));
797 CHECK_NUMBER (limit
);
804 Lisp_Object initial_value
, value
;
805 ptrdiff_t count
= SPECPDL_INDEX ();
808 CHECK_BUFFER (object
);
810 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
812 record_unwind_current_buffer ();
813 Fset_buffer (object
);
816 CHECK_NUMBER_COERCE_MARKER (position
);
818 initial_value
= Fget_char_property (position
, prop
, object
);
821 XSETFASTINT (limit
, ZV
);
823 CHECK_NUMBER_COERCE_MARKER (limit
);
825 if (XFASTINT (position
) >= XFASTINT (limit
))
828 if (XFASTINT (position
) > ZV
)
829 XSETFASTINT (position
, ZV
);
834 position
= Fnext_char_property_change (position
, limit
);
835 if (XFASTINT (position
) >= XFASTINT (limit
))
841 value
= Fget_char_property (position
, prop
, object
);
842 if (!EQ (value
, initial_value
))
846 unbind_to (count
, Qnil
);
852 DEFUN ("previous-single-char-property-change",
853 Fprevious_single_char_property_change
,
854 Sprevious_single_char_property_change
, 2, 4, 0,
855 doc
: /* Return the position of previous text property or overlay change for a specific property.
856 Scans characters backward from POSITION till it finds
857 a change in the PROP property, then returns the position of the change.
858 If the optional third argument OBJECT is a buffer (or nil, which means
859 the current buffer), POSITION is a buffer position (integer or marker).
860 If OBJECT is a string, POSITION is a 0-based index into it.
862 In a string, scan runs to the start of the string.
863 In a buffer, it runs to (point-min), and the value cannot be less than that.
865 The property values are compared with `eq'.
866 If the property is constant all the way to the start of OBJECT, return the
867 first valid position in OBJECT.
868 If the optional fourth argument LIMIT is non-nil, don't search back past
869 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
870 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
872 if (STRINGP (object
))
874 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
878 position
= make_number (0);
881 CHECK_NUMBER (limit
);
888 ptrdiff_t count
= SPECPDL_INDEX ();
891 CHECK_BUFFER (object
);
893 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
895 record_unwind_current_buffer ();
896 Fset_buffer (object
);
899 CHECK_NUMBER_COERCE_MARKER (position
);
902 XSETFASTINT (limit
, BEGV
);
904 CHECK_NUMBER_COERCE_MARKER (limit
);
906 if (XFASTINT (position
) <= XFASTINT (limit
))
909 if (XFASTINT (position
) < BEGV
)
910 XSETFASTINT (position
, BEGV
);
914 Lisp_Object initial_value
915 = Fget_char_property (make_number (XFASTINT (position
) - 1),
920 position
= Fprevious_char_property_change (position
, limit
);
922 if (XFASTINT (position
) <= XFASTINT (limit
))
930 = Fget_char_property (make_number (XFASTINT (position
) - 1),
933 if (!EQ (value
, initial_value
))
939 unbind_to (count
, Qnil
);
945 DEFUN ("next-property-change", Fnext_property_change
,
946 Snext_property_change
, 1, 3, 0,
947 doc
: /* Return the position of next property change.
948 Scans characters forward from POSITION in OBJECT till it finds
949 a change in some text property, then returns the position of the change.
950 If the optional second argument OBJECT is a buffer (or nil, which means
951 the current buffer), POSITION is a buffer position (integer or marker).
952 If OBJECT is a string, POSITION is a 0-based index into it.
953 Return nil if the property is constant all the way to the end of OBJECT.
954 If the value is non-nil, it is a position greater than POSITION, never equal.
956 If the optional third argument LIMIT is non-nil, don't search
957 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
958 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
960 register INTERVAL i
, next
;
963 XSETBUFFER (object
, current_buffer
);
965 if (!NILP (limit
) && !EQ (limit
, Qt
))
966 CHECK_NUMBER_COERCE_MARKER (limit
);
968 i
= validate_interval_range (object
, &position
, &position
, soft
);
970 /* If LIMIT is t, return start of next interval--don't
971 bother checking further intervals. */
977 next
= next_interval (i
);
980 XSETFASTINT (position
, (STRINGP (object
)
982 : BUF_ZV (XBUFFER (object
))));
984 XSETFASTINT (position
, next
->position
);
991 next
= next_interval (i
);
993 while (next
&& intervals_equal (i
, next
)
994 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
995 next
= next_interval (next
);
1003 : BUF_ZV (XBUFFER (object
))))))
1006 return make_number (next
->position
);
1009 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1010 Snext_single_property_change
, 2, 4, 0,
1011 doc
: /* Return the position of next property change for a specific property.
1012 Scans characters forward from POSITION till it finds
1013 a change in the PROP property, then returns the position of the change.
1014 If the optional third argument OBJECT is a buffer (or nil, which means
1015 the current buffer), POSITION is a buffer position (integer or marker).
1016 If OBJECT is a string, POSITION is a 0-based index into it.
1017 The property values are compared with `eq'.
1018 Return nil if the property is constant all the way to the end of OBJECT.
1019 If the value is non-nil, it is a position greater than POSITION, never equal.
1021 If the optional fourth argument LIMIT is non-nil, don't search
1022 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1023 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1025 register INTERVAL i
, next
;
1026 register Lisp_Object here_val
;
1029 XSETBUFFER (object
, current_buffer
);
1032 CHECK_NUMBER_COERCE_MARKER (limit
);
1034 i
= validate_interval_range (object
, &position
, &position
, soft
);
1038 here_val
= textget (i
->plist
, prop
);
1039 next
= next_interval (i
);
1041 && EQ (here_val
, textget (next
->plist
, prop
))
1042 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1043 next
= next_interval (next
);
1047 >= (INTEGERP (limit
)
1051 : BUF_ZV (XBUFFER (object
))))))
1054 return make_number (next
->position
);
1057 DEFUN ("previous-property-change", Fprevious_property_change
,
1058 Sprevious_property_change
, 1, 3, 0,
1059 doc
: /* Return the position of previous property change.
1060 Scans characters backwards from POSITION in OBJECT till it finds
1061 a change in some text property, then returns the position of the change.
1062 If the optional second argument OBJECT is a buffer (or nil, which means
1063 the current buffer), POSITION is a buffer position (integer or marker).
1064 If OBJECT is a string, POSITION is a 0-based index into it.
1065 Return nil if the property is constant all the way to the start of OBJECT.
1066 If the value is non-nil, it is a position less than POSITION, never equal.
1068 If the optional third argument LIMIT is non-nil, don't search
1069 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1070 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1072 register INTERVAL i
, previous
;
1075 XSETBUFFER (object
, current_buffer
);
1078 CHECK_NUMBER_COERCE_MARKER (limit
);
1080 i
= validate_interval_range (object
, &position
, &position
, soft
);
1084 /* Start with the interval containing the char before point. */
1085 if (i
->position
== XFASTINT (position
))
1086 i
= previous_interval (i
);
1088 previous
= previous_interval (i
);
1089 while (previous
&& intervals_equal (previous
, i
)
1091 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1092 previous
= previous_interval (previous
);
1095 || (previous
->position
+ LENGTH (previous
)
1096 <= (INTEGERP (limit
)
1098 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1101 return make_number (previous
->position
+ LENGTH (previous
));
1104 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1105 Sprevious_single_property_change
, 2, 4, 0,
1106 doc
: /* Return the position of previous property change for a specific property.
1107 Scans characters backward from POSITION till it finds
1108 a change in the PROP property, then returns the position of the change.
1109 If the optional third argument OBJECT is a buffer (or nil, which means
1110 the current buffer), POSITION is a buffer position (integer or marker).
1111 If OBJECT is a string, POSITION is a 0-based index into it.
1112 The property values are compared with `eq'.
1113 Return nil if the property is constant all the way to the start of OBJECT.
1114 If the value is non-nil, it is a position less than POSITION, never equal.
1116 If the optional fourth argument LIMIT is non-nil, don't search
1117 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1118 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1120 register INTERVAL i
, previous
;
1121 register Lisp_Object here_val
;
1124 XSETBUFFER (object
, current_buffer
);
1127 CHECK_NUMBER_COERCE_MARKER (limit
);
1129 i
= validate_interval_range (object
, &position
, &position
, soft
);
1131 /* Start with the interval containing the char before point. */
1132 if (i
&& i
->position
== XFASTINT (position
))
1133 i
= previous_interval (i
);
1138 here_val
= textget (i
->plist
, prop
);
1139 previous
= previous_interval (i
);
1141 && EQ (here_val
, textget (previous
->plist
, prop
))
1143 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1144 previous
= previous_interval (previous
);
1147 || (previous
->position
+ LENGTH (previous
)
1148 <= (INTEGERP (limit
)
1150 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1153 return make_number (previous
->position
+ LENGTH (previous
));
1156 /* Used by add-text-properties and add-face-text-property. */
1159 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1160 Lisp_Object properties
, Lisp_Object object
,
1161 enum property_set_type set_type
) {
1162 INTERVAL i
, unchanged
;
1165 struct gcpro gcpro1
;
1166 bool first_time
= 1;
1168 properties
= validate_plist (properties
);
1169 if (NILP (properties
))
1173 XSETBUFFER (object
, current_buffer
);
1176 i
= validate_interval_range (object
, &start
, &end
, hard
);
1181 len
= XINT (end
) - s
;
1183 /* No need to protect OBJECT, because we GC only if it's a buffer,
1184 and live buffers are always protected. */
1185 GCPRO1 (properties
);
1187 /* If this interval already has the properties, we can skip it. */
1188 if (interval_has_all_properties (properties
, i
))
1190 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1195 RETURN_UNGCPRO (Qnil
);
1197 i
= next_interval (i
);
1200 while (interval_has_all_properties (properties
, i
));
1202 else if (i
->position
!= s
)
1204 /* If we're not starting on an interval boundary, we have to
1205 split this interval. */
1207 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1208 copy_properties (unchanged
, i
);
1211 if (BUFFERP (object
) && first_time
)
1213 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1214 ptrdiff_t prev_pos
= i
->position
;
1216 modify_region (object
, start
, end
);
1217 /* If someone called us recursively as a side effect of
1218 modify_region, and changed the intervals behind our back
1219 (could happen if lock_file, called by prepare_to_modify_buffer,
1220 triggers redisplay, and that calls add-text-properties again
1221 in the same buffer), we cannot continue with I, because its
1222 data changed. So we restart the interval analysis anew. */
1223 if (TOTAL_LENGTH (i
) != prev_total_length
1224 || i
->position
!= prev_pos
)
1231 /* We are at the beginning of interval I, with LEN chars to scan. */
1236 if (LENGTH (i
) >= len
)
1238 /* We can UNGCPRO safely here, because there will be just
1239 one more chance to gc, in the next call to add_properties,
1240 and after that we will not need PROPERTIES or OBJECT again. */
1243 if (interval_has_all_properties (properties
, i
))
1245 if (BUFFERP (object
))
1246 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1247 XINT (end
) - XINT (start
));
1253 if (LENGTH (i
) == len
)
1255 add_properties (properties
, i
, object
, set_type
);
1256 if (BUFFERP (object
))
1257 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1258 XINT (end
) - XINT (start
));
1262 /* i doesn't have the properties, and goes past the change limit */
1264 i
= split_interval_left (unchanged
, len
);
1265 copy_properties (unchanged
, i
);
1266 add_properties (properties
, i
, object
, set_type
);
1267 if (BUFFERP (object
))
1268 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1269 XINT (end
) - XINT (start
));
1274 modified
|= add_properties (properties
, i
, object
, set_type
);
1275 i
= next_interval (i
);
1279 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1281 DEFUN ("add-text-properties", Fadd_text_properties
,
1282 Sadd_text_properties
, 3, 4, 0,
1283 doc
: /* Add properties to the text from START to END.
1284 The third argument PROPERTIES is a property list
1285 specifying the property values to add. If the optional fourth argument
1286 OBJECT is a buffer (or nil, which means the current buffer),
1287 START and END are buffer positions (integers or markers).
1288 If OBJECT is a string, START and END are 0-based indices into it.
1289 Return t if any property value actually changed, nil otherwise. */)
1290 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1293 return add_text_properties_1 (start
, end
, properties
, object
,
1294 TEXT_PROPERTY_REPLACE
);
1297 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1299 DEFUN ("put-text-property", Fput_text_property
,
1300 Sput_text_property
, 4, 5, 0,
1301 doc
: /* Set one property of the text from START to END.
1302 The third and fourth arguments PROPERTY and VALUE
1303 specify the property to add.
1304 If the optional fifth argument OBJECT is a buffer (or nil, which means
1305 the current buffer), START and END are buffer positions (integers or
1306 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1307 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1309 Fadd_text_properties (start
, end
, list2 (property
, value
), 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 The third argument FACE specifies the face to add.
1332 If any text in the region already has any face properties, this new
1333 face property will be added to the front of the face property list.
1334 If the optional fourth argument APPENDP is non-nil, append to the end
1335 of the face property list instead.
1336 If the optional fifth argument OBJECT is a buffer (or nil, which means
1337 the current buffer), START and END are buffer positions (integers or
1338 markers). If OBJECT is a string, START and END are 0-based indices
1340 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1341 Lisp_Object appendp
, Lisp_Object object
)
1343 add_text_properties_1 (start
, end
, list2 (Qface
, face
), 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
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1362 register INTERVAL i
;
1363 Lisp_Object ostart
, oend
;
1368 properties
= validate_plist (properties
);
1371 XSETBUFFER (object
, current_buffer
);
1373 /* If we want no properties for a whole string,
1374 get rid of its intervals. */
1375 if (NILP (properties
) && STRINGP (object
)
1376 && XFASTINT (start
) == 0
1377 && XFASTINT (end
) == SCHARS (object
))
1379 if (!string_intervals (object
))
1382 set_string_intervals (object
, NULL
);
1386 i
= validate_interval_range (object
, &start
, &end
, soft
);
1390 /* If buffer has no properties, and we want none, return now. */
1391 if (NILP (properties
))
1394 /* Restore the original START and END values
1395 because validate_interval_range increments them for strings. */
1399 i
= validate_interval_range (object
, &start
, &end
, hard
);
1400 /* This can return if start == end. */
1405 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1406 modify_region (object
, start
, end
);
1408 set_text_properties_1 (start
, end
, properties
, object
, i
);
1410 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1411 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1412 XINT (end
) - XINT (start
));
1416 /* Replace properties of text from START to END with new list of
1417 properties PROPERTIES. OBJECT is the buffer or string containing
1418 the text. This does not obey any hooks.
1419 You should provide the interval that START is located in as I.
1420 START and END can be in any order. */
1423 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1425 register INTERVAL prev_changed
= NULL
;
1426 register ptrdiff_t s
, len
;
1429 if (XINT (start
) < XINT (end
))
1432 len
= XINT (end
) - s
;
1434 else if (XINT (end
) < XINT (start
))
1437 len
= XINT (start
) - s
;
1444 if (i
->position
!= s
)
1447 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1449 if (LENGTH (i
) > len
)
1451 copy_properties (unchanged
, i
);
1452 i
= split_interval_left (i
, len
);
1453 set_properties (properties
, i
, object
);
1457 set_properties (properties
, i
, object
);
1459 if (LENGTH (i
) == len
)
1464 i
= next_interval (i
);
1467 /* We are starting at the beginning of an interval I. LEN is positive. */
1472 if (LENGTH (i
) >= len
)
1474 if (LENGTH (i
) > len
)
1475 i
= split_interval_left (i
, len
);
1477 /* We have to call set_properties even if we are going to
1478 merge the intervals, so as to make the undo records
1479 and cause redisplay to happen. */
1480 set_properties (properties
, i
, object
);
1482 merge_interval_left (i
);
1488 /* We have to call set_properties even if we are going to
1489 merge the intervals, so as to make the undo records
1490 and cause redisplay to happen. */
1491 set_properties (properties
, i
, object
);
1495 prev_changed
= i
= merge_interval_left (i
);
1497 i
= next_interval (i
);
1502 DEFUN ("remove-text-properties", Fremove_text_properties
,
1503 Sremove_text_properties
, 3, 4, 0,
1504 doc
: /* Remove some properties from text from START to END.
1505 The third argument PROPERTIES is a property list
1506 whose property names specify the properties to remove.
1507 \(The values stored in PROPERTIES are ignored.)
1508 If the optional fourth argument OBJECT is a buffer (or nil, which means
1509 the current buffer), START and END are buffer positions (integers or
1510 markers). If OBJECT is a string, START and END are 0-based indices into it.
1511 Return t if any property was actually removed, nil otherwise.
1513 Use `set-text-properties' if you want to remove all text properties. */)
1514 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1516 INTERVAL i
, unchanged
;
1519 bool first_time
= 1;
1522 XSETBUFFER (object
, current_buffer
);
1525 i
= validate_interval_range (object
, &start
, &end
, soft
);
1530 len
= XINT (end
) - s
;
1532 /* If there are no properties on this entire interval, return. */
1533 if (! interval_has_some_properties (properties
, i
))
1535 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1542 i
= next_interval (i
);
1545 while (! interval_has_some_properties (properties
, i
));
1547 /* Split away the beginning of this interval; what we don't
1549 else if (i
->position
!= s
)
1552 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1553 copy_properties (unchanged
, i
);
1556 if (BUFFERP (object
) && first_time
)
1558 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1559 ptrdiff_t prev_pos
= i
->position
;
1561 modify_region (object
, start
, end
);
1562 /* If someone called us recursively as a side effect of
1563 modify_region, and changed the intervals behind our back
1564 (could happen if lock_file, called by prepare_to_modify_buffer,
1565 triggers redisplay, and that calls add-text-properties again
1566 in the same buffer), we cannot continue with I, because its
1567 data changed. So we restart the interval analysis anew. */
1568 if (TOTAL_LENGTH (i
) != prev_total_length
1569 || i
->position
!= prev_pos
)
1576 /* We are at the beginning of an interval, with len to scan */
1581 if (LENGTH (i
) >= len
)
1583 if (! interval_has_some_properties (properties
, i
))
1586 if (BUFFERP (object
))
1587 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1588 XINT (end
) - XINT (start
));
1592 if (LENGTH (i
) == len
)
1594 remove_properties (properties
, Qnil
, i
, object
);
1595 if (BUFFERP (object
))
1596 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1597 XINT (end
) - XINT (start
));
1601 /* i has the properties, and goes past the change limit */
1603 i
= split_interval_left (i
, len
);
1604 copy_properties (unchanged
, i
);
1605 remove_properties (properties
, Qnil
, i
, object
);
1606 if (BUFFERP (object
))
1607 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1608 XINT (end
) - XINT (start
));
1613 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1614 i
= next_interval (i
);
1618 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1619 Sremove_list_of_text_properties
, 3, 4, 0,
1620 doc
: /* Remove some properties from text from START to END.
1621 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1622 If the optional fourth argument OBJECT is a buffer (or nil, which means
1623 the current buffer), START and END are buffer positions (integers or
1624 markers). If OBJECT is a string, START and END are 0-based indices into it.
1625 Return t if any property was actually removed, nil otherwise. */)
1626 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1628 INTERVAL i
, unchanged
;
1631 Lisp_Object properties
;
1632 properties
= list_of_properties
;
1635 XSETBUFFER (object
, current_buffer
);
1637 i
= validate_interval_range (object
, &start
, &end
, soft
);
1642 len
= XINT (end
) - s
;
1644 /* If there are no properties on the interval, return. */
1645 if (! interval_has_some_properties_list (properties
, i
))
1647 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1654 i
= next_interval (i
);
1657 while (! interval_has_some_properties_list (properties
, i
));
1659 /* Split away the beginning of this interval; what we don't
1661 else if (i
->position
!= s
)
1664 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1665 copy_properties (unchanged
, i
);
1668 /* We are at the beginning of an interval, with len to scan.
1669 The flag `modified' records if changes have been made.
1670 When object is a buffer, we must call modify_region before changes are
1671 made and signal_after_change when we are done.
1672 We call modify_region before calling remove_properties if modified == 0,
1673 and we call signal_after_change before returning if modified != 0. */
1678 if (LENGTH (i
) >= len
)
1680 if (! interval_has_some_properties_list (properties
, i
))
1684 if (BUFFERP (object
))
1685 signal_after_change (XINT (start
),
1686 XINT (end
) - XINT (start
),
1687 XINT (end
) - XINT (start
));
1693 else if (LENGTH (i
) == len
)
1695 if (!modified
&& BUFFERP (object
))
1696 modify_region (object
, start
, end
);
1697 remove_properties (Qnil
, properties
, i
, object
);
1698 if (BUFFERP (object
))
1699 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1700 XINT (end
) - XINT (start
));
1704 { /* i has the properties, and goes past the change limit. */
1706 i
= split_interval_left (i
, len
);
1707 copy_properties (unchanged
, i
);
1708 if (!modified
&& BUFFERP (object
))
1709 modify_region (object
, start
, end
);
1710 remove_properties (Qnil
, properties
, i
, object
);
1711 if (BUFFERP (object
))
1712 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1713 XINT (end
) - XINT (start
));
1717 if (interval_has_some_properties_list (properties
, i
))
1719 if (!modified
&& BUFFERP (object
))
1720 modify_region (object
, start
, end
);
1721 remove_properties (Qnil
, properties
, i
, object
);
1725 i
= next_interval (i
);
1729 DEFUN ("text-property-any", Ftext_property_any
,
1730 Stext_property_any
, 4, 5, 0,
1731 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1732 If so, return the position of the first character whose property PROPERTY
1733 is `eq' to VALUE. Otherwise return nil.
1734 If the optional fifth argument OBJECT is a buffer (or nil, which means
1735 the current buffer), START and END are buffer positions (integers or
1736 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1737 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1739 register INTERVAL i
;
1740 register ptrdiff_t e
, pos
;
1743 XSETBUFFER (object
, current_buffer
);
1744 i
= validate_interval_range (object
, &start
, &end
, soft
);
1746 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1751 if (i
->position
>= e
)
1753 if (EQ (textget (i
->plist
, property
), value
))
1756 if (pos
< XINT (start
))
1758 return make_number (pos
);
1760 i
= next_interval (i
);
1765 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1766 Stext_property_not_all
, 4, 5, 0,
1767 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1768 If so, return the position of the first character whose property PROPERTY
1769 is not `eq' to VALUE. Otherwise, return nil.
1770 If the optional fifth argument OBJECT is a buffer (or nil, which means
1771 the current buffer), START and END are buffer positions (integers or
1772 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1773 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1775 register INTERVAL i
;
1776 register ptrdiff_t s
, e
;
1779 XSETBUFFER (object
, current_buffer
);
1780 i
= validate_interval_range (object
, &start
, &end
, soft
);
1782 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1788 if (i
->position
>= e
)
1790 if (! EQ (textget (i
->plist
, property
), value
))
1792 if (i
->position
> s
)
1794 return make_number (s
);
1796 i
= next_interval (i
);
1802 /* Return the direction from which the text-property PROP would be
1803 inherited by any new text inserted at POS: 1 if it would be
1804 inherited from the char after POS, -1 if it would be inherited from
1805 the char before POS, and 0 if from neither.
1806 BUFFER can be either a buffer or nil (meaning current buffer). */
1809 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1811 Lisp_Object prev_pos
, front_sticky
;
1812 bool is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1813 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1816 XSETBUFFER (buffer
, current_buffer
);
1818 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1821 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1822 /* Consider previous character. */
1824 Lisp_Object rear_non_sticky
;
1826 prev_pos
= make_number (XINT (pos
) - 1);
1827 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1829 if (!NILP (CONSP (rear_non_sticky
)
1830 ? Fmemq (prop
, rear_non_sticky
)
1832 /* PROP is rear-non-sticky. */
1838 /* Consider following character. */
1839 /* This signals an arg-out-of-range error if pos is outside the
1840 buffer's accessible range. */
1841 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1843 if (EQ (front_sticky
, Qt
)
1844 || (CONSP (front_sticky
)
1845 && !NILP (Fmemq (prop
, front_sticky
))))
1846 /* PROP is inherited from after. */
1847 is_front_sticky
= 1;
1849 /* Simple cases, where the properties are consistent. */
1850 if (is_rear_sticky
&& !is_front_sticky
)
1852 else if (!is_rear_sticky
&& is_front_sticky
)
1854 else if (!is_rear_sticky
&& !is_front_sticky
)
1857 /* The stickiness properties are inconsistent, so we have to
1858 disambiguate. Basically, rear-sticky wins, _except_ if the
1859 property that would be inherited has a value of nil, in which case
1860 front-sticky wins. */
1861 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1862 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1869 /* Copying properties between objects. */
1871 /* Add properties from START to END of SRC, starting at POS in DEST.
1872 SRC and DEST may each refer to strings or buffers.
1873 Optional sixth argument PROP causes only that property to be copied.
1874 Properties are copied to DEST as if by `add-text-properties'.
1875 Return t if any property value actually changed, nil otherwise. */
1877 /* Note this can GC when DEST is a buffer. */
1880 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1886 ptrdiff_t s
, e
, e2
, p
, len
;
1888 struct gcpro gcpro1
, gcpro2
;
1890 i
= validate_interval_range (src
, &start
, &end
, soft
);
1894 CHECK_NUMBER_COERCE_MARKER (pos
);
1896 Lisp_Object dest_start
, dest_end
;
1898 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1899 if (MOST_POSITIVE_FIXNUM
< e
)
1900 args_out_of_range (pos
, end
);
1902 XSETFASTINT (dest_end
, e
);
1903 /* Apply this to a copy of pos; it will try to increment its arguments,
1904 which we don't want. */
1905 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1916 e2
= i
->position
+ LENGTH (i
);
1923 while (! NILP (plist
))
1925 if (EQ (Fcar (plist
), prop
))
1927 plist
= list2 (prop
, Fcar (Fcdr (plist
)));
1930 plist
= Fcdr (Fcdr (plist
));
1934 /* Must defer modifications to the interval tree in case src
1935 and dest refer to the same string or buffer. */
1936 stuff
= Fcons (list3 (make_number (p
), make_number (p
+ len
), plist
),
1940 i
= next_interval (i
);
1948 GCPRO2 (stuff
, dest
);
1950 while (! NILP (stuff
))
1953 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1954 Fcar (Fcdr (Fcdr (res
))), dest
);
1957 stuff
= Fcdr (stuff
);
1962 return modified
? Qt
: Qnil
;
1966 /* Return a list representing the text properties of OBJECT between
1967 START and END. if PROP is non-nil, report only on that property.
1968 Each result list element has the form (S E PLIST), where S and E
1969 are positions in OBJECT and PLIST is a property list containing the
1970 text properties of OBJECT between S and E. Value is nil if OBJECT
1971 doesn't contain text properties between START and END. */
1974 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1981 i
= validate_interval_range (object
, &start
, &end
, soft
);
1984 ptrdiff_t s
= XINT (start
);
1985 ptrdiff_t e
= XINT (end
);
1989 ptrdiff_t interval_end
, len
;
1992 interval_end
= i
->position
+ LENGTH (i
);
1993 if (interval_end
> e
)
1995 len
= interval_end
- s
;
2000 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2001 if (EQ (XCAR (plist
), prop
))
2003 plist
= list2 (prop
, Fcar (XCDR (plist
)));
2008 result
= Fcons (list3 (make_number (s
), make_number (s
+ len
),
2012 i
= next_interval (i
);
2023 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2024 (START END PLIST), where START and END are positions and PLIST is a
2025 property list containing the text properties to add. Adjust START
2026 and END positions by DELTA before adding properties. */
2029 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2031 struct gcpro gcpro1
, gcpro2
;
2033 GCPRO2 (list
, object
);
2035 for (; CONSP (list
); list
= XCDR (list
))
2037 Lisp_Object item
, start
, end
, plist
;
2040 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2041 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2042 plist
= XCAR (XCDR (XCDR (item
)));
2044 Fadd_text_properties (start
, end
, plist
, object
);
2052 /* Modify end-points of ranges in LIST destructively, and return the
2053 new list. LIST is a list as returned from text_property_list.
2054 Discard properties that begin at or after NEW_END, and limit
2055 end-points to NEW_END. */
2058 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2060 Lisp_Object prev
= Qnil
, head
= list
;
2061 ptrdiff_t max
= XINT (new_end
);
2063 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2065 Lisp_Object item
, beg
, end
;
2069 end
= XCAR (XCDR (item
));
2071 if (XINT (beg
) >= max
)
2073 /* The start-point is past the end of the new string.
2074 Discard this property. */
2075 if (EQ (head
, list
))
2078 XSETCDR (prev
, XCDR (list
));
2080 else if (XINT (end
) > max
)
2081 /* The end-point is past the end of the new string. */
2082 XSETCAR (XCDR (item
), new_end
);
2090 /* Call the modification hook functions in LIST, each with START and END. */
2093 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2095 struct gcpro gcpro1
;
2097 while (!NILP (list
))
2099 call2 (Fcar (list
), start
, end
);
2105 /* Check for read-only intervals between character positions START ... END,
2106 in BUF, and signal an error if we find one.
2108 Then check for any modification hooks in the range.
2109 Create a list of all these hooks in lexicographic order,
2110 eliminating consecutive extra copies of the same hook. Then call
2111 those hooks in order, with START and END - 1 as arguments. */
2114 verify_interval_modification (struct buffer
*buf
,
2115 ptrdiff_t start
, ptrdiff_t end
)
2117 INTERVAL intervals
= buffer_intervals (buf
);
2120 Lisp_Object prev_mod_hooks
;
2121 Lisp_Object mod_hooks
;
2122 struct gcpro gcpro1
;
2125 prev_mod_hooks
= Qnil
;
2128 interval_insert_behind_hooks
= Qnil
;
2129 interval_insert_in_front_hooks
= Qnil
;
2136 ptrdiff_t temp
= start
;
2141 /* For an insert operation, check the two chars around the position. */
2144 INTERVAL prev
= NULL
;
2145 Lisp_Object before
, after
;
2147 /* Set I to the interval containing the char after START,
2148 and PREV to the interval containing the char before START.
2149 Either one may be null. They may be equal. */
2150 i
= find_interval (intervals
, start
);
2152 if (start
== BUF_BEGV (buf
))
2154 else if (i
->position
== start
)
2155 prev
= previous_interval (i
);
2156 else if (i
->position
< start
)
2158 if (start
== BUF_ZV (buf
))
2161 /* If Vinhibit_read_only is set and is not a list, we can
2162 skip the read_only checks. */
2163 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2165 /* If I and PREV differ we need to check for the read-only
2166 property together with its stickiness. If either I or
2167 PREV are 0, this check is all we need.
2168 We have to take special care, since read-only may be
2169 indirectly defined via the category property. */
2174 after
= textget (i
->plist
, Qread_only
);
2176 /* If interval I is read-only and read-only is
2177 front-sticky, inhibit insertion.
2178 Check for read-only as well as category. */
2180 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2184 tem
= textget (i
->plist
, Qfront_sticky
);
2185 if (TMEM (Qread_only
, tem
)
2186 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2187 && TMEM (Qcategory
, tem
)))
2188 text_read_only (after
);
2194 before
= textget (prev
->plist
, Qread_only
);
2196 /* If interval PREV is read-only and read-only isn't
2197 rear-nonsticky, inhibit insertion.
2198 Check for read-only as well as category. */
2200 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2204 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2205 if (! TMEM (Qread_only
, tem
)
2206 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2207 || ! TMEM (Qcategory
, tem
)))
2208 text_read_only (before
);
2214 after
= textget (i
->plist
, Qread_only
);
2216 /* If interval I is read-only and read-only is
2217 front-sticky, inhibit insertion.
2218 Check for read-only as well as category. */
2219 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2223 tem
= textget (i
->plist
, Qfront_sticky
);
2224 if (TMEM (Qread_only
, tem
)
2225 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2226 && TMEM (Qcategory
, tem
)))
2227 text_read_only (after
);
2229 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2230 if (! TMEM (Qread_only
, tem
)
2231 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2232 || ! TMEM (Qcategory
, tem
)))
2233 text_read_only (after
);
2238 /* Run both insert hooks (just once if they're the same). */
2240 interval_insert_behind_hooks
2241 = textget (prev
->plist
, Qinsert_behind_hooks
);
2243 interval_insert_in_front_hooks
2244 = textget (i
->plist
, Qinsert_in_front_hooks
);
2248 /* Loop over intervals on or next to START...END,
2249 collecting their hooks. */
2251 i
= find_interval (intervals
, start
);
2254 if (! INTERVAL_WRITABLE_P (i
))
2255 text_read_only (textget (i
->plist
, Qread_only
));
2257 if (!inhibit_modification_hooks
)
2259 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2260 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2262 hooks
= Fcons (mod_hooks
, hooks
);
2263 prev_mod_hooks
= mod_hooks
;
2267 i
= next_interval (i
);
2269 /* Keep going thru the interval containing the char before END. */
2270 while (i
&& i
->position
< end
);
2272 if (!inhibit_modification_hooks
)
2275 hooks
= Fnreverse (hooks
);
2276 while (! EQ (hooks
, Qnil
))
2278 call_mod_hooks (Fcar (hooks
), make_number (start
),
2280 hooks
= Fcdr (hooks
);
2287 /* Run the interval hooks for an insertion on character range START ... END.
2288 verify_interval_modification chose which hooks to run;
2289 this function is called after the insertion happens
2290 so it can indicate the range of inserted text. */
2293 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2295 if (! NILP (interval_insert_behind_hooks
))
2296 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2297 if (! NILP (interval_insert_in_front_hooks
)
2298 && ! EQ (interval_insert_in_front_hooks
,
2299 interval_insert_behind_hooks
))
2300 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2304 syms_of_textprop (void)
2306 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2307 doc
: /* Property-list used as default values.
2308 The value of a property in this list is seen as the value for every
2309 character that does not have its own value for that property. */);
2310 Vdefault_text_properties
= Qnil
;
2312 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2313 doc
: /* Alist of alternative properties for properties without a value.
2314 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2315 If a piece of text has no direct value for a particular property, then
2316 this alist is consulted. If that property appears in the alist, then
2317 the first non-nil value from the associated alternative properties is
2319 Vchar_property_alias_alist
= Qnil
;
2321 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2322 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2323 This also inhibits the use of the `intangible' text property. */);
2324 Vinhibit_point_motion_hooks
= Qnil
;
2326 DEFVAR_LISP ("text-property-default-nonsticky",
2327 Vtext_property_default_nonsticky
,
2328 doc
: /* Alist of properties vs the corresponding non-stickiness.
2329 Each element has the form (PROPERTY . NONSTICKINESS).
2331 If a character in a buffer has PROPERTY, new text inserted adjacent to
2332 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2333 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2334 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2335 /* Text properties `syntax-table'and `display' should be nonsticky
2337 Vtext_property_default_nonsticky
2338 = list2 (Fcons (intern_c_string ("syntax-table"), Qt
),
2339 Fcons (intern_c_string ("display"), Qt
));
2341 staticpro (&interval_insert_behind_hooks
);
2342 staticpro (&interval_insert_in_front_hooks
);
2343 interval_insert_behind_hooks
= Qnil
;
2344 interval_insert_in_front_hooks
= Qnil
;
2347 /* Common attributes one might give text */
2349 DEFSYM (Qforeground
, "foreground");
2350 DEFSYM (Qbackground
, "background");
2351 DEFSYM (Qfont
, "font");
2352 DEFSYM (Qface
, "face");
2353 DEFSYM (Qstipple
, "stipple");
2354 DEFSYM (Qunderline
, "underline");
2355 DEFSYM (Qread_only
, "read-only");
2356 DEFSYM (Qinvisible
, "invisible");
2357 DEFSYM (Qintangible
, "intangible");
2358 DEFSYM (Qcategory
, "category");
2359 DEFSYM (Qlocal_map
, "local-map");
2360 DEFSYM (Qfront_sticky
, "front-sticky");
2361 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2362 DEFSYM (Qmouse_face
, "mouse-face");
2363 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2365 /* Properties that text might use to specify certain actions */
2367 DEFSYM (Qmouse_left
, "mouse-left");
2368 DEFSYM (Qmouse_entered
, "mouse-entered");
2369 DEFSYM (Qpoint_left
, "point-left");
2370 DEFSYM (Qpoint_entered
, "point-entered");
2372 defsubr (&Stext_properties_at
);
2373 defsubr (&Sget_text_property
);
2374 defsubr (&Sget_char_property
);
2375 defsubr (&Sget_char_property_and_overlay
);
2376 defsubr (&Snext_char_property_change
);
2377 defsubr (&Sprevious_char_property_change
);
2378 defsubr (&Snext_single_char_property_change
);
2379 defsubr (&Sprevious_single_char_property_change
);
2380 defsubr (&Snext_property_change
);
2381 defsubr (&Snext_single_property_change
);
2382 defsubr (&Sprevious_property_change
);
2383 defsubr (&Sprevious_single_property_change
);
2384 defsubr (&Sadd_text_properties
);
2385 defsubr (&Sput_text_property
);
2386 defsubr (&Sset_text_properties
);
2387 defsubr (&Sadd_face_text_property
);
2388 defsubr (&Sremove_text_properties
);
2389 defsubr (&Sremove_list_of_text_properties
);
2390 defsubr (&Stext_property_any
);
2391 defsubr (&Stext_property_not_all
);