1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include "intervals.h"
28 #define NULL (void *)0
31 /* Test for membership, allowing for t (actually any non-cons) to mean the
34 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
37 /* NOTES: previous- and next- property change will have to skip
38 zero-length intervals if they are implemented. This could be done
39 inside next_interval and previous_interval.
41 set_properties needs to deal with the interval property cache.
43 It is assumed that for any interval plist, a property appears
44 only once on the list. Although some code i.e., remove_properties,
45 handles the more general case, the uniqueness of properties is
46 necessary for the system to remain consistent. This requirement
47 is enforced by the subrs installing properties onto the intervals. */
51 Lisp_Object Qmouse_left
;
52 Lisp_Object Qmouse_entered
;
53 Lisp_Object Qpoint_left
;
54 Lisp_Object Qpoint_entered
;
55 Lisp_Object Qcategory
;
56 Lisp_Object Qlocal_map
;
58 /* Visual properties text (including strings) may have. */
59 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
60 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 Lisp_Object Vinhibit_point_motion_hooks
;
71 Lisp_Object Vdefault_text_properties
;
72 Lisp_Object Vtext_property_default_nonsticky
;
74 /* verify_interval_modification saves insertion hooks here
75 to be run later by report_interval_modification. */
76 Lisp_Object interval_insert_behind_hooks
;
77 Lisp_Object interval_insert_in_front_hooks
;
79 /* Extract the interval at the position pointed to by BEGIN from
80 OBJECT, a string or buffer. Additionally, check that the positions
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
82 reverse them if *BEGIN is greater than *END. The objects pointed
83 to by BEGIN and END may be integers or markers; if the latter, they
84 are coerced to integers.
86 When OBJECT is a string, we increment *BEGIN and *END
87 to make them origin-one.
89 Note that buffer points don't correspond to interval indices.
90 For example, point-max is 1 greater than the index of the last
91 character. This difference is handled in the caller, which uses
92 the validated points to determine a length, and operates on that.
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
94 Fprevious_property_change which call this function with BEGIN == END.
95 Handle this case specially.
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
98 create an interval tree for OBJECT if one doesn't exist, provided
99 the object actually contains text. In the current design, if there
100 is no text, there can be no text properties. */
106 validate_interval_range (object
, begin
, end
, force
)
107 Lisp_Object object
, *begin
, *end
;
113 CHECK_STRING_OR_BUFFER (object
, 0);
114 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
115 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
117 /* If we are asked for a point, but from a subr which operates
118 on a range, then return nothing. */
119 if (EQ (*begin
, *end
) && begin
!= end
)
120 return NULL_INTERVAL
;
122 if (XINT (*begin
) > XINT (*end
))
130 if (BUFFERP (object
))
132 register struct buffer
*b
= XBUFFER (object
);
134 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
135 && XINT (*end
) <= BUF_ZV (b
)))
136 args_out_of_range (*begin
, *end
);
137 i
= BUF_INTERVALS (b
);
139 /* If there's no text, there are no properties. */
140 if (BUF_BEGV (b
) == BUF_ZV (b
))
141 return NULL_INTERVAL
;
143 searchpos
= XINT (*begin
);
147 register struct Lisp_String
*s
= XSTRING (object
);
149 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
150 && XINT (*end
) <= s
->size
))
151 args_out_of_range (*begin
, *end
);
152 XSETFASTINT (*begin
, XFASTINT (*begin
));
154 XSETFASTINT (*end
, XFASTINT (*end
));
158 return NULL_INTERVAL
;
160 searchpos
= XINT (*begin
);
163 if (NULL_INTERVAL_P (i
))
164 return (force
? create_root_interval (object
) : i
);
166 return find_interval (i
, searchpos
);
169 /* Validate LIST as a property list. If LIST is not a list, then
170 make one consisting of (LIST nil). Otherwise, verify that LIST
171 is even numbered and thus suitable as a plist. */
174 validate_plist (list
)
183 register Lisp_Object tail
;
184 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
190 error ("Odd length text property list");
194 return Fcons (list
, Fcons (Qnil
, Qnil
));
197 /* Return nonzero if interval I has all the properties,
198 with the same values, of list PLIST. */
201 interval_has_all_properties (plist
, i
)
205 register Lisp_Object tail1
, tail2
, sym1
;
208 /* Go through each element of PLIST. */
209 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
214 /* Go through I's plist, looking for sym1 */
215 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
216 if (EQ (sym1
, Fcar (tail2
)))
218 /* Found the same property on both lists. If the
219 values are unequal, return zero. */
220 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
223 /* Property has same value on both lists; go to next one. */
235 /* Return nonzero if the plist of interval I has any of the
236 properties of PLIST, regardless of their values. */
239 interval_has_some_properties (plist
, i
)
243 register Lisp_Object tail1
, tail2
, sym
;
245 /* Go through each element of PLIST. */
246 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
250 /* Go through i's plist, looking for tail1 */
251 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
252 if (EQ (sym
, Fcar (tail2
)))
259 /* Changing the plists of individual intervals. */
261 /* Return the value of PROP in property-list PLIST, or Qunbound if it
264 property_value (plist
, prop
)
265 Lisp_Object plist
, prop
;
269 while (PLIST_ELT_P (plist
, value
))
270 if (EQ (XCAR (plist
), prop
))
273 plist
= XCDR (value
);
278 /* Set the properties of INTERVAL to PROPERTIES,
279 and record undo info for the previous values.
280 OBJECT is the string or buffer that INTERVAL belongs to. */
283 set_properties (properties
, interval
, object
)
284 Lisp_Object properties
, object
;
287 Lisp_Object sym
, value
;
289 if (BUFFERP (object
))
291 /* For each property in the old plist which is missing from PROPERTIES,
292 or has a different value in PROPERTIES, make an undo record. */
293 for (sym
= interval
->plist
;
294 PLIST_ELT_P (sym
, value
);
296 if (! EQ (property_value (properties
, XCAR (sym
)),
299 record_property_change (interval
->position
, LENGTH (interval
),
300 XCAR (sym
), XCAR (value
),
304 /* For each new property that has no value at all in the old plist,
305 make an undo record binding it to nil, so it will be removed. */
306 for (sym
= properties
;
307 PLIST_ELT_P (sym
, value
);
309 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
311 record_property_change (interval
->position
, LENGTH (interval
),
317 /* Store new properties. */
318 interval
->plist
= Fcopy_sequence (properties
);
321 /* Add the properties of PLIST to the interval I, or set
322 the value of I's property to the value of the property on PLIST
323 if they are different.
325 OBJECT should be the string or buffer the interval is in.
327 Return nonzero if this changes I (i.e., if any members of PLIST
328 are actually added to I's plist) */
331 add_properties (plist
, i
, object
)
336 Lisp_Object tail1
, tail2
, sym1
, val1
;
337 register int changed
= 0;
339 struct gcpro gcpro1
, gcpro2
, gcpro3
;
344 /* No need to protect OBJECT, because we can GC only in the case
345 where it is a buffer, and live buffers are always protected.
346 I and its plist are also protected, via OBJECT. */
347 GCPRO3 (tail1
, sym1
, val1
);
349 /* Go through each element of PLIST. */
350 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
353 val1
= Fcar (Fcdr (tail1
));
356 /* Go through I's plist, looking for sym1 */
357 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
358 if (EQ (sym1
, Fcar (tail2
)))
360 /* No need to gcpro, because tail2 protects this
361 and it must be a cons cell (we get an error otherwise). */
362 register Lisp_Object this_cdr
;
364 this_cdr
= Fcdr (tail2
);
365 /* Found the property. Now check its value. */
368 /* The properties have the same value on both lists.
369 Continue to the next property. */
370 if (EQ (val1
, Fcar (this_cdr
)))
373 /* Record this change in the buffer, for undo purposes. */
374 if (BUFFERP (object
))
376 record_property_change (i
->position
, LENGTH (i
),
377 sym1
, Fcar (this_cdr
), object
);
380 /* I's property has a different value -- change it */
381 Fsetcar (this_cdr
, val1
);
388 /* Record this change in the buffer, for undo purposes. */
389 if (BUFFERP (object
))
391 record_property_change (i
->position
, LENGTH (i
),
394 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
404 /* For any members of PLIST which are properties of I, remove them
406 OBJECT is the string or buffer containing I. */
409 remove_properties (plist
, i
, object
)
414 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
415 register int changed
= 0;
417 current_plist
= i
->plist
;
418 /* Go through each element of plist. */
419 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
423 /* First, remove the symbol if its at the head of the list */
424 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
426 if (BUFFERP (object
))
428 record_property_change (i
->position
, LENGTH (i
),
429 sym
, Fcar (Fcdr (current_plist
)),
433 current_plist
= Fcdr (Fcdr (current_plist
));
437 /* Go through i's plist, looking for sym */
438 tail2
= current_plist
;
439 while (! NILP (tail2
))
441 register Lisp_Object
this;
442 this = Fcdr (Fcdr (tail2
));
443 if (EQ (sym
, Fcar (this)))
445 if (BUFFERP (object
))
447 record_property_change (i
->position
, LENGTH (i
),
448 sym
, Fcar (Fcdr (this)), object
);
451 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
459 i
->plist
= current_plist
;
464 /* Remove all properties from interval I. Return non-zero
465 if this changes the interval. */
479 /* Returns the interval of POSITION in OBJECT.
480 POSITION is BEG-based. */
483 interval_of (position
, object
)
491 XSETBUFFER (object
, current_buffer
);
492 else if (EQ (object
, Qt
))
493 return NULL_INTERVAL
;
495 CHECK_STRING_OR_BUFFER (object
, 0);
497 if (BUFFERP (object
))
499 register struct buffer
*b
= XBUFFER (object
);
503 i
= BUF_INTERVALS (b
);
507 register struct Lisp_String
*s
= XSTRING (object
);
514 if (!(beg
<= position
&& position
<= end
))
515 args_out_of_range (make_number (position
), make_number (position
));
516 if (beg
== end
|| NULL_INTERVAL_P (i
))
517 return NULL_INTERVAL
;
519 return find_interval (i
, position
);
522 DEFUN ("text-properties-at", Ftext_properties_at
,
523 Stext_properties_at
, 1, 2, 0,
524 "Return the list of properties of the character at POSITION in OBJECT.\n\
525 OBJECT is the string or buffer to look for the properties in;\n\
526 nil means the current buffer.\n\
527 If POSITION is at the end of OBJECT, the value is nil.")
529 Lisp_Object position
, object
;
534 XSETBUFFER (object
, current_buffer
);
536 i
= validate_interval_range (object
, &position
, &position
, soft
);
537 if (NULL_INTERVAL_P (i
))
539 /* If POSITION is at the end of the interval,
540 it means it's the end of OBJECT.
541 There are no properties at the very end,
542 since no character follows. */
543 if (XINT (position
) == LENGTH (i
) + i
->position
)
549 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
550 "Return the value of POSITION's property PROP, in OBJECT.\n\
551 OBJECT is optional and defaults to the current buffer.\n\
552 If POSITION is at the end of OBJECT, the value is nil.")
553 (position
, prop
, object
)
554 Lisp_Object position
, object
;
557 return textget (Ftext_properties_at (position
, object
), prop
);
560 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
561 "Return the value of POSITION's property PROP, in OBJECT.\n\
562 OBJECT is optional and defaults to the current buffer.\n\
563 If POSITION is at the end of OBJECT, the value is nil.\n\
564 If OBJECT is a buffer, then overlay properties are considered as well as\n\
566 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
567 overlays are considered only if they are associated with OBJECT.")
568 (position
, prop
, object
)
569 Lisp_Object position
, object
;
570 register Lisp_Object prop
;
572 struct window
*w
= 0;
574 CHECK_NUMBER_COERCE_MARKER (position
, 0);
577 XSETBUFFER (object
, current_buffer
);
579 if (WINDOWP (object
))
581 w
= XWINDOW (object
);
584 if (BUFFERP (object
))
586 int posn
= XINT (position
);
588 Lisp_Object
*overlay_vec
, tem
;
591 struct buffer
*obuf
= current_buffer
;
593 set_buffer_temp (XBUFFER (object
));
595 /* First try with room for 40 overlays. */
597 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
599 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
600 &next_overlay
, NULL
);
602 /* If there are more than 40,
603 make enough space for all, and try again. */
607 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
608 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
609 &next_overlay
, NULL
);
611 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
613 set_buffer_temp (obuf
);
615 /* Now check the overlays in order of decreasing priority. */
616 while (--noverlays
>= 0)
618 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
623 /* Not a buffer, or no appropriate overlay, so fall through to the
625 return (Fget_text_property (position
, prop
, object
));
628 DEFUN ("next-char-property-change", Fnext_char_property_change
,
629 Snext_char_property_change
, 1, 2, 0,
630 "Return the position of next text property or overlay change.\n\
631 This scans characters forward from POSITION in OBJECT till it finds\n\
632 a change in some text property, or the beginning or end of an overlay,\n\
633 and returns the position of that.\n\
634 If none is found, the function returns (point-max).\n\
636 If the optional third argument LIMIT is non-nil, don't search\n\
637 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
639 Lisp_Object position
, limit
;
643 temp
= Fnext_overlay_change (position
);
646 CHECK_NUMBER (limit
, 2);
647 if (XINT (limit
) < XINT (temp
))
650 return Fnext_property_change (position
, Qnil
, temp
);
653 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
654 Sprevious_char_property_change
, 1, 2, 0,
655 "Return the position of previous text property or overlay change.\n\
656 Scans characters backward from POSITION in OBJECT till it finds\n\
657 a change in some text property, or the beginning or end of an overlay,\n\
658 and returns the position of that.\n\
659 If none is found, the function returns (point-max).\n\
661 If the optional third argument LIMIT is non-nil, don't search\n\
662 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
664 Lisp_Object position
, limit
;
668 temp
= Fprevious_overlay_change (position
);
671 CHECK_NUMBER (limit
, 2);
672 if (XINT (limit
) > XINT (temp
))
675 return Fprevious_property_change (position
, Qnil
, temp
);
679 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
680 Snext_single_char_property_change
, 2, 4, 0,
681 "Return the position of next text property or overlay change for a specific property.\n\
682 Scans characters forward from POSITION till it finds\n\
683 a change in the PROP property, then returns the position of the change.\n\
684 The optional third argument OBJECT is the string or buffer to scan.\n\
685 The property values are compared with `eq'.\n\
686 Return nil if the property is constant all the way to the end of OBJECT.\n\
687 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
688 If the optional fourth argument LIMIT is non-nil, don't search\n\
689 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
690 (position
, prop
, object
, limit
)
691 Lisp_Object prop
, position
, object
, limit
;
693 if (STRINGP (object
))
695 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
699 position
= make_number (XSTRING (object
)->size
);
706 Lisp_Object initial_value
, value
;
707 int count
= specpdl_ptr
- specpdl
;
710 CHECK_BUFFER (object
, 0);
712 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
714 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
715 Fset_buffer (object
);
718 initial_value
= Fget_char_property (position
, prop
, object
);
721 XSETFASTINT (limit
, BUF_ZV (current_buffer
));
723 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
727 position
= Fnext_char_property_change (position
, limit
);
728 if (XFASTINT (position
) >= XFASTINT (limit
)) {
733 value
= Fget_char_property (position
, prop
, object
);
734 if (!EQ (value
, initial_value
))
738 unbind_to (count
, Qnil
);
744 DEFUN ("previous-single-char-property-change",
745 Fprevious_single_char_property_change
,
746 Sprevious_single_char_property_change
, 2, 4, 0,
747 "Return the position of previous text property or overlay change for a specific property.\n\
748 Scans characters backward from POSITION till it finds\n\
749 a change in the PROP property, then returns the position of the change.\n\
750 The optional third argument OBJECT is the string or buffer to scan.\n\
751 The property values are compared with `eq'.\n\
752 Return nil if the property is constant all the way to the start of OBJECT.\n\
753 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
754 If the optional fourth argument LIMIT is non-nil, don't search\n\
755 back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
756 (position
, prop
, object
, limit
)
757 Lisp_Object prop
, position
, object
, limit
;
759 if (STRINGP (object
))
761 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
765 position
= make_number (XSTRING (object
)->size
);
772 int count
= specpdl_ptr
- specpdl
;
775 CHECK_BUFFER (object
, 0);
777 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
779 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
780 Fset_buffer (object
);
784 XSETFASTINT (limit
, BUF_BEGV (current_buffer
));
786 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
788 if (XFASTINT (position
) <= XFASTINT (limit
))
792 Lisp_Object initial_value
=
793 Fget_char_property (position
- 1, prop
, object
);
797 position
= Fprevious_char_property_change (position
, limit
);
799 if (XFASTINT (position
) <= XFASTINT (limit
))
807 Fget_char_property (position
- 1, prop
, object
);
809 if (!EQ (value
, initial_value
))
815 unbind_to (count
, Qnil
);
821 DEFUN ("next-property-change", Fnext_property_change
,
822 Snext_property_change
, 1, 3, 0,
823 "Return the position of next property change.\n\
824 Scans characters forward from POSITION in OBJECT till it finds\n\
825 a change in some text property, then returns the position of the change.\n\
826 The optional second argument OBJECT is the string or buffer to scan.\n\
827 Return nil if the property is constant all the way to the end of OBJECT.\n\
828 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
829 If the optional third argument LIMIT is non-nil, don't search\n\
830 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
831 (position
, object
, limit
)
832 Lisp_Object position
, object
, limit
;
834 register INTERVAL i
, next
;
837 XSETBUFFER (object
, current_buffer
);
839 if (! NILP (limit
) && ! EQ (limit
, Qt
))
840 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
842 i
= validate_interval_range (object
, &position
, &position
, soft
);
844 /* If LIMIT is t, return start of next interval--don't
845 bother checking further intervals. */
848 if (NULL_INTERVAL_P (i
))
851 next
= next_interval (i
);
853 if (NULL_INTERVAL_P (next
))
854 XSETFASTINT (position
, (STRINGP (object
)
855 ? XSTRING (object
)->size
856 : BUF_ZV (XBUFFER (object
))));
858 XSETFASTINT (position
, next
->position
);
862 if (NULL_INTERVAL_P (i
))
865 next
= next_interval (i
);
867 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
868 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
869 next
= next_interval (next
);
871 if (NULL_INTERVAL_P (next
))
873 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
876 XSETFASTINT (position
, next
->position
);
880 /* Return 1 if there's a change in some property between BEG and END. */
883 property_change_between_p (beg
, end
)
886 register INTERVAL i
, next
;
887 Lisp_Object object
, pos
;
889 XSETBUFFER (object
, current_buffer
);
890 XSETFASTINT (pos
, beg
);
892 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
893 if (NULL_INTERVAL_P (i
))
896 next
= next_interval (i
);
897 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
899 next
= next_interval (next
);
900 if (NULL_INTERVAL_P (next
))
902 if (next
->position
>= end
)
906 if (NULL_INTERVAL_P (next
))
912 DEFUN ("next-single-property-change", Fnext_single_property_change
,
913 Snext_single_property_change
, 2, 4, 0,
914 "Return the position of next property change for a specific property.\n\
915 Scans characters forward from POSITION till it finds\n\
916 a change in the PROP property, then returns the position of the change.\n\
917 The optional third argument OBJECT is the string or buffer to scan.\n\
918 The property values are compared with `eq'.\n\
919 Return nil if the property is constant all the way to the end of OBJECT.\n\
920 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
921 If the optional fourth argument LIMIT is non-nil, don't search\n\
922 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
923 (position
, prop
, object
, limit
)
924 Lisp_Object position
, prop
, object
, limit
;
926 register INTERVAL i
, next
;
927 register Lisp_Object here_val
;
930 XSETBUFFER (object
, current_buffer
);
933 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
935 i
= validate_interval_range (object
, &position
, &position
, soft
);
936 if (NULL_INTERVAL_P (i
))
939 here_val
= textget (i
->plist
, prop
);
940 next
= next_interval (i
);
941 while (! NULL_INTERVAL_P (next
)
942 && EQ (here_val
, textget (next
->plist
, prop
))
943 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
944 next
= next_interval (next
);
946 if (NULL_INTERVAL_P (next
))
948 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
951 return make_number (next
->position
);
954 DEFUN ("previous-property-change", Fprevious_property_change
,
955 Sprevious_property_change
, 1, 3, 0,
956 "Return the position of previous property change.\n\
957 Scans characters backwards from POSITION in OBJECT till it finds\n\
958 a change in some text property, then returns the position of the change.\n\
959 The optional second argument OBJECT is the string or buffer to scan.\n\
960 Return nil if the property is constant all the way to the start of OBJECT.\n\
961 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
962 If the optional third argument LIMIT is non-nil, don't search\n\
963 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
964 (position
, object
, limit
)
965 Lisp_Object position
, object
, limit
;
967 register INTERVAL i
, previous
;
970 XSETBUFFER (object
, current_buffer
);
973 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
975 i
= validate_interval_range (object
, &position
, &position
, soft
);
976 if (NULL_INTERVAL_P (i
))
979 /* Start with the interval containing the char before point. */
980 if (i
->position
== XFASTINT (position
))
981 i
= previous_interval (i
);
983 previous
= previous_interval (i
);
984 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
986 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
987 previous
= previous_interval (previous
);
988 if (NULL_INTERVAL_P (previous
))
991 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
994 return make_number (previous
->position
+ LENGTH (previous
));
997 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
998 Sprevious_single_property_change
, 2, 4, 0,
999 "Return the position of previous property change for a specific property.\n\
1000 Scans characters backward from POSITION till it finds\n\
1001 a change in the PROP property, then returns the position of the change.\n\
1002 The optional third argument OBJECT is the string or buffer to scan.\n\
1003 The property values are compared with `eq'.\n\
1004 Return nil if the property is constant all the way to the start of OBJECT.\n\
1005 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
1006 If the optional fourth argument LIMIT is non-nil, don't search\n\
1007 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
1008 (position
, prop
, object
, limit
)
1009 Lisp_Object position
, prop
, object
, limit
;
1011 register INTERVAL i
, previous
;
1012 register Lisp_Object here_val
;
1015 XSETBUFFER (object
, current_buffer
);
1018 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
1020 i
= validate_interval_range (object
, &position
, &position
, soft
);
1022 /* Start with the interval containing the char before point. */
1023 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1024 i
= previous_interval (i
);
1026 if (NULL_INTERVAL_P (i
))
1029 here_val
= textget (i
->plist
, prop
);
1030 previous
= previous_interval (i
);
1031 while (! NULL_INTERVAL_P (previous
)
1032 && EQ (here_val
, textget (previous
->plist
, prop
))
1034 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1035 previous
= previous_interval (previous
);
1036 if (NULL_INTERVAL_P (previous
))
1039 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1042 return make_number (previous
->position
+ LENGTH (previous
));
1045 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1047 DEFUN ("add-text-properties", Fadd_text_properties
,
1048 Sadd_text_properties
, 3, 4, 0,
1049 "Add properties to the text from START to END.\n\
1050 The third argument PROPERTIES is a property list\n\
1051 specifying the property values to add.\n\
1052 The optional fourth argument, OBJECT,\n\
1053 is the string or buffer containing the text.\n\
1054 Return t if any property value actually changed, nil otherwise.")
1055 (start
, end
, properties
, object
)
1056 Lisp_Object start
, end
, properties
, object
;
1058 register INTERVAL i
, unchanged
;
1059 register int s
, len
, modified
= 0;
1060 struct gcpro gcpro1
;
1062 properties
= validate_plist (properties
);
1063 if (NILP (properties
))
1067 XSETBUFFER (object
, current_buffer
);
1069 i
= validate_interval_range (object
, &start
, &end
, hard
);
1070 if (NULL_INTERVAL_P (i
))
1074 len
= XINT (end
) - s
;
1076 /* No need to protect OBJECT, because we GC only if it's a buffer,
1077 and live buffers are always protected. */
1078 GCPRO1 (properties
);
1080 /* If we're not starting on an interval boundary, we have to
1081 split this interval. */
1082 if (i
->position
!= s
)
1084 /* If this interval already has the properties, we can
1086 if (interval_has_all_properties (properties
, i
))
1088 int got
= (LENGTH (i
) - (s
- i
->position
));
1090 RETURN_UNGCPRO (Qnil
);
1092 i
= next_interval (i
);
1097 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1098 copy_properties (unchanged
, i
);
1102 if (BUFFERP (object
))
1103 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1105 /* We are at the beginning of interval I, with LEN chars to scan. */
1111 if (LENGTH (i
) >= len
)
1113 /* We can UNGCPRO safely here, because there will be just
1114 one more chance to gc, in the next call to add_properties,
1115 and after that we will not need PROPERTIES or OBJECT again. */
1118 if (interval_has_all_properties (properties
, i
))
1120 if (BUFFERP (object
))
1121 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1122 XINT (end
) - XINT (start
));
1124 return modified
? Qt
: Qnil
;
1127 if (LENGTH (i
) == len
)
1129 add_properties (properties
, i
, object
);
1130 if (BUFFERP (object
))
1131 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1132 XINT (end
) - XINT (start
));
1136 /* i doesn't have the properties, and goes past the change limit */
1138 i
= split_interval_left (unchanged
, len
);
1139 copy_properties (unchanged
, i
);
1140 add_properties (properties
, i
, object
);
1141 if (BUFFERP (object
))
1142 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1143 XINT (end
) - XINT (start
));
1148 modified
+= add_properties (properties
, i
, object
);
1149 i
= next_interval (i
);
1153 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1155 DEFUN ("put-text-property", Fput_text_property
,
1156 Sput_text_property
, 4, 5, 0,
1157 "Set one property of the text from START to END.\n\
1158 The third and fourth arguments PROPERTY and VALUE\n\
1159 specify the property to add.\n\
1160 The optional fifth argument, OBJECT,\n\
1161 is the string or buffer containing the text.")
1162 (start
, end
, property
, value
, object
)
1163 Lisp_Object start
, end
, property
, value
, object
;
1165 Fadd_text_properties (start
, end
,
1166 Fcons (property
, Fcons (value
, Qnil
)),
1171 DEFUN ("set-text-properties", Fset_text_properties
,
1172 Sset_text_properties
, 3, 4, 0,
1173 "Completely replace properties of text from START to END.\n\
1174 The third argument PROPERTIES is the new property list.\n\
1175 The optional fourth argument, OBJECT,\n\
1176 is the string or buffer containing the text.")
1177 (start
, end
, properties
, object
)
1178 Lisp_Object start
, end
, properties
, object
;
1180 return set_text_properties (start
, end
, properties
, object
, Qt
);
1184 /* Replace properties of text from START to END with new list of
1185 properties PROPERTIES. OBJECT is the buffer or string containing
1186 the text. OBJECT nil means use the current buffer.
1187 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1188 is non-nil if properties were replaced; it is nil if there weren't
1189 any properties to replace. */
1192 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1193 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1195 register INTERVAL i
, unchanged
;
1196 register INTERVAL prev_changed
= NULL_INTERVAL
;
1197 register int s
, len
;
1198 Lisp_Object ostart
, oend
;
1203 properties
= validate_plist (properties
);
1206 XSETBUFFER (object
, current_buffer
);
1208 /* If we want no properties for a whole string,
1209 get rid of its intervals. */
1210 if (NILP (properties
) && STRINGP (object
)
1211 && XFASTINT (start
) == 0
1212 && XFASTINT (end
) == XSTRING (object
)->size
)
1214 if (! XSTRING (object
)->intervals
)
1217 XSTRING (object
)->intervals
= 0;
1221 i
= validate_interval_range (object
, &start
, &end
, soft
);
1223 if (NULL_INTERVAL_P (i
))
1225 /* If buffer has no properties, and we want none, return now. */
1226 if (NILP (properties
))
1229 /* Restore the original START and END values
1230 because validate_interval_range increments them for strings. */
1234 i
= validate_interval_range (object
, &start
, &end
, hard
);
1235 /* This can return if start == end. */
1236 if (NULL_INTERVAL_P (i
))
1241 len
= XINT (end
) - s
;
1243 if (BUFFERP (object
))
1244 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1246 if (i
->position
!= s
)
1249 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1251 if (LENGTH (i
) > len
)
1253 copy_properties (unchanged
, i
);
1254 i
= split_interval_left (i
, len
);
1255 set_properties (properties
, i
, object
);
1256 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1257 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1258 XINT (end
) - XINT (start
));
1263 set_properties (properties
, i
, object
);
1265 if (LENGTH (i
) == len
)
1267 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1268 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1269 XINT (end
) - XINT (start
));
1276 i
= next_interval (i
);
1279 /* We are starting at the beginning of an interval, I */
1285 if (LENGTH (i
) >= len
)
1287 if (LENGTH (i
) > len
)
1288 i
= split_interval_left (i
, len
);
1290 /* We have to call set_properties even if we are going to
1291 merge the intervals, so as to make the undo records
1292 and cause redisplay to happen. */
1293 set_properties (properties
, i
, object
);
1294 if (!NULL_INTERVAL_P (prev_changed
))
1295 merge_interval_left (i
);
1296 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1297 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1298 XINT (end
) - XINT (start
));
1304 /* We have to call set_properties even if we are going to
1305 merge the intervals, so as to make the undo records
1306 and cause redisplay to happen. */
1307 set_properties (properties
, i
, object
);
1308 if (NULL_INTERVAL_P (prev_changed
))
1311 prev_changed
= i
= merge_interval_left (i
);
1313 i
= next_interval (i
);
1316 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1317 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1318 XINT (end
) - XINT (start
));
1322 DEFUN ("remove-text-properties", Fremove_text_properties
,
1323 Sremove_text_properties
, 3, 4, 0,
1324 "Remove some properties from text from START to END.\n\
1325 The third argument PROPERTIES is a property list\n\
1326 whose property names specify the properties to remove.\n\
1327 \(The values stored in PROPERTIES are ignored.)\n\
1328 The optional fourth argument, OBJECT,\n\
1329 is the string or buffer containing the text.\n\
1330 Return t if any property was actually removed, nil otherwise.")
1331 (start
, end
, properties
, object
)
1332 Lisp_Object start
, end
, properties
, object
;
1334 register INTERVAL i
, unchanged
;
1335 register int s
, len
, modified
= 0;
1338 XSETBUFFER (object
, current_buffer
);
1340 i
= validate_interval_range (object
, &start
, &end
, soft
);
1341 if (NULL_INTERVAL_P (i
))
1345 len
= XINT (end
) - s
;
1347 if (i
->position
!= s
)
1349 /* No properties on this first interval -- return if
1350 it covers the entire region. */
1351 if (! interval_has_some_properties (properties
, i
))
1353 int got
= (LENGTH (i
) - (s
- i
->position
));
1357 i
= next_interval (i
);
1359 /* Split away the beginning of this interval; what we don't
1364 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1365 copy_properties (unchanged
, i
);
1369 if (BUFFERP (object
))
1370 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1372 /* We are at the beginning of an interval, with len to scan */
1378 if (LENGTH (i
) >= len
)
1380 if (! interval_has_some_properties (properties
, i
))
1381 return modified
? Qt
: Qnil
;
1383 if (LENGTH (i
) == len
)
1385 remove_properties (properties
, i
, object
);
1386 if (BUFFERP (object
))
1387 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1388 XINT (end
) - XINT (start
));
1392 /* i has the properties, and goes past the change limit */
1394 i
= split_interval_left (i
, len
);
1395 copy_properties (unchanged
, i
);
1396 remove_properties (properties
, i
, object
);
1397 if (BUFFERP (object
))
1398 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1399 XINT (end
) - XINT (start
));
1404 modified
+= remove_properties (properties
, i
, object
);
1405 i
= next_interval (i
);
1409 DEFUN ("text-property-any", Ftext_property_any
,
1410 Stext_property_any
, 4, 5, 0,
1411 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1412 If so, return the position of the first character whose property PROPERTY\n\
1413 is `eq' to VALUE. Otherwise return nil.\n\
1414 The optional fifth argument, OBJECT, is the string or buffer\n\
1415 containing the text.")
1416 (start
, end
, property
, value
, object
)
1417 Lisp_Object start
, end
, property
, value
, object
;
1419 register INTERVAL i
;
1420 register int e
, pos
;
1423 XSETBUFFER (object
, current_buffer
);
1424 i
= validate_interval_range (object
, &start
, &end
, soft
);
1425 if (NULL_INTERVAL_P (i
))
1426 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1429 while (! NULL_INTERVAL_P (i
))
1431 if (i
->position
>= e
)
1433 if (EQ (textget (i
->plist
, property
), value
))
1436 if (pos
< XINT (start
))
1438 return make_number (pos
);
1440 i
= next_interval (i
);
1445 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1446 Stext_property_not_all
, 4, 5, 0,
1447 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1448 If so, return the position of the first character whose property PROPERTY\n\
1449 is not `eq' to VALUE. Otherwise, return nil.\n\
1450 The optional fifth argument, OBJECT, is the string or buffer\n\
1451 containing the text.")
1452 (start
, end
, property
, value
, object
)
1453 Lisp_Object start
, end
, property
, value
, object
;
1455 register INTERVAL i
;
1459 XSETBUFFER (object
, current_buffer
);
1460 i
= validate_interval_range (object
, &start
, &end
, soft
);
1461 if (NULL_INTERVAL_P (i
))
1462 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1466 while (! NULL_INTERVAL_P (i
))
1468 if (i
->position
>= e
)
1470 if (! EQ (textget (i
->plist
, property
), value
))
1472 if (i
->position
> s
)
1474 return make_number (s
);
1476 i
= next_interval (i
);
1481 /* I don't think this is the right interface to export; how often do you
1482 want to do something like this, other than when you're copying objects
1485 I think it would be better to have a pair of functions, one which
1486 returns the text properties of a region as a list of ranges and
1487 plists, and another which applies such a list to another object. */
1489 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1490 SRC and DEST may each refer to strings or buffers.
1491 Optional sixth argument PROP causes only that property to be copied.
1492 Properties are copied to DEST as if by `add-text-properties'.
1493 Return t if any property value actually changed, nil otherwise. */
1495 /* Note this can GC when DEST is a buffer. */
1498 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1499 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1505 int s
, e
, e2
, p
, len
, modified
= 0;
1506 struct gcpro gcpro1
, gcpro2
;
1508 i
= validate_interval_range (src
, &start
, &end
, soft
);
1509 if (NULL_INTERVAL_P (i
))
1512 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1514 Lisp_Object dest_start
, dest_end
;
1517 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1518 /* Apply this to a copy of pos; it will try to increment its arguments,
1519 which we don't want. */
1520 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1531 e2
= i
->position
+ LENGTH (i
);
1538 while (! NILP (plist
))
1540 if (EQ (Fcar (plist
), prop
))
1542 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1545 plist
= Fcdr (Fcdr (plist
));
1549 /* Must defer modifications to the interval tree in case src
1550 and dest refer to the same string or buffer. */
1551 stuff
= Fcons (Fcons (make_number (p
),
1552 Fcons (make_number (p
+ len
),
1553 Fcons (plist
, Qnil
))),
1557 i
= next_interval (i
);
1558 if (NULL_INTERVAL_P (i
))
1565 GCPRO2 (stuff
, dest
);
1567 while (! NILP (stuff
))
1570 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1571 Fcar (Fcdr (Fcdr (res
))), dest
);
1574 stuff
= Fcdr (stuff
);
1579 return modified
? Qt
: Qnil
;
1583 /* Return a list representing the text properties of OBJECT between
1584 START and END. if PROP is non-nil, report only on that property.
1585 Each result list element has the form (S E PLIST), where S and E
1586 are positions in OBJECT and PLIST is a property list containing the
1587 text properties of OBJECT between S and E. Value is nil if OBJECT
1588 doesn't contain text properties between START and END. */
1591 text_property_list (object
, start
, end
, prop
)
1592 Lisp_Object object
, start
, end
, prop
;
1599 i
= validate_interval_range (object
, &start
, &end
, soft
);
1600 if (!NULL_INTERVAL_P (i
))
1602 int s
= XINT (start
);
1607 int interval_end
, len
;
1610 interval_end
= i
->position
+ LENGTH (i
);
1611 if (interval_end
> e
)
1613 len
= interval_end
- s
;
1618 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1619 if (EQ (Fcar (plist
), prop
))
1621 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1626 result
= Fcons (Fcons (make_number (s
),
1627 Fcons (make_number (s
+ len
),
1628 Fcons (plist
, Qnil
))),
1631 i
= next_interval (i
);
1632 if (NULL_INTERVAL_P (i
))
1642 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1643 (START END PLIST), where START and END are positions and PLIST is a
1644 property list containing the text properties to add. Adjust START
1645 and END positions by DELTA before adding properties. Value is
1646 non-zero if OBJECT was modified. */
1649 add_text_properties_from_list (object
, list
, delta
)
1650 Lisp_Object object
, list
, delta
;
1652 struct gcpro gcpro1
, gcpro2
;
1655 GCPRO2 (list
, object
);
1657 for (; CONSP (list
); list
= XCDR (list
))
1659 Lisp_Object item
, start
, end
, plist
, tem
;
1662 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1663 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1664 plist
= XCAR (XCDR (XCDR (item
)));
1666 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1677 /* Modify end-points of ranges in LIST destructively. LIST is a list
1678 as returned from text_property_list. Change end-points equal to
1679 OLD_END to NEW_END. */
1682 extend_property_ranges (list
, old_end
, new_end
)
1683 Lisp_Object list
, old_end
, new_end
;
1685 for (; CONSP (list
); list
= XCDR (list
))
1687 Lisp_Object item
, end
;
1690 end
= XCAR (XCDR (item
));
1692 if (EQ (end
, old_end
))
1693 XCAR (XCDR (item
)) = new_end
;
1699 /* Call the modification hook functions in LIST, each with START and END. */
1702 call_mod_hooks (list
, start
, end
)
1703 Lisp_Object list
, start
, end
;
1705 struct gcpro gcpro1
;
1707 while (!NILP (list
))
1709 call2 (Fcar (list
), start
, end
);
1715 /* Check for read-only intervals between character positions START ... END,
1716 in BUF, and signal an error if we find one.
1718 Then check for any modification hooks in the range.
1719 Create a list of all these hooks in lexicographic order,
1720 eliminating consecutive extra copies of the same hook. Then call
1721 those hooks in order, with START and END - 1 as arguments. */
1724 verify_interval_modification (buf
, start
, end
)
1728 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1729 register INTERVAL i
;
1731 register Lisp_Object prev_mod_hooks
;
1732 Lisp_Object mod_hooks
;
1733 struct gcpro gcpro1
;
1736 prev_mod_hooks
= Qnil
;
1739 interval_insert_behind_hooks
= Qnil
;
1740 interval_insert_in_front_hooks
= Qnil
;
1742 if (NULL_INTERVAL_P (intervals
))
1752 /* For an insert operation, check the two chars around the position. */
1756 Lisp_Object before
, after
;
1758 /* Set I to the interval containing the char after START,
1759 and PREV to the interval containing the char before START.
1760 Either one may be null. They may be equal. */
1761 i
= find_interval (intervals
, start
);
1763 if (start
== BUF_BEGV (buf
))
1765 else if (i
->position
== start
)
1766 prev
= previous_interval (i
);
1767 else if (i
->position
< start
)
1769 if (start
== BUF_ZV (buf
))
1772 /* If Vinhibit_read_only is set and is not a list, we can
1773 skip the read_only checks. */
1774 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1776 /* If I and PREV differ we need to check for the read-only
1777 property together with its stickiness. If either I or
1778 PREV are 0, this check is all we need.
1779 We have to take special care, since read-only may be
1780 indirectly defined via the category property. */
1783 if (! NULL_INTERVAL_P (i
))
1785 after
= textget (i
->plist
, Qread_only
);
1787 /* If interval I is read-only and read-only is
1788 front-sticky, inhibit insertion.
1789 Check for read-only as well as category. */
1791 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1795 tem
= textget (i
->plist
, Qfront_sticky
);
1796 if (TMEM (Qread_only
, tem
)
1797 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1798 && TMEM (Qcategory
, tem
)))
1799 Fsignal (Qtext_read_only
, Qnil
);
1803 if (! NULL_INTERVAL_P (prev
))
1805 before
= textget (prev
->plist
, Qread_only
);
1807 /* If interval PREV is read-only and read-only isn't
1808 rear-nonsticky, inhibit insertion.
1809 Check for read-only as well as category. */
1811 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1815 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1816 if (! TMEM (Qread_only
, tem
)
1817 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1818 || ! TMEM (Qcategory
, tem
)))
1819 Fsignal (Qtext_read_only
, Qnil
);
1823 else if (! NULL_INTERVAL_P (i
))
1825 after
= textget (i
->plist
, Qread_only
);
1827 /* If interval I is read-only and read-only is
1828 front-sticky, inhibit insertion.
1829 Check for read-only as well as category. */
1830 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1834 tem
= textget (i
->plist
, Qfront_sticky
);
1835 if (TMEM (Qread_only
, tem
)
1836 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1837 && TMEM (Qcategory
, tem
)))
1838 Fsignal (Qtext_read_only
, Qnil
);
1840 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1841 if (! TMEM (Qread_only
, tem
)
1842 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1843 || ! TMEM (Qcategory
, tem
)))
1844 Fsignal (Qtext_read_only
, Qnil
);
1849 /* Run both insert hooks (just once if they're the same). */
1850 if (!NULL_INTERVAL_P (prev
))
1851 interval_insert_behind_hooks
1852 = textget (prev
->plist
, Qinsert_behind_hooks
);
1853 if (!NULL_INTERVAL_P (i
))
1854 interval_insert_in_front_hooks
1855 = textget (i
->plist
, Qinsert_in_front_hooks
);
1859 /* Loop over intervals on or next to START...END,
1860 collecting their hooks. */
1862 i
= find_interval (intervals
, start
);
1865 if (! INTERVAL_WRITABLE_P (i
))
1866 Fsignal (Qtext_read_only
, Qnil
);
1868 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1869 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1871 hooks
= Fcons (mod_hooks
, hooks
);
1872 prev_mod_hooks
= mod_hooks
;
1875 i
= next_interval (i
);
1877 /* Keep going thru the interval containing the char before END. */
1878 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1881 hooks
= Fnreverse (hooks
);
1882 while (! EQ (hooks
, Qnil
))
1884 call_mod_hooks (Fcar (hooks
), make_number (start
),
1886 hooks
= Fcdr (hooks
);
1892 /* Run the interval hooks for an insertion on character range START ... END.
1893 verify_interval_modification chose which hooks to run;
1894 this function is called after the insertion happens
1895 so it can indicate the range of inserted text. */
1898 report_interval_modification (start
, end
)
1899 Lisp_Object start
, end
;
1901 if (! NILP (interval_insert_behind_hooks
))
1902 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1903 if (! NILP (interval_insert_in_front_hooks
)
1904 && ! EQ (interval_insert_in_front_hooks
,
1905 interval_insert_behind_hooks
))
1906 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1912 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1913 "Property-list used as default values.\n\
1914 The value of a property in this list is seen as the value for every\n\
1915 character that does not have its own value for that property.");
1916 Vdefault_text_properties
= Qnil
;
1918 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1919 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1920 This also inhibits the use of the `intangible' text property.");
1921 Vinhibit_point_motion_hooks
= Qnil
;
1923 DEFVAR_LISP ("text-property-default-nonsticky",
1924 &Vtext_property_default_nonsticky
,
1925 "Alist of properties vs the corresponding non-stickinesses.\n\
1926 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1928 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1929 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1930 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1931 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1932 Vtext_property_default_nonsticky
= Qnil
;
1934 staticpro (&interval_insert_behind_hooks
);
1935 staticpro (&interval_insert_in_front_hooks
);
1936 interval_insert_behind_hooks
= Qnil
;
1937 interval_insert_in_front_hooks
= Qnil
;
1940 /* Common attributes one might give text */
1942 staticpro (&Qforeground
);
1943 Qforeground
= intern ("foreground");
1944 staticpro (&Qbackground
);
1945 Qbackground
= intern ("background");
1947 Qfont
= intern ("font");
1948 staticpro (&Qstipple
);
1949 Qstipple
= intern ("stipple");
1950 staticpro (&Qunderline
);
1951 Qunderline
= intern ("underline");
1952 staticpro (&Qread_only
);
1953 Qread_only
= intern ("read-only");
1954 staticpro (&Qinvisible
);
1955 Qinvisible
= intern ("invisible");
1956 staticpro (&Qintangible
);
1957 Qintangible
= intern ("intangible");
1958 staticpro (&Qcategory
);
1959 Qcategory
= intern ("category");
1960 staticpro (&Qlocal_map
);
1961 Qlocal_map
= intern ("local-map");
1962 staticpro (&Qfront_sticky
);
1963 Qfront_sticky
= intern ("front-sticky");
1964 staticpro (&Qrear_nonsticky
);
1965 Qrear_nonsticky
= intern ("rear-nonsticky");
1966 staticpro (&Qmouse_face
);
1967 Qmouse_face
= intern ("mouse-face");
1969 /* Properties that text might use to specify certain actions */
1971 staticpro (&Qmouse_left
);
1972 Qmouse_left
= intern ("mouse-left");
1973 staticpro (&Qmouse_entered
);
1974 Qmouse_entered
= intern ("mouse-entered");
1975 staticpro (&Qpoint_left
);
1976 Qpoint_left
= intern ("point-left");
1977 staticpro (&Qpoint_entered
);
1978 Qpoint_entered
= intern ("point-entered");
1980 defsubr (&Stext_properties_at
);
1981 defsubr (&Sget_text_property
);
1982 defsubr (&Sget_char_property
);
1983 defsubr (&Snext_char_property_change
);
1984 defsubr (&Sprevious_char_property_change
);
1985 defsubr (&Snext_single_char_property_change
);
1986 defsubr (&Sprevious_single_char_property_change
);
1987 defsubr (&Snext_property_change
);
1988 defsubr (&Snext_single_property_change
);
1989 defsubr (&Sprevious_property_change
);
1990 defsubr (&Sprevious_single_property_change
);
1991 defsubr (&Sadd_text_properties
);
1992 defsubr (&Sput_text_property
);
1993 defsubr (&Sset_text_properties
);
1994 defsubr (&Sremove_text_properties
);
1995 defsubr (&Stext_property_any
);
1996 defsubr (&Stext_property_not_all
);
1997 /* defsubr (&Serase_text_properties); */
1998 /* defsubr (&Scopy_text_properties); */