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 Fcons (list
, Fcons (Qnil
, 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
), Fcons (val1
, Qnil
));
441 /* The previous value is a single value, so make it
443 if (set_type
== TEXT_PROPERTY_PREPEND
)
445 Fcons (val1
, Fcons (Fcar (this_cdr
), Qnil
)));
448 Fcons (Fcar (this_cdr
), Fcons (val1
, Qnil
)));
457 /* Record this change in the buffer, for undo purposes. */
458 if (BUFFERP (object
))
460 record_property_change (i
->position
, LENGTH (i
),
463 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
473 /* For any members of PLIST, or LIST,
474 which are properties of I, remove them from I's plist.
475 (If PLIST is non-nil, use that, otherwise use LIST.)
476 OBJECT is the string or buffer containing I. */
479 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
481 Lisp_Object tail1
, tail2
, sym
, current_plist
;
484 /* True means tail1 is a plist, otherwise it is a list. */
487 current_plist
= i
->plist
;
490 tail1
= plist
, use_plist
= 1;
492 tail1
= list
, use_plist
= 0;
494 /* Go through each element of LIST or PLIST. */
495 while (CONSP (tail1
))
499 /* First, remove the symbol if it's at the head of the list */
500 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
502 if (BUFFERP (object
))
503 record_property_change (i
->position
, LENGTH (i
),
504 sym
, XCAR (XCDR (current_plist
)),
507 current_plist
= XCDR (XCDR (current_plist
));
511 /* Go through I's plist, looking for SYM. */
512 tail2
= current_plist
;
513 while (! NILP (tail2
))
515 register Lisp_Object
this;
516 this = XCDR (XCDR (tail2
));
517 if (CONSP (this) && EQ (sym
, XCAR (this)))
519 if (BUFFERP (object
))
520 record_property_change (i
->position
, LENGTH (i
),
521 sym
, XCAR (XCDR (this)), object
);
523 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
529 /* Advance thru TAIL1 one way or the other. */
530 tail1
= XCDR (tail1
);
531 if (use_plist
&& CONSP (tail1
))
532 tail1
= XCDR (tail1
);
536 set_interval_plist (i
, current_plist
);
540 /* Returns the interval of POSITION in OBJECT.
541 POSITION is BEG-based. */
544 interval_of (ptrdiff_t position
, Lisp_Object object
)
550 XSETBUFFER (object
, current_buffer
);
551 else if (EQ (object
, Qt
))
554 CHECK_STRING_OR_BUFFER (object
);
556 if (BUFFERP (object
))
558 register struct buffer
*b
= XBUFFER (object
);
562 i
= buffer_intervals (b
);
567 end
= SCHARS (object
);
568 i
= string_intervals (object
);
571 if (!(beg
<= position
&& position
<= end
))
572 args_out_of_range (make_number (position
), make_number (position
));
573 if (beg
== end
|| !i
)
576 return find_interval (i
, position
);
579 DEFUN ("text-properties-at", Ftext_properties_at
,
580 Stext_properties_at
, 1, 2, 0,
581 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
582 If the optional second argument OBJECT is a buffer (or nil, which means
583 the current buffer), POSITION is a buffer position (integer or marker).
584 If OBJECT is a string, POSITION is a 0-based index into it.
585 If POSITION is at the end of OBJECT, the value is nil. */)
586 (Lisp_Object position
, Lisp_Object object
)
591 XSETBUFFER (object
, current_buffer
);
593 i
= validate_interval_range (object
, &position
, &position
, soft
);
596 /* If POSITION is at the end of the interval,
597 it means it's the end of OBJECT.
598 There are no properties at the very end,
599 since no character follows. */
600 if (XINT (position
) == LENGTH (i
) + i
->position
)
606 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
607 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
608 OBJECT should be a buffer or a string; if omitted or nil, it defaults
609 to the current buffer.
610 If POSITION is at the end of OBJECT, the value is nil. */)
611 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
613 return textget (Ftext_properties_at (position
, object
), prop
);
616 /* Return the value of char's property PROP, in OBJECT at POSITION.
617 OBJECT is optional and defaults to the current buffer.
618 If OVERLAY is non-0, then in the case that the returned property is from
619 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
620 returned in *OVERLAY.
621 If POSITION is at the end of OBJECT, the value is nil.
622 If OBJECT is a buffer, then overlay properties are considered as well as
624 If OBJECT is a window, then that window's buffer is used, but
625 window-specific overlays are considered only if they are associated
628 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
630 struct window
*w
= 0;
632 CHECK_NUMBER_COERCE_MARKER (position
);
635 XSETBUFFER (object
, current_buffer
);
637 if (WINDOWP (object
))
639 CHECK_LIVE_WINDOW (object
);
640 w
= XWINDOW (object
);
641 object
= w
->contents
;
643 if (BUFFERP (object
))
646 Lisp_Object
*overlay_vec
;
647 struct buffer
*obuf
= current_buffer
;
649 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
650 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
651 xsignal1 (Qargs_out_of_range
, position
);
653 set_buffer_temp (XBUFFER (object
));
655 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
656 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
658 set_buffer_temp (obuf
);
660 /* Now check the overlays in order of decreasing priority. */
661 while (--noverlays
>= 0)
663 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
667 /* Return the overlay we got the property from. */
668 *overlay
= overlay_vec
[noverlays
];
675 /* Indicate that the return value is not from an overlay. */
678 /* Not a buffer, or no appropriate overlay, so fall through to the
680 return Fget_text_property (position
, prop
, object
);
683 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
684 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
685 Both overlay properties and text properties are checked.
686 OBJECT is optional and defaults to the current buffer.
687 If POSITION is at the end of OBJECT, the value is nil.
688 If OBJECT is a buffer, then overlay properties are considered as well as
690 If OBJECT is a window, then that window's buffer is used, but window-specific
691 overlays are considered only if they are associated with OBJECT. */)
692 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
694 return get_char_property_and_overlay (position
, prop
, object
, 0);
697 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
698 Sget_char_property_and_overlay
, 2, 3, 0,
699 doc
: /* Like `get-char-property', but with extra overlay information.
700 The value is a cons cell. Its car is the return value of `get-char-property'
701 with the same arguments--that is, the value of POSITION's property
702 PROP in OBJECT. Its cdr is the overlay in which the property was
703 found, or nil, if it was found as a text property or not found at all.
705 OBJECT is optional and defaults to the current buffer. OBJECT may be
706 a string, a buffer or a window. For strings, the cdr of the return
707 value is always nil, since strings do not have overlays. If OBJECT is
708 a window, then that window's buffer is used, but window-specific
709 overlays are considered only if they are associated with OBJECT. If
710 POSITION is at the end of OBJECT, both car and cdr are nil. */)
711 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
715 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
716 return Fcons (val
, overlay
);
720 DEFUN ("next-char-property-change", Fnext_char_property_change
,
721 Snext_char_property_change
, 1, 2, 0,
722 doc
: /* Return the position of next text property or overlay change.
723 This scans characters forward in the current buffer from POSITION till
724 it finds a change in some text property, or the beginning or end of an
725 overlay, and returns the position of that.
726 If none is found up to (point-max), the function returns (point-max).
728 If the optional second argument LIMIT is non-nil, don't search
729 past position LIMIT; return LIMIT if nothing is found before LIMIT.
730 LIMIT is a no-op if it is greater than (point-max). */)
731 (Lisp_Object position
, Lisp_Object limit
)
735 temp
= Fnext_overlay_change (position
);
738 CHECK_NUMBER_COERCE_MARKER (limit
);
739 if (XINT (limit
) < XINT (temp
))
742 return Fnext_property_change (position
, Qnil
, temp
);
745 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
746 Sprevious_char_property_change
, 1, 2, 0,
747 doc
: /* Return the position of previous text property or overlay change.
748 Scans characters backward in the current buffer from POSITION till it
749 finds a change in some text property, or the beginning or end of an
750 overlay, and returns the position of that.
751 If none is found since (point-min), the function returns (point-min).
753 If the optional second argument LIMIT is non-nil, don't search
754 past position LIMIT; return LIMIT if nothing is found before LIMIT.
755 LIMIT is a no-op if it is less than (point-min). */)
756 (Lisp_Object position
, Lisp_Object limit
)
760 temp
= Fprevious_overlay_change (position
);
763 CHECK_NUMBER_COERCE_MARKER (limit
);
764 if (XINT (limit
) > XINT (temp
))
767 return Fprevious_property_change (position
, Qnil
, temp
);
771 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
772 Snext_single_char_property_change
, 2, 4, 0,
773 doc
: /* Return the position of next text property or overlay change for a specific property.
774 Scans characters forward from POSITION till it finds
775 a change in the PROP property, then returns the position of the change.
776 If the optional third argument OBJECT is a buffer (or nil, which means
777 the current buffer), POSITION is a buffer position (integer or marker).
778 If OBJECT is a string, POSITION is a 0-based index into it.
780 In a string, scan runs to the end of the string.
781 In a buffer, it runs to (point-max), and the value cannot exceed that.
783 The property values are compared with `eq'.
784 If the property is constant all the way to the end of OBJECT, return the
785 last valid position in OBJECT.
786 If the optional fourth argument LIMIT is non-nil, don't search
787 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
788 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
790 if (STRINGP (object
))
792 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
796 position
= make_number (SCHARS (object
));
799 CHECK_NUMBER (limit
);
806 Lisp_Object initial_value
, value
;
807 ptrdiff_t count
= SPECPDL_INDEX ();
810 CHECK_BUFFER (object
);
812 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
814 record_unwind_current_buffer ();
815 Fset_buffer (object
);
818 CHECK_NUMBER_COERCE_MARKER (position
);
820 initial_value
= Fget_char_property (position
, prop
, object
);
823 XSETFASTINT (limit
, ZV
);
825 CHECK_NUMBER_COERCE_MARKER (limit
);
827 if (XFASTINT (position
) >= XFASTINT (limit
))
830 if (XFASTINT (position
) > ZV
)
831 XSETFASTINT (position
, ZV
);
836 position
= Fnext_char_property_change (position
, limit
);
837 if (XFASTINT (position
) >= XFASTINT (limit
))
843 value
= Fget_char_property (position
, prop
, object
);
844 if (!EQ (value
, initial_value
))
848 unbind_to (count
, Qnil
);
854 DEFUN ("previous-single-char-property-change",
855 Fprevious_single_char_property_change
,
856 Sprevious_single_char_property_change
, 2, 4, 0,
857 doc
: /* Return the position of previous text property or overlay change for a specific property.
858 Scans characters backward from POSITION till it finds
859 a change in the PROP property, then returns the position of the change.
860 If the optional third argument OBJECT is a buffer (or nil, which means
861 the current buffer), POSITION is a buffer position (integer or marker).
862 If OBJECT is a string, POSITION is a 0-based index into it.
864 In a string, scan runs to the start of the string.
865 In a buffer, it runs to (point-min), and the value cannot be less than that.
867 The property values are compared with `eq'.
868 If the property is constant all the way to the start of OBJECT, return the
869 first valid position in OBJECT.
870 If the optional fourth argument LIMIT is non-nil, don't search back past
871 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
872 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
874 if (STRINGP (object
))
876 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
880 position
= make_number (0);
883 CHECK_NUMBER (limit
);
890 ptrdiff_t count
= SPECPDL_INDEX ();
893 CHECK_BUFFER (object
);
895 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
897 record_unwind_current_buffer ();
898 Fset_buffer (object
);
901 CHECK_NUMBER_COERCE_MARKER (position
);
904 XSETFASTINT (limit
, BEGV
);
906 CHECK_NUMBER_COERCE_MARKER (limit
);
908 if (XFASTINT (position
) <= XFASTINT (limit
))
911 if (XFASTINT (position
) < BEGV
)
912 XSETFASTINT (position
, BEGV
);
916 Lisp_Object initial_value
917 = Fget_char_property (make_number (XFASTINT (position
) - 1),
922 position
= Fprevious_char_property_change (position
, limit
);
924 if (XFASTINT (position
) <= XFASTINT (limit
))
932 = Fget_char_property (make_number (XFASTINT (position
) - 1),
935 if (!EQ (value
, initial_value
))
941 unbind_to (count
, Qnil
);
947 DEFUN ("next-property-change", Fnext_property_change
,
948 Snext_property_change
, 1, 3, 0,
949 doc
: /* Return the position of next property change.
950 Scans characters forward from POSITION in OBJECT till it finds
951 a change in some text property, then returns the position of the change.
952 If the optional second argument OBJECT is a buffer (or nil, which means
953 the current buffer), POSITION is a buffer position (integer or marker).
954 If OBJECT is a string, POSITION is a 0-based index into it.
955 Return nil if the property is constant all the way to the end of OBJECT.
956 If the value is non-nil, it is a position greater than POSITION, never equal.
958 If the optional third argument LIMIT is non-nil, don't search
959 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
960 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
962 register INTERVAL i
, next
;
965 XSETBUFFER (object
, current_buffer
);
967 if (!NILP (limit
) && !EQ (limit
, Qt
))
968 CHECK_NUMBER_COERCE_MARKER (limit
);
970 i
= validate_interval_range (object
, &position
, &position
, soft
);
972 /* If LIMIT is t, return start of next interval--don't
973 bother checking further intervals. */
979 next
= next_interval (i
);
982 XSETFASTINT (position
, (STRINGP (object
)
984 : BUF_ZV (XBUFFER (object
))));
986 XSETFASTINT (position
, next
->position
);
993 next
= next_interval (i
);
995 while (next
&& intervals_equal (i
, next
)
996 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
997 next
= next_interval (next
);
1001 >= (INTEGERP (limit
)
1005 : BUF_ZV (XBUFFER (object
))))))
1008 return make_number (next
->position
);
1011 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1012 Snext_single_property_change
, 2, 4, 0,
1013 doc
: /* Return the position of next property change for a specific property.
1014 Scans characters forward from POSITION till it finds
1015 a change in the PROP property, then returns the position of the change.
1016 If the optional third argument OBJECT is a buffer (or nil, which means
1017 the current buffer), POSITION is a buffer position (integer or marker).
1018 If OBJECT is a string, POSITION is a 0-based index into it.
1019 The property values are compared with `eq'.
1020 Return nil if the property is constant all the way to the end of OBJECT.
1021 If the value is non-nil, it is a position greater than POSITION, never equal.
1023 If the optional fourth argument LIMIT is non-nil, don't search
1024 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1025 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1027 register INTERVAL i
, next
;
1028 register Lisp_Object here_val
;
1031 XSETBUFFER (object
, current_buffer
);
1034 CHECK_NUMBER_COERCE_MARKER (limit
);
1036 i
= validate_interval_range (object
, &position
, &position
, soft
);
1040 here_val
= textget (i
->plist
, prop
);
1041 next
= next_interval (i
);
1043 && EQ (here_val
, textget (next
->plist
, prop
))
1044 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1045 next
= next_interval (next
);
1049 >= (INTEGERP (limit
)
1053 : BUF_ZV (XBUFFER (object
))))))
1056 return make_number (next
->position
);
1059 DEFUN ("previous-property-change", Fprevious_property_change
,
1060 Sprevious_property_change
, 1, 3, 0,
1061 doc
: /* Return the position of previous property change.
1062 Scans characters backwards from POSITION in OBJECT till it finds
1063 a change in some text property, then returns the position of the change.
1064 If the optional second argument OBJECT is a buffer (or nil, which means
1065 the current buffer), POSITION is a buffer position (integer or marker).
1066 If OBJECT is a string, POSITION is a 0-based index into it.
1067 Return nil if the property is constant all the way to the start of OBJECT.
1068 If the value is non-nil, it is a position less than POSITION, never equal.
1070 If the optional third argument LIMIT is non-nil, don't search
1071 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1072 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1074 register INTERVAL i
, previous
;
1077 XSETBUFFER (object
, current_buffer
);
1080 CHECK_NUMBER_COERCE_MARKER (limit
);
1082 i
= validate_interval_range (object
, &position
, &position
, soft
);
1086 /* Start with the interval containing the char before point. */
1087 if (i
->position
== XFASTINT (position
))
1088 i
= previous_interval (i
);
1090 previous
= previous_interval (i
);
1091 while (previous
&& intervals_equal (previous
, i
)
1093 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1094 previous
= previous_interval (previous
);
1097 || (previous
->position
+ LENGTH (previous
)
1098 <= (INTEGERP (limit
)
1100 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1103 return make_number (previous
->position
+ LENGTH (previous
));
1106 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1107 Sprevious_single_property_change
, 2, 4, 0,
1108 doc
: /* Return the position of previous property change for a specific property.
1109 Scans characters backward from POSITION till it finds
1110 a change in the PROP property, then returns the position of the change.
1111 If the optional third argument OBJECT is a buffer (or nil, which means
1112 the current buffer), POSITION is a buffer position (integer or marker).
1113 If OBJECT is a string, POSITION is a 0-based index into it.
1114 The property values are compared with `eq'.
1115 Return nil if the property is constant all the way to the start of OBJECT.
1116 If the value is non-nil, it is a position less than POSITION, never equal.
1118 If the optional fourth argument LIMIT is non-nil, don't search
1119 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1120 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1122 register INTERVAL i
, previous
;
1123 register Lisp_Object here_val
;
1126 XSETBUFFER (object
, current_buffer
);
1129 CHECK_NUMBER_COERCE_MARKER (limit
);
1131 i
= validate_interval_range (object
, &position
, &position
, soft
);
1133 /* Start with the interval containing the char before point. */
1134 if (i
&& i
->position
== XFASTINT (position
))
1135 i
= previous_interval (i
);
1140 here_val
= textget (i
->plist
, prop
);
1141 previous
= previous_interval (i
);
1143 && EQ (here_val
, textget (previous
->plist
, prop
))
1145 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1146 previous
= previous_interval (previous
);
1149 || (previous
->position
+ LENGTH (previous
)
1150 <= (INTEGERP (limit
)
1152 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1155 return make_number (previous
->position
+ LENGTH (previous
));
1158 /* Used by add-text-properties and add-face-text-property. */
1161 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1162 Lisp_Object properties
, Lisp_Object object
,
1163 enum property_set_type set_type
) {
1164 INTERVAL i
, unchanged
;
1167 struct gcpro gcpro1
;
1168 bool first_time
= 1;
1170 properties
= validate_plist (properties
);
1171 if (NILP (properties
))
1175 XSETBUFFER (object
, current_buffer
);
1178 i
= validate_interval_range (object
, &start
, &end
, hard
);
1183 len
= XINT (end
) - s
;
1185 /* No need to protect OBJECT, because we GC only if it's a buffer,
1186 and live buffers are always protected. */
1187 GCPRO1 (properties
);
1189 /* If this interval already has the properties, we can skip it. */
1190 if (interval_has_all_properties (properties
, i
))
1192 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1197 RETURN_UNGCPRO (Qnil
);
1199 i
= next_interval (i
);
1202 while (interval_has_all_properties (properties
, i
));
1204 else if (i
->position
!= s
)
1206 /* If we're not starting on an interval boundary, we have to
1207 split this interval. */
1209 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1210 copy_properties (unchanged
, i
);
1213 if (BUFFERP (object
) && first_time
)
1215 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1216 ptrdiff_t prev_pos
= i
->position
;
1218 modify_region (object
, start
, end
);
1219 /* If someone called us recursively as a side effect of
1220 modify_region, and changed the intervals behind our back
1221 (could happen if lock_file, called by prepare_to_modify_buffer,
1222 triggers redisplay, and that calls add-text-properties again
1223 in the same buffer), we cannot continue with I, because its
1224 data changed. So we restart the interval analysis anew. */
1225 if (TOTAL_LENGTH (i
) != prev_total_length
1226 || i
->position
!= prev_pos
)
1233 /* We are at the beginning of interval I, with LEN chars to scan. */
1238 if (LENGTH (i
) >= len
)
1240 /* We can UNGCPRO safely here, because there will be just
1241 one more chance to gc, in the next call to add_properties,
1242 and after that we will not need PROPERTIES or OBJECT again. */
1245 if (interval_has_all_properties (properties
, i
))
1247 if (BUFFERP (object
))
1248 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1249 XINT (end
) - XINT (start
));
1255 if (LENGTH (i
) == len
)
1257 add_properties (properties
, i
, object
, set_type
);
1258 if (BUFFERP (object
))
1259 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1260 XINT (end
) - XINT (start
));
1264 /* i doesn't have the properties, and goes past the change limit */
1266 i
= split_interval_left (unchanged
, len
);
1267 copy_properties (unchanged
, i
);
1268 add_properties (properties
, i
, object
, set_type
);
1269 if (BUFFERP (object
))
1270 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1271 XINT (end
) - XINT (start
));
1276 modified
|= add_properties (properties
, i
, object
, set_type
);
1277 i
= next_interval (i
);
1281 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1283 DEFUN ("add-text-properties", Fadd_text_properties
,
1284 Sadd_text_properties
, 3, 4, 0,
1285 doc
: /* Add properties to the text from START to END.
1286 The third argument PROPERTIES is a property list
1287 specifying the property values to add. If the optional fourth argument
1288 OBJECT is a buffer (or nil, which means the current buffer),
1289 START and END are buffer positions (integers or markers).
1290 If OBJECT is a string, START and END are 0-based indices into it.
1291 Return t if any property value actually changed, nil otherwise. */)
1292 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1295 return add_text_properties_1 (start
, end
, properties
, object
,
1296 TEXT_PROPERTY_REPLACE
);
1299 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1301 DEFUN ("put-text-property", Fput_text_property
,
1302 Sput_text_property
, 4, 5, 0,
1303 doc
: /* Set one property of the text from START to END.
1304 The third and fourth arguments PROPERTY and VALUE
1305 specify the property to add.
1306 If the optional fifth argument OBJECT is a buffer (or nil, which means
1307 the current buffer), START and END are buffer positions (integers or
1308 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1309 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1311 Fadd_text_properties (start
, end
,
1312 Fcons (property
, Fcons (value
, Qnil
)),
1317 DEFUN ("set-text-properties", Fset_text_properties
,
1318 Sset_text_properties
, 3, 4, 0,
1319 doc
: /* Completely replace properties of text from START to END.
1320 The third argument PROPERTIES is the new property list.
1321 If the optional fourth argument OBJECT is a buffer (or nil, which means
1322 the current buffer), START and END are buffer positions (integers or
1323 markers). If OBJECT is a string, START and END are 0-based indices into it.
1324 If PROPERTIES is nil, the effect is to remove all properties from
1325 the designated part of OBJECT. */)
1326 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1328 return set_text_properties (start
, end
, properties
, object
, Qt
);
1332 DEFUN ("add-face-text-property", Fadd_face_text_property
,
1333 Sadd_face_text_property
, 3, 5, 0,
1334 doc
: /* Add the face property to the text from START to END.
1335 The third argument FACE specifies the face to add.
1336 If any text in the region already has any face properties, this new
1337 face property will be added to the front of the face property list.
1338 If the optional fourth argument APPENDP is non-nil, append to the end
1339 of the face property list instead.
1340 If the optional fifth argument OBJECT is a buffer (or nil, which means
1341 the current buffer), START and END are buffer positions (integers or
1342 markers). If OBJECT is a string, START and END are 0-based indices
1344 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1345 Lisp_Object appendp
, Lisp_Object object
)
1347 add_text_properties_1 (start
, end
,
1348 Fcons (Qface
, Fcons (face
, Qnil
)),
1350 NILP (appendp
)? TEXT_PROPERTY_PREPEND
:
1351 TEXT_PROPERTY_APPEND
);
1355 /* Replace properties of text from START to END with new list of
1356 properties PROPERTIES. OBJECT is the buffer or string containing
1357 the text. OBJECT nil means use the current buffer.
1358 COHERENT_CHANGE_P nil means this is being called as an internal
1359 subroutine, rather than as a change primitive with checking of
1360 read-only, invoking change hooks, etc.. Value is nil if the
1361 function _detected_ that it did not replace any properties, non-nil
1365 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1367 register INTERVAL i
;
1368 Lisp_Object ostart
, oend
;
1373 properties
= validate_plist (properties
);
1376 XSETBUFFER (object
, current_buffer
);
1378 /* If we want no properties for a whole string,
1379 get rid of its intervals. */
1380 if (NILP (properties
) && STRINGP (object
)
1381 && XFASTINT (start
) == 0
1382 && XFASTINT (end
) == SCHARS (object
))
1384 if (!string_intervals (object
))
1387 set_string_intervals (object
, NULL
);
1391 i
= validate_interval_range (object
, &start
, &end
, soft
);
1395 /* If buffer has no properties, and we want none, return now. */
1396 if (NILP (properties
))
1399 /* Restore the original START and END values
1400 because validate_interval_range increments them for strings. */
1404 i
= validate_interval_range (object
, &start
, &end
, hard
);
1405 /* This can return if start == end. */
1410 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1411 modify_region (object
, start
, end
);
1413 set_text_properties_1 (start
, end
, properties
, object
, i
);
1415 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1416 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1417 XINT (end
) - XINT (start
));
1421 /* Replace properties of text from START to END with new list of
1422 properties PROPERTIES. OBJECT is the buffer or string containing
1423 the text. This does not obey any hooks.
1424 You should provide the interval that START is located in as I.
1425 START and END can be in any order. */
1428 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1430 register INTERVAL prev_changed
= NULL
;
1431 register ptrdiff_t s
, len
;
1434 if (XINT (start
) < XINT (end
))
1437 len
= XINT (end
) - s
;
1439 else if (XINT (end
) < XINT (start
))
1442 len
= XINT (start
) - s
;
1449 if (i
->position
!= s
)
1452 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1454 if (LENGTH (i
) > len
)
1456 copy_properties (unchanged
, i
);
1457 i
= split_interval_left (i
, len
);
1458 set_properties (properties
, i
, object
);
1462 set_properties (properties
, i
, object
);
1464 if (LENGTH (i
) == len
)
1469 i
= next_interval (i
);
1472 /* We are starting at the beginning of an interval I. LEN is positive. */
1477 if (LENGTH (i
) >= len
)
1479 if (LENGTH (i
) > len
)
1480 i
= split_interval_left (i
, len
);
1482 /* We have to call set_properties even if we are going to
1483 merge the intervals, so as to make the undo records
1484 and cause redisplay to happen. */
1485 set_properties (properties
, i
, object
);
1487 merge_interval_left (i
);
1493 /* We have to call set_properties even if we are going to
1494 merge the intervals, so as to make the undo records
1495 and cause redisplay to happen. */
1496 set_properties (properties
, i
, object
);
1500 prev_changed
= i
= merge_interval_left (i
);
1502 i
= next_interval (i
);
1507 DEFUN ("remove-text-properties", Fremove_text_properties
,
1508 Sremove_text_properties
, 3, 4, 0,
1509 doc
: /* Remove some properties from text from START to END.
1510 The third argument PROPERTIES is a property list
1511 whose property names specify the properties to remove.
1512 \(The values stored in PROPERTIES are ignored.)
1513 If the optional fourth argument OBJECT is a buffer (or nil, which means
1514 the current buffer), START and END are buffer positions (integers or
1515 markers). If OBJECT is a string, START and END are 0-based indices into it.
1516 Return t if any property was actually removed, nil otherwise.
1518 Use `set-text-properties' if you want to remove all text properties. */)
1519 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1521 INTERVAL i
, unchanged
;
1524 bool first_time
= 1;
1527 XSETBUFFER (object
, current_buffer
);
1530 i
= validate_interval_range (object
, &start
, &end
, soft
);
1535 len
= XINT (end
) - s
;
1537 /* If there are no properties on this entire interval, return. */
1538 if (! interval_has_some_properties (properties
, i
))
1540 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1547 i
= next_interval (i
);
1550 while (! interval_has_some_properties (properties
, i
));
1552 /* Split away the beginning of this interval; what we don't
1554 else if (i
->position
!= s
)
1557 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1558 copy_properties (unchanged
, i
);
1561 if (BUFFERP (object
) && first_time
)
1563 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1564 ptrdiff_t prev_pos
= i
->position
;
1566 modify_region (object
, start
, end
);
1567 /* If someone called us recursively as a side effect of
1568 modify_region, and changed the intervals behind our back
1569 (could happen if lock_file, called by prepare_to_modify_buffer,
1570 triggers redisplay, and that calls add-text-properties again
1571 in the same buffer), we cannot continue with I, because its
1572 data changed. So we restart the interval analysis anew. */
1573 if (TOTAL_LENGTH (i
) != prev_total_length
1574 || i
->position
!= prev_pos
)
1581 /* We are at the beginning of an interval, with len to scan */
1586 if (LENGTH (i
) >= len
)
1588 if (! interval_has_some_properties (properties
, i
))
1591 if (BUFFERP (object
))
1592 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1593 XINT (end
) - XINT (start
));
1597 if (LENGTH (i
) == len
)
1599 remove_properties (properties
, Qnil
, i
, object
);
1600 if (BUFFERP (object
))
1601 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1602 XINT (end
) - XINT (start
));
1606 /* i has the properties, and goes past the change limit */
1608 i
= split_interval_left (i
, len
);
1609 copy_properties (unchanged
, i
);
1610 remove_properties (properties
, Qnil
, i
, object
);
1611 if (BUFFERP (object
))
1612 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1613 XINT (end
) - XINT (start
));
1618 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1619 i
= next_interval (i
);
1623 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1624 Sremove_list_of_text_properties
, 3, 4, 0,
1625 doc
: /* Remove some properties from text from START to END.
1626 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1627 If the optional fourth argument OBJECT is a buffer (or nil, which means
1628 the current buffer), START and END are buffer positions (integers or
1629 markers). If OBJECT is a string, START and END are 0-based indices into it.
1630 Return t if any property was actually removed, nil otherwise. */)
1631 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1633 INTERVAL i
, unchanged
;
1636 Lisp_Object properties
;
1637 properties
= list_of_properties
;
1640 XSETBUFFER (object
, current_buffer
);
1642 i
= validate_interval_range (object
, &start
, &end
, soft
);
1647 len
= XINT (end
) - s
;
1649 /* If there are no properties on the interval, return. */
1650 if (! interval_has_some_properties_list (properties
, i
))
1652 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1659 i
= next_interval (i
);
1662 while (! interval_has_some_properties_list (properties
, i
));
1664 /* Split away the beginning of this interval; what we don't
1666 else if (i
->position
!= s
)
1669 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1670 copy_properties (unchanged
, i
);
1673 /* We are at the beginning of an interval, with len to scan.
1674 The flag `modified' records if changes have been made.
1675 When object is a buffer, we must call modify_region before changes are
1676 made and signal_after_change when we are done.
1677 We call modify_region before calling remove_properties if modified == 0,
1678 and we call signal_after_change before returning if modified != 0. */
1683 if (LENGTH (i
) >= len
)
1685 if (! interval_has_some_properties_list (properties
, i
))
1689 if (BUFFERP (object
))
1690 signal_after_change (XINT (start
),
1691 XINT (end
) - XINT (start
),
1692 XINT (end
) - XINT (start
));
1698 else if (LENGTH (i
) == len
)
1700 if (!modified
&& BUFFERP (object
))
1701 modify_region (object
, start
, end
);
1702 remove_properties (Qnil
, properties
, i
, object
);
1703 if (BUFFERP (object
))
1704 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1705 XINT (end
) - XINT (start
));
1709 { /* i has the properties, and goes past the change limit. */
1711 i
= split_interval_left (i
, len
);
1712 copy_properties (unchanged
, i
);
1713 if (!modified
&& BUFFERP (object
))
1714 modify_region (object
, start
, end
);
1715 remove_properties (Qnil
, properties
, i
, object
);
1716 if (BUFFERP (object
))
1717 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1718 XINT (end
) - XINT (start
));
1722 if (interval_has_some_properties_list (properties
, i
))
1724 if (!modified
&& BUFFERP (object
))
1725 modify_region (object
, start
, end
);
1726 remove_properties (Qnil
, properties
, i
, object
);
1730 i
= next_interval (i
);
1734 DEFUN ("text-property-any", Ftext_property_any
,
1735 Stext_property_any
, 4, 5, 0,
1736 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1737 If so, return the position of the first character whose property PROPERTY
1738 is `eq' to VALUE. Otherwise return nil.
1739 If the optional fifth argument OBJECT is a buffer (or nil, which means
1740 the current buffer), START and END are buffer positions (integers or
1741 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1742 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1744 register INTERVAL i
;
1745 register ptrdiff_t e
, pos
;
1748 XSETBUFFER (object
, current_buffer
);
1749 i
= validate_interval_range (object
, &start
, &end
, soft
);
1751 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1756 if (i
->position
>= e
)
1758 if (EQ (textget (i
->plist
, property
), value
))
1761 if (pos
< XINT (start
))
1763 return make_number (pos
);
1765 i
= next_interval (i
);
1770 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1771 Stext_property_not_all
, 4, 5, 0,
1772 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1773 If so, return the position of the first character whose property PROPERTY
1774 is not `eq' to VALUE. Otherwise, return nil.
1775 If the optional fifth argument OBJECT is a buffer (or nil, which means
1776 the current buffer), START and END are buffer positions (integers or
1777 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1778 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1780 register INTERVAL i
;
1781 register ptrdiff_t s
, e
;
1784 XSETBUFFER (object
, current_buffer
);
1785 i
= validate_interval_range (object
, &start
, &end
, soft
);
1787 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1793 if (i
->position
>= e
)
1795 if (! EQ (textget (i
->plist
, property
), value
))
1797 if (i
->position
> s
)
1799 return make_number (s
);
1801 i
= next_interval (i
);
1807 /* Return the direction from which the text-property PROP would be
1808 inherited by any new text inserted at POS: 1 if it would be
1809 inherited from the char after POS, -1 if it would be inherited from
1810 the char before POS, and 0 if from neither.
1811 BUFFER can be either a buffer or nil (meaning current buffer). */
1814 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1816 Lisp_Object prev_pos
, front_sticky
;
1817 bool is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1818 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1821 XSETBUFFER (buffer
, current_buffer
);
1823 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1826 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1827 /* Consider previous character. */
1829 Lisp_Object rear_non_sticky
;
1831 prev_pos
= make_number (XINT (pos
) - 1);
1832 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1834 if (!NILP (CONSP (rear_non_sticky
)
1835 ? Fmemq (prop
, rear_non_sticky
)
1837 /* PROP is rear-non-sticky. */
1843 /* Consider following character. */
1844 /* This signals an arg-out-of-range error if pos is outside the
1845 buffer's accessible range. */
1846 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1848 if (EQ (front_sticky
, Qt
)
1849 || (CONSP (front_sticky
)
1850 && !NILP (Fmemq (prop
, front_sticky
))))
1851 /* PROP is inherited from after. */
1852 is_front_sticky
= 1;
1854 /* Simple cases, where the properties are consistent. */
1855 if (is_rear_sticky
&& !is_front_sticky
)
1857 else if (!is_rear_sticky
&& is_front_sticky
)
1859 else if (!is_rear_sticky
&& !is_front_sticky
)
1862 /* The stickiness properties are inconsistent, so we have to
1863 disambiguate. Basically, rear-sticky wins, _except_ if the
1864 property that would be inherited has a value of nil, in which case
1865 front-sticky wins. */
1866 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1867 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1874 /* Copying properties between objects. */
1876 /* Add properties from START to END of SRC, starting at POS in DEST.
1877 SRC and DEST may each refer to strings or buffers.
1878 Optional sixth argument PROP causes only that property to be copied.
1879 Properties are copied to DEST as if by `add-text-properties'.
1880 Return t if any property value actually changed, nil otherwise. */
1882 /* Note this can GC when DEST is a buffer. */
1885 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1891 ptrdiff_t s
, e
, e2
, p
, len
;
1893 struct gcpro gcpro1
, gcpro2
;
1895 i
= validate_interval_range (src
, &start
, &end
, soft
);
1899 CHECK_NUMBER_COERCE_MARKER (pos
);
1901 Lisp_Object dest_start
, dest_end
;
1903 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1904 if (MOST_POSITIVE_FIXNUM
< e
)
1905 args_out_of_range (pos
, end
);
1907 XSETFASTINT (dest_end
, e
);
1908 /* Apply this to a copy of pos; it will try to increment its arguments,
1909 which we don't want. */
1910 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1921 e2
= i
->position
+ LENGTH (i
);
1928 while (! NILP (plist
))
1930 if (EQ (Fcar (plist
), prop
))
1932 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1935 plist
= Fcdr (Fcdr (plist
));
1939 /* Must defer modifications to the interval tree in case src
1940 and dest refer to the same string or buffer. */
1941 stuff
= Fcons (Fcons (make_number (p
),
1942 Fcons (make_number (p
+ len
),
1943 Fcons (plist
, Qnil
))),
1947 i
= next_interval (i
);
1955 GCPRO2 (stuff
, dest
);
1957 while (! NILP (stuff
))
1960 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1961 Fcar (Fcdr (Fcdr (res
))), dest
);
1964 stuff
= Fcdr (stuff
);
1969 return modified
? Qt
: Qnil
;
1973 /* Return a list representing the text properties of OBJECT between
1974 START and END. if PROP is non-nil, report only on that property.
1975 Each result list element has the form (S E PLIST), where S and E
1976 are positions in OBJECT and PLIST is a property list containing the
1977 text properties of OBJECT between S and E. Value is nil if OBJECT
1978 doesn't contain text properties between START and END. */
1981 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1988 i
= validate_interval_range (object
, &start
, &end
, soft
);
1991 ptrdiff_t s
= XINT (start
);
1992 ptrdiff_t e
= XINT (end
);
1996 ptrdiff_t interval_end
, len
;
1999 interval_end
= i
->position
+ LENGTH (i
);
2000 if (interval_end
> e
)
2002 len
= interval_end
- s
;
2007 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2008 if (EQ (XCAR (plist
), prop
))
2010 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
2015 result
= Fcons (Fcons (make_number (s
),
2016 Fcons (make_number (s
+ len
),
2017 Fcons (plist
, Qnil
))),
2020 i
= next_interval (i
);
2031 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2032 (START END PLIST), where START and END are positions and PLIST is a
2033 property list containing the text properties to add. Adjust START
2034 and END positions by DELTA before adding properties. */
2037 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2039 struct gcpro gcpro1
, gcpro2
;
2041 GCPRO2 (list
, object
);
2043 for (; CONSP (list
); list
= XCDR (list
))
2045 Lisp_Object item
, start
, end
, plist
;
2048 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2049 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2050 plist
= XCAR (XCDR (XCDR (item
)));
2052 Fadd_text_properties (start
, end
, plist
, object
);
2060 /* Modify end-points of ranges in LIST destructively, and return the
2061 new list. LIST is a list as returned from text_property_list.
2062 Discard properties that begin at or after NEW_END, and limit
2063 end-points to NEW_END. */
2066 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2068 Lisp_Object prev
= Qnil
, head
= list
;
2069 ptrdiff_t max
= XINT (new_end
);
2071 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2073 Lisp_Object item
, beg
, end
;
2077 end
= XCAR (XCDR (item
));
2079 if (XINT (beg
) >= max
)
2081 /* The start-point is past the end of the new string.
2082 Discard this property. */
2083 if (EQ (head
, list
))
2086 XSETCDR (prev
, XCDR (list
));
2088 else if (XINT (end
) > max
)
2089 /* The end-point is past the end of the new string. */
2090 XSETCAR (XCDR (item
), new_end
);
2098 /* Call the modification hook functions in LIST, each with START and END. */
2101 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2103 struct gcpro gcpro1
;
2105 while (!NILP (list
))
2107 call2 (Fcar (list
), start
, end
);
2113 /* Check for read-only intervals between character positions START ... END,
2114 in BUF, and signal an error if we find one.
2116 Then check for any modification hooks in the range.
2117 Create a list of all these hooks in lexicographic order,
2118 eliminating consecutive extra copies of the same hook. Then call
2119 those hooks in order, with START and END - 1 as arguments. */
2122 verify_interval_modification (struct buffer
*buf
,
2123 ptrdiff_t start
, ptrdiff_t end
)
2125 INTERVAL intervals
= buffer_intervals (buf
);
2128 Lisp_Object prev_mod_hooks
;
2129 Lisp_Object mod_hooks
;
2130 struct gcpro gcpro1
;
2133 prev_mod_hooks
= Qnil
;
2136 interval_insert_behind_hooks
= Qnil
;
2137 interval_insert_in_front_hooks
= Qnil
;
2144 ptrdiff_t temp
= start
;
2149 /* For an insert operation, check the two chars around the position. */
2152 INTERVAL prev
= NULL
;
2153 Lisp_Object before
, after
;
2155 /* Set I to the interval containing the char after START,
2156 and PREV to the interval containing the char before START.
2157 Either one may be null. They may be equal. */
2158 i
= find_interval (intervals
, start
);
2160 if (start
== BUF_BEGV (buf
))
2162 else if (i
->position
== start
)
2163 prev
= previous_interval (i
);
2164 else if (i
->position
< start
)
2166 if (start
== BUF_ZV (buf
))
2169 /* If Vinhibit_read_only is set and is not a list, we can
2170 skip the read_only checks. */
2171 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2173 /* If I and PREV differ we need to check for the read-only
2174 property together with its stickiness. If either I or
2175 PREV are 0, this check is all we need.
2176 We have to take special care, since read-only may be
2177 indirectly defined via the category property. */
2182 after
= textget (i
->plist
, Qread_only
);
2184 /* If interval I is read-only and read-only is
2185 front-sticky, inhibit insertion.
2186 Check for read-only as well as category. */
2188 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2192 tem
= textget (i
->plist
, Qfront_sticky
);
2193 if (TMEM (Qread_only
, tem
)
2194 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2195 && TMEM (Qcategory
, tem
)))
2196 text_read_only (after
);
2202 before
= textget (prev
->plist
, Qread_only
);
2204 /* If interval PREV is read-only and read-only isn't
2205 rear-nonsticky, inhibit insertion.
2206 Check for read-only as well as category. */
2208 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2212 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2213 if (! TMEM (Qread_only
, tem
)
2214 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2215 || ! TMEM (Qcategory
, tem
)))
2216 text_read_only (before
);
2222 after
= textget (i
->plist
, Qread_only
);
2224 /* If interval I is read-only and read-only is
2225 front-sticky, inhibit insertion.
2226 Check for read-only as well as category. */
2227 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2231 tem
= textget (i
->plist
, Qfront_sticky
);
2232 if (TMEM (Qread_only
, tem
)
2233 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2234 && TMEM (Qcategory
, tem
)))
2235 text_read_only (after
);
2237 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2238 if (! TMEM (Qread_only
, tem
)
2239 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2240 || ! TMEM (Qcategory
, tem
)))
2241 text_read_only (after
);
2246 /* Run both insert hooks (just once if they're the same). */
2248 interval_insert_behind_hooks
2249 = textget (prev
->plist
, Qinsert_behind_hooks
);
2251 interval_insert_in_front_hooks
2252 = textget (i
->plist
, Qinsert_in_front_hooks
);
2256 /* Loop over intervals on or next to START...END,
2257 collecting their hooks. */
2259 i
= find_interval (intervals
, start
);
2262 if (! INTERVAL_WRITABLE_P (i
))
2263 text_read_only (textget (i
->plist
, Qread_only
));
2265 if (!inhibit_modification_hooks
)
2267 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2268 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2270 hooks
= Fcons (mod_hooks
, hooks
);
2271 prev_mod_hooks
= mod_hooks
;
2275 i
= next_interval (i
);
2277 /* Keep going thru the interval containing the char before END. */
2278 while (i
&& i
->position
< end
);
2280 if (!inhibit_modification_hooks
)
2283 hooks
= Fnreverse (hooks
);
2284 while (! EQ (hooks
, Qnil
))
2286 call_mod_hooks (Fcar (hooks
), make_number (start
),
2288 hooks
= Fcdr (hooks
);
2295 /* Run the interval hooks for an insertion on character range START ... END.
2296 verify_interval_modification chose which hooks to run;
2297 this function is called after the insertion happens
2298 so it can indicate the range of inserted text. */
2301 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2303 if (! NILP (interval_insert_behind_hooks
))
2304 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2305 if (! NILP (interval_insert_in_front_hooks
)
2306 && ! EQ (interval_insert_in_front_hooks
,
2307 interval_insert_behind_hooks
))
2308 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2312 syms_of_textprop (void)
2314 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2315 doc
: /* Property-list used as default values.
2316 The value of a property in this list is seen as the value for every
2317 character that does not have its own value for that property. */);
2318 Vdefault_text_properties
= Qnil
;
2320 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2321 doc
: /* Alist of alternative properties for properties without a value.
2322 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2323 If a piece of text has no direct value for a particular property, then
2324 this alist is consulted. If that property appears in the alist, then
2325 the first non-nil value from the associated alternative properties is
2327 Vchar_property_alias_alist
= Qnil
;
2329 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2330 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2331 This also inhibits the use of the `intangible' text property. */);
2332 Vinhibit_point_motion_hooks
= Qnil
;
2334 DEFVAR_LISP ("text-property-default-nonsticky",
2335 Vtext_property_default_nonsticky
,
2336 doc
: /* Alist of properties vs the corresponding non-stickiness.
2337 Each element has the form (PROPERTY . NONSTICKINESS).
2339 If a character in a buffer has PROPERTY, new text inserted adjacent to
2340 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2341 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2342 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2343 /* Text properties `syntax-table'and `display' should be nonsticky
2345 Vtext_property_default_nonsticky
2346 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
),
2347 Fcons (Fcons (intern_c_string ("display"), Qt
), Qnil
));
2349 staticpro (&interval_insert_behind_hooks
);
2350 staticpro (&interval_insert_in_front_hooks
);
2351 interval_insert_behind_hooks
= Qnil
;
2352 interval_insert_in_front_hooks
= Qnil
;
2355 /* Common attributes one might give text */
2357 DEFSYM (Qforeground
, "foreground");
2358 DEFSYM (Qbackground
, "background");
2359 DEFSYM (Qfont
, "font");
2360 DEFSYM (Qface
, "face");
2361 DEFSYM (Qstipple
, "stipple");
2362 DEFSYM (Qunderline
, "underline");
2363 DEFSYM (Qread_only
, "read-only");
2364 DEFSYM (Qinvisible
, "invisible");
2365 DEFSYM (Qintangible
, "intangible");
2366 DEFSYM (Qcategory
, "category");
2367 DEFSYM (Qlocal_map
, "local-map");
2368 DEFSYM (Qfront_sticky
, "front-sticky");
2369 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2370 DEFSYM (Qmouse_face
, "mouse-face");
2371 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2373 /* Properties that text might use to specify certain actions */
2375 DEFSYM (Qmouse_left
, "mouse-left");
2376 DEFSYM (Qmouse_entered
, "mouse-entered");
2377 DEFSYM (Qpoint_left
, "point-left");
2378 DEFSYM (Qpoint_entered
, "point-entered");
2380 defsubr (&Stext_properties_at
);
2381 defsubr (&Sget_text_property
);
2382 defsubr (&Sget_char_property
);
2383 defsubr (&Sget_char_property_and_overlay
);
2384 defsubr (&Snext_char_property_change
);
2385 defsubr (&Sprevious_char_property_change
);
2386 defsubr (&Snext_single_char_property_change
);
2387 defsubr (&Sprevious_single_char_property_change
);
2388 defsubr (&Snext_property_change
);
2389 defsubr (&Snext_single_property_change
);
2390 defsubr (&Sprevious_property_change
);
2391 defsubr (&Sprevious_single_property_change
);
2392 defsubr (&Sadd_text_properties
);
2393 defsubr (&Sput_text_property
);
2394 defsubr (&Sset_text_properties
);
2395 defsubr (&Sadd_face_text_property
);
2396 defsubr (&Sremove_text_properties
);
2397 defsubr (&Sremove_list_of_text_properties
);
2398 defsubr (&Stext_property_any
);
2399 defsubr (&Stext_property_not_all
);