1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001
3 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., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, 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 Vtext_property_default_nonsticky
;
75 /* verify_interval_modification saves insertion hooks here
76 to be run later by report_interval_modification. */
77 Lisp_Object interval_insert_behind_hooks
;
78 Lisp_Object interval_insert_in_front_hooks
;
81 /* Signal a `text-read-only' error. This function makes it easier
82 to capture that error in GDB by putting a breakpoint on it. */
87 Fsignal (Qtext_read_only
, Qnil
);
92 /* Extract the interval at the position pointed to by BEGIN from
93 OBJECT, a string or buffer. Additionally, check that the positions
94 pointed to by BEGIN and END are within the bounds of OBJECT, and
95 reverse them if *BEGIN is greater than *END. The objects pointed
96 to by BEGIN and END may be integers or markers; if the latter, they
97 are coerced to integers.
99 When OBJECT is a string, we increment *BEGIN and *END
100 to make them origin-one.
102 Note that buffer points don't correspond to interval indices.
103 For example, point-max is 1 greater than the index of the last
104 character. This difference is handled in the caller, which uses
105 the validated points to determine a length, and operates on that.
106 Exceptions are Ftext_properties_at, Fnext_property_change, and
107 Fprevious_property_change which call this function with BEGIN == END.
108 Handle this case specially.
110 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
111 create an interval tree for OBJECT if one doesn't exist, provided
112 the object actually contains text. In the current design, if there
113 is no text, there can be no text properties. */
119 validate_interval_range (object
, begin
, end
, force
)
120 Lisp_Object object
, *begin
, *end
;
126 CHECK_STRING_OR_BUFFER (object
);
127 CHECK_NUMBER_COERCE_MARKER (*begin
);
128 CHECK_NUMBER_COERCE_MARKER (*end
);
130 /* If we are asked for a point, but from a subr which operates
131 on a range, then return nothing. */
132 if (EQ (*begin
, *end
) && begin
!= end
)
133 return NULL_INTERVAL
;
135 if (XINT (*begin
) > XINT (*end
))
143 if (BUFFERP (object
))
145 register struct buffer
*b
= XBUFFER (object
);
147 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
148 && XINT (*end
) <= BUF_ZV (b
)))
149 args_out_of_range (*begin
, *end
);
150 i
= BUF_INTERVALS (b
);
152 /* If there's no text, there are no properties. */
153 if (BUF_BEGV (b
) == BUF_ZV (b
))
154 return NULL_INTERVAL
;
156 searchpos
= XINT (*begin
);
160 register struct Lisp_String
*s
= XSTRING (object
);
162 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
163 && XINT (*end
) <= s
->size
))
164 args_out_of_range (*begin
, *end
);
165 XSETFASTINT (*begin
, XFASTINT (*begin
));
167 XSETFASTINT (*end
, XFASTINT (*end
));
171 return NULL_INTERVAL
;
173 searchpos
= XINT (*begin
);
176 if (NULL_INTERVAL_P (i
))
177 return (force
? create_root_interval (object
) : i
);
179 return find_interval (i
, searchpos
);
182 /* Validate LIST as a property list. If LIST is not a list, then
183 make one consisting of (LIST nil). Otherwise, verify that LIST
184 is even numbered and thus suitable as a plist. */
187 validate_plist (list
)
196 register Lisp_Object tail
;
197 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
203 error ("Odd length text property list");
207 return Fcons (list
, Fcons (Qnil
, Qnil
));
210 /* Return nonzero if interval I has all the properties,
211 with the same values, of list PLIST. */
214 interval_has_all_properties (plist
, i
)
218 register Lisp_Object tail1
, tail2
, sym1
;
221 /* Go through each element of PLIST. */
222 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
227 /* Go through I's plist, looking for sym1 */
228 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
229 if (EQ (sym1
, Fcar (tail2
)))
231 /* Found the same property on both lists. If the
232 values are unequal, return zero. */
233 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
236 /* Property has same value on both lists; go to next one. */
248 /* Return nonzero if the plist of interval I has any of the
249 properties of PLIST, regardless of their values. */
252 interval_has_some_properties (plist
, i
)
256 register Lisp_Object tail1
, tail2
, sym
;
258 /* Go through each element of PLIST. */
259 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
263 /* Go through i's plist, looking for tail1 */
264 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
265 if (EQ (sym
, Fcar (tail2
)))
272 /* Changing the plists of individual intervals. */
274 /* Return the value of PROP in property-list PLIST, or Qunbound if it
277 property_value (plist
, prop
)
278 Lisp_Object plist
, prop
;
282 while (PLIST_ELT_P (plist
, value
))
283 if (EQ (XCAR (plist
), prop
))
286 plist
= XCDR (value
);
291 /* Set the properties of INTERVAL to PROPERTIES,
292 and record undo info for the previous values.
293 OBJECT is the string or buffer that INTERVAL belongs to. */
296 set_properties (properties
, interval
, object
)
297 Lisp_Object properties
, object
;
300 Lisp_Object sym
, value
;
302 if (BUFFERP (object
))
304 /* For each property in the old plist which is missing from PROPERTIES,
305 or has a different value in PROPERTIES, make an undo record. */
306 for (sym
= interval
->plist
;
307 PLIST_ELT_P (sym
, value
);
309 if (! EQ (property_value (properties
, XCAR (sym
)),
312 record_property_change (interval
->position
, LENGTH (interval
),
313 XCAR (sym
), XCAR (value
),
317 /* For each new property that has no value at all in the old plist,
318 make an undo record binding it to nil, so it will be removed. */
319 for (sym
= properties
;
320 PLIST_ELT_P (sym
, value
);
322 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
324 record_property_change (interval
->position
, LENGTH (interval
),
330 /* Store new properties. */
331 interval
->plist
= Fcopy_sequence (properties
);
334 /* Add the properties of PLIST to the interval I, or set
335 the value of I's property to the value of the property on PLIST
336 if they are different.
338 OBJECT should be the string or buffer the interval is in.
340 Return nonzero if this changes I (i.e., if any members of PLIST
341 are actually added to I's plist) */
344 add_properties (plist
, i
, object
)
349 Lisp_Object tail1
, tail2
, sym1
, val1
;
350 register int changed
= 0;
352 struct gcpro gcpro1
, gcpro2
, gcpro3
;
357 /* No need to protect OBJECT, because we can GC only in the case
358 where it is a buffer, and live buffers are always protected.
359 I and its plist are also protected, via OBJECT. */
360 GCPRO3 (tail1
, sym1
, val1
);
362 /* Go through each element of PLIST. */
363 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
366 val1
= Fcar (Fcdr (tail1
));
369 /* Go through I's plist, looking for sym1 */
370 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
371 if (EQ (sym1
, Fcar (tail2
)))
373 /* No need to gcpro, because tail2 protects this
374 and it must be a cons cell (we get an error otherwise). */
375 register Lisp_Object this_cdr
;
377 this_cdr
= Fcdr (tail2
);
378 /* Found the property. Now check its value. */
381 /* The properties have the same value on both lists.
382 Continue to the next property. */
383 if (EQ (val1
, Fcar (this_cdr
)))
386 /* Record this change in the buffer, for undo purposes. */
387 if (BUFFERP (object
))
389 record_property_change (i
->position
, LENGTH (i
),
390 sym1
, Fcar (this_cdr
), object
);
393 /* I's property has a different value -- change it */
394 Fsetcar (this_cdr
, val1
);
401 /* Record this change in the buffer, for undo purposes. */
402 if (BUFFERP (object
))
404 record_property_change (i
->position
, LENGTH (i
),
407 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
417 /* For any members of PLIST which are properties of I, remove them
419 OBJECT is the string or buffer containing I. */
422 remove_properties (plist
, i
, object
)
427 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
428 register int changed
= 0;
430 current_plist
= i
->plist
;
431 /* Go through each element of plist. */
432 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
436 /* First, remove the symbol if its at the head of the list */
437 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
439 if (BUFFERP (object
))
441 record_property_change (i
->position
, LENGTH (i
),
442 sym
, Fcar (Fcdr (current_plist
)),
446 current_plist
= Fcdr (Fcdr (current_plist
));
450 /* Go through i's plist, looking for sym */
451 tail2
= current_plist
;
452 while (! NILP (tail2
))
454 register Lisp_Object
this;
455 this = Fcdr (Fcdr (tail2
));
456 if (EQ (sym
, Fcar (this)))
458 if (BUFFERP (object
))
460 record_property_change (i
->position
, LENGTH (i
),
461 sym
, Fcar (Fcdr (this)), object
);
464 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
472 i
->plist
= current_plist
;
477 /* Remove all properties from interval I. Return non-zero
478 if this changes the interval. */
492 /* Returns the interval of POSITION in OBJECT.
493 POSITION is BEG-based. */
496 interval_of (position
, object
)
504 XSETBUFFER (object
, current_buffer
);
505 else if (EQ (object
, Qt
))
506 return NULL_INTERVAL
;
508 CHECK_STRING_OR_BUFFER (object
);
510 if (BUFFERP (object
))
512 register struct buffer
*b
= XBUFFER (object
);
516 i
= BUF_INTERVALS (b
);
520 register struct Lisp_String
*s
= XSTRING (object
);
527 if (!(beg
<= position
&& position
<= end
))
528 args_out_of_range (make_number (position
), make_number (position
));
529 if (beg
== end
|| NULL_INTERVAL_P (i
))
530 return NULL_INTERVAL
;
532 return find_interval (i
, position
);
535 DEFUN ("text-properties-at", Ftext_properties_at
,
536 Stext_properties_at
, 1, 2, 0,
537 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
538 OBJECT is the string or buffer to look for the properties in;
539 nil means the current buffer.
540 If POSITION is at the end of OBJECT, the value is nil. */)
542 Lisp_Object position
, object
;
547 XSETBUFFER (object
, current_buffer
);
549 i
= validate_interval_range (object
, &position
, &position
, soft
);
550 if (NULL_INTERVAL_P (i
))
552 /* If POSITION is at the end of the interval,
553 it means it's the end of OBJECT.
554 There are no properties at the very end,
555 since no character follows. */
556 if (XINT (position
) == LENGTH (i
) + i
->position
)
562 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
563 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
564 OBJECT is optional and defaults to the current buffer.
565 If POSITION is at the end of OBJECT, the value is nil. */)
566 (position
, prop
, object
)
567 Lisp_Object position
, object
;
570 return textget (Ftext_properties_at (position
, object
), prop
);
573 /* Return the value of POSITION's property PROP, in OBJECT.
574 OBJECT is optional and defaults to the current buffer.
575 If OVERLAY is non-0, then in the case that the returned property is from
576 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
577 returned in *OVERLAY.
578 If POSITION is at the end of OBJECT, the value is nil.
579 If OBJECT is a buffer, then overlay properties are considered as well as
581 If OBJECT is a window, then that window's buffer is used, but
582 window-specific overlays are considered only if they are associated
585 get_char_property_and_overlay (position
, prop
, object
, overlay
)
586 Lisp_Object position
, object
;
587 register Lisp_Object prop
;
588 Lisp_Object
*overlay
;
590 struct window
*w
= 0;
592 CHECK_NUMBER_COERCE_MARKER (position
);
595 XSETBUFFER (object
, current_buffer
);
597 if (WINDOWP (object
))
599 w
= XWINDOW (object
);
602 if (BUFFERP (object
))
604 int posn
= XINT (position
);
606 Lisp_Object
*overlay_vec
, tem
;
609 struct buffer
*obuf
= current_buffer
;
611 set_buffer_temp (XBUFFER (object
));
613 /* First try with room for 40 overlays. */
615 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
617 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
618 &next_overlay
, NULL
, 0);
620 /* If there are more than 40,
621 make enough space for all, and try again. */
625 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
626 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
627 &next_overlay
, NULL
, 0);
629 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
631 set_buffer_temp (obuf
);
633 /* Now check the overlays in order of decreasing priority. */
634 while (--noverlays
>= 0)
636 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
640 /* Return the overlay we got the property from. */
641 *overlay
= overlay_vec
[noverlays
];
648 /* Indicate that the return value is not from an overlay. */
651 /* Not a buffer, or no appropriate overlay, so fall through to the
653 return Fget_text_property (position
, prop
, object
);
656 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
657 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
658 Both overlay properties and text properties are checked.
659 OBJECT is optional and defaults to the current buffer.
660 If POSITION is at the end of OBJECT, the value is nil.
661 If OBJECT is a buffer, then overlay properties are considered as well as
663 If OBJECT is a window, then that window's buffer is used, but window-specific
664 overlays are considered only if they are associated with OBJECT. */)
665 (position
, prop
, object
)
666 Lisp_Object position
, object
;
667 register Lisp_Object prop
;
669 return get_char_property_and_overlay (position
, prop
, object
, 0);
672 DEFUN ("next-char-property-change", Fnext_char_property_change
,
673 Snext_char_property_change
, 1, 2, 0,
674 doc
: /* Return the position of next text property or overlay change.
675 This scans characters forward from POSITION till it finds a change in
676 some text property, or the beginning or end of an overlay, and returns
677 the position of that.
678 If none is found, the function returns (point-max).
680 If the optional third argument LIMIT is non-nil, don't search
681 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
683 Lisp_Object position
, limit
;
687 temp
= Fnext_overlay_change (position
);
690 CHECK_NUMBER (limit
);
691 if (XINT (limit
) < XINT (temp
))
694 return Fnext_property_change (position
, Qnil
, temp
);
697 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
698 Sprevious_char_property_change
, 1, 2, 0,
699 doc
: /* Return the position of previous text property or overlay change.
700 Scans characters backward from POSITION till it finds a change in some
701 text property, or the beginning or end of an overlay, and returns the
703 If none is found, the function returns (point-max).
705 If the optional third argument LIMIT is non-nil, don't search
706 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
708 Lisp_Object position
, limit
;
712 temp
= Fprevious_overlay_change (position
);
715 CHECK_NUMBER (limit
);
716 if (XINT (limit
) > XINT (temp
))
719 return Fprevious_property_change (position
, Qnil
, temp
);
723 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
724 Snext_single_char_property_change
, 2, 4, 0,
725 doc
: /* Return the position of next text property or overlay change for a specific property.
726 Scans characters forward from POSITION till it finds
727 a change in the PROP property, then returns the position of the change.
728 The optional third argument OBJECT is the string or buffer to scan.
729 The property values are compared with `eq'.
730 If the property is constant all the way to the end of OBJECT, return the
731 last valid position in OBJECT.
732 If the optional fourth argument LIMIT is non-nil, don't search
733 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
734 (position
, prop
, object
, limit
)
735 Lisp_Object prop
, position
, object
, limit
;
737 if (STRINGP (object
))
739 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
743 position
= make_number (XSTRING (object
)->size
);
750 Lisp_Object initial_value
, value
;
751 int count
= specpdl_ptr
- specpdl
;
754 CHECK_BUFFER (object
);
756 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
758 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
759 Fset_buffer (object
);
762 initial_value
= Fget_char_property (position
, prop
, object
);
765 XSETFASTINT (limit
, BUF_ZV (current_buffer
));
767 CHECK_NUMBER_COERCE_MARKER (limit
);
771 position
= Fnext_char_property_change (position
, limit
);
772 if (XFASTINT (position
) >= XFASTINT (limit
)) {
777 value
= Fget_char_property (position
, prop
, object
);
778 if (!EQ (value
, initial_value
))
782 unbind_to (count
, Qnil
);
788 DEFUN ("previous-single-char-property-change",
789 Fprevious_single_char_property_change
,
790 Sprevious_single_char_property_change
, 2, 4, 0,
791 doc
: /* Return the position of previous text property or overlay change for a specific property.
792 Scans characters backward from POSITION till it finds
793 a change in the PROP property, then returns the position of the change.
794 The optional third argument OBJECT is the string or buffer to scan.
795 The property values are compared with `eq'.
796 If the property is constant all the way to the start of OBJECT, return the
797 first valid position in OBJECT.
798 If the optional fourth argument LIMIT is non-nil, don't search
799 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
800 (position
, prop
, object
, limit
)
801 Lisp_Object prop
, position
, object
, limit
;
803 if (STRINGP (object
))
805 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
809 position
= make_number (XSTRING (object
)->size
);
816 int count
= specpdl_ptr
- specpdl
;
819 CHECK_BUFFER (object
);
821 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
823 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
824 Fset_buffer (object
);
828 XSETFASTINT (limit
, BUF_BEGV (current_buffer
));
830 CHECK_NUMBER_COERCE_MARKER (limit
);
832 if (XFASTINT (position
) <= XFASTINT (limit
))
836 Lisp_Object initial_value
=
837 Fget_char_property (make_number (XFASTINT (position
) - 1),
842 position
= Fprevious_char_property_change (position
, limit
);
844 if (XFASTINT (position
) <= XFASTINT (limit
))
852 Fget_char_property (make_number (XFASTINT (position
) - 1),
855 if (!EQ (value
, initial_value
))
861 unbind_to (count
, Qnil
);
867 DEFUN ("next-property-change", Fnext_property_change
,
868 Snext_property_change
, 1, 3, 0,
869 doc
: /* Return the position of next property change.
870 Scans characters forward from POSITION in OBJECT till it finds
871 a change in some text property, then returns the position of the change.
872 The optional second argument OBJECT is the string or buffer to scan.
873 Return nil if the property is constant all the way to the end of OBJECT.
874 If the value is non-nil, it is a position greater than POSITION, never equal.
876 If the optional third argument LIMIT is non-nil, don't search
877 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
878 (position
, object
, limit
)
879 Lisp_Object position
, object
, limit
;
881 register INTERVAL i
, next
;
884 XSETBUFFER (object
, current_buffer
);
886 if (! NILP (limit
) && ! EQ (limit
, Qt
))
887 CHECK_NUMBER_COERCE_MARKER (limit
);
889 i
= validate_interval_range (object
, &position
, &position
, soft
);
891 /* If LIMIT is t, return start of next interval--don't
892 bother checking further intervals. */
895 if (NULL_INTERVAL_P (i
))
898 next
= next_interval (i
);
900 if (NULL_INTERVAL_P (next
))
901 XSETFASTINT (position
, (STRINGP (object
)
902 ? XSTRING (object
)->size
903 : BUF_ZV (XBUFFER (object
))));
905 XSETFASTINT (position
, next
->position
);
909 if (NULL_INTERVAL_P (i
))
912 next
= next_interval (i
);
914 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
915 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
916 next
= next_interval (next
);
918 if (NULL_INTERVAL_P (next
))
920 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
923 XSETFASTINT (position
, next
->position
);
927 /* Return 1 if there's a change in some property between BEG and END. */
930 property_change_between_p (beg
, end
)
933 register INTERVAL i
, next
;
934 Lisp_Object object
, pos
;
936 XSETBUFFER (object
, current_buffer
);
937 XSETFASTINT (pos
, beg
);
939 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
940 if (NULL_INTERVAL_P (i
))
943 next
= next_interval (i
);
944 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
946 next
= next_interval (next
);
947 if (NULL_INTERVAL_P (next
))
949 if (next
->position
>= end
)
953 if (NULL_INTERVAL_P (next
))
959 DEFUN ("next-single-property-change", Fnext_single_property_change
,
960 Snext_single_property_change
, 2, 4, 0,
961 doc
: /* Return the position of next property change for a specific property.
962 Scans characters forward from POSITION till it finds
963 a change in the PROP property, then returns the position of the change.
964 The optional third argument OBJECT is the string or buffer to scan.
965 The property values are compared with `eq'.
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 fourth argument LIMIT is non-nil, don't search
970 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
971 (position
, prop
, object
, limit
)
972 Lisp_Object position
, prop
, object
, limit
;
974 register INTERVAL i
, next
;
975 register Lisp_Object here_val
;
978 XSETBUFFER (object
, current_buffer
);
981 CHECK_NUMBER_COERCE_MARKER (limit
);
983 i
= validate_interval_range (object
, &position
, &position
, soft
);
984 if (NULL_INTERVAL_P (i
))
987 here_val
= textget (i
->plist
, prop
);
988 next
= next_interval (i
);
989 while (! NULL_INTERVAL_P (next
)
990 && EQ (here_val
, textget (next
->plist
, prop
))
991 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
992 next
= next_interval (next
);
994 if (NULL_INTERVAL_P (next
))
996 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
999 return make_number (next
->position
);
1002 DEFUN ("previous-property-change", Fprevious_property_change
,
1003 Sprevious_property_change
, 1, 3, 0,
1004 doc
: /* Return the position of previous property change.
1005 Scans characters backwards from POSITION in OBJECT till it finds
1006 a change in some text property, then returns the position of the change.
1007 The optional second argument OBJECT is the string or buffer to scan.
1008 Return nil if the property is constant all the way to the start of OBJECT.
1009 If the value is non-nil, it is a position less than POSITION, never equal.
1011 If the optional third argument LIMIT is non-nil, don't search
1012 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1013 (position
, object
, limit
)
1014 Lisp_Object position
, object
, limit
;
1016 register INTERVAL i
, previous
;
1019 XSETBUFFER (object
, current_buffer
);
1022 CHECK_NUMBER_COERCE_MARKER (limit
);
1024 i
= validate_interval_range (object
, &position
, &position
, soft
);
1025 if (NULL_INTERVAL_P (i
))
1028 /* Start with the interval containing the char before point. */
1029 if (i
->position
== XFASTINT (position
))
1030 i
= previous_interval (i
);
1032 previous
= previous_interval (i
);
1033 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1035 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1036 previous
= previous_interval (previous
);
1037 if (NULL_INTERVAL_P (previous
))
1040 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1043 return make_number (previous
->position
+ LENGTH (previous
));
1046 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1047 Sprevious_single_property_change
, 2, 4, 0,
1048 doc
: /* Return the position of previous property change for a specific property.
1049 Scans characters backward from POSITION till it finds
1050 a change in the PROP property, then returns the position of the change.
1051 The optional third argument OBJECT is the string or buffer to scan.
1052 The property values are compared with `eq'.
1053 Return nil if the property is constant all the way to the start of OBJECT.
1054 If the value is non-nil, it is a position less than POSITION, never equal.
1056 If the optional fourth argument LIMIT is non-nil, don't search
1057 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1058 (position
, prop
, object
, limit
)
1059 Lisp_Object position
, prop
, object
, limit
;
1061 register INTERVAL i
, previous
;
1062 register Lisp_Object here_val
;
1065 XSETBUFFER (object
, current_buffer
);
1068 CHECK_NUMBER_COERCE_MARKER (limit
);
1070 i
= validate_interval_range (object
, &position
, &position
, soft
);
1072 /* Start with the interval containing the char before point. */
1073 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1074 i
= previous_interval (i
);
1076 if (NULL_INTERVAL_P (i
))
1079 here_val
= textget (i
->plist
, prop
);
1080 previous
= previous_interval (i
);
1081 while (! NULL_INTERVAL_P (previous
)
1082 && EQ (here_val
, textget (previous
->plist
, prop
))
1084 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1085 previous
= previous_interval (previous
);
1086 if (NULL_INTERVAL_P (previous
))
1089 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1092 return make_number (previous
->position
+ LENGTH (previous
));
1095 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1097 DEFUN ("add-text-properties", Fadd_text_properties
,
1098 Sadd_text_properties
, 3, 4, 0,
1099 doc
: /* Add properties to the text from START to END.
1100 The third argument PROPERTIES is a property list
1101 specifying the property values to add.
1102 The optional fourth argument, OBJECT,
1103 is the string or buffer containing the text.
1104 Return t if any property value actually changed, nil otherwise. */)
1105 (start
, end
, properties
, object
)
1106 Lisp_Object start
, end
, properties
, object
;
1108 register INTERVAL i
, unchanged
;
1109 register int s
, len
, modified
= 0;
1110 struct gcpro gcpro1
;
1112 properties
= validate_plist (properties
);
1113 if (NILP (properties
))
1117 XSETBUFFER (object
, current_buffer
);
1119 i
= validate_interval_range (object
, &start
, &end
, hard
);
1120 if (NULL_INTERVAL_P (i
))
1124 len
= XINT (end
) - s
;
1126 /* No need to protect OBJECT, because we GC only if it's a buffer,
1127 and live buffers are always protected. */
1128 GCPRO1 (properties
);
1130 /* If we're not starting on an interval boundary, we have to
1131 split this interval. */
1132 if (i
->position
!= s
)
1134 /* If this interval already has the properties, we can
1136 if (interval_has_all_properties (properties
, i
))
1138 int got
= (LENGTH (i
) - (s
- i
->position
));
1140 RETURN_UNGCPRO (Qnil
);
1142 i
= next_interval (i
);
1147 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1148 copy_properties (unchanged
, i
);
1152 if (BUFFERP (object
))
1153 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1155 /* We are at the beginning of interval I, with LEN chars to scan. */
1161 if (LENGTH (i
) >= len
)
1163 /* We can UNGCPRO safely here, because there will be just
1164 one more chance to gc, in the next call to add_properties,
1165 and after that we will not need PROPERTIES or OBJECT again. */
1168 if (interval_has_all_properties (properties
, i
))
1170 if (BUFFERP (object
))
1171 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1172 XINT (end
) - XINT (start
));
1174 return modified
? Qt
: Qnil
;
1177 if (LENGTH (i
) == len
)
1179 add_properties (properties
, i
, object
);
1180 if (BUFFERP (object
))
1181 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1182 XINT (end
) - XINT (start
));
1186 /* i doesn't have the properties, and goes past the change limit */
1188 i
= split_interval_left (unchanged
, len
);
1189 copy_properties (unchanged
, i
);
1190 add_properties (properties
, i
, object
);
1191 if (BUFFERP (object
))
1192 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1193 XINT (end
) - XINT (start
));
1198 modified
+= add_properties (properties
, i
, object
);
1199 i
= next_interval (i
);
1203 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1205 DEFUN ("put-text-property", Fput_text_property
,
1206 Sput_text_property
, 4, 5, 0,
1207 doc
: /* Set one property of the text from START to END.
1208 The third and fourth arguments PROPERTY and VALUE
1209 specify the property to add.
1210 The optional fifth argument, OBJECT,
1211 is the string or buffer containing the text. */)
1212 (start
, end
, property
, value
, object
)
1213 Lisp_Object start
, end
, property
, value
, object
;
1215 Fadd_text_properties (start
, end
,
1216 Fcons (property
, Fcons (value
, Qnil
)),
1221 DEFUN ("set-text-properties", Fset_text_properties
,
1222 Sset_text_properties
, 3, 4, 0,
1223 doc
: /* Completely replace properties of text from START to END.
1224 The third argument PROPERTIES is the new property list.
1225 The optional fourth argument, OBJECT,
1226 is the string or buffer containing the text.
1227 If OBJECT is omitted or nil, it defaults to the current buffer.
1228 If PROPERTIES is nil, the effect is to remove all properties from
1229 the designated part of OBJECT. */)
1230 (start
, end
, properties
, object
)
1231 Lisp_Object start
, end
, properties
, object
;
1233 return set_text_properties (start
, end
, properties
, object
, Qt
);
1237 /* Replace properties of text from START to END with new list of
1238 properties PROPERTIES. OBJECT is the buffer or string containing
1239 the text. OBJECT nil means use the current buffer.
1240 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1241 is non-nil if properties were replaced; it is nil if there weren't
1242 any properties to replace. */
1245 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1246 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1248 register INTERVAL i
, unchanged
;
1249 register INTERVAL prev_changed
= NULL_INTERVAL
;
1250 register int s
, len
;
1251 Lisp_Object ostart
, oend
;
1256 properties
= validate_plist (properties
);
1259 XSETBUFFER (object
, current_buffer
);
1261 /* If we want no properties for a whole string,
1262 get rid of its intervals. */
1263 if (NILP (properties
) && STRINGP (object
)
1264 && XFASTINT (start
) == 0
1265 && XFASTINT (end
) == XSTRING (object
)->size
)
1267 if (! XSTRING (object
)->intervals
)
1270 XSTRING (object
)->intervals
= 0;
1274 i
= validate_interval_range (object
, &start
, &end
, soft
);
1276 if (NULL_INTERVAL_P (i
))
1278 /* If buffer has no properties, and we want none, return now. */
1279 if (NILP (properties
))
1282 /* Restore the original START and END values
1283 because validate_interval_range increments them for strings. */
1287 i
= validate_interval_range (object
, &start
, &end
, hard
);
1288 /* This can return if start == end. */
1289 if (NULL_INTERVAL_P (i
))
1294 len
= XINT (end
) - s
;
1296 if (BUFFERP (object
))
1297 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1299 if (i
->position
!= s
)
1302 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1304 if (LENGTH (i
) > len
)
1306 copy_properties (unchanged
, i
);
1307 i
= split_interval_left (i
, len
);
1308 set_properties (properties
, i
, object
);
1309 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1310 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1311 XINT (end
) - XINT (start
));
1316 set_properties (properties
, i
, object
);
1318 if (LENGTH (i
) == len
)
1320 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1321 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1322 XINT (end
) - XINT (start
));
1329 i
= next_interval (i
);
1332 /* We are starting at the beginning of an interval, I */
1338 if (LENGTH (i
) >= len
)
1340 if (LENGTH (i
) > len
)
1341 i
= split_interval_left (i
, len
);
1343 /* We have to call set_properties even if we are going to
1344 merge the intervals, so as to make the undo records
1345 and cause redisplay to happen. */
1346 set_properties (properties
, i
, object
);
1347 if (!NULL_INTERVAL_P (prev_changed
))
1348 merge_interval_left (i
);
1349 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1350 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1351 XINT (end
) - XINT (start
));
1357 /* We have to call set_properties even if we are going to
1358 merge the intervals, so as to make the undo records
1359 and cause redisplay to happen. */
1360 set_properties (properties
, i
, object
);
1361 if (NULL_INTERVAL_P (prev_changed
))
1364 prev_changed
= i
= merge_interval_left (i
);
1366 i
= next_interval (i
);
1369 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1370 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1371 XINT (end
) - XINT (start
));
1375 DEFUN ("remove-text-properties", Fremove_text_properties
,
1376 Sremove_text_properties
, 3, 4, 0,
1377 doc
: /* Remove some properties from text from START to END.
1378 The third argument PROPERTIES is a property list
1379 whose property names specify the properties to remove.
1380 \(The values stored in PROPERTIES are ignored.)
1381 The optional fourth argument, OBJECT,
1382 is the string or buffer containing the text.
1383 Return t if any property was actually removed, nil otherwise. */)
1384 (start
, end
, properties
, object
)
1385 Lisp_Object start
, end
, properties
, object
;
1387 register INTERVAL i
, unchanged
;
1388 register int s
, len
, modified
= 0;
1391 XSETBUFFER (object
, current_buffer
);
1393 i
= validate_interval_range (object
, &start
, &end
, soft
);
1394 if (NULL_INTERVAL_P (i
))
1398 len
= XINT (end
) - s
;
1400 if (i
->position
!= s
)
1402 /* No properties on this first interval -- return if
1403 it covers the entire region. */
1404 if (! interval_has_some_properties (properties
, i
))
1406 int got
= (LENGTH (i
) - (s
- i
->position
));
1410 i
= next_interval (i
);
1412 /* Split away the beginning of this interval; what we don't
1417 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1418 copy_properties (unchanged
, i
);
1422 if (BUFFERP (object
))
1423 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1425 /* We are at the beginning of an interval, with len to scan */
1431 if (LENGTH (i
) >= len
)
1433 if (! interval_has_some_properties (properties
, i
))
1434 return modified
? Qt
: Qnil
;
1436 if (LENGTH (i
) == len
)
1438 remove_properties (properties
, i
, object
);
1439 if (BUFFERP (object
))
1440 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1441 XINT (end
) - XINT (start
));
1445 /* i has the properties, and goes past the change limit */
1447 i
= split_interval_left (i
, len
);
1448 copy_properties (unchanged
, i
);
1449 remove_properties (properties
, i
, object
);
1450 if (BUFFERP (object
))
1451 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1452 XINT (end
) - XINT (start
));
1457 modified
+= remove_properties (properties
, i
, object
);
1458 i
= next_interval (i
);
1462 DEFUN ("text-property-any", Ftext_property_any
,
1463 Stext_property_any
, 4, 5, 0,
1464 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1465 If so, return the position of the first character whose property PROPERTY
1466 is `eq' to VALUE. Otherwise return nil.
1467 The optional fifth argument, OBJECT, is the string or buffer
1468 containing the text. */)
1469 (start
, end
, property
, value
, object
)
1470 Lisp_Object start
, end
, property
, value
, object
;
1472 register INTERVAL i
;
1473 register int e
, pos
;
1476 XSETBUFFER (object
, current_buffer
);
1477 i
= validate_interval_range (object
, &start
, &end
, soft
);
1478 if (NULL_INTERVAL_P (i
))
1479 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1482 while (! NULL_INTERVAL_P (i
))
1484 if (i
->position
>= e
)
1486 if (EQ (textget (i
->plist
, property
), value
))
1489 if (pos
< XINT (start
))
1491 return make_number (pos
);
1493 i
= next_interval (i
);
1498 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1499 Stext_property_not_all
, 4, 5, 0,
1500 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1501 If so, return the position of the first character whose property PROPERTY
1502 is not `eq' to VALUE. Otherwise, return nil.
1503 The optional fifth argument, OBJECT, is the string or buffer
1504 containing the text. */)
1505 (start
, end
, property
, value
, object
)
1506 Lisp_Object start
, end
, property
, value
, object
;
1508 register INTERVAL i
;
1512 XSETBUFFER (object
, current_buffer
);
1513 i
= validate_interval_range (object
, &start
, &end
, soft
);
1514 if (NULL_INTERVAL_P (i
))
1515 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1519 while (! NULL_INTERVAL_P (i
))
1521 if (i
->position
>= e
)
1523 if (! EQ (textget (i
->plist
, property
), value
))
1525 if (i
->position
> s
)
1527 return make_number (s
);
1529 i
= next_interval (i
);
1534 /* I don't think this is the right interface to export; how often do you
1535 want to do something like this, other than when you're copying objects
1538 I think it would be better to have a pair of functions, one which
1539 returns the text properties of a region as a list of ranges and
1540 plists, and another which applies such a list to another object. */
1542 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1543 SRC and DEST may each refer to strings or buffers.
1544 Optional sixth argument PROP causes only that property to be copied.
1545 Properties are copied to DEST as if by `add-text-properties'.
1546 Return t if any property value actually changed, nil otherwise. */
1548 /* Note this can GC when DEST is a buffer. */
1551 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1552 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1558 int s
, e
, e2
, p
, len
, modified
= 0;
1559 struct gcpro gcpro1
, gcpro2
;
1561 i
= validate_interval_range (src
, &start
, &end
, soft
);
1562 if (NULL_INTERVAL_P (i
))
1565 CHECK_NUMBER_COERCE_MARKER (pos
);
1567 Lisp_Object dest_start
, dest_end
;
1570 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1571 /* Apply this to a copy of pos; it will try to increment its arguments,
1572 which we don't want. */
1573 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1584 e2
= i
->position
+ LENGTH (i
);
1591 while (! NILP (plist
))
1593 if (EQ (Fcar (plist
), prop
))
1595 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1598 plist
= Fcdr (Fcdr (plist
));
1602 /* Must defer modifications to the interval tree in case src
1603 and dest refer to the same string or buffer. */
1604 stuff
= Fcons (Fcons (make_number (p
),
1605 Fcons (make_number (p
+ len
),
1606 Fcons (plist
, Qnil
))),
1610 i
= next_interval (i
);
1611 if (NULL_INTERVAL_P (i
))
1618 GCPRO2 (stuff
, dest
);
1620 while (! NILP (stuff
))
1623 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1624 Fcar (Fcdr (Fcdr (res
))), dest
);
1627 stuff
= Fcdr (stuff
);
1632 return modified
? Qt
: Qnil
;
1636 /* Return a list representing the text properties of OBJECT between
1637 START and END. if PROP is non-nil, report only on that property.
1638 Each result list element has the form (S E PLIST), where S and E
1639 are positions in OBJECT and PLIST is a property list containing the
1640 text properties of OBJECT between S and E. Value is nil if OBJECT
1641 doesn't contain text properties between START and END. */
1644 text_property_list (object
, start
, end
, prop
)
1645 Lisp_Object object
, start
, end
, prop
;
1652 i
= validate_interval_range (object
, &start
, &end
, soft
);
1653 if (!NULL_INTERVAL_P (i
))
1655 int s
= XINT (start
);
1660 int interval_end
, len
;
1663 interval_end
= i
->position
+ LENGTH (i
);
1664 if (interval_end
> e
)
1666 len
= interval_end
- s
;
1671 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1672 if (EQ (Fcar (plist
), prop
))
1674 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1679 result
= Fcons (Fcons (make_number (s
),
1680 Fcons (make_number (s
+ len
),
1681 Fcons (plist
, Qnil
))),
1684 i
= next_interval (i
);
1685 if (NULL_INTERVAL_P (i
))
1695 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1696 (START END PLIST), where START and END are positions and PLIST is a
1697 property list containing the text properties to add. Adjust START
1698 and END positions by DELTA before adding properties. Value is
1699 non-zero if OBJECT was modified. */
1702 add_text_properties_from_list (object
, list
, delta
)
1703 Lisp_Object object
, list
, delta
;
1705 struct gcpro gcpro1
, gcpro2
;
1708 GCPRO2 (list
, object
);
1710 for (; CONSP (list
); list
= XCDR (list
))
1712 Lisp_Object item
, start
, end
, plist
, tem
;
1715 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1716 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1717 plist
= XCAR (XCDR (XCDR (item
)));
1719 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1730 /* Modify end-points of ranges in LIST destructively. LIST is a list
1731 as returned from text_property_list. Change end-points equal to
1732 OLD_END to NEW_END. */
1735 extend_property_ranges (list
, old_end
, new_end
)
1736 Lisp_Object list
, old_end
, new_end
;
1738 for (; CONSP (list
); list
= XCDR (list
))
1740 Lisp_Object item
, end
;
1743 end
= XCAR (XCDR (item
));
1745 if (EQ (end
, old_end
))
1746 XSETCAR (XCDR (item
), new_end
);
1752 /* Call the modification hook functions in LIST, each with START and END. */
1755 call_mod_hooks (list
, start
, end
)
1756 Lisp_Object list
, start
, end
;
1758 struct gcpro gcpro1
;
1760 while (!NILP (list
))
1762 call2 (Fcar (list
), start
, end
);
1768 /* Check for read-only intervals between character positions START ... END,
1769 in BUF, and signal an error if we find one.
1771 Then check for any modification hooks in the range.
1772 Create a list of all these hooks in lexicographic order,
1773 eliminating consecutive extra copies of the same hook. Then call
1774 those hooks in order, with START and END - 1 as arguments. */
1777 verify_interval_modification (buf
, start
, end
)
1781 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1782 register INTERVAL i
;
1784 register Lisp_Object prev_mod_hooks
;
1785 Lisp_Object mod_hooks
;
1786 struct gcpro gcpro1
;
1789 prev_mod_hooks
= Qnil
;
1792 interval_insert_behind_hooks
= Qnil
;
1793 interval_insert_in_front_hooks
= Qnil
;
1795 if (NULL_INTERVAL_P (intervals
))
1805 /* For an insert operation, check the two chars around the position. */
1808 INTERVAL prev
= NULL
;
1809 Lisp_Object before
, after
;
1811 /* Set I to the interval containing the char after START,
1812 and PREV to the interval containing the char before START.
1813 Either one may be null. They may be equal. */
1814 i
= find_interval (intervals
, start
);
1816 if (start
== BUF_BEGV (buf
))
1818 else if (i
->position
== start
)
1819 prev
= previous_interval (i
);
1820 else if (i
->position
< start
)
1822 if (start
== BUF_ZV (buf
))
1825 /* If Vinhibit_read_only is set and is not a list, we can
1826 skip the read_only checks. */
1827 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1829 /* If I and PREV differ we need to check for the read-only
1830 property together with its stickiness. If either I or
1831 PREV are 0, this check is all we need.
1832 We have to take special care, since read-only may be
1833 indirectly defined via the category property. */
1836 if (! NULL_INTERVAL_P (i
))
1838 after
= textget (i
->plist
, Qread_only
);
1840 /* If interval I is read-only and read-only is
1841 front-sticky, inhibit insertion.
1842 Check for read-only as well as category. */
1844 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1848 tem
= textget (i
->plist
, Qfront_sticky
);
1849 if (TMEM (Qread_only
, tem
)
1850 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1851 && TMEM (Qcategory
, tem
)))
1856 if (! NULL_INTERVAL_P (prev
))
1858 before
= textget (prev
->plist
, Qread_only
);
1860 /* If interval PREV is read-only and read-only isn't
1861 rear-nonsticky, inhibit insertion.
1862 Check for read-only as well as category. */
1864 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1868 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1869 if (! TMEM (Qread_only
, tem
)
1870 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1871 || ! TMEM (Qcategory
, tem
)))
1876 else if (! NULL_INTERVAL_P (i
))
1878 after
= textget (i
->plist
, Qread_only
);
1880 /* If interval I is read-only and read-only is
1881 front-sticky, inhibit insertion.
1882 Check for read-only as well as category. */
1883 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1887 tem
= textget (i
->plist
, Qfront_sticky
);
1888 if (TMEM (Qread_only
, tem
)
1889 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1890 && TMEM (Qcategory
, tem
)))
1893 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1894 if (! TMEM (Qread_only
, tem
)
1895 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1896 || ! TMEM (Qcategory
, tem
)))
1902 /* Run both insert hooks (just once if they're the same). */
1903 if (!NULL_INTERVAL_P (prev
))
1904 interval_insert_behind_hooks
1905 = textget (prev
->plist
, Qinsert_behind_hooks
);
1906 if (!NULL_INTERVAL_P (i
))
1907 interval_insert_in_front_hooks
1908 = textget (i
->plist
, Qinsert_in_front_hooks
);
1912 /* Loop over intervals on or next to START...END,
1913 collecting their hooks. */
1915 i
= find_interval (intervals
, start
);
1918 if (! INTERVAL_WRITABLE_P (i
))
1921 if (!inhibit_modification_hooks
)
1923 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1924 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1926 hooks
= Fcons (mod_hooks
, hooks
);
1927 prev_mod_hooks
= mod_hooks
;
1931 i
= next_interval (i
);
1933 /* Keep going thru the interval containing the char before END. */
1934 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1936 if (!inhibit_modification_hooks
)
1939 hooks
= Fnreverse (hooks
);
1940 while (! EQ (hooks
, Qnil
))
1942 call_mod_hooks (Fcar (hooks
), make_number (start
),
1944 hooks
= Fcdr (hooks
);
1951 /* Run the interval hooks for an insertion on character range START ... END.
1952 verify_interval_modification chose which hooks to run;
1953 this function is called after the insertion happens
1954 so it can indicate the range of inserted text. */
1957 report_interval_modification (start
, end
)
1958 Lisp_Object start
, end
;
1960 if (! NILP (interval_insert_behind_hooks
))
1961 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1962 if (! NILP (interval_insert_in_front_hooks
)
1963 && ! EQ (interval_insert_in_front_hooks
,
1964 interval_insert_behind_hooks
))
1965 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1971 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1972 doc
: /* Property-list used as default values.
1973 The value of a property in this list is seen as the value for every
1974 character that does not have its own value for that property. */);
1975 Vdefault_text_properties
= Qnil
;
1977 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1978 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
1979 This also inhibits the use of the `intangible' text property. */);
1980 Vinhibit_point_motion_hooks
= Qnil
;
1982 DEFVAR_LISP ("text-property-default-nonsticky",
1983 &Vtext_property_default_nonsticky
,
1984 doc
: /* Alist of properties vs the corresponding non-stickinesses.
1985 Each element has the form (PROPERTY . NONSTICKINESS).
1987 If a character in a buffer has PROPERTY, new text inserted adjacent to
1988 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
1989 inherits it if NONSTICKINESS is nil. The front-sticky and
1990 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
1991 Vtext_property_default_nonsticky
= Qnil
;
1993 staticpro (&interval_insert_behind_hooks
);
1994 staticpro (&interval_insert_in_front_hooks
);
1995 interval_insert_behind_hooks
= Qnil
;
1996 interval_insert_in_front_hooks
= Qnil
;
1999 /* Common attributes one might give text */
2001 staticpro (&Qforeground
);
2002 Qforeground
= intern ("foreground");
2003 staticpro (&Qbackground
);
2004 Qbackground
= intern ("background");
2006 Qfont
= intern ("font");
2007 staticpro (&Qstipple
);
2008 Qstipple
= intern ("stipple");
2009 staticpro (&Qunderline
);
2010 Qunderline
= intern ("underline");
2011 staticpro (&Qread_only
);
2012 Qread_only
= intern ("read-only");
2013 staticpro (&Qinvisible
);
2014 Qinvisible
= intern ("invisible");
2015 staticpro (&Qintangible
);
2016 Qintangible
= intern ("intangible");
2017 staticpro (&Qcategory
);
2018 Qcategory
= intern ("category");
2019 staticpro (&Qlocal_map
);
2020 Qlocal_map
= intern ("local-map");
2021 staticpro (&Qfront_sticky
);
2022 Qfront_sticky
= intern ("front-sticky");
2023 staticpro (&Qrear_nonsticky
);
2024 Qrear_nonsticky
= intern ("rear-nonsticky");
2025 staticpro (&Qmouse_face
);
2026 Qmouse_face
= intern ("mouse-face");
2028 /* Properties that text might use to specify certain actions */
2030 staticpro (&Qmouse_left
);
2031 Qmouse_left
= intern ("mouse-left");
2032 staticpro (&Qmouse_entered
);
2033 Qmouse_entered
= intern ("mouse-entered");
2034 staticpro (&Qpoint_left
);
2035 Qpoint_left
= intern ("point-left");
2036 staticpro (&Qpoint_entered
);
2037 Qpoint_entered
= intern ("point-entered");
2039 defsubr (&Stext_properties_at
);
2040 defsubr (&Sget_text_property
);
2041 defsubr (&Sget_char_property
);
2042 defsubr (&Snext_char_property_change
);
2043 defsubr (&Sprevious_char_property_change
);
2044 defsubr (&Snext_single_char_property_change
);
2045 defsubr (&Sprevious_single_char_property_change
);
2046 defsubr (&Snext_property_change
);
2047 defsubr (&Snext_single_property_change
);
2048 defsubr (&Sprevious_property_change
);
2049 defsubr (&Sprevious_single_property_change
);
2050 defsubr (&Sadd_text_properties
);
2051 defsubr (&Sput_text_property
);
2052 defsubr (&Sset_text_properties
);
2053 defsubr (&Sremove_text_properties
);
2054 defsubr (&Stext_property_any
);
2055 defsubr (&Stext_property_not_all
);
2056 /* defsubr (&Serase_text_properties); */
2057 /* defsubr (&Scopy_text_properties); */