1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include "intervals.h"
28 #define NULL (void *)0
31 /* Test for membership, allowing for t (actually any non-cons) to mean the
34 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
37 /* NOTES: previous- and next- property change will have to skip
38 zero-length intervals if they are implemented. This could be done
39 inside next_interval and previous_interval.
41 set_properties needs to deal with the interval property cache.
43 It is assumed that for any interval plist, a property appears
44 only once on the list. Although some code i.e., remove_properties,
45 handles the more general case, the uniqueness of properties is
46 necessary for the system to remain consistent. This requirement
47 is enforced by the subrs installing properties onto the intervals. */
51 Lisp_Object Qmouse_left
;
52 Lisp_Object Qmouse_entered
;
53 Lisp_Object Qpoint_left
;
54 Lisp_Object Qpoint_entered
;
55 Lisp_Object Qcategory
;
56 Lisp_Object Qlocal_map
;
58 /* Visual properties text (including strings) may have. */
59 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
60 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 Lisp_Object Vinhibit_point_motion_hooks
;
71 Lisp_Object Vdefault_text_properties
;
72 Lisp_Object Vtext_property_default_nonsticky
;
74 /* verify_interval_modification saves insertion hooks here
75 to be run later by report_interval_modification. */
76 Lisp_Object interval_insert_behind_hooks
;
77 Lisp_Object interval_insert_in_front_hooks
;
79 /* Extract the interval at the position pointed to by BEGIN from
80 OBJECT, a string or buffer. Additionally, check that the positions
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
82 reverse them if *BEGIN is greater than *END. The objects pointed
83 to by BEGIN and END may be integers or markers; if the latter, they
84 are coerced to integers.
86 When OBJECT is a string, we increment *BEGIN and *END
87 to make them origin-one.
89 Note that buffer points don't correspond to interval indices.
90 For example, point-max is 1 greater than the index of the last
91 character. This difference is handled in the caller, which uses
92 the validated points to determine a length, and operates on that.
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
94 Fprevious_property_change which call this function with BEGIN == END.
95 Handle this case specially.
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
98 create an interval tree for OBJECT if one doesn't exist, provided
99 the object actually contains text. In the current design, if there
100 is no text, there can be no text properties. */
106 validate_interval_range (object
, begin
, end
, force
)
107 Lisp_Object object
, *begin
, *end
;
113 CHECK_STRING_OR_BUFFER (object
, 0);
114 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
115 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
117 /* If we are asked for a point, but from a subr which operates
118 on a range, then return nothing. */
119 if (EQ (*begin
, *end
) && begin
!= end
)
120 return NULL_INTERVAL
;
122 if (XINT (*begin
) > XINT (*end
))
130 if (BUFFERP (object
))
132 register struct buffer
*b
= XBUFFER (object
);
134 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
135 && XINT (*end
) <= BUF_ZV (b
)))
136 args_out_of_range (*begin
, *end
);
137 i
= BUF_INTERVALS (b
);
139 /* If there's no text, there are no properties. */
140 if (BUF_BEGV (b
) == BUF_ZV (b
))
141 return NULL_INTERVAL
;
143 searchpos
= XINT (*begin
);
147 register struct Lisp_String
*s
= XSTRING (object
);
149 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
150 && XINT (*end
) <= s
->size
))
151 args_out_of_range (*begin
, *end
);
152 XSETFASTINT (*begin
, XFASTINT (*begin
));
154 XSETFASTINT (*end
, XFASTINT (*end
));
158 return NULL_INTERVAL
;
160 searchpos
= XINT (*begin
);
163 if (NULL_INTERVAL_P (i
))
164 return (force
? create_root_interval (object
) : i
);
166 return find_interval (i
, searchpos
);
169 /* Validate LIST as a property list. If LIST is not a list, then
170 make one consisting of (LIST nil). Otherwise, verify that LIST
171 is even numbered and thus suitable as a plist. */
174 validate_plist (list
)
183 register Lisp_Object tail
;
184 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
190 error ("Odd length text property list");
194 return Fcons (list
, Fcons (Qnil
, Qnil
));
197 /* Return nonzero if interval I has all the properties,
198 with the same values, of list PLIST. */
201 interval_has_all_properties (plist
, i
)
205 register Lisp_Object tail1
, tail2
, sym1
;
208 /* Go through each element of PLIST. */
209 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
214 /* Go through I's plist, looking for sym1 */
215 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
216 if (EQ (sym1
, Fcar (tail2
)))
218 /* Found the same property on both lists. If the
219 values are unequal, return zero. */
220 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
223 /* Property has same value on both lists; go to next one. */
235 /* Return nonzero if the plist of interval I has any of the
236 properties of PLIST, regardless of their values. */
239 interval_has_some_properties (plist
, i
)
243 register Lisp_Object tail1
, tail2
, sym
;
245 /* Go through each element of PLIST. */
246 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
250 /* Go through i's plist, looking for tail1 */
251 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
252 if (EQ (sym
, Fcar (tail2
)))
259 /* Changing the plists of individual intervals. */
261 /* Return the value of PROP in property-list PLIST, or Qunbound if it
264 property_value (plist
, prop
)
265 Lisp_Object plist
, prop
;
269 while (PLIST_ELT_P (plist
, value
))
270 if (EQ (XCAR (plist
), prop
))
273 plist
= XCDR (value
);
278 /* Set the properties of INTERVAL to PROPERTIES,
279 and record undo info for the previous values.
280 OBJECT is the string or buffer that INTERVAL belongs to. */
283 set_properties (properties
, interval
, object
)
284 Lisp_Object properties
, object
;
287 Lisp_Object sym
, value
;
289 if (BUFFERP (object
))
291 /* For each property in the old plist which is missing from PROPERTIES,
292 or has a different value in PROPERTIES, make an undo record. */
293 for (sym
= interval
->plist
;
294 PLIST_ELT_P (sym
, value
);
296 if (! EQ (property_value (properties
, XCAR (sym
)),
299 record_property_change (interval
->position
, LENGTH (interval
),
300 XCAR (sym
), XCAR (value
),
304 /* For each new property that has no value at all in the old plist,
305 make an undo record binding it to nil, so it will be removed. */
306 for (sym
= properties
;
307 PLIST_ELT_P (sym
, value
);
309 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
311 record_property_change (interval
->position
, LENGTH (interval
),
317 /* Store new properties. */
318 interval
->plist
= Fcopy_sequence (properties
);
321 /* Add the properties of PLIST to the interval I, or set
322 the value of I's property to the value of the property on PLIST
323 if they are different.
325 OBJECT should be the string or buffer the interval is in.
327 Return nonzero if this changes I (i.e., if any members of PLIST
328 are actually added to I's plist) */
331 add_properties (plist
, i
, object
)
336 Lisp_Object tail1
, tail2
, sym1
, val1
;
337 register int changed
= 0;
339 struct gcpro gcpro1
, gcpro2
, gcpro3
;
344 /* No need to protect OBJECT, because we can GC only in the case
345 where it is a buffer, and live buffers are always protected.
346 I and its plist are also protected, via OBJECT. */
347 GCPRO3 (tail1
, sym1
, val1
);
349 /* Go through each element of PLIST. */
350 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
353 val1
= Fcar (Fcdr (tail1
));
356 /* Go through I's plist, looking for sym1 */
357 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
358 if (EQ (sym1
, Fcar (tail2
)))
360 /* No need to gcpro, because tail2 protects this
361 and it must be a cons cell (we get an error otherwise). */
362 register Lisp_Object this_cdr
;
364 this_cdr
= Fcdr (tail2
);
365 /* Found the property. Now check its value. */
368 /* The properties have the same value on both lists.
369 Continue to the next property. */
370 if (EQ (val1
, Fcar (this_cdr
)))
373 /* Record this change in the buffer, for undo purposes. */
374 if (BUFFERP (object
))
376 record_property_change (i
->position
, LENGTH (i
),
377 sym1
, Fcar (this_cdr
), object
);
380 /* I's property has a different value -- change it */
381 Fsetcar (this_cdr
, val1
);
388 /* Record this change in the buffer, for undo purposes. */
389 if (BUFFERP (object
))
391 record_property_change (i
->position
, LENGTH (i
),
394 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
404 /* For any members of PLIST which are properties of I, remove them
406 OBJECT is the string or buffer containing I. */
409 remove_properties (plist
, i
, object
)
414 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
415 register int changed
= 0;
417 current_plist
= i
->plist
;
418 /* Go through each element of plist. */
419 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
423 /* First, remove the symbol if its at the head of the list */
424 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
426 if (BUFFERP (object
))
428 record_property_change (i
->position
, LENGTH (i
),
429 sym
, Fcar (Fcdr (current_plist
)),
433 current_plist
= Fcdr (Fcdr (current_plist
));
437 /* Go through i's plist, looking for sym */
438 tail2
= current_plist
;
439 while (! NILP (tail2
))
441 register Lisp_Object
this;
442 this = Fcdr (Fcdr (tail2
));
443 if (EQ (sym
, Fcar (this)))
445 if (BUFFERP (object
))
447 record_property_change (i
->position
, LENGTH (i
),
448 sym
, Fcar (Fcdr (this)), object
);
451 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
459 i
->plist
= current_plist
;
464 /* Remove all properties from interval I. Return non-zero
465 if this changes the interval. */
479 /* Returns the interval of POSITION in OBJECT.
480 POSITION is BEG-based. */
483 interval_of (position
, object
)
491 XSETBUFFER (object
, current_buffer
);
492 else if (EQ (object
, Qt
))
493 return NULL_INTERVAL
;
495 CHECK_STRING_OR_BUFFER (object
, 0);
497 if (BUFFERP (object
))
499 register struct buffer
*b
= XBUFFER (object
);
503 i
= BUF_INTERVALS (b
);
507 register struct Lisp_String
*s
= XSTRING (object
);
514 if (!(beg
<= position
&& position
<= end
))
515 args_out_of_range (make_number (position
), make_number (position
));
516 if (beg
== end
|| NULL_INTERVAL_P (i
))
517 return NULL_INTERVAL
;
519 return find_interval (i
, position
);
522 DEFUN ("text-properties-at", Ftext_properties_at
,
523 Stext_properties_at
, 1, 2, 0,
524 "Return the list of properties of the character at POSITION in OBJECT.\n\
525 OBJECT is the string or buffer to look for the properties in;\n\
526 nil means the current buffer.\n\
527 If POSITION is at the end of OBJECT, the value is nil.")
529 Lisp_Object position
, object
;
534 XSETBUFFER (object
, current_buffer
);
536 i
= validate_interval_range (object
, &position
, &position
, soft
);
537 if (NULL_INTERVAL_P (i
))
539 /* If POSITION is at the end of the interval,
540 it means it's the end of OBJECT.
541 There are no properties at the very end,
542 since no character follows. */
543 if (XINT (position
) == LENGTH (i
) + i
->position
)
549 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
550 "Return the value of POSITION's property PROP, in OBJECT.\n\
551 OBJECT is optional and defaults to the current buffer.\n\
552 If POSITION is at the end of OBJECT, the value is nil.")
553 (position
, prop
, object
)
554 Lisp_Object position
, object
;
557 return textget (Ftext_properties_at (position
, object
), prop
);
560 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
561 "Return the value of POSITION's property PROP, in OBJECT.\n\
562 OBJECT is optional and defaults to the current buffer.\n\
563 If POSITION is at the end of OBJECT, the value is nil.\n\
564 If OBJECT is a buffer, then overlay properties are considered as well as\n\
566 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
567 overlays are considered only if they are associated with OBJECT.")
568 (position
, prop
, object
)
569 Lisp_Object position
, object
;
570 register Lisp_Object prop
;
572 struct window
*w
= 0;
574 CHECK_NUMBER_COERCE_MARKER (position
, 0);
577 XSETBUFFER (object
, current_buffer
);
579 if (WINDOWP (object
))
581 w
= XWINDOW (object
);
584 if (BUFFERP (object
))
586 int posn
= XINT (position
);
588 Lisp_Object
*overlay_vec
, tem
;
591 struct buffer
*obuf
= current_buffer
;
593 set_buffer_temp (XBUFFER (object
));
595 /* First try with room for 40 overlays. */
597 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
599 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
600 &next_overlay
, NULL
);
602 /* If there are more than 40,
603 make enough space for all, and try again. */
607 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
608 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
609 &next_overlay
, NULL
);
611 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
613 set_buffer_temp (obuf
);
615 /* Now check the overlays in order of decreasing priority. */
616 while (--noverlays
>= 0)
618 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
623 /* Not a buffer, or no appropriate overlay, so fall through to the
625 return (Fget_text_property (position
, prop
, object
));
628 DEFUN ("next-char-property-change", Fnext_char_property_change
,
629 Snext_char_property_change
, 1, 2, 0,
630 "Return the position of next text property or overlay change.\n\
631 This scans characters forward from POSITION in OBJECT till it finds\n\
632 a change in some text property, or the beginning or end of an overlay,\n\
633 and returns the position of that.\n\
634 If none is found, the function returns (point-max).\n\
636 If the optional third argument LIMIT is non-nil, don't search\n\
637 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
639 Lisp_Object position
, limit
;
643 temp
= Fnext_overlay_change (position
);
646 CHECK_NUMBER (limit
, 2);
647 if (XINT (limit
) < XINT (temp
))
650 return Fnext_property_change (position
, Qnil
, temp
);
653 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
654 Sprevious_char_property_change
, 1, 2, 0,
655 "Return the position of previous text property or overlay change.\n\
656 Scans characters backward from POSITION in OBJECT till it finds\n\
657 a change in some text property, or the beginning or end of an overlay,\n\
658 and returns the position of that.\n\
659 If none is found, the function returns (point-max).\n\
661 If the optional third argument LIMIT is non-nil, don't search\n\
662 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
664 Lisp_Object position
, limit
;
668 temp
= Fprevious_overlay_change (position
);
671 CHECK_NUMBER (limit
, 2);
672 if (XINT (limit
) > XINT (temp
))
675 return Fprevious_property_change (position
, Qnil
, temp
);
679 /* Value is the position in OBJECT after POS where the value of
680 property PROP changes. OBJECT must be a string or buffer. If
681 OBJECT is nil, use the current buffer. LIMIT if not nil limits the
685 next_single_char_property_change (pos
, prop
, object
, limit
)
686 Lisp_Object prop
, pos
, object
, limit
;
688 if (STRINGP (object
))
690 pos
= Fnext_single_property_change (pos
, prop
, object
, limit
);
694 pos
= make_number (XSTRING (object
)->size
);
701 Lisp_Object initial_value
, value
;
702 struct buffer
*old_current_buffer
= NULL
;
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 (&Qfront_sticky
);
1874 Qfront_sticky
= intern ("front-sticky");
1875 staticpro (&Qrear_nonsticky
);
1876 Qrear_nonsticky
= intern ("rear-nonsticky");
1877 staticpro (&Qmouse_face
);
1878 Qmouse_face
= intern ("mouse-face");
1880 /* Properties that text might use to specify certain actions */
1882 staticpro (&Qmouse_left
);
1883 Qmouse_left
= intern ("mouse-left");
1884 staticpro (&Qmouse_entered
);
1885 Qmouse_entered
= intern ("mouse-entered");
1886 staticpro (&Qpoint_left
);
1887 Qpoint_left
= intern ("point-left");
1888 staticpro (&Qpoint_entered
);
1889 Qpoint_entered
= intern ("point-entered");
1891 defsubr (&Stext_properties_at
);
1892 defsubr (&Sget_text_property
);
1893 defsubr (&Sget_char_property
);
1894 defsubr (&Snext_char_property_change
);
1895 defsubr (&Sprevious_char_property_change
);
1896 defsubr (&Snext_property_change
);
1897 defsubr (&Snext_single_property_change
);
1898 defsubr (&Sprevious_property_change
);
1899 defsubr (&Sprevious_single_property_change
);
1900 defsubr (&Sadd_text_properties
);
1901 defsubr (&Sput_text_property
);
1902 defsubr (&Sset_text_properties
);
1903 defsubr (&Sremove_text_properties
);
1904 defsubr (&Stext_property_any
);
1905 defsubr (&Stext_property_not_all
);
1906 /* defsubr (&Serase_text_properties); */
1907 /* defsubr (&Scopy_text_properties); */