1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include "intervals.h"
28 #define NULL (void *)0
31 /* Test for membership, allowing for t (actually any non-cons) to mean the
34 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
37 /* NOTES: previous- and next- property change will have to skip
38 zero-length intervals if they are implemented. This could be done
39 inside next_interval and previous_interval.
41 set_properties needs to deal with the interval property cache.
43 It is assumed that for any interval plist, a property appears
44 only once on the list. Although some code i.e., remove_properties,
45 handles the more general case, the uniqueness of properties is
46 necessary for the system to remain consistent. This requirement
47 is enforced by the subrs installing properties onto the intervals. */
51 Lisp_Object Qmouse_left
;
52 Lisp_Object Qmouse_entered
;
53 Lisp_Object Qpoint_left
;
54 Lisp_Object Qpoint_entered
;
55 Lisp_Object Qcategory
;
56 Lisp_Object Qlocal_map
;
58 /* Visual properties text (including strings) may have. */
59 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
60 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 Lisp_Object Vinhibit_point_motion_hooks
;
71 Lisp_Object Vdefault_text_properties
;
73 /* verify_interval_modification saves insertion hooks here
74 to be run later by report_interval_modification. */
75 Lisp_Object interval_insert_behind_hooks
;
76 Lisp_Object interval_insert_in_front_hooks
;
78 /* Extract the interval at the position pointed to by BEGIN from
79 OBJECT, a string or buffer. Additionally, check that the positions
80 pointed to by BEGIN and END are within the bounds of OBJECT, and
81 reverse them if *BEGIN is greater than *END. The objects pointed
82 to by BEGIN and END may be integers or markers; if the latter, they
83 are coerced to integers.
85 When OBJECT is a string, we increment *BEGIN and *END
86 to make them origin-one.
88 Note that buffer points don't correspond to interval indices.
89 For example, point-max is 1 greater than the index of the last
90 character. This difference is handled in the caller, which uses
91 the validated points to determine a length, and operates on that.
92 Exceptions are Ftext_properties_at, Fnext_property_change, and
93 Fprevious_property_change which call this function with BEGIN == END.
94 Handle this case specially.
96 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
97 create an interval tree for OBJECT if one doesn't exist, provided
98 the object actually contains text. In the current design, if there
99 is no text, there can be no text properties. */
105 validate_interval_range (object
, begin
, end
, force
)
106 Lisp_Object object
, *begin
, *end
;
112 CHECK_STRING_OR_BUFFER (object
, 0);
113 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
114 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
116 /* If we are asked for a point, but from a subr which operates
117 on a range, then return nothing. */
118 if (EQ (*begin
, *end
) && begin
!= end
)
119 return NULL_INTERVAL
;
121 if (XINT (*begin
) > XINT (*end
))
129 if (BUFFERP (object
))
131 register struct buffer
*b
= XBUFFER (object
);
133 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
134 && XINT (*end
) <= BUF_ZV (b
)))
135 args_out_of_range (*begin
, *end
);
136 i
= BUF_INTERVALS (b
);
138 /* If there's no text, there are no properties. */
139 if (BUF_BEGV (b
) == BUF_ZV (b
))
140 return NULL_INTERVAL
;
142 searchpos
= XINT (*begin
);
146 register struct Lisp_String
*s
= XSTRING (object
);
148 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
149 && XINT (*end
) <= s
->size
))
150 args_out_of_range (*begin
, *end
);
151 XSETFASTINT (*begin
, XFASTINT (*begin
));
153 XSETFASTINT (*end
, XFASTINT (*end
));
157 return NULL_INTERVAL
;
159 searchpos
= XINT (*begin
);
162 if (NULL_INTERVAL_P (i
))
163 return (force
? create_root_interval (object
) : i
);
165 return find_interval (i
, searchpos
);
168 /* Validate LIST as a property list. If LIST is not a list, then
169 make one consisting of (LIST nil). Otherwise, verify that LIST
170 is even numbered and thus suitable as a plist. */
173 validate_plist (list
)
182 register Lisp_Object tail
;
183 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
189 error ("Odd length text property list");
193 return Fcons (list
, Fcons (Qnil
, Qnil
));
196 /* Return nonzero if interval I has all the properties,
197 with the same values, of list PLIST. */
200 interval_has_all_properties (plist
, i
)
204 register Lisp_Object tail1
, tail2
, sym1
;
207 /* Go through each element of PLIST. */
208 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
213 /* Go through I's plist, looking for sym1 */
214 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
215 if (EQ (sym1
, Fcar (tail2
)))
217 /* Found the same property on both lists. If the
218 values are unequal, return zero. */
219 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
222 /* Property has same value on both lists; go to next one. */
234 /* Return nonzero if the plist of interval I has any of the
235 properties of PLIST, regardless of their values. */
238 interval_has_some_properties (plist
, i
)
242 register Lisp_Object tail1
, tail2
, sym
;
244 /* Go through each element of PLIST. */
245 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
249 /* Go through i's plist, looking for tail1 */
250 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
251 if (EQ (sym
, Fcar (tail2
)))
258 /* Changing the plists of individual intervals. */
260 /* Return the value of PROP in property-list PLIST, or Qunbound if it
263 property_value (plist
, prop
)
264 Lisp_Object plist
, prop
;
268 while (PLIST_ELT_P (plist
, value
))
269 if (EQ (XCAR (plist
), prop
))
272 plist
= XCDR (value
);
277 /* Set the properties of INTERVAL to PROPERTIES,
278 and record undo info for the previous values.
279 OBJECT is the string or buffer that INTERVAL belongs to. */
282 set_properties (properties
, interval
, object
)
283 Lisp_Object properties
, object
;
286 Lisp_Object sym
, value
;
288 if (BUFFERP (object
))
290 /* For each property in the old plist which is missing from PROPERTIES,
291 or has a different value in PROPERTIES, make an undo record. */
292 for (sym
= interval
->plist
;
293 PLIST_ELT_P (sym
, value
);
295 if (! EQ (property_value (properties
, XCAR (sym
)),
298 record_property_change (interval
->position
, LENGTH (interval
),
299 XCAR (sym
), XCAR (value
),
303 /* For each new property that has no value at all in the old plist,
304 make an undo record binding it to nil, so it will be removed. */
305 for (sym
= properties
;
306 PLIST_ELT_P (sym
, value
);
308 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
310 record_property_change (interval
->position
, LENGTH (interval
),
316 /* Store new properties. */
317 interval
->plist
= Fcopy_sequence (properties
);
320 /* Add the properties of PLIST to the interval I, or set
321 the value of I's property to the value of the property on PLIST
322 if they are different.
324 OBJECT should be the string or buffer the interval is in.
326 Return nonzero if this changes I (i.e., if any members of PLIST
327 are actually added to I's plist) */
330 add_properties (plist
, i
, object
)
335 Lisp_Object tail1
, tail2
, sym1
, val1
;
336 register int changed
= 0;
338 struct gcpro gcpro1
, gcpro2
, gcpro3
;
343 /* No need to protect OBJECT, because we can GC only in the case
344 where it is a buffer, and live buffers are always protected.
345 I and its plist are also protected, via OBJECT. */
346 GCPRO3 (tail1
, sym1
, val1
);
348 /* Go through each element of PLIST. */
349 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
352 val1
= Fcar (Fcdr (tail1
));
355 /* Go through I's plist, looking for sym1 */
356 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
357 if (EQ (sym1
, Fcar (tail2
)))
359 /* No need to gcpro, because tail2 protects this
360 and it must be a cons cell (we get an error otherwise). */
361 register Lisp_Object this_cdr
;
363 this_cdr
= Fcdr (tail2
);
364 /* Found the property. Now check its value. */
367 /* The properties have the same value on both lists.
368 Continue to the next property. */
369 if (EQ (val1
, Fcar (this_cdr
)))
372 /* Record this change in the buffer, for undo purposes. */
373 if (BUFFERP (object
))
375 record_property_change (i
->position
, LENGTH (i
),
376 sym1
, Fcar (this_cdr
), object
);
379 /* I's property has a different value -- change it */
380 Fsetcar (this_cdr
, val1
);
387 /* Record this change in the buffer, for undo purposes. */
388 if (BUFFERP (object
))
390 record_property_change (i
->position
, LENGTH (i
),
393 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
403 /* For any members of PLIST which are properties of I, remove them
405 OBJECT is the string or buffer containing I. */
408 remove_properties (plist
, i
, object
)
413 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
414 register int changed
= 0;
416 current_plist
= i
->plist
;
417 /* Go through each element of plist. */
418 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
422 /* First, remove the symbol if its at the head of the list */
423 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
425 if (BUFFERP (object
))
427 record_property_change (i
->position
, LENGTH (i
),
428 sym
, Fcar (Fcdr (current_plist
)),
432 current_plist
= Fcdr (Fcdr (current_plist
));
436 /* Go through i's plist, looking for sym */
437 tail2
= current_plist
;
438 while (! NILP (tail2
))
440 register Lisp_Object
this;
441 this = Fcdr (Fcdr (tail2
));
442 if (EQ (sym
, Fcar (this)))
444 if (BUFFERP (object
))
446 record_property_change (i
->position
, LENGTH (i
),
447 sym
, Fcar (Fcdr (this)), object
);
450 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
458 i
->plist
= current_plist
;
463 /* Remove all properties from interval I. Return non-zero
464 if this changes the interval. */
478 /* Returns the interval of POSITION in OBJECT.
479 POSITION is BEG-based. */
482 interval_of (position
, object
)
490 XSETBUFFER (object
, current_buffer
);
491 else if (EQ (object
, Qt
))
492 return NULL_INTERVAL
;
494 CHECK_STRING_OR_BUFFER (object
, 0);
496 if (BUFFERP (object
))
498 register struct buffer
*b
= XBUFFER (object
);
502 i
= BUF_INTERVALS (b
);
506 register struct Lisp_String
*s
= XSTRING (object
);
513 if (!(beg
<= position
&& position
<= end
))
514 args_out_of_range (make_number (position
), make_number (position
));
515 if (beg
== end
|| NULL_INTERVAL_P (i
))
516 return NULL_INTERVAL
;
518 return find_interval (i
, position
);
521 DEFUN ("text-properties-at", Ftext_properties_at
,
522 Stext_properties_at
, 1, 2, 0,
523 "Return the list of properties of the character at POSITION in OBJECT.\n\
524 OBJECT is the string or buffer to look for the properties in;\n\
525 nil means the current buffer.\n\
526 If POSITION is at the end of OBJECT, the value is nil.")
528 Lisp_Object position
, object
;
533 XSETBUFFER (object
, current_buffer
);
535 i
= validate_interval_range (object
, &position
, &position
, soft
);
536 if (NULL_INTERVAL_P (i
))
538 /* If POSITION is at the end of the interval,
539 it means it's the end of OBJECT.
540 There are no properties at the very end,
541 since no character follows. */
542 if (XINT (position
) == LENGTH (i
) + i
->position
)
548 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
549 "Return the value of POSITION's property PROP, in OBJECT.\n\
550 OBJECT is optional and defaults to the current buffer.\n\
551 If POSITION is at the end of OBJECT, the value is nil.")
552 (position
, prop
, object
)
553 Lisp_Object position
, object
;
556 return textget (Ftext_properties_at (position
, object
), prop
);
559 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
560 "Return the value of POSITION's property PROP, in OBJECT.\n\
561 OBJECT is optional and defaults to the current buffer.\n\
562 If POSITION is at the end of OBJECT, the value is nil.\n\
563 If OBJECT is a buffer, then overlay properties are considered as well as\n\
565 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
566 overlays are considered only if they are associated with OBJECT.")
567 (position
, prop
, object
)
568 Lisp_Object position
, object
;
569 register Lisp_Object prop
;
571 struct window
*w
= 0;
573 CHECK_NUMBER_COERCE_MARKER (position
, 0);
576 XSETBUFFER (object
, current_buffer
);
578 if (WINDOWP (object
))
580 w
= XWINDOW (object
);
583 if (BUFFERP (object
))
585 int posn
= XINT (position
);
587 Lisp_Object
*overlay_vec
, tem
;
590 struct buffer
*obuf
= current_buffer
;
592 set_buffer_temp (XBUFFER (object
));
594 /* First try with room for 40 overlays. */
596 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
598 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
599 &next_overlay
, NULL
);
601 /* If there are more than 40,
602 make enough space for all, and try again. */
606 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
607 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
608 &next_overlay
, NULL
);
610 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
612 set_buffer_temp (obuf
);
614 /* Now check the overlays in order of decreasing priority. */
615 while (--noverlays
>= 0)
617 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
622 /* Not a buffer, or no appropriate overlay, so fall through to the
624 return (Fget_text_property (position
, prop
, object
));
627 DEFUN ("next-char-property-change", Fnext_char_property_change
,
628 Snext_char_property_change
, 1, 2, 0,
629 "Return the position of next text property or overlay change.\n\
630 This scans characters forward from POSITION in OBJECT till it finds\n\
631 a change in some text property, or the beginning or end of an overlay,\n\
632 and returns the position of that.\n\
633 If none is found, the function returns (point-max).\n\
635 If the optional third argument LIMIT is non-nil, don't search\n\
636 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
638 Lisp_Object position
, limit
;
642 temp
= Fnext_overlay_change (position
);
645 CHECK_NUMBER (limit
, 2);
646 if (XINT (limit
) < XINT (temp
))
649 return Fnext_property_change (position
, Qnil
, temp
);
652 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
653 Sprevious_char_property_change
, 1, 2, 0,
654 "Return the position of previous text property or overlay change.\n\
655 Scans characters backward from POSITION in OBJECT till it finds\n\
656 a change in some text property, or the beginning or end of an overlay,\n\
657 and returns the position of that.\n\
658 If none is found, the function returns (point-max).\n\
660 If the optional third argument LIMIT is non-nil, don't search\n\
661 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
663 Lisp_Object position
, limit
;
667 temp
= Fprevious_overlay_change (position
);
670 CHECK_NUMBER (limit
, 2);
671 if (XINT (limit
) > XINT (temp
))
674 return Fprevious_property_change (position
, Qnil
, temp
);
678 /* Value is the position in OBJECT after POS where the value of
679 property PROP changes. OBJECT must be a string or buffer. If
680 OBJECT is nil, use the current buffer. LIMIT if not nil limits the
684 next_single_char_property_change (pos
, prop
, object
, limit
)
685 Lisp_Object prop
, pos
, object
, limit
;
687 if (STRINGP (object
))
689 pos
= Fnext_single_property_change (pos
, prop
, object
, limit
);
693 pos
= make_number (XSTRING (object
)->size
);
700 Lisp_Object initial_value
, value
;
701 struct buffer
*old_current_buffer
= NULL
;
702 int count
= specpdl_ptr
- specpdl
;
705 CHECK_BUFFER (object
, 0);
707 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
709 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
710 Fset_buffer (object
);
713 initial_value
= Fget_char_property (pos
, prop
, object
);
715 while (XFASTINT (pos
) < XFASTINT (limit
))
717 pos
= Fnext_char_property_change (pos
, limit
);
718 value
= Fget_char_property (pos
, prop
, object
);
719 if (!EQ (value
, initial_value
))
723 unbind_to (count
, Qnil
);
731 DEFUN ("next-property-change", Fnext_property_change
,
732 Snext_property_change
, 1, 3, 0,
733 "Return the position of next property change.\n\
734 Scans characters forward from POSITION in OBJECT till it finds\n\
735 a change in some text property, then returns the position of the change.\n\
736 The optional second argument OBJECT is the string or buffer to scan.\n\
737 Return nil if the property is constant all the way to the end of OBJECT.\n\
738 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
739 If the optional third argument LIMIT is non-nil, don't search\n\
740 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
741 (position
, object
, limit
)
742 Lisp_Object position
, object
, limit
;
744 register INTERVAL i
, next
;
747 XSETBUFFER (object
, current_buffer
);
749 if (! NILP (limit
) && ! EQ (limit
, Qt
))
750 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
752 i
= validate_interval_range (object
, &position
, &position
, soft
);
754 /* If LIMIT is t, return start of next interval--don't
755 bother checking further intervals. */
758 if (NULL_INTERVAL_P (i
))
761 next
= next_interval (i
);
763 if (NULL_INTERVAL_P (next
))
764 XSETFASTINT (position
, (STRINGP (object
)
765 ? XSTRING (object
)->size
766 : BUF_ZV (XBUFFER (object
))));
768 XSETFASTINT (position
, next
->position
);
772 if (NULL_INTERVAL_P (i
))
775 next
= next_interval (i
);
777 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
778 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
779 next
= next_interval (next
);
781 if (NULL_INTERVAL_P (next
))
783 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
786 XSETFASTINT (position
, next
->position
);
790 /* Return 1 if there's a change in some property between BEG and END. */
793 property_change_between_p (beg
, end
)
796 register INTERVAL i
, next
;
797 Lisp_Object object
, pos
;
799 XSETBUFFER (object
, current_buffer
);
800 XSETFASTINT (pos
, beg
);
802 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
803 if (NULL_INTERVAL_P (i
))
806 next
= next_interval (i
);
807 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
809 next
= next_interval (next
);
810 if (NULL_INTERVAL_P (next
))
812 if (next
->position
>= end
)
816 if (NULL_INTERVAL_P (next
))
822 DEFUN ("next-single-property-change", Fnext_single_property_change
,
823 Snext_single_property_change
, 2, 4, 0,
824 "Return the position of next property change for a specific property.\n\
825 Scans characters forward from POSITION till it finds\n\
826 a change in the PROP property, then returns the position of the change.\n\
827 The optional third argument OBJECT is the string or buffer to scan.\n\
828 The property values are compared with `eq'.\n\
829 Return nil if the property is constant all the way to the end of OBJECT.\n\
830 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
831 If the optional fourth argument LIMIT is non-nil, don't search\n\
832 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
833 (position
, prop
, object
, limit
)
834 Lisp_Object position
, prop
, object
, limit
;
836 register INTERVAL i
, next
;
837 register Lisp_Object here_val
;
840 XSETBUFFER (object
, current_buffer
);
843 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
845 i
= validate_interval_range (object
, &position
, &position
, soft
);
846 if (NULL_INTERVAL_P (i
))
849 here_val
= textget (i
->plist
, prop
);
850 next
= next_interval (i
);
851 while (! NULL_INTERVAL_P (next
)
852 && EQ (here_val
, textget (next
->plist
, prop
))
853 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
854 next
= next_interval (next
);
856 if (NULL_INTERVAL_P (next
))
858 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
861 return make_number (next
->position
);
864 DEFUN ("previous-property-change", Fprevious_property_change
,
865 Sprevious_property_change
, 1, 3, 0,
866 "Return the position of previous property change.\n\
867 Scans characters backwards from POSITION in OBJECT till it finds\n\
868 a change in some text property, then returns the position of the change.\n\
869 The optional second argument OBJECT is the string or buffer to scan.\n\
870 Return nil if the property is constant all the way to the start of OBJECT.\n\
871 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
872 If the optional third argument LIMIT is non-nil, don't search\n\
873 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
874 (position
, object
, limit
)
875 Lisp_Object position
, object
, limit
;
877 register INTERVAL i
, previous
;
880 XSETBUFFER (object
, current_buffer
);
883 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
885 i
= validate_interval_range (object
, &position
, &position
, soft
);
886 if (NULL_INTERVAL_P (i
))
889 /* Start with the interval containing the char before point. */
890 if (i
->position
== XFASTINT (position
))
891 i
= previous_interval (i
);
893 previous
= previous_interval (i
);
894 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
896 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
897 previous
= previous_interval (previous
);
898 if (NULL_INTERVAL_P (previous
))
901 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
904 return make_number (previous
->position
+ LENGTH (previous
));
907 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
908 Sprevious_single_property_change
, 2, 4, 0,
909 "Return the position of previous property change for a specific property.\n\
910 Scans characters backward from POSITION till it finds\n\
911 a change in the PROP property, then returns the position of the change.\n\
912 The optional third argument OBJECT is the string or buffer to scan.\n\
913 The property values are compared with `eq'.\n\
914 Return nil if the property is constant all the way to the start of OBJECT.\n\
915 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
916 If the optional fourth argument LIMIT is non-nil, don't search\n\
917 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
918 (position
, prop
, object
, limit
)
919 Lisp_Object position
, prop
, object
, limit
;
921 register INTERVAL i
, previous
;
922 register Lisp_Object here_val
;
925 XSETBUFFER (object
, current_buffer
);
928 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
930 i
= validate_interval_range (object
, &position
, &position
, soft
);
932 /* Start with the interval containing the char before point. */
933 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
934 i
= previous_interval (i
);
936 if (NULL_INTERVAL_P (i
))
939 here_val
= textget (i
->plist
, prop
);
940 previous
= previous_interval (i
);
941 while (! NULL_INTERVAL_P (previous
)
942 && EQ (here_val
, textget (previous
->plist
, prop
))
944 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
945 previous
= previous_interval (previous
);
946 if (NULL_INTERVAL_P (previous
))
949 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
952 return make_number (previous
->position
+ LENGTH (previous
));
955 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
957 DEFUN ("add-text-properties", Fadd_text_properties
,
958 Sadd_text_properties
, 3, 4, 0,
959 "Add properties to the text from START to END.\n\
960 The third argument PROPERTIES is a property list\n\
961 specifying the property values to add.\n\
962 The optional fourth argument, OBJECT,\n\
963 is the string or buffer containing the text.\n\
964 Return t if any property value actually changed, nil otherwise.")
965 (start
, end
, properties
, object
)
966 Lisp_Object start
, end
, properties
, object
;
968 register INTERVAL i
, unchanged
;
969 register int s
, len
, modified
= 0;
972 properties
= validate_plist (properties
);
973 if (NILP (properties
))
977 XSETBUFFER (object
, current_buffer
);
979 i
= validate_interval_range (object
, &start
, &end
, hard
);
980 if (NULL_INTERVAL_P (i
))
984 len
= XINT (end
) - s
;
986 /* No need to protect OBJECT, because we GC only if it's a buffer,
987 and live buffers are always protected. */
990 /* If we're not starting on an interval boundary, we have to
991 split this interval. */
992 if (i
->position
!= s
)
994 /* If this interval already has the properties, we can
996 if (interval_has_all_properties (properties
, i
))
998 int got
= (LENGTH (i
) - (s
- i
->position
));
1000 RETURN_UNGCPRO (Qnil
);
1002 i
= next_interval (i
);
1007 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1008 copy_properties (unchanged
, i
);
1012 if (BUFFERP (object
))
1013 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1015 /* We are at the beginning of interval I, with LEN chars to scan. */
1021 if (LENGTH (i
) >= len
)
1023 /* We can UNGCPRO safely here, because there will be just
1024 one more chance to gc, in the next call to add_properties,
1025 and after that we will not need PROPERTIES or OBJECT again. */
1028 if (interval_has_all_properties (properties
, i
))
1030 if (BUFFERP (object
))
1031 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1032 XINT (end
) - XINT (start
));
1034 return modified
? Qt
: Qnil
;
1037 if (LENGTH (i
) == len
)
1039 add_properties (properties
, i
, object
);
1040 if (BUFFERP (object
))
1041 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1042 XINT (end
) - XINT (start
));
1046 /* i doesn't have the properties, and goes past the change limit */
1048 i
= split_interval_left (unchanged
, len
);
1049 copy_properties (unchanged
, i
);
1050 add_properties (properties
, i
, object
);
1051 if (BUFFERP (object
))
1052 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1053 XINT (end
) - XINT (start
));
1058 modified
+= add_properties (properties
, i
, object
);
1059 i
= next_interval (i
);
1063 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1065 DEFUN ("put-text-property", Fput_text_property
,
1066 Sput_text_property
, 4, 5, 0,
1067 "Set one property of the text from START to END.\n\
1068 The third and fourth arguments PROPERTY and VALUE\n\
1069 specify the property to add.\n\
1070 The optional fifth argument, OBJECT,\n\
1071 is the string or buffer containing the text.")
1072 (start
, end
, property
, value
, object
)
1073 Lisp_Object start
, end
, property
, value
, object
;
1075 Fadd_text_properties (start
, end
,
1076 Fcons (property
, Fcons (value
, Qnil
)),
1081 DEFUN ("set-text-properties", Fset_text_properties
,
1082 Sset_text_properties
, 3, 4, 0,
1083 "Completely replace properties of text from START to END.\n\
1084 The third argument PROPERTIES is the new property list.\n\
1085 The optional fourth argument, OBJECT,\n\
1086 is the string or buffer containing the text.")
1087 (start
, end
, properties
, object
)
1088 Lisp_Object start
, end
, properties
, object
;
1090 return set_text_properties (start
, end
, properties
, object
, Qt
);
1094 /* Replace properties of text from START to END with new list of
1095 properties PROPERTIES. OBJECT is the buffer or string containing
1096 the text. OBJECT nil means use the current buffer.
1097 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1098 is non-nil if properties were replaced; it is nil if there weren't
1099 any properties to replace. */
1102 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1103 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1105 register INTERVAL i
, unchanged
;
1106 register INTERVAL prev_changed
= NULL_INTERVAL
;
1107 register int s
, len
;
1108 Lisp_Object ostart
, oend
;
1113 properties
= validate_plist (properties
);
1116 XSETBUFFER (object
, current_buffer
);
1118 /* If we want no properties for a whole string,
1119 get rid of its intervals. */
1120 if (NILP (properties
) && STRINGP (object
)
1121 && XFASTINT (start
) == 0
1122 && XFASTINT (end
) == XSTRING (object
)->size
)
1124 if (! XSTRING (object
)->intervals
)
1127 XSTRING (object
)->intervals
= 0;
1131 i
= validate_interval_range (object
, &start
, &end
, soft
);
1133 if (NULL_INTERVAL_P (i
))
1135 /* If buffer has no properties, and we want none, return now. */
1136 if (NILP (properties
))
1139 /* Restore the original START and END values
1140 because validate_interval_range increments them for strings. */
1144 i
= validate_interval_range (object
, &start
, &end
, hard
);
1145 /* This can return if start == end. */
1146 if (NULL_INTERVAL_P (i
))
1151 len
= XINT (end
) - s
;
1153 if (BUFFERP (object
))
1154 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1156 if (i
->position
!= s
)
1159 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1161 if (LENGTH (i
) > len
)
1163 copy_properties (unchanged
, i
);
1164 i
= split_interval_left (i
, len
);
1165 set_properties (properties
, i
, object
);
1166 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1167 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1168 XINT (end
) - XINT (start
));
1173 set_properties (properties
, i
, object
);
1175 if (LENGTH (i
) == len
)
1177 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1178 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1179 XINT (end
) - XINT (start
));
1186 i
= next_interval (i
);
1189 /* We are starting at the beginning of an interval, I */
1195 if (LENGTH (i
) >= len
)
1197 if (LENGTH (i
) > len
)
1198 i
= split_interval_left (i
, len
);
1200 /* We have to call set_properties even if we are going to
1201 merge the intervals, so as to make the undo records
1202 and cause redisplay to happen. */
1203 set_properties (properties
, i
, object
);
1204 if (!NULL_INTERVAL_P (prev_changed
))
1205 merge_interval_left (i
);
1206 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1207 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1208 XINT (end
) - XINT (start
));
1214 /* We have to call set_properties even if we are going to
1215 merge the intervals, so as to make the undo records
1216 and cause redisplay to happen. */
1217 set_properties (properties
, i
, object
);
1218 if (NULL_INTERVAL_P (prev_changed
))
1221 prev_changed
= i
= merge_interval_left (i
);
1223 i
= next_interval (i
);
1226 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1227 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1228 XINT (end
) - XINT (start
));
1232 DEFUN ("remove-text-properties", Fremove_text_properties
,
1233 Sremove_text_properties
, 3, 4, 0,
1234 "Remove some properties from text from START to END.\n\
1235 The third argument PROPERTIES is a property list\n\
1236 whose property names specify the properties to remove.\n\
1237 \(The values stored in PROPERTIES are ignored.)\n\
1238 The optional fourth argument, OBJECT,\n\
1239 is the string or buffer containing the text.\n\
1240 Return t if any property was actually removed, nil otherwise.")
1241 (start
, end
, properties
, object
)
1242 Lisp_Object start
, end
, properties
, object
;
1244 register INTERVAL i
, unchanged
;
1245 register int s
, len
, modified
= 0;
1248 XSETBUFFER (object
, current_buffer
);
1250 i
= validate_interval_range (object
, &start
, &end
, soft
);
1251 if (NULL_INTERVAL_P (i
))
1255 len
= XINT (end
) - s
;
1257 if (i
->position
!= s
)
1259 /* No properties on this first interval -- return if
1260 it covers the entire region. */
1261 if (! interval_has_some_properties (properties
, i
))
1263 int got
= (LENGTH (i
) - (s
- i
->position
));
1267 i
= next_interval (i
);
1269 /* Split away the beginning of this interval; what we don't
1274 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1275 copy_properties (unchanged
, i
);
1279 if (BUFFERP (object
))
1280 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1282 /* We are at the beginning of an interval, with len to scan */
1288 if (LENGTH (i
) >= len
)
1290 if (! interval_has_some_properties (properties
, i
))
1291 return modified
? Qt
: Qnil
;
1293 if (LENGTH (i
) == len
)
1295 remove_properties (properties
, i
, object
);
1296 if (BUFFERP (object
))
1297 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1298 XINT (end
) - XINT (start
));
1302 /* i has the properties, and goes past the change limit */
1304 i
= split_interval_left (i
, len
);
1305 copy_properties (unchanged
, i
);
1306 remove_properties (properties
, i
, object
);
1307 if (BUFFERP (object
))
1308 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1309 XINT (end
) - XINT (start
));
1314 modified
+= remove_properties (properties
, i
, object
);
1315 i
= next_interval (i
);
1319 DEFUN ("text-property-any", Ftext_property_any
,
1320 Stext_property_any
, 4, 5, 0,
1321 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1322 If so, return the position of the first character whose property PROPERTY\n\
1323 is `eq' to VALUE. Otherwise return nil.\n\
1324 The optional fifth argument, OBJECT, is the string or buffer\n\
1325 containing the text.")
1326 (start
, end
, property
, value
, object
)
1327 Lisp_Object start
, end
, property
, value
, object
;
1329 register INTERVAL i
;
1330 register int e
, pos
;
1333 XSETBUFFER (object
, current_buffer
);
1334 i
= validate_interval_range (object
, &start
, &end
, soft
);
1335 if (NULL_INTERVAL_P (i
))
1336 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1339 while (! NULL_INTERVAL_P (i
))
1341 if (i
->position
>= e
)
1343 if (EQ (textget (i
->plist
, property
), value
))
1346 if (pos
< XINT (start
))
1348 return make_number (pos
);
1350 i
= next_interval (i
);
1355 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1356 Stext_property_not_all
, 4, 5, 0,
1357 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1358 If so, return the position of the first character whose property PROPERTY\n\
1359 is not `eq' to VALUE. Otherwise, return nil.\n\
1360 The optional fifth argument, OBJECT, is the string or buffer\n\
1361 containing the text.")
1362 (start
, end
, property
, value
, object
)
1363 Lisp_Object start
, end
, property
, value
, object
;
1365 register INTERVAL i
;
1369 XSETBUFFER (object
, current_buffer
);
1370 i
= validate_interval_range (object
, &start
, &end
, soft
);
1371 if (NULL_INTERVAL_P (i
))
1372 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1376 while (! NULL_INTERVAL_P (i
))
1378 if (i
->position
>= e
)
1380 if (! EQ (textget (i
->plist
, property
), value
))
1382 if (i
->position
> s
)
1384 return make_number (s
);
1386 i
= next_interval (i
);
1391 /* I don't think this is the right interface to export; how often do you
1392 want to do something like this, other than when you're copying objects
1395 I think it would be better to have a pair of functions, one which
1396 returns the text properties of a region as a list of ranges and
1397 plists, and another which applies such a list to another object. */
1399 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1400 SRC and DEST may each refer to strings or buffers.
1401 Optional sixth argument PROP causes only that property to be copied.
1402 Properties are copied to DEST as if by `add-text-properties'.
1403 Return t if any property value actually changed, nil otherwise. */
1405 /* Note this can GC when DEST is a buffer. */
1408 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1409 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1415 int s
, e
, e2
, p
, len
, modified
= 0;
1416 struct gcpro gcpro1
, gcpro2
;
1418 i
= validate_interval_range (src
, &start
, &end
, soft
);
1419 if (NULL_INTERVAL_P (i
))
1422 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1424 Lisp_Object dest_start
, dest_end
;
1427 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1428 /* Apply this to a copy of pos; it will try to increment its arguments,
1429 which we don't want. */
1430 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1441 e2
= i
->position
+ LENGTH (i
);
1448 while (! NILP (plist
))
1450 if (EQ (Fcar (plist
), prop
))
1452 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1455 plist
= Fcdr (Fcdr (plist
));
1459 /* Must defer modifications to the interval tree in case src
1460 and dest refer to the same string or buffer. */
1461 stuff
= Fcons (Fcons (make_number (p
),
1462 Fcons (make_number (p
+ len
),
1463 Fcons (plist
, Qnil
))),
1467 i
= next_interval (i
);
1468 if (NULL_INTERVAL_P (i
))
1475 GCPRO2 (stuff
, dest
);
1477 while (! NILP (stuff
))
1480 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1481 Fcar (Fcdr (Fcdr (res
))), dest
);
1484 stuff
= Fcdr (stuff
);
1489 return modified
? Qt
: Qnil
;
1493 /* Return a list representing the text properties of OBJECT between
1494 START and END. if PROP is non-nil, report only on that property.
1495 Each result list element has the form (S E PLIST), where S and E
1496 are positions in OBJECT and PLIST is a property list containing the
1497 text properties of OBJECT between S and E. Value is nil if OBJECT
1498 doesn't contain text properties between START and END. */
1501 text_property_list (object
, start
, end
, prop
)
1502 Lisp_Object object
, start
, end
, prop
;
1509 i
= validate_interval_range (object
, &start
, &end
, soft
);
1510 if (!NULL_INTERVAL_P (i
))
1512 int s
= XINT (start
);
1517 int interval_end
, len
;
1520 interval_end
= i
->position
+ LENGTH (i
);
1521 if (interval_end
> e
)
1523 len
= interval_end
- s
;
1528 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1529 if (EQ (Fcar (plist
), prop
))
1531 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1536 result
= Fcons (Fcons (make_number (s
),
1537 Fcons (make_number (s
+ len
),
1538 Fcons (plist
, Qnil
))),
1541 i
= next_interval (i
);
1542 if (NULL_INTERVAL_P (i
))
1552 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1553 (START END PLIST), where START and END are positions and PLIST is a
1554 property list containing the text properties to add. Adjust START
1555 and END positions by DELTA before adding properties. Value is
1556 non-zero if OBJECT was modified. */
1559 add_text_properties_from_list (object
, list
, delta
)
1560 Lisp_Object object
, list
, delta
;
1562 struct gcpro gcpro1
, gcpro2
;
1565 GCPRO2 (list
, object
);
1567 for (; CONSP (list
); list
= XCDR (list
))
1569 Lisp_Object item
, start
, end
, plist
, tem
;
1572 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1573 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1574 plist
= XCAR (XCDR (XCDR (item
)));
1576 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1587 /* Modify end-points of ranges in LIST destructively. LIST is a list
1588 as returned from text_property_list. Change end-points equal to
1589 OLD_END to NEW_END. */
1592 extend_property_ranges (list
, old_end
, new_end
)
1593 Lisp_Object list
, old_end
, new_end
;
1595 for (; CONSP (list
); list
= XCDR (list
))
1597 Lisp_Object item
, end
;
1600 end
= XCAR (XCDR (item
));
1602 if (EQ (end
, old_end
))
1603 XCAR (XCDR (item
)) = new_end
;
1609 /* Call the modification hook functions in LIST, each with START and END. */
1612 call_mod_hooks (list
, start
, end
)
1613 Lisp_Object list
, start
, end
;
1615 struct gcpro gcpro1
;
1617 while (!NILP (list
))
1619 call2 (Fcar (list
), start
, end
);
1625 /* Check for read-only intervals between character positions START ... END,
1626 in BUF, and signal an error if we find one.
1628 Then check for any modification hooks in the range.
1629 Create a list of all these hooks in lexicographic order,
1630 eliminating consecutive extra copies of the same hook. Then call
1631 those hooks in order, with START and END - 1 as arguments. */
1634 verify_interval_modification (buf
, start
, end
)
1638 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1639 register INTERVAL i
;
1641 register Lisp_Object prev_mod_hooks
;
1642 Lisp_Object mod_hooks
;
1643 struct gcpro gcpro1
;
1646 prev_mod_hooks
= Qnil
;
1649 interval_insert_behind_hooks
= Qnil
;
1650 interval_insert_in_front_hooks
= Qnil
;
1652 if (NULL_INTERVAL_P (intervals
))
1662 /* For an insert operation, check the two chars around the position. */
1666 Lisp_Object before
, after
;
1668 /* Set I to the interval containing the char after START,
1669 and PREV to the interval containing the char before START.
1670 Either one may be null. They may be equal. */
1671 i
= find_interval (intervals
, start
);
1673 if (start
== BUF_BEGV (buf
))
1675 else if (i
->position
== start
)
1676 prev
= previous_interval (i
);
1677 else if (i
->position
< start
)
1679 if (start
== BUF_ZV (buf
))
1682 /* If Vinhibit_read_only is set and is not a list, we can
1683 skip the read_only checks. */
1684 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1686 /* If I and PREV differ we need to check for the read-only
1687 property together with its stickiness. If either I or
1688 PREV are 0, this check is all we need.
1689 We have to take special care, since read-only may be
1690 indirectly defined via the category property. */
1693 if (! NULL_INTERVAL_P (i
))
1695 after
= textget (i
->plist
, Qread_only
);
1697 /* If interval I is read-only and read-only is
1698 front-sticky, inhibit insertion.
1699 Check for read-only as well as category. */
1701 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1705 tem
= textget (i
->plist
, Qfront_sticky
);
1706 if (TMEM (Qread_only
, tem
)
1707 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1708 && TMEM (Qcategory
, tem
)))
1709 Fsignal (Qtext_read_only
, Qnil
);
1713 if (! NULL_INTERVAL_P (prev
))
1715 before
= textget (prev
->plist
, Qread_only
);
1717 /* If interval PREV is read-only and read-only isn't
1718 rear-nonsticky, inhibit insertion.
1719 Check for read-only as well as category. */
1721 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1725 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1726 if (! TMEM (Qread_only
, tem
)
1727 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1728 || ! TMEM (Qcategory
, tem
)))
1729 Fsignal (Qtext_read_only
, Qnil
);
1733 else if (! NULL_INTERVAL_P (i
))
1735 after
= textget (i
->plist
, Qread_only
);
1737 /* If interval I is read-only and read-only is
1738 front-sticky, inhibit insertion.
1739 Check for read-only as well as category. */
1740 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1744 tem
= textget (i
->plist
, Qfront_sticky
);
1745 if (TMEM (Qread_only
, tem
)
1746 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1747 && TMEM (Qcategory
, tem
)))
1748 Fsignal (Qtext_read_only
, Qnil
);
1750 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1751 if (! TMEM (Qread_only
, tem
)
1752 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1753 || ! TMEM (Qcategory
, tem
)))
1754 Fsignal (Qtext_read_only
, Qnil
);
1759 /* Run both insert hooks (just once if they're the same). */
1760 if (!NULL_INTERVAL_P (prev
))
1761 interval_insert_behind_hooks
1762 = textget (prev
->plist
, Qinsert_behind_hooks
);
1763 if (!NULL_INTERVAL_P (i
))
1764 interval_insert_in_front_hooks
1765 = textget (i
->plist
, Qinsert_in_front_hooks
);
1769 /* Loop over intervals on or next to START...END,
1770 collecting their hooks. */
1772 i
= find_interval (intervals
, start
);
1775 if (! INTERVAL_WRITABLE_P (i
))
1776 Fsignal (Qtext_read_only
, Qnil
);
1778 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1779 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1781 hooks
= Fcons (mod_hooks
, hooks
);
1782 prev_mod_hooks
= mod_hooks
;
1785 i
= next_interval (i
);
1787 /* Keep going thru the interval containing the char before END. */
1788 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1791 hooks
= Fnreverse (hooks
);
1792 while (! EQ (hooks
, Qnil
))
1794 call_mod_hooks (Fcar (hooks
), make_number (start
),
1796 hooks
= Fcdr (hooks
);
1802 /* Run the interval hooks for an insertion on character range START ... END.
1803 verify_interval_modification chose which hooks to run;
1804 this function is called after the insertion happens
1805 so it can indicate the range of inserted text. */
1808 report_interval_modification (start
, end
)
1809 Lisp_Object start
, end
;
1811 if (! NILP (interval_insert_behind_hooks
))
1812 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1813 if (! NILP (interval_insert_in_front_hooks
)
1814 && ! EQ (interval_insert_in_front_hooks
,
1815 interval_insert_behind_hooks
))
1816 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1822 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1823 "Property-list used as default values.\n\
1824 The value of a property in this list is seen as the value for every\n\
1825 character that does not have its own value for that property.");
1826 Vdefault_text_properties
= Qnil
;
1828 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1829 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1830 This also inhibits the use of the `intangible' text property.");
1831 Vinhibit_point_motion_hooks
= Qnil
;
1833 staticpro (&interval_insert_behind_hooks
);
1834 staticpro (&interval_insert_in_front_hooks
);
1835 interval_insert_behind_hooks
= Qnil
;
1836 interval_insert_in_front_hooks
= Qnil
;
1839 /* Common attributes one might give text */
1841 staticpro (&Qforeground
);
1842 Qforeground
= intern ("foreground");
1843 staticpro (&Qbackground
);
1844 Qbackground
= intern ("background");
1846 Qfont
= intern ("font");
1847 staticpro (&Qstipple
);
1848 Qstipple
= intern ("stipple");
1849 staticpro (&Qunderline
);
1850 Qunderline
= intern ("underline");
1851 staticpro (&Qread_only
);
1852 Qread_only
= intern ("read-only");
1853 staticpro (&Qinvisible
);
1854 Qinvisible
= intern ("invisible");
1855 staticpro (&Qintangible
);
1856 Qintangible
= intern ("intangible");
1857 staticpro (&Qcategory
);
1858 Qcategory
= intern ("category");
1859 staticpro (&Qlocal_map
);
1860 Qlocal_map
= intern ("local-map");
1861 staticpro (&Qfront_sticky
);
1862 Qfront_sticky
= intern ("front-sticky");
1863 staticpro (&Qrear_nonsticky
);
1864 Qrear_nonsticky
= intern ("rear-nonsticky");
1865 staticpro (&Qmouse_face
);
1866 Qmouse_face
= intern ("mouse-face");
1868 /* Properties that text might use to specify certain actions */
1870 staticpro (&Qmouse_left
);
1871 Qmouse_left
= intern ("mouse-left");
1872 staticpro (&Qmouse_entered
);
1873 Qmouse_entered
= intern ("mouse-entered");
1874 staticpro (&Qpoint_left
);
1875 Qpoint_left
= intern ("point-left");
1876 staticpro (&Qpoint_entered
);
1877 Qpoint_entered
= intern ("point-entered");
1879 defsubr (&Stext_properties_at
);
1880 defsubr (&Sget_text_property
);
1881 defsubr (&Sget_char_property
);
1882 defsubr (&Snext_char_property_change
);
1883 defsubr (&Sprevious_char_property_change
);
1884 defsubr (&Snext_property_change
);
1885 defsubr (&Snext_single_property_change
);
1886 defsubr (&Sprevious_property_change
);
1887 defsubr (&Sprevious_single_property_change
);
1888 defsubr (&Sadd_text_properties
);
1889 defsubr (&Sput_text_property
);
1890 defsubr (&Sset_text_properties
);
1891 defsubr (&Sremove_text_properties
);
1892 defsubr (&Stext_property_any
);
1893 defsubr (&Stext_property_not_all
);
1894 /* defsubr (&Serase_text_properties); */
1895 /* defsubr (&Scopy_text_properties); */