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
, 0);
127 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
128 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
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
, 0);
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 "Return the list of properties of the character at POSITION in OBJECT.\n\
538 OBJECT is the string or buffer to look for the properties in;\n\
539 nil means the current buffer.\n\
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 "Return the value of POSITION's property PROP, in OBJECT.\n\
564 OBJECT is optional and defaults to the current buffer.\n\
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
, 0);
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 "Return the value of POSITION's property PROP, in OBJECT.\n\
658 OBJECT is optional and defaults to the current buffer.\n\
659 If POSITION is at the end of OBJECT, the value is nil.\n\
660 If OBJECT is a buffer, then overlay properties are considered as well as\n\
662 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
663 overlays are considered only if they are associated with OBJECT.")
664 (position
, prop
, object
)
665 Lisp_Object position
, object
;
666 register Lisp_Object prop
;
668 return get_char_property_and_overlay (position
, prop
, object
, 0);
671 DEFUN ("next-char-property-change", Fnext_char_property_change
,
672 Snext_char_property_change
, 1, 2, 0,
673 "Return the position of next text property or overlay change.\n\
674 This scans characters forward from POSITION till it finds a change in\n\
675 some text property, or the beginning or end of an overlay, and returns\n\
676 the position of that.\n\
677 If none is found, the function returns (point-max).\n\
679 If the optional third argument LIMIT is non-nil, don't search\n\
680 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
682 Lisp_Object position
, limit
;
686 temp
= Fnext_overlay_change (position
);
689 CHECK_NUMBER (limit
, 2);
690 if (XINT (limit
) < XINT (temp
))
693 return Fnext_property_change (position
, Qnil
, temp
);
696 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
697 Sprevious_char_property_change
, 1, 2, 0,
698 "Return the position of previous text property or overlay change.\n\
699 Scans characters backward from POSITION till it finds a change in some\n\
700 text property, or the beginning or end of an overlay, and returns the\n\
702 If none is found, the function returns (point-max).\n\
704 If the optional third argument LIMIT is non-nil, don't search\n\
705 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
707 Lisp_Object position
, limit
;
711 temp
= Fprevious_overlay_change (position
);
714 CHECK_NUMBER (limit
, 2);
715 if (XINT (limit
) > XINT (temp
))
718 return Fprevious_property_change (position
, Qnil
, temp
);
722 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
723 Snext_single_char_property_change
, 2, 4, 0,
724 "Return the position of next text property or overlay change for a specific property.\n\
725 Scans characters forward from POSITION till it finds\n\
726 a change in the PROP property, then returns the position of the change.\n\
727 The optional third argument OBJECT is the string or buffer to scan.\n\
728 The property values are compared with `eq'.\n\
729 If the property is constant all the way to the end of OBJECT, return the\n\
730 last valid position in OBJECT.\n\
731 If the optional fourth argument LIMIT is non-nil, don't search\n\
732 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
733 (position
, prop
, object
, limit
)
734 Lisp_Object prop
, position
, object
, limit
;
736 if (STRINGP (object
))
738 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
742 position
= make_number (XSTRING (object
)->size
);
749 Lisp_Object initial_value
, value
;
750 int count
= specpdl_ptr
- specpdl
;
753 CHECK_BUFFER (object
, 0);
755 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
757 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
758 Fset_buffer (object
);
761 initial_value
= Fget_char_property (position
, prop
, object
);
764 XSETFASTINT (limit
, BUF_ZV (current_buffer
));
766 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
770 position
= Fnext_char_property_change (position
, limit
);
771 if (XFASTINT (position
) >= XFASTINT (limit
)) {
776 value
= Fget_char_property (position
, prop
, object
);
777 if (!EQ (value
, initial_value
))
781 unbind_to (count
, Qnil
);
787 DEFUN ("previous-single-char-property-change",
788 Fprevious_single_char_property_change
,
789 Sprevious_single_char_property_change
, 2, 4, 0,
790 "Return the position of previous text property or overlay change for a specific property.\n\
791 Scans characters backward from POSITION till it finds\n\
792 a change in the PROP property, then returns the position of the change.\n\
793 The optional third argument OBJECT is the string or buffer to scan.\n\
794 The property values are compared with `eq'.\n\
795 If the property is constant all the way to the start of OBJECT, return the\n\
796 first valid position in OBJECT.\n\
797 If the optional fourth argument LIMIT is non-nil, don't search\n\
798 back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
799 (position
, prop
, object
, limit
)
800 Lisp_Object prop
, position
, object
, limit
;
802 if (STRINGP (object
))
804 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
808 position
= make_number (XSTRING (object
)->size
);
815 int count
= specpdl_ptr
- specpdl
;
818 CHECK_BUFFER (object
, 0);
820 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
822 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
823 Fset_buffer (object
);
827 XSETFASTINT (limit
, BUF_BEGV (current_buffer
));
829 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
831 if (XFASTINT (position
) <= XFASTINT (limit
))
835 Lisp_Object initial_value
=
836 Fget_char_property (make_number (XFASTINT (position
) - 1),
841 position
= Fprevious_char_property_change (position
, limit
);
843 if (XFASTINT (position
) <= XFASTINT (limit
))
851 Fget_char_property (make_number (XFASTINT (position
) - 1),
854 if (!EQ (value
, initial_value
))
860 unbind_to (count
, Qnil
);
866 DEFUN ("next-property-change", Fnext_property_change
,
867 Snext_property_change
, 1, 3, 0,
868 "Return the position of next property change.\n\
869 Scans characters forward from POSITION in OBJECT till it finds\n\
870 a change in some text property, then returns the position of the change.\n\
871 The optional second argument OBJECT is the string or buffer to scan.\n\
872 Return nil if the property is constant all the way to the end of OBJECT.\n\
873 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
874 If the optional third argument LIMIT is non-nil, don't search\n\
875 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
876 (position
, object
, limit
)
877 Lisp_Object position
, object
, limit
;
879 register INTERVAL i
, next
;
882 XSETBUFFER (object
, current_buffer
);
884 if (! NILP (limit
) && ! EQ (limit
, Qt
))
885 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
887 i
= validate_interval_range (object
, &position
, &position
, soft
);
889 /* If LIMIT is t, return start of next interval--don't
890 bother checking further intervals. */
893 if (NULL_INTERVAL_P (i
))
896 next
= next_interval (i
);
898 if (NULL_INTERVAL_P (next
))
899 XSETFASTINT (position
, (STRINGP (object
)
900 ? XSTRING (object
)->size
901 : BUF_ZV (XBUFFER (object
))));
903 XSETFASTINT (position
, next
->position
);
907 if (NULL_INTERVAL_P (i
))
910 next
= next_interval (i
);
912 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
913 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
914 next
= next_interval (next
);
916 if (NULL_INTERVAL_P (next
))
918 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
921 XSETFASTINT (position
, next
->position
);
925 /* Return 1 if there's a change in some property between BEG and END. */
928 property_change_between_p (beg
, end
)
931 register INTERVAL i
, next
;
932 Lisp_Object object
, pos
;
934 XSETBUFFER (object
, current_buffer
);
935 XSETFASTINT (pos
, beg
);
937 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
938 if (NULL_INTERVAL_P (i
))
941 next
= next_interval (i
);
942 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
944 next
= next_interval (next
);
945 if (NULL_INTERVAL_P (next
))
947 if (next
->position
>= end
)
951 if (NULL_INTERVAL_P (next
))
957 DEFUN ("next-single-property-change", Fnext_single_property_change
,
958 Snext_single_property_change
, 2, 4, 0,
959 "Return the position of next property change for a specific property.\n\
960 Scans characters forward from POSITION till it finds\n\
961 a change in the PROP property, then returns the position of the change.\n\
962 The optional third argument OBJECT is the string or buffer to scan.\n\
963 The property values are compared with `eq'.\n\
964 Return nil if the property is constant all the way to the end of OBJECT.\n\
965 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
966 If the optional fourth argument LIMIT is non-nil, don't search\n\
967 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
968 (position
, prop
, object
, limit
)
969 Lisp_Object position
, prop
, object
, limit
;
971 register INTERVAL i
, next
;
972 register Lisp_Object here_val
;
975 XSETBUFFER (object
, current_buffer
);
978 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
980 i
= validate_interval_range (object
, &position
, &position
, soft
);
981 if (NULL_INTERVAL_P (i
))
984 here_val
= textget (i
->plist
, prop
);
985 next
= next_interval (i
);
986 while (! NULL_INTERVAL_P (next
)
987 && EQ (here_val
, textget (next
->plist
, prop
))
988 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
989 next
= next_interval (next
);
991 if (NULL_INTERVAL_P (next
))
993 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
996 return make_number (next
->position
);
999 DEFUN ("previous-property-change", Fprevious_property_change
,
1000 Sprevious_property_change
, 1, 3, 0,
1001 "Return the position of previous property change.\n\
1002 Scans characters backwards from POSITION in OBJECT till it finds\n\
1003 a change in some text property, then returns the position of the change.\n\
1004 The optional second argument OBJECT is the string or buffer to scan.\n\
1005 Return nil if the property is constant all the way to the start of OBJECT.\n\
1006 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
1007 If the optional third argument LIMIT is non-nil, don't search\n\
1008 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
1009 (position
, object
, limit
)
1010 Lisp_Object position
, object
, limit
;
1012 register INTERVAL i
, previous
;
1015 XSETBUFFER (object
, current_buffer
);
1018 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
1020 i
= validate_interval_range (object
, &position
, &position
, soft
);
1021 if (NULL_INTERVAL_P (i
))
1024 /* Start with the interval containing the char before point. */
1025 if (i
->position
== XFASTINT (position
))
1026 i
= previous_interval (i
);
1028 previous
= previous_interval (i
);
1029 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1031 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1032 previous
= previous_interval (previous
);
1033 if (NULL_INTERVAL_P (previous
))
1036 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1039 return make_number (previous
->position
+ LENGTH (previous
));
1042 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1043 Sprevious_single_property_change
, 2, 4, 0,
1044 "Return the position of previous property change for a specific property.\n\
1045 Scans characters backward from POSITION till it finds\n\
1046 a change in the PROP property, then returns the position of the change.\n\
1047 The optional third argument OBJECT is the string or buffer to scan.\n\
1048 The property values are compared with `eq'.\n\
1049 Return nil if the property is constant all the way to the start of OBJECT.\n\
1050 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
1051 If the optional fourth argument LIMIT is non-nil, don't search\n\
1052 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
1053 (position
, prop
, object
, limit
)
1054 Lisp_Object position
, prop
, object
, limit
;
1056 register INTERVAL i
, previous
;
1057 register Lisp_Object here_val
;
1060 XSETBUFFER (object
, current_buffer
);
1063 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
1065 i
= validate_interval_range (object
, &position
, &position
, soft
);
1067 /* Start with the interval containing the char before point. */
1068 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1069 i
= previous_interval (i
);
1071 if (NULL_INTERVAL_P (i
))
1074 here_val
= textget (i
->plist
, prop
);
1075 previous
= previous_interval (i
);
1076 while (! NULL_INTERVAL_P (previous
)
1077 && EQ (here_val
, textget (previous
->plist
, prop
))
1079 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1080 previous
= previous_interval (previous
);
1081 if (NULL_INTERVAL_P (previous
))
1084 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1087 return make_number (previous
->position
+ LENGTH (previous
));
1090 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1092 DEFUN ("add-text-properties", Fadd_text_properties
,
1093 Sadd_text_properties
, 3, 4, 0,
1094 "Add properties to the text from START to END.\n\
1095 The third argument PROPERTIES is a property list\n\
1096 specifying the property values to add.\n\
1097 The optional fourth argument, OBJECT,\n\
1098 is the string or buffer containing the text.\n\
1099 Return t if any property value actually changed, nil otherwise.")
1100 (start
, end
, properties
, object
)
1101 Lisp_Object start
, end
, properties
, object
;
1103 register INTERVAL i
, unchanged
;
1104 register int s
, len
, modified
= 0;
1105 struct gcpro gcpro1
;
1107 properties
= validate_plist (properties
);
1108 if (NILP (properties
))
1112 XSETBUFFER (object
, current_buffer
);
1114 i
= validate_interval_range (object
, &start
, &end
, hard
);
1115 if (NULL_INTERVAL_P (i
))
1119 len
= XINT (end
) - s
;
1121 /* No need to protect OBJECT, because we GC only if it's a buffer,
1122 and live buffers are always protected. */
1123 GCPRO1 (properties
);
1125 /* If we're not starting on an interval boundary, we have to
1126 split this interval. */
1127 if (i
->position
!= s
)
1129 /* If this interval already has the properties, we can
1131 if (interval_has_all_properties (properties
, i
))
1133 int got
= (LENGTH (i
) - (s
- i
->position
));
1135 RETURN_UNGCPRO (Qnil
);
1137 i
= next_interval (i
);
1142 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1143 copy_properties (unchanged
, i
);
1147 if (BUFFERP (object
))
1148 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1150 /* We are at the beginning of interval I, with LEN chars to scan. */
1156 if (LENGTH (i
) >= len
)
1158 /* We can UNGCPRO safely here, because there will be just
1159 one more chance to gc, in the next call to add_properties,
1160 and after that we will not need PROPERTIES or OBJECT again. */
1163 if (interval_has_all_properties (properties
, i
))
1165 if (BUFFERP (object
))
1166 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1167 XINT (end
) - XINT (start
));
1169 return modified
? Qt
: Qnil
;
1172 if (LENGTH (i
) == len
)
1174 add_properties (properties
, i
, object
);
1175 if (BUFFERP (object
))
1176 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1177 XINT (end
) - XINT (start
));
1181 /* i doesn't have the properties, and goes past the change limit */
1183 i
= split_interval_left (unchanged
, len
);
1184 copy_properties (unchanged
, i
);
1185 add_properties (properties
, i
, object
);
1186 if (BUFFERP (object
))
1187 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1188 XINT (end
) - XINT (start
));
1193 modified
+= add_properties (properties
, i
, object
);
1194 i
= next_interval (i
);
1198 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1200 DEFUN ("put-text-property", Fput_text_property
,
1201 Sput_text_property
, 4, 5, 0,
1202 "Set one property of the text from START to END.\n\
1203 The third and fourth arguments PROPERTY and VALUE\n\
1204 specify the property to add.\n\
1205 The optional fifth argument, OBJECT,\n\
1206 is the string or buffer containing the text.")
1207 (start
, end
, property
, value
, object
)
1208 Lisp_Object start
, end
, property
, value
, object
;
1210 Fadd_text_properties (start
, end
,
1211 Fcons (property
, Fcons (value
, Qnil
)),
1216 DEFUN ("set-text-properties", Fset_text_properties
,
1217 Sset_text_properties
, 3, 4, 0,
1218 "Completely replace properties of text from START to END.\n\
1219 The third argument PROPERTIES is the new property list.\n\
1220 The optional fourth argument, OBJECT,\n\
1221 is the string or buffer containing the text.\n\
1222 If OBJECT is omitted or nil, it defaults to the current buffer.\n\
1223 If PROPERTIES is nil, the effect is to remove all properties from\n\
1224 the designated part of OBJECT.")
1225 (start
, end
, properties
, object
)
1226 Lisp_Object start
, end
, properties
, object
;
1228 return set_text_properties (start
, end
, properties
, object
, Qt
);
1232 /* Replace properties of text from START to END with new list of
1233 properties PROPERTIES. OBJECT is the buffer or string containing
1234 the text. OBJECT nil means use the current buffer.
1235 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1236 is non-nil if properties were replaced; it is nil if there weren't
1237 any properties to replace. */
1240 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1241 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1243 register INTERVAL i
, unchanged
;
1244 register INTERVAL prev_changed
= NULL_INTERVAL
;
1245 register int s
, len
;
1246 Lisp_Object ostart
, oend
;
1251 properties
= validate_plist (properties
);
1254 XSETBUFFER (object
, current_buffer
);
1256 /* If we want no properties for a whole string,
1257 get rid of its intervals. */
1258 if (NILP (properties
) && STRINGP (object
)
1259 && XFASTINT (start
) == 0
1260 && XFASTINT (end
) == XSTRING (object
)->size
)
1262 if (! XSTRING (object
)->intervals
)
1265 XSTRING (object
)->intervals
= 0;
1269 i
= validate_interval_range (object
, &start
, &end
, soft
);
1271 if (NULL_INTERVAL_P (i
))
1273 /* If buffer has no properties, and we want none, return now. */
1274 if (NILP (properties
))
1277 /* Restore the original START and END values
1278 because validate_interval_range increments them for strings. */
1282 i
= validate_interval_range (object
, &start
, &end
, hard
);
1283 /* This can return if start == end. */
1284 if (NULL_INTERVAL_P (i
))
1289 len
= XINT (end
) - s
;
1291 if (BUFFERP (object
))
1292 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1294 if (i
->position
!= s
)
1297 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1299 if (LENGTH (i
) > len
)
1301 copy_properties (unchanged
, i
);
1302 i
= split_interval_left (i
, len
);
1303 set_properties (properties
, i
, object
);
1304 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1305 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1306 XINT (end
) - XINT (start
));
1311 set_properties (properties
, i
, object
);
1313 if (LENGTH (i
) == len
)
1315 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1316 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1317 XINT (end
) - XINT (start
));
1324 i
= next_interval (i
);
1327 /* We are starting at the beginning of an interval, I */
1333 if (LENGTH (i
) >= len
)
1335 if (LENGTH (i
) > len
)
1336 i
= split_interval_left (i
, len
);
1338 /* We have to call set_properties even if we are going to
1339 merge the intervals, so as to make the undo records
1340 and cause redisplay to happen. */
1341 set_properties (properties
, i
, object
);
1342 if (!NULL_INTERVAL_P (prev_changed
))
1343 merge_interval_left (i
);
1344 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1345 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1346 XINT (end
) - XINT (start
));
1352 /* We have to call set_properties even if we are going to
1353 merge the intervals, so as to make the undo records
1354 and cause redisplay to happen. */
1355 set_properties (properties
, i
, object
);
1356 if (NULL_INTERVAL_P (prev_changed
))
1359 prev_changed
= i
= merge_interval_left (i
);
1361 i
= next_interval (i
);
1364 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1365 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1366 XINT (end
) - XINT (start
));
1370 DEFUN ("remove-text-properties", Fremove_text_properties
,
1371 Sremove_text_properties
, 3, 4, 0,
1372 "Remove some properties from text from START to END.\n\
1373 The third argument PROPERTIES is a property list\n\
1374 whose property names specify the properties to remove.\n\
1375 \(The values stored in PROPERTIES are ignored.)\n\
1376 The optional fourth argument, OBJECT,\n\
1377 is the string or buffer containing the text.\n\
1378 Return t if any property was actually removed, nil otherwise.")
1379 (start
, end
, properties
, object
)
1380 Lisp_Object start
, end
, properties
, object
;
1382 register INTERVAL i
, unchanged
;
1383 register int s
, len
, modified
= 0;
1386 XSETBUFFER (object
, current_buffer
);
1388 i
= validate_interval_range (object
, &start
, &end
, soft
);
1389 if (NULL_INTERVAL_P (i
))
1393 len
= XINT (end
) - s
;
1395 if (i
->position
!= s
)
1397 /* No properties on this first interval -- return if
1398 it covers the entire region. */
1399 if (! interval_has_some_properties (properties
, i
))
1401 int got
= (LENGTH (i
) - (s
- i
->position
));
1405 i
= next_interval (i
);
1407 /* Split away the beginning of this interval; what we don't
1412 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1413 copy_properties (unchanged
, i
);
1417 if (BUFFERP (object
))
1418 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1420 /* We are at the beginning of an interval, with len to scan */
1426 if (LENGTH (i
) >= len
)
1428 if (! interval_has_some_properties (properties
, i
))
1429 return modified
? Qt
: Qnil
;
1431 if (LENGTH (i
) == len
)
1433 remove_properties (properties
, i
, object
);
1434 if (BUFFERP (object
))
1435 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1436 XINT (end
) - XINT (start
));
1440 /* i has the properties, and goes past the change limit */
1442 i
= split_interval_left (i
, len
);
1443 copy_properties (unchanged
, i
);
1444 remove_properties (properties
, i
, object
);
1445 if (BUFFERP (object
))
1446 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1447 XINT (end
) - XINT (start
));
1452 modified
+= remove_properties (properties
, i
, object
);
1453 i
= next_interval (i
);
1457 DEFUN ("text-property-any", Ftext_property_any
,
1458 Stext_property_any
, 4, 5, 0,
1459 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1460 If so, return the position of the first character whose property PROPERTY\n\
1461 is `eq' to VALUE. Otherwise return nil.\n\
1462 The optional fifth argument, OBJECT, is the string or buffer\n\
1463 containing the text.")
1464 (start
, end
, property
, value
, object
)
1465 Lisp_Object start
, end
, property
, value
, object
;
1467 register INTERVAL i
;
1468 register int e
, pos
;
1471 XSETBUFFER (object
, current_buffer
);
1472 i
= validate_interval_range (object
, &start
, &end
, soft
);
1473 if (NULL_INTERVAL_P (i
))
1474 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1477 while (! NULL_INTERVAL_P (i
))
1479 if (i
->position
>= e
)
1481 if (EQ (textget (i
->plist
, property
), value
))
1484 if (pos
< XINT (start
))
1486 return make_number (pos
);
1488 i
= next_interval (i
);
1493 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1494 Stext_property_not_all
, 4, 5, 0,
1495 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1496 If so, return the position of the first character whose property PROPERTY\n\
1497 is not `eq' to VALUE. Otherwise, return nil.\n\
1498 The optional fifth argument, OBJECT, is the string or buffer\n\
1499 containing the text.")
1500 (start
, end
, property
, value
, object
)
1501 Lisp_Object start
, end
, property
, value
, object
;
1503 register INTERVAL i
;
1507 XSETBUFFER (object
, current_buffer
);
1508 i
= validate_interval_range (object
, &start
, &end
, soft
);
1509 if (NULL_INTERVAL_P (i
))
1510 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1514 while (! NULL_INTERVAL_P (i
))
1516 if (i
->position
>= e
)
1518 if (! EQ (textget (i
->plist
, property
), value
))
1520 if (i
->position
> s
)
1522 return make_number (s
);
1524 i
= next_interval (i
);
1529 /* I don't think this is the right interface to export; how often do you
1530 want to do something like this, other than when you're copying objects
1533 I think it would be better to have a pair of functions, one which
1534 returns the text properties of a region as a list of ranges and
1535 plists, and another which applies such a list to another object. */
1537 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1538 SRC and DEST may each refer to strings or buffers.
1539 Optional sixth argument PROP causes only that property to be copied.
1540 Properties are copied to DEST as if by `add-text-properties'.
1541 Return t if any property value actually changed, nil otherwise. */
1543 /* Note this can GC when DEST is a buffer. */
1546 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1547 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1553 int s
, e
, e2
, p
, len
, modified
= 0;
1554 struct gcpro gcpro1
, gcpro2
;
1556 i
= validate_interval_range (src
, &start
, &end
, soft
);
1557 if (NULL_INTERVAL_P (i
))
1560 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1562 Lisp_Object dest_start
, dest_end
;
1565 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1566 /* Apply this to a copy of pos; it will try to increment its arguments,
1567 which we don't want. */
1568 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1579 e2
= i
->position
+ LENGTH (i
);
1586 while (! NILP (plist
))
1588 if (EQ (Fcar (plist
), prop
))
1590 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1593 plist
= Fcdr (Fcdr (plist
));
1597 /* Must defer modifications to the interval tree in case src
1598 and dest refer to the same string or buffer. */
1599 stuff
= Fcons (Fcons (make_number (p
),
1600 Fcons (make_number (p
+ len
),
1601 Fcons (plist
, Qnil
))),
1605 i
= next_interval (i
);
1606 if (NULL_INTERVAL_P (i
))
1613 GCPRO2 (stuff
, dest
);
1615 while (! NILP (stuff
))
1618 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1619 Fcar (Fcdr (Fcdr (res
))), dest
);
1622 stuff
= Fcdr (stuff
);
1627 return modified
? Qt
: Qnil
;
1631 /* Return a list representing the text properties of OBJECT between
1632 START and END. if PROP is non-nil, report only on that property.
1633 Each result list element has the form (S E PLIST), where S and E
1634 are positions in OBJECT and PLIST is a property list containing the
1635 text properties of OBJECT between S and E. Value is nil if OBJECT
1636 doesn't contain text properties between START and END. */
1639 text_property_list (object
, start
, end
, prop
)
1640 Lisp_Object object
, start
, end
, prop
;
1647 i
= validate_interval_range (object
, &start
, &end
, soft
);
1648 if (!NULL_INTERVAL_P (i
))
1650 int s
= XINT (start
);
1655 int interval_end
, len
;
1658 interval_end
= i
->position
+ LENGTH (i
);
1659 if (interval_end
> e
)
1661 len
= interval_end
- s
;
1666 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1667 if (EQ (Fcar (plist
), prop
))
1669 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1674 result
= Fcons (Fcons (make_number (s
),
1675 Fcons (make_number (s
+ len
),
1676 Fcons (plist
, Qnil
))),
1679 i
= next_interval (i
);
1680 if (NULL_INTERVAL_P (i
))
1690 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1691 (START END PLIST), where START and END are positions and PLIST is a
1692 property list containing the text properties to add. Adjust START
1693 and END positions by DELTA before adding properties. Value is
1694 non-zero if OBJECT was modified. */
1697 add_text_properties_from_list (object
, list
, delta
)
1698 Lisp_Object object
, list
, delta
;
1700 struct gcpro gcpro1
, gcpro2
;
1703 GCPRO2 (list
, object
);
1705 for (; CONSP (list
); list
= XCDR (list
))
1707 Lisp_Object item
, start
, end
, plist
, tem
;
1710 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1711 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1712 plist
= XCAR (XCDR (XCDR (item
)));
1714 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1725 /* Modify end-points of ranges in LIST destructively. LIST is a list
1726 as returned from text_property_list. Change end-points equal to
1727 OLD_END to NEW_END. */
1730 extend_property_ranges (list
, old_end
, new_end
)
1731 Lisp_Object list
, old_end
, new_end
;
1733 for (; CONSP (list
); list
= XCDR (list
))
1735 Lisp_Object item
, end
;
1738 end
= XCAR (XCDR (item
));
1740 if (EQ (end
, old_end
))
1741 XCAR (XCDR (item
)) = new_end
;
1747 /* Call the modification hook functions in LIST, each with START and END. */
1750 call_mod_hooks (list
, start
, end
)
1751 Lisp_Object list
, start
, end
;
1753 struct gcpro gcpro1
;
1755 while (!NILP (list
))
1757 call2 (Fcar (list
), start
, end
);
1763 /* Check for read-only intervals between character positions START ... END,
1764 in BUF, and signal an error if we find one.
1766 Then check for any modification hooks in the range.
1767 Create a list of all these hooks in lexicographic order,
1768 eliminating consecutive extra copies of the same hook. Then call
1769 those hooks in order, with START and END - 1 as arguments. */
1772 verify_interval_modification (buf
, start
, end
)
1776 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1777 register INTERVAL i
;
1779 register Lisp_Object prev_mod_hooks
;
1780 Lisp_Object mod_hooks
;
1781 struct gcpro gcpro1
;
1784 prev_mod_hooks
= Qnil
;
1787 interval_insert_behind_hooks
= Qnil
;
1788 interval_insert_in_front_hooks
= Qnil
;
1790 if (NULL_INTERVAL_P (intervals
))
1800 /* For an insert operation, check the two chars around the position. */
1803 INTERVAL prev
= NULL
;
1804 Lisp_Object before
, after
;
1806 /* Set I to the interval containing the char after START,
1807 and PREV to the interval containing the char before START.
1808 Either one may be null. They may be equal. */
1809 i
= find_interval (intervals
, start
);
1811 if (start
== BUF_BEGV (buf
))
1813 else if (i
->position
== start
)
1814 prev
= previous_interval (i
);
1815 else if (i
->position
< start
)
1817 if (start
== BUF_ZV (buf
))
1820 /* If Vinhibit_read_only is set and is not a list, we can
1821 skip the read_only checks. */
1822 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1824 /* If I and PREV differ we need to check for the read-only
1825 property together with its stickiness. If either I or
1826 PREV are 0, this check is all we need.
1827 We have to take special care, since read-only may be
1828 indirectly defined via the category property. */
1831 if (! NULL_INTERVAL_P (i
))
1833 after
= textget (i
->plist
, Qread_only
);
1835 /* If interval I is read-only and read-only is
1836 front-sticky, inhibit insertion.
1837 Check for read-only as well as category. */
1839 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1843 tem
= textget (i
->plist
, Qfront_sticky
);
1844 if (TMEM (Qread_only
, tem
)
1845 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1846 && TMEM (Qcategory
, tem
)))
1851 if (! NULL_INTERVAL_P (prev
))
1853 before
= textget (prev
->plist
, Qread_only
);
1855 /* If interval PREV is read-only and read-only isn't
1856 rear-nonsticky, inhibit insertion.
1857 Check for read-only as well as category. */
1859 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1863 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1864 if (! TMEM (Qread_only
, tem
)
1865 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1866 || ! TMEM (Qcategory
, tem
)))
1871 else if (! NULL_INTERVAL_P (i
))
1873 after
= textget (i
->plist
, Qread_only
);
1875 /* If interval I is read-only and read-only is
1876 front-sticky, inhibit insertion.
1877 Check for read-only as well as category. */
1878 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1882 tem
= textget (i
->plist
, Qfront_sticky
);
1883 if (TMEM (Qread_only
, tem
)
1884 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1885 && TMEM (Qcategory
, tem
)))
1888 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1889 if (! TMEM (Qread_only
, tem
)
1890 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1891 || ! TMEM (Qcategory
, tem
)))
1897 /* Run both insert hooks (just once if they're the same). */
1898 if (!NULL_INTERVAL_P (prev
))
1899 interval_insert_behind_hooks
1900 = textget (prev
->plist
, Qinsert_behind_hooks
);
1901 if (!NULL_INTERVAL_P (i
))
1902 interval_insert_in_front_hooks
1903 = textget (i
->plist
, Qinsert_in_front_hooks
);
1907 /* Loop over intervals on or next to START...END,
1908 collecting their hooks. */
1910 i
= find_interval (intervals
, start
);
1913 if (! INTERVAL_WRITABLE_P (i
))
1916 if (!inhibit_modification_hooks
)
1918 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1919 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1921 hooks
= Fcons (mod_hooks
, hooks
);
1922 prev_mod_hooks
= mod_hooks
;
1926 i
= next_interval (i
);
1928 /* Keep going thru the interval containing the char before END. */
1929 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1931 if (!inhibit_modification_hooks
)
1934 hooks
= Fnreverse (hooks
);
1935 while (! EQ (hooks
, Qnil
))
1937 call_mod_hooks (Fcar (hooks
), make_number (start
),
1939 hooks
= Fcdr (hooks
);
1946 /* Run the interval hooks for an insertion on character range START ... END.
1947 verify_interval_modification chose which hooks to run;
1948 this function is called after the insertion happens
1949 so it can indicate the range of inserted text. */
1952 report_interval_modification (start
, end
)
1953 Lisp_Object start
, end
;
1955 if (! NILP (interval_insert_behind_hooks
))
1956 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1957 if (! NILP (interval_insert_in_front_hooks
)
1958 && ! EQ (interval_insert_in_front_hooks
,
1959 interval_insert_behind_hooks
))
1960 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1966 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1967 "Property-list used as default values.\n\
1968 The value of a property in this list is seen as the value for every\n\
1969 character that does not have its own value for that property.");
1970 Vdefault_text_properties
= Qnil
;
1972 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1973 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1974 This also inhibits the use of the `intangible' text property.");
1975 Vinhibit_point_motion_hooks
= Qnil
;
1977 DEFVAR_LISP ("text-property-default-nonsticky",
1978 &Vtext_property_default_nonsticky
,
1979 "Alist of properties vs the corresponding non-stickinesses.\n\
1980 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1982 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1983 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1984 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1985 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1986 Vtext_property_default_nonsticky
= Qnil
;
1988 staticpro (&interval_insert_behind_hooks
);
1989 staticpro (&interval_insert_in_front_hooks
);
1990 interval_insert_behind_hooks
= Qnil
;
1991 interval_insert_in_front_hooks
= Qnil
;
1994 /* Common attributes one might give text */
1996 staticpro (&Qforeground
);
1997 Qforeground
= intern ("foreground");
1998 staticpro (&Qbackground
);
1999 Qbackground
= intern ("background");
2001 Qfont
= intern ("font");
2002 staticpro (&Qstipple
);
2003 Qstipple
= intern ("stipple");
2004 staticpro (&Qunderline
);
2005 Qunderline
= intern ("underline");
2006 staticpro (&Qread_only
);
2007 Qread_only
= intern ("read-only");
2008 staticpro (&Qinvisible
);
2009 Qinvisible
= intern ("invisible");
2010 staticpro (&Qintangible
);
2011 Qintangible
= intern ("intangible");
2012 staticpro (&Qcategory
);
2013 Qcategory
= intern ("category");
2014 staticpro (&Qlocal_map
);
2015 Qlocal_map
= intern ("local-map");
2016 staticpro (&Qfront_sticky
);
2017 Qfront_sticky
= intern ("front-sticky");
2018 staticpro (&Qrear_nonsticky
);
2019 Qrear_nonsticky
= intern ("rear-nonsticky");
2020 staticpro (&Qmouse_face
);
2021 Qmouse_face
= intern ("mouse-face");
2023 /* Properties that text might use to specify certain actions */
2025 staticpro (&Qmouse_left
);
2026 Qmouse_left
= intern ("mouse-left");
2027 staticpro (&Qmouse_entered
);
2028 Qmouse_entered
= intern ("mouse-entered");
2029 staticpro (&Qpoint_left
);
2030 Qpoint_left
= intern ("point-left");
2031 staticpro (&Qpoint_entered
);
2032 Qpoint_entered
= intern ("point-entered");
2034 defsubr (&Stext_properties_at
);
2035 defsubr (&Sget_text_property
);
2036 defsubr (&Sget_char_property
);
2037 defsubr (&Snext_char_property_change
);
2038 defsubr (&Sprevious_char_property_change
);
2039 defsubr (&Snext_single_char_property_change
);
2040 defsubr (&Sprevious_single_char_property_change
);
2041 defsubr (&Snext_property_change
);
2042 defsubr (&Snext_single_property_change
);
2043 defsubr (&Sprevious_property_change
);
2044 defsubr (&Sprevious_single_property_change
);
2045 defsubr (&Sadd_text_properties
);
2046 defsubr (&Sput_text_property
);
2047 defsubr (&Sset_text_properties
);
2048 defsubr (&Sremove_text_properties
);
2049 defsubr (&Stext_property_any
);
2050 defsubr (&Stext_property_not_all
);
2051 /* defsubr (&Serase_text_properties); */
2052 /* defsubr (&Scopy_text_properties); */