1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
24 #include "intervals.h"
29 #define NULL (void *)0
32 /* Test for membership, allowing for t (actually any non-cons) to mean the
35 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
38 /* NOTES: previous- and next- property change will have to skip
39 zero-length intervals if they are implemented. This could be done
40 inside next_interval and previous_interval.
42 set_properties needs to deal with the interval property cache.
44 It is assumed that for any interval plist, a property appears
45 only once on the list. Although some code i.e., remove_properties,
46 handles the more general case, the uniqueness of properties is
47 necessary for the system to remain consistent. This requirement
48 is enforced by the subrs installing properties onto the intervals. */
52 Lisp_Object Qmouse_left
;
53 Lisp_Object Qmouse_entered
;
54 Lisp_Object Qpoint_left
;
55 Lisp_Object Qpoint_entered
;
56 Lisp_Object Qcategory
;
57 Lisp_Object Qlocal_map
;
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
61 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
71 Lisp_Object Vinhibit_point_motion_hooks
;
72 Lisp_Object Vdefault_text_properties
;
73 Lisp_Object Vchar_property_alias_alist
;
74 Lisp_Object Vtext_property_default_nonsticky
;
76 /* verify_interval_modification saves insertion hooks here
77 to be run later by report_interval_modification. */
78 Lisp_Object interval_insert_behind_hooks
;
79 Lisp_Object interval_insert_in_front_hooks
;
82 /* Signal a `text-read-only' error. This function makes it easier
83 to capture that error in GDB by putting a breakpoint on it. */
86 text_read_only (propval
)
89 Fsignal (Qtext_read_only
, STRINGP (propval
) ? Fcons (propval
, Qnil
) : Qnil
);
94 /* Extract the interval at the position pointed to by BEGIN from
95 OBJECT, a string or buffer. Additionally, check that the positions
96 pointed to by BEGIN and END are within the bounds of OBJECT, and
97 reverse them if *BEGIN is greater than *END. The objects pointed
98 to by BEGIN and END may be integers or markers; if the latter, they
99 are coerced to integers.
101 When OBJECT is a string, we increment *BEGIN and *END
102 to make them origin-one.
104 Note that buffer points don't correspond to interval indices.
105 For example, point-max is 1 greater than the index of the last
106 character. This difference is handled in the caller, which uses
107 the validated points to determine a length, and operates on that.
108 Exceptions are Ftext_properties_at, Fnext_property_change, and
109 Fprevious_property_change which call this function with BEGIN == END.
110 Handle this case specially.
112 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
113 create an interval tree for OBJECT if one doesn't exist, provided
114 the object actually contains text. In the current design, if there
115 is no text, there can be no text properties. */
121 validate_interval_range (object
, begin
, end
, force
)
122 Lisp_Object object
, *begin
, *end
;
128 CHECK_STRING_OR_BUFFER (object
);
129 CHECK_NUMBER_COERCE_MARKER (*begin
);
130 CHECK_NUMBER_COERCE_MARKER (*end
);
132 /* If we are asked for a point, but from a subr which operates
133 on a range, then return nothing. */
134 if (EQ (*begin
, *end
) && begin
!= end
)
135 return NULL_INTERVAL
;
137 if (XINT (*begin
) > XINT (*end
))
145 if (BUFFERP (object
))
147 register struct buffer
*b
= XBUFFER (object
);
149 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
150 && XINT (*end
) <= BUF_ZV (b
)))
151 args_out_of_range (*begin
, *end
);
152 i
= BUF_INTERVALS (b
);
154 /* If there's no text, there are no properties. */
155 if (BUF_BEGV (b
) == BUF_ZV (b
))
156 return NULL_INTERVAL
;
158 searchpos
= XINT (*begin
);
162 int len
= SCHARS (object
);
164 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
165 && XINT (*end
) <= len
))
166 args_out_of_range (*begin
, *end
);
167 XSETFASTINT (*begin
, XFASTINT (*begin
));
169 XSETFASTINT (*end
, XFASTINT (*end
));
170 i
= STRING_INTERVALS (object
);
173 return NULL_INTERVAL
;
175 searchpos
= XINT (*begin
);
178 if (NULL_INTERVAL_P (i
))
179 return (force
? create_root_interval (object
) : i
);
181 return find_interval (i
, searchpos
);
184 /* Validate LIST as a property list. If LIST is not a list, then
185 make one consisting of (LIST nil). Otherwise, verify that LIST
186 is even numbered and thus suitable as a plist. */
189 validate_plist (list
)
198 register Lisp_Object tail
;
199 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
205 error ("Odd length text property list");
209 return Fcons (list
, Fcons (Qnil
, Qnil
));
212 /* Return nonzero if interval I has all the properties,
213 with the same values, of list PLIST. */
216 interval_has_all_properties (plist
, i
)
220 register Lisp_Object tail1
, tail2
, sym1
;
223 /* Go through each element of PLIST. */
224 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
229 /* Go through I's plist, looking for sym1 */
230 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
231 if (EQ (sym1
, Fcar (tail2
)))
233 /* Found the same property on both lists. If the
234 values are unequal, return zero. */
235 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
238 /* Property has same value on both lists; go to next one. */
250 /* Return nonzero if the plist of interval I has any of the
251 properties of PLIST, regardless of their values. */
254 interval_has_some_properties (plist
, i
)
258 register Lisp_Object tail1
, tail2
, sym
;
260 /* Go through each element of PLIST. */
261 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
265 /* Go through i's plist, looking for tail1 */
266 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
267 if (EQ (sym
, Fcar (tail2
)))
274 /* Return nonzero if the plist of interval I has any of the
275 property names in LIST, regardless of their values. */
278 interval_has_some_properties_list (list
, i
)
282 register Lisp_Object tail1
, tail2
, sym
;
284 /* Go through each element of LIST. */
285 for (tail1
= list
; ! NILP (tail1
); tail1
= XCDR (tail1
))
289 /* Go through i's plist, looking for tail1 */
290 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= XCDR (XCDR (tail2
)))
291 if (EQ (sym
, XCAR (tail2
)))
298 /* Changing the plists of individual intervals. */
300 /* Return the value of PROP in property-list PLIST, or Qunbound if it
303 property_value (plist
, prop
)
304 Lisp_Object plist
, prop
;
308 while (PLIST_ELT_P (plist
, value
))
309 if (EQ (XCAR (plist
), prop
))
312 plist
= XCDR (value
);
317 /* Set the properties of INTERVAL to PROPERTIES,
318 and record undo info for the previous values.
319 OBJECT is the string or buffer that INTERVAL belongs to. */
322 set_properties (properties
, interval
, object
)
323 Lisp_Object properties
, object
;
326 Lisp_Object sym
, value
;
328 if (BUFFERP (object
))
330 /* For each property in the old plist which is missing from PROPERTIES,
331 or has a different value in PROPERTIES, make an undo record. */
332 for (sym
= interval
->plist
;
333 PLIST_ELT_P (sym
, value
);
335 if (! EQ (property_value (properties
, XCAR (sym
)),
338 record_property_change (interval
->position
, LENGTH (interval
),
339 XCAR (sym
), XCAR (value
),
343 /* For each new property that has no value at all in the old plist,
344 make an undo record binding it to nil, so it will be removed. */
345 for (sym
= properties
;
346 PLIST_ELT_P (sym
, value
);
348 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
350 record_property_change (interval
->position
, LENGTH (interval
),
356 /* Store new properties. */
357 interval
->plist
= Fcopy_sequence (properties
);
360 /* Add the properties of PLIST to the interval I, or set
361 the value of I's property to the value of the property on PLIST
362 if they are different.
364 OBJECT should be the string or buffer the interval is in.
366 Return nonzero if this changes I (i.e., if any members of PLIST
367 are actually added to I's plist) */
370 add_properties (plist
, i
, object
)
375 Lisp_Object tail1
, tail2
, sym1
, val1
;
376 register int changed
= 0;
378 struct gcpro gcpro1
, gcpro2
, gcpro3
;
383 /* No need to protect OBJECT, because we can GC only in the case
384 where it is a buffer, and live buffers are always protected.
385 I and its plist are also protected, via OBJECT. */
386 GCPRO3 (tail1
, sym1
, val1
);
388 /* Go through each element of PLIST. */
389 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
392 val1
= Fcar (Fcdr (tail1
));
395 /* Go through I's plist, looking for sym1 */
396 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
397 if (EQ (sym1
, Fcar (tail2
)))
399 /* No need to gcpro, because tail2 protects this
400 and it must be a cons cell (we get an error otherwise). */
401 register Lisp_Object this_cdr
;
403 this_cdr
= Fcdr (tail2
);
404 /* Found the property. Now check its value. */
407 /* The properties have the same value on both lists.
408 Continue to the next property. */
409 if (EQ (val1
, Fcar (this_cdr
)))
412 /* Record this change in the buffer, for undo purposes. */
413 if (BUFFERP (object
))
415 record_property_change (i
->position
, LENGTH (i
),
416 sym1
, Fcar (this_cdr
), object
);
419 /* I's property has a different value -- change it */
420 Fsetcar (this_cdr
, val1
);
427 /* Record this change in the buffer, for undo purposes. */
428 if (BUFFERP (object
))
430 record_property_change (i
->position
, LENGTH (i
),
433 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
443 /* For any members of PLIST, or LIST,
444 which are properties of I, remove them from I's plist.
445 (If PLIST is non-nil, use that, otherwise use LIST.)
446 OBJECT is the string or buffer containing I. */
449 remove_properties (plist
, list
, i
, object
)
450 Lisp_Object plist
, list
;
454 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
455 register int changed
= 0;
457 /* Nonzero means tail1 is a plist, otherwise it is a list. */
460 current_plist
= i
->plist
;
463 tail1
= plist
, use_plist
= 1;
465 tail1
= list
, use_plist
= 0;
467 /* Go through each element of LIST or PLIST. */
468 while (CONSP (tail1
))
472 /* First, remove the symbol if it's at the head of the list */
473 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
475 if (BUFFERP (object
))
476 record_property_change (i
->position
, LENGTH (i
),
477 sym
, XCAR (XCDR (current_plist
)),
480 current_plist
= XCDR (XCDR (current_plist
));
484 /* Go through I's plist, looking for SYM. */
485 tail2
= current_plist
;
486 while (! NILP (tail2
))
488 register Lisp_Object
this;
489 this = XCDR (XCDR (tail2
));
490 if (CONSP (this) && EQ (sym
, XCAR (this)))
492 if (BUFFERP (object
))
493 record_property_change (i
->position
, LENGTH (i
),
494 sym
, XCAR (XCDR (this)), object
);
496 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
502 /* Advance thru TAIL1 one way or the other. */
503 tail1
= XCDR (tail1
);
504 if (use_plist
&& CONSP (tail1
))
505 tail1
= XCDR (tail1
);
509 i
->plist
= current_plist
;
514 /* Remove all properties from interval I. Return non-zero
515 if this changes the interval. */
529 /* Returns the interval of POSITION in OBJECT.
530 POSITION is BEG-based. */
533 interval_of (position
, object
)
541 XSETBUFFER (object
, current_buffer
);
542 else if (EQ (object
, Qt
))
543 return NULL_INTERVAL
;
545 CHECK_STRING_OR_BUFFER (object
);
547 if (BUFFERP (object
))
549 register struct buffer
*b
= XBUFFER (object
);
553 i
= BUF_INTERVALS (b
);
558 end
= SCHARS (object
);
559 i
= STRING_INTERVALS (object
);
562 if (!(beg
<= position
&& position
<= end
))
563 args_out_of_range (make_number (position
), make_number (position
));
564 if (beg
== end
|| NULL_INTERVAL_P (i
))
565 return NULL_INTERVAL
;
567 return find_interval (i
, position
);
570 DEFUN ("text-properties-at", Ftext_properties_at
,
571 Stext_properties_at
, 1, 2, 0,
572 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
573 If the optional second argument OBJECT is a buffer (or nil, which means
574 the current buffer), POSITION is a buffer position (integer or marker).
575 If OBJECT is a string, POSITION is a 0-based index into it.
576 If POSITION is at the end of OBJECT, the value is nil. */)
578 Lisp_Object position
, object
;
583 XSETBUFFER (object
, current_buffer
);
585 i
= validate_interval_range (object
, &position
, &position
, soft
);
586 if (NULL_INTERVAL_P (i
))
588 /* If POSITION is at the end of the interval,
589 it means it's the end of OBJECT.
590 There are no properties at the very end,
591 since no character follows. */
592 if (XINT (position
) == LENGTH (i
) + i
->position
)
598 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
599 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
600 OBJECT is optional and defaults to the current buffer.
601 If POSITION is at the end of OBJECT, the value is nil. */)
602 (position
, prop
, object
)
603 Lisp_Object position
, object
;
606 return textget (Ftext_properties_at (position
, object
), prop
);
609 /* Return the value of char's property PROP, in OBJECT at POSITION.
610 OBJECT is optional and defaults to the current buffer.
611 If OVERLAY is non-0, then in the case that the returned property is from
612 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
613 returned in *OVERLAY.
614 If POSITION is at the end of OBJECT, the value is nil.
615 If OBJECT is a buffer, then overlay properties are considered as well as
617 If OBJECT is a window, then that window's buffer is used, but
618 window-specific overlays are considered only if they are associated
621 get_char_property_and_overlay (position
, prop
, object
, overlay
)
622 Lisp_Object position
, object
;
623 register Lisp_Object prop
;
624 Lisp_Object
*overlay
;
626 struct window
*w
= 0;
628 CHECK_NUMBER_COERCE_MARKER (position
);
631 XSETBUFFER (object
, current_buffer
);
633 if (WINDOWP (object
))
635 w
= XWINDOW (object
);
638 if (BUFFERP (object
))
641 Lisp_Object
*overlay_vec
;
642 struct buffer
*obuf
= current_buffer
;
644 set_buffer_temp (XBUFFER (object
));
646 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
647 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
649 set_buffer_temp (obuf
);
651 /* Now check the overlays in order of decreasing priority. */
652 while (--noverlays
>= 0)
654 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
658 /* Return the overlay we got the property from. */
659 *overlay
= overlay_vec
[noverlays
];
666 /* Indicate that the return value is not from an overlay. */
669 /* Not a buffer, or no appropriate overlay, so fall through to the
671 return Fget_text_property (position
, prop
, object
);
674 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
675 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
676 Both overlay properties and text properties are checked.
677 OBJECT is optional and defaults to the current buffer.
678 If POSITION is at the end of OBJECT, the value is nil.
679 If OBJECT is a buffer, then overlay properties are considered as well as
681 If OBJECT is a window, then that window's buffer is used, but window-specific
682 overlays are considered only if they are associated with OBJECT. */)
683 (position
, prop
, object
)
684 Lisp_Object position
, object
;
685 register Lisp_Object prop
;
687 return get_char_property_and_overlay (position
, prop
, object
, 0);
690 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
691 Sget_char_property_and_overlay
, 2, 3, 0,
692 doc
: /* Like `get-char-property', but with extra overlay information.
693 Return a cons whose car is the return value of `get-char-property'
694 with the same arguments, that is, the value of POSITION's property
695 PROP in OBJECT, and whose cdr is the overlay in which the property was
696 found, or nil, if it was found as a text property or not found at all.
697 OBJECT is optional and defaults to the current buffer. OBJECT may be
698 a string, a buffer or a window. For strings, the cdr of the return
699 value is always nil, since strings do not have overlays. If OBJECT is
700 a window, then that window's buffer is used, but window-specific
701 overlays are considered only if they are associated with OBJECT. If
702 POSITION is at the end of OBJECT, both car and cdr are nil. */)
703 (position
, prop
, object
)
704 Lisp_Object position
, object
;
705 register Lisp_Object prop
;
709 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
710 return Fcons(val
, overlay
);
714 DEFUN ("next-char-property-change", Fnext_char_property_change
,
715 Snext_char_property_change
, 1, 2, 0,
716 doc
: /* Return the position of next text property or overlay change.
717 This scans characters forward in the current buffer from POSITION till
718 it finds a change in some text property, or the beginning or end of an
719 overlay, and returns the position of that.
720 If none is found up to (point-max), the function returns (point-max).
722 If the optional second argument LIMIT is non-nil, don't search
723 past position LIMIT; return LIMIT if nothing is found before LIMIT.
724 LIMIT is a no-op if it is greater than (point-max). */)
726 Lisp_Object position
, limit
;
730 temp
= Fnext_overlay_change (position
);
733 CHECK_NUMBER_COERCE_MARKER (limit
);
734 if (XINT (limit
) < XINT (temp
))
737 return Fnext_property_change (position
, Qnil
, temp
);
740 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
741 Sprevious_char_property_change
, 1, 2, 0,
742 doc
: /* Return the position of previous text property or overlay change.
743 Scans characters backward in the current buffer from POSITION till it
744 finds a change in some text property, or the beginning or end of an
745 overlay, and returns the position of that.
746 If none is found since (point-min), the function returns (point-min).
748 If the optional second argument LIMIT is non-nil, don't search
749 past position LIMIT; return LIMIT if nothing is found before LIMIT.
750 LIMIT is a no-op if it is less than (point-min). */)
752 Lisp_Object position
, limit
;
756 temp
= Fprevious_overlay_change (position
);
759 CHECK_NUMBER_COERCE_MARKER (limit
);
760 if (XINT (limit
) > XINT (temp
))
763 return Fprevious_property_change (position
, Qnil
, temp
);
767 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
768 Snext_single_char_property_change
, 2, 4, 0,
769 doc
: /* Return the position of next text property or overlay change for a specific property.
770 Scans characters forward from POSITION till it finds
771 a change in the PROP property, then returns the position of the change.
772 If the optional third argument OBJECT is a buffer (or nil, which means
773 the current buffer), POSITION is a buffer position (integer or marker).
774 If OBJECT is a string, POSITION is a 0-based index into it.
776 In a string, scan runs to the end of the string.
777 In a buffer, it runs to (point-max), and the value cannot exceed that.
779 The property values are compared with `eq'.
780 If the property is constant all the way to the end of OBJECT, return the
781 last valid position in OBJECT.
782 If the optional fourth argument LIMIT is non-nil, don't search
783 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
784 (position
, prop
, object
, limit
)
785 Lisp_Object prop
, position
, object
, limit
;
787 if (STRINGP (object
))
789 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
793 position
= make_number (SCHARS (object
));
796 CHECK_NUMBER (limit
);
803 Lisp_Object initial_value
, value
;
804 int count
= SPECPDL_INDEX ();
807 CHECK_BUFFER (object
);
809 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
811 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
812 Fset_buffer (object
);
815 CHECK_NUMBER_COERCE_MARKER (position
);
817 initial_value
= Fget_char_property (position
, prop
, object
);
820 XSETFASTINT (limit
, ZV
);
822 CHECK_NUMBER_COERCE_MARKER (limit
);
824 if (XFASTINT (position
) >= XFASTINT (limit
))
827 if (XFASTINT (position
) > ZV
)
828 XSETFASTINT (position
, ZV
);
833 position
= Fnext_char_property_change (position
, limit
);
834 if (XFASTINT (position
) >= XFASTINT (limit
))
840 value
= Fget_char_property (position
, prop
, object
);
841 if (!EQ (value
, initial_value
))
845 unbind_to (count
, Qnil
);
851 DEFUN ("previous-single-char-property-change",
852 Fprevious_single_char_property_change
,
853 Sprevious_single_char_property_change
, 2, 4, 0,
854 doc
: /* Return the position of previous text property or overlay change for a specific property.
855 Scans characters backward from POSITION till it finds
856 a change in the PROP property, then returns the position of the change.
857 If the optional third argument OBJECT is a buffer (or nil, which means
858 the current buffer), POSITION is a buffer position (integer or marker).
859 If OBJECT is a string, POSITION is a 0-based index into it.
861 In a string, scan runs to the start of the string.
862 In a buffer, it runs to (point-min), and the value cannot be less than that.
864 The property values are compared with `eq'.
865 If the property is constant all the way to the start of OBJECT, return the
866 first valid position in OBJECT.
867 If the optional fourth argument LIMIT is non-nil, don't search
868 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
869 (position
, prop
, object
, limit
)
870 Lisp_Object prop
, position
, object
, limit
;
872 if (STRINGP (object
))
874 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
878 position
= make_number (SCHARS (object
));
881 CHECK_NUMBER (limit
);
888 int count
= SPECPDL_INDEX ();
891 CHECK_BUFFER (object
);
893 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
895 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
896 Fset_buffer (object
);
899 CHECK_NUMBER_COERCE_MARKER (position
);
902 XSETFASTINT (limit
, BEGV
);
904 CHECK_NUMBER_COERCE_MARKER (limit
);
906 if (XFASTINT (position
) <= XFASTINT (limit
))
909 if (XFASTINT (position
) < BEGV
)
910 XSETFASTINT (position
, BEGV
);
914 Lisp_Object initial_value
915 = Fget_char_property (make_number (XFASTINT (position
) - 1),
920 position
= Fprevious_char_property_change (position
, limit
);
922 if (XFASTINT (position
) <= XFASTINT (limit
))
930 = Fget_char_property (make_number (XFASTINT (position
) - 1),
933 if (!EQ (value
, initial_value
))
939 unbind_to (count
, Qnil
);
945 DEFUN ("next-property-change", Fnext_property_change
,
946 Snext_property_change
, 1, 3, 0,
947 doc
: /* Return the position of next property change.
948 Scans characters forward from POSITION in OBJECT till it finds
949 a change in some text property, then returns the position of the change.
950 If the optional second argument OBJECT is a buffer (or nil, which means
951 the current buffer), POSITION is a buffer position (integer or marker).
952 If OBJECT is a string, POSITION is a 0-based index into it.
953 Return nil if the property is constant all the way to the end of OBJECT.
954 If the value is non-nil, it is a position greater than POSITION, never equal.
956 If the optional third argument LIMIT is non-nil, don't search
957 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
958 (position
, object
, limit
)
959 Lisp_Object position
, object
, limit
;
961 register INTERVAL i
, next
;
964 XSETBUFFER (object
, current_buffer
);
966 if (!NILP (limit
) && !EQ (limit
, Qt
))
967 CHECK_NUMBER_COERCE_MARKER (limit
);
969 i
= validate_interval_range (object
, &position
, &position
, soft
);
971 /* If LIMIT is t, return start of next interval--don't
972 bother checking further intervals. */
975 if (NULL_INTERVAL_P (i
))
978 next
= next_interval (i
);
980 if (NULL_INTERVAL_P (next
))
981 XSETFASTINT (position
, (STRINGP (object
)
983 : BUF_ZV (XBUFFER (object
))));
985 XSETFASTINT (position
, next
->position
);
989 if (NULL_INTERVAL_P (i
))
992 next
= next_interval (i
);
994 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
995 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
996 next
= next_interval (next
);
998 if (NULL_INTERVAL_P (next
))
1001 XSETFASTINT (limit
, (STRINGP (object
)
1003 : BUF_ZV (XBUFFER (object
))));
1004 if (!(next
->position
< XFASTINT (limit
)))
1007 XSETFASTINT (position
, next
->position
);
1011 /* Return 1 if there's a change in some property between BEG and END. */
1014 property_change_between_p (beg
, end
)
1017 register INTERVAL i
, next
;
1018 Lisp_Object object
, pos
;
1020 XSETBUFFER (object
, current_buffer
);
1021 XSETFASTINT (pos
, beg
);
1023 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
1024 if (NULL_INTERVAL_P (i
))
1027 next
= next_interval (i
);
1028 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
1030 next
= next_interval (next
);
1031 if (NULL_INTERVAL_P (next
))
1033 if (next
->position
>= end
)
1037 if (NULL_INTERVAL_P (next
))
1043 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1044 Snext_single_property_change
, 2, 4, 0,
1045 doc
: /* Return the position of next property change for a specific property.
1046 Scans characters forward from POSITION till it finds
1047 a change in the PROP property, then returns the position of the change.
1048 If the optional third argument OBJECT is a buffer (or nil, which means
1049 the current buffer), POSITION is a buffer position (integer or marker).
1050 If OBJECT is a string, POSITION is a 0-based index into it.
1051 The property values are compared with `eq'.
1052 Return nil if the property is constant all the way to the end of OBJECT.
1053 If the value is non-nil, it is a position greater than POSITION, never equal.
1055 If the optional fourth argument LIMIT is non-nil, don't search
1056 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1057 (position
, prop
, object
, limit
)
1058 Lisp_Object position
, prop
, object
, limit
;
1060 register INTERVAL i
, next
;
1061 register Lisp_Object here_val
;
1064 XSETBUFFER (object
, current_buffer
);
1067 CHECK_NUMBER_COERCE_MARKER (limit
);
1069 i
= validate_interval_range (object
, &position
, &position
, soft
);
1070 if (NULL_INTERVAL_P (i
))
1073 here_val
= textget (i
->plist
, prop
);
1074 next
= next_interval (i
);
1075 while (! NULL_INTERVAL_P (next
)
1076 && EQ (here_val
, textget (next
->plist
, prop
))
1077 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1078 next
= next_interval (next
);
1080 if (NULL_INTERVAL_P (next
))
1083 XSETFASTINT (limit
, (STRINGP (object
)
1085 : BUF_ZV (XBUFFER (object
))));
1086 if (!(next
->position
< XFASTINT (limit
)))
1089 return make_number (next
->position
);
1092 DEFUN ("previous-property-change", Fprevious_property_change
,
1093 Sprevious_property_change
, 1, 3, 0,
1094 doc
: /* Return the position of previous property change.
1095 Scans characters backwards from POSITION in OBJECT till it finds
1096 a change in some text property, then returns the position of the change.
1097 If the optional second argument OBJECT is a buffer (or nil, which means
1098 the current buffer), POSITION is a buffer position (integer or marker).
1099 If OBJECT is a string, POSITION is a 0-based index into it.
1100 Return nil if the property is constant all the way to the start of OBJECT.
1101 If the value is non-nil, it is a position less than POSITION, never equal.
1103 If the optional third argument LIMIT is non-nil, don't search
1104 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1105 (position
, object
, limit
)
1106 Lisp_Object position
, object
, limit
;
1108 register INTERVAL i
, previous
;
1111 XSETBUFFER (object
, current_buffer
);
1114 CHECK_NUMBER_COERCE_MARKER (limit
);
1116 i
= validate_interval_range (object
, &position
, &position
, soft
);
1117 if (NULL_INTERVAL_P (i
))
1120 /* Start with the interval containing the char before point. */
1121 if (i
->position
== XFASTINT (position
))
1122 i
= previous_interval (i
);
1124 previous
= previous_interval (i
);
1125 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1127 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1128 previous
= previous_interval (previous
);
1129 if (NULL_INTERVAL_P (previous
))
1132 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1133 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1136 return make_number (previous
->position
+ LENGTH (previous
));
1139 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1140 Sprevious_single_property_change
, 2, 4, 0,
1141 doc
: /* Return the position of previous property change for a specific property.
1142 Scans characters backward from POSITION till it finds
1143 a change in the PROP property, then returns the position of the change.
1144 If the optional third argument OBJECT is a buffer (or nil, which means
1145 the current buffer), POSITION is a buffer position (integer or marker).
1146 If OBJECT is a string, POSITION is a 0-based index into it.
1147 The property values are compared with `eq'.
1148 Return nil if the property is constant all the way to the start of OBJECT.
1149 If the value is non-nil, it is a position less than POSITION, never equal.
1151 If the optional fourth argument LIMIT is non-nil, don't search
1152 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1153 (position
, prop
, object
, limit
)
1154 Lisp_Object position
, prop
, object
, limit
;
1156 register INTERVAL i
, previous
;
1157 register Lisp_Object here_val
;
1160 XSETBUFFER (object
, current_buffer
);
1163 CHECK_NUMBER_COERCE_MARKER (limit
);
1165 i
= validate_interval_range (object
, &position
, &position
, soft
);
1167 /* Start with the interval containing the char before point. */
1168 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1169 i
= previous_interval (i
);
1171 if (NULL_INTERVAL_P (i
))
1174 here_val
= textget (i
->plist
, prop
);
1175 previous
= previous_interval (i
);
1176 while (!NULL_INTERVAL_P (previous
)
1177 && EQ (here_val
, textget (previous
->plist
, prop
))
1179 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1180 previous
= previous_interval (previous
);
1181 if (NULL_INTERVAL_P (previous
))
1184 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1185 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1188 return make_number (previous
->position
+ LENGTH (previous
));
1191 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1193 DEFUN ("add-text-properties", Fadd_text_properties
,
1194 Sadd_text_properties
, 3, 4, 0,
1195 doc
: /* Add properties to the text from START to END.
1196 The third argument PROPERTIES is a property list
1197 specifying the property values to add. If the optional fourth argument
1198 OBJECT is a buffer (or nil, which means the current buffer),
1199 START and END are buffer positions (integers or markers).
1200 If OBJECT is a string, START and END are 0-based indices into it.
1201 Return t if any property value actually changed, nil otherwise. */)
1202 (start
, end
, properties
, object
)
1203 Lisp_Object start
, end
, properties
, object
;
1205 register INTERVAL i
, unchanged
;
1206 register int s
, len
, modified
= 0;
1207 struct gcpro gcpro1
;
1209 properties
= validate_plist (properties
);
1210 if (NILP (properties
))
1214 XSETBUFFER (object
, current_buffer
);
1216 i
= validate_interval_range (object
, &start
, &end
, hard
);
1217 if (NULL_INTERVAL_P (i
))
1221 len
= XINT (end
) - s
;
1223 /* No need to protect OBJECT, because we GC only if it's a buffer,
1224 and live buffers are always protected. */
1225 GCPRO1 (properties
);
1227 /* If we're not starting on an interval boundary, we have to
1228 split this interval. */
1229 if (i
->position
!= s
)
1231 /* If this interval already has the properties, we can
1233 if (interval_has_all_properties (properties
, i
))
1235 int got
= (LENGTH (i
) - (s
- i
->position
));
1237 RETURN_UNGCPRO (Qnil
);
1239 i
= next_interval (i
);
1244 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1245 copy_properties (unchanged
, i
);
1249 if (BUFFERP (object
))
1250 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1252 /* We are at the beginning of interval I, with LEN chars to scan. */
1258 if (LENGTH (i
) >= len
)
1260 /* We can UNGCPRO safely here, because there will be just
1261 one more chance to gc, in the next call to add_properties,
1262 and after that we will not need PROPERTIES or OBJECT again. */
1265 if (interval_has_all_properties (properties
, i
))
1267 if (BUFFERP (object
))
1268 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1269 XINT (end
) - XINT (start
));
1271 return modified
? Qt
: Qnil
;
1274 if (LENGTH (i
) == len
)
1276 add_properties (properties
, i
, object
);
1277 if (BUFFERP (object
))
1278 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1279 XINT (end
) - XINT (start
));
1283 /* i doesn't have the properties, and goes past the change limit */
1285 i
= split_interval_left (unchanged
, len
);
1286 copy_properties (unchanged
, i
);
1287 add_properties (properties
, i
, object
);
1288 if (BUFFERP (object
))
1289 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1290 XINT (end
) - XINT (start
));
1295 modified
+= add_properties (properties
, i
, object
);
1296 i
= next_interval (i
);
1300 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1302 DEFUN ("put-text-property", Fput_text_property
,
1303 Sput_text_property
, 4, 5, 0,
1304 doc
: /* Set one property of the text from START to END.
1305 The third and fourth arguments PROPERTY and VALUE
1306 specify the property to add.
1307 If the optional fifth argument OBJECT is a buffer (or nil, which means
1308 the current buffer), START and END are buffer positions (integers or
1309 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1310 (start
, end
, property
, value
, object
)
1311 Lisp_Object start
, end
, property
, value
, object
;
1313 Fadd_text_properties (start
, end
,
1314 Fcons (property
, Fcons (value
, Qnil
)),
1319 DEFUN ("set-text-properties", Fset_text_properties
,
1320 Sset_text_properties
, 3, 4, 0,
1321 doc
: /* Completely replace properties of text from START to END.
1322 The third argument PROPERTIES is the new property list.
1323 If the optional fourth argument OBJECT is a buffer (or nil, which means
1324 the current buffer), START and END are buffer positions (integers or
1325 markers). If OBJECT is a string, START and END are 0-based indices into it.
1326 If PROPERTIES is nil, the effect is to remove all properties from
1327 the designated part of OBJECT. */)
1328 (start
, end
, properties
, object
)
1329 Lisp_Object start
, end
, properties
, object
;
1331 return set_text_properties (start
, end
, properties
, object
, Qt
);
1335 /* Replace properties of text from START to END with new list of
1336 properties PROPERTIES. OBJECT is the buffer or string containing
1337 the text. OBJECT nil means use the current buffer.
1338 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1339 is nil if the function _detected_ that it did not replace any
1340 properties, non-nil otherwise. */
1343 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1344 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1346 register INTERVAL i
;
1347 Lisp_Object ostart
, oend
;
1352 properties
= validate_plist (properties
);
1355 XSETBUFFER (object
, current_buffer
);
1357 /* If we want no properties for a whole string,
1358 get rid of its intervals. */
1359 if (NILP (properties
) && STRINGP (object
)
1360 && XFASTINT (start
) == 0
1361 && XFASTINT (end
) == SCHARS (object
))
1363 if (! STRING_INTERVALS (object
))
1366 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1370 i
= validate_interval_range (object
, &start
, &end
, soft
);
1372 if (NULL_INTERVAL_P (i
))
1374 /* If buffer has no properties, and we want none, return now. */
1375 if (NILP (properties
))
1378 /* Restore the original START and END values
1379 because validate_interval_range increments them for strings. */
1383 i
= validate_interval_range (object
, &start
, &end
, hard
);
1384 /* This can return if start == end. */
1385 if (NULL_INTERVAL_P (i
))
1389 if (BUFFERP (object
))
1390 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1392 set_text_properties_1 (start
, end
, properties
, object
, i
);
1394 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1395 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1396 XINT (end
) - XINT (start
));
1400 /* Replace properties of text from START to END with new list of
1401 properties PROPERTIES. BUFFER is the buffer containing
1402 the text. This does not obey any hooks.
1403 You can provide the interval that START is located in as I,
1404 or pass NULL for I and this function will find it.
1405 START and END can be in any order. */
1408 set_text_properties_1 (start
, end
, properties
, buffer
, i
)
1409 Lisp_Object start
, end
, properties
, buffer
;
1412 register INTERVAL prev_changed
= NULL_INTERVAL
;
1413 register int s
, len
;
1417 len
= XINT (end
) - s
;
1427 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1429 if (i
->position
!= s
)
1432 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1434 if (LENGTH (i
) > len
)
1436 copy_properties (unchanged
, i
);
1437 i
= split_interval_left (i
, len
);
1438 set_properties (properties
, i
, buffer
);
1442 set_properties (properties
, i
, buffer
);
1444 if (LENGTH (i
) == len
)
1449 i
= next_interval (i
);
1452 /* We are starting at the beginning of an interval, I */
1458 if (LENGTH (i
) >= len
)
1460 if (LENGTH (i
) > len
)
1461 i
= split_interval_left (i
, len
);
1463 /* We have to call set_properties even if we are going to
1464 merge the intervals, so as to make the undo records
1465 and cause redisplay to happen. */
1466 set_properties (properties
, i
, buffer
);
1467 if (!NULL_INTERVAL_P (prev_changed
))
1468 merge_interval_left (i
);
1474 /* We have to call set_properties even if we are going to
1475 merge the intervals, so as to make the undo records
1476 and cause redisplay to happen. */
1477 set_properties (properties
, i
, buffer
);
1478 if (NULL_INTERVAL_P (prev_changed
))
1481 prev_changed
= i
= merge_interval_left (i
);
1483 i
= next_interval (i
);
1487 DEFUN ("remove-text-properties", Fremove_text_properties
,
1488 Sremove_text_properties
, 3, 4, 0,
1489 doc
: /* Remove some properties from text from START to END.
1490 The third argument PROPERTIES is a property list
1491 whose property names specify the properties to remove.
1492 \(The values stored in PROPERTIES are ignored.)
1493 If the optional fourth argument OBJECT is a buffer (or nil, which means
1494 the current buffer), START and END are buffer positions (integers or
1495 markers). If OBJECT is a string, START and END are 0-based indices into it.
1496 Return t if any property was actually removed, nil otherwise.
1498 Use set-text-properties if you want to remove all text properties. */)
1499 (start
, end
, properties
, object
)
1500 Lisp_Object start
, end
, properties
, object
;
1502 register INTERVAL i
, unchanged
;
1503 register int s
, len
, modified
= 0;
1506 XSETBUFFER (object
, current_buffer
);
1508 i
= validate_interval_range (object
, &start
, &end
, soft
);
1509 if (NULL_INTERVAL_P (i
))
1513 len
= XINT (end
) - s
;
1515 if (i
->position
!= s
)
1517 /* No properties on this first interval -- return if
1518 it covers the entire region. */
1519 if (! interval_has_some_properties (properties
, i
))
1521 int got
= (LENGTH (i
) - (s
- i
->position
));
1525 i
= next_interval (i
);
1527 /* Split away the beginning of this interval; what we don't
1532 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1533 copy_properties (unchanged
, i
);
1537 if (BUFFERP (object
))
1538 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1540 /* We are at the beginning of an interval, with len to scan */
1546 if (LENGTH (i
) >= len
)
1548 if (! interval_has_some_properties (properties
, i
))
1549 return modified
? Qt
: Qnil
;
1551 if (LENGTH (i
) == len
)
1553 remove_properties (properties
, Qnil
, i
, object
);
1554 if (BUFFERP (object
))
1555 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1556 XINT (end
) - XINT (start
));
1560 /* i has the properties, and goes past the change limit */
1562 i
= split_interval_left (i
, len
);
1563 copy_properties (unchanged
, i
);
1564 remove_properties (properties
, Qnil
, i
, object
);
1565 if (BUFFERP (object
))
1566 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1567 XINT (end
) - XINT (start
));
1572 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1573 i
= next_interval (i
);
1577 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1578 Sremove_list_of_text_properties
, 3, 4, 0,
1579 doc
: /* Remove some properties from text from START to END.
1580 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1581 If the optional fourth argument OBJECT is a buffer (or nil, which means
1582 the current buffer), START and END are buffer positions (integers or
1583 markers). If OBJECT is a string, START and END are 0-based indices into it.
1584 Return t if any property was actually removed, nil otherwise. */)
1585 (start
, end
, list_of_properties
, object
)
1586 Lisp_Object start
, end
, list_of_properties
, object
;
1588 register INTERVAL i
, unchanged
;
1589 register int s
, len
, modified
= 0;
1590 Lisp_Object properties
;
1591 properties
= list_of_properties
;
1594 XSETBUFFER (object
, current_buffer
);
1596 i
= validate_interval_range (object
, &start
, &end
, soft
);
1597 if (NULL_INTERVAL_P (i
))
1601 len
= XINT (end
) - s
;
1603 if (i
->position
!= s
)
1605 /* No properties on this first interval -- return if
1606 it covers the entire region. */
1607 if (! interval_has_some_properties_list (properties
, i
))
1609 int got
= (LENGTH (i
) - (s
- i
->position
));
1613 i
= next_interval (i
);
1615 /* Split away the beginning of this interval; what we don't
1620 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1621 copy_properties (unchanged
, i
);
1625 /* We are at the beginning of an interval, with len to scan.
1626 The flag `modified' records if changes have been made.
1627 When object is a buffer, we must call modify_region before changes are
1628 made and signal_after_change when we are done.
1629 We call modify_region before calling remove_properties iff modified == 0,
1630 and we call signal_after_change before returning iff modified != 0. */
1636 if (LENGTH (i
) >= len
)
1638 if (! interval_has_some_properties_list (properties
, i
))
1641 if (BUFFERP (object
))
1642 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1643 XINT (end
) - XINT (start
));
1649 if (LENGTH (i
) == len
)
1651 if (!modified
&& BUFFERP (object
))
1652 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1653 remove_properties (Qnil
, properties
, i
, object
);
1654 if (BUFFERP (object
))
1655 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1656 XINT (end
) - XINT (start
));
1660 /* i has the properties, and goes past the change limit */
1662 i
= split_interval_left (i
, len
);
1663 copy_properties (unchanged
, i
);
1664 if (!modified
&& BUFFERP (object
))
1665 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1666 remove_properties (Qnil
, properties
, i
, object
);
1667 if (BUFFERP (object
))
1668 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1669 XINT (end
) - XINT (start
));
1673 if (interval_has_some_properties_list (properties
, i
))
1675 if (!modified
&& BUFFERP (object
))
1676 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1677 remove_properties (Qnil
, properties
, i
, object
);
1681 i
= next_interval (i
);
1685 DEFUN ("text-property-any", Ftext_property_any
,
1686 Stext_property_any
, 4, 5, 0,
1687 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1688 If so, return the position of the first character whose property PROPERTY
1689 is `eq' to VALUE. Otherwise return nil.
1690 If the optional fifth argument OBJECT is a buffer (or nil, which means
1691 the current buffer), START and END are buffer positions (integers or
1692 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1693 (start
, end
, property
, value
, object
)
1694 Lisp_Object start
, end
, property
, value
, object
;
1696 register INTERVAL i
;
1697 register int e
, pos
;
1700 XSETBUFFER (object
, current_buffer
);
1701 i
= validate_interval_range (object
, &start
, &end
, soft
);
1702 if (NULL_INTERVAL_P (i
))
1703 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1706 while (! NULL_INTERVAL_P (i
))
1708 if (i
->position
>= e
)
1710 if (EQ (textget (i
->plist
, property
), value
))
1713 if (pos
< XINT (start
))
1715 return make_number (pos
);
1717 i
= next_interval (i
);
1722 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1723 Stext_property_not_all
, 4, 5, 0,
1724 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1725 If so, return the position of the first character whose property PROPERTY
1726 is not `eq' to VALUE. Otherwise, return nil.
1727 If the optional fifth argument OBJECT is a buffer (or nil, which means
1728 the current buffer), START and END are buffer positions (integers or
1729 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1730 (start
, end
, property
, value
, object
)
1731 Lisp_Object start
, end
, property
, value
, object
;
1733 register INTERVAL i
;
1737 XSETBUFFER (object
, current_buffer
);
1738 i
= validate_interval_range (object
, &start
, &end
, soft
);
1739 if (NULL_INTERVAL_P (i
))
1740 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1744 while (! NULL_INTERVAL_P (i
))
1746 if (i
->position
>= e
)
1748 if (! EQ (textget (i
->plist
, property
), value
))
1750 if (i
->position
> s
)
1752 return make_number (s
);
1754 i
= next_interval (i
);
1760 /* Return the direction from which the text-property PROP would be
1761 inherited by any new text inserted at POS: 1 if it would be
1762 inherited from the char after POS, -1 if it would be inherited from
1763 the char before POS, and 0 if from neither.
1764 BUFFER can be either a buffer or nil (meaning current buffer). */
1767 text_property_stickiness (prop
, pos
, buffer
)
1768 Lisp_Object prop
, pos
, buffer
;
1770 Lisp_Object prev_pos
, front_sticky
;
1771 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1774 XSETBUFFER (buffer
, current_buffer
);
1776 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1777 /* Consider previous character. */
1779 Lisp_Object rear_non_sticky
;
1781 prev_pos
= make_number (XINT (pos
) - 1);
1782 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1784 if (!NILP (CONSP (rear_non_sticky
)
1785 ? Fmemq (prop
, rear_non_sticky
)
1787 /* PROP is rear-non-sticky. */
1793 /* Consider following character. */
1794 /* This signals an arg-out-of-range error if pos is outside the
1795 buffer's accessible range. */
1796 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1798 if (EQ (front_sticky
, Qt
)
1799 || (CONSP (front_sticky
)
1800 && !NILP (Fmemq (prop
, front_sticky
))))
1801 /* PROP is inherited from after. */
1802 is_front_sticky
= 1;
1804 /* Simple cases, where the properties are consistent. */
1805 if (is_rear_sticky
&& !is_front_sticky
)
1807 else if (!is_rear_sticky
&& is_front_sticky
)
1809 else if (!is_rear_sticky
&& !is_front_sticky
)
1812 /* The stickiness properties are inconsistent, so we have to
1813 disambiguate. Basically, rear-sticky wins, _except_ if the
1814 property that would be inherited has a value of nil, in which case
1815 front-sticky wins. */
1816 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1817 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1824 /* I don't think this is the right interface to export; how often do you
1825 want to do something like this, other than when you're copying objects
1828 I think it would be better to have a pair of functions, one which
1829 returns the text properties of a region as a list of ranges and
1830 plists, and another which applies such a list to another object. */
1832 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1833 SRC and DEST may each refer to strings or buffers.
1834 Optional sixth argument PROP causes only that property to be copied.
1835 Properties are copied to DEST as if by `add-text-properties'.
1836 Return t if any property value actually changed, nil otherwise. */
1838 /* Note this can GC when DEST is a buffer. */
1841 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1842 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1848 int s
, e
, e2
, p
, len
, modified
= 0;
1849 struct gcpro gcpro1
, gcpro2
;
1851 i
= validate_interval_range (src
, &start
, &end
, soft
);
1852 if (NULL_INTERVAL_P (i
))
1855 CHECK_NUMBER_COERCE_MARKER (pos
);
1857 Lisp_Object dest_start
, dest_end
;
1860 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1861 /* Apply this to a copy of pos; it will try to increment its arguments,
1862 which we don't want. */
1863 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1874 e2
= i
->position
+ LENGTH (i
);
1881 while (! NILP (plist
))
1883 if (EQ (Fcar (plist
), prop
))
1885 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1888 plist
= Fcdr (Fcdr (plist
));
1892 /* Must defer modifications to the interval tree in case src
1893 and dest refer to the same string or buffer. */
1894 stuff
= Fcons (Fcons (make_number (p
),
1895 Fcons (make_number (p
+ len
),
1896 Fcons (plist
, Qnil
))),
1900 i
= next_interval (i
);
1901 if (NULL_INTERVAL_P (i
))
1908 GCPRO2 (stuff
, dest
);
1910 while (! NILP (stuff
))
1913 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1914 Fcar (Fcdr (Fcdr (res
))), dest
);
1917 stuff
= Fcdr (stuff
);
1922 return modified
? Qt
: Qnil
;
1926 /* Return a list representing the text properties of OBJECT between
1927 START and END. if PROP is non-nil, report only on that property.
1928 Each result list element has the form (S E PLIST), where S and E
1929 are positions in OBJECT and PLIST is a property list containing the
1930 text properties of OBJECT between S and E. Value is nil if OBJECT
1931 doesn't contain text properties between START and END. */
1934 text_property_list (object
, start
, end
, prop
)
1935 Lisp_Object object
, start
, end
, prop
;
1942 i
= validate_interval_range (object
, &start
, &end
, soft
);
1943 if (!NULL_INTERVAL_P (i
))
1945 int s
= XINT (start
);
1950 int interval_end
, len
;
1953 interval_end
= i
->position
+ LENGTH (i
);
1954 if (interval_end
> e
)
1956 len
= interval_end
- s
;
1961 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1962 if (EQ (Fcar (plist
), prop
))
1964 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1969 result
= Fcons (Fcons (make_number (s
),
1970 Fcons (make_number (s
+ len
),
1971 Fcons (plist
, Qnil
))),
1974 i
= next_interval (i
);
1975 if (NULL_INTERVAL_P (i
))
1985 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1986 (START END PLIST), where START and END are positions and PLIST is a
1987 property list containing the text properties to add. Adjust START
1988 and END positions by DELTA before adding properties. Value is
1989 non-zero if OBJECT was modified. */
1992 add_text_properties_from_list (object
, list
, delta
)
1993 Lisp_Object object
, list
, delta
;
1995 struct gcpro gcpro1
, gcpro2
;
1998 GCPRO2 (list
, object
);
2000 for (; CONSP (list
); list
= XCDR (list
))
2002 Lisp_Object item
, start
, end
, plist
, tem
;
2005 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2006 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2007 plist
= XCAR (XCDR (XCDR (item
)));
2009 tem
= Fadd_text_properties (start
, end
, plist
, object
);
2020 /* Modify end-points of ranges in LIST destructively. LIST is a list
2021 as returned from text_property_list. Change end-points equal to
2022 OLD_END to NEW_END. */
2025 extend_property_ranges (list
, old_end
, new_end
)
2026 Lisp_Object list
, old_end
, new_end
;
2028 for (; CONSP (list
); list
= XCDR (list
))
2030 Lisp_Object item
, end
;
2033 end
= XCAR (XCDR (item
));
2035 if (EQ (end
, old_end
))
2036 XSETCAR (XCDR (item
), new_end
);
2042 /* Call the modification hook functions in LIST, each with START and END. */
2045 call_mod_hooks (list
, start
, end
)
2046 Lisp_Object list
, start
, end
;
2048 struct gcpro gcpro1
;
2050 while (!NILP (list
))
2052 call2 (Fcar (list
), start
, end
);
2058 /* Check for read-only intervals between character positions START ... END,
2059 in BUF, and signal an error if we find one.
2061 Then check for any modification hooks in the range.
2062 Create a list of all these hooks in lexicographic order,
2063 eliminating consecutive extra copies of the same hook. Then call
2064 those hooks in order, with START and END - 1 as arguments. */
2067 verify_interval_modification (buf
, start
, end
)
2071 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2072 register INTERVAL i
;
2074 register Lisp_Object prev_mod_hooks
;
2075 Lisp_Object mod_hooks
;
2076 struct gcpro gcpro1
;
2079 prev_mod_hooks
= Qnil
;
2082 interval_insert_behind_hooks
= Qnil
;
2083 interval_insert_in_front_hooks
= Qnil
;
2085 if (NULL_INTERVAL_P (intervals
))
2095 /* For an insert operation, check the two chars around the position. */
2098 INTERVAL prev
= NULL
;
2099 Lisp_Object before
, after
;
2101 /* Set I to the interval containing the char after START,
2102 and PREV to the interval containing the char before START.
2103 Either one may be null. They may be equal. */
2104 i
= find_interval (intervals
, start
);
2106 if (start
== BUF_BEGV (buf
))
2108 else if (i
->position
== start
)
2109 prev
= previous_interval (i
);
2110 else if (i
->position
< start
)
2112 if (start
== BUF_ZV (buf
))
2115 /* If Vinhibit_read_only is set and is not a list, we can
2116 skip the read_only checks. */
2117 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2119 /* If I and PREV differ we need to check for the read-only
2120 property together with its stickiness. If either I or
2121 PREV are 0, this check is all we need.
2122 We have to take special care, since read-only may be
2123 indirectly defined via the category property. */
2126 if (! NULL_INTERVAL_P (i
))
2128 after
= textget (i
->plist
, Qread_only
);
2130 /* If interval I is read-only and read-only is
2131 front-sticky, inhibit insertion.
2132 Check for read-only as well as category. */
2134 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2138 tem
= textget (i
->plist
, Qfront_sticky
);
2139 if (TMEM (Qread_only
, tem
)
2140 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2141 && TMEM (Qcategory
, tem
)))
2142 text_read_only (after
);
2146 if (! NULL_INTERVAL_P (prev
))
2148 before
= textget (prev
->plist
, Qread_only
);
2150 /* If interval PREV is read-only and read-only isn't
2151 rear-nonsticky, inhibit insertion.
2152 Check for read-only as well as category. */
2154 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2158 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2159 if (! TMEM (Qread_only
, tem
)
2160 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2161 || ! TMEM (Qcategory
, tem
)))
2162 text_read_only (before
);
2166 else if (! NULL_INTERVAL_P (i
))
2168 after
= textget (i
->plist
, Qread_only
);
2170 /* If interval I is read-only and read-only is
2171 front-sticky, inhibit insertion.
2172 Check for read-only as well as category. */
2173 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2177 tem
= textget (i
->plist
, Qfront_sticky
);
2178 if (TMEM (Qread_only
, tem
)
2179 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2180 && TMEM (Qcategory
, tem
)))
2181 text_read_only (after
);
2183 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2184 if (! TMEM (Qread_only
, tem
)
2185 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2186 || ! TMEM (Qcategory
, tem
)))
2187 text_read_only (after
);
2192 /* Run both insert hooks (just once if they're the same). */
2193 if (!NULL_INTERVAL_P (prev
))
2194 interval_insert_behind_hooks
2195 = textget (prev
->plist
, Qinsert_behind_hooks
);
2196 if (!NULL_INTERVAL_P (i
))
2197 interval_insert_in_front_hooks
2198 = textget (i
->plist
, Qinsert_in_front_hooks
);
2202 /* Loop over intervals on or next to START...END,
2203 collecting their hooks. */
2205 i
= find_interval (intervals
, start
);
2208 if (! INTERVAL_WRITABLE_P (i
))
2209 text_read_only (textget (i
->plist
, Qread_only
));
2211 if (!inhibit_modification_hooks
)
2213 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2214 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2216 hooks
= Fcons (mod_hooks
, hooks
);
2217 prev_mod_hooks
= mod_hooks
;
2221 i
= next_interval (i
);
2223 /* Keep going thru the interval containing the char before END. */
2224 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2226 if (!inhibit_modification_hooks
)
2229 hooks
= Fnreverse (hooks
);
2230 while (! EQ (hooks
, Qnil
))
2232 call_mod_hooks (Fcar (hooks
), make_number (start
),
2234 hooks
= Fcdr (hooks
);
2241 /* Run the interval hooks for an insertion on character range START ... END.
2242 verify_interval_modification chose which hooks to run;
2243 this function is called after the insertion happens
2244 so it can indicate the range of inserted text. */
2247 report_interval_modification (start
, end
)
2248 Lisp_Object start
, end
;
2250 if (! NILP (interval_insert_behind_hooks
))
2251 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2252 if (! NILP (interval_insert_in_front_hooks
)
2253 && ! EQ (interval_insert_in_front_hooks
,
2254 interval_insert_behind_hooks
))
2255 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2261 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
2262 doc
: /* Property-list used as default values.
2263 The value of a property in this list is seen as the value for every
2264 character that does not have its own value for that property. */);
2265 Vdefault_text_properties
= Qnil
;
2267 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist
,
2268 doc
: /* Alist of alternative properties for properties without a value.
2269 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2270 If a piece of text has no direct value for a particular property, then
2271 this alist is consulted. If that property appears in the alist, then
2272 the first non-nil value from the associated alternative properties is
2274 Vchar_property_alias_alist
= Qnil
;
2276 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
2277 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2278 This also inhibits the use of the `intangible' text property. */);
2279 Vinhibit_point_motion_hooks
= Qnil
;
2281 DEFVAR_LISP ("text-property-default-nonsticky",
2282 &Vtext_property_default_nonsticky
,
2283 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2284 Each element has the form (PROPERTY . NONSTICKINESS).
2286 If a character in a buffer has PROPERTY, new text inserted adjacent to
2287 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2288 inherits it if NONSTICKINESS is nil. The front-sticky and
2289 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2290 /* Text property `syntax-table' should be nonsticky by default. */
2291 Vtext_property_default_nonsticky
2292 = Fcons (Fcons (intern ("syntax-table"), Qt
), Qnil
);
2294 staticpro (&interval_insert_behind_hooks
);
2295 staticpro (&interval_insert_in_front_hooks
);
2296 interval_insert_behind_hooks
= Qnil
;
2297 interval_insert_in_front_hooks
= Qnil
;
2300 /* Common attributes one might give text */
2302 staticpro (&Qforeground
);
2303 Qforeground
= intern ("foreground");
2304 staticpro (&Qbackground
);
2305 Qbackground
= intern ("background");
2307 Qfont
= intern ("font");
2308 staticpro (&Qstipple
);
2309 Qstipple
= intern ("stipple");
2310 staticpro (&Qunderline
);
2311 Qunderline
= intern ("underline");
2312 staticpro (&Qread_only
);
2313 Qread_only
= intern ("read-only");
2314 staticpro (&Qinvisible
);
2315 Qinvisible
= intern ("invisible");
2316 staticpro (&Qintangible
);
2317 Qintangible
= intern ("intangible");
2318 staticpro (&Qcategory
);
2319 Qcategory
= intern ("category");
2320 staticpro (&Qlocal_map
);
2321 Qlocal_map
= intern ("local-map");
2322 staticpro (&Qfront_sticky
);
2323 Qfront_sticky
= intern ("front-sticky");
2324 staticpro (&Qrear_nonsticky
);
2325 Qrear_nonsticky
= intern ("rear-nonsticky");
2326 staticpro (&Qmouse_face
);
2327 Qmouse_face
= intern ("mouse-face");
2329 /* Properties that text might use to specify certain actions */
2331 staticpro (&Qmouse_left
);
2332 Qmouse_left
= intern ("mouse-left");
2333 staticpro (&Qmouse_entered
);
2334 Qmouse_entered
= intern ("mouse-entered");
2335 staticpro (&Qpoint_left
);
2336 Qpoint_left
= intern ("point-left");
2337 staticpro (&Qpoint_entered
);
2338 Qpoint_entered
= intern ("point-entered");
2340 defsubr (&Stext_properties_at
);
2341 defsubr (&Sget_text_property
);
2342 defsubr (&Sget_char_property
);
2343 defsubr (&Sget_char_property_and_overlay
);
2344 defsubr (&Snext_char_property_change
);
2345 defsubr (&Sprevious_char_property_change
);
2346 defsubr (&Snext_single_char_property_change
);
2347 defsubr (&Sprevious_single_char_property_change
);
2348 defsubr (&Snext_property_change
);
2349 defsubr (&Snext_single_property_change
);
2350 defsubr (&Sprevious_property_change
);
2351 defsubr (&Sprevious_single_property_change
);
2352 defsubr (&Sadd_text_properties
);
2353 defsubr (&Sput_text_property
);
2354 defsubr (&Sset_text_properties
);
2355 defsubr (&Sremove_text_properties
);
2356 defsubr (&Sremove_list_of_text_properties
);
2357 defsubr (&Stext_property_any
);
2358 defsubr (&Stext_property_not_all
);
2359 /* defsubr (&Serase_text_properties); */
2360 /* defsubr (&Scopy_text_properties); */
2363 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2364 (do not change this comment) */