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, 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. */)
725 Lisp_Object position
, limit
;
729 temp
= Fnext_overlay_change (position
);
732 CHECK_NUMBER_COERCE_MARKER (limit
);
733 if (XINT (limit
) < XINT (temp
))
736 return Fnext_property_change (position
, Qnil
, temp
);
739 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
740 Sprevious_char_property_change
, 1, 2, 0,
741 doc
: /* Return the position of previous text property or overlay change.
742 Scans characters backward in the current buffer from POSITION till it
743 finds a change in some text property, or the beginning or end of an
744 overlay, and returns the position of that.
745 If none is found, the function returns (point-max).
747 If the optional second argument LIMIT is non-nil, don't search
748 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
750 Lisp_Object position
, limit
;
754 temp
= Fprevious_overlay_change (position
);
757 CHECK_NUMBER_COERCE_MARKER (limit
);
758 if (XINT (limit
) > XINT (temp
))
761 return Fprevious_property_change (position
, Qnil
, temp
);
765 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
766 Snext_single_char_property_change
, 2, 4, 0,
767 doc
: /* Return the position of next text property or overlay change for a specific property.
768 Scans characters forward from POSITION till it finds
769 a change in the PROP property, then returns the position of the change.
770 If the optional third argument OBJECT is a buffer (or nil, which means
771 the current buffer), POSITION is a buffer position (integer or marker).
772 If OBJECT is a string, POSITION is a 0-based index into it.
774 The property values are compared with `eq'.
775 If the property is constant all the way to the end of OBJECT, return the
776 last valid position in OBJECT.
777 If the optional fourth argument LIMIT is non-nil, don't search
778 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
779 (position
, prop
, object
, limit
)
780 Lisp_Object prop
, position
, object
, limit
;
782 if (STRINGP (object
))
784 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
788 position
= make_number (SCHARS (object
));
791 CHECK_NUMBER (limit
);
798 Lisp_Object initial_value
, value
;
799 int count
= SPECPDL_INDEX ();
802 CHECK_BUFFER (object
);
804 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
806 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
807 Fset_buffer (object
);
810 CHECK_NUMBER_COERCE_MARKER (position
);
812 initial_value
= Fget_char_property (position
, prop
, object
);
815 XSETFASTINT (limit
, BUF_ZV (current_buffer
));
817 CHECK_NUMBER_COERCE_MARKER (limit
);
821 position
= Fnext_char_property_change (position
, limit
);
822 if (XFASTINT (position
) >= XFASTINT (limit
)) {
827 value
= Fget_char_property (position
, prop
, object
);
828 if (!EQ (value
, initial_value
))
832 unbind_to (count
, Qnil
);
838 DEFUN ("previous-single-char-property-change",
839 Fprevious_single_char_property_change
,
840 Sprevious_single_char_property_change
, 2, 4, 0,
841 doc
: /* Return the position of previous text property or overlay change for a specific property.
842 Scans characters backward from POSITION till it finds
843 a change in the PROP property, then returns the position of the change.
844 If the optional third argument OBJECT is a buffer (or nil, which means
845 the current buffer), POSITION is a buffer position (integer or marker).
846 If OBJECT is a string, POSITION is a 0-based index into it.
848 The property values are compared with `eq'.
849 If the property is constant all the way to the start of OBJECT, return the
850 first valid position in OBJECT.
851 If the optional fourth argument LIMIT is non-nil, don't search
852 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
853 (position
, prop
, object
, limit
)
854 Lisp_Object prop
, position
, object
, limit
;
856 if (STRINGP (object
))
858 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
862 position
= make_number (SCHARS (object
));
865 CHECK_NUMBER (limit
);
872 int count
= SPECPDL_INDEX ();
875 CHECK_BUFFER (object
);
877 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
879 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
880 Fset_buffer (object
);
883 CHECK_NUMBER_COERCE_MARKER (position
);
886 XSETFASTINT (limit
, BUF_BEGV (current_buffer
));
888 CHECK_NUMBER_COERCE_MARKER (limit
);
890 if (XFASTINT (position
) <= XFASTINT (limit
))
894 Lisp_Object initial_value
=
895 Fget_char_property (make_number (XFASTINT (position
) - 1),
900 position
= Fprevious_char_property_change (position
, limit
);
902 if (XFASTINT (position
) <= XFASTINT (limit
))
910 Fget_char_property (make_number (XFASTINT (position
) - 1),
913 if (!EQ (value
, initial_value
))
919 unbind_to (count
, Qnil
);
925 DEFUN ("next-property-change", Fnext_property_change
,
926 Snext_property_change
, 1, 3, 0,
927 doc
: /* Return the position of next property change.
928 Scans characters forward from POSITION in OBJECT till it finds
929 a change in some text property, then returns the position of the change.
930 If the optional second argument OBJECT is a buffer (or nil, which means
931 the current buffer), POSITION is a buffer position (integer or marker).
932 If OBJECT is a string, POSITION is a 0-based index into it.
933 Return nil if the property is constant all the way to the end of OBJECT.
934 If the value is non-nil, it is a position greater than POSITION, never equal.
936 If the optional third argument LIMIT is non-nil, don't search
937 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
938 (position
, object
, limit
)
939 Lisp_Object position
, object
, limit
;
941 register INTERVAL i
, next
;
944 XSETBUFFER (object
, current_buffer
);
946 if (!NILP (limit
) && !EQ (limit
, Qt
))
947 CHECK_NUMBER_COERCE_MARKER (limit
);
949 i
= validate_interval_range (object
, &position
, &position
, soft
);
951 /* If LIMIT is t, return start of next interval--don't
952 bother checking further intervals. */
955 if (NULL_INTERVAL_P (i
))
958 next
= next_interval (i
);
960 if (NULL_INTERVAL_P (next
))
961 XSETFASTINT (position
, (STRINGP (object
)
963 : BUF_ZV (XBUFFER (object
))));
965 XSETFASTINT (position
, next
->position
);
969 if (NULL_INTERVAL_P (i
))
972 next
= next_interval (i
);
974 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
975 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
976 next
= next_interval (next
);
978 if (NULL_INTERVAL_P (next
))
981 XSETFASTINT (limit
, (STRINGP (object
)
983 : BUF_ZV (XBUFFER (object
))));
984 if (!(next
->position
< XFASTINT (limit
)))
987 XSETFASTINT (position
, next
->position
);
991 /* Return 1 if there's a change in some property between BEG and END. */
994 property_change_between_p (beg
, end
)
997 register INTERVAL i
, next
;
998 Lisp_Object object
, pos
;
1000 XSETBUFFER (object
, current_buffer
);
1001 XSETFASTINT (pos
, beg
);
1003 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
1004 if (NULL_INTERVAL_P (i
))
1007 next
= next_interval (i
);
1008 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
1010 next
= next_interval (next
);
1011 if (NULL_INTERVAL_P (next
))
1013 if (next
->position
>= end
)
1017 if (NULL_INTERVAL_P (next
))
1023 DEFUN ("next-single-property-change", Fnext_single_property_change
,
1024 Snext_single_property_change
, 2, 4, 0,
1025 doc
: /* Return the position of next property change for a specific property.
1026 Scans characters forward from POSITION till it finds
1027 a change in the PROP property, then returns the position of the change.
1028 If the optional third argument OBJECT is a buffer (or nil, which means
1029 the current buffer), POSITION is a buffer position (integer or marker).
1030 If OBJECT is a string, POSITION is a 0-based index into it.
1031 The property values are compared with `eq'.
1032 Return nil if the property is constant all the way to the end of OBJECT.
1033 If the value is non-nil, it is a position greater than POSITION, never equal.
1035 If the optional fourth argument LIMIT is non-nil, don't search
1036 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1037 (position
, prop
, object
, limit
)
1038 Lisp_Object position
, prop
, object
, limit
;
1040 register INTERVAL i
, next
;
1041 register Lisp_Object here_val
;
1044 XSETBUFFER (object
, current_buffer
);
1047 CHECK_NUMBER_COERCE_MARKER (limit
);
1049 i
= validate_interval_range (object
, &position
, &position
, soft
);
1050 if (NULL_INTERVAL_P (i
))
1053 here_val
= textget (i
->plist
, prop
);
1054 next
= next_interval (i
);
1055 while (! NULL_INTERVAL_P (next
)
1056 && EQ (here_val
, textget (next
->plist
, prop
))
1057 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1058 next
= next_interval (next
);
1060 if (NULL_INTERVAL_P (next
))
1063 XSETFASTINT (limit
, (STRINGP (object
)
1065 : BUF_ZV (XBUFFER (object
))));
1066 if (!(next
->position
< XFASTINT (limit
)))
1069 return make_number (next
->position
);
1072 DEFUN ("previous-property-change", Fprevious_property_change
,
1073 Sprevious_property_change
, 1, 3, 0,
1074 doc
: /* Return the position of previous property change.
1075 Scans characters backwards from POSITION in OBJECT till it finds
1076 a change in some text property, then returns the position of the change.
1077 If the optional second argument OBJECT is a buffer (or nil, which means
1078 the current buffer), POSITION is a buffer position (integer or marker).
1079 If OBJECT is a string, POSITION is a 0-based index into it.
1080 Return nil if the property is constant all the way to the start of OBJECT.
1081 If the value is non-nil, it is a position less than POSITION, never equal.
1083 If the optional third argument LIMIT is non-nil, don't search
1084 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1085 (position
, object
, limit
)
1086 Lisp_Object position
, object
, limit
;
1088 register INTERVAL i
, previous
;
1091 XSETBUFFER (object
, current_buffer
);
1094 CHECK_NUMBER_COERCE_MARKER (limit
);
1096 i
= validate_interval_range (object
, &position
, &position
, soft
);
1097 if (NULL_INTERVAL_P (i
))
1100 /* Start with the interval containing the char before point. */
1101 if (i
->position
== XFASTINT (position
))
1102 i
= previous_interval (i
);
1104 previous
= previous_interval (i
);
1105 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1107 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1108 previous
= previous_interval (previous
);
1109 if (NULL_INTERVAL_P (previous
))
1112 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1113 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1116 return make_number (previous
->position
+ LENGTH (previous
));
1119 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1120 Sprevious_single_property_change
, 2, 4, 0,
1121 doc
: /* Return the position of previous property change for a specific property.
1122 Scans characters backward from POSITION till it finds
1123 a change in the PROP property, then returns the position of the change.
1124 If the optional third argument OBJECT is a buffer (or nil, which means
1125 the current buffer), POSITION is a buffer position (integer or marker).
1126 If OBJECT is a string, POSITION is a 0-based index into it.
1127 The property values are compared with `eq'.
1128 Return nil if the property is constant all the way to the start of OBJECT.
1129 If the value is non-nil, it is a position less than POSITION, never equal.
1131 If the optional fourth argument LIMIT is non-nil, don't search
1132 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1133 (position
, prop
, object
, limit
)
1134 Lisp_Object position
, prop
, object
, limit
;
1136 register INTERVAL i
, previous
;
1137 register Lisp_Object here_val
;
1140 XSETBUFFER (object
, current_buffer
);
1143 CHECK_NUMBER_COERCE_MARKER (limit
);
1145 i
= validate_interval_range (object
, &position
, &position
, soft
);
1147 /* Start with the interval containing the char before point. */
1148 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1149 i
= previous_interval (i
);
1151 if (NULL_INTERVAL_P (i
))
1154 here_val
= textget (i
->plist
, prop
);
1155 previous
= previous_interval (i
);
1156 while (!NULL_INTERVAL_P (previous
)
1157 && EQ (here_val
, textget (previous
->plist
, prop
))
1159 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1160 previous
= previous_interval (previous
);
1161 if (NULL_INTERVAL_P (previous
))
1164 XSETFASTINT (limit
, (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))));
1165 if (!(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
1168 return make_number (previous
->position
+ LENGTH (previous
));
1171 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1173 DEFUN ("add-text-properties", Fadd_text_properties
,
1174 Sadd_text_properties
, 3, 4, 0,
1175 doc
: /* Add properties to the text from START to END.
1176 The third argument PROPERTIES is a property list
1177 specifying the property values to add. If the optional fourth argument
1178 OBJECT is a buffer (or nil, which means the current buffer),
1179 START and END are buffer positions (integers or markers).
1180 If OBJECT is a string, START and END are 0-based indices into it.
1181 Return t if any property value actually changed, nil otherwise. */)
1182 (start
, end
, properties
, object
)
1183 Lisp_Object start
, end
, properties
, object
;
1185 register INTERVAL i
, unchanged
;
1186 register int s
, len
, modified
= 0;
1187 struct gcpro gcpro1
;
1189 properties
= validate_plist (properties
);
1190 if (NILP (properties
))
1194 XSETBUFFER (object
, current_buffer
);
1196 i
= validate_interval_range (object
, &start
, &end
, hard
);
1197 if (NULL_INTERVAL_P (i
))
1201 len
= XINT (end
) - s
;
1203 /* No need to protect OBJECT, because we GC only if it's a buffer,
1204 and live buffers are always protected. */
1205 GCPRO1 (properties
);
1207 /* If we're not starting on an interval boundary, we have to
1208 split this interval. */
1209 if (i
->position
!= s
)
1211 /* If this interval already has the properties, we can
1213 if (interval_has_all_properties (properties
, i
))
1215 int got
= (LENGTH (i
) - (s
- i
->position
));
1217 RETURN_UNGCPRO (Qnil
);
1219 i
= next_interval (i
);
1224 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1225 copy_properties (unchanged
, i
);
1229 if (BUFFERP (object
))
1230 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1232 /* We are at the beginning of interval I, with LEN chars to scan. */
1238 if (LENGTH (i
) >= len
)
1240 /* We can UNGCPRO safely here, because there will be just
1241 one more chance to gc, in the next call to add_properties,
1242 and after that we will not need PROPERTIES or OBJECT again. */
1245 if (interval_has_all_properties (properties
, i
))
1247 if (BUFFERP (object
))
1248 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1249 XINT (end
) - XINT (start
));
1251 return modified
? Qt
: Qnil
;
1254 if (LENGTH (i
) == len
)
1256 add_properties (properties
, i
, object
);
1257 if (BUFFERP (object
))
1258 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1259 XINT (end
) - XINT (start
));
1263 /* i doesn't have the properties, and goes past the change limit */
1265 i
= split_interval_left (unchanged
, len
);
1266 copy_properties (unchanged
, i
);
1267 add_properties (properties
, i
, object
);
1268 if (BUFFERP (object
))
1269 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1270 XINT (end
) - XINT (start
));
1275 modified
+= add_properties (properties
, i
, object
);
1276 i
= next_interval (i
);
1280 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1282 DEFUN ("put-text-property", Fput_text_property
,
1283 Sput_text_property
, 4, 5, 0,
1284 doc
: /* Set one property of the text from START to END.
1285 The third and fourth arguments PROPERTY and VALUE
1286 specify the property to add.
1287 If the optional fifth argument OBJECT is a buffer (or nil, which means
1288 the current buffer), START and END are buffer positions (integers or
1289 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1290 (start
, end
, property
, value
, object
)
1291 Lisp_Object start
, end
, property
, value
, object
;
1293 Fadd_text_properties (start
, end
,
1294 Fcons (property
, Fcons (value
, Qnil
)),
1299 DEFUN ("set-text-properties", Fset_text_properties
,
1300 Sset_text_properties
, 3, 4, 0,
1301 doc
: /* Completely replace properties of text from START to END.
1302 The third argument PROPERTIES is the new property list.
1303 If the optional fourth argument OBJECT is a buffer (or nil, which means
1304 the current buffer), START and END are buffer positions (integers or
1305 markers). If OBJECT is a string, START and END are 0-based indices into it.
1306 If PROPERTIES is nil, the effect is to remove all properties from
1307 the designated part of OBJECT. */)
1308 (start
, end
, properties
, object
)
1309 Lisp_Object start
, end
, properties
, object
;
1311 return set_text_properties (start
, end
, properties
, object
, Qt
);
1315 /* Replace properties of text from START to END with new list of
1316 properties PROPERTIES. OBJECT is the buffer or string containing
1317 the text. OBJECT nil means use the current buffer.
1318 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1319 is nil if the function _detected_ that it did not replace any
1320 properties, non-nil otherwise. */
1323 set_text_properties (start
, end
, properties
, object
, signal_after_change_p
)
1324 Lisp_Object start
, end
, properties
, object
, signal_after_change_p
;
1326 register INTERVAL i
;
1327 Lisp_Object ostart
, oend
;
1332 properties
= validate_plist (properties
);
1335 XSETBUFFER (object
, current_buffer
);
1337 /* If we want no properties for a whole string,
1338 get rid of its intervals. */
1339 if (NILP (properties
) && STRINGP (object
)
1340 && XFASTINT (start
) == 0
1341 && XFASTINT (end
) == SCHARS (object
))
1343 if (! STRING_INTERVALS (object
))
1346 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1350 i
= validate_interval_range (object
, &start
, &end
, soft
);
1352 if (NULL_INTERVAL_P (i
))
1354 /* If buffer has no properties, and we want none, return now. */
1355 if (NILP (properties
))
1358 /* Restore the original START and END values
1359 because validate_interval_range increments them for strings. */
1363 i
= validate_interval_range (object
, &start
, &end
, hard
);
1364 /* This can return if start == end. */
1365 if (NULL_INTERVAL_P (i
))
1369 if (BUFFERP (object
))
1370 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1372 set_text_properties_1 (start
, end
, properties
, object
, i
);
1374 if (BUFFERP (object
) && !NILP (signal_after_change_p
))
1375 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1376 XINT (end
) - XINT (start
));
1380 /* Replace properties of text from START to END with new list of
1381 properties PROPERTIES. BUFFER is the buffer containing
1382 the text. This does not obey any hooks.
1383 You can provide the interval that START is located in as I,
1384 or pass NULL for I and this function will find it.
1385 START and END can be in any order. */
1388 set_text_properties_1 (start
, end
, properties
, buffer
, i
)
1389 Lisp_Object start
, end
, properties
, buffer
;
1392 register INTERVAL prev_changed
= NULL_INTERVAL
;
1393 register int s
, len
;
1397 len
= XINT (end
) - s
;
1407 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1409 if (i
->position
!= s
)
1412 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1414 if (LENGTH (i
) > len
)
1416 copy_properties (unchanged
, i
);
1417 i
= split_interval_left (i
, len
);
1418 set_properties (properties
, i
, buffer
);
1422 set_properties (properties
, i
, buffer
);
1424 if (LENGTH (i
) == len
)
1429 i
= next_interval (i
);
1432 /* We are starting at the beginning of an interval, I */
1438 if (LENGTH (i
) >= len
)
1440 if (LENGTH (i
) > len
)
1441 i
= split_interval_left (i
, len
);
1443 /* We have to call set_properties even if we are going to
1444 merge the intervals, so as to make the undo records
1445 and cause redisplay to happen. */
1446 set_properties (properties
, i
, buffer
);
1447 if (!NULL_INTERVAL_P (prev_changed
))
1448 merge_interval_left (i
);
1454 /* We have to call set_properties even if we are going to
1455 merge the intervals, so as to make the undo records
1456 and cause redisplay to happen. */
1457 set_properties (properties
, i
, buffer
);
1458 if (NULL_INTERVAL_P (prev_changed
))
1461 prev_changed
= i
= merge_interval_left (i
);
1463 i
= next_interval (i
);
1467 DEFUN ("remove-text-properties", Fremove_text_properties
,
1468 Sremove_text_properties
, 3, 4, 0,
1469 doc
: /* Remove some properties from text from START to END.
1470 The third argument PROPERTIES is a property list
1471 whose property names specify the properties to remove.
1472 \(The values stored in PROPERTIES are ignored.)
1473 If the optional fourth argument OBJECT is a buffer (or nil, which means
1474 the current buffer), START and END are buffer positions (integers or
1475 markers). If OBJECT is a string, START and END are 0-based indices into it.
1476 Return t if any property was actually removed, nil otherwise.
1478 Use set-text-properties if you want to remove all text properties. */)
1479 (start
, end
, properties
, object
)
1480 Lisp_Object start
, end
, properties
, object
;
1482 register INTERVAL i
, unchanged
;
1483 register int s
, len
, modified
= 0;
1486 XSETBUFFER (object
, current_buffer
);
1488 i
= validate_interval_range (object
, &start
, &end
, soft
);
1489 if (NULL_INTERVAL_P (i
))
1493 len
= XINT (end
) - s
;
1495 if (i
->position
!= s
)
1497 /* No properties on this first interval -- return if
1498 it covers the entire region. */
1499 if (! interval_has_some_properties (properties
, i
))
1501 int got
= (LENGTH (i
) - (s
- i
->position
));
1505 i
= next_interval (i
);
1507 /* Split away the beginning of this interval; what we don't
1512 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1513 copy_properties (unchanged
, i
);
1517 if (BUFFERP (object
))
1518 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1520 /* We are at the beginning of an interval, with len to scan */
1526 if (LENGTH (i
) >= len
)
1528 if (! interval_has_some_properties (properties
, i
))
1529 return modified
? Qt
: Qnil
;
1531 if (LENGTH (i
) == len
)
1533 remove_properties (properties
, Qnil
, i
, object
);
1534 if (BUFFERP (object
))
1535 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1536 XINT (end
) - XINT (start
));
1540 /* i has the properties, and goes past the change limit */
1542 i
= split_interval_left (i
, len
);
1543 copy_properties (unchanged
, i
);
1544 remove_properties (properties
, Qnil
, i
, object
);
1545 if (BUFFERP (object
))
1546 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1547 XINT (end
) - XINT (start
));
1552 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1553 i
= next_interval (i
);
1557 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1558 Sremove_list_of_text_properties
, 3, 4, 0,
1559 doc
: /* Remove some properties from text from START to END.
1560 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1561 If the optional fourth argument OBJECT is a buffer (or nil, which means
1562 the current buffer), START and END are buffer positions (integers or
1563 markers). If OBJECT is a string, START and END are 0-based indices into it.
1564 Return t if any property was actually removed, nil otherwise. */)
1565 (start
, end
, list_of_properties
, object
)
1566 Lisp_Object start
, end
, list_of_properties
, object
;
1568 register INTERVAL i
, unchanged
;
1569 register int s
, len
, modified
= 0;
1570 Lisp_Object properties
;
1571 properties
= list_of_properties
;
1574 XSETBUFFER (object
, current_buffer
);
1576 i
= validate_interval_range (object
, &start
, &end
, soft
);
1577 if (NULL_INTERVAL_P (i
))
1581 len
= XINT (end
) - s
;
1583 if (i
->position
!= s
)
1585 /* No properties on this first interval -- return if
1586 it covers the entire region. */
1587 if (! interval_has_some_properties_list (properties
, i
))
1589 int got
= (LENGTH (i
) - (s
- i
->position
));
1593 i
= next_interval (i
);
1595 /* Split away the beginning of this interval; what we don't
1600 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1601 copy_properties (unchanged
, i
);
1605 /* We are at the beginning of an interval, with len to scan.
1606 The flag `modified' records if changes have been made.
1607 When object is a buffer, we must call modify_region before changes are
1608 made and signal_after_change when we are done.
1609 We call modify_region before calling remove_properties iff modified == 0,
1610 and we call signal_after_change before returning iff modified != 0. */
1616 if (LENGTH (i
) >= len
)
1618 if (! interval_has_some_properties_list (properties
, i
))
1621 if (BUFFERP (object
))
1622 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1623 XINT (end
) - XINT (start
));
1629 if (LENGTH (i
) == len
)
1631 if (!modified
&& BUFFERP (object
))
1632 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1633 remove_properties (Qnil
, properties
, i
, object
);
1634 if (BUFFERP (object
))
1635 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1636 XINT (end
) - XINT (start
));
1640 /* i has the properties, and goes past the change limit */
1642 i
= split_interval_left (i
, len
);
1643 copy_properties (unchanged
, i
);
1644 if (!modified
&& BUFFERP (object
))
1645 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1646 remove_properties (Qnil
, properties
, i
, object
);
1647 if (BUFFERP (object
))
1648 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1649 XINT (end
) - XINT (start
));
1653 if (interval_has_some_properties_list (properties
, i
))
1655 if (!modified
&& BUFFERP (object
))
1656 modify_region (XBUFFER (object
), XINT (start
), XINT (end
));
1657 remove_properties (Qnil
, properties
, i
, object
);
1661 i
= next_interval (i
);
1665 DEFUN ("text-property-any", Ftext_property_any
,
1666 Stext_property_any
, 4, 5, 0,
1667 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1668 If so, return the position of the first character whose property PROPERTY
1669 is `eq' to VALUE. Otherwise return nil.
1670 If the optional fifth argument OBJECT is a buffer (or nil, which means
1671 the current buffer), START and END are buffer positions (integers or
1672 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1673 (start
, end
, property
, value
, object
)
1674 Lisp_Object start
, end
, property
, value
, object
;
1676 register INTERVAL i
;
1677 register int e
, pos
;
1680 XSETBUFFER (object
, current_buffer
);
1681 i
= validate_interval_range (object
, &start
, &end
, soft
);
1682 if (NULL_INTERVAL_P (i
))
1683 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1686 while (! NULL_INTERVAL_P (i
))
1688 if (i
->position
>= e
)
1690 if (EQ (textget (i
->plist
, property
), value
))
1693 if (pos
< XINT (start
))
1695 return make_number (pos
);
1697 i
= next_interval (i
);
1702 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1703 Stext_property_not_all
, 4, 5, 0,
1704 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1705 If so, return the position of the first character whose property PROPERTY
1706 is not `eq' to VALUE. Otherwise, return nil.
1707 If the optional fifth argument OBJECT is a buffer (or nil, which means
1708 the current buffer), START and END are buffer positions (integers or
1709 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1710 (start
, end
, property
, value
, object
)
1711 Lisp_Object start
, end
, property
, value
, object
;
1713 register INTERVAL i
;
1717 XSETBUFFER (object
, current_buffer
);
1718 i
= validate_interval_range (object
, &start
, &end
, soft
);
1719 if (NULL_INTERVAL_P (i
))
1720 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1724 while (! NULL_INTERVAL_P (i
))
1726 if (i
->position
>= e
)
1728 if (! EQ (textget (i
->plist
, property
), value
))
1730 if (i
->position
> s
)
1732 return make_number (s
);
1734 i
= next_interval (i
);
1740 /* Return the direction from which the text-property PROP would be
1741 inherited by any new text inserted at POS: 1 if it would be
1742 inherited from the char after POS, -1 if it would be inherited from
1743 the char before POS, and 0 if from neither.
1744 BUFFER can be either a buffer or nil (meaning current buffer). */
1747 text_property_stickiness (prop
, pos
, buffer
)
1748 Lisp_Object prop
, pos
, buffer
;
1750 Lisp_Object prev_pos
, front_sticky
;
1751 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1754 XSETBUFFER (buffer
, current_buffer
);
1756 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1757 /* Consider previous character. */
1759 Lisp_Object rear_non_sticky
;
1761 prev_pos
= make_number (XINT (pos
) - 1);
1762 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1764 if (!NILP (CONSP (rear_non_sticky
)
1765 ? Fmemq (prop
, rear_non_sticky
)
1767 /* PROP is rear-non-sticky. */
1771 /* Consider following character. */
1772 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1774 if (EQ (front_sticky
, Qt
)
1775 || (CONSP (front_sticky
)
1776 && !NILP (Fmemq (prop
, front_sticky
))))
1777 /* PROP is inherited from after. */
1778 is_front_sticky
= 1;
1780 /* Simple cases, where the properties are consistent. */
1781 if (is_rear_sticky
&& !is_front_sticky
)
1783 else if (!is_rear_sticky
&& is_front_sticky
)
1785 else if (!is_rear_sticky
&& !is_front_sticky
)
1788 /* The stickiness properties are inconsistent, so we have to
1789 disambiguate. Basically, rear-sticky wins, _except_ if the
1790 property that would be inherited has a value of nil, in which case
1791 front-sticky wins. */
1792 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1793 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1800 /* I don't think this is the right interface to export; how often do you
1801 want to do something like this, other than when you're copying objects
1804 I think it would be better to have a pair of functions, one which
1805 returns the text properties of a region as a list of ranges and
1806 plists, and another which applies such a list to another object. */
1808 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1809 SRC and DEST may each refer to strings or buffers.
1810 Optional sixth argument PROP causes only that property to be copied.
1811 Properties are copied to DEST as if by `add-text-properties'.
1812 Return t if any property value actually changed, nil otherwise. */
1814 /* Note this can GC when DEST is a buffer. */
1817 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1818 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1824 int s
, e
, e2
, p
, len
, modified
= 0;
1825 struct gcpro gcpro1
, gcpro2
;
1827 i
= validate_interval_range (src
, &start
, &end
, soft
);
1828 if (NULL_INTERVAL_P (i
))
1831 CHECK_NUMBER_COERCE_MARKER (pos
);
1833 Lisp_Object dest_start
, dest_end
;
1836 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1837 /* Apply this to a copy of pos; it will try to increment its arguments,
1838 which we don't want. */
1839 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1850 e2
= i
->position
+ LENGTH (i
);
1857 while (! NILP (plist
))
1859 if (EQ (Fcar (plist
), prop
))
1861 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1864 plist
= Fcdr (Fcdr (plist
));
1868 /* Must defer modifications to the interval tree in case src
1869 and dest refer to the same string or buffer. */
1870 stuff
= Fcons (Fcons (make_number (p
),
1871 Fcons (make_number (p
+ len
),
1872 Fcons (plist
, Qnil
))),
1876 i
= next_interval (i
);
1877 if (NULL_INTERVAL_P (i
))
1884 GCPRO2 (stuff
, dest
);
1886 while (! NILP (stuff
))
1889 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1890 Fcar (Fcdr (Fcdr (res
))), dest
);
1893 stuff
= Fcdr (stuff
);
1898 return modified
? Qt
: Qnil
;
1902 /* Return a list representing the text properties of OBJECT between
1903 START and END. if PROP is non-nil, report only on that property.
1904 Each result list element has the form (S E PLIST), where S and E
1905 are positions in OBJECT and PLIST is a property list containing the
1906 text properties of OBJECT between S and E. Value is nil if OBJECT
1907 doesn't contain text properties between START and END. */
1910 text_property_list (object
, start
, end
, prop
)
1911 Lisp_Object object
, start
, end
, prop
;
1918 i
= validate_interval_range (object
, &start
, &end
, soft
);
1919 if (!NULL_INTERVAL_P (i
))
1921 int s
= XINT (start
);
1926 int interval_end
, len
;
1929 interval_end
= i
->position
+ LENGTH (i
);
1930 if (interval_end
> e
)
1932 len
= interval_end
- s
;
1937 for (; !NILP (plist
); plist
= Fcdr (Fcdr (plist
)))
1938 if (EQ (Fcar (plist
), prop
))
1940 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1945 result
= Fcons (Fcons (make_number (s
),
1946 Fcons (make_number (s
+ len
),
1947 Fcons (plist
, Qnil
))),
1950 i
= next_interval (i
);
1951 if (NULL_INTERVAL_P (i
))
1961 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1962 (START END PLIST), where START and END are positions and PLIST is a
1963 property list containing the text properties to add. Adjust START
1964 and END positions by DELTA before adding properties. Value is
1965 non-zero if OBJECT was modified. */
1968 add_text_properties_from_list (object
, list
, delta
)
1969 Lisp_Object object
, list
, delta
;
1971 struct gcpro gcpro1
, gcpro2
;
1974 GCPRO2 (list
, object
);
1976 for (; CONSP (list
); list
= XCDR (list
))
1978 Lisp_Object item
, start
, end
, plist
, tem
;
1981 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1982 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1983 plist
= XCAR (XCDR (XCDR (item
)));
1985 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1996 /* Modify end-points of ranges in LIST destructively. LIST is a list
1997 as returned from text_property_list. Change end-points equal to
1998 OLD_END to NEW_END. */
2001 extend_property_ranges (list
, old_end
, new_end
)
2002 Lisp_Object list
, old_end
, new_end
;
2004 for (; CONSP (list
); list
= XCDR (list
))
2006 Lisp_Object item
, end
;
2009 end
= XCAR (XCDR (item
));
2011 if (EQ (end
, old_end
))
2012 XSETCAR (XCDR (item
), new_end
);
2018 /* Call the modification hook functions in LIST, each with START and END. */
2021 call_mod_hooks (list
, start
, end
)
2022 Lisp_Object list
, start
, end
;
2024 struct gcpro gcpro1
;
2026 while (!NILP (list
))
2028 call2 (Fcar (list
), start
, end
);
2034 /* Check for read-only intervals between character positions START ... END,
2035 in BUF, and signal an error if we find one.
2037 Then check for any modification hooks in the range.
2038 Create a list of all these hooks in lexicographic order,
2039 eliminating consecutive extra copies of the same hook. Then call
2040 those hooks in order, with START and END - 1 as arguments. */
2043 verify_interval_modification (buf
, start
, end
)
2047 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2048 register INTERVAL i
;
2050 register Lisp_Object prev_mod_hooks
;
2051 Lisp_Object mod_hooks
;
2052 struct gcpro gcpro1
;
2055 prev_mod_hooks
= Qnil
;
2058 interval_insert_behind_hooks
= Qnil
;
2059 interval_insert_in_front_hooks
= Qnil
;
2061 if (NULL_INTERVAL_P (intervals
))
2071 /* For an insert operation, check the two chars around the position. */
2074 INTERVAL prev
= NULL
;
2075 Lisp_Object before
, after
;
2077 /* Set I to the interval containing the char after START,
2078 and PREV to the interval containing the char before START.
2079 Either one may be null. They may be equal. */
2080 i
= find_interval (intervals
, start
);
2082 if (start
== BUF_BEGV (buf
))
2084 else if (i
->position
== start
)
2085 prev
= previous_interval (i
);
2086 else if (i
->position
< start
)
2088 if (start
== BUF_ZV (buf
))
2091 /* If Vinhibit_read_only is set and is not a list, we can
2092 skip the read_only checks. */
2093 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2095 /* If I and PREV differ we need to check for the read-only
2096 property together with its stickiness. If either I or
2097 PREV are 0, this check is all we need.
2098 We have to take special care, since read-only may be
2099 indirectly defined via the category property. */
2102 if (! NULL_INTERVAL_P (i
))
2104 after
= textget (i
->plist
, Qread_only
);
2106 /* If interval I is read-only and read-only is
2107 front-sticky, inhibit insertion.
2108 Check for read-only as well as category. */
2110 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2114 tem
= textget (i
->plist
, Qfront_sticky
);
2115 if (TMEM (Qread_only
, tem
)
2116 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2117 && TMEM (Qcategory
, tem
)))
2118 text_read_only (after
);
2122 if (! NULL_INTERVAL_P (prev
))
2124 before
= textget (prev
->plist
, Qread_only
);
2126 /* If interval PREV is read-only and read-only isn't
2127 rear-nonsticky, inhibit insertion.
2128 Check for read-only as well as category. */
2130 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2134 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2135 if (! TMEM (Qread_only
, tem
)
2136 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2137 || ! TMEM (Qcategory
, tem
)))
2138 text_read_only (before
);
2142 else if (! NULL_INTERVAL_P (i
))
2144 after
= textget (i
->plist
, Qread_only
);
2146 /* If interval I is read-only and read-only is
2147 front-sticky, inhibit insertion.
2148 Check for read-only as well as category. */
2149 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2153 tem
= textget (i
->plist
, Qfront_sticky
);
2154 if (TMEM (Qread_only
, tem
)
2155 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2156 && TMEM (Qcategory
, tem
)))
2157 text_read_only (after
);
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 (after
);
2168 /* Run both insert hooks (just once if they're the same). */
2169 if (!NULL_INTERVAL_P (prev
))
2170 interval_insert_behind_hooks
2171 = textget (prev
->plist
, Qinsert_behind_hooks
);
2172 if (!NULL_INTERVAL_P (i
))
2173 interval_insert_in_front_hooks
2174 = textget (i
->plist
, Qinsert_in_front_hooks
);
2178 /* Loop over intervals on or next to START...END,
2179 collecting their hooks. */
2181 i
= find_interval (intervals
, start
);
2184 if (! INTERVAL_WRITABLE_P (i
))
2185 text_read_only (textget (i
->plist
, Qread_only
));
2187 if (!inhibit_modification_hooks
)
2189 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2190 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2192 hooks
= Fcons (mod_hooks
, hooks
);
2193 prev_mod_hooks
= mod_hooks
;
2197 i
= next_interval (i
);
2199 /* Keep going thru the interval containing the char before END. */
2200 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2202 if (!inhibit_modification_hooks
)
2205 hooks
= Fnreverse (hooks
);
2206 while (! EQ (hooks
, Qnil
))
2208 call_mod_hooks (Fcar (hooks
), make_number (start
),
2210 hooks
= Fcdr (hooks
);
2217 /* Run the interval hooks for an insertion on character range START ... END.
2218 verify_interval_modification chose which hooks to run;
2219 this function is called after the insertion happens
2220 so it can indicate the range of inserted text. */
2223 report_interval_modification (start
, end
)
2224 Lisp_Object start
, end
;
2226 if (! NILP (interval_insert_behind_hooks
))
2227 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2228 if (! NILP (interval_insert_in_front_hooks
)
2229 && ! EQ (interval_insert_in_front_hooks
,
2230 interval_insert_behind_hooks
))
2231 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2237 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
2238 doc
: /* Property-list used as default values.
2239 The value of a property in this list is seen as the value for every
2240 character that does not have its own value for that property. */);
2241 Vdefault_text_properties
= Qnil
;
2243 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist
,
2244 doc
: /* Alist of alternative properties for properties without a value.
2245 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2246 If a piece of text has no direct value for a particular property, then
2247 this alist is consulted. If that property appears in the alist, then
2248 the first non-nil value from the associated alternative properties is
2250 Vchar_property_alias_alist
= Qnil
;
2252 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
2253 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2254 This also inhibits the use of the `intangible' text property. */);
2255 Vinhibit_point_motion_hooks
= Qnil
;
2257 DEFVAR_LISP ("text-property-default-nonsticky",
2258 &Vtext_property_default_nonsticky
,
2259 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2260 Each element has the form (PROPERTY . NONSTICKINESS).
2262 If a character in a buffer has PROPERTY, new text inserted adjacent to
2263 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2264 inherits it if NONSTICKINESS is nil. The front-sticky and
2265 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2266 /* Text property `syntax-table' should be nonsticky by default. */
2267 Vtext_property_default_nonsticky
2268 = Fcons (Fcons (intern ("syntax-table"), Qt
), Qnil
);
2270 staticpro (&interval_insert_behind_hooks
);
2271 staticpro (&interval_insert_in_front_hooks
);
2272 interval_insert_behind_hooks
= Qnil
;
2273 interval_insert_in_front_hooks
= Qnil
;
2276 /* Common attributes one might give text */
2278 staticpro (&Qforeground
);
2279 Qforeground
= intern ("foreground");
2280 staticpro (&Qbackground
);
2281 Qbackground
= intern ("background");
2283 Qfont
= intern ("font");
2284 staticpro (&Qstipple
);
2285 Qstipple
= intern ("stipple");
2286 staticpro (&Qunderline
);
2287 Qunderline
= intern ("underline");
2288 staticpro (&Qread_only
);
2289 Qread_only
= intern ("read-only");
2290 staticpro (&Qinvisible
);
2291 Qinvisible
= intern ("invisible");
2292 staticpro (&Qintangible
);
2293 Qintangible
= intern ("intangible");
2294 staticpro (&Qcategory
);
2295 Qcategory
= intern ("category");
2296 staticpro (&Qlocal_map
);
2297 Qlocal_map
= intern ("local-map");
2298 staticpro (&Qfront_sticky
);
2299 Qfront_sticky
= intern ("front-sticky");
2300 staticpro (&Qrear_nonsticky
);
2301 Qrear_nonsticky
= intern ("rear-nonsticky");
2302 staticpro (&Qmouse_face
);
2303 Qmouse_face
= intern ("mouse-face");
2305 /* Properties that text might use to specify certain actions */
2307 staticpro (&Qmouse_left
);
2308 Qmouse_left
= intern ("mouse-left");
2309 staticpro (&Qmouse_entered
);
2310 Qmouse_entered
= intern ("mouse-entered");
2311 staticpro (&Qpoint_left
);
2312 Qpoint_left
= intern ("point-left");
2313 staticpro (&Qpoint_entered
);
2314 Qpoint_entered
= intern ("point-entered");
2316 defsubr (&Stext_properties_at
);
2317 defsubr (&Sget_text_property
);
2318 defsubr (&Sget_char_property
);
2319 defsubr (&Sget_char_property_and_overlay
);
2320 defsubr (&Snext_char_property_change
);
2321 defsubr (&Sprevious_char_property_change
);
2322 defsubr (&Snext_single_char_property_change
);
2323 defsubr (&Sprevious_single_char_property_change
);
2324 defsubr (&Snext_property_change
);
2325 defsubr (&Snext_single_property_change
);
2326 defsubr (&Sprevious_property_change
);
2327 defsubr (&Sprevious_single_property_change
);
2328 defsubr (&Sadd_text_properties
);
2329 defsubr (&Sput_text_property
);
2330 defsubr (&Sset_text_properties
);
2331 defsubr (&Sremove_text_properties
);
2332 defsubr (&Sremove_list_of_text_properties
);
2333 defsubr (&Stext_property_any
);
2334 defsubr (&Stext_property_not_all
);
2335 /* defsubr (&Serase_text_properties); */
2336 /* defsubr (&Scopy_text_properties); */
2339 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2340 (do not change this comment) */