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 The value is a cons cell. Its 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. Its 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.
698 OBJECT is optional and defaults to the current buffer. OBJECT may be
699 a string, a buffer or a window. For strings, the cdr of the return
700 value is always nil, since strings do not have overlays. If OBJECT is
701 a window, then that window's buffer is used, but window-specific
702 overlays are considered only if they are associated with OBJECT. If
703 POSITION is at the end of OBJECT, both car and cdr are nil. */)
704 (position
, prop
, object
)
705 Lisp_Object position
, object
;
706 register Lisp_Object prop
;
710 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
711 return Fcons(val
, overlay
);
715 DEFUN ("next-char-property-change", Fnext_char_property_change
,
716 Snext_char_property_change
, 1, 2, 0,
717 doc
: /* Return the position of next text property or overlay change.
718 This scans characters forward in the current buffer from POSITION till
719 it finds a change in some text property, or the beginning or end of an
720 overlay, and returns the position of that.
721 If none is found up to (point-max), the function returns (point-max).
723 If the optional second argument LIMIT is non-nil, don't search
724 past position LIMIT; return LIMIT if nothing is found before LIMIT.
725 LIMIT is a no-op if it is greater than (point-max). */)
727 Lisp_Object position
, limit
;
731 temp
= Fnext_overlay_change (position
);
734 CHECK_NUMBER_COERCE_MARKER (limit
);
735 if (XINT (limit
) < XINT (temp
))
738 return Fnext_property_change (position
, Qnil
, temp
);
741 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
742 Sprevious_char_property_change
, 1, 2, 0,
743 doc
: /* Return the position of previous text property or overlay change.
744 Scans characters backward in the current buffer from POSITION till it
745 finds a change in some text property, or the beginning or end of an
746 overlay, and returns the position of that.
747 If none is found since (point-min), the function returns (point-min).
749 If the optional second argument LIMIT is non-nil, don't search
750 past position LIMIT; return LIMIT if nothing is found before LIMIT.
751 LIMIT is a no-op if it is less than (point-min). */)
753 Lisp_Object position
, limit
;
757 temp
= Fprevious_overlay_change (position
);
760 CHECK_NUMBER_COERCE_MARKER (limit
);
761 if (XINT (limit
) > XINT (temp
))
764 return Fprevious_property_change (position
, Qnil
, temp
);
768 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
769 Snext_single_char_property_change
, 2, 4, 0,
770 doc
: /* Return the position of next text property or overlay change for a specific property.
771 Scans characters forward from POSITION till it finds
772 a change in the PROP property, then returns the position of the change.
773 If the optional third argument OBJECT is a buffer (or nil, which means
774 the current buffer), POSITION is a buffer position (integer or marker).
775 If OBJECT is a string, POSITION is a 0-based index into it.
777 In a string, scan runs to the end of the string.
778 In a buffer, it runs to (point-max), and the value cannot exceed that.
780 The property values are compared with `eq'.
781 If the property is constant all the way to the end of OBJECT, return the
782 last valid position in OBJECT.
783 If the optional fourth argument LIMIT is non-nil, don't search
784 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
785 (position
, prop
, object
, limit
)
786 Lisp_Object prop
, position
, object
, limit
;
788 if (STRINGP (object
))
790 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
794 position
= make_number (SCHARS (object
));
797 CHECK_NUMBER (limit
);
804 Lisp_Object initial_value
, value
;
805 int count
= SPECPDL_INDEX ();
808 CHECK_BUFFER (object
);
810 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
812 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
813 Fset_buffer (object
);
816 CHECK_NUMBER_COERCE_MARKER (position
);
818 initial_value
= Fget_char_property (position
, prop
, object
);
821 XSETFASTINT (limit
, ZV
);
823 CHECK_NUMBER_COERCE_MARKER (limit
);
825 if (XFASTINT (position
) >= XFASTINT (limit
))
828 if (XFASTINT (position
) > ZV
)
829 XSETFASTINT (position
, ZV
);
834 position
= Fnext_char_property_change (position
, limit
);
835 if (XFASTINT (position
) >= XFASTINT (limit
))
841 value
= Fget_char_property (position
, prop
, object
);
842 if (!EQ (value
, initial_value
))
846 unbind_to (count
, Qnil
);
852 DEFUN ("previous-single-char-property-change",
853 Fprevious_single_char_property_change
,
854 Sprevious_single_char_property_change
, 2, 4, 0,
855 doc
: /* Return the position of previous text property or overlay change for a specific property.
856 Scans characters backward from POSITION till it finds
857 a change in the PROP property, then returns the position of the change.
858 If the optional third argument OBJECT is a buffer (or nil, which means
859 the current buffer), POSITION is a buffer position (integer or marker).
860 If OBJECT is a string, POSITION is a 0-based index into it.
862 In a string, scan runs to the start of the string.
863 In a buffer, it runs to (point-min), and the value cannot be less than that.
865 The property values are compared with `eq'.
866 If the property is constant all the way to the start of OBJECT, return the
867 first valid position in OBJECT.
868 If the optional fourth argument LIMIT is non-nil, don't search
869 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
870 (position
, prop
, object
, limit
)
871 Lisp_Object prop
, position
, object
, limit
;
873 if (STRINGP (object
))
875 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
879 position
= make_number (SCHARS (object
));
882 CHECK_NUMBER (limit
);
889 int count
= SPECPDL_INDEX ();
892 CHECK_BUFFER (object
);
894 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
896 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
897 Fset_buffer (object
);
900 CHECK_NUMBER_COERCE_MARKER (position
);
903 XSETFASTINT (limit
, BEGV
);
905 CHECK_NUMBER_COERCE_MARKER (limit
);
907 if (XFASTINT (position
) <= XFASTINT (limit
))
910 if (XFASTINT (position
) < BEGV
)
911 XSETFASTINT (position
, BEGV
);
915 Lisp_Object initial_value
916 = Fget_char_property (make_number (XFASTINT (position
) - 1),
921 position
= Fprevious_char_property_change (position
, limit
);
923 if (XFASTINT (position
) <= XFASTINT (limit
))
931 = Fget_char_property (make_number (XFASTINT (position
) - 1),
934 if (!EQ (value
, initial_value
))
940 unbind_to (count
, Qnil
);
946 DEFUN ("next-property-change", Fnext_property_change
,
947 Snext_property_change
, 1, 3, 0,
948 doc
: /* Return the position of next property change.
949 Scans characters forward from POSITION in OBJECT till it finds
950 a change in some text property, then returns the position of the change.
951 If the optional second argument OBJECT is a buffer (or nil, which means
952 the current buffer), POSITION is a buffer position (integer or marker).
953 If OBJECT is a string, POSITION is a 0-based index into it.
954 Return nil if the property is constant all the way to the end of OBJECT.
955 If the value is non-nil, it is a position greater than POSITION, never equal.
957 If the optional third argument LIMIT is non-nil, don't search
958 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
959 (position
, object
, limit
)
960 Lisp_Object position
, object
, limit
;
962 register INTERVAL i
, next
;
965 XSETBUFFER (object
, current_buffer
);
967 if (!NILP (limit
) && !EQ (limit
, Qt
))
968 CHECK_NUMBER_COERCE_MARKER (limit
);
970 i
= validate_interval_range (object
, &position
, &position
, soft
);
972 /* If LIMIT is t, return start of next interval--don't
973 bother checking further intervals. */
976 if (NULL_INTERVAL_P (i
))
979 next
= next_interval (i
);
981 if (NULL_INTERVAL_P (next
))
982 XSETFASTINT (position
, (STRINGP (object
)
984 : BUF_ZV (XBUFFER (object
))));
986 XSETFASTINT (position
, next
->position
);
990 if (NULL_INTERVAL_P (i
))
993 next
= next_interval (i
);
995 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
996 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
997 next
= next_interval (next
);
999 if (NULL_INTERVAL_P (next
))
1002 XSETFASTINT (limit
, (STRINGP (object
)
1004 : BUF_ZV (XBUFFER (object
))));
1005 if (!(next
->position
< XFASTINT (limit
)))
1008 XSETFASTINT (position
, next
->position
);
1012 /* Return 1 if there's a change in some property between BEG and END. */
1015 property_change_between_p (beg
, end
)
1018 register INTERVAL i
, next
;
1019 Lisp_Object object
, pos
;
1021 XSETBUFFER (object
, current_buffer
);
1022 XSETFASTINT (pos
, beg
);
1024 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
1025 if (NULL_INTERVAL_P (i
))
1028 next
= next_interval (i
);
1029 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
1031 next
= next_interval (next
);
1032 if (NULL_INTERVAL_P (next
))
1034 if (next
->position
>= end
)
1038 if (NULL_INTERVAL_P (next
))
1044 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1045 Snext_single_property_change
, 2, 4, 0,
1046 doc
: /* Return the position of next property change for a specific property.
1047 Scans characters forward from POSITION till it finds
1048 a change in the PROP property, then returns the position of the change.
1049 If the optional third argument OBJECT is a buffer (or nil, which means
1050 the current buffer), POSITION is a buffer position (integer or marker).
1051 If OBJECT is a string, POSITION is a 0-based index into it.
1052 The property values are compared with `eq'.
1053 Return nil if the property is constant all the way to the end of OBJECT.
1054 If the value is non-nil, it is a position greater than POSITION, never equal.
1056 If the optional fourth argument LIMIT is non-nil, don't search
1057 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1058 (position
, prop
, object
, limit
)
1059 Lisp_Object position
, prop
, object
, limit
;
1061 register INTERVAL i
, next
;
1062 register Lisp_Object here_val
;
1065 XSETBUFFER (object
, current_buffer
);
1068 CHECK_NUMBER_COERCE_MARKER (limit
);
1070 i
= validate_interval_range (object
, &position
, &position
, soft
);
1071 if (NULL_INTERVAL_P (i
))
1074 here_val
= textget (i
->plist
, prop
);
1075 next
= next_interval (i
);
1076 while (! NULL_INTERVAL_P (next
)
1077 && EQ (here_val
, textget (next
->plist
, prop
))
1078 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1079 next
= next_interval (next
);
1081 if (NULL_INTERVAL_P (next
))
1084 XSETFASTINT (limit
, (STRINGP (object
)
1086 : BUF_ZV (XBUFFER (object
))));
1087 if (!(next
->position
< XFASTINT (limit
)))
1090 return make_number (next
->position
);
1093 DEFUN ("previous-property-change", Fprevious_property_change
,
1094 Sprevious_property_change
, 1, 3, 0,
1095 doc
: /* Return the position of previous property change.
1096 Scans characters backwards from POSITION in OBJECT till it finds
1097 a change in some text property, then returns the position of the change.
1098 If the optional second argument OBJECT is a buffer (or nil, which means
1099 the current buffer), POSITION is a buffer position (integer or marker).
1100 If OBJECT is a string, POSITION is a 0-based index into it.
1101 Return nil if the property is constant all the way to the start of OBJECT.
1102 If the value is non-nil, it is a position less than POSITION, never equal.
1104 If the optional third argument LIMIT is non-nil, don't search
1105 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1106 (position
, object
, limit
)
1107 Lisp_Object position
, object
, limit
;
1109 register INTERVAL i
, previous
;
1112 XSETBUFFER (object
, current_buffer
);
1115 CHECK_NUMBER_COERCE_MARKER (limit
);
1117 i
= validate_interval_range (object
, &position
, &position
, soft
);
1118 if (NULL_INTERVAL_P (i
))
1121 /* Start with the interval containing the char before point. */
1122 if (i
->position
== XFASTINT (position
))
1123 i
= previous_interval (i
);
1125 previous
= previous_interval (i
);
1126 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1128 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1129 previous
= previous_interval (previous
);
1130 if (NULL_INTERVAL_P (previous
))
1133 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1134 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1137 return make_number (previous
->position
+ LENGTH (previous
));
1140 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1141 Sprevious_single_property_change
, 2, 4, 0,
1142 doc
: /* Return the position of previous property change for a specific property.
1143 Scans characters backward from POSITION till it finds
1144 a change in the PROP property, then returns the position of the change.
1145 If the optional third argument OBJECT is a buffer (or nil, which means
1146 the current buffer), POSITION is a buffer position (integer or marker).
1147 If OBJECT is a string, POSITION is a 0-based index into it.
1148 The property values are compared with `eq'.
1149 Return nil if the property is constant all the way to the start of OBJECT.
1150 If the value is non-nil, it is a position less than POSITION, never equal.
1152 If the optional fourth argument LIMIT is non-nil, don't search
1153 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1154 (position
, prop
, object
, limit
)
1155 Lisp_Object position
, prop
, object
, limit
;
1157 register INTERVAL i
, previous
;
1158 register Lisp_Object here_val
;
1161 XSETBUFFER (object
, current_buffer
);
1164 CHECK_NUMBER_COERCE_MARKER (limit
);
1166 i
= validate_interval_range (object
, &position
, &position
, soft
);
1168 /* Start with the interval containing the char before point. */
1169 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1170 i
= previous_interval (i
);
1172 if (NULL_INTERVAL_P (i
))
1175 here_val
= textget (i
->plist
, prop
);
1176 previous
= previous_interval (i
);
1177 while (!NULL_INTERVAL_P (previous
)
1178 && EQ (here_val
, textget (previous
->plist
, prop
))
1180 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1181 previous
= previous_interval (previous
);
1182 if (NULL_INTERVAL_P (previous
))
1185 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1186 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1189 return make_number (previous
->position
+ LENGTH (previous
));
1192 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1194 DEFUN ("add-text-properties", Fadd_text_properties
,
1195 Sadd_text_properties
, 3, 4, 0,
1196 doc
: /* Add properties to the text from START to END.
1197 The third argument PROPERTIES is a property list
1198 specifying the property values to add. If the optional fourth argument
1199 OBJECT is a buffer (or nil, which means the current buffer),
1200 START and END are buffer positions (integers or markers).
1201 If OBJECT is a string, START and END are 0-based indices into it.
1202 Return t if any property value actually changed, nil otherwise. */)
1203 (start
, end
, properties
, object
)
1204 Lisp_Object start
, end
, properties
, object
;
1206 register INTERVAL i
, unchanged
;
1207 register int s
, len
, modified
= 0;
1208 struct gcpro gcpro1
;
1210 properties
= validate_plist (properties
);
1211 if (NILP (properties
))
1215 XSETBUFFER (object
, current_buffer
);
1217 i
= validate_interval_range (object
, &start
, &end
, hard
);
1218 if (NULL_INTERVAL_P (i
))
1222 len
= XINT (end
) - s
;
1224 /* No need to protect OBJECT, because we GC only if it's a buffer,
1225 and live buffers are always protected. */
1226 GCPRO1 (properties
);
1228 /* If we're not starting on an interval boundary, we have to
1229 split this interval. */
1230 if (i
->position
!= s
)
1232 /* If this interval already has the properties, we can
1234 if (interval_has_all_properties (properties
, i
))
1236 int got
= (LENGTH (i
) - (s
- i
->position
));
1238 RETURN_UNGCPRO (Qnil
);
1240 i
= next_interval (i
);
1245 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1246 copy_properties (unchanged
, i
);
1250 if (BUFFERP (object
))
1251 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1253 /* We are at the beginning of interval I, with LEN chars to scan. */
1259 if (LENGTH (i
) >= len
)
1261 /* We can UNGCPRO safely here, because there will be just
1262 one more chance to gc, in the next call to add_properties,
1263 and after that we will not need PROPERTIES or OBJECT again. */
1266 if (interval_has_all_properties (properties
, i
))
1268 if (BUFFERP (object
))
1269 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1270 XINT (end
) - XINT (start
));
1272 return modified
? Qt
: Qnil
;
1275 if (LENGTH (i
) == len
)
1277 add_properties (properties
, i
, object
);
1278 if (BUFFERP (object
))
1279 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1280 XINT (end
) - XINT (start
));
1284 /* i doesn't have the properties, and goes past the change limit */
1286 i
= split_interval_left (unchanged
, len
);
1287 copy_properties (unchanged
, i
);
1288 add_properties (properties
, i
, object
);
1289 if (BUFFERP (object
))
1290 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1291 XINT (end
) - XINT (start
));
1296 modified
+= add_properties (properties
, i
, object
);
1297 i
= next_interval (i
);
1301 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1303 DEFUN ("put-text-property", Fput_text_property
,
1304 Sput_text_property
, 4, 5, 0,
1305 doc
: /* Set one property of the text from START to END.
1306 The third and fourth arguments PROPERTY and VALUE
1307 specify the property to add.
1308 If the optional fifth argument OBJECT is a buffer (or nil, which means
1309 the current buffer), START and END are buffer positions (integers or
1310 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1311 (start
, end
, property
, value
, object
)
1312 Lisp_Object start
, end
, property
, value
, object
;
1314 Fadd_text_properties (start
, end
,
1315 Fcons (property
, Fcons (value
, Qnil
)),
1320 DEFUN ("set-text-properties", Fset_text_properties
,
1321 Sset_text_properties
, 3, 4, 0,
1322 doc
: /* Completely replace properties of text from START to END.
1323 The third argument PROPERTIES is the new property list.
1324 If the optional fourth argument OBJECT is a buffer (or nil, which means
1325 the current buffer), START and END are buffer positions (integers or
1326 markers). If OBJECT is a string, START and END are 0-based indices into it.
1327 If PROPERTIES is nil, the effect is to remove all properties from
1328 the designated part of OBJECT. */)
1329 (start
, end
, properties
, object
)
1330 Lisp_Object start
, end
, properties
, object
;
1332 return set_text_properties (start
, end
, properties
, object
, Qt
);
1336 /* Replace properties of text from START to END with new list of
1337 properties PROPERTIES. OBJECT is the buffer or string containing
1338 the text. OBJECT nil means use the current buffer.
1339 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1340 is nil if the function _detected_ that it did not replace any
1341 properties, non-nil otherwise. */
1344 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1345 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1347 register INTERVAL i
;
1348 Lisp_Object ostart
, oend
;
1353 properties
= validate_plist (properties
);
1356 XSETBUFFER (object
, current_buffer
);
1358 /* If we want no properties for a whole string,
1359 get rid of its intervals. */
1360 if (NILP (properties
) && STRINGP (object
)
1361 && XFASTINT (start
) == 0
1362 && XFASTINT (end
) == SCHARS (object
))
1364 if (! STRING_INTERVALS (object
))
1367 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1371 i
= validate_interval_range (object
, &start
, &end
, soft
);
1373 if (NULL_INTERVAL_P (i
))
1375 /* If buffer has no properties, and we want none, return now. */
1376 if (NILP (properties
))
1379 /* Restore the original START and END values
1380 because validate_interval_range increments them for strings. */
1384 i
= validate_interval_range (object
, &start
, &end
, hard
);
1385 /* This can return if start == end. */
1386 if (NULL_INTERVAL_P (i
))
1390 if (BUFFERP (object
))
1391 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1393 set_text_properties_1 (start
, end
, properties
, object
, i
);
1395 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1396 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1397 XINT (end
) - XINT (start
));
1401 /* Replace properties of text from START to END with new list of
1402 properties PROPERTIES. BUFFER is the buffer containing
1403 the text. This does not obey any hooks.
1404 You can provide the interval that START is located in as I,
1405 or pass NULL for I and this function will find it.
1406 START and END can be in any order. */
1409 set_text_properties_1 (start
, end
, properties
, buffer
, i
)
1410 Lisp_Object start
, end
, properties
, buffer
;
1413 register INTERVAL prev_changed
= NULL_INTERVAL
;
1414 register int s
, len
;
1418 len
= XINT (end
) - s
;
1428 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1430 if (i
->position
!= s
)
1433 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1435 if (LENGTH (i
) > len
)
1437 copy_properties (unchanged
, i
);
1438 i
= split_interval_left (i
, len
);
1439 set_properties (properties
, i
, buffer
);
1443 set_properties (properties
, i
, buffer
);
1445 if (LENGTH (i
) == len
)
1450 i
= next_interval (i
);
1453 /* We are starting at the beginning of an interval, I */
1459 if (LENGTH (i
) >= len
)
1461 if (LENGTH (i
) > len
)
1462 i
= split_interval_left (i
, len
);
1464 /* We have to call set_properties even if we are going to
1465 merge the intervals, so as to make the undo records
1466 and cause redisplay to happen. */
1467 set_properties (properties
, i
, buffer
);
1468 if (!NULL_INTERVAL_P (prev_changed
))
1469 merge_interval_left (i
);
1475 /* We have to call set_properties even if we are going to
1476 merge the intervals, so as to make the undo records
1477 and cause redisplay to happen. */
1478 set_properties (properties
, i
, buffer
);
1479 if (NULL_INTERVAL_P (prev_changed
))
1482 prev_changed
= i
= merge_interval_left (i
);
1484 i
= next_interval (i
);
1488 DEFUN ("remove-text-properties", Fremove_text_properties
,
1489 Sremove_text_properties
, 3, 4, 0,
1490 doc
: /* Remove some properties from text from START to END.
1491 The third argument PROPERTIES is a property list
1492 whose property names specify the properties to remove.
1493 \(The values stored in PROPERTIES are ignored.)
1494 If the optional fourth argument OBJECT is a buffer (or nil, which means
1495 the current buffer), START and END are buffer positions (integers or
1496 markers). If OBJECT is a string, START and END are 0-based indices into it.
1497 Return t if any property was actually removed, nil otherwise.
1499 Use set-text-properties if you want to remove all text properties. */)
1500 (start
, end
, properties
, object
)
1501 Lisp_Object start
, end
, properties
, object
;
1503 register INTERVAL i
, unchanged
;
1504 register int s
, len
, modified
= 0;
1507 XSETBUFFER (object
, current_buffer
);
1509 i
= validate_interval_range (object
, &start
, &end
, soft
);
1510 if (NULL_INTERVAL_P (i
))
1514 len
= XINT (end
) - s
;
1516 if (i
->position
!= s
)
1518 /* No properties on this first interval -- return if
1519 it covers the entire region. */
1520 if (! interval_has_some_properties (properties
, i
))
1522 int got
= (LENGTH (i
) - (s
- i
->position
));
1526 i
= next_interval (i
);
1528 /* Split away the beginning of this interval; what we don't
1533 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1534 copy_properties (unchanged
, i
);
1538 if (BUFFERP (object
))
1539 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1541 /* We are at the beginning of an interval, with len to scan */
1547 if (LENGTH (i
) >= len
)
1549 if (! interval_has_some_properties (properties
, i
))
1550 return modified
? Qt
: Qnil
;
1552 if (LENGTH (i
) == len
)
1554 remove_properties (properties
, Qnil
, i
, object
);
1555 if (BUFFERP (object
))
1556 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1557 XINT (end
) - XINT (start
));
1561 /* i has the properties, and goes past the change limit */
1563 i
= split_interval_left (i
, len
);
1564 copy_properties (unchanged
, i
);
1565 remove_properties (properties
, Qnil
, i
, object
);
1566 if (BUFFERP (object
))
1567 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1568 XINT (end
) - XINT (start
));
1573 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1574 i
= next_interval (i
);
1578 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1579 Sremove_list_of_text_properties
, 3, 4, 0,
1580 doc
: /* Remove some properties from text from START to END.
1581 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1582 If the optional fourth argument OBJECT is a buffer (or nil, which means
1583 the current buffer), START and END are buffer positions (integers or
1584 markers). If OBJECT is a string, START and END are 0-based indices into it.
1585 Return t if any property was actually removed, nil otherwise. */)
1586 (start
, end
, list_of_properties
, object
)
1587 Lisp_Object start
, end
, list_of_properties
, object
;
1589 register INTERVAL i
, unchanged
;
1590 register int s
, len
, modified
= 0;
1591 Lisp_Object properties
;
1592 properties
= list_of_properties
;
1595 XSETBUFFER (object
, current_buffer
);
1597 i
= validate_interval_range (object
, &start
, &end
, soft
);
1598 if (NULL_INTERVAL_P (i
))
1602 len
= XINT (end
) - s
;
1604 if (i
->position
!= s
)
1606 /* No properties on this first interval -- return if
1607 it covers the entire region. */
1608 if (! interval_has_some_properties_list (properties
, i
))
1610 int got
= (LENGTH (i
) - (s
- i
->position
));
1614 i
= next_interval (i
);
1616 /* Split away the beginning of this interval; what we don't
1621 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1622 copy_properties (unchanged
, i
);
1626 /* We are at the beginning of an interval, with len to scan.
1627 The flag `modified' records if changes have been made.
1628 When object is a buffer, we must call modify_region before changes are
1629 made and signal_after_change when we are done.
1630 We call modify_region before calling remove_properties iff modified == 0,
1631 and we call signal_after_change before returning iff modified != 0. */
1637 if (LENGTH (i
) >= len
)
1639 if (! interval_has_some_properties_list (properties
, i
))
1642 if (BUFFERP (object
))
1643 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1644 XINT (end
) - XINT (start
));
1650 if (LENGTH (i
) == len
)
1652 if (!modified
&& BUFFERP (object
))
1653 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1654 remove_properties (Qnil
, properties
, i
, object
);
1655 if (BUFFERP (object
))
1656 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1657 XINT (end
) - XINT (start
));
1661 /* i has the properties, and goes past the change limit */
1663 i
= split_interval_left (i
, len
);
1664 copy_properties (unchanged
, i
);
1665 if (!modified
&& BUFFERP (object
))
1666 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1667 remove_properties (Qnil
, properties
, i
, object
);
1668 if (BUFFERP (object
))
1669 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1670 XINT (end
) - XINT (start
));
1674 if (interval_has_some_properties_list (properties
, i
))
1676 if (!modified
&& BUFFERP (object
))
1677 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1678 remove_properties (Qnil
, properties
, i
, object
);
1682 i
= next_interval (i
);
1686 DEFUN ("text-property-any", Ftext_property_any
,
1687 Stext_property_any
, 4, 5, 0,
1688 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1689 If so, return the position of the first character whose property PROPERTY
1690 is `eq' to VALUE. Otherwise return nil.
1691 If the optional fifth argument OBJECT is a buffer (or nil, which means
1692 the current buffer), START and END are buffer positions (integers or
1693 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1694 (start
, end
, property
, value
, object
)
1695 Lisp_Object start
, end
, property
, value
, object
;
1697 register INTERVAL i
;
1698 register int e
, pos
;
1701 XSETBUFFER (object
, current_buffer
);
1702 i
= validate_interval_range (object
, &start
, &end
, soft
);
1703 if (NULL_INTERVAL_P (i
))
1704 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1707 while (! NULL_INTERVAL_P (i
))
1709 if (i
->position
>= e
)
1711 if (EQ (textget (i
->plist
, property
), value
))
1714 if (pos
< XINT (start
))
1716 return make_number (pos
);
1718 i
= next_interval (i
);
1723 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1724 Stext_property_not_all
, 4, 5, 0,
1725 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1726 If so, return the position of the first character whose property PROPERTY
1727 is not `eq' to VALUE. Otherwise, return nil.
1728 If the optional fifth argument OBJECT is a buffer (or nil, which means
1729 the current buffer), START and END are buffer positions (integers or
1730 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1731 (start
, end
, property
, value
, object
)
1732 Lisp_Object start
, end
, property
, value
, object
;
1734 register INTERVAL i
;
1738 XSETBUFFER (object
, current_buffer
);
1739 i
= validate_interval_range (object
, &start
, &end
, soft
);
1740 if (NULL_INTERVAL_P (i
))
1741 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1745 while (! NULL_INTERVAL_P (i
))
1747 if (i
->position
>= e
)
1749 if (! EQ (textget (i
->plist
, property
), value
))
1751 if (i
->position
> s
)
1753 return make_number (s
);
1755 i
= next_interval (i
);
1761 /* Return the direction from which the text-property PROP would be
1762 inherited by any new text inserted at POS: 1 if it would be
1763 inherited from the char after POS, -1 if it would be inherited from
1764 the char before POS, and 0 if from neither.
1765 BUFFER can be either a buffer or nil (meaning current buffer). */
1768 text_property_stickiness (prop
, pos
, buffer
)
1769 Lisp_Object prop
, pos
, buffer
;
1771 Lisp_Object prev_pos
, front_sticky
;
1772 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1775 XSETBUFFER (buffer
, current_buffer
);
1777 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1778 /* Consider previous character. */
1780 Lisp_Object rear_non_sticky
;
1782 prev_pos
= make_number (XINT (pos
) - 1);
1783 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1785 if (!NILP (CONSP (rear_non_sticky
)
1786 ? Fmemq (prop
, rear_non_sticky
)
1788 /* PROP is rear-non-sticky. */
1794 /* Consider following character. */
1795 /* This signals an arg-out-of-range error if pos is outside the
1796 buffer's accessible range. */
1797 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1799 if (EQ (front_sticky
, Qt
)
1800 || (CONSP (front_sticky
)
1801 && !NILP (Fmemq (prop
, front_sticky
))))
1802 /* PROP is inherited from after. */
1803 is_front_sticky
= 1;
1805 /* Simple cases, where the properties are consistent. */
1806 if (is_rear_sticky
&& !is_front_sticky
)
1808 else if (!is_rear_sticky
&& is_front_sticky
)
1810 else if (!is_rear_sticky
&& !is_front_sticky
)
1813 /* The stickiness properties are inconsistent, so we have to
1814 disambiguate. Basically, rear-sticky wins, _except_ if the
1815 property that would be inherited has a value of nil, in which case
1816 front-sticky wins. */
1817 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1818 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1825 /* I don't think this is the right interface to export; how often do you
1826 want to do something like this, other than when you're copying objects
1829 I think it would be better to have a pair of functions, one which
1830 returns the text properties of a region as a list of ranges and
1831 plists, and another which applies such a list to another object. */
1833 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1834 SRC and DEST may each refer to strings or buffers.
1835 Optional sixth argument PROP causes only that property to be copied.
1836 Properties are copied to DEST as if by `add-text-properties'.
1837 Return t if any property value actually changed, nil otherwise. */
1839 /* Note this can GC when DEST is a buffer. */
1842 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1843 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1849 int s
, e
, e2
, p
, len
, modified
= 0;
1850 struct gcpro gcpro1
, gcpro2
;
1852 i
= validate_interval_range (src
, &start
, &end
, soft
);
1853 if (NULL_INTERVAL_P (i
))
1856 CHECK_NUMBER_COERCE_MARKER (pos
);
1858 Lisp_Object dest_start
, dest_end
;
1861 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1862 /* Apply this to a copy of pos; it will try to increment its arguments,
1863 which we don't want. */
1864 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1875 e2
= i
->position
+ LENGTH (i
);
1882 while (! NILP (plist
))
1884 if (EQ (Fcar (plist
), prop
))
1886 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1889 plist
= Fcdr (Fcdr (plist
));
1893 /* Must defer modifications to the interval tree in case src
1894 and dest refer to the same string or buffer. */
1895 stuff
= Fcons (Fcons (make_number (p
),
1896 Fcons (make_number (p
+ len
),
1897 Fcons (plist
, Qnil
))),
1901 i
= next_interval (i
);
1902 if (NULL_INTERVAL_P (i
))
1909 GCPRO2 (stuff
, dest
);
1911 while (! NILP (stuff
))
1914 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1915 Fcar (Fcdr (Fcdr (res
))), dest
);
1918 stuff
= Fcdr (stuff
);
1923 return modified
? Qt
: Qnil
;
1927 /* Return a list representing the text properties of OBJECT between
1928 START and END. if PROP is non-nil, report only on that property.
1929 Each result list element has the form (S E PLIST), where S and E
1930 are positions in OBJECT and PLIST is a property list containing the
1931 text properties of OBJECT between S and E. Value is nil if OBJECT
1932 doesn't contain text properties between START and END. */
1935 text_property_list (object
, start
, end
, prop
)
1936 Lisp_Object object
, start
, end
, prop
;
1943 i
= validate_interval_range (object
, &start
, &end
, soft
);
1944 if (!NULL_INTERVAL_P (i
))
1946 int s
= XINT (start
);
1951 int interval_end
, len
;
1954 interval_end
= i
->position
+ LENGTH (i
);
1955 if (interval_end
> e
)
1957 len
= interval_end
- s
;
1962 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1963 if (EQ (Fcar (plist
), prop
))
1965 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1970 result
= Fcons (Fcons (make_number (s
),
1971 Fcons (make_number (s
+ len
),
1972 Fcons (plist
, Qnil
))),
1975 i
= next_interval (i
);
1976 if (NULL_INTERVAL_P (i
))
1986 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1987 (START END PLIST), where START and END are positions and PLIST is a
1988 property list containing the text properties to add. Adjust START
1989 and END positions by DELTA before adding properties. Value is
1990 non-zero if OBJECT was modified. */
1993 add_text_properties_from_list (object
, list
, delta
)
1994 Lisp_Object object
, list
, delta
;
1996 struct gcpro gcpro1
, gcpro2
;
1999 GCPRO2 (list
, object
);
2001 for (; CONSP (list
); list
= XCDR (list
))
2003 Lisp_Object item
, start
, end
, plist
, tem
;
2006 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
2007 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
2008 plist
= XCAR (XCDR (XCDR (item
)));
2010 tem
= Fadd_text_properties (start
, end
, plist
, object
);
2021 /* Modify end-points of ranges in LIST destructively. LIST is a list
2022 as returned from text_property_list. Change end-points equal to
2023 OLD_END to NEW_END. */
2026 extend_property_ranges (list
, old_end
, new_end
)
2027 Lisp_Object list
, old_end
, new_end
;
2029 for (; CONSP (list
); list
= XCDR (list
))
2031 Lisp_Object item
, end
;
2034 end
= XCAR (XCDR (item
));
2036 if (EQ (end
, old_end
))
2037 XSETCAR (XCDR (item
), new_end
);
2043 /* Call the modification hook functions in LIST, each with START and END. */
2046 call_mod_hooks (list
, start
, end
)
2047 Lisp_Object list
, start
, end
;
2049 struct gcpro gcpro1
;
2051 while (!NILP (list
))
2053 call2 (Fcar (list
), start
, end
);
2059 /* Check for read-only intervals between character positions START ... END,
2060 in BUF, and signal an error if we find one.
2062 Then check for any modification hooks in the range.
2063 Create a list of all these hooks in lexicographic order,
2064 eliminating consecutive extra copies of the same hook. Then call
2065 those hooks in order, with START and END - 1 as arguments. */
2068 verify_interval_modification (buf
, start
, end
)
2072 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2073 register INTERVAL i
;
2075 register Lisp_Object prev_mod_hooks
;
2076 Lisp_Object mod_hooks
;
2077 struct gcpro gcpro1
;
2080 prev_mod_hooks
= Qnil
;
2083 interval_insert_behind_hooks
= Qnil
;
2084 interval_insert_in_front_hooks
= Qnil
;
2086 if (NULL_INTERVAL_P (intervals
))
2096 /* For an insert operation, check the two chars around the position. */
2099 INTERVAL prev
= NULL
;
2100 Lisp_Object before
, after
;
2102 /* Set I to the interval containing the char after START,
2103 and PREV to the interval containing the char before START.
2104 Either one may be null. They may be equal. */
2105 i
= find_interval (intervals
, start
);
2107 if (start
== BUF_BEGV (buf
))
2109 else if (i
->position
== start
)
2110 prev
= previous_interval (i
);
2111 else if (i
->position
< start
)
2113 if (start
== BUF_ZV (buf
))
2116 /* If Vinhibit_read_only is set and is not a list, we can
2117 skip the read_only checks. */
2118 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2120 /* If I and PREV differ we need to check for the read-only
2121 property together with its stickiness. If either I or
2122 PREV are 0, this check is all we need.
2123 We have to take special care, since read-only may be
2124 indirectly defined via the category property. */
2127 if (! NULL_INTERVAL_P (i
))
2129 after
= textget (i
->plist
, Qread_only
);
2131 /* If interval I is read-only and read-only is
2132 front-sticky, inhibit insertion.
2133 Check for read-only as well as category. */
2135 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2139 tem
= textget (i
->plist
, Qfront_sticky
);
2140 if (TMEM (Qread_only
, tem
)
2141 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2142 && TMEM (Qcategory
, tem
)))
2143 text_read_only (after
);
2147 if (! NULL_INTERVAL_P (prev
))
2149 before
= textget (prev
->plist
, Qread_only
);
2151 /* If interval PREV is read-only and read-only isn't
2152 rear-nonsticky, inhibit insertion.
2153 Check for read-only as well as category. */
2155 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2159 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2160 if (! TMEM (Qread_only
, tem
)
2161 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2162 || ! TMEM (Qcategory
, tem
)))
2163 text_read_only (before
);
2167 else if (! NULL_INTERVAL_P (i
))
2169 after
= textget (i
->plist
, Qread_only
);
2171 /* If interval I is read-only and read-only is
2172 front-sticky, inhibit insertion.
2173 Check for read-only as well as category. */
2174 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2178 tem
= textget (i
->plist
, Qfront_sticky
);
2179 if (TMEM (Qread_only
, tem
)
2180 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2181 && TMEM (Qcategory
, tem
)))
2182 text_read_only (after
);
2184 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2185 if (! TMEM (Qread_only
, tem
)
2186 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2187 || ! TMEM (Qcategory
, tem
)))
2188 text_read_only (after
);
2193 /* Run both insert hooks (just once if they're the same). */
2194 if (!NULL_INTERVAL_P (prev
))
2195 interval_insert_behind_hooks
2196 = textget (prev
->plist
, Qinsert_behind_hooks
);
2197 if (!NULL_INTERVAL_P (i
))
2198 interval_insert_in_front_hooks
2199 = textget (i
->plist
, Qinsert_in_front_hooks
);
2203 /* Loop over intervals on or next to START...END,
2204 collecting their hooks. */
2206 i
= find_interval (intervals
, start
);
2209 if (! INTERVAL_WRITABLE_P (i
))
2210 text_read_only (textget (i
->plist
, Qread_only
));
2212 if (!inhibit_modification_hooks
)
2214 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2215 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2217 hooks
= Fcons (mod_hooks
, hooks
);
2218 prev_mod_hooks
= mod_hooks
;
2222 i
= next_interval (i
);
2224 /* Keep going thru the interval containing the char before END. */
2225 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2227 if (!inhibit_modification_hooks
)
2230 hooks
= Fnreverse (hooks
);
2231 while (! EQ (hooks
, Qnil
))
2233 call_mod_hooks (Fcar (hooks
), make_number (start
),
2235 hooks
= Fcdr (hooks
);
2242 /* Run the interval hooks for an insertion on character range START ... END.
2243 verify_interval_modification chose which hooks to run;
2244 this function is called after the insertion happens
2245 so it can indicate the range of inserted text. */
2248 report_interval_modification (start
, end
)
2249 Lisp_Object start
, end
;
2251 if (! NILP (interval_insert_behind_hooks
))
2252 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2253 if (! NILP (interval_insert_in_front_hooks
)
2254 && ! EQ (interval_insert_in_front_hooks
,
2255 interval_insert_behind_hooks
))
2256 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2262 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
2263 doc
: /* Property-list used as default values.
2264 The value of a property in this list is seen as the value for every
2265 character that does not have its own value for that property. */);
2266 Vdefault_text_properties
= Qnil
;
2268 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist
,
2269 doc
: /* Alist of alternative properties for properties without a value.
2270 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2271 If a piece of text has no direct value for a particular property, then
2272 this alist is consulted. If that property appears in the alist, then
2273 the first non-nil value from the associated alternative properties is
2275 Vchar_property_alias_alist
= Qnil
;
2277 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
2278 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2279 This also inhibits the use of the `intangible' text property. */);
2280 Vinhibit_point_motion_hooks
= Qnil
;
2282 DEFVAR_LISP ("text-property-default-nonsticky",
2283 &Vtext_property_default_nonsticky
,
2284 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2285 Each element has the form (PROPERTY . NONSTICKINESS).
2287 If a character in a buffer has PROPERTY, new text inserted adjacent to
2288 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2289 inherits it if NONSTICKINESS is nil. The front-sticky and
2290 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2291 /* Text property `syntax-table' should be nonsticky by default. */
2292 Vtext_property_default_nonsticky
2293 = Fcons (Fcons (intern ("syntax-table"), Qt
), Qnil
);
2295 staticpro (&interval_insert_behind_hooks
);
2296 staticpro (&interval_insert_in_front_hooks
);
2297 interval_insert_behind_hooks
= Qnil
;
2298 interval_insert_in_front_hooks
= Qnil
;
2301 /* Common attributes one might give text */
2303 staticpro (&Qforeground
);
2304 Qforeground
= intern ("foreground");
2305 staticpro (&Qbackground
);
2306 Qbackground
= intern ("background");
2308 Qfont
= intern ("font");
2309 staticpro (&Qstipple
);
2310 Qstipple
= intern ("stipple");
2311 staticpro (&Qunderline
);
2312 Qunderline
= intern ("underline");
2313 staticpro (&Qread_only
);
2314 Qread_only
= intern ("read-only");
2315 staticpro (&Qinvisible
);
2316 Qinvisible
= intern ("invisible");
2317 staticpro (&Qintangible
);
2318 Qintangible
= intern ("intangible");
2319 staticpro (&Qcategory
);
2320 Qcategory
= intern ("category");
2321 staticpro (&Qlocal_map
);
2322 Qlocal_map
= intern ("local-map");
2323 staticpro (&Qfront_sticky
);
2324 Qfront_sticky
= intern ("front-sticky");
2325 staticpro (&Qrear_nonsticky
);
2326 Qrear_nonsticky
= intern ("rear-nonsticky");
2327 staticpro (&Qmouse_face
);
2328 Qmouse_face
= intern ("mouse-face");
2330 /* Properties that text might use to specify certain actions */
2332 staticpro (&Qmouse_left
);
2333 Qmouse_left
= intern ("mouse-left");
2334 staticpro (&Qmouse_entered
);
2335 Qmouse_entered
= intern ("mouse-entered");
2336 staticpro (&Qpoint_left
);
2337 Qpoint_left
= intern ("point-left");
2338 staticpro (&Qpoint_entered
);
2339 Qpoint_entered
= intern ("point-entered");
2341 defsubr (&Stext_properties_at
);
2342 defsubr (&Sget_text_property
);
2343 defsubr (&Sget_char_property
);
2344 defsubr (&Sget_char_property_and_overlay
);
2345 defsubr (&Snext_char_property_change
);
2346 defsubr (&Sprevious_char_property_change
);
2347 defsubr (&Snext_single_char_property_change
);
2348 defsubr (&Sprevious_single_char_property_change
);
2349 defsubr (&Snext_property_change
);
2350 defsubr (&Snext_single_property_change
);
2351 defsubr (&Sprevious_property_change
);
2352 defsubr (&Sprevious_single_property_change
);
2353 defsubr (&Sadd_text_properties
);
2354 defsubr (&Sput_text_property
);
2355 defsubr (&Sset_text_properties
);
2356 defsubr (&Sremove_text_properties
);
2357 defsubr (&Sremove_list_of_text_properties
);
2358 defsubr (&Stext_property_any
);
2359 defsubr (&Stext_property_not_all
);
2360 /* defsubr (&Serase_text_properties); */
2361 /* defsubr (&Scopy_text_properties); */
2364 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2365 (do not change this comment) */