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
;
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
61 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
71 Lisp_Object Vinhibit_point_motion_hooks
;
72 Lisp_Object Vdefault_text_properties
;
73 Lisp_Object Vtext_property_default_nonsticky
;
75 /* verify_interval_modification saves insertion hooks here
76 to be run later by report_interval_modification. */
77 Lisp_Object interval_insert_behind_hooks
;
78 Lisp_Object interval_insert_in_front_hooks
;
80 /* Extract the interval at the position pointed to by BEGIN from
81 OBJECT, a string or buffer. Additionally, check that the positions
82 pointed to by BEGIN and END are within the bounds of OBJECT, and
83 reverse them if *BEGIN is greater than *END. The objects pointed
84 to by BEGIN and END may be integers or markers; if the latter, they
85 are coerced to integers.
87 When OBJECT is a string, we increment *BEGIN and *END
88 to make them origin-one.
90 Note that buffer points don't correspond to interval indices.
91 For example, point-max is 1 greater than the index of the last
92 character. This difference is handled in the caller, which uses
93 the validated points to determine a length, and operates on that.
94 Exceptions are Ftext_properties_at, Fnext_property_change, and
95 Fprevious_property_change which call this function with BEGIN == END.
96 Handle this case specially.
98 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
99 create an interval tree for OBJECT if one doesn't exist, provided
100 the object actually contains text. In the current design, if there
101 is no text, there can be no text properties. */
107 validate_interval_range (object
, begin
, end
, force
)
108 Lisp_Object object
, *begin
, *end
;
114 CHECK_STRING_OR_BUFFER (object
, 0);
115 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
116 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
118 /* If we are asked for a point, but from a subr which operates
119 on a range, then return nothing. */
120 if (EQ (*begin
, *end
) && begin
!= end
)
121 return NULL_INTERVAL
;
123 if (XINT (*begin
) > XINT (*end
))
131 if (BUFFERP (object
))
133 register struct buffer
*b
= XBUFFER (object
);
135 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
136 && XINT (*end
) <= BUF_ZV (b
)))
137 args_out_of_range (*begin
, *end
);
138 i
= BUF_INTERVALS (b
);
140 /* If there's no text, there are no properties. */
141 if (BUF_BEGV (b
) == BUF_ZV (b
))
142 return NULL_INTERVAL
;
144 searchpos
= XINT (*begin
);
148 register struct Lisp_String
*s
= XSTRING (object
);
150 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
151 && XINT (*end
) <= s
->size
))
152 args_out_of_range (*begin
, *end
);
153 XSETFASTINT (*begin
, XFASTINT (*begin
));
155 XSETFASTINT (*end
, XFASTINT (*end
));
159 return NULL_INTERVAL
;
161 searchpos
= XINT (*begin
);
164 if (NULL_INTERVAL_P (i
))
165 return (force
? create_root_interval (object
) : i
);
167 return find_interval (i
, searchpos
);
170 /* Validate LIST as a property list. If LIST is not a list, then
171 make one consisting of (LIST nil). Otherwise, verify that LIST
172 is even numbered and thus suitable as a plist. */
175 validate_plist (list
)
184 register Lisp_Object tail
;
185 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
191 error ("Odd length text property list");
195 return Fcons (list
, Fcons (Qnil
, Qnil
));
198 /* Return nonzero if interval I has all the properties,
199 with the same values, of list PLIST. */
202 interval_has_all_properties (plist
, i
)
206 register Lisp_Object tail1
, tail2
, sym1
;
209 /* Go through each element of PLIST. */
210 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
215 /* Go through I's plist, looking for sym1 */
216 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
217 if (EQ (sym1
, Fcar (tail2
)))
219 /* Found the same property on both lists. If the
220 values are unequal, return zero. */
221 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
224 /* Property has same value on both lists; go to next one. */
236 /* Return nonzero if the plist of interval I has any of the
237 properties of PLIST, regardless of their values. */
240 interval_has_some_properties (plist
, i
)
244 register Lisp_Object tail1
, tail2
, sym
;
246 /* Go through each element of PLIST. */
247 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
251 /* Go through i's plist, looking for tail1 */
252 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
253 if (EQ (sym
, Fcar (tail2
)))
260 /* Changing the plists of individual intervals. */
262 /* Return the value of PROP in property-list PLIST, or Qunbound if it
265 property_value (plist
, prop
)
266 Lisp_Object plist
, prop
;
270 while (PLIST_ELT_P (plist
, value
))
271 if (EQ (XCAR (plist
), prop
))
274 plist
= XCDR (value
);
279 /* Set the properties of INTERVAL to PROPERTIES,
280 and record undo info for the previous values.
281 OBJECT is the string or buffer that INTERVAL belongs to. */
284 set_properties (properties
, interval
, object
)
285 Lisp_Object properties
, object
;
288 Lisp_Object sym
, value
;
290 if (BUFFERP (object
))
292 /* For each property in the old plist which is missing from PROPERTIES,
293 or has a different value in PROPERTIES, make an undo record. */
294 for (sym
= interval
->plist
;
295 PLIST_ELT_P (sym
, value
);
297 if (! EQ (property_value (properties
, XCAR (sym
)),
300 record_property_change (interval
->position
, LENGTH (interval
),
301 XCAR (sym
), XCAR (value
),
305 /* For each new property that has no value at all in the old plist,
306 make an undo record binding it to nil, so it will be removed. */
307 for (sym
= properties
;
308 PLIST_ELT_P (sym
, value
);
310 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
312 record_property_change (interval
->position
, LENGTH (interval
),
318 /* Store new properties. */
319 interval
->plist
= Fcopy_sequence (properties
);
322 /* Add the properties of PLIST to the interval I, or set
323 the value of I's property to the value of the property on PLIST
324 if they are different.
326 OBJECT should be the string or buffer the interval is in.
328 Return nonzero if this changes I (i.e., if any members of PLIST
329 are actually added to I's plist) */
332 add_properties (plist
, i
, object
)
337 Lisp_Object tail1
, tail2
, sym1
, val1
;
338 register int changed
= 0;
340 struct gcpro gcpro1
, gcpro2
, gcpro3
;
345 /* No need to protect OBJECT, because we can GC only in the case
346 where it is a buffer, and live buffers are always protected.
347 I and its plist are also protected, via OBJECT. */
348 GCPRO3 (tail1
, sym1
, val1
);
350 /* Go through each element of PLIST. */
351 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
354 val1
= Fcar (Fcdr (tail1
));
357 /* Go through I's plist, looking for sym1 */
358 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
359 if (EQ (sym1
, Fcar (tail2
)))
361 /* No need to gcpro, because tail2 protects this
362 and it must be a cons cell (we get an error otherwise). */
363 register Lisp_Object this_cdr
;
365 this_cdr
= Fcdr (tail2
);
366 /* Found the property. Now check its value. */
369 /* The properties have the same value on both lists.
370 Continue to the next property. */
371 if (EQ (val1
, Fcar (this_cdr
)))
374 /* Record this change in the buffer, for undo purposes. */
375 if (BUFFERP (object
))
377 record_property_change (i
->position
, LENGTH (i
),
378 sym1
, Fcar (this_cdr
), object
);
381 /* I's property has a different value -- change it */
382 Fsetcar (this_cdr
, val1
);
389 /* Record this change in the buffer, for undo purposes. */
390 if (BUFFERP (object
))
392 record_property_change (i
->position
, LENGTH (i
),
395 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
405 /* For any members of PLIST which are properties of I, remove them
407 OBJECT is the string or buffer containing I. */
410 remove_properties (plist
, i
, object
)
415 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
416 register int changed
= 0;
418 current_plist
= i
->plist
;
419 /* Go through each element of plist. */
420 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
424 /* First, remove the symbol if its at the head of the list */
425 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
427 if (BUFFERP (object
))
429 record_property_change (i
->position
, LENGTH (i
),
430 sym
, Fcar (Fcdr (current_plist
)),
434 current_plist
= Fcdr (Fcdr (current_plist
));
438 /* Go through i's plist, looking for sym */
439 tail2
= current_plist
;
440 while (! NILP (tail2
))
442 register Lisp_Object
this;
443 this = Fcdr (Fcdr (tail2
));
444 if (EQ (sym
, Fcar (this)))
446 if (BUFFERP (object
))
448 record_property_change (i
->position
, LENGTH (i
),
449 sym
, Fcar (Fcdr (this)), object
);
452 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
460 i
->plist
= current_plist
;
465 /* Remove all properties from interval I. Return non-zero
466 if this changes the interval. */
480 /* Returns the interval of POSITION in OBJECT.
481 POSITION is BEG-based. */
484 interval_of (position
, object
)
492 XSETBUFFER (object
, current_buffer
);
493 else if (EQ (object
, Qt
))
494 return NULL_INTERVAL
;
496 CHECK_STRING_OR_BUFFER (object
, 0);
498 if (BUFFERP (object
))
500 register struct buffer
*b
= XBUFFER (object
);
504 i
= BUF_INTERVALS (b
);
508 register struct Lisp_String
*s
= XSTRING (object
);
515 if (!(beg
<= position
&& position
<= end
))
516 args_out_of_range (make_number (position
), make_number (position
));
517 if (beg
== end
|| NULL_INTERVAL_P (i
))
518 return NULL_INTERVAL
;
520 return find_interval (i
, position
);
523 DEFUN ("text-properties-at", Ftext_properties_at
,
524 Stext_properties_at
, 1, 2, 0,
525 "Return the list of properties of the character at POSITION in OBJECT.\n\
526 OBJECT is the string or buffer to look for the properties in;\n\
527 nil means the current buffer.\n\
528 If POSITION is at the end of OBJECT, the value is nil.")
530 Lisp_Object position
, object
;
535 XSETBUFFER (object
, current_buffer
);
537 i
= validate_interval_range (object
, &position
, &position
, soft
);
538 if (NULL_INTERVAL_P (i
))
540 /* If POSITION is at the end of the interval,
541 it means it's the end of OBJECT.
542 There are no properties at the very end,
543 since no character follows. */
544 if (XINT (position
) == LENGTH (i
) + i
->position
)
550 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
551 "Return the value of POSITION's property PROP, in OBJECT.\n\
552 OBJECT is optional and defaults to the current buffer.\n\
553 If POSITION is at the end of OBJECT, the value is nil.")
554 (position
, prop
, object
)
555 Lisp_Object position
, object
;
558 return textget (Ftext_properties_at (position
, object
), prop
);
561 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
562 "Return the value of POSITION's property PROP, in OBJECT.\n\
563 OBJECT is optional and defaults to the current buffer.\n\
564 If POSITION is at the end of OBJECT, the value is nil.\n\
565 If OBJECT is a buffer, then overlay properties are considered as well as\n\
567 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
568 overlays are considered only if they are associated with OBJECT.")
569 (position
, prop
, object
)
570 Lisp_Object position
, object
;
571 register Lisp_Object prop
;
573 struct window
*w
= 0;
575 CHECK_NUMBER_COERCE_MARKER (position
, 0);
578 XSETBUFFER (object
, current_buffer
);
580 if (WINDOWP (object
))
582 w
= XWINDOW (object
);
585 if (BUFFERP (object
))
587 int posn
= XINT (position
);
589 Lisp_Object
*overlay_vec
, tem
;
592 struct buffer
*obuf
= current_buffer
;
594 set_buffer_temp (XBUFFER (object
));
596 /* First try with room for 40 overlays. */
598 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
600 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
601 &next_overlay
, NULL
);
603 /* If there are more than 40,
604 make enough space for all, and try again. */
608 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
609 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
610 &next_overlay
, NULL
);
612 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
614 set_buffer_temp (obuf
);
616 /* Now check the overlays in order of decreasing priority. */
617 while (--noverlays
>= 0)
619 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
624 /* Not a buffer, or no appropriate overlay, so fall through to the
626 return (Fget_text_property (position
, prop
, object
));
629 DEFUN ("next-char-property-change", Fnext_char_property_change
,
630 Snext_char_property_change
, 1, 2, 0,
631 "Return the position of next text property or overlay change.\n\
632 This scans characters forward from POSITION in OBJECT till it finds\n\
633 a change in some text property, or the beginning or end of an overlay,\n\
634 and returns the position of that.\n\
635 If none is found, the function returns (point-max).\n\
637 If the optional third argument LIMIT is non-nil, don't search\n\
638 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
640 Lisp_Object position
, limit
;
644 temp
= Fnext_overlay_change (position
);
647 CHECK_NUMBER (limit
, 2);
648 if (XINT (limit
) < XINT (temp
))
651 return Fnext_property_change (position
, Qnil
, temp
);
654 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
655 Sprevious_char_property_change
, 1, 2, 0,
656 "Return the position of previous text property or overlay change.\n\
657 Scans characters backward from POSITION in OBJECT till it finds\n\
658 a change in some text property, or the beginning or end of an overlay,\n\
659 and returns the position of that.\n\
660 If none is found, the function returns (point-max).\n\
662 If the optional third argument LIMIT is non-nil, don't search\n\
663 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
665 Lisp_Object position
, limit
;
669 temp
= Fprevious_overlay_change (position
);
672 CHECK_NUMBER (limit
, 2);
673 if (XINT (limit
) > XINT (temp
))
676 return Fprevious_property_change (position
, Qnil
, temp
);
680 /* Value is the position in OBJECT after POS where the value of
681 property PROP changes. OBJECT must be a string or buffer. If
682 OBJECT is nil, use the current buffer. LIMIT if not nil limits the
686 next_single_char_property_change (pos
, prop
, object
, limit
)
687 Lisp_Object prop
, pos
, object
, limit
;
689 if (STRINGP (object
))
691 pos
= Fnext_single_property_change (pos
, prop
, object
, limit
);
695 pos
= make_number (XSTRING (object
)->size
);
702 Lisp_Object initial_value
, value
;
703 int count
= specpdl_ptr
- specpdl
;
706 CHECK_BUFFER (object
, 0);
708 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
710 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
711 Fset_buffer (object
);
714 initial_value
= Fget_char_property (pos
, prop
, object
);
716 while (XFASTINT (pos
) < XFASTINT (limit
))
718 pos
= Fnext_char_property_change (pos
, limit
);
719 value
= Fget_char_property (pos
, prop
, object
);
720 if (!EQ (value
, initial_value
))
724 unbind_to (count
, Qnil
);
732 DEFUN ("next-property-change", Fnext_property_change
,
733 Snext_property_change
, 1, 3, 0,
734 "Return the position of next property change.\n\
735 Scans characters forward from POSITION in OBJECT till it finds\n\
736 a change in some text property, then returns the position of the change.\n\
737 The optional second argument OBJECT is the string or buffer to scan.\n\
738 Return nil if the property is constant all the way to the end of OBJECT.\n\
739 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
740 If the optional third argument LIMIT is non-nil, don't search\n\
741 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
742 (position
, object
, limit
)
743 Lisp_Object position
, object
, limit
;
745 register INTERVAL i
, next
;
748 XSETBUFFER (object
, current_buffer
);
750 if (! NILP (limit
) && ! EQ (limit
, Qt
))
751 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
753 i
= validate_interval_range (object
, &position
, &position
, soft
);
755 /* If LIMIT is t, return start of next interval--don't
756 bother checking further intervals. */
759 if (NULL_INTERVAL_P (i
))
762 next
= next_interval (i
);
764 if (NULL_INTERVAL_P (next
))
765 XSETFASTINT (position
, (STRINGP (object
)
766 ? XSTRING (object
)->size
767 : BUF_ZV (XBUFFER (object
))));
769 XSETFASTINT (position
, next
->position
);
773 if (NULL_INTERVAL_P (i
))
776 next
= next_interval (i
);
778 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
779 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
780 next
= next_interval (next
);
782 if (NULL_INTERVAL_P (next
))
784 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
787 XSETFASTINT (position
, next
->position
);
791 /* Return 1 if there's a change in some property between BEG and END. */
794 property_change_between_p (beg
, end
)
797 register INTERVAL i
, next
;
798 Lisp_Object object
, pos
;
800 XSETBUFFER (object
, current_buffer
);
801 XSETFASTINT (pos
, beg
);
803 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
804 if (NULL_INTERVAL_P (i
))
807 next
= next_interval (i
);
808 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
810 next
= next_interval (next
);
811 if (NULL_INTERVAL_P (next
))
813 if (next
->position
>= end
)
817 if (NULL_INTERVAL_P (next
))
823 DEFUN ("next-single-property-change", Fnext_single_property_change
,
824 Snext_single_property_change
, 2, 4, 0,
825 "Return the position of next property change for a specific property.\n\
826 Scans characters forward from POSITION till it finds\n\
827 a change in the PROP property, then returns the position of the change.\n\
828 The optional third argument OBJECT is the string or buffer to scan.\n\
829 The property values are compared with `eq'.\n\
830 Return nil if the property is constant all the way to the end of OBJECT.\n\
831 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
832 If the optional fourth argument LIMIT is non-nil, don't search\n\
833 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
834 (position
, prop
, object
, limit
)
835 Lisp_Object position
, prop
, object
, limit
;
837 register INTERVAL i
, next
;
838 register Lisp_Object here_val
;
841 XSETBUFFER (object
, current_buffer
);
844 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
846 i
= validate_interval_range (object
, &position
, &position
, soft
);
847 if (NULL_INTERVAL_P (i
))
850 here_val
= textget (i
->plist
, prop
);
851 next
= next_interval (i
);
852 while (! NULL_INTERVAL_P (next
)
853 && EQ (here_val
, textget (next
->plist
, prop
))
854 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
855 next
= next_interval (next
);
857 if (NULL_INTERVAL_P (next
))
859 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
862 return make_number (next
->position
);
865 DEFUN ("previous-property-change", Fprevious_property_change
,
866 Sprevious_property_change
, 1, 3, 0,
867 "Return the position of previous property change.\n\
868 Scans characters backwards from POSITION in OBJECT till it finds\n\
869 a change in some text property, then returns the position of the change.\n\
870 The optional second argument OBJECT is the string or buffer to scan.\n\
871 Return nil if the property is constant all the way to the start of OBJECT.\n\
872 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
873 If the optional third argument LIMIT is non-nil, don't search\n\
874 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
875 (position
, object
, limit
)
876 Lisp_Object position
, object
, limit
;
878 register INTERVAL i
, previous
;
881 XSETBUFFER (object
, current_buffer
);
884 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
886 i
= validate_interval_range (object
, &position
, &position
, soft
);
887 if (NULL_INTERVAL_P (i
))
890 /* Start with the interval containing the char before point. */
891 if (i
->position
== XFASTINT (position
))
892 i
= previous_interval (i
);
894 previous
= previous_interval (i
);
895 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
897 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
898 previous
= previous_interval (previous
);
899 if (NULL_INTERVAL_P (previous
))
902 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
905 return make_number (previous
->position
+ LENGTH (previous
));
908 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
909 Sprevious_single_property_change
, 2, 4, 0,
910 "Return the position of previous property change for a specific property.\n\
911 Scans characters backward from POSITION till it finds\n\
912 a change in the PROP property, then returns the position of the change.\n\
913 The optional third argument OBJECT is the string or buffer to scan.\n\
914 The property values are compared with `eq'.\n\
915 Return nil if the property is constant all the way to the start of OBJECT.\n\
916 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
917 If the optional fourth argument LIMIT is non-nil, don't search\n\
918 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
919 (position
, prop
, object
, limit
)
920 Lisp_Object position
, prop
, object
, limit
;
922 register INTERVAL i
, previous
;
923 register Lisp_Object here_val
;
926 XSETBUFFER (object
, current_buffer
);
929 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
931 i
= validate_interval_range (object
, &position
, &position
, soft
);
933 /* Start with the interval containing the char before point. */
934 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
935 i
= previous_interval (i
);
937 if (NULL_INTERVAL_P (i
))
940 here_val
= textget (i
->plist
, prop
);
941 previous
= previous_interval (i
);
942 while (! NULL_INTERVAL_P (previous
)
943 && EQ (here_val
, textget (previous
->plist
, prop
))
945 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
946 previous
= previous_interval (previous
);
947 if (NULL_INTERVAL_P (previous
))
950 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
953 return make_number (previous
->position
+ LENGTH (previous
));
956 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
958 DEFUN ("add-text-properties", Fadd_text_properties
,
959 Sadd_text_properties
, 3, 4, 0,
960 "Add properties to the text from START to END.\n\
961 The third argument PROPERTIES is a property list\n\
962 specifying the property values to add.\n\
963 The optional fourth argument, OBJECT,\n\
964 is the string or buffer containing the text.\n\
965 Return t if any property value actually changed, nil otherwise.")
966 (start
, end
, properties
, object
)
967 Lisp_Object start
, end
, properties
, object
;
969 register INTERVAL i
, unchanged
;
970 register int s
, len
, modified
= 0;
973 properties
= validate_plist (properties
);
974 if (NILP (properties
))
978 XSETBUFFER (object
, current_buffer
);
980 i
= validate_interval_range (object
, &start
, &end
, hard
);
981 if (NULL_INTERVAL_P (i
))
985 len
= XINT (end
) - s
;
987 /* No need to protect OBJECT, because we GC only if it's a buffer,
988 and live buffers are always protected. */
991 /* If we're not starting on an interval boundary, we have to
992 split this interval. */
993 if (i
->position
!= s
)
995 /* If this interval already has the properties, we can
997 if (interval_has_all_properties (properties
, i
))
999 int got
= (LENGTH (i
) - (s
- i
->position
));
1001 RETURN_UNGCPRO (Qnil
);
1003 i
= next_interval (i
);
1008 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1009 copy_properties (unchanged
, i
);
1013 if (BUFFERP (object
))
1014 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1016 /* We are at the beginning of interval I, with LEN chars to scan. */
1022 if (LENGTH (i
) >= len
)
1024 /* We can UNGCPRO safely here, because there will be just
1025 one more chance to gc, in the next call to add_properties,
1026 and after that we will not need PROPERTIES or OBJECT again. */
1029 if (interval_has_all_properties (properties
, i
))
1031 if (BUFFERP (object
))
1032 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1033 XINT (end
) - XINT (start
));
1035 return modified
? Qt
: Qnil
;
1038 if (LENGTH (i
) == len
)
1040 add_properties (properties
, i
, object
);
1041 if (BUFFERP (object
))
1042 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1043 XINT (end
) - XINT (start
));
1047 /* i doesn't have the properties, and goes past the change limit */
1049 i
= split_interval_left (unchanged
, len
);
1050 copy_properties (unchanged
, i
);
1051 add_properties (properties
, i
, object
);
1052 if (BUFFERP (object
))
1053 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1054 XINT (end
) - XINT (start
));
1059 modified
+= add_properties (properties
, i
, object
);
1060 i
= next_interval (i
);
1064 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1066 DEFUN ("put-text-property", Fput_text_property
,
1067 Sput_text_property
, 4, 5, 0,
1068 "Set one property of the text from START to END.\n\
1069 The third and fourth arguments PROPERTY and VALUE\n\
1070 specify the property to add.\n\
1071 The optional fifth argument, OBJECT,\n\
1072 is the string or buffer containing the text.")
1073 (start
, end
, property
, value
, object
)
1074 Lisp_Object start
, end
, property
, value
, object
;
1076 Fadd_text_properties (start
, end
,
1077 Fcons (property
, Fcons (value
, Qnil
)),
1082 DEFUN ("set-text-properties", Fset_text_properties
,
1083 Sset_text_properties
, 3, 4, 0,
1084 "Completely replace properties of text from START to END.\n\
1085 The third argument PROPERTIES is the new property list.\n\
1086 The optional fourth argument, OBJECT,\n\
1087 is the string or buffer containing the text.")
1088 (start
, end
, properties
, object
)
1089 Lisp_Object start
, end
, properties
, object
;
1091 return set_text_properties (start
, end
, properties
, object
, Qt
);
1095 /* Replace properties of text from START to END with new list of
1096 properties PROPERTIES. OBJECT is the buffer or string containing
1097 the text. OBJECT nil means use the current buffer.
1098 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1099 is non-nil if properties were replaced; it is nil if there weren't
1100 any properties to replace. */
1103 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1104 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1106 register INTERVAL i
, unchanged
;
1107 register INTERVAL prev_changed
= NULL_INTERVAL
;
1108 register int s
, len
;
1109 Lisp_Object ostart
, oend
;
1114 properties
= validate_plist (properties
);
1117 XSETBUFFER (object
, current_buffer
);
1119 /* If we want no properties for a whole string,
1120 get rid of its intervals. */
1121 if (NILP (properties
) && STRINGP (object
)
1122 && XFASTINT (start
) == 0
1123 && XFASTINT (end
) == XSTRING (object
)->size
)
1125 if (! XSTRING (object
)->intervals
)
1128 XSTRING (object
)->intervals
= 0;
1132 i
= validate_interval_range (object
, &start
, &end
, soft
);
1134 if (NULL_INTERVAL_P (i
))
1136 /* If buffer has no properties, and we want none, return now. */
1137 if (NILP (properties
))
1140 /* Restore the original START and END values
1141 because validate_interval_range increments them for strings. */
1145 i
= validate_interval_range (object
, &start
, &end
, hard
);
1146 /* This can return if start == end. */
1147 if (NULL_INTERVAL_P (i
))
1152 len
= XINT (end
) - s
;
1154 if (BUFFERP (object
))
1155 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1157 if (i
->position
!= s
)
1160 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1162 if (LENGTH (i
) > len
)
1164 copy_properties (unchanged
, i
);
1165 i
= split_interval_left (i
, len
);
1166 set_properties (properties
, i
, object
);
1167 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1168 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1169 XINT (end
) - XINT (start
));
1174 set_properties (properties
, i
, object
);
1176 if (LENGTH (i
) == len
)
1178 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1179 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1180 XINT (end
) - XINT (start
));
1187 i
= next_interval (i
);
1190 /* We are starting at the beginning of an interval, I */
1196 if (LENGTH (i
) >= len
)
1198 if (LENGTH (i
) > len
)
1199 i
= split_interval_left (i
, len
);
1201 /* We have to call set_properties even if we are going to
1202 merge the intervals, so as to make the undo records
1203 and cause redisplay to happen. */
1204 set_properties (properties
, i
, object
);
1205 if (!NULL_INTERVAL_P (prev_changed
))
1206 merge_interval_left (i
);
1207 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1208 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1209 XINT (end
) - XINT (start
));
1215 /* We have to call set_properties even if we are going to
1216 merge the intervals, so as to make the undo records
1217 and cause redisplay to happen. */
1218 set_properties (properties
, i
, object
);
1219 if (NULL_INTERVAL_P (prev_changed
))
1222 prev_changed
= i
= merge_interval_left (i
);
1224 i
= next_interval (i
);
1227 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1228 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1229 XINT (end
) - XINT (start
));
1233 DEFUN ("remove-text-properties", Fremove_text_properties
,
1234 Sremove_text_properties
, 3, 4, 0,
1235 "Remove some properties from text from START to END.\n\
1236 The third argument PROPERTIES is a property list\n\
1237 whose property names specify the properties to remove.\n\
1238 \(The values stored in PROPERTIES are ignored.)\n\
1239 The optional fourth argument, OBJECT,\n\
1240 is the string or buffer containing the text.\n\
1241 Return t if any property was actually removed, nil otherwise.")
1242 (start
, end
, properties
, object
)
1243 Lisp_Object start
, end
, properties
, object
;
1245 register INTERVAL i
, unchanged
;
1246 register int s
, len
, modified
= 0;
1249 XSETBUFFER (object
, current_buffer
);
1251 i
= validate_interval_range (object
, &start
, &end
, soft
);
1252 if (NULL_INTERVAL_P (i
))
1256 len
= XINT (end
) - s
;
1258 if (i
->position
!= s
)
1260 /* No properties on this first interval -- return if
1261 it covers the entire region. */
1262 if (! interval_has_some_properties (properties
, i
))
1264 int got
= (LENGTH (i
) - (s
- i
->position
));
1268 i
= next_interval (i
);
1270 /* Split away the beginning of this interval; what we don't
1275 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1276 copy_properties (unchanged
, i
);
1280 if (BUFFERP (object
))
1281 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1283 /* We are at the beginning of an interval, with len to scan */
1289 if (LENGTH (i
) >= len
)
1291 if (! interval_has_some_properties (properties
, i
))
1292 return modified
? Qt
: Qnil
;
1294 if (LENGTH (i
) == len
)
1296 remove_properties (properties
, i
, object
);
1297 if (BUFFERP (object
))
1298 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1299 XINT (end
) - XINT (start
));
1303 /* i has the properties, and goes past the change limit */
1305 i
= split_interval_left (i
, len
);
1306 copy_properties (unchanged
, i
);
1307 remove_properties (properties
, i
, object
);
1308 if (BUFFERP (object
))
1309 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1310 XINT (end
) - XINT (start
));
1315 modified
+= remove_properties (properties
, i
, object
);
1316 i
= next_interval (i
);
1320 DEFUN ("text-property-any", Ftext_property_any
,
1321 Stext_property_any
, 4, 5, 0,
1322 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1323 If so, return the position of the first character whose property PROPERTY\n\
1324 is `eq' to VALUE. Otherwise return nil.\n\
1325 The optional fifth argument, OBJECT, is the string or buffer\n\
1326 containing the text.")
1327 (start
, end
, property
, value
, object
)
1328 Lisp_Object start
, end
, property
, value
, object
;
1330 register INTERVAL i
;
1331 register int e
, pos
;
1334 XSETBUFFER (object
, current_buffer
);
1335 i
= validate_interval_range (object
, &start
, &end
, soft
);
1336 if (NULL_INTERVAL_P (i
))
1337 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1340 while (! NULL_INTERVAL_P (i
))
1342 if (i
->position
>= e
)
1344 if (EQ (textget (i
->plist
, property
), value
))
1347 if (pos
< XINT (start
))
1349 return make_number (pos
);
1351 i
= next_interval (i
);
1356 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1357 Stext_property_not_all
, 4, 5, 0,
1358 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1359 If so, return the position of the first character whose property PROPERTY\n\
1360 is not `eq' to VALUE. Otherwise, return nil.\n\
1361 The optional fifth argument, OBJECT, is the string or buffer\n\
1362 containing the text.")
1363 (start
, end
, property
, value
, object
)
1364 Lisp_Object start
, end
, property
, value
, object
;
1366 register INTERVAL i
;
1370 XSETBUFFER (object
, current_buffer
);
1371 i
= validate_interval_range (object
, &start
, &end
, soft
);
1372 if (NULL_INTERVAL_P (i
))
1373 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1377 while (! NULL_INTERVAL_P (i
))
1379 if (i
->position
>= e
)
1381 if (! EQ (textget (i
->plist
, property
), value
))
1383 if (i
->position
> s
)
1385 return make_number (s
);
1387 i
= next_interval (i
);
1392 /* I don't think this is the right interface to export; how often do you
1393 want to do something like this, other than when you're copying objects
1396 I think it would be better to have a pair of functions, one which
1397 returns the text properties of a region as a list of ranges and
1398 plists, and another which applies such a list to another object. */
1400 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1401 SRC and DEST may each refer to strings or buffers.
1402 Optional sixth argument PROP causes only that property to be copied.
1403 Properties are copied to DEST as if by `add-text-properties'.
1404 Return t if any property value actually changed, nil otherwise. */
1406 /* Note this can GC when DEST is a buffer. */
1409 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1410 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1416 int s
, e
, e2
, p
, len
, modified
= 0;
1417 struct gcpro gcpro1
, gcpro2
;
1419 i
= validate_interval_range (src
, &start
, &end
, soft
);
1420 if (NULL_INTERVAL_P (i
))
1423 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1425 Lisp_Object dest_start
, dest_end
;
1428 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1429 /* Apply this to a copy of pos; it will try to increment its arguments,
1430 which we don't want. */
1431 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1442 e2
= i
->position
+ LENGTH (i
);
1449 while (! NILP (plist
))
1451 if (EQ (Fcar (plist
), prop
))
1453 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1456 plist
= Fcdr (Fcdr (plist
));
1460 /* Must defer modifications to the interval tree in case src
1461 and dest refer to the same string or buffer. */
1462 stuff
= Fcons (Fcons (make_number (p
),
1463 Fcons (make_number (p
+ len
),
1464 Fcons (plist
, Qnil
))),
1468 i
= next_interval (i
);
1469 if (NULL_INTERVAL_P (i
))
1476 GCPRO2 (stuff
, dest
);
1478 while (! NILP (stuff
))
1481 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1482 Fcar (Fcdr (Fcdr (res
))), dest
);
1485 stuff
= Fcdr (stuff
);
1490 return modified
? Qt
: Qnil
;
1494 /* Return a list representing the text properties of OBJECT between
1495 START and END. if PROP is non-nil, report only on that property.
1496 Each result list element has the form (S E PLIST), where S and E
1497 are positions in OBJECT and PLIST is a property list containing the
1498 text properties of OBJECT between S and E. Value is nil if OBJECT
1499 doesn't contain text properties between START and END. */
1502 text_property_list (object
, start
, end
, prop
)
1503 Lisp_Object object
, start
, end
, prop
;
1510 i
= validate_interval_range (object
, &start
, &end
, soft
);
1511 if (!NULL_INTERVAL_P (i
))
1513 int s
= XINT (start
);
1518 int interval_end
, len
;
1521 interval_end
= i
->position
+ LENGTH (i
);
1522 if (interval_end
> e
)
1524 len
= interval_end
- s
;
1529 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1530 if (EQ (Fcar (plist
), prop
))
1532 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1537 result
= Fcons (Fcons (make_number (s
),
1538 Fcons (make_number (s
+ len
),
1539 Fcons (plist
, Qnil
))),
1542 i
= next_interval (i
);
1543 if (NULL_INTERVAL_P (i
))
1553 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1554 (START END PLIST), where START and END are positions and PLIST is a
1555 property list containing the text properties to add. Adjust START
1556 and END positions by DELTA before adding properties. Value is
1557 non-zero if OBJECT was modified. */
1560 add_text_properties_from_list (object
, list
, delta
)
1561 Lisp_Object object
, list
, delta
;
1563 struct gcpro gcpro1
, gcpro2
;
1566 GCPRO2 (list
, object
);
1568 for (; CONSP (list
); list
= XCDR (list
))
1570 Lisp_Object item
, start
, end
, plist
, tem
;
1573 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1574 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1575 plist
= XCAR (XCDR (XCDR (item
)));
1577 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1588 /* Modify end-points of ranges in LIST destructively. LIST is a list
1589 as returned from text_property_list. Change end-points equal to
1590 OLD_END to NEW_END. */
1593 extend_property_ranges (list
, old_end
, new_end
)
1594 Lisp_Object list
, old_end
, new_end
;
1596 for (; CONSP (list
); list
= XCDR (list
))
1598 Lisp_Object item
, end
;
1601 end
= XCAR (XCDR (item
));
1603 if (EQ (end
, old_end
))
1604 XCAR (XCDR (item
)) = new_end
;
1610 /* Call the modification hook functions in LIST, each with START and END. */
1613 call_mod_hooks (list
, start
, end
)
1614 Lisp_Object list
, start
, end
;
1616 struct gcpro gcpro1
;
1618 while (!NILP (list
))
1620 call2 (Fcar (list
), start
, end
);
1626 /* Check for read-only intervals between character positions START ... END,
1627 in BUF, and signal an error if we find one.
1629 Then check for any modification hooks in the range.
1630 Create a list of all these hooks in lexicographic order,
1631 eliminating consecutive extra copies of the same hook. Then call
1632 those hooks in order, with START and END - 1 as arguments. */
1635 verify_interval_modification (buf
, start
, end
)
1639 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1640 register INTERVAL i
;
1642 register Lisp_Object prev_mod_hooks
;
1643 Lisp_Object mod_hooks
;
1644 struct gcpro gcpro1
;
1647 prev_mod_hooks
= Qnil
;
1650 interval_insert_behind_hooks
= Qnil
;
1651 interval_insert_in_front_hooks
= Qnil
;
1653 if (NULL_INTERVAL_P (intervals
))
1663 /* For an insert operation, check the two chars around the position. */
1667 Lisp_Object before
, after
;
1669 /* Set I to the interval containing the char after START,
1670 and PREV to the interval containing the char before START.
1671 Either one may be null. They may be equal. */
1672 i
= find_interval (intervals
, start
);
1674 if (start
== BUF_BEGV (buf
))
1676 else if (i
->position
== start
)
1677 prev
= previous_interval (i
);
1678 else if (i
->position
< start
)
1680 if (start
== BUF_ZV (buf
))
1683 /* If Vinhibit_read_only is set and is not a list, we can
1684 skip the read_only checks. */
1685 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1687 /* If I and PREV differ we need to check for the read-only
1688 property together with its stickiness. If either I or
1689 PREV are 0, this check is all we need.
1690 We have to take special care, since read-only may be
1691 indirectly defined via the category property. */
1694 if (! NULL_INTERVAL_P (i
))
1696 after
= textget (i
->plist
, Qread_only
);
1698 /* If interval I is read-only and read-only is
1699 front-sticky, inhibit insertion.
1700 Check for read-only as well as category. */
1702 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1706 tem
= textget (i
->plist
, Qfront_sticky
);
1707 if (TMEM (Qread_only
, tem
)
1708 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1709 && TMEM (Qcategory
, tem
)))
1710 Fsignal (Qtext_read_only
, Qnil
);
1714 if (! NULL_INTERVAL_P (prev
))
1716 before
= textget (prev
->plist
, Qread_only
);
1718 /* If interval PREV is read-only and read-only isn't
1719 rear-nonsticky, inhibit insertion.
1720 Check for read-only as well as category. */
1722 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1726 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1727 if (! TMEM (Qread_only
, tem
)
1728 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1729 || ! TMEM (Qcategory
, tem
)))
1730 Fsignal (Qtext_read_only
, Qnil
);
1734 else if (! NULL_INTERVAL_P (i
))
1736 after
= textget (i
->plist
, Qread_only
);
1738 /* If interval I is read-only and read-only is
1739 front-sticky, inhibit insertion.
1740 Check for read-only as well as category. */
1741 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1745 tem
= textget (i
->plist
, Qfront_sticky
);
1746 if (TMEM (Qread_only
, tem
)
1747 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1748 && TMEM (Qcategory
, tem
)))
1749 Fsignal (Qtext_read_only
, Qnil
);
1751 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1752 if (! TMEM (Qread_only
, tem
)
1753 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1754 || ! TMEM (Qcategory
, tem
)))
1755 Fsignal (Qtext_read_only
, Qnil
);
1760 /* Run both insert hooks (just once if they're the same). */
1761 if (!NULL_INTERVAL_P (prev
))
1762 interval_insert_behind_hooks
1763 = textget (prev
->plist
, Qinsert_behind_hooks
);
1764 if (!NULL_INTERVAL_P (i
))
1765 interval_insert_in_front_hooks
1766 = textget (i
->plist
, Qinsert_in_front_hooks
);
1770 /* Loop over intervals on or next to START...END,
1771 collecting their hooks. */
1773 i
= find_interval (intervals
, start
);
1776 if (! INTERVAL_WRITABLE_P (i
))
1777 Fsignal (Qtext_read_only
, Qnil
);
1779 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1780 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1782 hooks
= Fcons (mod_hooks
, hooks
);
1783 prev_mod_hooks
= mod_hooks
;
1786 i
= next_interval (i
);
1788 /* Keep going thru the interval containing the char before END. */
1789 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1792 hooks
= Fnreverse (hooks
);
1793 while (! EQ (hooks
, Qnil
))
1795 call_mod_hooks (Fcar (hooks
), make_number (start
),
1797 hooks
= Fcdr (hooks
);
1803 /* Run the interval hooks for an insertion on character range START ... END.
1804 verify_interval_modification chose which hooks to run;
1805 this function is called after the insertion happens
1806 so it can indicate the range of inserted text. */
1809 report_interval_modification (start
, end
)
1810 Lisp_Object start
, end
;
1812 if (! NILP (interval_insert_behind_hooks
))
1813 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1814 if (! NILP (interval_insert_in_front_hooks
)
1815 && ! EQ (interval_insert_in_front_hooks
,
1816 interval_insert_behind_hooks
))
1817 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1823 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1824 "Property-list used as default values.\n\
1825 The value of a property in this list is seen as the value for every\n\
1826 character that does not have its own value for that property.");
1827 Vdefault_text_properties
= Qnil
;
1829 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1830 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1831 This also inhibits the use of the `intangible' text property.");
1832 Vinhibit_point_motion_hooks
= Qnil
;
1834 DEFVAR_LISP ("text-property-default-nonsticky",
1835 &Vtext_property_default_nonsticky
,
1836 "Alist of properties vs the corresponding non-stickinesses.\n\
1837 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1839 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1840 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1841 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1842 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1843 Vtext_property_default_nonsticky
= Qnil
;
1845 staticpro (&interval_insert_behind_hooks
);
1846 staticpro (&interval_insert_in_front_hooks
);
1847 interval_insert_behind_hooks
= Qnil
;
1848 interval_insert_in_front_hooks
= Qnil
;
1851 /* Common attributes one might give text */
1853 staticpro (&Qforeground
);
1854 Qforeground
= intern ("foreground");
1855 staticpro (&Qbackground
);
1856 Qbackground
= intern ("background");
1858 Qfont
= intern ("font");
1859 staticpro (&Qstipple
);
1860 Qstipple
= intern ("stipple");
1861 staticpro (&Qunderline
);
1862 Qunderline
= intern ("underline");
1863 staticpro (&Qread_only
);
1864 Qread_only
= intern ("read-only");
1865 staticpro (&Qinvisible
);
1866 Qinvisible
= intern ("invisible");
1867 staticpro (&Qintangible
);
1868 Qintangible
= intern ("intangible");
1869 staticpro (&Qcategory
);
1870 Qcategory
= intern ("category");
1871 staticpro (&Qlocal_map
);
1872 Qlocal_map
= intern ("local-map");
1873 staticpro (&Qkeymap
);
1874 Qkeymap
= intern ("keymap");
1875 staticpro (&Qfront_sticky
);
1876 Qfront_sticky
= intern ("front-sticky");
1877 staticpro (&Qrear_nonsticky
);
1878 Qrear_nonsticky
= intern ("rear-nonsticky");
1879 staticpro (&Qmouse_face
);
1880 Qmouse_face
= intern ("mouse-face");
1882 /* Properties that text might use to specify certain actions */
1884 staticpro (&Qmouse_left
);
1885 Qmouse_left
= intern ("mouse-left");
1886 staticpro (&Qmouse_entered
);
1887 Qmouse_entered
= intern ("mouse-entered");
1888 staticpro (&Qpoint_left
);
1889 Qpoint_left
= intern ("point-left");
1890 staticpro (&Qpoint_entered
);
1891 Qpoint_entered
= intern ("point-entered");
1893 defsubr (&Stext_properties_at
);
1894 defsubr (&Sget_text_property
);
1895 defsubr (&Sget_char_property
);
1896 defsubr (&Snext_char_property_change
);
1897 defsubr (&Sprevious_char_property_change
);
1898 defsubr (&Snext_property_change
);
1899 defsubr (&Snext_single_property_change
);
1900 defsubr (&Sprevious_property_change
);
1901 defsubr (&Sprevious_single_property_change
);
1902 defsubr (&Sadd_text_properties
);
1903 defsubr (&Sput_text_property
);
1904 defsubr (&Sset_text_properties
);
1905 defsubr (&Sremove_text_properties
);
1906 defsubr (&Stext_property_any
);
1907 defsubr (&Stext_property_not_all
);
1908 /* defsubr (&Serase_text_properties); */
1909 /* defsubr (&Scopy_text_properties); */