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 Lisp_Object initial_value
, value
;
773 int count
= specpdl_ptr
- specpdl
;
776 CHECK_BUFFER (object
, 0);
778 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
780 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
781 Fset_buffer (object
);
785 XSETFASTINT (limit
, BUF_BEGV (current_buffer
));
787 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
789 initial_value
= Fget_char_property (position
, prop
, object
);
793 position
= Fprevious_char_property_change (position
, limit
);
794 if (XFASTINT (position
) <= XFASTINT (limit
)) {
799 value
= Fget_char_property (position
- 1, prop
, object
);
800 if (!EQ (value
, initial_value
))
804 unbind_to (count
, Qnil
);
810 DEFUN ("next-property-change", Fnext_property_change
,
811 Snext_property_change
, 1, 3, 0,
812 "Return the position of next property change.\n\
813 Scans characters forward from POSITION in OBJECT till it finds\n\
814 a change in some text property, then returns the position of the change.\n\
815 The optional second argument OBJECT is the string or buffer to scan.\n\
816 Return nil if the property is constant all the way to the end of OBJECT.\n\
817 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
818 If the optional third argument LIMIT is non-nil, don't search\n\
819 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
820 (position
, object
, limit
)
821 Lisp_Object position
, object
, limit
;
823 register INTERVAL i
, next
;
826 XSETBUFFER (object
, current_buffer
);
828 if (! NILP (limit
) && ! EQ (limit
, Qt
))
829 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
831 i
= validate_interval_range (object
, &position
, &position
, soft
);
833 /* If LIMIT is t, return start of next interval--don't
834 bother checking further intervals. */
837 if (NULL_INTERVAL_P (i
))
840 next
= next_interval (i
);
842 if (NULL_INTERVAL_P (next
))
843 XSETFASTINT (position
, (STRINGP (object
)
844 ? XSTRING (object
)->size
845 : BUF_ZV (XBUFFER (object
))));
847 XSETFASTINT (position
, next
->position
);
851 if (NULL_INTERVAL_P (i
))
854 next
= next_interval (i
);
856 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
857 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
858 next
= next_interval (next
);
860 if (NULL_INTERVAL_P (next
))
862 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
865 XSETFASTINT (position
, next
->position
);
869 /* Return 1 if there's a change in some property between BEG and END. */
872 property_change_between_p (beg
, end
)
875 register INTERVAL i
, next
;
876 Lisp_Object object
, pos
;
878 XSETBUFFER (object
, current_buffer
);
879 XSETFASTINT (pos
, beg
);
881 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
882 if (NULL_INTERVAL_P (i
))
885 next
= next_interval (i
);
886 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
888 next
= next_interval (next
);
889 if (NULL_INTERVAL_P (next
))
891 if (next
->position
>= end
)
895 if (NULL_INTERVAL_P (next
))
901 DEFUN ("next-single-property-change", Fnext_single_property_change
,
902 Snext_single_property_change
, 2, 4, 0,
903 "Return the position of next property change for a specific property.\n\
904 Scans characters forward from POSITION till it finds\n\
905 a change in the PROP property, then returns the position of the change.\n\
906 The optional third argument OBJECT is the string or buffer to scan.\n\
907 The property values are compared with `eq'.\n\
908 Return nil if the property is constant all the way to the end of OBJECT.\n\
909 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
910 If the optional fourth argument LIMIT is non-nil, don't search\n\
911 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
912 (position
, prop
, object
, limit
)
913 Lisp_Object position
, prop
, object
, limit
;
915 register INTERVAL i
, next
;
916 register Lisp_Object here_val
;
919 XSETBUFFER (object
, current_buffer
);
922 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
924 i
= validate_interval_range (object
, &position
, &position
, soft
);
925 if (NULL_INTERVAL_P (i
))
928 here_val
= textget (i
->plist
, prop
);
929 next
= next_interval (i
);
930 while (! NULL_INTERVAL_P (next
)
931 && EQ (here_val
, textget (next
->plist
, prop
))
932 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
933 next
= next_interval (next
);
935 if (NULL_INTERVAL_P (next
))
937 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
940 return make_number (next
->position
);
943 DEFUN ("previous-property-change", Fprevious_property_change
,
944 Sprevious_property_change
, 1, 3, 0,
945 "Return the position of previous property change.\n\
946 Scans characters backwards from POSITION in OBJECT till it finds\n\
947 a change in some text property, then returns the position of the change.\n\
948 The optional second argument OBJECT is the string or buffer to scan.\n\
949 Return nil if the property is constant all the way to the start of OBJECT.\n\
950 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
951 If the optional third argument LIMIT is non-nil, don't search\n\
952 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
953 (position
, object
, limit
)
954 Lisp_Object position
, object
, limit
;
956 register INTERVAL i
, previous
;
959 XSETBUFFER (object
, current_buffer
);
962 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
964 i
= validate_interval_range (object
, &position
, &position
, soft
);
965 if (NULL_INTERVAL_P (i
))
968 /* Start with the interval containing the char before point. */
969 if (i
->position
== XFASTINT (position
))
970 i
= previous_interval (i
);
972 previous
= previous_interval (i
);
973 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
975 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
976 previous
= previous_interval (previous
);
977 if (NULL_INTERVAL_P (previous
))
980 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
983 return make_number (previous
->position
+ LENGTH (previous
));
986 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
987 Sprevious_single_property_change
, 2, 4, 0,
988 "Return the position of previous property change for a specific property.\n\
989 Scans characters backward from POSITION till it finds\n\
990 a change in the PROP property, then returns the position of the change.\n\
991 The optional third argument OBJECT is the string or buffer to scan.\n\
992 The property values are compared with `eq'.\n\
993 Return nil if the property is constant all the way to the start of OBJECT.\n\
994 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
995 If the optional fourth argument LIMIT is non-nil, don't search\n\
996 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
997 (position
, prop
, object
, limit
)
998 Lisp_Object position
, prop
, object
, limit
;
1000 register INTERVAL i
, previous
;
1001 register Lisp_Object here_val
;
1004 XSETBUFFER (object
, current_buffer
);
1007 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
1009 i
= validate_interval_range (object
, &position
, &position
, soft
);
1011 /* Start with the interval containing the char before point. */
1012 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1013 i
= previous_interval (i
);
1015 if (NULL_INTERVAL_P (i
))
1018 here_val
= textget (i
->plist
, prop
);
1019 previous
= previous_interval (i
);
1020 while (! NULL_INTERVAL_P (previous
)
1021 && EQ (here_val
, textget (previous
->plist
, prop
))
1023 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1024 previous
= previous_interval (previous
);
1025 if (NULL_INTERVAL_P (previous
))
1028 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1031 return make_number (previous
->position
+ LENGTH (previous
));
1034 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1036 DEFUN ("add-text-properties", Fadd_text_properties
,
1037 Sadd_text_properties
, 3, 4, 0,
1038 "Add properties to the text from START to END.\n\
1039 The third argument PROPERTIES is a property list\n\
1040 specifying the property values to add.\n\
1041 The optional fourth argument, OBJECT,\n\
1042 is the string or buffer containing the text.\n\
1043 Return t if any property value actually changed, nil otherwise.")
1044 (start
, end
, properties
, object
)
1045 Lisp_Object start
, end
, properties
, object
;
1047 register INTERVAL i
, unchanged
;
1048 register int s
, len
, modified
= 0;
1049 struct gcpro gcpro1
;
1051 properties
= validate_plist (properties
);
1052 if (NILP (properties
))
1056 XSETBUFFER (object
, current_buffer
);
1058 i
= validate_interval_range (object
, &start
, &end
, hard
);
1059 if (NULL_INTERVAL_P (i
))
1063 len
= XINT (end
) - s
;
1065 /* No need to protect OBJECT, because we GC only if it's a buffer,
1066 and live buffers are always protected. */
1067 GCPRO1 (properties
);
1069 /* If we're not starting on an interval boundary, we have to
1070 split this interval. */
1071 if (i
->position
!= s
)
1073 /* If this interval already has the properties, we can
1075 if (interval_has_all_properties (properties
, i
))
1077 int got
= (LENGTH (i
) - (s
- i
->position
));
1079 RETURN_UNGCPRO (Qnil
);
1081 i
= next_interval (i
);
1086 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1087 copy_properties (unchanged
, i
);
1091 if (BUFFERP (object
))
1092 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1094 /* We are at the beginning of interval I, with LEN chars to scan. */
1100 if (LENGTH (i
) >= len
)
1102 /* We can UNGCPRO safely here, because there will be just
1103 one more chance to gc, in the next call to add_properties,
1104 and after that we will not need PROPERTIES or OBJECT again. */
1107 if (interval_has_all_properties (properties
, i
))
1109 if (BUFFERP (object
))
1110 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1111 XINT (end
) - XINT (start
));
1113 return modified
? Qt
: Qnil
;
1116 if (LENGTH (i
) == len
)
1118 add_properties (properties
, i
, object
);
1119 if (BUFFERP (object
))
1120 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1121 XINT (end
) - XINT (start
));
1125 /* i doesn't have the properties, and goes past the change limit */
1127 i
= split_interval_left (unchanged
, len
);
1128 copy_properties (unchanged
, i
);
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
));
1137 modified
+= add_properties (properties
, i
, object
);
1138 i
= next_interval (i
);
1142 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1144 DEFUN ("put-text-property", Fput_text_property
,
1145 Sput_text_property
, 4, 5, 0,
1146 "Set one property of the text from START to END.\n\
1147 The third and fourth arguments PROPERTY and VALUE\n\
1148 specify the property to add.\n\
1149 The optional fifth argument, OBJECT,\n\
1150 is the string or buffer containing the text.")
1151 (start
, end
, property
, value
, object
)
1152 Lisp_Object start
, end
, property
, value
, object
;
1154 Fadd_text_properties (start
, end
,
1155 Fcons (property
, Fcons (value
, Qnil
)),
1160 DEFUN ("set-text-properties", Fset_text_properties
,
1161 Sset_text_properties
, 3, 4, 0,
1162 "Completely replace properties of text from START to END.\n\
1163 The third argument PROPERTIES is the new property list.\n\
1164 The optional fourth argument, OBJECT,\n\
1165 is the string or buffer containing the text.")
1166 (start
, end
, properties
, object
)
1167 Lisp_Object start
, end
, properties
, object
;
1169 return set_text_properties (start
, end
, properties
, object
, Qt
);
1173 /* Replace properties of text from START to END with new list of
1174 properties PROPERTIES. OBJECT is the buffer or string containing
1175 the text. OBJECT nil means use the current buffer.
1176 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1177 is non-nil if properties were replaced; it is nil if there weren't
1178 any properties to replace. */
1181 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1182 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1184 register INTERVAL i
, unchanged
;
1185 register INTERVAL prev_changed
= NULL_INTERVAL
;
1186 register int s
, len
;
1187 Lisp_Object ostart
, oend
;
1192 properties
= validate_plist (properties
);
1195 XSETBUFFER (object
, current_buffer
);
1197 /* If we want no properties for a whole string,
1198 get rid of its intervals. */
1199 if (NILP (properties
) && STRINGP (object
)
1200 && XFASTINT (start
) == 0
1201 && XFASTINT (end
) == XSTRING (object
)->size
)
1203 if (! XSTRING (object
)->intervals
)
1206 XSTRING (object
)->intervals
= 0;
1210 i
= validate_interval_range (object
, &start
, &end
, soft
);
1212 if (NULL_INTERVAL_P (i
))
1214 /* If buffer has no properties, and we want none, return now. */
1215 if (NILP (properties
))
1218 /* Restore the original START and END values
1219 because validate_interval_range increments them for strings. */
1223 i
= validate_interval_range (object
, &start
, &end
, hard
);
1224 /* This can return if start == end. */
1225 if (NULL_INTERVAL_P (i
))
1230 len
= XINT (end
) - s
;
1232 if (BUFFERP (object
))
1233 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1235 if (i
->position
!= s
)
1238 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1240 if (LENGTH (i
) > len
)
1242 copy_properties (unchanged
, i
);
1243 i
= split_interval_left (i
, len
);
1244 set_properties (properties
, i
, object
);
1245 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1246 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1247 XINT (end
) - XINT (start
));
1252 set_properties (properties
, i
, object
);
1254 if (LENGTH (i
) == len
)
1256 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1257 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1258 XINT (end
) - XINT (start
));
1265 i
= next_interval (i
);
1268 /* We are starting at the beginning of an interval, I */
1274 if (LENGTH (i
) >= len
)
1276 if (LENGTH (i
) > len
)
1277 i
= split_interval_left (i
, len
);
1279 /* We have to call set_properties even if we are going to
1280 merge the intervals, so as to make the undo records
1281 and cause redisplay to happen. */
1282 set_properties (properties
, i
, object
);
1283 if (!NULL_INTERVAL_P (prev_changed
))
1284 merge_interval_left (i
);
1285 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1286 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1287 XINT (end
) - XINT (start
));
1293 /* We have to call set_properties even if we are going to
1294 merge the intervals, so as to make the undo records
1295 and cause redisplay to happen. */
1296 set_properties (properties
, i
, object
);
1297 if (NULL_INTERVAL_P (prev_changed
))
1300 prev_changed
= i
= merge_interval_left (i
);
1302 i
= next_interval (i
);
1305 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1306 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1307 XINT (end
) - XINT (start
));
1311 DEFUN ("remove-text-properties", Fremove_text_properties
,
1312 Sremove_text_properties
, 3, 4, 0,
1313 "Remove some properties from text from START to END.\n\
1314 The third argument PROPERTIES is a property list\n\
1315 whose property names specify the properties to remove.\n\
1316 \(The values stored in PROPERTIES are ignored.)\n\
1317 The optional fourth argument, OBJECT,\n\
1318 is the string or buffer containing the text.\n\
1319 Return t if any property was actually removed, nil otherwise.")
1320 (start
, end
, properties
, object
)
1321 Lisp_Object start
, end
, properties
, object
;
1323 register INTERVAL i
, unchanged
;
1324 register int s
, len
, modified
= 0;
1327 XSETBUFFER (object
, current_buffer
);
1329 i
= validate_interval_range (object
, &start
, &end
, soft
);
1330 if (NULL_INTERVAL_P (i
))
1334 len
= XINT (end
) - s
;
1336 if (i
->position
!= s
)
1338 /* No properties on this first interval -- return if
1339 it covers the entire region. */
1340 if (! interval_has_some_properties (properties
, i
))
1342 int got
= (LENGTH (i
) - (s
- i
->position
));
1346 i
= next_interval (i
);
1348 /* Split away the beginning of this interval; what we don't
1353 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1354 copy_properties (unchanged
, i
);
1358 if (BUFFERP (object
))
1359 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1361 /* We are at the beginning of an interval, with len to scan */
1367 if (LENGTH (i
) >= len
)
1369 if (! interval_has_some_properties (properties
, i
))
1370 return modified
? Qt
: Qnil
;
1372 if (LENGTH (i
) == len
)
1374 remove_properties (properties
, i
, object
);
1375 if (BUFFERP (object
))
1376 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1377 XINT (end
) - XINT (start
));
1381 /* i has the properties, and goes past the change limit */
1383 i
= split_interval_left (i
, len
);
1384 copy_properties (unchanged
, i
);
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
));
1393 modified
+= remove_properties (properties
, i
, object
);
1394 i
= next_interval (i
);
1398 DEFUN ("text-property-any", Ftext_property_any
,
1399 Stext_property_any
, 4, 5, 0,
1400 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1401 If so, return the position of the first character whose property PROPERTY\n\
1402 is `eq' to VALUE. Otherwise return nil.\n\
1403 The optional fifth argument, OBJECT, is the string or buffer\n\
1404 containing the text.")
1405 (start
, end
, property
, value
, object
)
1406 Lisp_Object start
, end
, property
, value
, object
;
1408 register INTERVAL i
;
1409 register int e
, pos
;
1412 XSETBUFFER (object
, current_buffer
);
1413 i
= validate_interval_range (object
, &start
, &end
, soft
);
1414 if (NULL_INTERVAL_P (i
))
1415 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1418 while (! NULL_INTERVAL_P (i
))
1420 if (i
->position
>= e
)
1422 if (EQ (textget (i
->plist
, property
), value
))
1425 if (pos
< XINT (start
))
1427 return make_number (pos
);
1429 i
= next_interval (i
);
1434 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1435 Stext_property_not_all
, 4, 5, 0,
1436 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1437 If so, return the position of the first character whose property PROPERTY\n\
1438 is not `eq' to VALUE. Otherwise, return nil.\n\
1439 The optional fifth argument, OBJECT, is the string or buffer\n\
1440 containing the text.")
1441 (start
, end
, property
, value
, object
)
1442 Lisp_Object start
, end
, property
, value
, object
;
1444 register INTERVAL i
;
1448 XSETBUFFER (object
, current_buffer
);
1449 i
= validate_interval_range (object
, &start
, &end
, soft
);
1450 if (NULL_INTERVAL_P (i
))
1451 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1455 while (! NULL_INTERVAL_P (i
))
1457 if (i
->position
>= e
)
1459 if (! EQ (textget (i
->plist
, property
), value
))
1461 if (i
->position
> s
)
1463 return make_number (s
);
1465 i
= next_interval (i
);
1470 /* I don't think this is the right interface to export; how often do you
1471 want to do something like this, other than when you're copying objects
1474 I think it would be better to have a pair of functions, one which
1475 returns the text properties of a region as a list of ranges and
1476 plists, and another which applies such a list to another object. */
1478 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1479 SRC and DEST may each refer to strings or buffers.
1480 Optional sixth argument PROP causes only that property to be copied.
1481 Properties are copied to DEST as if by `add-text-properties'.
1482 Return t if any property value actually changed, nil otherwise. */
1484 /* Note this can GC when DEST is a buffer. */
1487 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1488 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1494 int s
, e
, e2
, p
, len
, modified
= 0;
1495 struct gcpro gcpro1
, gcpro2
;
1497 i
= validate_interval_range (src
, &start
, &end
, soft
);
1498 if (NULL_INTERVAL_P (i
))
1501 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1503 Lisp_Object dest_start
, dest_end
;
1506 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1507 /* Apply this to a copy of pos; it will try to increment its arguments,
1508 which we don't want. */
1509 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1520 e2
= i
->position
+ LENGTH (i
);
1527 while (! NILP (plist
))
1529 if (EQ (Fcar (plist
), prop
))
1531 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1534 plist
= Fcdr (Fcdr (plist
));
1538 /* Must defer modifications to the interval tree in case src
1539 and dest refer to the same string or buffer. */
1540 stuff
= Fcons (Fcons (make_number (p
),
1541 Fcons (make_number (p
+ len
),
1542 Fcons (plist
, Qnil
))),
1546 i
= next_interval (i
);
1547 if (NULL_INTERVAL_P (i
))
1554 GCPRO2 (stuff
, dest
);
1556 while (! NILP (stuff
))
1559 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1560 Fcar (Fcdr (Fcdr (res
))), dest
);
1563 stuff
= Fcdr (stuff
);
1568 return modified
? Qt
: Qnil
;
1572 /* Return a list representing the text properties of OBJECT between
1573 START and END. if PROP is non-nil, report only on that property.
1574 Each result list element has the form (S E PLIST), where S and E
1575 are positions in OBJECT and PLIST is a property list containing the
1576 text properties of OBJECT between S and E. Value is nil if OBJECT
1577 doesn't contain text properties between START and END. */
1580 text_property_list (object
, start
, end
, prop
)
1581 Lisp_Object object
, start
, end
, prop
;
1588 i
= validate_interval_range (object
, &start
, &end
, soft
);
1589 if (!NULL_INTERVAL_P (i
))
1591 int s
= XINT (start
);
1596 int interval_end
, len
;
1599 interval_end
= i
->position
+ LENGTH (i
);
1600 if (interval_end
> e
)
1602 len
= interval_end
- s
;
1607 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1608 if (EQ (Fcar (plist
), prop
))
1610 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1615 result
= Fcons (Fcons (make_number (s
),
1616 Fcons (make_number (s
+ len
),
1617 Fcons (plist
, Qnil
))),
1620 i
= next_interval (i
);
1621 if (NULL_INTERVAL_P (i
))
1631 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1632 (START END PLIST), where START and END are positions and PLIST is a
1633 property list containing the text properties to add. Adjust START
1634 and END positions by DELTA before adding properties. Value is
1635 non-zero if OBJECT was modified. */
1638 add_text_properties_from_list (object
, list
, delta
)
1639 Lisp_Object object
, list
, delta
;
1641 struct gcpro gcpro1
, gcpro2
;
1644 GCPRO2 (list
, object
);
1646 for (; CONSP (list
); list
= XCDR (list
))
1648 Lisp_Object item
, start
, end
, plist
, tem
;
1651 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1652 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1653 plist
= XCAR (XCDR (XCDR (item
)));
1655 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1666 /* Modify end-points of ranges in LIST destructively. LIST is a list
1667 as returned from text_property_list. Change end-points equal to
1668 OLD_END to NEW_END. */
1671 extend_property_ranges (list
, old_end
, new_end
)
1672 Lisp_Object list
, old_end
, new_end
;
1674 for (; CONSP (list
); list
= XCDR (list
))
1676 Lisp_Object item
, end
;
1679 end
= XCAR (XCDR (item
));
1681 if (EQ (end
, old_end
))
1682 XCAR (XCDR (item
)) = new_end
;
1688 /* Call the modification hook functions in LIST, each with START and END. */
1691 call_mod_hooks (list
, start
, end
)
1692 Lisp_Object list
, start
, end
;
1694 struct gcpro gcpro1
;
1696 while (!NILP (list
))
1698 call2 (Fcar (list
), start
, end
);
1704 /* Check for read-only intervals between character positions START ... END,
1705 in BUF, and signal an error if we find one.
1707 Then check for any modification hooks in the range.
1708 Create a list of all these hooks in lexicographic order,
1709 eliminating consecutive extra copies of the same hook. Then call
1710 those hooks in order, with START and END - 1 as arguments. */
1713 verify_interval_modification (buf
, start
, end
)
1717 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1718 register INTERVAL i
;
1720 register Lisp_Object prev_mod_hooks
;
1721 Lisp_Object mod_hooks
;
1722 struct gcpro gcpro1
;
1725 prev_mod_hooks
= Qnil
;
1728 interval_insert_behind_hooks
= Qnil
;
1729 interval_insert_in_front_hooks
= Qnil
;
1731 if (NULL_INTERVAL_P (intervals
))
1741 /* For an insert operation, check the two chars around the position. */
1745 Lisp_Object before
, after
;
1747 /* Set I to the interval containing the char after START,
1748 and PREV to the interval containing the char before START.
1749 Either one may be null. They may be equal. */
1750 i
= find_interval (intervals
, start
);
1752 if (start
== BUF_BEGV (buf
))
1754 else if (i
->position
== start
)
1755 prev
= previous_interval (i
);
1756 else if (i
->position
< start
)
1758 if (start
== BUF_ZV (buf
))
1761 /* If Vinhibit_read_only is set and is not a list, we can
1762 skip the read_only checks. */
1763 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1765 /* If I and PREV differ we need to check for the read-only
1766 property together with its stickiness. If either I or
1767 PREV are 0, this check is all we need.
1768 We have to take special care, since read-only may be
1769 indirectly defined via the category property. */
1772 if (! NULL_INTERVAL_P (i
))
1774 after
= textget (i
->plist
, Qread_only
);
1776 /* If interval I is read-only and read-only is
1777 front-sticky, inhibit insertion.
1778 Check for read-only as well as category. */
1780 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1784 tem
= textget (i
->plist
, Qfront_sticky
);
1785 if (TMEM (Qread_only
, tem
)
1786 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1787 && TMEM (Qcategory
, tem
)))
1788 Fsignal (Qtext_read_only
, Qnil
);
1792 if (! NULL_INTERVAL_P (prev
))
1794 before
= textget (prev
->plist
, Qread_only
);
1796 /* If interval PREV is read-only and read-only isn't
1797 rear-nonsticky, inhibit insertion.
1798 Check for read-only as well as category. */
1800 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1804 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1805 if (! TMEM (Qread_only
, tem
)
1806 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1807 || ! TMEM (Qcategory
, tem
)))
1808 Fsignal (Qtext_read_only
, Qnil
);
1812 else if (! NULL_INTERVAL_P (i
))
1814 after
= textget (i
->plist
, Qread_only
);
1816 /* If interval I is read-only and read-only is
1817 front-sticky, inhibit insertion.
1818 Check for read-only as well as category. */
1819 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1823 tem
= textget (i
->plist
, Qfront_sticky
);
1824 if (TMEM (Qread_only
, tem
)
1825 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1826 && TMEM (Qcategory
, tem
)))
1827 Fsignal (Qtext_read_only
, Qnil
);
1829 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1830 if (! TMEM (Qread_only
, tem
)
1831 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1832 || ! TMEM (Qcategory
, tem
)))
1833 Fsignal (Qtext_read_only
, Qnil
);
1838 /* Run both insert hooks (just once if they're the same). */
1839 if (!NULL_INTERVAL_P (prev
))
1840 interval_insert_behind_hooks
1841 = textget (prev
->plist
, Qinsert_behind_hooks
);
1842 if (!NULL_INTERVAL_P (i
))
1843 interval_insert_in_front_hooks
1844 = textget (i
->plist
, Qinsert_in_front_hooks
);
1848 /* Loop over intervals on or next to START...END,
1849 collecting their hooks. */
1851 i
= find_interval (intervals
, start
);
1854 if (! INTERVAL_WRITABLE_P (i
))
1855 Fsignal (Qtext_read_only
, Qnil
);
1857 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1858 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1860 hooks
= Fcons (mod_hooks
, hooks
);
1861 prev_mod_hooks
= mod_hooks
;
1864 i
= next_interval (i
);
1866 /* Keep going thru the interval containing the char before END. */
1867 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1870 hooks
= Fnreverse (hooks
);
1871 while (! EQ (hooks
, Qnil
))
1873 call_mod_hooks (Fcar (hooks
), make_number (start
),
1875 hooks
= Fcdr (hooks
);
1881 /* Run the interval hooks for an insertion on character range START ... END.
1882 verify_interval_modification chose which hooks to run;
1883 this function is called after the insertion happens
1884 so it can indicate the range of inserted text. */
1887 report_interval_modification (start
, end
)
1888 Lisp_Object start
, end
;
1890 if (! NILP (interval_insert_behind_hooks
))
1891 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
1892 if (! NILP (interval_insert_in_front_hooks
)
1893 && ! EQ (interval_insert_in_front_hooks
,
1894 interval_insert_behind_hooks
))
1895 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
1901 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1902 "Property-list used as default values.\n\
1903 The value of a property in this list is seen as the value for every\n\
1904 character that does not have its own value for that property.");
1905 Vdefault_text_properties
= Qnil
;
1907 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1908 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1909 This also inhibits the use of the `intangible' text property.");
1910 Vinhibit_point_motion_hooks
= Qnil
;
1912 DEFVAR_LISP ("text-property-default-nonsticky",
1913 &Vtext_property_default_nonsticky
,
1914 "Alist of properties vs the corresponding non-stickinesses.\n\
1915 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1917 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1918 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1919 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1920 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1921 Vtext_property_default_nonsticky
= Qnil
;
1923 staticpro (&interval_insert_behind_hooks
);
1924 staticpro (&interval_insert_in_front_hooks
);
1925 interval_insert_behind_hooks
= Qnil
;
1926 interval_insert_in_front_hooks
= Qnil
;
1929 /* Common attributes one might give text */
1931 staticpro (&Qforeground
);
1932 Qforeground
= intern ("foreground");
1933 staticpro (&Qbackground
);
1934 Qbackground
= intern ("background");
1936 Qfont
= intern ("font");
1937 staticpro (&Qstipple
);
1938 Qstipple
= intern ("stipple");
1939 staticpro (&Qunderline
);
1940 Qunderline
= intern ("underline");
1941 staticpro (&Qread_only
);
1942 Qread_only
= intern ("read-only");
1943 staticpro (&Qinvisible
);
1944 Qinvisible
= intern ("invisible");
1945 staticpro (&Qintangible
);
1946 Qintangible
= intern ("intangible");
1947 staticpro (&Qcategory
);
1948 Qcategory
= intern ("category");
1949 staticpro (&Qlocal_map
);
1950 Qlocal_map
= intern ("local-map");
1951 staticpro (&Qfront_sticky
);
1952 Qfront_sticky
= intern ("front-sticky");
1953 staticpro (&Qrear_nonsticky
);
1954 Qrear_nonsticky
= intern ("rear-nonsticky");
1955 staticpro (&Qmouse_face
);
1956 Qmouse_face
= intern ("mouse-face");
1958 /* Properties that text might use to specify certain actions */
1960 staticpro (&Qmouse_left
);
1961 Qmouse_left
= intern ("mouse-left");
1962 staticpro (&Qmouse_entered
);
1963 Qmouse_entered
= intern ("mouse-entered");
1964 staticpro (&Qpoint_left
);
1965 Qpoint_left
= intern ("point-left");
1966 staticpro (&Qpoint_entered
);
1967 Qpoint_entered
= intern ("point-entered");
1969 defsubr (&Stext_properties_at
);
1970 defsubr (&Sget_text_property
);
1971 defsubr (&Sget_char_property
);
1972 defsubr (&Snext_char_property_change
);
1973 defsubr (&Sprevious_char_property_change
);
1974 defsubr (&Snext_single_char_property_change
);
1975 defsubr (&Sprevious_single_char_property_change
);
1976 defsubr (&Snext_property_change
);
1977 defsubr (&Snext_single_property_change
);
1978 defsubr (&Sprevious_property_change
);
1979 defsubr (&Sprevious_single_property_change
);
1980 defsubr (&Sadd_text_properties
);
1981 defsubr (&Sput_text_property
);
1982 defsubr (&Sset_text_properties
);
1983 defsubr (&Sremove_text_properties
);
1984 defsubr (&Stext_property_any
);
1985 defsubr (&Stext_property_not_all
);
1986 /* defsubr (&Serase_text_properties); */
1987 /* defsubr (&Scopy_text_properties); */