1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2014 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 text properties of BUFFER from START to END. */
99 modify_text_properties (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
101 ptrdiff_t b
= XINT (start
), e
= XINT (end
);
102 struct buffer
*buf
= XBUFFER (buffer
), *old
= current_buffer
;
104 set_buffer_internal (buf
);
106 prepare_to_modify_buffer_1 (b
, e
, NULL
);
108 BUF_COMPUTE_UNCHANGED (buf
, b
- 1, e
);
109 if (MODIFF
<= SAVE_MODIFF
)
110 record_first_change ();
113 bset_point_before_scroll (current_buffer
, Qnil
);
115 set_buffer_internal (old
);
118 /* Complain if object is not string or buffer type. */
121 CHECK_STRING_OR_BUFFER (Lisp_Object x
)
123 CHECK_TYPE (STRINGP (x
) || BUFFERP (x
), Qbuffer_or_string_p
, x
);
126 /* Extract the interval at the position pointed to by BEGIN from
127 OBJECT, a string or buffer. Additionally, check that the positions
128 pointed to by BEGIN and END are within the bounds of OBJECT, and
129 reverse them if *BEGIN is greater than *END. The objects pointed
130 to by BEGIN and END may be integers or markers; if the latter, they
131 are coerced to integers.
133 When OBJECT is a string, we increment *BEGIN and *END
134 to make them origin-one.
136 Note that buffer points don't correspond to interval indices.
137 For example, point-max is 1 greater than the index of the last
138 character. This difference is handled in the caller, which uses
139 the validated points to determine a length, and operates on that.
140 Exceptions are Ftext_properties_at, Fnext_property_change, and
141 Fprevious_property_change which call this function with BEGIN == END.
142 Handle this case specially.
144 If FORCE is soft (0), it's OK to return NULL. Otherwise,
145 create an interval tree for OBJECT if one doesn't exist, provided
146 the object actually contains text. In the current design, if there
147 is no text, there can be no text properties. */
153 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
,
154 Lisp_Object
*end
, bool force
)
159 CHECK_STRING_OR_BUFFER (object
);
160 CHECK_NUMBER_COERCE_MARKER (*begin
);
161 CHECK_NUMBER_COERCE_MARKER (*end
);
163 /* If we are asked for a point, but from a subr which operates
164 on a range, then return nothing. */
165 if (EQ (*begin
, *end
) && begin
!= end
)
168 if (XINT (*begin
) > XINT (*end
))
176 if (BUFFERP (object
))
178 register struct buffer
*b
= XBUFFER (object
);
180 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
181 && XINT (*end
) <= BUF_ZV (b
)))
182 args_out_of_range (*begin
, *end
);
183 i
= buffer_intervals (b
);
185 /* If there's no text, there are no properties. */
186 if (BUF_BEGV (b
) == BUF_ZV (b
))
189 searchpos
= XINT (*begin
);
193 ptrdiff_t len
= SCHARS (object
);
195 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
196 && XINT (*end
) <= len
))
197 args_out_of_range (*begin
, *end
);
198 XSETFASTINT (*begin
, XFASTINT (*begin
));
200 XSETFASTINT (*end
, XFASTINT (*end
));
201 i
= string_intervals (object
);
206 searchpos
= XINT (*begin
);
210 return (force
? create_root_interval (object
) : i
);
212 return find_interval (i
, searchpos
);
215 /* Validate LIST as a property list. If LIST is not a list, then
216 make one consisting of (LIST nil). Otherwise, verify that LIST
217 is even numbered and thus suitable as a plist. */
220 validate_plist (Lisp_Object list
)
229 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
235 error ("Odd length text property list");
239 return list2 (list
, Qnil
);
242 /* Return true if interval I has all the properties,
243 with the same values, of list PLIST. */
246 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
248 Lisp_Object tail1
, tail2
;
250 /* Go through each element of PLIST. */
251 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
253 Lisp_Object sym1
= XCAR (tail1
);
256 /* Go through I's plist, looking for sym1 */
257 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
258 if (EQ (sym1
, XCAR (tail2
)))
260 /* Found the same property on both lists. If the
261 values are unequal, return zero. */
262 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
265 /* Property has same value on both lists; go to next one. */
277 /* Return true if the plist of interval I has any of the
278 properties of PLIST, regardless of their values. */
281 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
283 Lisp_Object tail1
, tail2
, sym
;
285 /* Go through each element of PLIST. */
286 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
290 /* Go through i's plist, looking for tail1 */
291 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
292 if (EQ (sym
, XCAR (tail2
)))
299 /* Return nonzero if the plist of interval I has any of the
300 property names in LIST, regardless of their values. */
303 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
305 Lisp_Object tail1
, tail2
, sym
;
307 /* Go through each element of LIST. */
308 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
312 /* Go through i's plist, looking for tail1 */
313 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
314 if (EQ (sym
, XCAR (tail2
)))
321 /* Changing the plists of individual intervals. */
323 /* Return the value of PROP in property-list PLIST, or Qunbound if it
326 property_value (Lisp_Object plist
, Lisp_Object prop
)
330 while (PLIST_ELT_P (plist
, value
))
331 if (EQ (XCAR (plist
), prop
))
334 plist
= XCDR (value
);
339 /* Set the properties of INTERVAL to PROPERTIES,
340 and record undo info for the previous values.
341 OBJECT is the string or buffer that INTERVAL belongs to. */
344 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
346 Lisp_Object sym
, value
;
348 if (BUFFERP (object
))
350 /* For each property in the old plist which is missing from PROPERTIES,
351 or has a different value in PROPERTIES, make an undo record. */
352 for (sym
= interval
->plist
;
353 PLIST_ELT_P (sym
, value
);
355 if (! EQ (property_value (properties
, XCAR (sym
)),
358 record_property_change (interval
->position
, LENGTH (interval
),
359 XCAR (sym
), XCAR (value
),
363 /* For each new property that has no value at all in the old plist,
364 make an undo record binding it to nil, so it will be removed. */
365 for (sym
= properties
;
366 PLIST_ELT_P (sym
, value
);
368 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
370 record_property_change (interval
->position
, LENGTH (interval
),
376 /* Store new properties. */
377 set_interval_plist (interval
, Fcopy_sequence (properties
));
380 /* Add the properties of PLIST to the interval I, or set
381 the value of I's property to the value of the property on PLIST
382 if they are different.
384 OBJECT should be the string or buffer the interval is in.
386 Return true if this changes I (i.e., if any members of PLIST
387 are actually added to I's plist) */
390 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
,
391 enum property_set_type set_type
)
393 Lisp_Object tail1
, tail2
, sym1
, val1
;
395 struct gcpro gcpro1
, gcpro2
, gcpro3
;
400 /* No need to protect OBJECT, because we can GC only in the case
401 where it is a buffer, and live buffers are always protected.
402 I and its plist are also protected, via OBJECT. */
403 GCPRO3 (tail1
, sym1
, val1
);
405 /* Go through each element of PLIST. */
406 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
410 val1
= Fcar (XCDR (tail1
));
412 /* Go through I's plist, looking for sym1 */
413 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
414 if (EQ (sym1
, XCAR (tail2
)))
416 /* No need to gcpro, because tail2 protects this
417 and it must be a cons cell (we get an error otherwise). */
418 register Lisp_Object this_cdr
;
420 this_cdr
= XCDR (tail2
);
421 /* Found the property. Now check its value. */
424 /* The properties have the same value on both lists.
425 Continue to the next property. */
426 if (EQ (val1
, Fcar (this_cdr
)))
429 /* Record this change in the buffer, for undo purposes. */
430 if (BUFFERP (object
))
432 record_property_change (i
->position
, LENGTH (i
),
433 sym1
, Fcar (this_cdr
), object
);
436 /* I's property has a different value -- change it */
437 if (set_type
== TEXT_PROPERTY_REPLACE
)
438 Fsetcar (this_cdr
, val1
);
440 if (CONSP (Fcar (this_cdr
)) &&
441 /* Special-case anonymous face properties. */
442 (! EQ (sym1
, Qface
) ||
443 NILP (Fkeywordp (Fcar (Fcar (this_cdr
))))))
444 /* The previous value is a list, so prepend (or
445 append) the new value to this list. */
446 if (set_type
== TEXT_PROPERTY_PREPEND
)
447 Fsetcar (this_cdr
, Fcons (val1
, Fcar (this_cdr
)));
449 nconc2 (Fcar (this_cdr
), list1 (val1
));
451 /* The previous value is a single value, so make it
453 if (set_type
== TEXT_PROPERTY_PREPEND
)
454 Fsetcar (this_cdr
, list2 (val1
, Fcar (this_cdr
)));
456 Fsetcar (this_cdr
, list2 (Fcar (this_cdr
), val1
));
465 /* Record this change in the buffer, for undo purposes. */
466 if (BUFFERP (object
))
468 record_property_change (i
->position
, LENGTH (i
),
471 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
481 /* For any members of PLIST, or LIST,
482 which are properties of I, remove them from I's plist.
483 (If PLIST is non-nil, use that, otherwise use LIST.)
484 OBJECT is the string or buffer containing I. */
487 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
489 Lisp_Object tail1
, tail2
, sym
, current_plist
;
492 /* True means tail1 is a plist, otherwise it is a list. */
495 current_plist
= i
->plist
;
498 tail1
= plist
, use_plist
= 1;
500 tail1
= list
, use_plist
= 0;
502 /* Go through each element of LIST or PLIST. */
503 while (CONSP (tail1
))
507 /* First, remove the symbol if it's at the head of the list */
508 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
510 if (BUFFERP (object
))
511 record_property_change (i
->position
, LENGTH (i
),
512 sym
, XCAR (XCDR (current_plist
)),
515 current_plist
= XCDR (XCDR (current_plist
));
519 /* Go through I's plist, looking for SYM. */
520 tail2
= current_plist
;
521 while (! NILP (tail2
))
523 register Lisp_Object
this;
524 this = XCDR (XCDR (tail2
));
525 if (CONSP (this) && EQ (sym
, XCAR (this)))
527 if (BUFFERP (object
))
528 record_property_change (i
->position
, LENGTH (i
),
529 sym
, XCAR (XCDR (this)), object
);
531 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
537 /* Advance thru TAIL1 one way or the other. */
538 tail1
= XCDR (tail1
);
539 if (use_plist
&& CONSP (tail1
))
540 tail1
= XCDR (tail1
);
544 set_interval_plist (i
, current_plist
);
548 /* Returns the interval of POSITION in OBJECT.
549 POSITION is BEG-based. */
552 interval_of (ptrdiff_t position
, Lisp_Object object
)
558 XSETBUFFER (object
, current_buffer
);
559 else if (EQ (object
, Qt
))
562 CHECK_STRING_OR_BUFFER (object
);
564 if (BUFFERP (object
))
566 register struct buffer
*b
= XBUFFER (object
);
570 i
= buffer_intervals (b
);
575 end
= SCHARS (object
);
576 i
= string_intervals (object
);
579 if (!(beg
<= position
&& position
<= end
))
580 args_out_of_range (make_number (position
), make_number (position
));
581 if (beg
== end
|| !i
)
584 return find_interval (i
, position
);
587 DEFUN ("text-properties-at", Ftext_properties_at
,
588 Stext_properties_at
, 1, 2, 0,
589 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
590 If the optional second argument OBJECT is a buffer (or nil, which means
591 the current buffer), POSITION is a buffer position (integer or marker).
592 If OBJECT is a string, POSITION is a 0-based index into it.
593 If POSITION is at the end of OBJECT, the value is nil. */)
594 (Lisp_Object position
, Lisp_Object object
)
599 XSETBUFFER (object
, current_buffer
);
601 i
= validate_interval_range (object
, &position
, &position
, soft
);
604 /* If POSITION is at the end of the interval,
605 it means it's the end of OBJECT.
606 There are no properties at the very end,
607 since no character follows. */
608 if (XINT (position
) == LENGTH (i
) + i
->position
)
614 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
615 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
616 OBJECT should be a buffer or a string; if omitted or nil, it defaults
617 to the current buffer.
618 If POSITION is at the end of OBJECT, the value is nil. */)
619 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
621 return textget (Ftext_properties_at (position
, object
), prop
);
624 /* Return the value of char's property PROP, in OBJECT at POSITION.
625 OBJECT is optional and defaults to the current buffer.
626 If OVERLAY is non-0, then in the case that the returned property is from
627 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
628 returned in *OVERLAY.
629 If POSITION is at the end of OBJECT, the value is nil.
630 If OBJECT is a buffer, then overlay properties are considered as well as
632 If OBJECT is a window, then that window's buffer is used, but
633 window-specific overlays are considered only if they are associated
636 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
638 struct window
*w
= 0;
640 CHECK_NUMBER_COERCE_MARKER (position
);
643 XSETBUFFER (object
, current_buffer
);
645 if (WINDOWP (object
))
647 CHECK_LIVE_WINDOW (object
);
648 w
= XWINDOW (object
);
649 object
= w
->contents
;
651 if (BUFFERP (object
))
654 Lisp_Object
*overlay_vec
;
655 struct buffer
*obuf
= current_buffer
;
657 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
658 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
659 xsignal1 (Qargs_out_of_range
, position
);
661 set_buffer_temp (XBUFFER (object
));
664 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
665 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
667 set_buffer_temp (obuf
);
669 /* Now check the overlays in order of decreasing priority. */
670 while (--noverlays
>= 0)
672 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
676 /* Return the overlay we got the property from. */
677 *overlay
= overlay_vec
[noverlays
];
686 /* Indicate that the return value is not from an overlay. */
689 /* Not a buffer, or no appropriate overlay, so fall through to the
691 return Fget_text_property (position
, prop
, object
);
694 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
695 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
696 Both overlay properties and text properties are checked.
697 OBJECT is optional and defaults to the current buffer.
698 If POSITION is at the end of OBJECT, the value is nil.
699 If OBJECT is a buffer, then overlay properties are considered as well as
701 If OBJECT is a window, then that window's buffer is used, but window-specific
702 overlays are considered only if they are associated with OBJECT. */)
703 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
705 return get_char_property_and_overlay (position
, prop
, object
, 0);
708 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
709 Sget_char_property_and_overlay
, 2, 3, 0,
710 doc
: /* Like `get-char-property', but with extra overlay information.
711 The value is a cons cell. Its car is the return value of `get-char-property'
712 with the same arguments--that is, the value of POSITION's property
713 PROP in OBJECT. Its cdr is the overlay in which the property was
714 found, or nil, if it was found as a text property or not found at all.
716 OBJECT is optional and defaults to the current buffer. OBJECT may be
717 a string, a buffer or a window. For strings, the cdr of the return
718 value is always nil, since strings do not have overlays. If OBJECT is
719 a window, then that window's buffer is used, but window-specific
720 overlays are considered only if they are associated with OBJECT. If
721 POSITION is at the end of OBJECT, both car and cdr are nil. */)
722 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
726 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
727 return Fcons (val
, overlay
);
731 DEFUN ("next-char-property-change", Fnext_char_property_change
,
732 Snext_char_property_change
, 1, 2, 0,
733 doc
: /* Return the position of next text property or overlay change.
734 This scans characters forward in the current buffer from POSITION till
735 it finds a change in some text property, or the beginning or end of an
736 overlay, and returns the position of that.
737 If none is found up to (point-max), the function returns (point-max).
739 If the optional second argument LIMIT is non-nil, don't search
740 past position LIMIT; return LIMIT if nothing is found before LIMIT.
741 LIMIT is a no-op if it is greater than (point-max). */)
742 (Lisp_Object position
, Lisp_Object limit
)
746 temp
= Fnext_overlay_change (position
);
749 CHECK_NUMBER_COERCE_MARKER (limit
);
750 if (XINT (limit
) < XINT (temp
))
753 return Fnext_property_change (position
, Qnil
, temp
);
756 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
757 Sprevious_char_property_change
, 1, 2, 0,
758 doc
: /* Return the position of previous text property or overlay change.
759 Scans characters backward in the current buffer from POSITION till it
760 finds a change in some text property, or the beginning or end of an
761 overlay, and returns the position of that.
762 If none is found since (point-min), the function returns (point-min).
764 If the optional second argument LIMIT is non-nil, don't search
765 past position LIMIT; return LIMIT if nothing is found before LIMIT.
766 LIMIT is a no-op if it is less than (point-min). */)
767 (Lisp_Object position
, Lisp_Object limit
)
771 temp
= Fprevious_overlay_change (position
);
774 CHECK_NUMBER_COERCE_MARKER (limit
);
775 if (XINT (limit
) > XINT (temp
))
778 return Fprevious_property_change (position
, Qnil
, temp
);
782 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
783 Snext_single_char_property_change
, 2, 4, 0,
784 doc
: /* Return the position of next text property or overlay change for a specific property.
785 Scans characters forward from POSITION till it finds
786 a change in the PROP property, then returns the position of the change.
787 If the optional third argument OBJECT is a buffer (or nil, which means
788 the current buffer), POSITION is a buffer position (integer or marker).
789 If OBJECT is a string, POSITION is a 0-based index into it.
791 In a string, scan runs to the end of the string.
792 In a buffer, it runs to (point-max), and the value cannot exceed that.
794 The property values are compared with `eq'.
795 If the property is constant all the way to the end of OBJECT, return the
796 last valid position in OBJECT.
797 If the optional fourth argument LIMIT is non-nil, don't search
798 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
799 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
801 if (STRINGP (object
))
803 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
807 position
= make_number (SCHARS (object
));
810 CHECK_NUMBER (limit
);
817 Lisp_Object initial_value
, value
;
818 ptrdiff_t count
= SPECPDL_INDEX ();
821 CHECK_BUFFER (object
);
823 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
825 record_unwind_current_buffer ();
826 Fset_buffer (object
);
829 CHECK_NUMBER_COERCE_MARKER (position
);
831 initial_value
= Fget_char_property (position
, prop
, object
);
834 XSETFASTINT (limit
, ZV
);
836 CHECK_NUMBER_COERCE_MARKER (limit
);
838 if (XFASTINT (position
) >= XFASTINT (limit
))
841 if (XFASTINT (position
) > ZV
)
842 XSETFASTINT (position
, ZV
);
847 position
= Fnext_char_property_change (position
, limit
);
848 if (XFASTINT (position
) >= XFASTINT (limit
))
854 value
= Fget_char_property (position
, prop
, object
);
855 if (!EQ (value
, initial_value
))
859 unbind_to (count
, Qnil
);
865 DEFUN ("previous-single-char-property-change",
866 Fprevious_single_char_property_change
,
867 Sprevious_single_char_property_change
, 2, 4, 0,
868 doc
: /* Return the position of previous text property or overlay change for a specific property.
869 Scans characters backward from POSITION till it finds
870 a change in the PROP property, then returns the position of the change.
871 If the optional third argument OBJECT is a buffer (or nil, which means
872 the current buffer), POSITION is a buffer position (integer or marker).
873 If OBJECT is a string, POSITION is a 0-based index into it.
875 In a string, scan runs to the start of the string.
876 In a buffer, it runs to (point-min), and the value cannot be less than that.
878 The property values are compared with `eq'.
879 If the property is constant all the way to the start of OBJECT, return the
880 first valid position in OBJECT.
881 If the optional fourth argument LIMIT is non-nil, don't search back past
882 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
883 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
885 if (STRINGP (object
))
887 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
891 position
= make_number (0);
894 CHECK_NUMBER (limit
);
901 ptrdiff_t count
= SPECPDL_INDEX ();
904 CHECK_BUFFER (object
);
906 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
908 record_unwind_current_buffer ();
909 Fset_buffer (object
);
912 CHECK_NUMBER_COERCE_MARKER (position
);
915 XSETFASTINT (limit
, BEGV
);
917 CHECK_NUMBER_COERCE_MARKER (limit
);
919 if (XFASTINT (position
) <= XFASTINT (limit
))
922 if (XFASTINT (position
) < BEGV
)
923 XSETFASTINT (position
, BEGV
);
927 Lisp_Object initial_value
928 = Fget_char_property (make_number (XFASTINT (position
) - 1),
933 position
= Fprevious_char_property_change (position
, limit
);
935 if (XFASTINT (position
) <= XFASTINT (limit
))
943 = Fget_char_property (make_number (XFASTINT (position
) - 1),
946 if (!EQ (value
, initial_value
))
952 unbind_to (count
, Qnil
);
958 DEFUN ("next-property-change", Fnext_property_change
,
959 Snext_property_change
, 1, 3, 0,
960 doc
: /* Return the position of next property change.
961 Scans characters forward from POSITION in OBJECT till it finds
962 a change in some text property, then returns the position of the change.
963 If the optional second argument OBJECT is a buffer (or nil, which means
964 the current buffer), POSITION is a buffer position (integer or marker).
965 If OBJECT is a string, POSITION is a 0-based index into it.
966 Return nil if the property is constant all the way to the end of OBJECT.
967 If the value is non-nil, it is a position greater than POSITION, never equal.
969 If the optional third argument LIMIT is non-nil, don't search
970 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
971 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
973 register INTERVAL i
, next
;
976 XSETBUFFER (object
, current_buffer
);
978 if (!NILP (limit
) && !EQ (limit
, Qt
))
979 CHECK_NUMBER_COERCE_MARKER (limit
);
981 i
= validate_interval_range (object
, &position
, &position
, soft
);
983 /* If LIMIT is t, return start of next interval--don't
984 bother checking further intervals. */
990 next
= next_interval (i
);
993 XSETFASTINT (position
, (STRINGP (object
)
995 : BUF_ZV (XBUFFER (object
))));
997 XSETFASTINT (position
, next
->position
);
1004 next
= next_interval (i
);
1006 while (next
&& intervals_equal (i
, next
)
1007 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1008 next
= next_interval (next
);
1012 >= (INTEGERP (limit
)
1016 : BUF_ZV (XBUFFER (object
))))))
1019 return make_number (next
->position
);
1022 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1023 Snext_single_property_change
, 2, 4, 0,
1024 doc
: /* Return the position of next property change for a specific property.
1025 Scans characters forward from POSITION till it finds
1026 a change in the PROP property, then returns the position of the change.
1027 If the optional third argument OBJECT is a buffer (or nil, which means
1028 the current buffer), POSITION is a buffer position (integer or marker).
1029 If OBJECT is a string, POSITION is a 0-based index into it.
1030 The property values are compared with `eq'.
1031 Return nil if the property is constant all the way to the end of OBJECT.
1032 If the value is non-nil, it is a position greater than POSITION, never equal.
1034 If the optional fourth argument LIMIT is non-nil, don't search
1035 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1036 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1038 register INTERVAL i
, next
;
1039 register Lisp_Object here_val
;
1042 XSETBUFFER (object
, current_buffer
);
1045 CHECK_NUMBER_COERCE_MARKER (limit
);
1047 i
= validate_interval_range (object
, &position
, &position
, soft
);
1051 here_val
= textget (i
->plist
, prop
);
1052 next
= next_interval (i
);
1054 && EQ (here_val
, textget (next
->plist
, prop
))
1055 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1056 next
= next_interval (next
);
1060 >= (INTEGERP (limit
)
1064 : BUF_ZV (XBUFFER (object
))))))
1067 return make_number (next
->position
);
1070 DEFUN ("previous-property-change", Fprevious_property_change
,
1071 Sprevious_property_change
, 1, 3, 0,
1072 doc
: /* Return the position of previous property change.
1073 Scans characters backwards from POSITION in OBJECT till it finds
1074 a change in some text property, then returns the position of the change.
1075 If the optional second argument OBJECT is a buffer (or nil, which means
1076 the current buffer), POSITION is a buffer position (integer or marker).
1077 If OBJECT is a string, POSITION is a 0-based index into it.
1078 Return nil if the property is constant all the way to the start of OBJECT.
1079 If the value is non-nil, it is a position less than POSITION, never equal.
1081 If the optional third argument LIMIT is non-nil, don't search
1082 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1083 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1085 register INTERVAL i
, previous
;
1088 XSETBUFFER (object
, current_buffer
);
1091 CHECK_NUMBER_COERCE_MARKER (limit
);
1093 i
= validate_interval_range (object
, &position
, &position
, soft
);
1097 /* Start with the interval containing the char before point. */
1098 if (i
->position
== XFASTINT (position
))
1099 i
= previous_interval (i
);
1101 previous
= previous_interval (i
);
1102 while (previous
&& intervals_equal (previous
, i
)
1104 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1105 previous
= previous_interval (previous
);
1108 || (previous
->position
+ LENGTH (previous
)
1109 <= (INTEGERP (limit
)
1111 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1114 return make_number (previous
->position
+ LENGTH (previous
));
1117 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1118 Sprevious_single_property_change
, 2, 4, 0,
1119 doc
: /* Return the position of previous property change for a specific property.
1120 Scans characters backward from POSITION till it finds
1121 a change in the PROP property, then returns the position of the change.
1122 If the optional third argument OBJECT is a buffer (or nil, which means
1123 the current buffer), POSITION is a buffer position (integer or marker).
1124 If OBJECT is a string, POSITION is a 0-based index into it.
1125 The property values are compared with `eq'.
1126 Return nil if the property is constant all the way to the start of OBJECT.
1127 If the value is non-nil, it is a position less than POSITION, never equal.
1129 If the optional fourth argument LIMIT is non-nil, don't search
1130 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1131 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1133 register INTERVAL i
, previous
;
1134 register Lisp_Object here_val
;
1137 XSETBUFFER (object
, current_buffer
);
1140 CHECK_NUMBER_COERCE_MARKER (limit
);
1142 i
= validate_interval_range (object
, &position
, &position
, soft
);
1144 /* Start with the interval containing the char before point. */
1145 if (i
&& i
->position
== XFASTINT (position
))
1146 i
= previous_interval (i
);
1151 here_val
= textget (i
->plist
, prop
);
1152 previous
= previous_interval (i
);
1154 && EQ (here_val
, textget (previous
->plist
, prop
))
1156 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1157 previous
= previous_interval (previous
);
1160 || (previous
->position
+ LENGTH (previous
)
1161 <= (INTEGERP (limit
)
1163 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1166 return make_number (previous
->position
+ LENGTH (previous
));
1169 /* Used by add-text-properties and add-face-text-property. */
1172 add_text_properties_1 (Lisp_Object start
, Lisp_Object end
,
1173 Lisp_Object properties
, Lisp_Object object
,
1174 enum property_set_type set_type
) {
1175 INTERVAL i
, unchanged
;
1178 struct gcpro gcpro1
;
1179 bool first_time
= 1;
1181 properties
= validate_plist (properties
);
1182 if (NILP (properties
))
1186 XSETBUFFER (object
, current_buffer
);
1189 i
= validate_interval_range (object
, &start
, &end
, hard
);
1194 len
= XINT (end
) - s
;
1196 /* No need to protect OBJECT, because we GC only if it's a buffer,
1197 and live buffers are always protected. */
1198 GCPRO1 (properties
);
1200 /* If this interval already has the properties, we can skip it. */
1201 if (interval_has_all_properties (properties
, i
))
1203 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1208 RETURN_UNGCPRO (Qnil
);
1210 i
= next_interval (i
);
1213 while (interval_has_all_properties (properties
, i
));
1215 else if (i
->position
!= s
)
1217 /* If we're not starting on an interval boundary, we have to
1218 split this interval. */
1220 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1221 copy_properties (unchanged
, i
);
1224 if (BUFFERP (object
) && first_time
)
1226 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1227 ptrdiff_t prev_pos
= i
->position
;
1229 modify_text_properties (object
, start
, end
);
1230 /* If someone called us recursively as a side effect of
1231 modify_text_properties, and changed the intervals behind our back
1232 (could happen if lock_file, called by prepare_to_modify_buffer,
1233 triggers redisplay, and that calls add-text-properties again
1234 in the same buffer), we cannot continue with I, because its
1235 data changed. So we restart the interval analysis anew. */
1236 if (TOTAL_LENGTH (i
) != prev_total_length
1237 || i
->position
!= prev_pos
)
1244 /* We are at the beginning of interval I, with LEN chars to scan. */
1249 if (LENGTH (i
) >= len
)
1251 /* We can UNGCPRO safely here, because there will be just
1252 one more chance to gc, in the next call to add_properties,
1253 and after that we will not need PROPERTIES or OBJECT again. */
1256 if (interval_has_all_properties (properties
, i
))
1258 if (BUFFERP (object
))
1259 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1260 XINT (end
) - XINT (start
));
1266 if (LENGTH (i
) == len
)
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
));
1275 /* i doesn't have the properties, and goes past the change limit */
1277 i
= split_interval_left (unchanged
, len
);
1278 copy_properties (unchanged
, i
);
1279 add_properties (properties
, i
, object
, set_type
);
1280 if (BUFFERP (object
))
1281 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1282 XINT (end
) - XINT (start
));
1287 modified
|= add_properties (properties
, i
, object
, set_type
);
1288 i
= next_interval (i
);
1292 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1294 DEFUN ("add-text-properties", Fadd_text_properties
,
1295 Sadd_text_properties
, 3, 4, 0,
1296 doc
: /* Add properties to the text from START to END.
1297 The third argument PROPERTIES is a property list
1298 specifying the property values to add. If the optional fourth argument
1299 OBJECT is a buffer (or nil, which means the current buffer),
1300 START and END are buffer positions (integers or markers).
1301 If OBJECT is a string, START and END are 0-based indices into it.
1302 Return t if any property value actually changed, nil otherwise. */)
1303 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1306 return add_text_properties_1 (start
, end
, properties
, object
,
1307 TEXT_PROPERTY_REPLACE
);
1310 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1312 DEFUN ("put-text-property", Fput_text_property
,
1313 Sput_text_property
, 4, 5, 0,
1314 doc
: /* Set one property of the text from START to END.
1315 The third and fourth arguments PROPERTY and VALUE
1316 specify the property to add.
1317 If the optional fifth 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 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
,
1321 Lisp_Object value
, Lisp_Object object
)
1323 AUTO_LIST2 (properties
, property
, value
);
1324 Fadd_text_properties (start
, end
, properties
, object
);
1328 DEFUN ("set-text-properties", Fset_text_properties
,
1329 Sset_text_properties
, 3, 4, 0,
1330 doc
: /* Completely replace properties of text from START to END.
1331 The third argument PROPERTIES is the new property list.
1332 If the optional fourth argument OBJECT is a buffer (or nil, which means
1333 the current buffer), START and END are buffer positions (integers or
1334 markers). If OBJECT is a string, START and END are 0-based indices into it.
1335 If PROPERTIES is nil, the effect is to remove all properties from
1336 the designated part of OBJECT. */)
1337 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1339 return set_text_properties (start
, end
, properties
, object
, Qt
);
1343 DEFUN ("add-face-text-property", Fadd_face_text_property
,
1344 Sadd_face_text_property
, 3, 5, 0,
1345 doc
: /* Add the face property to the text from START to END.
1346 FACE specifies the face to add. It should be a valid value of the
1347 `face' property (typically a face name or a plist of face attributes
1350 If any text in the region already has a non-nil `face' property, those
1351 face(s) are retained. This is done by setting the `face' property to
1352 a list of faces, with FACE as the first element (by default) and the
1353 pre-existing faces as the remaining elements.
1355 If optional fourth argument APPEND is non-nil, append FACE to the end
1356 of the face list instead.
1358 If optional fifth argument OBJECT is a buffer (or nil, which means the
1359 current buffer), START and END are buffer positions (integers or
1360 markers). If OBJECT is a string, START and END are 0-based indices
1362 (Lisp_Object start
, Lisp_Object end
, Lisp_Object face
,
1363 Lisp_Object append
, Lisp_Object object
)
1365 AUTO_LIST2 (properties
, Qface
, face
);
1366 add_text_properties_1 (start
, end
, properties
, object
,
1368 ? TEXT_PROPERTY_PREPEND
1369 : TEXT_PROPERTY_APPEND
));
1373 /* Replace properties of text from START to END with new list of
1374 properties PROPERTIES. OBJECT is the buffer or string containing
1375 the text. OBJECT nil means use the current buffer.
1376 COHERENT_CHANGE_P nil means this is being called as an internal
1377 subroutine, rather than as a change primitive with checking of
1378 read-only, invoking change hooks, etc.. Value is nil if the
1379 function _detected_ that it did not replace any properties, non-nil
1383 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
,
1384 Lisp_Object object
, Lisp_Object coherent_change_p
)
1386 register INTERVAL i
;
1387 Lisp_Object ostart
, oend
;
1392 properties
= validate_plist (properties
);
1395 XSETBUFFER (object
, current_buffer
);
1397 /* If we want no properties for a whole string,
1398 get rid of its intervals. */
1399 if (NILP (properties
) && STRINGP (object
)
1400 && XFASTINT (start
) == 0
1401 && XFASTINT (end
) == SCHARS (object
))
1403 if (!string_intervals (object
))
1406 set_string_intervals (object
, NULL
);
1410 i
= validate_interval_range (object
, &start
, &end
, soft
);
1414 /* If buffer has no properties, and we want none, return now. */
1415 if (NILP (properties
))
1418 /* Restore the original START and END values
1419 because validate_interval_range increments them for strings. */
1423 i
= validate_interval_range (object
, &start
, &end
, hard
);
1424 /* This can return if start == end. */
1429 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1430 modify_text_properties (object
, start
, end
);
1432 set_text_properties_1 (start
, end
, properties
, object
, i
);
1434 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1435 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1436 XINT (end
) - XINT (start
));
1440 /* Replace properties of text from START to END with new list of
1441 properties PROPERTIES. OBJECT is the buffer or string containing
1442 the text. This does not obey any hooks.
1443 You should provide the interval that START is located in as I.
1444 START and END can be in any order. */
1447 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1449 register INTERVAL prev_changed
= NULL
;
1450 register ptrdiff_t s
, len
;
1453 if (XINT (start
) < XINT (end
))
1456 len
= XINT (end
) - s
;
1458 else if (XINT (end
) < XINT (start
))
1461 len
= XINT (start
) - s
;
1468 if (i
->position
!= s
)
1471 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1473 if (LENGTH (i
) > len
)
1475 copy_properties (unchanged
, i
);
1476 i
= split_interval_left (i
, len
);
1477 set_properties (properties
, i
, object
);
1481 set_properties (properties
, i
, object
);
1483 if (LENGTH (i
) == len
)
1488 i
= next_interval (i
);
1491 /* We are starting at the beginning of an interval I. LEN is positive. */
1496 if (LENGTH (i
) >= len
)
1498 if (LENGTH (i
) > len
)
1499 i
= split_interval_left (i
, len
);
1501 /* We have to call set_properties even if we are going to
1502 merge the intervals, so as to make the undo records
1503 and cause redisplay to happen. */
1504 set_properties (properties
, i
, object
);
1506 merge_interval_left (i
);
1512 /* We have to call set_properties even if we are going to
1513 merge the intervals, so as to make the undo records
1514 and cause redisplay to happen. */
1515 set_properties (properties
, i
, object
);
1519 prev_changed
= i
= merge_interval_left (i
);
1521 i
= next_interval (i
);
1526 DEFUN ("remove-text-properties", Fremove_text_properties
,
1527 Sremove_text_properties
, 3, 4, 0,
1528 doc
: /* Remove some properties from text from START to END.
1529 The third argument PROPERTIES is a property list
1530 whose property names specify the properties to remove.
1531 \(The values stored in PROPERTIES are ignored.)
1532 If the optional fourth argument OBJECT is a buffer (or nil, which means
1533 the current buffer), START and END are buffer positions (integers or
1534 markers). If OBJECT is a string, START and END are 0-based indices into it.
1535 Return t if any property was actually removed, nil otherwise.
1537 Use `set-text-properties' if you want to remove all text properties. */)
1538 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1540 INTERVAL i
, unchanged
;
1543 bool first_time
= 1;
1546 XSETBUFFER (object
, current_buffer
);
1549 i
= validate_interval_range (object
, &start
, &end
, soft
);
1554 len
= XINT (end
) - s
;
1556 /* If there are no properties on this entire interval, return. */
1557 if (! interval_has_some_properties (properties
, i
))
1559 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1566 i
= next_interval (i
);
1569 while (! interval_has_some_properties (properties
, i
));
1571 /* Split away the beginning of this interval; what we don't
1573 else if (i
->position
!= s
)
1576 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1577 copy_properties (unchanged
, i
);
1580 if (BUFFERP (object
) && first_time
)
1582 ptrdiff_t prev_total_length
= TOTAL_LENGTH (i
);
1583 ptrdiff_t prev_pos
= i
->position
;
1585 modify_text_properties (object
, start
, end
);
1586 /* If someone called us recursively as a side effect of
1587 modify_text_properties, and changed the intervals behind our back
1588 (could happen if lock_file, called by prepare_to_modify_buffer,
1589 triggers redisplay, and that calls add-text-properties again
1590 in the same buffer), we cannot continue with I, because its
1591 data changed. So we restart the interval analysis anew. */
1592 if (TOTAL_LENGTH (i
) != prev_total_length
1593 || i
->position
!= prev_pos
)
1600 /* We are at the beginning of an interval, with len to scan */
1605 if (LENGTH (i
) >= len
)
1607 if (! interval_has_some_properties (properties
, i
))
1610 if (BUFFERP (object
))
1611 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1612 XINT (end
) - XINT (start
));
1616 if (LENGTH (i
) == len
)
1618 remove_properties (properties
, Qnil
, i
, object
);
1619 if (BUFFERP (object
))
1620 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1621 XINT (end
) - XINT (start
));
1625 /* i has the properties, and goes past the change limit */
1627 i
= split_interval_left (i
, len
);
1628 copy_properties (unchanged
, i
);
1629 remove_properties (properties
, Qnil
, i
, object
);
1630 if (BUFFERP (object
))
1631 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1632 XINT (end
) - XINT (start
));
1637 modified
|= remove_properties (properties
, Qnil
, i
, object
);
1638 i
= next_interval (i
);
1642 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1643 Sremove_list_of_text_properties
, 3, 4, 0,
1644 doc
: /* Remove some properties from text from START to END.
1645 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1646 If the optional fourth argument OBJECT is a buffer (or nil, which means
1647 the current buffer), START and END are buffer positions (integers or
1648 markers). If OBJECT is a string, START and END are 0-based indices into it.
1649 Return t if any property was actually removed, nil otherwise. */)
1650 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1652 INTERVAL i
, unchanged
;
1655 Lisp_Object properties
;
1656 properties
= list_of_properties
;
1659 XSETBUFFER (object
, current_buffer
);
1661 i
= validate_interval_range (object
, &start
, &end
, soft
);
1666 len
= XINT (end
) - s
;
1668 /* If there are no properties on the interval, return. */
1669 if (! interval_has_some_properties_list (properties
, i
))
1671 ptrdiff_t got
= LENGTH (i
) - (s
- i
->position
);
1678 i
= next_interval (i
);
1681 while (! interval_has_some_properties_list (properties
, i
));
1683 /* Split away the beginning of this interval; what we don't
1685 else if (i
->position
!= s
)
1688 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1689 copy_properties (unchanged
, i
);
1692 /* We are at the beginning of an interval, with len to scan.
1693 The flag `modified' records if changes have been made.
1694 When object is a buffer, we must call modify_text_properties
1695 before changes are made and signal_after_change when we are done.
1696 We call modify_text_properties before calling remove_properties if modified == 0,
1697 and we call signal_after_change before returning if modified != 0. */
1702 if (LENGTH (i
) >= len
)
1704 if (! interval_has_some_properties_list (properties
, i
))
1708 if (BUFFERP (object
))
1709 signal_after_change (XINT (start
),
1710 XINT (end
) - XINT (start
),
1711 XINT (end
) - XINT (start
));
1717 else if (LENGTH (i
) == len
)
1719 if (!modified
&& BUFFERP (object
))
1720 modify_text_properties (object
, start
, end
);
1721 remove_properties (Qnil
, properties
, i
, object
);
1722 if (BUFFERP (object
))
1723 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1724 XINT (end
) - XINT (start
));
1728 { /* i has the properties, and goes past the change limit. */
1730 i
= split_interval_left (i
, len
);
1731 copy_properties (unchanged
, i
);
1732 if (!modified
&& BUFFERP (object
))
1733 modify_text_properties (object
, start
, end
);
1734 remove_properties (Qnil
, properties
, i
, object
);
1735 if (BUFFERP (object
))
1736 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1737 XINT (end
) - XINT (start
));
1741 if (interval_has_some_properties_list (properties
, i
))
1743 if (!modified
&& BUFFERP (object
))
1744 modify_text_properties (object
, start
, end
);
1745 remove_properties (Qnil
, properties
, i
, object
);
1749 i
= next_interval (i
);
1754 if (BUFFERP (object
))
1755 signal_after_change (XINT (start
),
1756 XINT (end
) - XINT (start
),
1757 XINT (end
) - XINT (start
));
1766 DEFUN ("text-property-any", Ftext_property_any
,
1767 Stext_property_any
, 4, 5, 0,
1768 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1769 If so, return the position of the first character whose property PROPERTY
1770 is `eq' to VALUE. Otherwise return nil.
1771 If the optional fifth argument OBJECT is a buffer (or nil, which means
1772 the current buffer), START and END are buffer positions (integers or
1773 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1774 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1776 register INTERVAL i
;
1777 register ptrdiff_t e
, pos
;
1780 XSETBUFFER (object
, current_buffer
);
1781 i
= validate_interval_range (object
, &start
, &end
, soft
);
1783 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1788 if (i
->position
>= e
)
1790 if (EQ (textget (i
->plist
, property
), value
))
1793 if (pos
< XINT (start
))
1795 return make_number (pos
);
1797 i
= next_interval (i
);
1802 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1803 Stext_property_not_all
, 4, 5, 0,
1804 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1805 If so, return the position of the first character whose property PROPERTY
1806 is not `eq' to VALUE. Otherwise, return nil.
1807 If the optional fifth argument OBJECT is a buffer (or nil, which means
1808 the current buffer), START and END are buffer positions (integers or
1809 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1810 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1812 register INTERVAL i
;
1813 register ptrdiff_t s
, e
;
1816 XSETBUFFER (object
, current_buffer
);
1817 i
= validate_interval_range (object
, &start
, &end
, soft
);
1819 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1825 if (i
->position
>= e
)
1827 if (! EQ (textget (i
->plist
, property
), value
))
1829 if (i
->position
> s
)
1831 return make_number (s
);
1833 i
= next_interval (i
);
1839 /* Return the direction from which the text-property PROP would be
1840 inherited by any new text inserted at POS: 1 if it would be
1841 inherited from the char after POS, -1 if it would be inherited from
1842 the char before POS, and 0 if from neither.
1843 BUFFER can be either a buffer or nil (meaning current buffer). */
1846 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1848 bool ignore_previous_character
;
1849 Lisp_Object prev_pos
= make_number (XINT (pos
) - 1);
1850 Lisp_Object front_sticky
;
1851 bool is_rear_sticky
= true, is_front_sticky
= false; /* defaults */
1852 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1855 XSETBUFFER (buffer
, current_buffer
);
1857 ignore_previous_character
= XINT (pos
) <= BUF_BEGV (XBUFFER (buffer
));
1859 if (ignore_previous_character
|| (CONSP (defalt
) && !NILP (XCDR (defalt
))))
1860 is_rear_sticky
= false;
1863 Lisp_Object rear_non_sticky
1864 = Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1866 if (!NILP (CONSP (rear_non_sticky
)
1867 ? Fmemq (prop
, rear_non_sticky
)
1869 /* PROP is rear-non-sticky. */
1870 is_rear_sticky
= false;
1873 /* Consider following character. */
1874 /* This signals an arg-out-of-range error if pos is outside the
1875 buffer's accessible range. */
1876 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1878 if (EQ (front_sticky
, Qt
)
1879 || (CONSP (front_sticky
)
1880 && !NILP (Fmemq (prop
, front_sticky
))))
1881 /* PROP is inherited from after. */
1882 is_front_sticky
= true;
1884 /* Simple cases, where the properties are consistent. */
1885 if (is_rear_sticky
&& !is_front_sticky
)
1887 else if (!is_rear_sticky
&& is_front_sticky
)
1889 else if (!is_rear_sticky
&& !is_front_sticky
)
1892 /* The stickiness properties are inconsistent, so we have to
1893 disambiguate. Basically, rear-sticky wins, _except_ if the
1894 property that would be inherited has a value of nil, in which case
1895 front-sticky wins. */
1896 if (ignore_previous_character
1897 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1904 /* Copying properties between objects. */
1906 /* Add properties from START to END of SRC, starting at POS in DEST.
1907 SRC and DEST may each refer to strings or buffers.
1908 Optional sixth argument PROP causes only that property to be copied.
1909 Properties are copied to DEST as if by `add-text-properties'.
1910 Return t if any property value actually changed, nil otherwise. */
1912 /* Note this can GC when DEST is a buffer. */
1915 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
,
1916 Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1922 ptrdiff_t s
, e
, e2
, p
, len
;
1924 struct gcpro gcpro1
, gcpro2
;
1926 i
= validate_interval_range (src
, &start
, &end
, soft
);
1930 CHECK_NUMBER_COERCE_MARKER (pos
);
1932 Lisp_Object dest_start
, dest_end
;
1934 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1935 if (MOST_POSITIVE_FIXNUM
< e
)
1936 args_out_of_range (pos
, end
);
1938 XSETFASTINT (dest_end
, e
);
1939 /* Apply this to a copy of pos; it will try to increment its arguments,
1940 which we don't want. */
1941 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1952 e2
= i
->position
+ LENGTH (i
);
1959 while (! NILP (plist
))
1961 if (EQ (Fcar (plist
), prop
))
1963 plist
= list2 (prop
, Fcar (Fcdr (plist
)));
1966 plist
= Fcdr (Fcdr (plist
));
1969 /* Must defer modifications to the interval tree in case
1970 src and dest refer to the same string or buffer. */
1971 stuff
= Fcons (list3 (make_number (p
), make_number (p
+ len
), plist
),
1974 i
= next_interval (i
);
1982 GCPRO2 (stuff
, dest
);
1984 while (! NILP (stuff
))
1987 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1988 Fcar (Fcdr (Fcdr (res
))), dest
);
1991 stuff
= Fcdr (stuff
);
1996 return modified
? Qt
: Qnil
;
2000 /* Return a list representing the text properties of OBJECT between
2001 START and END. if PROP is non-nil, report only on that property.
2002 Each result list element has the form (S E PLIST), where S and E
2003 are positions in OBJECT and PLIST is a property list containing the
2004 text properties of OBJECT between S and E. Value is nil if OBJECT
2005 doesn't contain text properties between START and END. */
2008 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
2015 i
= validate_interval_range (object
, &start
, &end
, soft
);
2018 ptrdiff_t s
= XINT (start
);
2019 ptrdiff_t e
= XINT (end
);
2023 ptrdiff_t interval_end
, len
;
2026 interval_end
= i
->position
+ LENGTH (i
);
2027 if (interval_end
> e
)
2029 len
= interval_end
- s
;
2034 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
2035 if (EQ (XCAR (plist
), prop
))
2037 plist
= list2 (prop
, Fcar (XCDR (plist
)));
2042 result
= Fcons (list3 (make_number (s
), make_number (s
+ len
),
2046 i
= next_interval (i
);
2057 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2058 (START END PLIST), where START and END are positions and PLIST is a
2059 property list containing the text properties to add. Adjust START
2060 and END positions by DELTA before adding properties. */
2063 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
2065 struct gcpro gcpro1
, gcpro2
;
2067 GCPRO2 (list
, object
);
2069 for (; CONSP (list
); list
= XCDR (list
))
2071 Lisp_Object item
, start
, end
, plist
;
2074 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2075 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2076 plist
= XCAR (XCDR (XCDR (item
)));
2078 Fadd_text_properties (start
, end
, plist
, object
);
2086 /* Modify end-points of ranges in LIST destructively, and return the
2087 new list. LIST is a list as returned from text_property_list.
2088 Discard properties that begin at or after NEW_END, and limit
2089 end-points to NEW_END. */
2092 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
2094 Lisp_Object prev
= Qnil
, head
= list
;
2095 ptrdiff_t max
= XINT (new_end
);
2097 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
2099 Lisp_Object item
, beg
, end
;
2103 end
= XCAR (XCDR (item
));
2105 if (XINT (beg
) >= max
)
2107 /* The start-point is past the end of the new string.
2108 Discard this property. */
2109 if (EQ (head
, list
))
2112 XSETCDR (prev
, XCDR (list
));
2114 else if (XINT (end
) > max
)
2115 /* The end-point is past the end of the new string. */
2116 XSETCAR (XCDR (item
), new_end
);
2124 /* Call the modification hook functions in LIST, each with START and END. */
2127 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
2129 struct gcpro gcpro1
;
2131 while (!NILP (list
))
2133 call2 (Fcar (list
), start
, end
);
2139 /* Check for read-only intervals between character positions START ... END,
2140 in BUF, and signal an error if we find one.
2142 Then check for any modification hooks in the range.
2143 Create a list of all these hooks in lexicographic order,
2144 eliminating consecutive extra copies of the same hook. Then call
2145 those hooks in order, with START and END - 1 as arguments. */
2148 verify_interval_modification (struct buffer
*buf
,
2149 ptrdiff_t start
, ptrdiff_t end
)
2151 INTERVAL intervals
= buffer_intervals (buf
);
2154 Lisp_Object prev_mod_hooks
;
2155 Lisp_Object mod_hooks
;
2156 struct gcpro gcpro1
;
2159 prev_mod_hooks
= Qnil
;
2162 interval_insert_behind_hooks
= Qnil
;
2163 interval_insert_in_front_hooks
= Qnil
;
2170 ptrdiff_t temp
= start
;
2175 /* For an insert operation, check the two chars around the position. */
2178 INTERVAL prev
= NULL
;
2179 Lisp_Object before
, after
;
2181 /* Set I to the interval containing the char after START,
2182 and PREV to the interval containing the char before START.
2183 Either one may be null. They may be equal. */
2184 i
= find_interval (intervals
, start
);
2186 if (start
== BUF_BEGV (buf
))
2188 else if (i
->position
== start
)
2189 prev
= previous_interval (i
);
2190 else if (i
->position
< start
)
2192 if (start
== BUF_ZV (buf
))
2195 /* If Vinhibit_read_only is set and is not a list, we can
2196 skip the read_only checks. */
2197 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2199 /* If I and PREV differ we need to check for the read-only
2200 property together with its stickiness. If either I or
2201 PREV are 0, this check is all we need.
2202 We have to take special care, since read-only may be
2203 indirectly defined via the category property. */
2208 after
= textget (i
->plist
, Qread_only
);
2210 /* If interval I is read-only and read-only is
2211 front-sticky, inhibit insertion.
2212 Check for read-only as well as category. */
2214 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2218 tem
= textget (i
->plist
, Qfront_sticky
);
2219 if (TMEM (Qread_only
, tem
)
2220 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2221 && TMEM (Qcategory
, tem
)))
2222 text_read_only (after
);
2228 before
= textget (prev
->plist
, Qread_only
);
2230 /* If interval PREV is read-only and read-only isn't
2231 rear-nonsticky, inhibit insertion.
2232 Check for read-only as well as category. */
2234 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2238 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2239 if (! TMEM (Qread_only
, tem
)
2240 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2241 || ! TMEM (Qcategory
, tem
)))
2242 text_read_only (before
);
2248 after
= textget (i
->plist
, Qread_only
);
2250 /* If interval I is read-only and read-only is
2251 front-sticky, inhibit insertion.
2252 Check for read-only as well as category. */
2253 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2257 tem
= textget (i
->plist
, Qfront_sticky
);
2258 if (TMEM (Qread_only
, tem
)
2259 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2260 && TMEM (Qcategory
, tem
)))
2261 text_read_only (after
);
2263 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2264 if (! TMEM (Qread_only
, tem
)
2265 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2266 || ! TMEM (Qcategory
, tem
)))
2267 text_read_only (after
);
2272 /* Run both insert hooks (just once if they're the same). */
2274 interval_insert_behind_hooks
2275 = textget (prev
->plist
, Qinsert_behind_hooks
);
2277 interval_insert_in_front_hooks
2278 = textget (i
->plist
, Qinsert_in_front_hooks
);
2282 /* Loop over intervals on or next to START...END,
2283 collecting their hooks. */
2285 i
= find_interval (intervals
, start
);
2288 if (! INTERVAL_WRITABLE_P (i
))
2289 text_read_only (textget (i
->plist
, Qread_only
));
2291 if (!inhibit_modification_hooks
)
2293 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2294 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2296 hooks
= Fcons (mod_hooks
, hooks
);
2297 prev_mod_hooks
= mod_hooks
;
2301 if (i
->position
+ LENGTH (i
) < end
2302 && (!NILP (BVAR (current_buffer
, read_only
))
2303 && NILP (Vinhibit_read_only
)))
2304 xsignal1 (Qbuffer_read_only
, Fcurrent_buffer ());
2306 i
= next_interval (i
);
2308 /* Keep going thru the interval containing the char before END. */
2309 while (i
&& i
->position
< end
);
2311 if (!inhibit_modification_hooks
)
2314 hooks
= Fnreverse (hooks
);
2315 while (! EQ (hooks
, Qnil
))
2317 call_mod_hooks (Fcar (hooks
), make_number (start
),
2319 hooks
= Fcdr (hooks
);
2326 /* Run the interval hooks for an insertion on character range START ... END.
2327 verify_interval_modification chose which hooks to run;
2328 this function is called after the insertion happens
2329 so it can indicate the range of inserted text. */
2332 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2334 if (! NILP (interval_insert_behind_hooks
))
2335 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2336 if (! NILP (interval_insert_in_front_hooks
)
2337 && ! EQ (interval_insert_in_front_hooks
,
2338 interval_insert_behind_hooks
))
2339 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2343 syms_of_textprop (void)
2345 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2346 doc
: /* Property-list used as default values.
2347 The value of a property in this list is seen as the value for every
2348 character that does not have its own value for that property. */);
2349 Vdefault_text_properties
= Qnil
;
2351 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2352 doc
: /* Alist of alternative properties for properties without a value.
2353 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2354 If a piece of text has no direct value for a particular property, then
2355 this alist is consulted. If that property appears in the alist, then
2356 the first non-nil value from the associated alternative properties is
2358 Vchar_property_alias_alist
= Qnil
;
2360 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2361 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2362 This also inhibits the use of the `intangible' text property. */);
2363 Vinhibit_point_motion_hooks
= Qnil
;
2365 DEFVAR_LISP ("text-property-default-nonsticky",
2366 Vtext_property_default_nonsticky
,
2367 doc
: /* Alist of properties vs the corresponding non-stickiness.
2368 Each element has the form (PROPERTY . NONSTICKINESS).
2370 If a character in a buffer has PROPERTY, new text inserted adjacent to
2371 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2372 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2373 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2374 /* Text properties `syntax-table'and `display' should be nonsticky
2376 Vtext_property_default_nonsticky
2377 = list2 (Fcons (intern_c_string ("syntax-table"), Qt
),
2378 Fcons (intern_c_string ("display"), Qt
));
2380 staticpro (&interval_insert_behind_hooks
);
2381 staticpro (&interval_insert_in_front_hooks
);
2382 interval_insert_behind_hooks
= Qnil
;
2383 interval_insert_in_front_hooks
= Qnil
;
2386 /* Common attributes one might give text */
2388 DEFSYM (Qforeground
, "foreground");
2389 DEFSYM (Qbackground
, "background");
2390 DEFSYM (Qfont
, "font");
2391 DEFSYM (Qface
, "face");
2392 DEFSYM (Qstipple
, "stipple");
2393 DEFSYM (Qunderline
, "underline");
2394 DEFSYM (Qread_only
, "read-only");
2395 DEFSYM (Qinvisible
, "invisible");
2396 DEFSYM (Qintangible
, "intangible");
2397 DEFSYM (Qcategory
, "category");
2398 DEFSYM (Qlocal_map
, "local-map");
2399 DEFSYM (Qfront_sticky
, "front-sticky");
2400 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2401 DEFSYM (Qmouse_face
, "mouse-face");
2402 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2404 /* Properties that text might use to specify certain actions */
2406 DEFSYM (Qmouse_left
, "mouse-left");
2407 DEFSYM (Qmouse_entered
, "mouse-entered");
2408 DEFSYM (Qpoint_left
, "point-left");
2409 DEFSYM (Qpoint_entered
, "point-entered");
2411 defsubr (&Stext_properties_at
);
2412 defsubr (&Sget_text_property
);
2413 defsubr (&Sget_char_property
);
2414 defsubr (&Sget_char_property_and_overlay
);
2415 defsubr (&Snext_char_property_change
);
2416 defsubr (&Sprevious_char_property_change
);
2417 defsubr (&Snext_single_char_property_change
);
2418 defsubr (&Sprevious_single_char_property_change
);
2419 defsubr (&Snext_property_change
);
2420 defsubr (&Snext_single_property_change
);
2421 defsubr (&Sprevious_property_change
);
2422 defsubr (&Sprevious_single_property_change
);
2423 defsubr (&Sadd_text_properties
);
2424 defsubr (&Sput_text_property
);
2425 defsubr (&Sset_text_properties
);
2426 defsubr (&Sadd_face_text_property
);
2427 defsubr (&Sremove_text_properties
);
2428 defsubr (&Sremove_list_of_text_properties
);
2429 defsubr (&Stext_property_any
);
2430 defsubr (&Stext_property_not_all
);