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. */
49 /* The rest of the file is within this conditional */
50 #ifdef USE_TEXT_PROPERTIES
53 Lisp_Object Qmouse_left
;
54 Lisp_Object Qmouse_entered
;
55 Lisp_Object Qpoint_left
;
56 Lisp_Object Qpoint_entered
;
57 Lisp_Object Qcategory
;
58 Lisp_Object Qlocal_map
;
60 /* Visual properties text (including strings) may have. */
61 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
62 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
64 /* Sticky properties */
65 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
67 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
68 the o1's cdr. Otherwise, return zero. This is handy for
70 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
72 Lisp_Object Vinhibit_point_motion_hooks
;
73 Lisp_Object Vdefault_text_properties
;
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 struct buffer
*old_current_buffer
= NULL
;
704 int count
= specpdl_ptr
- specpdl
;
707 CHECK_BUFFER (object
, 0);
709 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
711 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
712 Fset_buffer (object
);
715 initial_value
= Fget_char_property (pos
, prop
, object
);
717 while (XFASTINT (pos
) < XFASTINT (limit
))
719 pos
= Fnext_char_property_change (pos
, limit
);
720 value
= Fget_char_property (pos
, prop
, object
);
721 if (!EQ (value
, initial_value
))
725 unbind_to (count
, Qnil
);
733 DEFUN ("next-property-change", Fnext_property_change
,
734 Snext_property_change
, 1, 3, 0,
735 "Return the position of next property change.\n\
736 Scans characters forward from POSITION in OBJECT till it finds\n\
737 a change in some text property, then returns the position of the change.\n\
738 The optional second argument OBJECT is the string or buffer to scan.\n\
739 Return nil if the property is constant all the way to the end of OBJECT.\n\
740 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
741 If the optional third argument LIMIT is non-nil, don't search\n\
742 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
743 (position
, object
, limit
)
744 Lisp_Object position
, object
, limit
;
746 register INTERVAL i
, next
;
749 XSETBUFFER (object
, current_buffer
);
751 if (! NILP (limit
) && ! EQ (limit
, Qt
))
752 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
754 i
= validate_interval_range (object
, &position
, &position
, soft
);
756 /* If LIMIT is t, return start of next interval--don't
757 bother checking further intervals. */
760 if (NULL_INTERVAL_P (i
))
763 next
= next_interval (i
);
765 if (NULL_INTERVAL_P (next
))
766 XSETFASTINT (position
, (STRINGP (object
)
767 ? XSTRING (object
)->size
768 : BUF_ZV (XBUFFER (object
))));
770 XSETFASTINT (position
, next
->position
);
774 if (NULL_INTERVAL_P (i
))
777 next
= next_interval (i
);
779 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
780 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
781 next
= next_interval (next
);
783 if (NULL_INTERVAL_P (next
))
785 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
788 XSETFASTINT (position
, next
->position
);
792 /* Return 1 if there's a change in some property between BEG and END. */
795 property_change_between_p (beg
, end
)
798 register INTERVAL i
, next
;
799 Lisp_Object object
, pos
;
801 XSETBUFFER (object
, current_buffer
);
802 XSETFASTINT (pos
, beg
);
804 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
805 if (NULL_INTERVAL_P (i
))
808 next
= next_interval (i
);
809 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
811 next
= next_interval (next
);
812 if (NULL_INTERVAL_P (next
))
814 if (next
->position
>= end
)
818 if (NULL_INTERVAL_P (next
))
824 DEFUN ("next-single-property-change", Fnext_single_property_change
,
825 Snext_single_property_change
, 2, 4, 0,
826 "Return the position of next property change for a specific property.\n\
827 Scans characters forward from POSITION till it finds\n\
828 a change in the PROP property, then returns the position of the change.\n\
829 The optional third argument OBJECT is the string or buffer to scan.\n\
830 The property values are compared with `eq'.\n\
831 Return nil if the property is constant all the way to the end of OBJECT.\n\
832 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
833 If the optional fourth argument LIMIT is non-nil, don't search\n\
834 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
835 (position
, prop
, object
, limit
)
836 Lisp_Object position
, prop
, object
, limit
;
838 register INTERVAL i
, next
;
839 register Lisp_Object here_val
;
842 XSETBUFFER (object
, current_buffer
);
845 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
847 i
= validate_interval_range (object
, &position
, &position
, soft
);
848 if (NULL_INTERVAL_P (i
))
851 here_val
= textget (i
->plist
, prop
);
852 next
= next_interval (i
);
853 while (! NULL_INTERVAL_P (next
)
854 && EQ (here_val
, textget (next
->plist
, prop
))
855 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
856 next
= next_interval (next
);
858 if (NULL_INTERVAL_P (next
))
860 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
863 return make_number (next
->position
);
866 DEFUN ("previous-property-change", Fprevious_property_change
,
867 Sprevious_property_change
, 1, 3, 0,
868 "Return the position of previous property change.\n\
869 Scans characters backwards from POSITION in OBJECT till it finds\n\
870 a change in some text property, then returns the position of the change.\n\
871 The optional second argument OBJECT is the string or buffer to scan.\n\
872 Return nil if the property is constant all the way to the start of OBJECT.\n\
873 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
874 If the optional third argument LIMIT is non-nil, don't search\n\
875 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
876 (position
, object
, limit
)
877 Lisp_Object position
, object
, limit
;
879 register INTERVAL i
, previous
;
882 XSETBUFFER (object
, current_buffer
);
885 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
887 i
= validate_interval_range (object
, &position
, &position
, soft
);
888 if (NULL_INTERVAL_P (i
))
891 /* Start with the interval containing the char before point. */
892 if (i
->position
== XFASTINT (position
))
893 i
= previous_interval (i
);
895 previous
= previous_interval (i
);
896 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
898 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
899 previous
= previous_interval (previous
);
900 if (NULL_INTERVAL_P (previous
))
903 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
906 return make_number (previous
->position
+ LENGTH (previous
));
909 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
910 Sprevious_single_property_change
, 2, 4, 0,
911 "Return the position of previous property change for a specific property.\n\
912 Scans characters backward from POSITION till it finds\n\
913 a change in the PROP property, then returns the position of the change.\n\
914 The optional third argument OBJECT is the string or buffer to scan.\n\
915 The property values are compared with `eq'.\n\
916 Return nil if the property is constant all the way to the start of OBJECT.\n\
917 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
918 If the optional fourth argument LIMIT is non-nil, don't search\n\
919 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
920 (position
, prop
, object
, limit
)
921 Lisp_Object position
, prop
, object
, limit
;
923 register INTERVAL i
, previous
;
924 register Lisp_Object here_val
;
927 XSETBUFFER (object
, current_buffer
);
930 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
932 i
= validate_interval_range (object
, &position
, &position
, soft
);
934 /* Start with the interval containing the char before point. */
935 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
936 i
= previous_interval (i
);
938 if (NULL_INTERVAL_P (i
))
941 here_val
= textget (i
->plist
, prop
);
942 previous
= previous_interval (i
);
943 while (! NULL_INTERVAL_P (previous
)
944 && EQ (here_val
, textget (previous
->plist
, prop
))
946 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
947 previous
= previous_interval (previous
);
948 if (NULL_INTERVAL_P (previous
))
951 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
954 return make_number (previous
->position
+ LENGTH (previous
));
957 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
959 DEFUN ("add-text-properties", Fadd_text_properties
,
960 Sadd_text_properties
, 3, 4, 0,
961 "Add properties to the text from START to END.\n\
962 The third argument PROPERTIES is a property list\n\
963 specifying the property values to add.\n\
964 The optional fourth argument, OBJECT,\n\
965 is the string or buffer containing the text.\n\
966 Return t if any property value actually changed, nil otherwise.")
967 (start
, end
, properties
, object
)
968 Lisp_Object start
, end
, properties
, object
;
970 register INTERVAL i
, unchanged
;
971 register int s
, len
, modified
= 0;
974 properties
= validate_plist (properties
);
975 if (NILP (properties
))
979 XSETBUFFER (object
, current_buffer
);
981 i
= validate_interval_range (object
, &start
, &end
, hard
);
982 if (NULL_INTERVAL_P (i
))
986 len
= XINT (end
) - s
;
988 /* No need to protect OBJECT, because we GC only if it's a buffer,
989 and live buffers are always protected. */
992 /* If we're not starting on an interval boundary, we have to
993 split this interval. */
994 if (i
->position
!= s
)
996 /* If this interval already has the properties, we can
998 if (interval_has_all_properties (properties
, i
))
1000 int got
= (LENGTH (i
) - (s
- i
->position
));
1002 RETURN_UNGCPRO (Qnil
);
1004 i
= next_interval (i
);
1009 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1010 copy_properties (unchanged
, i
);
1014 if (BUFFERP (object
))
1015 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1017 /* We are at the beginning of interval I, with LEN chars to scan. */
1023 if (LENGTH (i
) >= len
)
1025 /* We can UNGCPRO safely here, because there will be just
1026 one more chance to gc, in the next call to add_properties,
1027 and after that we will not need PROPERTIES or OBJECT again. */
1030 if (interval_has_all_properties (properties
, i
))
1032 if (BUFFERP (object
))
1033 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1034 XINT (end
) - XINT (start
));
1036 return modified
? Qt
: Qnil
;
1039 if (LENGTH (i
) == len
)
1041 add_properties (properties
, i
, object
);
1042 if (BUFFERP (object
))
1043 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1044 XINT (end
) - XINT (start
));
1048 /* i doesn't have the properties, and goes past the change limit */
1050 i
= split_interval_left (unchanged
, len
);
1051 copy_properties (unchanged
, i
);
1052 add_properties (properties
, i
, object
);
1053 if (BUFFERP (object
))
1054 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1055 XINT (end
) - XINT (start
));
1060 modified
+= add_properties (properties
, i
, object
);
1061 i
= next_interval (i
);
1065 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1067 DEFUN ("put-text-property", Fput_text_property
,
1068 Sput_text_property
, 4, 5, 0,
1069 "Set one property of the text from START to END.\n\
1070 The third and fourth arguments PROPERTY and VALUE\n\
1071 specify the property to add.\n\
1072 The optional fifth argument, OBJECT,\n\
1073 is the string or buffer containing the text.")
1074 (start
, end
, property
, value
, object
)
1075 Lisp_Object start
, end
, property
, value
, object
;
1077 Fadd_text_properties (start
, end
,
1078 Fcons (property
, Fcons (value
, Qnil
)),
1083 DEFUN ("set-text-properties", Fset_text_properties
,
1084 Sset_text_properties
, 3, 4, 0,
1085 "Completely replace properties of text from START to END.\n\
1086 The third argument PROPERTIES is the new property list.\n\
1087 The optional fourth argument, OBJECT,\n\
1088 is the string or buffer containing the text.")
1089 (start
, end
, properties
, object
)
1090 Lisp_Object start
, end
, properties
, object
;
1092 register INTERVAL i
, unchanged
;
1093 register INTERVAL prev_changed
= NULL_INTERVAL
;
1094 register int s
, len
;
1095 Lisp_Object ostart
, oend
;
1100 properties
= validate_plist (properties
);
1103 XSETBUFFER (object
, current_buffer
);
1105 /* If we want no properties for a whole string,
1106 get rid of its intervals. */
1107 if (NILP (properties
) && STRINGP (object
)
1108 && XFASTINT (start
) == 0
1109 && XFASTINT (end
) == XSTRING (object
)->size
)
1111 if (! XSTRING (object
)->intervals
)
1114 XSTRING (object
)->intervals
= 0;
1118 i
= validate_interval_range (object
, &start
, &end
, soft
);
1120 if (NULL_INTERVAL_P (i
))
1122 /* If buffer has no properties, and we want none, return now. */
1123 if (NILP (properties
))
1126 /* Restore the original START and END values
1127 because validate_interval_range increments them for strings. */
1131 i
= validate_interval_range (object
, &start
, &end
, hard
);
1132 /* This can return if start == end. */
1133 if (NULL_INTERVAL_P (i
))
1138 len
= XINT (end
) - s
;
1140 if (BUFFERP (object
))
1141 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1143 if (i
->position
!= s
)
1146 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1148 if (LENGTH (i
) > len
)
1150 copy_properties (unchanged
, i
);
1151 i
= split_interval_left (i
, len
);
1152 set_properties (properties
, i
, object
);
1153 if (BUFFERP (object
))
1154 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1155 XINT (end
) - XINT (start
));
1160 set_properties (properties
, i
, object
);
1162 if (LENGTH (i
) == len
)
1164 if (BUFFERP (object
))
1165 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1166 XINT (end
) - XINT (start
));
1173 i
= next_interval (i
);
1176 /* We are starting at the beginning of an interval, I */
1182 if (LENGTH (i
) >= len
)
1184 if (LENGTH (i
) > len
)
1185 i
= split_interval_left (i
, len
);
1187 /* We have to call set_properties even if we are going to
1188 merge the intervals, so as to make the undo records
1189 and cause redisplay to happen. */
1190 set_properties (properties
, i
, object
);
1191 if (!NULL_INTERVAL_P (prev_changed
))
1192 merge_interval_left (i
);
1193 if (BUFFERP (object
))
1194 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1195 XINT (end
) - XINT (start
));
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
))
1208 prev_changed
= i
= merge_interval_left (i
);
1210 i
= next_interval (i
);
1213 if (BUFFERP (object
))
1214 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1215 XINT (end
) - XINT (start
));
1219 DEFUN ("remove-text-properties", Fremove_text_properties
,
1220 Sremove_text_properties
, 3, 4, 0,
1221 "Remove some properties from text from START to END.\n\
1222 The third argument PROPERTIES is a property list\n\
1223 whose property names specify the properties to remove.\n\
1224 \(The values stored in PROPERTIES are ignored.)\n\
1225 The optional fourth argument, OBJECT,\n\
1226 is the string or buffer containing the text.\n\
1227 Return t if any property was actually removed, nil otherwise.")
1228 (start
, end
, properties
, object
)
1229 Lisp_Object start
, end
, properties
, object
;
1231 register INTERVAL i
, unchanged
;
1232 register int s
, len
, modified
= 0;
1235 XSETBUFFER (object
, current_buffer
);
1237 i
= validate_interval_range (object
, &start
, &end
, soft
);
1238 if (NULL_INTERVAL_P (i
))
1242 len
= XINT (end
) - s
;
1244 if (i
->position
!= s
)
1246 /* No properties on this first interval -- return if
1247 it covers the entire region. */
1248 if (! interval_has_some_properties (properties
, i
))
1250 int got
= (LENGTH (i
) - (s
- i
->position
));
1254 i
= next_interval (i
);
1256 /* Split away the beginning of this interval; what we don't
1261 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1262 copy_properties (unchanged
, i
);
1266 if (BUFFERP (object
))
1267 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1269 /* We are at the beginning of an interval, with len to scan */
1275 if (LENGTH (i
) >= len
)
1277 if (! interval_has_some_properties (properties
, i
))
1278 return modified
? Qt
: Qnil
;
1280 if (LENGTH (i
) == len
)
1282 remove_properties (properties
, i
, object
);
1283 if (BUFFERP (object
))
1284 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1285 XINT (end
) - XINT (start
));
1289 /* i has the properties, and goes past the change limit */
1291 i
= split_interval_left (i
, len
);
1292 copy_properties (unchanged
, i
);
1293 remove_properties (properties
, i
, object
);
1294 if (BUFFERP (object
))
1295 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1296 XINT (end
) - XINT (start
));
1301 modified
+= remove_properties (properties
, i
, object
);
1302 i
= next_interval (i
);
1306 DEFUN ("text-property-any", Ftext_property_any
,
1307 Stext_property_any
, 4, 5, 0,
1308 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1309 If so, return the position of the first character whose property PROPERTY\n\
1310 is `eq' to VALUE. Otherwise return nil.\n\
1311 The optional fifth argument, OBJECT, is the string or buffer\n\
1312 containing the text.")
1313 (start
, end
, property
, value
, object
)
1314 Lisp_Object start
, end
, property
, value
, object
;
1316 register INTERVAL i
;
1317 register int e
, pos
;
1320 XSETBUFFER (object
, current_buffer
);
1321 i
= validate_interval_range (object
, &start
, &end
, soft
);
1322 if (NULL_INTERVAL_P (i
))
1323 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1326 while (! NULL_INTERVAL_P (i
))
1328 if (i
->position
>= e
)
1330 if (EQ (textget (i
->plist
, property
), value
))
1333 if (pos
< XINT (start
))
1335 return make_number (pos
);
1337 i
= next_interval (i
);
1342 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1343 Stext_property_not_all
, 4, 5, 0,
1344 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1345 If so, return the position of the first character whose property PROPERTY\n\
1346 is not `eq' to VALUE. Otherwise, return nil.\n\
1347 The optional fifth argument, OBJECT, is the string or buffer\n\
1348 containing the text.")
1349 (start
, end
, property
, value
, object
)
1350 Lisp_Object start
, end
, property
, value
, object
;
1352 register INTERVAL i
;
1356 XSETBUFFER (object
, current_buffer
);
1357 i
= validate_interval_range (object
, &start
, &end
, soft
);
1358 if (NULL_INTERVAL_P (i
))
1359 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1363 while (! NULL_INTERVAL_P (i
))
1365 if (i
->position
>= e
)
1367 if (! EQ (textget (i
->plist
, property
), value
))
1369 if (i
->position
> s
)
1371 return make_number (s
);
1373 i
= next_interval (i
);
1378 /* I don't think this is the right interface to export; how often do you
1379 want to do something like this, other than when you're copying objects
1382 I think it would be better to have a pair of functions, one which
1383 returns the text properties of a region as a list of ranges and
1384 plists, and another which applies such a list to another object. */
1386 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1387 SRC and DEST may each refer to strings or buffers.
1388 Optional sixth argument PROP causes only that property to be copied.
1389 Properties are copied to DEST as if by `add-text-properties'.
1390 Return t if any property value actually changed, nil otherwise. */
1392 /* Note this can GC when DEST is a buffer. */
1395 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1396 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1402 int s
, e
, e2
, p
, len
, modified
= 0;
1403 struct gcpro gcpro1
, gcpro2
;
1405 i
= validate_interval_range (src
, &start
, &end
, soft
);
1406 if (NULL_INTERVAL_P (i
))
1409 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1411 Lisp_Object dest_start
, dest_end
;
1414 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1415 /* Apply this to a copy of pos; it will try to increment its arguments,
1416 which we don't want. */
1417 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1428 e2
= i
->position
+ LENGTH (i
);
1435 while (! NILP (plist
))
1437 if (EQ (Fcar (plist
), prop
))
1439 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1442 plist
= Fcdr (Fcdr (plist
));
1446 /* Must defer modifications to the interval tree in case src
1447 and dest refer to the same string or buffer. */
1448 stuff
= Fcons (Fcons (make_number (p
),
1449 Fcons (make_number (p
+ len
),
1450 Fcons (plist
, Qnil
))),
1454 i
= next_interval (i
);
1455 if (NULL_INTERVAL_P (i
))
1462 GCPRO2 (stuff
, dest
);
1464 while (! NILP (stuff
))
1467 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1468 Fcar (Fcdr (Fcdr (res
))), dest
);
1471 stuff
= Fcdr (stuff
);
1476 return modified
? Qt
: Qnil
;
1480 /* Return a list representing the text properties of OBJECT between
1481 START and END. if PROP is non-nil, report only on that property.
1482 Each result list element has the form (S E PLIST), where S and E
1483 are positions in OBJECT and PLIST is a property list containing the
1484 text properties of OBJECT between S and E. Value is nil if OBJECT
1485 doesn't contain text properties between START and END. */
1488 text_property_list (object
, start
, end
, prop
)
1489 Lisp_Object object
, start
, end
, prop
;
1496 i
= validate_interval_range (object
, &start
, &end
, soft
);
1497 if (!NULL_INTERVAL_P (i
))
1499 int s
= XINT (start
);
1504 int interval_end
, len
;
1507 interval_end
= i
->position
+ LENGTH (i
);
1508 if (interval_end
> e
)
1510 len
= interval_end
- s
;
1515 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1516 if (EQ (Fcar (plist
), prop
))
1518 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1523 result
= Fcons (Fcons (make_number (s
),
1524 Fcons (make_number (s
+ len
),
1525 Fcons (plist
, Qnil
))),
1528 i
= next_interval (i
);
1529 if (NULL_INTERVAL_P (i
))
1539 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1540 (START END PLIST), where START and END are positions and PLIST is a
1541 property list containing the text properties to add. Adjust START
1542 and END positions by DELTA before adding properties. Value is
1543 non-zero if OBJECT was modified. */
1546 add_text_properties_from_list (object
, list
, delta
)
1547 Lisp_Object object
, list
, delta
;
1549 struct gcpro gcpro1
, gcpro2
;
1552 GCPRO2 (list
, object
);
1554 for (; CONSP (list
); list
= XCDR (list
))
1556 Lisp_Object item
, start
, end
, plist
, tem
;
1559 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1560 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1561 plist
= XCAR (XCDR (XCDR (item
)));
1563 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1574 /* Modify end-points of ranges in LIST destructively. LIST is a list
1575 as returned from text_property_list. Change end-points equal to
1576 OLD_END to NEW_END. */
1579 extend_property_ranges (list
, old_end
, new_end
)
1580 Lisp_Object list
, old_end
, new_end
;
1582 for (; CONSP (list
); list
= XCDR (list
))
1584 Lisp_Object item
, end
;
1587 end
= XCAR (XCDR (item
));
1589 if (EQ (end
, old_end
))
1590 XCAR (XCDR (item
)) = new_end
;
1596 /* Call the modification hook functions in LIST, each with START and END. */
1599 call_mod_hooks (list
, start
, end
)
1600 Lisp_Object list
, start
, end
;
1602 struct gcpro gcpro1
;
1604 while (!NILP (list
))
1606 call2 (Fcar (list
), start
, end
);
1612 /* Check for read-only intervals between character positions START ... END,
1613 in BUF, and signal an error if we find one.
1615 Then check for any modification hooks in the range.
1616 Create a list of all these hooks in lexicographic order,
1617 eliminating consecutive extra copies of the same hook. Then call
1618 those hooks in order, with START and END - 1 as arguments. */
1621 verify_interval_modification (buf
, start
, end
)
1625 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1626 register INTERVAL i
;
1628 register Lisp_Object prev_mod_hooks
;
1629 Lisp_Object mod_hooks
;
1630 struct gcpro gcpro1
;
1633 prev_mod_hooks
= Qnil
;
1636 interval_insert_behind_hooks
= Qnil
;
1637 interval_insert_in_front_hooks
= Qnil
;
1639 if (NULL_INTERVAL_P (intervals
))
1649 /* For an insert operation, check the two chars around the position. */
1653 Lisp_Object before
, after
;
1655 /* Set I to the interval containing the char after START,
1656 and PREV to the interval containing the char before START.
1657 Either one may be null. They may be equal. */
1658 i
= find_interval (intervals
, start
);
1660 if (start
== BUF_BEGV (buf
))
1662 else if (i
->position
== start
)
1663 prev
= previous_interval (i
);
1664 else if (i
->position
< start
)
1666 if (start
== BUF_ZV (buf
))
1669 /* If Vinhibit_read_only is set and is not a list, we can
1670 skip the read_only checks. */
1671 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1673 /* If I and PREV differ we need to check for the read-only
1674 property together with its stickiness. If either I or
1675 PREV are 0, this check is all we need.
1676 We have to take special care, since read-only may be
1677 indirectly defined via the category property. */
1680 if (! NULL_INTERVAL_P (i
))
1682 after
= textget (i
->plist
, Qread_only
);
1684 /* If interval I is read-only and read-only is
1685 front-sticky, inhibit insertion.
1686 Check for read-only as well as category. */
1688 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1692 tem
= textget (i
->plist
, Qfront_sticky
);
1693 if (TMEM (Qread_only
, tem
)
1694 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1695 && TMEM (Qcategory
, tem
)))
1696 error ("Attempt to insert within read-only text");
1700 if (! NULL_INTERVAL_P (prev
))
1702 before
= textget (prev
->plist
, Qread_only
);
1704 /* If interval PREV is read-only and read-only isn't
1705 rear-nonsticky, inhibit insertion.
1706 Check for read-only as well as category. */
1708 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1712 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1713 if (! TMEM (Qread_only
, tem
)
1714 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1715 || ! TMEM (Qcategory
, tem
)))
1716 error ("Attempt to insert within read-only text");
1720 else if (! NULL_INTERVAL_P (i
))
1722 after
= textget (i
->plist
, Qread_only
);
1724 /* If interval I is read-only and read-only is
1725 front-sticky, inhibit insertion.
1726 Check for read-only as well as category. */
1727 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1731 tem
= textget (i
->plist
, Qfront_sticky
);
1732 if (TMEM (Qread_only
, tem
)
1733 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1734 && TMEM (Qcategory
, tem
)))
1735 error ("Attempt to insert within read-only text");
1737 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1738 if (! TMEM (Qread_only
, tem
)
1739 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1740 || ! TMEM (Qcategory
, tem
)))
1741 error ("Attempt to insert within read-only text");
1746 /* Run both insert hooks (just once if they're the same). */
1747 if (!NULL_INTERVAL_P (prev
))
1748 interval_insert_behind_hooks
1749 = textget (prev
->plist
, Qinsert_behind_hooks
);
1750 if (!NULL_INTERVAL_P (i
))
1751 interval_insert_in_front_hooks
1752 = textget (i
->plist
, Qinsert_in_front_hooks
);
1756 /* Loop over intervals on or next to START...END,
1757 collecting their hooks. */
1759 i
= find_interval (intervals
, start
);
1762 if (! INTERVAL_WRITABLE_P (i
))
1763 error ("Attempt to modify read-only text");
1765 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1766 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1768 hooks
= Fcons (mod_hooks
, hooks
);
1769 prev_mod_hooks
= mod_hooks
;
1772 i
= next_interval (i
);
1774 /* Keep going thru the interval containing the char before END. */
1775 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1778 hooks
= Fnreverse (hooks
);
1779 while (! EQ (hooks
, Qnil
))
1781 call_mod_hooks (Fcar (hooks
), make_number (start
),
1783 hooks
= Fcdr (hooks
);
1789 /* Run the interval hooks for an insertion on character range START ... END.
1790 verify_interval_modification chose which hooks to run;
1791 this function is called after the insertion happens
1792 so it can indicate the range of inserted text. */
1795 report_interval_modification (start
, end
)
1796 Lisp_Object start
, end
;
1798 if (! NILP (interval_insert_behind_hooks
))
1799 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1800 if (! NILP (interval_insert_in_front_hooks
)
1801 && ! EQ (interval_insert_in_front_hooks
,
1802 interval_insert_behind_hooks
))
1803 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1809 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1810 "Property-list used as default values.\n\
1811 The value of a property in this list is seen as the value for every\n\
1812 character that does not have its own value for that property.");
1813 Vdefault_text_properties
= Qnil
;
1815 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1816 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1817 This also inhibits the use of the `intangible' text property.");
1818 Vinhibit_point_motion_hooks
= Qnil
;
1820 staticpro (&interval_insert_behind_hooks
);
1821 staticpro (&interval_insert_in_front_hooks
);
1822 interval_insert_behind_hooks
= Qnil
;
1823 interval_insert_in_front_hooks
= Qnil
;
1826 /* Common attributes one might give text */
1828 staticpro (&Qforeground
);
1829 Qforeground
= intern ("foreground");
1830 staticpro (&Qbackground
);
1831 Qbackground
= intern ("background");
1833 Qfont
= intern ("font");
1834 staticpro (&Qstipple
);
1835 Qstipple
= intern ("stipple");
1836 staticpro (&Qunderline
);
1837 Qunderline
= intern ("underline");
1838 staticpro (&Qread_only
);
1839 Qread_only
= intern ("read-only");
1840 staticpro (&Qinvisible
);
1841 Qinvisible
= intern ("invisible");
1842 staticpro (&Qintangible
);
1843 Qintangible
= intern ("intangible");
1844 staticpro (&Qcategory
);
1845 Qcategory
= intern ("category");
1846 staticpro (&Qlocal_map
);
1847 Qlocal_map
= intern ("local-map");
1848 staticpro (&Qfront_sticky
);
1849 Qfront_sticky
= intern ("front-sticky");
1850 staticpro (&Qrear_nonsticky
);
1851 Qrear_nonsticky
= intern ("rear-nonsticky");
1852 staticpro (&Qmouse_face
);
1853 Qmouse_face
= intern ("mouse-face");
1855 /* Properties that text might use to specify certain actions */
1857 staticpro (&Qmouse_left
);
1858 Qmouse_left
= intern ("mouse-left");
1859 staticpro (&Qmouse_entered
);
1860 Qmouse_entered
= intern ("mouse-entered");
1861 staticpro (&Qpoint_left
);
1862 Qpoint_left
= intern ("point-left");
1863 staticpro (&Qpoint_entered
);
1864 Qpoint_entered
= intern ("point-entered");
1866 defsubr (&Stext_properties_at
);
1867 defsubr (&Sget_text_property
);
1868 defsubr (&Sget_char_property
);
1869 defsubr (&Snext_char_property_change
);
1870 defsubr (&Sprevious_char_property_change
);
1871 defsubr (&Snext_property_change
);
1872 defsubr (&Snext_single_property_change
);
1873 defsubr (&Sprevious_property_change
);
1874 defsubr (&Sprevious_single_property_change
);
1875 defsubr (&Sadd_text_properties
);
1876 defsubr (&Sput_text_property
);
1877 defsubr (&Sset_text_properties
);
1878 defsubr (&Sremove_text_properties
);
1879 defsubr (&Stext_property_any
);
1880 defsubr (&Stext_property_not_all
);
1881 /* defsubr (&Serase_text_properties); */
1882 /* defsubr (&Scopy_text_properties); */
1887 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1889 #endif /* USE_TEXT_PROPERTIES */