1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999 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
;
72 Lisp_Object Vtext_property_default_nonsticky
;
74 /* verify_interval_modification saves insertion hooks here
75 to be run later by report_interval_modification. */
76 Lisp_Object interval_insert_behind_hooks
;
77 Lisp_Object interval_insert_in_front_hooks
;
79 /* Extract the interval at the position pointed to by BEGIN from
80 OBJECT, a string or buffer. Additionally, check that the positions
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
82 reverse them if *BEGIN is greater than *END. The objects pointed
83 to by BEGIN and END may be integers or markers; if the latter, they
84 are coerced to integers.
86 When OBJECT is a string, we increment *BEGIN and *END
87 to make them origin-one.
89 Note that buffer points don't correspond to interval indices.
90 For example, point-max is 1 greater than the index of the last
91 character. This difference is handled in the caller, which uses
92 the validated points to determine a length, and operates on that.
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
94 Fprevious_property_change which call this function with BEGIN == END.
95 Handle this case specially.
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
98 create an interval tree for OBJECT if one doesn't exist, provided
99 the object actually contains text. In the current design, if there
100 is no text, there can be no text properties. */
106 validate_interval_range (object
, begin
, end
, force
)
107 Lisp_Object object
, *begin
, *end
;
113 CHECK_STRING_OR_BUFFER (object
, 0);
114 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
115 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
117 /* If we are asked for a point, but from a subr which operates
118 on a range, then return nothing. */
119 if (EQ (*begin
, *end
) && begin
!= end
)
120 return NULL_INTERVAL
;
122 if (XINT (*begin
) > XINT (*end
))
130 if (BUFFERP (object
))
132 register struct buffer
*b
= XBUFFER (object
);
134 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
135 && XINT (*end
) <= BUF_ZV (b
)))
136 args_out_of_range (*begin
, *end
);
137 i
= BUF_INTERVALS (b
);
139 /* If there's no text, there are no properties. */
140 if (BUF_BEGV (b
) == BUF_ZV (b
))
141 return NULL_INTERVAL
;
143 searchpos
= XINT (*begin
);
147 register struct Lisp_String
*s
= XSTRING (object
);
149 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
150 && XINT (*end
) <= s
->size
))
151 args_out_of_range (*begin
, *end
);
152 XSETFASTINT (*begin
, XFASTINT (*begin
));
154 XSETFASTINT (*end
, XFASTINT (*end
));
158 return NULL_INTERVAL
;
160 searchpos
= XINT (*begin
);
163 if (NULL_INTERVAL_P (i
))
164 return (force
? create_root_interval (object
) : i
);
166 return find_interval (i
, searchpos
);
169 /* Validate LIST as a property list. If LIST is not a list, then
170 make one consisting of (LIST nil). Otherwise, verify that LIST
171 is even numbered and thus suitable as a plist. */
174 validate_plist (list
)
183 register Lisp_Object tail
;
184 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
190 error ("Odd length text property list");
194 return Fcons (list
, Fcons (Qnil
, Qnil
));
197 /* Return nonzero if interval I has all the properties,
198 with the same values, of list PLIST. */
201 interval_has_all_properties (plist
, i
)
205 register Lisp_Object tail1
, tail2
, sym1
;
208 /* Go through each element of PLIST. */
209 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
214 /* Go through I's plist, looking for sym1 */
215 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
216 if (EQ (sym1
, Fcar (tail2
)))
218 /* Found the same property on both lists. If the
219 values are unequal, return zero. */
220 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
223 /* Property has same value on both lists; go to next one. */
235 /* Return nonzero if the plist of interval I has any of the
236 properties of PLIST, regardless of their values. */
239 interval_has_some_properties (plist
, i
)
243 register Lisp_Object tail1
, tail2
, sym
;
245 /* Go through each element of PLIST. */
246 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
250 /* Go through i's plist, looking for tail1 */
251 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
252 if (EQ (sym
, Fcar (tail2
)))
259 /* Changing the plists of individual intervals. */
261 /* Return the value of PROP in property-list PLIST, or Qunbound if it
264 property_value (plist
, prop
)
265 Lisp_Object plist
, prop
;
269 while (PLIST_ELT_P (plist
, value
))
270 if (EQ (XCAR (plist
), prop
))
273 plist
= XCDR (value
);
278 /* Set the properties of INTERVAL to PROPERTIES,
279 and record undo info for the previous values.
280 OBJECT is the string or buffer that INTERVAL belongs to. */
283 set_properties (properties
, interval
, object
)
284 Lisp_Object properties
, object
;
287 Lisp_Object sym
, value
;
289 if (BUFFERP (object
))
291 /* For each property in the old plist which is missing from PROPERTIES,
292 or has a different value in PROPERTIES, make an undo record. */
293 for (sym
= interval
->plist
;
294 PLIST_ELT_P (sym
, value
);
296 if (! EQ (property_value (properties
, XCAR (sym
)),
299 record_property_change (interval
->position
, LENGTH (interval
),
300 XCAR (sym
), XCAR (value
),
304 /* For each new property that has no value at all in the old plist,
305 make an undo record binding it to nil, so it will be removed. */
306 for (sym
= properties
;
307 PLIST_ELT_P (sym
, value
);
309 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
311 record_property_change (interval
->position
, LENGTH (interval
),
317 /* Store new properties. */
318 interval
->plist
= Fcopy_sequence (properties
);
321 /* Add the properties of PLIST to the interval I, or set
322 the value of I's property to the value of the property on PLIST
323 if they are different.
325 OBJECT should be the string or buffer the interval is in.
327 Return nonzero if this changes I (i.e., if any members of PLIST
328 are actually added to I's plist) */
331 add_properties (plist
, i
, object
)
336 Lisp_Object tail1
, tail2
, sym1
, val1
;
337 register int changed
= 0;
339 struct gcpro gcpro1
, gcpro2
, gcpro3
;
344 /* No need to protect OBJECT, because we can GC only in the case
345 where it is a buffer, and live buffers are always protected.
346 I and its plist are also protected, via OBJECT. */
347 GCPRO3 (tail1
, sym1
, val1
);
349 /* Go through each element of PLIST. */
350 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
353 val1
= Fcar (Fcdr (tail1
));
356 /* Go through I's plist, looking for sym1 */
357 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
358 if (EQ (sym1
, Fcar (tail2
)))
360 /* No need to gcpro, because tail2 protects this
361 and it must be a cons cell (we get an error otherwise). */
362 register Lisp_Object this_cdr
;
364 this_cdr
= Fcdr (tail2
);
365 /* Found the property. Now check its value. */
368 /* The properties have the same value on both lists.
369 Continue to the next property. */
370 if (EQ (val1
, Fcar (this_cdr
)))
373 /* Record this change in the buffer, for undo purposes. */
374 if (BUFFERP (object
))
376 record_property_change (i
->position
, LENGTH (i
),
377 sym1
, Fcar (this_cdr
), object
);
380 /* I's property has a different value -- change it */
381 Fsetcar (this_cdr
, val1
);
388 /* Record this change in the buffer, for undo purposes. */
389 if (BUFFERP (object
))
391 record_property_change (i
->position
, LENGTH (i
),
394 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
404 /* For any members of PLIST which are properties of I, remove them
406 OBJECT is the string or buffer containing I. */
409 remove_properties (plist
, i
, object
)
414 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
415 register int changed
= 0;
417 current_plist
= i
->plist
;
418 /* Go through each element of plist. */
419 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
423 /* First, remove the symbol if its at the head of the list */
424 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
426 if (BUFFERP (object
))
428 record_property_change (i
->position
, LENGTH (i
),
429 sym
, Fcar (Fcdr (current_plist
)),
433 current_plist
= Fcdr (Fcdr (current_plist
));
437 /* Go through i's plist, looking for sym */
438 tail2
= current_plist
;
439 while (! NILP (tail2
))
441 register Lisp_Object
this;
442 this = Fcdr (Fcdr (tail2
));
443 if (EQ (sym
, Fcar (this)))
445 if (BUFFERP (object
))
447 record_property_change (i
->position
, LENGTH (i
),
448 sym
, Fcar (Fcdr (this)), object
);
451 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
459 i
->plist
= current_plist
;
464 /* Remove all properties from interval I. Return non-zero
465 if this changes the interval. */
479 /* Returns the interval of POSITION in OBJECT.
480 POSITION is BEG-based. */
483 interval_of (position
, object
)
491 XSETBUFFER (object
, current_buffer
);
492 else if (EQ (object
, Qt
))
493 return NULL_INTERVAL
;
495 CHECK_STRING_OR_BUFFER (object
, 0);
497 if (BUFFERP (object
))
499 register struct buffer
*b
= XBUFFER (object
);
503 i
= BUF_INTERVALS (b
);
507 register struct Lisp_String
*s
= XSTRING (object
);
514 if (!(beg
<= position
&& position
<= end
))
515 args_out_of_range (make_number (position
), make_number (position
));
516 if (beg
== end
|| NULL_INTERVAL_P (i
))
517 return NULL_INTERVAL
;
519 return find_interval (i
, position
);
522 DEFUN ("text-properties-at", Ftext_properties_at
,
523 Stext_properties_at
, 1, 2, 0,
524 "Return the list of properties of the character at POSITION in OBJECT.\n\
525 OBJECT is the string or buffer to look for the properties in;\n\
526 nil means the current buffer.\n\
527 If POSITION is at the end of OBJECT, the value is nil.")
529 Lisp_Object position
, object
;
534 XSETBUFFER (object
, current_buffer
);
536 i
= validate_interval_range (object
, &position
, &position
, soft
);
537 if (NULL_INTERVAL_P (i
))
539 /* If POSITION is at the end of the interval,
540 it means it's the end of OBJECT.
541 There are no properties at the very end,
542 since no character follows. */
543 if (XINT (position
) == LENGTH (i
) + i
->position
)
549 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
550 "Return the value of POSITION's property PROP, in OBJECT.\n\
551 OBJECT is optional and defaults to the current buffer.\n\
552 If POSITION is at the end of OBJECT, the value is nil.")
553 (position
, prop
, object
)
554 Lisp_Object position
, object
;
557 return textget (Ftext_properties_at (position
, object
), prop
);
560 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
561 "Return the value of POSITION's property PROP, in OBJECT.\n\
562 OBJECT is optional and defaults to the current buffer.\n\
563 If POSITION is at the end of OBJECT, the value is nil.\n\
564 If OBJECT is a buffer, then overlay properties are considered as well as\n\
566 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
567 overlays are considered only if they are associated with OBJECT.")
568 (position
, prop
, object
)
569 Lisp_Object position
, object
;
570 register Lisp_Object prop
;
572 struct window
*w
= 0;
574 CHECK_NUMBER_COERCE_MARKER (position
, 0);
577 XSETBUFFER (object
, current_buffer
);
579 if (WINDOWP (object
))
581 w
= XWINDOW (object
);
584 if (BUFFERP (object
))
586 int posn
= XINT (position
);
588 Lisp_Object
*overlay_vec
, tem
;
591 struct buffer
*obuf
= current_buffer
;
593 set_buffer_temp (XBUFFER (object
));
595 /* First try with room for 40 overlays. */
597 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
599 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
600 &next_overlay
, NULL
);
602 /* If there are more than 40,
603 make enough space for all, and try again. */
607 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
608 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
609 &next_overlay
, NULL
);
611 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
613 set_buffer_temp (obuf
);
615 /* Now check the overlays in order of decreasing priority. */
616 while (--noverlays
>= 0)
618 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
623 /* Not a buffer, or no appropriate overlay, so fall through to the
625 return (Fget_text_property (position
, prop
, object
));
628 DEFUN ("next-char-property-change", Fnext_char_property_change
,
629 Snext_char_property_change
, 1, 2, 0,
630 "Return the position of next text property or overlay change.\n\
631 This scans characters forward from POSITION in OBJECT till it finds\n\
632 a change in some text property, or the beginning or end of an overlay,\n\
633 and returns the position of that.\n\
634 If none is found, the function returns (point-max).\n\
636 If the optional third argument LIMIT is non-nil, don't search\n\
637 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
639 Lisp_Object position
, limit
;
643 temp
= Fnext_overlay_change (position
);
646 CHECK_NUMBER (limit
, 2);
647 if (XINT (limit
) < XINT (temp
))
650 return Fnext_property_change (position
, Qnil
, temp
);
653 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
654 Sprevious_char_property_change
, 1, 2, 0,
655 "Return the position of previous text property or overlay change.\n\
656 Scans characters backward from POSITION in OBJECT till it finds\n\
657 a change in some text property, or the beginning or end of an overlay,\n\
658 and returns the position of that.\n\
659 If none is found, the function returns (point-max).\n\
661 If the optional third argument LIMIT is non-nil, don't search\n\
662 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
664 Lisp_Object position
, limit
;
668 temp
= Fprevious_overlay_change (position
);
671 CHECK_NUMBER (limit
, 2);
672 if (XINT (limit
) > XINT (temp
))
675 return Fprevious_property_change (position
, Qnil
, temp
);
679 /* Value is the position in OBJECT after POS where the value of
680 property PROP changes. OBJECT must be a string or buffer. If
681 OBJECT is nil, use the current buffer. LIMIT if not nil limits the
685 next_single_char_property_change (pos
, prop
, object
, limit
)
686 Lisp_Object prop
, pos
, object
, limit
;
688 if (STRINGP (object
))
690 pos
= Fnext_single_property_change (pos
, prop
, object
, limit
);
694 pos
= make_number (XSTRING (object
)->size
);
701 Lisp_Object initial_value
, value
;
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 DEFVAR_LISP ("text-property-default-nonsticky",
1834 &Vtext_property_default_nonsticky
,
1835 "Alist of properties vs the corresponding non-stickinesses.\n\
1836 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1838 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1839 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1840 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1841 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1842 Vtext_property_default_nonsticky
= Qnil
;
1844 staticpro (&interval_insert_behind_hooks
);
1845 staticpro (&interval_insert_in_front_hooks
);
1846 interval_insert_behind_hooks
= Qnil
;
1847 interval_insert_in_front_hooks
= Qnil
;
1850 /* Common attributes one might give text */
1852 staticpro (&Qforeground
);
1853 Qforeground
= intern ("foreground");
1854 staticpro (&Qbackground
);
1855 Qbackground
= intern ("background");
1857 Qfont
= intern ("font");
1858 staticpro (&Qstipple
);
1859 Qstipple
= intern ("stipple");
1860 staticpro (&Qunderline
);
1861 Qunderline
= intern ("underline");
1862 staticpro (&Qread_only
);
1863 Qread_only
= intern ("read-only");
1864 staticpro (&Qinvisible
);
1865 Qinvisible
= intern ("invisible");
1866 staticpro (&Qintangible
);
1867 Qintangible
= intern ("intangible");
1868 staticpro (&Qcategory
);
1869 Qcategory
= intern ("category");
1870 staticpro (&Qlocal_map
);
1871 Qlocal_map
= intern ("local-map");
1872 staticpro (&Qfront_sticky
);
1873 Qfront_sticky
= intern ("front-sticky");
1874 staticpro (&Qrear_nonsticky
);
1875 Qrear_nonsticky
= intern ("rear-nonsticky");
1876 staticpro (&Qmouse_face
);
1877 Qmouse_face
= intern ("mouse-face");
1879 /* Properties that text might use to specify certain actions */
1881 staticpro (&Qmouse_left
);
1882 Qmouse_left
= intern ("mouse-left");
1883 staticpro (&Qmouse_entered
);
1884 Qmouse_entered
= intern ("mouse-entered");
1885 staticpro (&Qpoint_left
);
1886 Qpoint_left
= intern ("point-left");
1887 staticpro (&Qpoint_entered
);
1888 Qpoint_entered
= intern ("point-entered");
1890 defsubr (&Stext_properties_at
);
1891 defsubr (&Sget_text_property
);
1892 defsubr (&Sget_char_property
);
1893 defsubr (&Snext_char_property_change
);
1894 defsubr (&Sprevious_char_property_change
);
1895 defsubr (&Snext_property_change
);
1896 defsubr (&Snext_single_property_change
);
1897 defsubr (&Sprevious_property_change
);
1898 defsubr (&Sprevious_single_property_change
);
1899 defsubr (&Sadd_text_properties
);
1900 defsubr (&Sput_text_property
);
1901 defsubr (&Sset_text_properties
);
1902 defsubr (&Sremove_text_properties
);
1903 defsubr (&Stext_property_any
);
1904 defsubr (&Stext_property_not_all
);
1905 /* defsubr (&Serase_text_properties); */
1906 /* defsubr (&Scopy_text_properties); */