1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include "intervals.h"
27 #define NULL (void *)0
30 /* Test for membership, allowing for t (actually any non-cons) to mean the
33 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
36 /* NOTES: previous- and next- property change will have to skip
37 zero-length intervals if they are implemented. This could be done
38 inside next_interval and previous_interval.
40 set_properties needs to deal with the interval property cache.
42 It is assumed that for any interval plist, a property appears
43 only once on the list. Although some code i.e., remove_properties,
44 handles the more general case, the uniqueness of properties is
45 necessary for the system to remain consistent. This requirement
46 is enforced by the subrs installing properties onto the intervals. */
50 static Lisp_Object Qmouse_left
;
51 static Lisp_Object Qmouse_entered
;
52 Lisp_Object Qpoint_left
;
53 Lisp_Object Qpoint_entered
;
54 Lisp_Object Qcategory
;
55 Lisp_Object Qlocal_map
;
57 /* Visual properties text (including strings) may have. */
58 static Lisp_Object Qforeground
, Qbackground
, Qunderline
;
60 static Lisp_Object Qstipple
;
61 Lisp_Object Qinvisible
, Qintangible
, Qmouse_face
;
62 static Lisp_Object Qread_only
;
63 Lisp_Object Qminibuffer_prompt
;
65 /* Sticky properties */
66 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
68 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
69 the o1's cdr. Otherwise, return zero. This is handy for
71 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
73 /* verify_interval_modification saves insertion hooks here
74 to be run later by report_interval_modification. */
75 Lisp_Object interval_insert_behind_hooks
;
76 Lisp_Object interval_insert_in_front_hooks
;
78 static void text_read_only (Lisp_Object
) NO_RETURN
;
79 INFUN (Fprevious_property_change
, 3);
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 (Lisp_Object propval
)
88 if (STRINGP (propval
))
89 xsignal1 (Qtext_read_only
, propval
);
91 xsignal0 (Qtext_read_only
);
96 /* Extract the interval at the position pointed to by BEGIN from
97 OBJECT, a string or buffer. Additionally, check that the positions
98 pointed to by BEGIN and END are within the bounds of OBJECT, and
99 reverse them if *BEGIN is greater than *END. The objects pointed
100 to by BEGIN and END may be integers or markers; if the latter, they
101 are coerced to integers.
103 When OBJECT is a string, we increment *BEGIN and *END
104 to make them origin-one.
106 Note that buffer points don't correspond to interval indices.
107 For example, point-max is 1 greater than the index of the last
108 character. This difference is handled in the caller, which uses
109 the validated points to determine a length, and operates on that.
110 Exceptions are Ftext_properties_at, Fnext_property_change, and
111 Fprevious_property_change which call this function with BEGIN == END.
112 Handle this case specially.
114 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
115 create an interval tree for OBJECT if one doesn't exist, provided
116 the object actually contains text. In the current design, if there
117 is no text, there can be no text properties. */
123 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
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 EMACS_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 (Lisp_Object list
)
197 register Lisp_Object tail
;
198 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
204 error ("Odd length text property list");
208 return Fcons (list
, Fcons (Qnil
, Qnil
));
211 /* Return nonzero if interval I has all the properties,
212 with the same values, of list PLIST. */
215 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
217 register Lisp_Object tail1
, tail2
, sym1
;
220 /* Go through each element of PLIST. */
221 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
226 /* Go through I's plist, looking for sym1 */
227 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
228 if (EQ (sym1
, XCAR (tail2
)))
230 /* Found the same property on both lists. If the
231 values are unequal, return zero. */
232 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
235 /* Property has same value on both lists; go to next one. */
247 /* Return nonzero if the plist of interval I has any of the
248 properties of PLIST, regardless of their values. */
251 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
253 register Lisp_Object tail1
, tail2
, sym
;
255 /* Go through each element of PLIST. */
256 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
260 /* Go through i's plist, looking for tail1 */
261 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
262 if (EQ (sym
, XCAR (tail2
)))
269 /* Return nonzero if the plist of interval I has any of the
270 property names in LIST, regardless of their values. */
273 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
275 register Lisp_Object tail1
, tail2
, sym
;
277 /* Go through each element of LIST. */
278 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
282 /* Go through i's plist, looking for tail1 */
283 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
284 if (EQ (sym
, XCAR (tail2
)))
291 /* Changing the plists of individual intervals. */
293 /* Return the value of PROP in property-list PLIST, or Qunbound if it
296 property_value (Lisp_Object plist
, Lisp_Object prop
)
300 while (PLIST_ELT_P (plist
, value
))
301 if (EQ (XCAR (plist
), prop
))
304 plist
= XCDR (value
);
309 /* Set the properties of INTERVAL to PROPERTIES,
310 and record undo info for the previous values.
311 OBJECT is the string or buffer that INTERVAL belongs to. */
314 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
316 Lisp_Object sym
, value
;
318 if (BUFFERP (object
))
320 /* For each property in the old plist which is missing from PROPERTIES,
321 or has a different value in PROPERTIES, make an undo record. */
322 for (sym
= interval
->plist
;
323 PLIST_ELT_P (sym
, value
);
325 if (! EQ (property_value (properties
, XCAR (sym
)),
328 record_property_change (interval
->position
, LENGTH (interval
),
329 XCAR (sym
), XCAR (value
),
333 /* For each new property that has no value at all in the old plist,
334 make an undo record binding it to nil, so it will be removed. */
335 for (sym
= properties
;
336 PLIST_ELT_P (sym
, value
);
338 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
340 record_property_change (interval
->position
, LENGTH (interval
),
346 /* Store new properties. */
347 interval
->plist
= Fcopy_sequence (properties
);
350 /* Add the properties of PLIST to the interval I, or set
351 the value of I's property to the value of the property on PLIST
352 if they are different.
354 OBJECT should be the string or buffer the interval is in.
356 Return nonzero if this changes I (i.e., if any members of PLIST
357 are actually added to I's plist) */
360 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
362 Lisp_Object tail1
, tail2
, sym1
, val1
;
363 register int changed
= 0;
365 struct gcpro gcpro1
, gcpro2
, gcpro3
;
370 /* No need to protect OBJECT, because we can GC only in the case
371 where it is a buffer, and live buffers are always protected.
372 I and its plist are also protected, via OBJECT. */
373 GCPRO3 (tail1
, sym1
, val1
);
375 /* Go through each element of PLIST. */
376 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
379 val1
= Fcar (XCDR (tail1
));
382 /* Go through I's plist, looking for sym1 */
383 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
384 if (EQ (sym1
, XCAR (tail2
)))
386 /* No need to gcpro, because tail2 protects this
387 and it must be a cons cell (we get an error otherwise). */
388 register Lisp_Object this_cdr
;
390 this_cdr
= XCDR (tail2
);
391 /* Found the property. Now check its value. */
394 /* The properties have the same value on both lists.
395 Continue to the next property. */
396 if (EQ (val1
, Fcar (this_cdr
)))
399 /* Record this change in the buffer, for undo purposes. */
400 if (BUFFERP (object
))
402 record_property_change (i
->position
, LENGTH (i
),
403 sym1
, Fcar (this_cdr
), object
);
406 /* I's property has a different value -- change it */
407 Fsetcar (this_cdr
, val1
);
414 /* Record this change in the buffer, for undo purposes. */
415 if (BUFFERP (object
))
417 record_property_change (i
->position
, LENGTH (i
),
420 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
430 /* For any members of PLIST, or LIST,
431 which are properties of I, remove them from I's plist.
432 (If PLIST is non-nil, use that, otherwise use LIST.)
433 OBJECT is the string or buffer containing I. */
436 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
438 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
439 register int changed
= 0;
441 /* Nonzero means tail1 is a plist, otherwise it is a list. */
444 current_plist
= i
->plist
;
447 tail1
= plist
, use_plist
= 1;
449 tail1
= list
, use_plist
= 0;
451 /* Go through each element of LIST or PLIST. */
452 while (CONSP (tail1
))
456 /* First, remove the symbol if it's at the head of the list */
457 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
459 if (BUFFERP (object
))
460 record_property_change (i
->position
, LENGTH (i
),
461 sym
, XCAR (XCDR (current_plist
)),
464 current_plist
= XCDR (XCDR (current_plist
));
468 /* Go through I's plist, looking for SYM. */
469 tail2
= current_plist
;
470 while (! NILP (tail2
))
472 register Lisp_Object
this;
473 this = XCDR (XCDR (tail2
));
474 if (CONSP (this) && EQ (sym
, XCAR (this)))
476 if (BUFFERP (object
))
477 record_property_change (i
->position
, LENGTH (i
),
478 sym
, XCAR (XCDR (this)), object
);
480 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
486 /* Advance thru TAIL1 one way or the other. */
487 tail1
= XCDR (tail1
);
488 if (use_plist
&& CONSP (tail1
))
489 tail1
= XCDR (tail1
);
493 i
->plist
= current_plist
;
498 /* Remove all properties from interval I. Return non-zero
499 if this changes the interval. */
502 erase_properties (INTERVAL i
)
512 /* Returns the interval of POSITION in OBJECT.
513 POSITION is BEG-based. */
516 interval_of (int position
, Lisp_Object object
)
522 XSETBUFFER (object
, current_buffer
);
523 else if (EQ (object
, Qt
))
524 return NULL_INTERVAL
;
526 CHECK_STRING_OR_BUFFER (object
);
528 if (BUFFERP (object
))
530 register struct buffer
*b
= XBUFFER (object
);
534 i
= BUF_INTERVALS (b
);
539 end
= SCHARS (object
);
540 i
= STRING_INTERVALS (object
);
543 if (!(beg
<= position
&& position
<= end
))
544 args_out_of_range (make_number (position
), make_number (position
));
545 if (beg
== end
|| NULL_INTERVAL_P (i
))
546 return NULL_INTERVAL
;
548 return find_interval (i
, position
);
551 DEFUE ("text-properties-at", Ftext_properties_at
,
552 Stext_properties_at
, 1, 2, 0,
553 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
554 If the optional second argument OBJECT is a buffer (or nil, which means
555 the current buffer), POSITION is a buffer position (integer or marker).
556 If OBJECT is a string, POSITION is a 0-based index into it.
557 If POSITION is at the end of OBJECT, the value is nil. */)
558 (Lisp_Object position
, Lisp_Object object
)
563 XSETBUFFER (object
, current_buffer
);
565 i
= validate_interval_range (object
, &position
, &position
, soft
);
566 if (NULL_INTERVAL_P (i
))
568 /* If POSITION is at the end of the interval,
569 it means it's the end of OBJECT.
570 There are no properties at the very end,
571 since no character follows. */
572 if (XINT (position
) == LENGTH (i
) + i
->position
)
578 DEFUE ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
579 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
580 OBJECT is optional and defaults to the current buffer.
581 If POSITION is at the end of OBJECT, the value is nil. */)
582 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
584 return textget (Ftext_properties_at (position
, object
), prop
);
587 /* Return the value of char's property PROP, in OBJECT at POSITION.
588 OBJECT is optional and defaults to the current buffer.
589 If OVERLAY is non-0, then in the case that the returned property is from
590 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
591 returned in *OVERLAY.
592 If POSITION is at the end of OBJECT, the value is nil.
593 If OBJECT is a buffer, then overlay properties are considered as well as
595 If OBJECT is a window, then that window's buffer is used, but
596 window-specific overlays are considered only if they are associated
599 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
601 struct window
*w
= 0;
603 CHECK_NUMBER_COERCE_MARKER (position
);
606 XSETBUFFER (object
, current_buffer
);
608 if (WINDOWP (object
))
610 w
= XWINDOW (object
);
613 if (BUFFERP (object
))
616 Lisp_Object
*overlay_vec
;
617 struct buffer
*obuf
= current_buffer
;
619 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
620 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
621 xsignal1 (Qargs_out_of_range
, position
);
623 set_buffer_temp (XBUFFER (object
));
625 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
626 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
628 set_buffer_temp (obuf
);
630 /* Now check the overlays in order of decreasing priority. */
631 while (--noverlays
>= 0)
633 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
637 /* Return the overlay we got the property from. */
638 *overlay
= overlay_vec
[noverlays
];
645 /* Indicate that the return value is not from an overlay. */
648 /* Not a buffer, or no appropriate overlay, so fall through to the
650 return Fget_text_property (position
, prop
, object
);
653 DEFUE ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
654 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
655 Both overlay properties and text properties are checked.
656 OBJECT is optional and defaults to the current buffer.
657 If POSITION is at the end of OBJECT, the value is nil.
658 If OBJECT is a buffer, then overlay properties are considered as well as
660 If OBJECT is a window, then that window's buffer is used, but window-specific
661 overlays are considered only if they are associated with OBJECT. */)
662 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
664 return get_char_property_and_overlay (position
, prop
, object
, 0);
667 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
668 Sget_char_property_and_overlay
, 2, 3, 0,
669 doc
: /* Like `get-char-property', but with extra overlay information.
670 The value is a cons cell. Its car is the return value of `get-char-property'
671 with the same arguments--that is, the value of POSITION's property
672 PROP in OBJECT. Its cdr is the overlay in which the property was
673 found, or nil, if it was found as a text property or not found at all.
675 OBJECT is optional and defaults to the current buffer. OBJECT may be
676 a string, a buffer or a window. For strings, the cdr of the return
677 value is always nil, since strings do not have overlays. If OBJECT is
678 a window, then that window's buffer is used, but window-specific
679 overlays are considered only if they are associated with OBJECT. If
680 POSITION is at the end of OBJECT, both car and cdr are nil. */)
681 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
685 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
686 return Fcons (val
, overlay
);
690 DEFUE ("next-char-property-change", Fnext_char_property_change
,
691 Snext_char_property_change
, 1, 2, 0,
692 doc
: /* Return the position of next text property or overlay change.
693 This scans characters forward in the current buffer from POSITION till
694 it finds a change in some text property, or the beginning or end of an
695 overlay, and returns the position of that.
696 If none is found up to (point-max), the function returns (point-max).
698 If the optional second argument LIMIT is non-nil, don't search
699 past position LIMIT; return LIMIT if nothing is found before LIMIT.
700 LIMIT is a no-op if it is greater than (point-max). */)
701 (Lisp_Object position
, Lisp_Object limit
)
705 temp
= Fnext_overlay_change (position
);
708 CHECK_NUMBER_COERCE_MARKER (limit
);
709 if (XINT (limit
) < XINT (temp
))
712 return Fnext_property_change (position
, Qnil
, temp
);
715 DEFUE ("previous-char-property-change", Fprevious_char_property_change
,
716 Sprevious_char_property_change
, 1, 2, 0,
717 doc
: /* Return the position of previous text property or overlay change.
718 Scans characters backward in the current buffer from POSITION till it
719 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 since (point-min), the function returns (point-min).
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 less than (point-min). */)
726 (Lisp_Object position
, Lisp_Object limit
)
730 temp
= Fprevious_overlay_change (position
);
733 CHECK_NUMBER_COERCE_MARKER (limit
);
734 if (XINT (limit
) > XINT (temp
))
737 return Fprevious_property_change (position
, Qnil
, temp
);
741 DEFUE ("next-single-char-property-change", Fnext_single_char_property_change
,
742 Snext_single_char_property_change
, 2, 4, 0,
743 doc
: /* Return the position of next text property or overlay change for a specific property.
744 Scans characters forward from POSITION till it finds
745 a change in the PROP property, then returns the position of the change.
746 If the optional third argument OBJECT is a buffer (or nil, which means
747 the current buffer), POSITION is a buffer position (integer or marker).
748 If OBJECT is a string, POSITION is a 0-based index into it.
750 In a string, scan runs to the end of the string.
751 In a buffer, it runs to (point-max), and the value cannot exceed that.
753 The property values are compared with `eq'.
754 If the property is constant all the way to the end of OBJECT, return the
755 last valid position in OBJECT.
756 If the optional fourth argument LIMIT is non-nil, don't search
757 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
758 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
760 if (STRINGP (object
))
762 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
766 position
= make_number (SCHARS (object
));
769 CHECK_NUMBER (limit
);
776 Lisp_Object initial_value
, value
;
777 int count
= SPECPDL_INDEX ();
780 CHECK_BUFFER (object
);
782 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
784 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
785 Fset_buffer (object
);
788 CHECK_NUMBER_COERCE_MARKER (position
);
790 initial_value
= Fget_char_property (position
, prop
, object
);
793 XSETFASTINT (limit
, ZV
);
795 CHECK_NUMBER_COERCE_MARKER (limit
);
797 if (XFASTINT (position
) >= XFASTINT (limit
))
800 if (XFASTINT (position
) > ZV
)
801 XSETFASTINT (position
, ZV
);
806 position
= Fnext_char_property_change (position
, limit
);
807 if (XFASTINT (position
) >= XFASTINT (limit
))
813 value
= Fget_char_property (position
, prop
, object
);
814 if (!EQ (value
, initial_value
))
818 unbind_to (count
, Qnil
);
824 DEFUE ("previous-single-char-property-change",
825 Fprevious_single_char_property_change
,
826 Sprevious_single_char_property_change
, 2, 4, 0,
827 doc
: /* Return the position of previous text property or overlay change for a specific property.
828 Scans characters backward from POSITION till it finds
829 a change in the PROP property, then returns the position of the change.
830 If the optional third argument OBJECT is a buffer (or nil, which means
831 the current buffer), POSITION is a buffer position (integer or marker).
832 If OBJECT is a string, POSITION is a 0-based index into it.
834 In a string, scan runs to the start of the string.
835 In a buffer, it runs to (point-min), and the value cannot be less than that.
837 The property values are compared with `eq'.
838 If the property is constant all the way to the start of OBJECT, return the
839 first valid position in OBJECT.
840 If the optional fourth argument LIMIT is non-nil, don't search
841 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
842 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
844 if (STRINGP (object
))
846 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
850 position
= make_number (0);
853 CHECK_NUMBER (limit
);
860 int count
= SPECPDL_INDEX ();
863 CHECK_BUFFER (object
);
865 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
867 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
868 Fset_buffer (object
);
871 CHECK_NUMBER_COERCE_MARKER (position
);
874 XSETFASTINT (limit
, BEGV
);
876 CHECK_NUMBER_COERCE_MARKER (limit
);
878 if (XFASTINT (position
) <= XFASTINT (limit
))
881 if (XFASTINT (position
) < BEGV
)
882 XSETFASTINT (position
, BEGV
);
886 Lisp_Object initial_value
887 = Fget_char_property (make_number (XFASTINT (position
) - 1),
892 position
= Fprevious_char_property_change (position
, limit
);
894 if (XFASTINT (position
) <= XFASTINT (limit
))
902 = Fget_char_property (make_number (XFASTINT (position
) - 1),
905 if (!EQ (value
, initial_value
))
911 unbind_to (count
, Qnil
);
917 DEFUE ("next-property-change", Fnext_property_change
,
918 Snext_property_change
, 1, 3, 0,
919 doc
: /* Return the position of next property change.
920 Scans characters forward from POSITION in OBJECT till it finds
921 a change in some text property, then returns the position of the change.
922 If the optional second argument OBJECT is a buffer (or nil, which means
923 the current buffer), POSITION is a buffer position (integer or marker).
924 If OBJECT is a string, POSITION is a 0-based index into it.
925 Return nil if the property is constant all the way to the end of OBJECT.
926 If the value is non-nil, it is a position greater than POSITION, never equal.
928 If the optional third argument LIMIT is non-nil, don't search
929 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
930 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
932 register INTERVAL i
, next
;
935 XSETBUFFER (object
, current_buffer
);
937 if (!NILP (limit
) && !EQ (limit
, Qt
))
938 CHECK_NUMBER_COERCE_MARKER (limit
);
940 i
= validate_interval_range (object
, &position
, &position
, soft
);
942 /* If LIMIT is t, return start of next interval--don't
943 bother checking further intervals. */
946 if (NULL_INTERVAL_P (i
))
949 next
= next_interval (i
);
951 if (NULL_INTERVAL_P (next
))
952 XSETFASTINT (position
, (STRINGP (object
)
954 : BUF_ZV (XBUFFER (object
))));
956 XSETFASTINT (position
, next
->position
);
960 if (NULL_INTERVAL_P (i
))
963 next
= next_interval (i
);
965 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
966 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
967 next
= next_interval (next
);
969 if (NULL_INTERVAL_P (next
)
975 : BUF_ZV (XBUFFER (object
))))))
978 return make_number (next
->position
);
981 DEFUE ("next-single-property-change", Fnext_single_property_change
,
982 Snext_single_property_change
, 2, 4, 0,
983 doc
: /* Return the position of next property change for a specific property.
984 Scans characters forward from POSITION till it finds
985 a change in the PROP property, then returns the position of the change.
986 If the optional third argument OBJECT is a buffer (or nil, which means
987 the current buffer), POSITION is a buffer position (integer or marker).
988 If OBJECT is a string, POSITION is a 0-based index into it.
989 The property values are compared with `eq'.
990 Return nil if the property is constant all the way to the end of OBJECT.
991 If the value is non-nil, it is a position greater than POSITION, never equal.
993 If the optional fourth argument LIMIT is non-nil, don't search
994 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
995 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
997 register INTERVAL i
, next
;
998 register Lisp_Object here_val
;
1001 XSETBUFFER (object
, current_buffer
);
1004 CHECK_NUMBER_COERCE_MARKER (limit
);
1006 i
= validate_interval_range (object
, &position
, &position
, soft
);
1007 if (NULL_INTERVAL_P (i
))
1010 here_val
= textget (i
->plist
, prop
);
1011 next
= next_interval (i
);
1012 while (! NULL_INTERVAL_P (next
)
1013 && EQ (here_val
, textget (next
->plist
, prop
))
1014 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1015 next
= next_interval (next
);
1017 if (NULL_INTERVAL_P (next
)
1019 >= (INTEGERP (limit
)
1023 : BUF_ZV (XBUFFER (object
))))))
1026 return make_number (next
->position
);
1029 DEFUE ("previous-property-change", Fprevious_property_change
,
1030 Sprevious_property_change
, 1, 3, 0,
1031 doc
: /* Return the position of previous property change.
1032 Scans characters backwards from POSITION in OBJECT till it finds
1033 a change in some text property, then returns the position of the change.
1034 If the optional second argument OBJECT is a buffer (or nil, which means
1035 the current buffer), POSITION is a buffer position (integer or marker).
1036 If OBJECT is a string, POSITION is a 0-based index into it.
1037 Return nil if the property is constant all the way to the start of OBJECT.
1038 If the value is non-nil, it is a position less than POSITION, never equal.
1040 If the optional third argument LIMIT is non-nil, don't search
1041 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1042 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1044 register INTERVAL i
, previous
;
1047 XSETBUFFER (object
, current_buffer
);
1050 CHECK_NUMBER_COERCE_MARKER (limit
);
1052 i
= validate_interval_range (object
, &position
, &position
, soft
);
1053 if (NULL_INTERVAL_P (i
))
1056 /* Start with the interval containing the char before point. */
1057 if (i
->position
== XFASTINT (position
))
1058 i
= previous_interval (i
);
1060 previous
= previous_interval (i
);
1061 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1063 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1064 previous
= previous_interval (previous
);
1066 if (NULL_INTERVAL_P (previous
)
1067 || (previous
->position
+ LENGTH (previous
)
1068 <= (INTEGERP (limit
)
1070 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1073 return make_number (previous
->position
+ LENGTH (previous
));
1076 DEFUE ("previous-single-property-change", Fprevious_single_property_change
,
1077 Sprevious_single_property_change
, 2, 4, 0,
1078 doc
: /* Return the position of previous property change for a specific property.
1079 Scans characters backward from POSITION till it finds
1080 a change in the PROP property, then returns the position of the change.
1081 If the optional third argument OBJECT is a buffer (or nil, which means
1082 the current buffer), POSITION is a buffer position (integer or marker).
1083 If OBJECT is a string, POSITION is a 0-based index into it.
1084 The property values are compared with `eq'.
1085 Return nil if the property is constant all the way to the start of OBJECT.
1086 If the value is non-nil, it is a position less than POSITION, never equal.
1088 If the optional fourth argument LIMIT is non-nil, don't search
1089 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1090 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1092 register INTERVAL i
, previous
;
1093 register Lisp_Object here_val
;
1096 XSETBUFFER (object
, current_buffer
);
1099 CHECK_NUMBER_COERCE_MARKER (limit
);
1101 i
= validate_interval_range (object
, &position
, &position
, soft
);
1103 /* Start with the interval containing the char before point. */
1104 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1105 i
= previous_interval (i
);
1107 if (NULL_INTERVAL_P (i
))
1110 here_val
= textget (i
->plist
, prop
);
1111 previous
= previous_interval (i
);
1112 while (!NULL_INTERVAL_P (previous
)
1113 && EQ (here_val
, textget (previous
->plist
, prop
))
1115 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1116 previous
= previous_interval (previous
);
1118 if (NULL_INTERVAL_P (previous
)
1119 || (previous
->position
+ LENGTH (previous
)
1120 <= (INTEGERP (limit
)
1122 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1125 return make_number (previous
->position
+ LENGTH (previous
));
1128 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1130 DEFUE ("add-text-properties", Fadd_text_properties
,
1131 Sadd_text_properties
, 3, 4, 0,
1132 doc
: /* Add properties to the text from START to END.
1133 The third argument PROPERTIES is a property list
1134 specifying the property values to add. If the optional fourth argument
1135 OBJECT is a buffer (or nil, which means the current buffer),
1136 START and END are buffer positions (integers or markers).
1137 If OBJECT is a string, START and END are 0-based indices into it.
1138 Return t if any property value actually changed, nil otherwise. */)
1139 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1141 register INTERVAL i
, unchanged
;
1142 register EMACS_INT s
, len
;
1143 register int modified
= 0;
1144 struct gcpro gcpro1
;
1146 properties
= validate_plist (properties
);
1147 if (NILP (properties
))
1151 XSETBUFFER (object
, current_buffer
);
1153 i
= validate_interval_range (object
, &start
, &end
, hard
);
1154 if (NULL_INTERVAL_P (i
))
1158 len
= XINT (end
) - s
;
1160 /* No need to protect OBJECT, because we GC only if it's a buffer,
1161 and live buffers are always protected. */
1162 GCPRO1 (properties
);
1164 /* If we're not starting on an interval boundary, we have to
1165 split this interval. */
1166 if (i
->position
!= s
)
1168 /* If this interval already has the properties, we can
1170 if (interval_has_all_properties (properties
, i
))
1172 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1174 RETURN_UNGCPRO (Qnil
);
1176 i
= next_interval (i
);
1181 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1182 copy_properties (unchanged
, i
);
1186 if (BUFFERP (object
))
1187 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1189 /* We are at the beginning of interval I, with LEN chars to scan. */
1195 if (LENGTH (i
) >= len
)
1197 /* We can UNGCPRO safely here, because there will be just
1198 one more chance to gc, in the next call to add_properties,
1199 and after that we will not need PROPERTIES or OBJECT again. */
1202 if (interval_has_all_properties (properties
, i
))
1204 if (BUFFERP (object
))
1205 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1206 XINT (end
) - XINT (start
));
1208 return modified
? Qt
: Qnil
;
1211 if (LENGTH (i
) == len
)
1213 add_properties (properties
, i
, object
);
1214 if (BUFFERP (object
))
1215 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1216 XINT (end
) - XINT (start
));
1220 /* i doesn't have the properties, and goes past the change limit */
1222 i
= split_interval_left (unchanged
, len
);
1223 copy_properties (unchanged
, i
);
1224 add_properties (properties
, i
, object
);
1225 if (BUFFERP (object
))
1226 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1227 XINT (end
) - XINT (start
));
1232 modified
+= add_properties (properties
, i
, object
);
1233 i
= next_interval (i
);
1237 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1239 DEFUE ("put-text-property", Fput_text_property
,
1240 Sput_text_property
, 4, 5, 0,
1241 doc
: /* Set one property of the text from START to END.
1242 The third and fourth arguments PROPERTY and VALUE
1243 specify the property to add.
1244 If the optional fifth argument OBJECT is a buffer (or nil, which means
1245 the current buffer), START and END are buffer positions (integers or
1246 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1247 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1249 Fadd_text_properties (start
, end
,
1250 Fcons (property
, Fcons (value
, Qnil
)),
1255 DEFUE ("set-text-properties", Fset_text_properties
,
1256 Sset_text_properties
, 3, 4, 0,
1257 doc
: /* Completely replace properties of text from START to END.
1258 The third argument PROPERTIES is the new property list.
1259 If the optional fourth argument OBJECT is a buffer (or nil, which means
1260 the current buffer), START and END are buffer positions (integers or
1261 markers). If OBJECT is a string, START and END are 0-based indices into it.
1262 If PROPERTIES is nil, the effect is to remove all properties from
1263 the designated part of OBJECT. */)
1264 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1266 return set_text_properties (start
, end
, properties
, object
, Qt
);
1270 /* Replace properties of text from START to END with new list of
1271 properties PROPERTIES. OBJECT is the buffer or string containing
1272 the text. OBJECT nil means use the current buffer.
1273 COHERENT_CHANGE_P nil means this is being called as an internal
1274 subroutine, rather than as a change primitive with checking of
1275 read-only, invoking change hooks, etc.. Value is nil if the
1276 function _detected_ that it did not replace any properties, non-nil
1280 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1282 register INTERVAL i
;
1283 Lisp_Object ostart
, oend
;
1288 properties
= validate_plist (properties
);
1291 XSETBUFFER (object
, current_buffer
);
1293 /* If we want no properties for a whole string,
1294 get rid of its intervals. */
1295 if (NILP (properties
) && STRINGP (object
)
1296 && XFASTINT (start
) == 0
1297 && XFASTINT (end
) == SCHARS (object
))
1299 if (! STRING_INTERVALS (object
))
1302 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1306 i
= validate_interval_range (object
, &start
, &end
, soft
);
1308 if (NULL_INTERVAL_P (i
))
1310 /* If buffer has no properties, and we want none, return now. */
1311 if (NILP (properties
))
1314 /* Restore the original START and END values
1315 because validate_interval_range increments them for strings. */
1319 i
= validate_interval_range (object
, &start
, &end
, hard
);
1320 /* This can return if start == end. */
1321 if (NULL_INTERVAL_P (i
))
1325 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1326 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1328 set_text_properties_1 (start
, end
, properties
, object
, i
);
1330 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1331 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1332 XINT (end
) - XINT (start
));
1336 /* Replace properties of text from START to END with new list of
1337 properties PROPERTIES. BUFFER is the buffer containing
1338 the text. This does not obey any hooks.
1339 You can provide the interval that START is located in as I,
1340 or pass NULL for I and this function will find it.
1341 START and END can be in any order. */
1344 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object buffer
, INTERVAL i
)
1346 register INTERVAL prev_changed
= NULL_INTERVAL
;
1347 register EMACS_INT s
, len
;
1351 len
= XINT (end
) - s
;
1361 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1363 if (i
->position
!= s
)
1366 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1368 if (LENGTH (i
) > len
)
1370 copy_properties (unchanged
, i
);
1371 i
= split_interval_left (i
, len
);
1372 set_properties (properties
, i
, buffer
);
1376 set_properties (properties
, i
, buffer
);
1378 if (LENGTH (i
) == len
)
1383 i
= next_interval (i
);
1386 /* We are starting at the beginning of an interval I. LEN is positive. */
1392 if (LENGTH (i
) >= len
)
1394 if (LENGTH (i
) > len
)
1395 i
= split_interval_left (i
, len
);
1397 /* We have to call set_properties even if we are going to
1398 merge the intervals, so as to make the undo records
1399 and cause redisplay to happen. */
1400 set_properties (properties
, i
, buffer
);
1401 if (!NULL_INTERVAL_P (prev_changed
))
1402 merge_interval_left (i
);
1408 /* We have to call set_properties even if we are going to
1409 merge the intervals, so as to make the undo records
1410 and cause redisplay to happen. */
1411 set_properties (properties
, i
, buffer
);
1412 if (NULL_INTERVAL_P (prev_changed
))
1415 prev_changed
= i
= merge_interval_left (i
);
1417 i
= next_interval (i
);
1422 DEFUE ("remove-text-properties", Fremove_text_properties
,
1423 Sremove_text_properties
, 3, 4, 0,
1424 doc
: /* Remove some properties from text from START to END.
1425 The third argument PROPERTIES is a property list
1426 whose property names specify the properties to remove.
1427 \(The values stored in PROPERTIES are ignored.)
1428 If the optional fourth argument OBJECT is a buffer (or nil, which means
1429 the current buffer), START and END are buffer positions (integers or
1430 markers). If OBJECT is a string, START and END are 0-based indices into it.
1431 Return t if any property was actually removed, nil otherwise.
1433 Use `set-text-properties' if you want to remove all text properties. */)
1434 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1436 register INTERVAL i
, unchanged
;
1437 register EMACS_INT s
, len
;
1438 register int modified
= 0;
1441 XSETBUFFER (object
, current_buffer
);
1443 i
= validate_interval_range (object
, &start
, &end
, soft
);
1444 if (NULL_INTERVAL_P (i
))
1448 len
= XINT (end
) - s
;
1450 if (i
->position
!= s
)
1452 /* No properties on this first interval -- return if
1453 it covers the entire region. */
1454 if (! interval_has_some_properties (properties
, i
))
1456 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1460 i
= next_interval (i
);
1462 /* Split away the beginning of this interval; what we don't
1467 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1468 copy_properties (unchanged
, i
);
1472 if (BUFFERP (object
))
1473 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1475 /* We are at the beginning of an interval, with len to scan */
1481 if (LENGTH (i
) >= len
)
1483 if (! interval_has_some_properties (properties
, i
))
1484 return modified
? Qt
: Qnil
;
1486 if (LENGTH (i
) == len
)
1488 remove_properties (properties
, Qnil
, i
, object
);
1489 if (BUFFERP (object
))
1490 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1491 XINT (end
) - XINT (start
));
1495 /* i has the properties, and goes past the change limit */
1497 i
= split_interval_left (i
, len
);
1498 copy_properties (unchanged
, i
);
1499 remove_properties (properties
, Qnil
, i
, object
);
1500 if (BUFFERP (object
))
1501 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1502 XINT (end
) - XINT (start
));
1507 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1508 i
= next_interval (i
);
1512 DEFUE ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1513 Sremove_list_of_text_properties
, 3, 4, 0,
1514 doc
: /* Remove some properties from text from START to END.
1515 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1516 If the optional fourth argument OBJECT is a buffer (or nil, which means
1517 the current buffer), START and END are buffer positions (integers or
1518 markers). If OBJECT is a string, START and END are 0-based indices into it.
1519 Return t if any property was actually removed, nil otherwise. */)
1520 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1522 register INTERVAL i
, unchanged
;
1523 register EMACS_INT s
, len
;
1524 register int modified
= 0;
1525 Lisp_Object properties
;
1526 properties
= list_of_properties
;
1529 XSETBUFFER (object
, current_buffer
);
1531 i
= validate_interval_range (object
, &start
, &end
, soft
);
1532 if (NULL_INTERVAL_P (i
))
1536 len
= XINT (end
) - s
;
1538 if (i
->position
!= s
)
1540 /* No properties on this first interval -- return if
1541 it covers the entire region. */
1542 if (! interval_has_some_properties_list (properties
, i
))
1544 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1548 i
= next_interval (i
);
1550 /* Split away the beginning of this interval; what we don't
1555 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1556 copy_properties (unchanged
, i
);
1560 /* We are at the beginning of an interval, with len to scan.
1561 The flag `modified' records if changes have been made.
1562 When object is a buffer, we must call modify_region before changes are
1563 made and signal_after_change when we are done.
1564 We call modify_region before calling remove_properties if modified == 0,
1565 and we call signal_after_change before returning if modified != 0. */
1571 if (LENGTH (i
) >= len
)
1573 if (! interval_has_some_properties_list (properties
, i
))
1577 if (BUFFERP (object
))
1578 signal_after_change (XINT (start
),
1579 XINT (end
) - XINT (start
),
1580 XINT (end
) - XINT (start
));
1586 else if (LENGTH (i
) == len
)
1588 if (!modified
&& BUFFERP (object
))
1589 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1590 remove_properties (Qnil
, properties
, i
, object
);
1591 if (BUFFERP (object
))
1592 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1593 XINT (end
) - XINT (start
));
1597 { /* i has the properties, and goes past the change limit. */
1599 i
= split_interval_left (i
, len
);
1600 copy_properties (unchanged
, i
);
1601 if (!modified
&& BUFFERP (object
))
1602 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1603 remove_properties (Qnil
, properties
, i
, object
);
1604 if (BUFFERP (object
))
1605 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1606 XINT (end
) - XINT (start
));
1610 if (interval_has_some_properties_list (properties
, i
))
1612 if (!modified
&& BUFFERP (object
))
1613 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1614 remove_properties (Qnil
, properties
, i
, object
);
1618 i
= next_interval (i
);
1622 DEFUE ("text-property-any", Ftext_property_any
,
1623 Stext_property_any
, 4, 5, 0,
1624 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1625 If so, return the position of the first character whose property PROPERTY
1626 is `eq' to VALUE. Otherwise return nil.
1627 If the optional fifth argument OBJECT is a buffer (or nil, which means
1628 the current buffer), START and END are buffer positions (integers or
1629 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1630 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1632 register INTERVAL i
;
1633 register EMACS_INT e
, pos
;
1636 XSETBUFFER (object
, current_buffer
);
1637 i
= validate_interval_range (object
, &start
, &end
, soft
);
1638 if (NULL_INTERVAL_P (i
))
1639 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1642 while (! NULL_INTERVAL_P (i
))
1644 if (i
->position
>= e
)
1646 if (EQ (textget (i
->plist
, property
), value
))
1649 if (pos
< XINT (start
))
1651 return make_number (pos
);
1653 i
= next_interval (i
);
1658 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1659 Stext_property_not_all
, 4, 5, 0,
1660 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1661 If so, return the position of the first character whose property PROPERTY
1662 is not `eq' to VALUE. Otherwise, return nil.
1663 If the optional fifth argument OBJECT is a buffer (or nil, which means
1664 the current buffer), START and END are buffer positions (integers or
1665 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1666 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1668 register INTERVAL i
;
1669 register EMACS_INT s
, e
;
1672 XSETBUFFER (object
, current_buffer
);
1673 i
= validate_interval_range (object
, &start
, &end
, soft
);
1674 if (NULL_INTERVAL_P (i
))
1675 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1679 while (! NULL_INTERVAL_P (i
))
1681 if (i
->position
>= e
)
1683 if (! EQ (textget (i
->plist
, property
), value
))
1685 if (i
->position
> s
)
1687 return make_number (s
);
1689 i
= next_interval (i
);
1695 /* Return the direction from which the text-property PROP would be
1696 inherited by any new text inserted at POS: 1 if it would be
1697 inherited from the char after POS, -1 if it would be inherited from
1698 the char before POS, and 0 if from neither.
1699 BUFFER can be either a buffer or nil (meaning current buffer). */
1702 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1704 Lisp_Object prev_pos
, front_sticky
;
1705 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1708 XSETBUFFER (buffer
, current_buffer
);
1710 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1711 /* Consider previous character. */
1713 Lisp_Object rear_non_sticky
;
1715 prev_pos
= make_number (XINT (pos
) - 1);
1716 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1718 if (!NILP (CONSP (rear_non_sticky
)
1719 ? Fmemq (prop
, rear_non_sticky
)
1721 /* PROP is rear-non-sticky. */
1727 /* Consider following character. */
1728 /* This signals an arg-out-of-range error if pos is outside the
1729 buffer's accessible range. */
1730 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1732 if (EQ (front_sticky
, Qt
)
1733 || (CONSP (front_sticky
)
1734 && !NILP (Fmemq (prop
, front_sticky
))))
1735 /* PROP is inherited from after. */
1736 is_front_sticky
= 1;
1738 /* Simple cases, where the properties are consistent. */
1739 if (is_rear_sticky
&& !is_front_sticky
)
1741 else if (!is_rear_sticky
&& is_front_sticky
)
1743 else if (!is_rear_sticky
&& !is_front_sticky
)
1746 /* The stickiness properties are inconsistent, so we have to
1747 disambiguate. Basically, rear-sticky wins, _except_ if the
1748 property that would be inherited has a value of nil, in which case
1749 front-sticky wins. */
1750 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1751 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1758 /* I don't think this is the right interface to export; how often do you
1759 want to do something like this, other than when you're copying objects
1762 I think it would be better to have a pair of functions, one which
1763 returns the text properties of a region as a list of ranges and
1764 plists, and another which applies such a list to another object. */
1766 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1767 SRC and DEST may each refer to strings or buffers.
1768 Optional sixth argument PROP causes only that property to be copied.
1769 Properties are copied to DEST as if by `add-text-properties'.
1770 Return t if any property value actually changed, nil otherwise. */
1772 /* Note this can GC when DEST is a buffer. */
1775 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1781 EMACS_INT s
, e
, e2
, p
, len
;
1783 struct gcpro gcpro1
, gcpro2
;
1785 i
= validate_interval_range (src
, &start
, &end
, soft
);
1786 if (NULL_INTERVAL_P (i
))
1789 CHECK_NUMBER_COERCE_MARKER (pos
);
1791 Lisp_Object dest_start
, dest_end
;
1794 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1795 /* Apply this to a copy of pos; it will try to increment its arguments,
1796 which we don't want. */
1797 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1808 e2
= i
->position
+ LENGTH (i
);
1815 while (! NILP (plist
))
1817 if (EQ (Fcar (plist
), prop
))
1819 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1822 plist
= Fcdr (Fcdr (plist
));
1826 /* Must defer modifications to the interval tree in case src
1827 and dest refer to the same string or buffer. */
1828 stuff
= Fcons (Fcons (make_number (p
),
1829 Fcons (make_number (p
+ len
),
1830 Fcons (plist
, Qnil
))),
1834 i
= next_interval (i
);
1835 if (NULL_INTERVAL_P (i
))
1842 GCPRO2 (stuff
, dest
);
1844 while (! NILP (stuff
))
1847 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1848 Fcar (Fcdr (Fcdr (res
))), dest
);
1851 stuff
= Fcdr (stuff
);
1856 return modified
? Qt
: Qnil
;
1860 /* Return a list representing the text properties of OBJECT between
1861 START and END. if PROP is non-nil, report only on that property.
1862 Each result list element has the form (S E PLIST), where S and E
1863 are positions in OBJECT and PLIST is a property list containing the
1864 text properties of OBJECT between S and E. Value is nil if OBJECT
1865 doesn't contain text properties between START and END. */
1868 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1875 i
= validate_interval_range (object
, &start
, &end
, soft
);
1876 if (!NULL_INTERVAL_P (i
))
1878 EMACS_INT s
= XINT (start
);
1879 EMACS_INT e
= XINT (end
);
1883 EMACS_INT interval_end
, len
;
1886 interval_end
= i
->position
+ LENGTH (i
);
1887 if (interval_end
> e
)
1889 len
= interval_end
- s
;
1894 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
1895 if (EQ (XCAR (plist
), prop
))
1897 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
1902 result
= Fcons (Fcons (make_number (s
),
1903 Fcons (make_number (s
+ len
),
1904 Fcons (plist
, Qnil
))),
1907 i
= next_interval (i
);
1908 if (NULL_INTERVAL_P (i
))
1918 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1919 (START END PLIST), where START and END are positions and PLIST is a
1920 property list containing the text properties to add. Adjust START
1921 and END positions by DELTA before adding properties. Value is
1922 non-zero if OBJECT was modified. */
1925 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
1927 struct gcpro gcpro1
, gcpro2
;
1930 GCPRO2 (list
, object
);
1932 for (; CONSP (list
); list
= XCDR (list
))
1934 Lisp_Object item
, start
, end
, plist
, tem
;
1937 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1938 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1939 plist
= XCAR (XCDR (XCDR (item
)));
1941 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1952 /* Modify end-points of ranges in LIST destructively, and return the
1953 new list. LIST is a list as returned from text_property_list.
1954 Discard properties that begin at or after NEW_END, and limit
1955 end-points to NEW_END. */
1958 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
1960 Lisp_Object prev
= Qnil
, head
= list
;
1961 EMACS_INT max
= XINT (new_end
);
1963 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
1965 Lisp_Object item
, beg
, end
;
1969 end
= XCAR (XCDR (item
));
1971 if (XINT (beg
) >= max
)
1973 /* The start-point is past the end of the new string.
1974 Discard this property. */
1975 if (EQ (head
, list
))
1978 XSETCDR (prev
, XCDR (list
));
1980 else if (XINT (end
) > max
)
1981 /* The end-point is past the end of the new string. */
1982 XSETCAR (XCDR (item
), new_end
);
1990 /* Call the modification hook functions in LIST, each with START and END. */
1993 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
1995 struct gcpro gcpro1
;
1997 while (!NILP (list
))
1999 call2 (Fcar (list
), start
, end
);
2005 /* Check for read-only intervals between character positions START ... END,
2006 in BUF, and signal an error if we find one.
2008 Then check for any modification hooks in the range.
2009 Create a list of all these hooks in lexicographic order,
2010 eliminating consecutive extra copies of the same hook. Then call
2011 those hooks in order, with START and END - 1 as arguments. */
2014 verify_interval_modification (struct buffer
*buf
, int start
, int end
)
2016 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2017 register INTERVAL i
;
2019 register Lisp_Object prev_mod_hooks
;
2020 Lisp_Object mod_hooks
;
2021 struct gcpro gcpro1
;
2024 prev_mod_hooks
= Qnil
;
2027 interval_insert_behind_hooks
= Qnil
;
2028 interval_insert_in_front_hooks
= Qnil
;
2030 if (NULL_INTERVAL_P (intervals
))
2035 EMACS_INT temp
= start
;
2040 /* For an insert operation, check the two chars around the position. */
2043 INTERVAL prev
= NULL
;
2044 Lisp_Object before
, after
;
2046 /* Set I to the interval containing the char after START,
2047 and PREV to the interval containing the char before START.
2048 Either one may be null. They may be equal. */
2049 i
= find_interval (intervals
, start
);
2051 if (start
== BUF_BEGV (buf
))
2053 else if (i
->position
== start
)
2054 prev
= previous_interval (i
);
2055 else if (i
->position
< start
)
2057 if (start
== BUF_ZV (buf
))
2060 /* If Vinhibit_read_only is set and is not a list, we can
2061 skip the read_only checks. */
2062 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2064 /* If I and PREV differ we need to check for the read-only
2065 property together with its stickiness. If either I or
2066 PREV are 0, this check is all we need.
2067 We have to take special care, since read-only may be
2068 indirectly defined via the category property. */
2071 if (! NULL_INTERVAL_P (i
))
2073 after
= textget (i
->plist
, Qread_only
);
2075 /* If interval I is read-only and read-only is
2076 front-sticky, inhibit insertion.
2077 Check for read-only as well as category. */
2079 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2083 tem
= textget (i
->plist
, Qfront_sticky
);
2084 if (TMEM (Qread_only
, tem
)
2085 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2086 && TMEM (Qcategory
, tem
)))
2087 text_read_only (after
);
2091 if (! NULL_INTERVAL_P (prev
))
2093 before
= textget (prev
->plist
, Qread_only
);
2095 /* If interval PREV is read-only and read-only isn't
2096 rear-nonsticky, inhibit insertion.
2097 Check for read-only as well as category. */
2099 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2103 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2104 if (! TMEM (Qread_only
, tem
)
2105 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2106 || ! TMEM (Qcategory
, tem
)))
2107 text_read_only (before
);
2111 else if (! NULL_INTERVAL_P (i
))
2113 after
= textget (i
->plist
, Qread_only
);
2115 /* If interval I is read-only and read-only is
2116 front-sticky, inhibit insertion.
2117 Check for read-only as well as category. */
2118 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2122 tem
= textget (i
->plist
, Qfront_sticky
);
2123 if (TMEM (Qread_only
, tem
)
2124 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2125 && TMEM (Qcategory
, tem
)))
2126 text_read_only (after
);
2128 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2129 if (! TMEM (Qread_only
, tem
)
2130 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2131 || ! TMEM (Qcategory
, tem
)))
2132 text_read_only (after
);
2137 /* Run both insert hooks (just once if they're the same). */
2138 if (!NULL_INTERVAL_P (prev
))
2139 interval_insert_behind_hooks
2140 = textget (prev
->plist
, Qinsert_behind_hooks
);
2141 if (!NULL_INTERVAL_P (i
))
2142 interval_insert_in_front_hooks
2143 = textget (i
->plist
, Qinsert_in_front_hooks
);
2147 /* Loop over intervals on or next to START...END,
2148 collecting their hooks. */
2150 i
= find_interval (intervals
, start
);
2153 if (! INTERVAL_WRITABLE_P (i
))
2154 text_read_only (textget (i
->plist
, Qread_only
));
2156 if (!inhibit_modification_hooks
)
2158 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2159 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2161 hooks
= Fcons (mod_hooks
, hooks
);
2162 prev_mod_hooks
= mod_hooks
;
2166 i
= next_interval (i
);
2168 /* Keep going thru the interval containing the char before END. */
2169 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2171 if (!inhibit_modification_hooks
)
2174 hooks
= Fnreverse (hooks
);
2175 while (! EQ (hooks
, Qnil
))
2177 call_mod_hooks (Fcar (hooks
), make_number (start
),
2179 hooks
= Fcdr (hooks
);
2186 /* Run the interval hooks for an insertion on character range START ... END.
2187 verify_interval_modification chose which hooks to run;
2188 this function is called after the insertion happens
2189 so it can indicate the range of inserted text. */
2192 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2194 if (! NILP (interval_insert_behind_hooks
))
2195 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2196 if (! NILP (interval_insert_in_front_hooks
)
2197 && ! EQ (interval_insert_in_front_hooks
,
2198 interval_insert_behind_hooks
))
2199 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2203 syms_of_textprop (void)
2205 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2206 doc
: /* Property-list used as default values.
2207 The value of a property in this list is seen as the value for every
2208 character that does not have its own value for that property. */);
2209 Vdefault_text_properties
= Qnil
;
2211 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2212 doc
: /* Alist of alternative properties for properties without a value.
2213 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2214 If a piece of text has no direct value for a particular property, then
2215 this alist is consulted. If that property appears in the alist, then
2216 the first non-nil value from the associated alternative properties is
2218 Vchar_property_alias_alist
= Qnil
;
2220 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2221 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2222 This also inhibits the use of the `intangible' text property. */);
2223 Vinhibit_point_motion_hooks
= Qnil
;
2225 DEFVAR_LISP ("text-property-default-nonsticky",
2226 Vtext_property_default_nonsticky
,
2227 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2228 Each element has the form (PROPERTY . NONSTICKINESS).
2230 If a character in a buffer has PROPERTY, new text inserted adjacent to
2231 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2232 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2233 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2234 /* Text property `syntax-table' should be nonsticky by default. */
2235 Vtext_property_default_nonsticky
2236 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
), Qnil
);
2238 staticpro (&interval_insert_behind_hooks
);
2239 staticpro (&interval_insert_in_front_hooks
);
2240 interval_insert_behind_hooks
= Qnil
;
2241 interval_insert_in_front_hooks
= Qnil
;
2244 /* Common attributes one might give text */
2246 staticpro (&Qforeground
);
2247 Qforeground
= intern_c_string ("foreground");
2248 staticpro (&Qbackground
);
2249 Qbackground
= intern_c_string ("background");
2251 Qfont
= intern_c_string ("font");
2252 staticpro (&Qstipple
);
2253 Qstipple
= intern_c_string ("stipple");
2254 staticpro (&Qunderline
);
2255 Qunderline
= intern_c_string ("underline");
2256 staticpro (&Qread_only
);
2257 Qread_only
= intern_c_string ("read-only");
2258 staticpro (&Qinvisible
);
2259 Qinvisible
= intern_c_string ("invisible");
2260 staticpro (&Qintangible
);
2261 Qintangible
= intern_c_string ("intangible");
2262 staticpro (&Qcategory
);
2263 Qcategory
= intern_c_string ("category");
2264 staticpro (&Qlocal_map
);
2265 Qlocal_map
= intern_c_string ("local-map");
2266 staticpro (&Qfront_sticky
);
2267 Qfront_sticky
= intern_c_string ("front-sticky");
2268 staticpro (&Qrear_nonsticky
);
2269 Qrear_nonsticky
= intern_c_string ("rear-nonsticky");
2270 staticpro (&Qmouse_face
);
2271 Qmouse_face
= intern_c_string ("mouse-face");
2272 staticpro (&Qminibuffer_prompt
);
2273 Qminibuffer_prompt
= intern_c_string ("minibuffer-prompt");
2275 /* Properties that text might use to specify certain actions */
2277 staticpro (&Qmouse_left
);
2278 Qmouse_left
= intern_c_string ("mouse-left");
2279 staticpro (&Qmouse_entered
);
2280 Qmouse_entered
= intern_c_string ("mouse-entered");
2281 staticpro (&Qpoint_left
);
2282 Qpoint_left
= intern_c_string ("point-left");
2283 staticpro (&Qpoint_entered
);
2284 Qpoint_entered
= intern_c_string ("point-entered");
2286 defsubr (&Stext_properties_at
);
2287 defsubr (&Sget_text_property
);
2288 defsubr (&Sget_char_property
);
2289 defsubr (&Sget_char_property_and_overlay
);
2290 defsubr (&Snext_char_property_change
);
2291 defsubr (&Sprevious_char_property_change
);
2292 defsubr (&Snext_single_char_property_change
);
2293 defsubr (&Sprevious_single_char_property_change
);
2294 defsubr (&Snext_property_change
);
2295 defsubr (&Snext_single_property_change
);
2296 defsubr (&Sprevious_property_change
);
2297 defsubr (&Sprevious_single_property_change
);
2298 defsubr (&Sadd_text_properties
);
2299 defsubr (&Sput_text_property
);
2300 defsubr (&Sset_text_properties
);
2301 defsubr (&Sremove_text_properties
);
2302 defsubr (&Sremove_list_of_text_properties
);
2303 defsubr (&Stext_property_any
);
2304 defsubr (&Stext_property_not_all
);
2305 /* defsubr (&Serase_text_properties); */
2306 /* defsubr (&Scopy_text_properties); */