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. */
1791 /* Consider following character. */
1792 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1794 if (EQ (front_sticky
, Qt
)
1795 || (CONSP (front_sticky
)
1796 && !NILP (Fmemq (prop
, front_sticky
))))
1797 /* PROP is inherited from after. */
1798 is_front_sticky
= 1;
1800 /* Simple cases, where the properties are consistent. */
1801 if (is_rear_sticky
&& !is_front_sticky
)
1803 else if (!is_rear_sticky
&& is_front_sticky
)
1805 else if (!is_rear_sticky
&& !is_front_sticky
)
1808 /* The stickiness properties are inconsistent, so we have to
1809 disambiguate. Basically, rear-sticky wins, _except_ if the
1810 property that would be inherited has a value of nil, in which case
1811 front-sticky wins. */
1812 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1813 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1820 /* I don't think this is the right interface to export; how often do you
1821 want to do something like this, other than when you're copying objects
1824 I think it would be better to have a pair of functions, one which
1825 returns the text properties of a region as a list of ranges and
1826 plists, and another which applies such a list to another object. */
1828 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1829 SRC and DEST may each refer to strings or buffers.
1830 Optional sixth argument PROP causes only that property to be copied.
1831 Properties are copied to DEST as if by `add-text-properties'.
1832 Return t if any property value actually changed, nil otherwise. */
1834 /* Note this can GC when DEST is a buffer. */
1837 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1838 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1844 int s
, e
, e2
, p
, len
, modified
= 0;
1845 struct gcpro gcpro1
, gcpro2
;
1847 i
= validate_interval_range (src
, &start
, &end
, soft
);
1848 if (NULL_INTERVAL_P (i
))
1851 CHECK_NUMBER_COERCE_MARKER (pos
);
1853 Lisp_Object dest_start
, dest_end
;
1856 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1857 /* Apply this to a copy of pos; it will try to increment its arguments,
1858 which we don't want. */
1859 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1870 e2
= i
->position
+ LENGTH (i
);
1877 while (! NILP (plist
))
1879 if (EQ (Fcar (plist
), prop
))
1881 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1884 plist
= Fcdr (Fcdr (plist
));
1888 /* Must defer modifications to the interval tree in case src
1889 and dest refer to the same string or buffer. */
1890 stuff
= Fcons (Fcons (make_number (p
),
1891 Fcons (make_number (p
+ len
),
1892 Fcons (plist
, Qnil
))),
1896 i
= next_interval (i
);
1897 if (NULL_INTERVAL_P (i
))
1904 GCPRO2 (stuff
, dest
);
1906 while (! NILP (stuff
))
1909 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1910 Fcar (Fcdr (Fcdr (res
))), dest
);
1913 stuff
= Fcdr (stuff
);
1918 return modified
? Qt
: Qnil
;
1922 /* Return a list representing the text properties of OBJECT between
1923 START and END. if PROP is non-nil, report only on that property.
1924 Each result list element has the form (S E PLIST), where S and E
1925 are positions in OBJECT and PLIST is a property list containing the
1926 text properties of OBJECT between S and E. Value is nil if OBJECT
1927 doesn't contain text properties between START and END. */
1930 text_property_list (object
, start
, end
, prop
)
1931 Lisp_Object object
, start
, end
, prop
;
1938 i
= validate_interval_range (object
, &start
, &end
, soft
);
1939 if (!NULL_INTERVAL_P (i
))
1941 int s
= XINT (start
);
1946 int interval_end
, len
;
1949 interval_end
= i
->position
+ LENGTH (i
);
1950 if (interval_end
> e
)
1952 len
= interval_end
- s
;
1957 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1958 if (EQ (Fcar (plist
), prop
))
1960 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1965 result
= Fcons (Fcons (make_number (s
),
1966 Fcons (make_number (s
+ len
),
1967 Fcons (plist
, Qnil
))),
1970 i
= next_interval (i
);
1971 if (NULL_INTERVAL_P (i
))
1981 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1982 (START END PLIST), where START and END are positions and PLIST is a
1983 property list containing the text properties to add. Adjust START
1984 and END positions by DELTA before adding properties. Value is
1985 non-zero if OBJECT was modified. */
1988 add_text_properties_from_list (object
, list
, delta
)
1989 Lisp_Object object
, list
, delta
;
1991 struct gcpro gcpro1
, gcpro2
;
1994 GCPRO2 (list
, object
);
1996 for (; CONSP (list
); list
= XCDR (list
))
1998 Lisp_Object item
, start
, end
, plist
, tem
;
2001 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2002 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2003 plist
= XCAR (XCDR (XCDR (item
)));
2005 tem
= Fadd_text_properties (start
, end
, plist
, object
);
2016 /* Modify end-points of ranges in LIST destructively. LIST is a list
2017 as returned from text_property_list. Change end-points equal to
2018 OLD_END to NEW_END. */
2021 extend_property_ranges (list
, old_end
, new_end
)
2022 Lisp_Object list
, old_end
, new_end
;
2024 for (; CONSP (list
); list
= XCDR (list
))
2026 Lisp_Object item
, end
;
2029 end
= XCAR (XCDR (item
));
2031 if (EQ (end
, old_end
))
2032 XSETCAR (XCDR (item
), new_end
);
2038 /* Call the modification hook functions in LIST, each with START and END. */
2041 call_mod_hooks (list
, start
, end
)
2042 Lisp_Object list
, start
, end
;
2044 struct gcpro gcpro1
;
2046 while (!NILP (list
))
2048 call2 (Fcar (list
), start
, end
);
2054 /* Check for read-only intervals between character positions START ... END,
2055 in BUF, and signal an error if we find one.
2057 Then check for any modification hooks in the range.
2058 Create a list of all these hooks in lexicographic order,
2059 eliminating consecutive extra copies of the same hook. Then call
2060 those hooks in order, with START and END - 1 as arguments. */
2063 verify_interval_modification (buf
, start
, end
)
2067 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2068 register INTERVAL i
;
2070 register Lisp_Object prev_mod_hooks
;
2071 Lisp_Object mod_hooks
;
2072 struct gcpro gcpro1
;
2075 prev_mod_hooks
= Qnil
;
2078 interval_insert_behind_hooks
= Qnil
;
2079 interval_insert_in_front_hooks
= Qnil
;
2081 if (NULL_INTERVAL_P (intervals
))
2091 /* For an insert operation, check the two chars around the position. */
2094 INTERVAL prev
= NULL
;
2095 Lisp_Object before
, after
;
2097 /* Set I to the interval containing the char after START,
2098 and PREV to the interval containing the char before START.
2099 Either one may be null. They may be equal. */
2100 i
= find_interval (intervals
, start
);
2102 if (start
== BUF_BEGV (buf
))
2104 else if (i
->position
== start
)
2105 prev
= previous_interval (i
);
2106 else if (i
->position
< start
)
2108 if (start
== BUF_ZV (buf
))
2111 /* If Vinhibit_read_only is set and is not a list, we can
2112 skip the read_only checks. */
2113 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2115 /* If I and PREV differ we need to check for the read-only
2116 property together with its stickiness. If either I or
2117 PREV are 0, this check is all we need.
2118 We have to take special care, since read-only may be
2119 indirectly defined via the category property. */
2122 if (! NULL_INTERVAL_P (i
))
2124 after
= textget (i
->plist
, Qread_only
);
2126 /* If interval I is read-only and read-only is
2127 front-sticky, inhibit insertion.
2128 Check for read-only as well as category. */
2130 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2134 tem
= textget (i
->plist
, Qfront_sticky
);
2135 if (TMEM (Qread_only
, tem
)
2136 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2137 && TMEM (Qcategory
, tem
)))
2138 text_read_only (after
);
2142 if (! NULL_INTERVAL_P (prev
))
2144 before
= textget (prev
->plist
, Qread_only
);
2146 /* If interval PREV is read-only and read-only isn't
2147 rear-nonsticky, inhibit insertion.
2148 Check for read-only as well as category. */
2150 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2154 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2155 if (! TMEM (Qread_only
, tem
)
2156 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2157 || ! TMEM (Qcategory
, tem
)))
2158 text_read_only (before
);
2162 else if (! NULL_INTERVAL_P (i
))
2164 after
= textget (i
->plist
, Qread_only
);
2166 /* If interval I is read-only and read-only is
2167 front-sticky, inhibit insertion.
2168 Check for read-only as well as category. */
2169 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2173 tem
= textget (i
->plist
, Qfront_sticky
);
2174 if (TMEM (Qread_only
, tem
)
2175 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2176 && TMEM (Qcategory
, tem
)))
2177 text_read_only (after
);
2179 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2180 if (! TMEM (Qread_only
, tem
)
2181 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2182 || ! TMEM (Qcategory
, tem
)))
2183 text_read_only (after
);
2188 /* Run both insert hooks (just once if they're the same). */
2189 if (!NULL_INTERVAL_P (prev
))
2190 interval_insert_behind_hooks
2191 = textget (prev
->plist
, Qinsert_behind_hooks
);
2192 if (!NULL_INTERVAL_P (i
))
2193 interval_insert_in_front_hooks
2194 = textget (i
->plist
, Qinsert_in_front_hooks
);
2198 /* Loop over intervals on or next to START...END,
2199 collecting their hooks. */
2201 i
= find_interval (intervals
, start
);
2204 if (! INTERVAL_WRITABLE_P (i
))
2205 text_read_only (textget (i
->plist
, Qread_only
));
2207 if (!inhibit_modification_hooks
)
2209 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2210 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2212 hooks
= Fcons (mod_hooks
, hooks
);
2213 prev_mod_hooks
= mod_hooks
;
2217 i
= next_interval (i
);
2219 /* Keep going thru the interval containing the char before END. */
2220 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2222 if (!inhibit_modification_hooks
)
2225 hooks
= Fnreverse (hooks
);
2226 while (! EQ (hooks
, Qnil
))
2228 call_mod_hooks (Fcar (hooks
), make_number (start
),
2230 hooks
= Fcdr (hooks
);
2237 /* Run the interval hooks for an insertion on character range START ... END.
2238 verify_interval_modification chose which hooks to run;
2239 this function is called after the insertion happens
2240 so it can indicate the range of inserted text. */
2243 report_interval_modification (start
, end
)
2244 Lisp_Object start
, end
;
2246 if (! NILP (interval_insert_behind_hooks
))
2247 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2248 if (! NILP (interval_insert_in_front_hooks
)
2249 && ! EQ (interval_insert_in_front_hooks
,
2250 interval_insert_behind_hooks
))
2251 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2257 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
2258 doc
: /* Property-list used as default values.
2259 The value of a property in this list is seen as the value for every
2260 character that does not have its own value for that property. */);
2261 Vdefault_text_properties
= Qnil
;
2263 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist
,
2264 doc
: /* Alist of alternative properties for properties without a value.
2265 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2266 If a piece of text has no direct value for a particular property, then
2267 this alist is consulted. If that property appears in the alist, then
2268 the first non-nil value from the associated alternative properties is
2270 Vchar_property_alias_alist
= Qnil
;
2272 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
2273 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2274 This also inhibits the use of the `intangible' text property. */);
2275 Vinhibit_point_motion_hooks
= Qnil
;
2277 DEFVAR_LISP ("text-property-default-nonsticky",
2278 &Vtext_property_default_nonsticky
,
2279 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2280 Each element has the form (PROPERTY . NONSTICKINESS).
2282 If a character in a buffer has PROPERTY, new text inserted adjacent to
2283 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2284 inherits it if NONSTICKINESS is nil. The front-sticky and
2285 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2286 /* Text property `syntax-table' should be nonsticky by default. */
2287 Vtext_property_default_nonsticky
2288 = Fcons (Fcons (intern ("syntax-table"), Qt
), Qnil
);
2290 staticpro (&interval_insert_behind_hooks
);
2291 staticpro (&interval_insert_in_front_hooks
);
2292 interval_insert_behind_hooks
= Qnil
;
2293 interval_insert_in_front_hooks
= Qnil
;
2296 /* Common attributes one might give text */
2298 staticpro (&Qforeground
);
2299 Qforeground
= intern ("foreground");
2300 staticpro (&Qbackground
);
2301 Qbackground
= intern ("background");
2303 Qfont
= intern ("font");
2304 staticpro (&Qstipple
);
2305 Qstipple
= intern ("stipple");
2306 staticpro (&Qunderline
);
2307 Qunderline
= intern ("underline");
2308 staticpro (&Qread_only
);
2309 Qread_only
= intern ("read-only");
2310 staticpro (&Qinvisible
);
2311 Qinvisible
= intern ("invisible");
2312 staticpro (&Qintangible
);
2313 Qintangible
= intern ("intangible");
2314 staticpro (&Qcategory
);
2315 Qcategory
= intern ("category");
2316 staticpro (&Qlocal_map
);
2317 Qlocal_map
= intern ("local-map");
2318 staticpro (&Qfront_sticky
);
2319 Qfront_sticky
= intern ("front-sticky");
2320 staticpro (&Qrear_nonsticky
);
2321 Qrear_nonsticky
= intern ("rear-nonsticky");
2322 staticpro (&Qmouse_face
);
2323 Qmouse_face
= intern ("mouse-face");
2325 /* Properties that text might use to specify certain actions */
2327 staticpro (&Qmouse_left
);
2328 Qmouse_left
= intern ("mouse-left");
2329 staticpro (&Qmouse_entered
);
2330 Qmouse_entered
= intern ("mouse-entered");
2331 staticpro (&Qpoint_left
);
2332 Qpoint_left
= intern ("point-left");
2333 staticpro (&Qpoint_entered
);
2334 Qpoint_entered
= intern ("point-entered");
2336 defsubr (&Stext_properties_at
);
2337 defsubr (&Sget_text_property
);
2338 defsubr (&Sget_char_property
);
2339 defsubr (&Sget_char_property_and_overlay
);
2340 defsubr (&Snext_char_property_change
);
2341 defsubr (&Sprevious_char_property_change
);
2342 defsubr (&Snext_single_char_property_change
);
2343 defsubr (&Sprevious_single_char_property_change
);
2344 defsubr (&Snext_property_change
);
2345 defsubr (&Snext_single_property_change
);
2346 defsubr (&Sprevious_property_change
);
2347 defsubr (&Sprevious_single_property_change
);
2348 defsubr (&Sadd_text_properties
);
2349 defsubr (&Sput_text_property
);
2350 defsubr (&Sset_text_properties
);
2351 defsubr (&Sremove_text_properties
);
2352 defsubr (&Sremove_list_of_text_properties
);
2353 defsubr (&Stext_property_any
);
2354 defsubr (&Stext_property_not_all
);
2355 /* defsubr (&Serase_text_properties); */
2356 /* defsubr (&Scopy_text_properties); */
2359 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2360 (do not change this comment) */