1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 Free Software Foundation, Inc.
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 2, or (at your option)
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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
24 #include "intervals.h"
29 #define NULL (void *)0
32 /* Test for membership, allowing for t (actually any non-cons) to mean the
35 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
38 /* NOTES: previous- and next- property change will have to skip
39 zero-length intervals if they are implemented. This could be done
40 inside next_interval and previous_interval.
42 set_properties needs to deal with the interval property cache.
44 It is assumed that for any interval plist, a property appears
45 only once on the list. Although some code i.e., remove_properties,
46 handles the more general case, the uniqueness of properties is
47 necessary for the system to remain consistent. This requirement
48 is enforced by the subrs installing properties onto the intervals. */
52 Lisp_Object Qmouse_left
;
53 Lisp_Object Qmouse_entered
;
54 Lisp_Object Qpoint_left
;
55 Lisp_Object Qpoint_entered
;
56 Lisp_Object Qcategory
;
57 Lisp_Object Qlocal_map
;
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
61 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
71 Lisp_Object Vinhibit_point_motion_hooks
;
72 Lisp_Object Vdefault_text_properties
;
73 Lisp_Object Vchar_property_alias_alist
;
74 Lisp_Object Vtext_property_default_nonsticky
;
76 /* verify_interval_modification saves insertion hooks here
77 to be run later by report_interval_modification. */
78 Lisp_Object interval_insert_behind_hooks
;
79 Lisp_Object interval_insert_in_front_hooks
;
82 /* Signal a `text-read-only' error. This function makes it easier
83 to capture that error in GDB by putting a breakpoint on it. */
86 text_read_only (propval
)
89 if (STRINGP (propval
))
90 xsignal1 (Qtext_read_only
, propval
);
92 xsignal0 (Qtext_read_only
);
97 /* Extract the interval at the position pointed to by BEGIN from
98 OBJECT, a string or buffer. Additionally, check that the positions
99 pointed to by BEGIN and END are within the bounds of OBJECT, and
100 reverse them if *BEGIN is greater than *END. The objects pointed
101 to by BEGIN and END may be integers or markers; if the latter, they
102 are coerced to integers.
104 When OBJECT is a string, we increment *BEGIN and *END
105 to make them origin-one.
107 Note that buffer points don't correspond to interval indices.
108 For example, point-max is 1 greater than the index of the last
109 character. This difference is handled in the caller, which uses
110 the validated points to determine a length, and operates on that.
111 Exceptions are Ftext_properties_at, Fnext_property_change, and
112 Fprevious_property_change which call this function with BEGIN == END.
113 Handle this case specially.
115 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
116 create an interval tree for OBJECT if one doesn't exist, provided
117 the object actually contains text. In the current design, if there
118 is no text, there can be no text properties. */
124 validate_interval_range (object
, begin
, end
, force
)
125 Lisp_Object object
, *begin
, *end
;
131 CHECK_STRING_OR_BUFFER (object
);
132 CHECK_NUMBER_COERCE_MARKER (*begin
);
133 CHECK_NUMBER_COERCE_MARKER (*end
);
135 /* If we are asked for a point, but from a subr which operates
136 on a range, then return nothing. */
137 if (EQ (*begin
, *end
) && begin
!= end
)
138 return NULL_INTERVAL
;
140 if (XINT (*begin
) > XINT (*end
))
148 if (BUFFERP (object
))
150 register struct buffer
*b
= XBUFFER (object
);
152 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
153 && XINT (*end
) <= BUF_ZV (b
)))
154 args_out_of_range (*begin
, *end
);
155 i
= BUF_INTERVALS (b
);
157 /* If there's no text, there are no properties. */
158 if (BUF_BEGV (b
) == BUF_ZV (b
))
159 return NULL_INTERVAL
;
161 searchpos
= XINT (*begin
);
165 int len
= SCHARS (object
);
167 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
168 && XINT (*end
) <= len
))
169 args_out_of_range (*begin
, *end
);
170 XSETFASTINT (*begin
, XFASTINT (*begin
));
172 XSETFASTINT (*end
, XFASTINT (*end
));
173 i
= STRING_INTERVALS (object
);
176 return NULL_INTERVAL
;
178 searchpos
= XINT (*begin
);
181 if (NULL_INTERVAL_P (i
))
182 return (force
? create_root_interval (object
) : i
);
184 return find_interval (i
, searchpos
);
187 /* Validate LIST as a property list. If LIST is not a list, then
188 make one consisting of (LIST nil). Otherwise, verify that LIST
189 is even numbered and thus suitable as a plist. */
192 validate_plist (list
)
201 register Lisp_Object tail
;
202 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
208 error ("Odd length text property list");
212 return Fcons (list
, Fcons (Qnil
, Qnil
));
215 /* Return nonzero if interval I has all the properties,
216 with the same values, of list PLIST. */
219 interval_has_all_properties (plist
, i
)
223 register Lisp_Object tail1
, tail2
, sym1
;
226 /* Go through each element of PLIST. */
227 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
232 /* Go through I's plist, looking for sym1 */
233 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
234 if (EQ (sym1
, Fcar (tail2
)))
236 /* Found the same property on both lists. If the
237 values are unequal, return zero. */
238 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
241 /* Property has same value on both lists; go to next one. */
253 /* Return nonzero if the plist of interval I has any of the
254 properties of PLIST, regardless of their values. */
257 interval_has_some_properties (plist
, i
)
261 register Lisp_Object tail1
, tail2
, sym
;
263 /* Go through each element of PLIST. */
264 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
268 /* Go through i's plist, looking for tail1 */
269 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
270 if (EQ (sym
, Fcar (tail2
)))
277 /* Return nonzero if the plist of interval I has any of the
278 property names in LIST, regardless of their values. */
281 interval_has_some_properties_list (list
, i
)
285 register Lisp_Object tail1
, tail2
, sym
;
287 /* Go through each element of LIST. */
288 for (tail1
= list
; ! NILP (tail1
); tail1
= XCDR (tail1
))
292 /* Go through i's plist, looking for tail1 */
293 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= XCDR (XCDR (tail2
)))
294 if (EQ (sym
, XCAR (tail2
)))
301 /* Changing the plists of individual intervals. */
303 /* Return the value of PROP in property-list PLIST, or Qunbound if it
306 property_value (plist
, prop
)
307 Lisp_Object plist
, prop
;
311 while (PLIST_ELT_P (plist
, value
))
312 if (EQ (XCAR (plist
), prop
))
315 plist
= XCDR (value
);
320 /* Set the properties of INTERVAL to PROPERTIES,
321 and record undo info for the previous values.
322 OBJECT is the string or buffer that INTERVAL belongs to. */
325 set_properties (properties
, interval
, object
)
326 Lisp_Object properties
, object
;
329 Lisp_Object sym
, value
;
331 if (BUFFERP (object
))
333 /* For each property in the old plist which is missing from PROPERTIES,
334 or has a different value in PROPERTIES, make an undo record. */
335 for (sym
= interval
->plist
;
336 PLIST_ELT_P (sym
, value
);
338 if (! EQ (property_value (properties
, XCAR (sym
)),
341 record_property_change (interval
->position
, LENGTH (interval
),
342 XCAR (sym
), XCAR (value
),
346 /* For each new property that has no value at all in the old plist,
347 make an undo record binding it to nil, so it will be removed. */
348 for (sym
= properties
;
349 PLIST_ELT_P (sym
, value
);
351 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
353 record_property_change (interval
->position
, LENGTH (interval
),
359 /* Store new properties. */
360 interval
->plist
= Fcopy_sequence (properties
);
363 /* Add the properties of PLIST to the interval I, or set
364 the value of I's property to the value of the property on PLIST
365 if they are different.
367 OBJECT should be the string or buffer the interval is in.
369 Return nonzero if this changes I (i.e., if any members of PLIST
370 are actually added to I's plist) */
373 add_properties (plist
, i
, object
)
378 Lisp_Object tail1
, tail2
, sym1
, val1
;
379 register int changed
= 0;
381 struct gcpro gcpro1
, gcpro2
, gcpro3
;
386 /* No need to protect OBJECT, because we can GC only in the case
387 where it is a buffer, and live buffers are always protected.
388 I and its plist are also protected, via OBJECT. */
389 GCPRO3 (tail1
, sym1
, val1
);
391 /* Go through each element of PLIST. */
392 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
395 val1
= Fcar (Fcdr (tail1
));
398 /* Go through I's plist, looking for sym1 */
399 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
400 if (EQ (sym1
, Fcar (tail2
)))
402 /* No need to gcpro, because tail2 protects this
403 and it must be a cons cell (we get an error otherwise). */
404 register Lisp_Object this_cdr
;
406 this_cdr
= Fcdr (tail2
);
407 /* Found the property. Now check its value. */
410 /* The properties have the same value on both lists.
411 Continue to the next property. */
412 if (EQ (val1
, Fcar (this_cdr
)))
415 /* Record this change in the buffer, for undo purposes. */
416 if (BUFFERP (object
))
418 record_property_change (i
->position
, LENGTH (i
),
419 sym1
, Fcar (this_cdr
), object
);
422 /* I's property has a different value -- change it */
423 Fsetcar (this_cdr
, val1
);
430 /* Record this change in the buffer, for undo purposes. */
431 if (BUFFERP (object
))
433 record_property_change (i
->position
, LENGTH (i
),
436 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
446 /* For any members of PLIST, or LIST,
447 which are properties of I, remove them from I's plist.
448 (If PLIST is non-nil, use that, otherwise use LIST.)
449 OBJECT is the string or buffer containing I. */
452 remove_properties (plist
, list
, i
, object
)
453 Lisp_Object plist
, list
;
457 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
458 register int changed
= 0;
460 /* Nonzero means tail1 is a plist, otherwise it is a list. */
463 current_plist
= i
->plist
;
466 tail1
= plist
, use_plist
= 1;
468 tail1
= list
, use_plist
= 0;
470 /* Go through each element of LIST or PLIST. */
471 while (CONSP (tail1
))
475 /* First, remove the symbol if it's at the head of the list */
476 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
478 if (BUFFERP (object
))
479 record_property_change (i
->position
, LENGTH (i
),
480 sym
, XCAR (XCDR (current_plist
)),
483 current_plist
= XCDR (XCDR (current_plist
));
487 /* Go through I's plist, looking for SYM. */
488 tail2
= current_plist
;
489 while (! NILP (tail2
))
491 register Lisp_Object
this;
492 this = XCDR (XCDR (tail2
));
493 if (CONSP (this) && EQ (sym
, XCAR (this)))
495 if (BUFFERP (object
))
496 record_property_change (i
->position
, LENGTH (i
),
497 sym
, XCAR (XCDR (this)), object
);
499 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
505 /* Advance thru TAIL1 one way or the other. */
506 tail1
= XCDR (tail1
);
507 if (use_plist
&& CONSP (tail1
))
508 tail1
= XCDR (tail1
);
512 i
->plist
= current_plist
;
517 /* Remove all properties from interval I. Return non-zero
518 if this changes the interval. */
532 /* Returns the interval of POSITION in OBJECT.
533 POSITION is BEG-based. */
536 interval_of (position
, object
)
544 XSETBUFFER (object
, current_buffer
);
545 else if (EQ (object
, Qt
))
546 return NULL_INTERVAL
;
548 CHECK_STRING_OR_BUFFER (object
);
550 if (BUFFERP (object
))
552 register struct buffer
*b
= XBUFFER (object
);
556 i
= BUF_INTERVALS (b
);
561 end
= SCHARS (object
);
562 i
= STRING_INTERVALS (object
);
565 if (!(beg
<= position
&& position
<= end
))
566 args_out_of_range (make_number (position
), make_number (position
));
567 if (beg
== end
|| NULL_INTERVAL_P (i
))
568 return NULL_INTERVAL
;
570 return find_interval (i
, position
);
573 DEFUN ("text-properties-at", Ftext_properties_at
,
574 Stext_properties_at
, 1, 2, 0,
575 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
576 If the optional second argument OBJECT is a buffer (or nil, which means
577 the current buffer), POSITION is a buffer position (integer or marker).
578 If OBJECT is a string, POSITION is a 0-based index into it.
579 If POSITION is at the end of OBJECT, the value is nil. */)
581 Lisp_Object position
, object
;
586 XSETBUFFER (object
, current_buffer
);
588 i
= validate_interval_range (object
, &position
, &position
, soft
);
589 if (NULL_INTERVAL_P (i
))
591 /* If POSITION is at the end of the interval,
592 it means it's the end of OBJECT.
593 There are no properties at the very end,
594 since no character follows. */
595 if (XINT (position
) == LENGTH (i
) + i
->position
)
601 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
602 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
603 OBJECT is optional and defaults to the current buffer.
604 If POSITION is at the end of OBJECT, the value is nil. */)
605 (position
, prop
, object
)
606 Lisp_Object position
, object
;
609 return textget (Ftext_properties_at (position
, object
), prop
);
612 /* Return the value of char's property PROP, in OBJECT at POSITION.
613 OBJECT is optional and defaults to the current buffer.
614 If OVERLAY is non-0, then in the case that the returned property is from
615 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
616 returned in *OVERLAY.
617 If POSITION is at the end of OBJECT, the value is nil.
618 If OBJECT is a buffer, then overlay properties are considered as well as
620 If OBJECT is a window, then that window's buffer is used, but
621 window-specific overlays are considered only if they are associated
624 get_char_property_and_overlay (position
, prop
, object
, overlay
)
625 Lisp_Object position
, object
;
626 register Lisp_Object prop
;
627 Lisp_Object
*overlay
;
629 struct window
*w
= 0;
631 CHECK_NUMBER_COERCE_MARKER (position
);
634 XSETBUFFER (object
, current_buffer
);
636 if (WINDOWP (object
))
638 w
= XWINDOW (object
);
641 if (BUFFERP (object
))
644 Lisp_Object
*overlay_vec
;
645 struct buffer
*obuf
= current_buffer
;
647 set_buffer_temp (XBUFFER (object
));
649 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
650 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
652 set_buffer_temp (obuf
);
654 /* Now check the overlays in order of decreasing priority. */
655 while (--noverlays
>= 0)
657 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
661 /* Return the overlay we got the property from. */
662 *overlay
= overlay_vec
[noverlays
];
669 /* Indicate that the return value is not from an overlay. */
672 /* Not a buffer, or no appropriate overlay, so fall through to the
674 return Fget_text_property (position
, prop
, object
);
677 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
678 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
679 Both overlay properties and text properties are checked.
680 OBJECT is optional and defaults to the current buffer.
681 If POSITION is at the end of OBJECT, the value is nil.
682 If OBJECT is a buffer, then overlay properties are considered as well as
684 If OBJECT is a window, then that window's buffer is used, but window-specific
685 overlays are considered only if they are associated with OBJECT. */)
686 (position
, prop
, object
)
687 Lisp_Object position
, object
;
688 register Lisp_Object prop
;
690 return get_char_property_and_overlay (position
, prop
, object
, 0);
693 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
694 Sget_char_property_and_overlay
, 2, 3, 0,
695 doc
: /* Like `get-char-property', but with extra overlay information.
696 The value is a cons cell. Its car is the return value of `get-char-property'
697 with the same arguments--that is, the value of POSITION's property
698 PROP in OBJECT. Its cdr is the overlay in which the property was
699 found, or nil, if it was found as a text property or not found at all.
701 OBJECT is optional and defaults to the current buffer. OBJECT may be
702 a string, a buffer or a window. For strings, the cdr of the return
703 value is always nil, since strings do not have overlays. If OBJECT is
704 a window, then that window's buffer is used, but window-specific
705 overlays are considered only if they are associated with OBJECT. If
706 POSITION is at the end of OBJECT, both car and cdr are nil. */)
707 (position
, prop
, object
)
708 Lisp_Object position
, object
;
709 register Lisp_Object prop
;
713 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
714 return Fcons(val
, overlay
);
718 DEFUN ("next-char-property-change", Fnext_char_property_change
,
719 Snext_char_property_change
, 1, 2, 0,
720 doc
: /* Return the position of next text property or overlay change.
721 This scans characters forward in the current buffer from POSITION till
722 it finds a change in some text property, or the beginning or end of an
723 overlay, and returns the position of that.
724 If none is found up to (point-max), the function returns (point-max).
726 If the optional second argument LIMIT is non-nil, don't search
727 past position LIMIT; return LIMIT if nothing is found before LIMIT.
728 LIMIT is a no-op if it is greater than (point-max). */)
730 Lisp_Object position
, limit
;
734 temp
= Fnext_overlay_change (position
);
737 CHECK_NUMBER_COERCE_MARKER (limit
);
738 if (XINT (limit
) < XINT (temp
))
741 return Fnext_property_change (position
, Qnil
, temp
);
744 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
745 Sprevious_char_property_change
, 1, 2, 0,
746 doc
: /* Return the position of previous text property or overlay change.
747 Scans characters backward in the current buffer from POSITION till it
748 finds a change in some text property, or the beginning or end of an
749 overlay, and returns the position of that.
750 If none is found since (point-min), the function returns (point-min).
752 If the optional second argument LIMIT is non-nil, don't search
753 past position LIMIT; return LIMIT if nothing is found before LIMIT.
754 LIMIT is a no-op if it is less than (point-min). */)
756 Lisp_Object position
, 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 (position
, prop
, object
, limit
)
789 Lisp_Object prop
, position
, object
, limit
;
791 if (STRINGP (object
))
793 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
797 position
= make_number (SCHARS (object
));
800 CHECK_NUMBER (limit
);
807 Lisp_Object initial_value
, value
;
808 int count
= SPECPDL_INDEX ();
811 CHECK_BUFFER (object
);
813 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
815 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
816 Fset_buffer (object
);
819 CHECK_NUMBER_COERCE_MARKER (position
);
821 initial_value
= Fget_char_property (position
, prop
, object
);
824 XSETFASTINT (limit
, ZV
);
826 CHECK_NUMBER_COERCE_MARKER (limit
);
828 if (XFASTINT (position
) >= XFASTINT (limit
))
831 if (XFASTINT (position
) > ZV
)
832 XSETFASTINT (position
, ZV
);
837 position
= Fnext_char_property_change (position
, limit
);
838 if (XFASTINT (position
) >= XFASTINT (limit
))
844 value
= Fget_char_property (position
, prop
, object
);
845 if (!EQ (value
, initial_value
))
849 unbind_to (count
, Qnil
);
855 DEFUN ("previous-single-char-property-change",
856 Fprevious_single_char_property_change
,
857 Sprevious_single_char_property_change
, 2, 4, 0,
858 doc
: /* Return the position of previous text property or overlay change for a specific property.
859 Scans characters backward from POSITION till it finds
860 a change in the PROP property, then returns the position of the change.
861 If the optional third argument OBJECT is a buffer (or nil, which means
862 the current buffer), POSITION is a buffer position (integer or marker).
863 If OBJECT is a string, POSITION is a 0-based index into it.
865 In a string, scan runs to the start of the string.
866 In a buffer, it runs to (point-min), and the value cannot be less than that.
868 The property values are compared with `eq'.
869 If the property is constant all the way to the start of OBJECT, return the
870 first valid position in OBJECT.
871 If the optional fourth argument LIMIT is non-nil, don't search
872 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
873 (position
, prop
, object
, limit
)
874 Lisp_Object prop
, position
, object
, limit
;
876 if (STRINGP (object
))
878 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
882 position
= make_number (SCHARS (object
));
885 CHECK_NUMBER (limit
);
892 int count
= SPECPDL_INDEX ();
895 CHECK_BUFFER (object
);
897 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
899 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
900 Fset_buffer (object
);
903 CHECK_NUMBER_COERCE_MARKER (position
);
906 XSETFASTINT (limit
, BEGV
);
908 CHECK_NUMBER_COERCE_MARKER (limit
);
910 if (XFASTINT (position
) <= XFASTINT (limit
))
913 if (XFASTINT (position
) < BEGV
)
914 XSETFASTINT (position
, BEGV
);
918 Lisp_Object initial_value
919 = Fget_char_property (make_number (XFASTINT (position
) - 1),
924 position
= Fprevious_char_property_change (position
, limit
);
926 if (XFASTINT (position
) <= XFASTINT (limit
))
934 = Fget_char_property (make_number (XFASTINT (position
) - 1),
937 if (!EQ (value
, initial_value
))
943 unbind_to (count
, Qnil
);
949 DEFUN ("next-property-change", Fnext_property_change
,
950 Snext_property_change
, 1, 3, 0,
951 doc
: /* Return the position of next property change.
952 Scans characters forward from POSITION in OBJECT till it finds
953 a change in some text property, then returns the position of the change.
954 If the optional second argument OBJECT is a buffer (or nil, which means
955 the current buffer), POSITION is a buffer position (integer or marker).
956 If OBJECT is a string, POSITION is a 0-based index into it.
957 Return nil if the property is constant all the way to the end of OBJECT.
958 If the value is non-nil, it is a position greater than POSITION, never equal.
960 If the optional third argument LIMIT is non-nil, don't search
961 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
962 (position
, object
, limit
)
963 Lisp_Object position
, object
, limit
;
965 register INTERVAL i
, next
;
968 XSETBUFFER (object
, current_buffer
);
970 if (!NILP (limit
) && !EQ (limit
, Qt
))
971 CHECK_NUMBER_COERCE_MARKER (limit
);
973 i
= validate_interval_range (object
, &position
, &position
, soft
);
975 /* If LIMIT is t, return start of next interval--don't
976 bother checking further intervals. */
979 if (NULL_INTERVAL_P (i
))
982 next
= next_interval (i
);
984 if (NULL_INTERVAL_P (next
))
985 XSETFASTINT (position
, (STRINGP (object
)
987 : BUF_ZV (XBUFFER (object
))));
989 XSETFASTINT (position
, next
->position
);
993 if (NULL_INTERVAL_P (i
))
996 next
= next_interval (i
);
998 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
999 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1000 next
= next_interval (next
);
1002 if (NULL_INTERVAL_P (next
))
1005 XSETFASTINT (limit
, (STRINGP (object
)
1007 : BUF_ZV (XBUFFER (object
))));
1008 if (!(next
->position
< XFASTINT (limit
)))
1011 XSETFASTINT (position
, next
->position
);
1015 /* Return 1 if there's a change in some property between BEG and END. */
1018 property_change_between_p (beg
, end
)
1021 register INTERVAL i
, next
;
1022 Lisp_Object object
, pos
;
1024 XSETBUFFER (object
, current_buffer
);
1025 XSETFASTINT (pos
, beg
);
1027 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
1028 if (NULL_INTERVAL_P (i
))
1031 next
= next_interval (i
);
1032 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
1034 next
= next_interval (next
);
1035 if (NULL_INTERVAL_P (next
))
1037 if (next
->position
>= end
)
1041 if (NULL_INTERVAL_P (next
))
1047 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1048 Snext_single_property_change
, 2, 4, 0,
1049 doc
: /* Return the position of next property change for a specific property.
1050 Scans characters forward from POSITION till it finds
1051 a change in the PROP property, then returns the position of the change.
1052 If the optional third argument OBJECT is a buffer (or nil, which means
1053 the current buffer), POSITION is a buffer position (integer or marker).
1054 If OBJECT is a string, POSITION is a 0-based index into it.
1055 The property values are compared with `eq'.
1056 Return nil if the property is constant all the way to the end of OBJECT.
1057 If the value is non-nil, it is a position greater than POSITION, never equal.
1059 If the optional fourth argument LIMIT is non-nil, don't search
1060 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1061 (position
, prop
, object
, limit
)
1062 Lisp_Object position
, prop
, object
, limit
;
1064 register INTERVAL i
, next
;
1065 register Lisp_Object here_val
;
1068 XSETBUFFER (object
, current_buffer
);
1071 CHECK_NUMBER_COERCE_MARKER (limit
);
1073 i
= validate_interval_range (object
, &position
, &position
, soft
);
1074 if (NULL_INTERVAL_P (i
))
1077 here_val
= textget (i
->plist
, prop
);
1078 next
= next_interval (i
);
1079 while (! NULL_INTERVAL_P (next
)
1080 && EQ (here_val
, textget (next
->plist
, prop
))
1081 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1082 next
= next_interval (next
);
1084 if (NULL_INTERVAL_P (next
))
1087 XSETFASTINT (limit
, (STRINGP (object
)
1089 : BUF_ZV (XBUFFER (object
))));
1090 if (!(next
->position
< XFASTINT (limit
)))
1093 return make_number (next
->position
);
1096 DEFUN ("previous-property-change", Fprevious_property_change
,
1097 Sprevious_property_change
, 1, 3, 0,
1098 doc
: /* Return the position of previous property change.
1099 Scans characters backwards from POSITION in OBJECT till it finds
1100 a change in some text property, then returns the position of the change.
1101 If the optional second argument OBJECT is a buffer (or nil, which means
1102 the current buffer), POSITION is a buffer position (integer or marker).
1103 If OBJECT is a string, POSITION is a 0-based index into it.
1104 Return nil if the property is constant all the way to the start of OBJECT.
1105 If the value is non-nil, it is a position less than POSITION, never equal.
1107 If the optional third argument LIMIT is non-nil, don't search
1108 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1109 (position
, object
, limit
)
1110 Lisp_Object position
, object
, limit
;
1112 register INTERVAL i
, previous
;
1115 XSETBUFFER (object
, current_buffer
);
1118 CHECK_NUMBER_COERCE_MARKER (limit
);
1120 i
= validate_interval_range (object
, &position
, &position
, soft
);
1121 if (NULL_INTERVAL_P (i
))
1124 /* Start with the interval containing the char before point. */
1125 if (i
->position
== XFASTINT (position
))
1126 i
= previous_interval (i
);
1128 previous
= previous_interval (i
);
1129 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1131 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1132 previous
= previous_interval (previous
);
1133 if (NULL_INTERVAL_P (previous
))
1136 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1137 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1140 return make_number (previous
->position
+ LENGTH (previous
));
1143 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1144 Sprevious_single_property_change
, 2, 4, 0,
1145 doc
: /* Return the position of previous property change for a specific property.
1146 Scans characters backward from POSITION till it finds
1147 a change in the PROP property, then returns the position of the change.
1148 If the optional third argument OBJECT is a buffer (or nil, which means
1149 the current buffer), POSITION is a buffer position (integer or marker).
1150 If OBJECT is a string, POSITION is a 0-based index into it.
1151 The property values are compared with `eq'.
1152 Return nil if the property is constant all the way to the start of OBJECT.
1153 If the value is non-nil, it is a position less than POSITION, never equal.
1155 If the optional fourth argument LIMIT is non-nil, don't search
1156 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1157 (position
, prop
, object
, limit
)
1158 Lisp_Object position
, prop
, object
, limit
;
1160 register INTERVAL i
, previous
;
1161 register Lisp_Object here_val
;
1164 XSETBUFFER (object
, current_buffer
);
1167 CHECK_NUMBER_COERCE_MARKER (limit
);
1169 i
= validate_interval_range (object
, &position
, &position
, soft
);
1171 /* Start with the interval containing the char before point. */
1172 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1173 i
= previous_interval (i
);
1175 if (NULL_INTERVAL_P (i
))
1178 here_val
= textget (i
->plist
, prop
);
1179 previous
= previous_interval (i
);
1180 while (!NULL_INTERVAL_P (previous
)
1181 && EQ (here_val
, textget (previous
->plist
, prop
))
1183 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1184 previous
= previous_interval (previous
);
1185 if (NULL_INTERVAL_P (previous
))
1188 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1189 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1192 return make_number (previous
->position
+ LENGTH (previous
));
1195 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1197 DEFUN ("add-text-properties", Fadd_text_properties
,
1198 Sadd_text_properties
, 3, 4, 0,
1199 doc
: /* Add properties to the text from START to END.
1200 The third argument PROPERTIES is a property list
1201 specifying the property values to add. If the optional fourth argument
1202 OBJECT is a buffer (or nil, which means the current buffer),
1203 START and END are buffer positions (integers or markers).
1204 If OBJECT is a string, START and END are 0-based indices into it.
1205 Return t if any property value actually changed, nil otherwise. */)
1206 (start
, end
, properties
, object
)
1207 Lisp_Object start
, end
, properties
, object
;
1209 register INTERVAL i
, unchanged
;
1210 register int s
, len
, modified
= 0;
1211 struct gcpro gcpro1
;
1213 properties
= validate_plist (properties
);
1214 if (NILP (properties
))
1218 XSETBUFFER (object
, current_buffer
);
1220 i
= validate_interval_range (object
, &start
, &end
, hard
);
1221 if (NULL_INTERVAL_P (i
))
1225 len
= XINT (end
) - s
;
1227 /* No need to protect OBJECT, because we GC only if it's a buffer,
1228 and live buffers are always protected. */
1229 GCPRO1 (properties
);
1231 /* If we're not starting on an interval boundary, we have to
1232 split this interval. */
1233 if (i
->position
!= s
)
1235 /* If this interval already has the properties, we can
1237 if (interval_has_all_properties (properties
, i
))
1239 int got
= (LENGTH (i
) - (s
- i
->position
));
1241 RETURN_UNGCPRO (Qnil
);
1243 i
= next_interval (i
);
1248 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1249 copy_properties (unchanged
, i
);
1253 if (BUFFERP (object
))
1254 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1256 /* We are at the beginning of interval I, with LEN chars to scan. */
1262 if (LENGTH (i
) >= len
)
1264 /* We can UNGCPRO safely here, because there will be just
1265 one more chance to gc, in the next call to add_properties,
1266 and after that we will not need PROPERTIES or OBJECT again. */
1269 if (interval_has_all_properties (properties
, i
))
1271 if (BUFFERP (object
))
1272 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1273 XINT (end
) - XINT (start
));
1275 return modified
? Qt
: Qnil
;
1278 if (LENGTH (i
) == len
)
1280 add_properties (properties
, i
, object
);
1281 if (BUFFERP (object
))
1282 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1283 XINT (end
) - XINT (start
));
1287 /* i doesn't have the properties, and goes past the change limit */
1289 i
= split_interval_left (unchanged
, len
);
1290 copy_properties (unchanged
, i
);
1291 add_properties (properties
, i
, object
);
1292 if (BUFFERP (object
))
1293 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1294 XINT (end
) - XINT (start
));
1299 modified
+= add_properties (properties
, i
, object
);
1300 i
= next_interval (i
);
1304 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1306 DEFUN ("put-text-property", Fput_text_property
,
1307 Sput_text_property
, 4, 5, 0,
1308 doc
: /* Set one property of the text from START to END.
1309 The third and fourth arguments PROPERTY and VALUE
1310 specify the property to add.
1311 If the optional fifth argument OBJECT is a buffer (or nil, which means
1312 the current buffer), START and END are buffer positions (integers or
1313 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1314 (start
, end
, property
, value
, object
)
1315 Lisp_Object start
, end
, property
, value
, object
;
1317 Fadd_text_properties (start
, end
,
1318 Fcons (property
, Fcons (value
, Qnil
)),
1323 DEFUN ("set-text-properties", Fset_text_properties
,
1324 Sset_text_properties
, 3, 4, 0,
1325 doc
: /* Completely replace properties of text from START to END.
1326 The third argument PROPERTIES is the new property list.
1327 If the optional fourth argument OBJECT is a buffer (or nil, which means
1328 the current buffer), START and END are buffer positions (integers or
1329 markers). If OBJECT is a string, START and END are 0-based indices into it.
1330 If PROPERTIES is nil, the effect is to remove all properties from
1331 the designated part of OBJECT. */)
1332 (start
, end
, properties
, object
)
1333 Lisp_Object start
, end
, properties
, object
;
1335 return set_text_properties (start
, end
, properties
, object
, Qt
);
1339 /* Replace properties of text from START to END with new list of
1340 properties PROPERTIES. OBJECT is the buffer or string containing
1341 the text. OBJECT nil means use the current buffer.
1342 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1343 is nil if the function _detected_ that it did not replace any
1344 properties, non-nil otherwise. */
1347 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1348 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1350 register INTERVAL i
;
1351 Lisp_Object ostart
, oend
;
1356 properties
= validate_plist (properties
);
1359 XSETBUFFER (object
, current_buffer
);
1361 /* If we want no properties for a whole string,
1362 get rid of its intervals. */
1363 if (NILP (properties
) && STRINGP (object
)
1364 && XFASTINT (start
) == 0
1365 && XFASTINT (end
) == SCHARS (object
))
1367 if (! STRING_INTERVALS (object
))
1370 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1374 i
= validate_interval_range (object
, &start
, &end
, soft
);
1376 if (NULL_INTERVAL_P (i
))
1378 /* If buffer has no properties, and we want none, return now. */
1379 if (NILP (properties
))
1382 /* Restore the original START and END values
1383 because validate_interval_range increments them for strings. */
1387 i
= validate_interval_range (object
, &start
, &end
, hard
);
1388 /* This can return if start == end. */
1389 if (NULL_INTERVAL_P (i
))
1393 if (BUFFERP (object
))
1394 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1396 set_text_properties_1 (start
, end
, properties
, object
, i
);
1398 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1399 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1400 XINT (end
) - XINT (start
));
1404 /* Replace properties of text from START to END with new list of
1405 properties PROPERTIES. BUFFER is the buffer containing
1406 the text. This does not obey any hooks.
1407 You can provide the interval that START is located in as I,
1408 or pass NULL for I and this function will find it.
1409 START and END can be in any order. */
1412 set_text_properties_1 (start
, end
, properties
, buffer
, i
)
1413 Lisp_Object start
, end
, properties
, buffer
;
1416 register INTERVAL prev_changed
= NULL_INTERVAL
;
1417 register int s
, len
;
1421 len
= XINT (end
) - s
;
1431 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1433 if (i
->position
!= s
)
1436 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1438 if (LENGTH (i
) > len
)
1440 copy_properties (unchanged
, i
);
1441 i
= split_interval_left (i
, len
);
1442 set_properties (properties
, i
, buffer
);
1446 set_properties (properties
, i
, buffer
);
1448 if (LENGTH (i
) == len
)
1453 i
= next_interval (i
);
1456 /* We are starting at the beginning of an interval, I */
1462 if (LENGTH (i
) >= len
)
1464 if (LENGTH (i
) > len
)
1465 i
= split_interval_left (i
, len
);
1467 /* We have to call set_properties even if we are going to
1468 merge the intervals, so as to make the undo records
1469 and cause redisplay to happen. */
1470 set_properties (properties
, i
, buffer
);
1471 if (!NULL_INTERVAL_P (prev_changed
))
1472 merge_interval_left (i
);
1478 /* We have to call set_properties even if we are going to
1479 merge the intervals, so as to make the undo records
1480 and cause redisplay to happen. */
1481 set_properties (properties
, i
, buffer
);
1482 if (NULL_INTERVAL_P (prev_changed
))
1485 prev_changed
= i
= merge_interval_left (i
);
1487 i
= next_interval (i
);
1491 DEFUN ("remove-text-properties", Fremove_text_properties
,
1492 Sremove_text_properties
, 3, 4, 0,
1493 doc
: /* Remove some properties from text from START to END.
1494 The third argument PROPERTIES is a property list
1495 whose property names specify the properties to remove.
1496 \(The values stored in PROPERTIES are ignored.)
1497 If the optional fourth argument OBJECT is a buffer (or nil, which means
1498 the current buffer), START and END are buffer positions (integers or
1499 markers). If OBJECT is a string, START and END are 0-based indices into it.
1500 Return t if any property was actually removed, nil otherwise.
1502 Use set-text-properties if you want to remove all text properties. */)
1503 (start
, end
, properties
, object
)
1504 Lisp_Object start
, end
, properties
, object
;
1506 register INTERVAL i
, unchanged
;
1507 register int s
, len
, modified
= 0;
1510 XSETBUFFER (object
, current_buffer
);
1512 i
= validate_interval_range (object
, &start
, &end
, soft
);
1513 if (NULL_INTERVAL_P (i
))
1517 len
= XINT (end
) - s
;
1519 if (i
->position
!= s
)
1521 /* No properties on this first interval -- return if
1522 it covers the entire region. */
1523 if (! interval_has_some_properties (properties
, i
))
1525 int got
= (LENGTH (i
) - (s
- i
->position
));
1529 i
= next_interval (i
);
1531 /* Split away the beginning of this interval; what we don't
1536 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1537 copy_properties (unchanged
, i
);
1541 if (BUFFERP (object
))
1542 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1544 /* We are at the beginning of an interval, with len to scan */
1550 if (LENGTH (i
) >= len
)
1552 if (! interval_has_some_properties (properties
, i
))
1553 return modified
? Qt
: Qnil
;
1555 if (LENGTH (i
) == len
)
1557 remove_properties (properties
, Qnil
, i
, object
);
1558 if (BUFFERP (object
))
1559 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1560 XINT (end
) - XINT (start
));
1564 /* i has the properties, and goes past the change limit */
1566 i
= split_interval_left (i
, len
);
1567 copy_properties (unchanged
, i
);
1568 remove_properties (properties
, Qnil
, i
, object
);
1569 if (BUFFERP (object
))
1570 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1571 XINT (end
) - XINT (start
));
1576 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1577 i
= next_interval (i
);
1581 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1582 Sremove_list_of_text_properties
, 3, 4, 0,
1583 doc
: /* Remove some properties from text from START to END.
1584 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1585 If the optional fourth argument OBJECT is a buffer (or nil, which means
1586 the current buffer), START and END are buffer positions (integers or
1587 markers). If OBJECT is a string, START and END are 0-based indices into it.
1588 Return t if any property was actually removed, nil otherwise. */)
1589 (start
, end
, list_of_properties
, object
)
1590 Lisp_Object start
, end
, list_of_properties
, object
;
1592 register INTERVAL i
, unchanged
;
1593 register int s
, len
, modified
= 0;
1594 Lisp_Object properties
;
1595 properties
= list_of_properties
;
1598 XSETBUFFER (object
, current_buffer
);
1600 i
= validate_interval_range (object
, &start
, &end
, soft
);
1601 if (NULL_INTERVAL_P (i
))
1605 len
= XINT (end
) - s
;
1607 if (i
->position
!= s
)
1609 /* No properties on this first interval -- return if
1610 it covers the entire region. */
1611 if (! interval_has_some_properties_list (properties
, i
))
1613 int got
= (LENGTH (i
) - (s
- i
->position
));
1617 i
= next_interval (i
);
1619 /* Split away the beginning of this interval; what we don't
1624 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1625 copy_properties (unchanged
, i
);
1629 /* We are at the beginning of an interval, with len to scan.
1630 The flag `modified' records if changes have been made.
1631 When object is a buffer, we must call modify_region before changes are
1632 made and signal_after_change when we are done.
1633 We call modify_region before calling remove_properties iff modified == 0,
1634 and we call signal_after_change before returning iff modified != 0. */
1640 if (LENGTH (i
) >= len
)
1642 if (! interval_has_some_properties_list (properties
, i
))
1645 if (BUFFERP (object
))
1646 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1647 XINT (end
) - XINT (start
));
1653 if (LENGTH (i
) == len
)
1655 if (!modified
&& BUFFERP (object
))
1656 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1657 remove_properties (Qnil
, properties
, i
, object
);
1658 if (BUFFERP (object
))
1659 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1660 XINT (end
) - XINT (start
));
1664 /* i has the properties, and goes past the change limit */
1666 i
= split_interval_left (i
, len
);
1667 copy_properties (unchanged
, i
);
1668 if (!modified
&& BUFFERP (object
))
1669 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1670 remove_properties (Qnil
, properties
, i
, object
);
1671 if (BUFFERP (object
))
1672 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1673 XINT (end
) - XINT (start
));
1677 if (interval_has_some_properties_list (properties
, i
))
1679 if (!modified
&& BUFFERP (object
))
1680 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1681 remove_properties (Qnil
, properties
, i
, object
);
1685 i
= next_interval (i
);
1689 DEFUN ("text-property-any", Ftext_property_any
,
1690 Stext_property_any
, 4, 5, 0,
1691 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1692 If so, return the position of the first character whose property PROPERTY
1693 is `eq' to VALUE. Otherwise return nil.
1694 If the optional fifth argument OBJECT is a buffer (or nil, which means
1695 the current buffer), START and END are buffer positions (integers or
1696 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1697 (start
, end
, property
, value
, object
)
1698 Lisp_Object start
, end
, property
, value
, object
;
1700 register INTERVAL i
;
1701 register int e
, pos
;
1704 XSETBUFFER (object
, current_buffer
);
1705 i
= validate_interval_range (object
, &start
, &end
, soft
);
1706 if (NULL_INTERVAL_P (i
))
1707 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1710 while (! NULL_INTERVAL_P (i
))
1712 if (i
->position
>= e
)
1714 if (EQ (textget (i
->plist
, property
), value
))
1717 if (pos
< XINT (start
))
1719 return make_number (pos
);
1721 i
= next_interval (i
);
1726 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1727 Stext_property_not_all
, 4, 5, 0,
1728 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1729 If so, return the position of the first character whose property PROPERTY
1730 is not `eq' to VALUE. Otherwise, return nil.
1731 If the optional fifth argument OBJECT is a buffer (or nil, which means
1732 the current buffer), START and END are buffer positions (integers or
1733 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1734 (start
, end
, property
, value
, object
)
1735 Lisp_Object start
, end
, property
, value
, object
;
1737 register INTERVAL i
;
1741 XSETBUFFER (object
, current_buffer
);
1742 i
= validate_interval_range (object
, &start
, &end
, soft
);
1743 if (NULL_INTERVAL_P (i
))
1744 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1748 while (! NULL_INTERVAL_P (i
))
1750 if (i
->position
>= e
)
1752 if (! EQ (textget (i
->plist
, property
), value
))
1754 if (i
->position
> s
)
1756 return make_number (s
);
1758 i
= next_interval (i
);
1764 /* Return the direction from which the text-property PROP would be
1765 inherited by any new text inserted at POS: 1 if it would be
1766 inherited from the char after POS, -1 if it would be inherited from
1767 the char before POS, and 0 if from neither.
1768 BUFFER can be either a buffer or nil (meaning current buffer). */
1771 text_property_stickiness (prop
, pos
, buffer
)
1772 Lisp_Object prop
, pos
, buffer
;
1774 Lisp_Object prev_pos
, front_sticky
;
1775 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1778 XSETBUFFER (buffer
, current_buffer
);
1780 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1781 /* Consider previous character. */
1783 Lisp_Object rear_non_sticky
;
1785 prev_pos
= make_number (XINT (pos
) - 1);
1786 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1788 if (!NILP (CONSP (rear_non_sticky
)
1789 ? Fmemq (prop
, rear_non_sticky
)
1791 /* PROP is rear-non-sticky. */
1797 /* Consider following character. */
1798 /* This signals an arg-out-of-range error if pos is outside the
1799 buffer's accessible range. */
1800 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1802 if (EQ (front_sticky
, Qt
)
1803 || (CONSP (front_sticky
)
1804 && !NILP (Fmemq (prop
, front_sticky
))))
1805 /* PROP is inherited from after. */
1806 is_front_sticky
= 1;
1808 /* Simple cases, where the properties are consistent. */
1809 if (is_rear_sticky
&& !is_front_sticky
)
1811 else if (!is_rear_sticky
&& is_front_sticky
)
1813 else if (!is_rear_sticky
&& !is_front_sticky
)
1816 /* The stickiness properties are inconsistent, so we have to
1817 disambiguate. Basically, rear-sticky wins, _except_ if the
1818 property that would be inherited has a value of nil, in which case
1819 front-sticky wins. */
1820 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1821 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1828 /* I don't think this is the right interface to export; how often do you
1829 want to do something like this, other than when you're copying objects
1832 I think it would be better to have a pair of functions, one which
1833 returns the text properties of a region as a list of ranges and
1834 plists, and another which applies such a list to another object. */
1836 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1837 SRC and DEST may each refer to strings or buffers.
1838 Optional sixth argument PROP causes only that property to be copied.
1839 Properties are copied to DEST as if by `add-text-properties'.
1840 Return t if any property value actually changed, nil otherwise. */
1842 /* Note this can GC when DEST is a buffer. */
1845 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1846 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1852 int s
, e
, e2
, p
, len
, modified
= 0;
1853 struct gcpro gcpro1
, gcpro2
;
1855 i
= validate_interval_range (src
, &start
, &end
, soft
);
1856 if (NULL_INTERVAL_P (i
))
1859 CHECK_NUMBER_COERCE_MARKER (pos
);
1861 Lisp_Object dest_start
, dest_end
;
1864 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1865 /* Apply this to a copy of pos; it will try to increment its arguments,
1866 which we don't want. */
1867 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1878 e2
= i
->position
+ LENGTH (i
);
1885 while (! NILP (plist
))
1887 if (EQ (Fcar (plist
), prop
))
1889 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1892 plist
= Fcdr (Fcdr (plist
));
1896 /* Must defer modifications to the interval tree in case src
1897 and dest refer to the same string or buffer. */
1898 stuff
= Fcons (Fcons (make_number (p
),
1899 Fcons (make_number (p
+ len
),
1900 Fcons (plist
, Qnil
))),
1904 i
= next_interval (i
);
1905 if (NULL_INTERVAL_P (i
))
1912 GCPRO2 (stuff
, dest
);
1914 while (! NILP (stuff
))
1917 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1918 Fcar (Fcdr (Fcdr (res
))), dest
);
1921 stuff
= Fcdr (stuff
);
1926 return modified
? Qt
: Qnil
;
1930 /* Return a list representing the text properties of OBJECT between
1931 START and END. if PROP is non-nil, report only on that property.
1932 Each result list element has the form (S E PLIST), where S and E
1933 are positions in OBJECT and PLIST is a property list containing the
1934 text properties of OBJECT between S and E. Value is nil if OBJECT
1935 doesn't contain text properties between START and END. */
1938 text_property_list (object
, start
, end
, prop
)
1939 Lisp_Object object
, start
, end
, prop
;
1946 i
= validate_interval_range (object
, &start
, &end
, soft
);
1947 if (!NULL_INTERVAL_P (i
))
1949 int s
= XINT (start
);
1954 int interval_end
, len
;
1957 interval_end
= i
->position
+ LENGTH (i
);
1958 if (interval_end
> e
)
1960 len
= interval_end
- s
;
1965 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1966 if (EQ (Fcar (plist
), prop
))
1968 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1973 result
= Fcons (Fcons (make_number (s
),
1974 Fcons (make_number (s
+ len
),
1975 Fcons (plist
, Qnil
))),
1978 i
= next_interval (i
);
1979 if (NULL_INTERVAL_P (i
))
1989 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1990 (START END PLIST), where START and END are positions and PLIST is a
1991 property list containing the text properties to add. Adjust START
1992 and END positions by DELTA before adding properties. Value is
1993 non-zero if OBJECT was modified. */
1996 add_text_properties_from_list (object
, list
, delta
)
1997 Lisp_Object object
, list
, delta
;
1999 struct gcpro gcpro1
, gcpro2
;
2002 GCPRO2 (list
, object
);
2004 for (; CONSP (list
); list
= XCDR (list
))
2006 Lisp_Object item
, start
, end
, plist
, tem
;
2009 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2010 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2011 plist
= XCAR (XCDR (XCDR (item
)));
2013 tem
= Fadd_text_properties (start
, end
, plist
, object
);
2024 /* Modify end-points of ranges in LIST destructively. LIST is a list
2025 as returned from text_property_list. Change end-points equal to
2026 OLD_END to NEW_END. */
2029 extend_property_ranges (list
, old_end
, new_end
)
2030 Lisp_Object list
, old_end
, new_end
;
2032 for (; CONSP (list
); list
= XCDR (list
))
2034 Lisp_Object item
, end
;
2037 end
= XCAR (XCDR (item
));
2039 if (EQ (end
, old_end
))
2040 XSETCAR (XCDR (item
), new_end
);
2046 /* Call the modification hook functions in LIST, each with START and END. */
2049 call_mod_hooks (list
, start
, end
)
2050 Lisp_Object list
, start
, end
;
2052 struct gcpro gcpro1
;
2054 while (!NILP (list
))
2056 call2 (Fcar (list
), start
, end
);
2062 /* Check for read-only intervals between character positions START ... END,
2063 in BUF, and signal an error if we find one.
2065 Then check for any modification hooks in the range.
2066 Create a list of all these hooks in lexicographic order,
2067 eliminating consecutive extra copies of the same hook. Then call
2068 those hooks in order, with START and END - 1 as arguments. */
2071 verify_interval_modification (buf
, start
, end
)
2075 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2076 register INTERVAL i
;
2078 register Lisp_Object prev_mod_hooks
;
2079 Lisp_Object mod_hooks
;
2080 struct gcpro gcpro1
;
2083 prev_mod_hooks
= Qnil
;
2086 interval_insert_behind_hooks
= Qnil
;
2087 interval_insert_in_front_hooks
= Qnil
;
2089 if (NULL_INTERVAL_P (intervals
))
2099 /* For an insert operation, check the two chars around the position. */
2102 INTERVAL prev
= NULL
;
2103 Lisp_Object before
, after
;
2105 /* Set I to the interval containing the char after START,
2106 and PREV to the interval containing the char before START.
2107 Either one may be null. They may be equal. */
2108 i
= find_interval (intervals
, start
);
2110 if (start
== BUF_BEGV (buf
))
2112 else if (i
->position
== start
)
2113 prev
= previous_interval (i
);
2114 else if (i
->position
< start
)
2116 if (start
== BUF_ZV (buf
))
2119 /* If Vinhibit_read_only is set and is not a list, we can
2120 skip the read_only checks. */
2121 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2123 /* If I and PREV differ we need to check for the read-only
2124 property together with its stickiness. If either I or
2125 PREV are 0, this check is all we need.
2126 We have to take special care, since read-only may be
2127 indirectly defined via the category property. */
2130 if (! NULL_INTERVAL_P (i
))
2132 after
= textget (i
->plist
, Qread_only
);
2134 /* If interval I is read-only and read-only is
2135 front-sticky, inhibit insertion.
2136 Check for read-only as well as category. */
2138 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2142 tem
= textget (i
->plist
, Qfront_sticky
);
2143 if (TMEM (Qread_only
, tem
)
2144 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2145 && TMEM (Qcategory
, tem
)))
2146 text_read_only (after
);
2150 if (! NULL_INTERVAL_P (prev
))
2152 before
= textget (prev
->plist
, Qread_only
);
2154 /* If interval PREV is read-only and read-only isn't
2155 rear-nonsticky, inhibit insertion.
2156 Check for read-only as well as category. */
2158 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2162 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2163 if (! TMEM (Qread_only
, tem
)
2164 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2165 || ! TMEM (Qcategory
, tem
)))
2166 text_read_only (before
);
2170 else if (! NULL_INTERVAL_P (i
))
2172 after
= textget (i
->plist
, Qread_only
);
2174 /* If interval I is read-only and read-only is
2175 front-sticky, inhibit insertion.
2176 Check for read-only as well as category. */
2177 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2181 tem
= textget (i
->plist
, Qfront_sticky
);
2182 if (TMEM (Qread_only
, tem
)
2183 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2184 && TMEM (Qcategory
, tem
)))
2185 text_read_only (after
);
2187 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2188 if (! TMEM (Qread_only
, tem
)
2189 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2190 || ! TMEM (Qcategory
, tem
)))
2191 text_read_only (after
);
2196 /* Run both insert hooks (just once if they're the same). */
2197 if (!NULL_INTERVAL_P (prev
))
2198 interval_insert_behind_hooks
2199 = textget (prev
->plist
, Qinsert_behind_hooks
);
2200 if (!NULL_INTERVAL_P (i
))
2201 interval_insert_in_front_hooks
2202 = textget (i
->plist
, Qinsert_in_front_hooks
);
2206 /* Loop over intervals on or next to START...END,
2207 collecting their hooks. */
2209 i
= find_interval (intervals
, start
);
2212 if (! INTERVAL_WRITABLE_P (i
))
2213 text_read_only (textget (i
->plist
, Qread_only
));
2215 if (!inhibit_modification_hooks
)
2217 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2218 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2220 hooks
= Fcons (mod_hooks
, hooks
);
2221 prev_mod_hooks
= mod_hooks
;
2225 i
= next_interval (i
);
2227 /* Keep going thru the interval containing the char before END. */
2228 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2230 if (!inhibit_modification_hooks
)
2233 hooks
= Fnreverse (hooks
);
2234 while (! EQ (hooks
, Qnil
))
2236 call_mod_hooks (Fcar (hooks
), make_number (start
),
2238 hooks
= Fcdr (hooks
);
2245 /* Run the interval hooks for an insertion on character range START ... END.
2246 verify_interval_modification chose which hooks to run;
2247 this function is called after the insertion happens
2248 so it can indicate the range of inserted text. */
2251 report_interval_modification (start
, end
)
2252 Lisp_Object start
, end
;
2254 if (! NILP (interval_insert_behind_hooks
))
2255 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2256 if (! NILP (interval_insert_in_front_hooks
)
2257 && ! EQ (interval_insert_in_front_hooks
,
2258 interval_insert_behind_hooks
))
2259 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2265 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
2266 doc
: /* Property-list used as default values.
2267 The value of a property in this list is seen as the value for every
2268 character that does not have its own value for that property. */);
2269 Vdefault_text_properties
= Qnil
;
2271 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist
,
2272 doc
: /* Alist of alternative properties for properties without a value.
2273 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2274 If a piece of text has no direct value for a particular property, then
2275 this alist is consulted. If that property appears in the alist, then
2276 the first non-nil value from the associated alternative properties is
2278 Vchar_property_alias_alist
= Qnil
;
2280 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
2281 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2282 This also inhibits the use of the `intangible' text property. */);
2283 Vinhibit_point_motion_hooks
= Qnil
;
2285 DEFVAR_LISP ("text-property-default-nonsticky",
2286 &Vtext_property_default_nonsticky
,
2287 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2288 Each element has the form (PROPERTY . NONSTICKINESS).
2290 If a character in a buffer has PROPERTY, new text inserted adjacent to
2291 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2292 inherits it if NONSTICKINESS is nil. The front-sticky and
2293 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2294 /* Text property `syntax-table' should be nonsticky by default. */
2295 Vtext_property_default_nonsticky
2296 = Fcons (Fcons (intern ("syntax-table"), Qt
), Qnil
);
2298 staticpro (&interval_insert_behind_hooks
);
2299 staticpro (&interval_insert_in_front_hooks
);
2300 interval_insert_behind_hooks
= Qnil
;
2301 interval_insert_in_front_hooks
= Qnil
;
2304 /* Common attributes one might give text */
2306 staticpro (&Qforeground
);
2307 Qforeground
= intern ("foreground");
2308 staticpro (&Qbackground
);
2309 Qbackground
= intern ("background");
2311 Qfont
= intern ("font");
2312 staticpro (&Qstipple
);
2313 Qstipple
= intern ("stipple");
2314 staticpro (&Qunderline
);
2315 Qunderline
= intern ("underline");
2316 staticpro (&Qread_only
);
2317 Qread_only
= intern ("read-only");
2318 staticpro (&Qinvisible
);
2319 Qinvisible
= intern ("invisible");
2320 staticpro (&Qintangible
);
2321 Qintangible
= intern ("intangible");
2322 staticpro (&Qcategory
);
2323 Qcategory
= intern ("category");
2324 staticpro (&Qlocal_map
);
2325 Qlocal_map
= intern ("local-map");
2326 staticpro (&Qfront_sticky
);
2327 Qfront_sticky
= intern ("front-sticky");
2328 staticpro (&Qrear_nonsticky
);
2329 Qrear_nonsticky
= intern ("rear-nonsticky");
2330 staticpro (&Qmouse_face
);
2331 Qmouse_face
= intern ("mouse-face");
2333 /* Properties that text might use to specify certain actions */
2335 staticpro (&Qmouse_left
);
2336 Qmouse_left
= intern ("mouse-left");
2337 staticpro (&Qmouse_entered
);
2338 Qmouse_entered
= intern ("mouse-entered");
2339 staticpro (&Qpoint_left
);
2340 Qpoint_left
= intern ("point-left");
2341 staticpro (&Qpoint_entered
);
2342 Qpoint_entered
= intern ("point-entered");
2344 defsubr (&Stext_properties_at
);
2345 defsubr (&Sget_text_property
);
2346 defsubr (&Sget_char_property
);
2347 defsubr (&Sget_char_property_and_overlay
);
2348 defsubr (&Snext_char_property_change
);
2349 defsubr (&Sprevious_char_property_change
);
2350 defsubr (&Snext_single_char_property_change
);
2351 defsubr (&Sprevious_single_char_property_change
);
2352 defsubr (&Snext_property_change
);
2353 defsubr (&Snext_single_property_change
);
2354 defsubr (&Sprevious_property_change
);
2355 defsubr (&Sprevious_single_property_change
);
2356 defsubr (&Sadd_text_properties
);
2357 defsubr (&Sput_text_property
);
2358 defsubr (&Sset_text_properties
);
2359 defsubr (&Sremove_text_properties
);
2360 defsubr (&Sremove_list_of_text_properties
);
2361 defsubr (&Stext_property_any
);
2362 defsubr (&Stext_property_not_all
);
2363 /* defsubr (&Serase_text_properties); */
2364 /* defsubr (&Scopy_text_properties); */
2367 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2368 (do not change this comment) */