1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2012 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"
26 /* Test for membership, allowing for t (actually any non-cons) to mean the
29 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
32 /* NOTES: previous- and next- property change will have to skip
33 zero-length intervals if they are implemented. This could be done
34 inside next_interval and previous_interval.
36 set_properties needs to deal with the interval property cache.
38 It is assumed that for any interval plist, a property appears
39 only once on the list. Although some code i.e., remove_properties,
40 handles the more general case, the uniqueness of properties is
41 necessary for the system to remain consistent. This requirement
42 is enforced by the subrs installing properties onto the intervals. */
46 static Lisp_Object Qmouse_left
;
47 static Lisp_Object Qmouse_entered
;
48 Lisp_Object Qpoint_left
;
49 Lisp_Object Qpoint_entered
;
50 Lisp_Object Qcategory
;
51 Lisp_Object Qlocal_map
;
53 /* Visual properties text (including strings) may have. */
54 static Lisp_Object Qforeground
, Qbackground
, Qunderline
;
56 static Lisp_Object Qstipple
;
57 Lisp_Object Qinvisible
, Qintangible
, Qmouse_face
;
58 static Lisp_Object Qread_only
;
59 Lisp_Object Qminibuffer_prompt
;
61 /* Sticky properties */
62 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
64 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
65 the o1's cdr. Otherwise, return zero. This is handy for
67 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
69 /* verify_interval_modification saves insertion hooks here
70 to be run later by report_interval_modification. */
71 static Lisp_Object interval_insert_behind_hooks
;
72 static Lisp_Object interval_insert_in_front_hooks
;
74 static void text_read_only (Lisp_Object
) NO_RETURN
;
75 static Lisp_Object
Fprevious_property_change (Lisp_Object
, Lisp_Object
,
79 /* Signal a `text-read-only' error. This function makes it easier
80 to capture that error in GDB by putting a breakpoint on it. */
83 text_read_only (Lisp_Object propval
)
85 if (STRINGP (propval
))
86 xsignal1 (Qtext_read_only
, propval
);
88 xsignal0 (Qtext_read_only
);
93 /* Extract the interval at the position pointed to by BEGIN from
94 OBJECT, a string or buffer. Additionally, check that the positions
95 pointed to by BEGIN and END are within the bounds of OBJECT, and
96 reverse them if *BEGIN is greater than *END. The objects pointed
97 to by BEGIN and END may be integers or markers; if the latter, they
98 are coerced to integers.
100 When OBJECT is a string, we increment *BEGIN and *END
101 to make them origin-one.
103 Note that buffer points don't correspond to interval indices.
104 For example, point-max is 1 greater than the index of the last
105 character. This difference is handled in the caller, which uses
106 the validated points to determine a length, and operates on that.
107 Exceptions are Ftext_properties_at, Fnext_property_change, and
108 Fprevious_property_change which call this function with BEGIN == END.
109 Handle this case specially.
111 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
112 create an interval tree for OBJECT if one doesn't exist, provided
113 the object actually contains text. In the current design, if there
114 is no text, there can be no text properties. */
120 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
125 CHECK_STRING_OR_BUFFER (object
);
126 CHECK_NUMBER_COERCE_MARKER (*begin
);
127 CHECK_NUMBER_COERCE_MARKER (*end
);
129 /* If we are asked for a point, but from a subr which operates
130 on a range, then return nothing. */
131 if (EQ (*begin
, *end
) && begin
!= end
)
132 return NULL_INTERVAL
;
134 if (XINT (*begin
) > XINT (*end
))
142 if (BUFFERP (object
))
144 register struct buffer
*b
= XBUFFER (object
);
146 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
147 && XINT (*end
) <= BUF_ZV (b
)))
148 args_out_of_range (*begin
, *end
);
149 i
= BUF_INTERVALS (b
);
151 /* If there's no text, there are no properties. */
152 if (BUF_BEGV (b
) == BUF_ZV (b
))
153 return NULL_INTERVAL
;
155 searchpos
= XINT (*begin
);
159 ptrdiff_t len
= SCHARS (object
);
161 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
162 && XINT (*end
) <= len
))
163 args_out_of_range (*begin
, *end
);
164 XSETFASTINT (*begin
, XFASTINT (*begin
));
166 XSETFASTINT (*end
, XFASTINT (*end
));
167 i
= STRING_INTERVALS (object
);
170 return NULL_INTERVAL
;
172 searchpos
= XINT (*begin
);
175 if (NULL_INTERVAL_P (i
))
176 return (force
? create_root_interval (object
) : i
);
178 return find_interval (i
, searchpos
);
181 /* Validate LIST as a property list. If LIST is not a list, then
182 make one consisting of (LIST nil). Otherwise, verify that LIST
183 is even numbered and thus suitable as a plist. */
186 validate_plist (Lisp_Object list
)
194 register Lisp_Object tail
;
195 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
201 error ("Odd length text property list");
205 return Fcons (list
, Fcons (Qnil
, Qnil
));
208 /* Return nonzero if interval I has all the properties,
209 with the same values, of list PLIST. */
212 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
214 register Lisp_Object tail1
, tail2
, sym1
;
217 /* Go through each element of PLIST. */
218 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
223 /* Go through I's plist, looking for sym1 */
224 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
225 if (EQ (sym1
, XCAR (tail2
)))
227 /* Found the same property on both lists. If the
228 values are unequal, return zero. */
229 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
232 /* Property has same value on both lists; go to next one. */
244 /* Return nonzero if the plist of interval I has any of the
245 properties of PLIST, regardless of their values. */
248 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
250 register Lisp_Object tail1
, tail2
, sym
;
252 /* Go through each element of PLIST. */
253 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
257 /* Go through i's plist, looking for tail1 */
258 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
259 if (EQ (sym
, XCAR (tail2
)))
266 /* Return nonzero if the plist of interval I has any of the
267 property names in LIST, regardless of their values. */
270 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
272 register Lisp_Object tail1
, tail2
, sym
;
274 /* Go through each element of LIST. */
275 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
279 /* Go through i's plist, looking for tail1 */
280 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
281 if (EQ (sym
, XCAR (tail2
)))
288 /* Changing the plists of individual intervals. */
290 /* Return the value of PROP in property-list PLIST, or Qunbound if it
293 property_value (Lisp_Object plist
, Lisp_Object prop
)
297 while (PLIST_ELT_P (plist
, value
))
298 if (EQ (XCAR (plist
), prop
))
301 plist
= XCDR (value
);
306 /* Set the properties of INTERVAL to PROPERTIES,
307 and record undo info for the previous values.
308 OBJECT is the string or buffer that INTERVAL belongs to. */
311 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
313 Lisp_Object sym
, value
;
315 if (BUFFERP (object
))
317 /* For each property in the old plist which is missing from PROPERTIES,
318 or has a different value in PROPERTIES, make an undo record. */
319 for (sym
= interval
->plist
;
320 PLIST_ELT_P (sym
, value
);
322 if (! EQ (property_value (properties
, XCAR (sym
)),
325 record_property_change (interval
->position
, LENGTH (interval
),
326 XCAR (sym
), XCAR (value
),
330 /* For each new property that has no value at all in the old plist,
331 make an undo record binding it to nil, so it will be removed. */
332 for (sym
= properties
;
333 PLIST_ELT_P (sym
, value
);
335 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
337 record_property_change (interval
->position
, LENGTH (interval
),
343 /* Store new properties. */
344 interval
->plist
= Fcopy_sequence (properties
);
347 /* Add the properties of PLIST to the interval I, or set
348 the value of I's property to the value of the property on PLIST
349 if they are different.
351 OBJECT should be the string or buffer the interval is in.
353 Return nonzero if this changes I (i.e., if any members of PLIST
354 are actually added to I's plist) */
357 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
359 Lisp_Object tail1
, tail2
, sym1
, val1
;
360 register int changed
= 0;
362 struct gcpro gcpro1
, gcpro2
, gcpro3
;
367 /* No need to protect OBJECT, because we can GC only in the case
368 where it is a buffer, and live buffers are always protected.
369 I and its plist are also protected, via OBJECT. */
370 GCPRO3 (tail1
, sym1
, val1
);
372 /* Go through each element of PLIST. */
373 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
376 val1
= Fcar (XCDR (tail1
));
379 /* Go through I's plist, looking for sym1 */
380 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
381 if (EQ (sym1
, XCAR (tail2
)))
383 /* No need to gcpro, because tail2 protects this
384 and it must be a cons cell (we get an error otherwise). */
385 register Lisp_Object this_cdr
;
387 this_cdr
= XCDR (tail2
);
388 /* Found the property. Now check its value. */
391 /* The properties have the same value on both lists.
392 Continue to the next property. */
393 if (EQ (val1
, Fcar (this_cdr
)))
396 /* Record this change in the buffer, for undo purposes. */
397 if (BUFFERP (object
))
399 record_property_change (i
->position
, LENGTH (i
),
400 sym1
, Fcar (this_cdr
), object
);
403 /* I's property has a different value -- change it */
404 Fsetcar (this_cdr
, val1
);
411 /* Record this change in the buffer, for undo purposes. */
412 if (BUFFERP (object
))
414 record_property_change (i
->position
, LENGTH (i
),
417 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
427 /* For any members of PLIST, or LIST,
428 which are properties of I, remove them from I's plist.
429 (If PLIST is non-nil, use that, otherwise use LIST.)
430 OBJECT is the string or buffer containing I. */
433 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
435 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
436 register int changed
= 0;
438 /* Nonzero means tail1 is a plist, otherwise it is a list. */
441 current_plist
= i
->plist
;
444 tail1
= plist
, use_plist
= 1;
446 tail1
= list
, use_plist
= 0;
448 /* Go through each element of LIST or PLIST. */
449 while (CONSP (tail1
))
453 /* First, remove the symbol if it's at the head of the list */
454 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
456 if (BUFFERP (object
))
457 record_property_change (i
->position
, LENGTH (i
),
458 sym
, XCAR (XCDR (current_plist
)),
461 current_plist
= XCDR (XCDR (current_plist
));
465 /* Go through I's plist, looking for SYM. */
466 tail2
= current_plist
;
467 while (! NILP (tail2
))
469 register Lisp_Object
this;
470 this = XCDR (XCDR (tail2
));
471 if (CONSP (this) && EQ (sym
, XCAR (this)))
473 if (BUFFERP (object
))
474 record_property_change (i
->position
, LENGTH (i
),
475 sym
, XCAR (XCDR (this)), object
);
477 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
483 /* Advance thru TAIL1 one way or the other. */
484 tail1
= XCDR (tail1
);
485 if (use_plist
&& CONSP (tail1
))
486 tail1
= XCDR (tail1
);
490 i
->plist
= current_plist
;
495 /* Remove all properties from interval I. Return non-zero
496 if this changes the interval. */
499 erase_properties (INTERVAL i
)
509 /* Returns the interval of POSITION in OBJECT.
510 POSITION is BEG-based. */
513 interval_of (ptrdiff_t position
, Lisp_Object object
)
519 XSETBUFFER (object
, current_buffer
);
520 else if (EQ (object
, Qt
))
521 return NULL_INTERVAL
;
523 CHECK_STRING_OR_BUFFER (object
);
525 if (BUFFERP (object
))
527 register struct buffer
*b
= XBUFFER (object
);
531 i
= BUF_INTERVALS (b
);
536 end
= SCHARS (object
);
537 i
= STRING_INTERVALS (object
);
540 if (!(beg
<= position
&& position
<= end
))
541 args_out_of_range (make_number (position
), make_number (position
));
542 if (beg
== end
|| NULL_INTERVAL_P (i
))
543 return NULL_INTERVAL
;
545 return find_interval (i
, position
);
548 DEFUN ("text-properties-at", Ftext_properties_at
,
549 Stext_properties_at
, 1, 2, 0,
550 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
551 If the optional second argument OBJECT is a buffer (or nil, which means
552 the current buffer), POSITION is a buffer position (integer or marker).
553 If OBJECT is a string, POSITION is a 0-based index into it.
554 If POSITION is at the end of OBJECT, the value is nil. */)
555 (Lisp_Object position
, Lisp_Object object
)
560 XSETBUFFER (object
, current_buffer
);
562 i
= validate_interval_range (object
, &position
, &position
, soft
);
563 if (NULL_INTERVAL_P (i
))
565 /* If POSITION is at the end of the interval,
566 it means it's the end of OBJECT.
567 There are no properties at the very end,
568 since no character follows. */
569 if (XINT (position
) == LENGTH (i
) + i
->position
)
575 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
576 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
577 OBJECT is optional and defaults to the current buffer.
578 If POSITION is at the end of OBJECT, the value is nil. */)
579 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
581 return textget (Ftext_properties_at (position
, object
), prop
);
584 /* Return the value of char's property PROP, in OBJECT at POSITION.
585 OBJECT is optional and defaults to the current buffer.
586 If OVERLAY is non-0, then in the case that the returned property is from
587 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
588 returned in *OVERLAY.
589 If POSITION is at the end of OBJECT, the value is nil.
590 If OBJECT is a buffer, then overlay properties are considered as well as
592 If OBJECT is a window, then that window's buffer is used, but
593 window-specific overlays are considered only if they are associated
596 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
598 struct window
*w
= 0;
600 CHECK_NUMBER_COERCE_MARKER (position
);
603 XSETBUFFER (object
, current_buffer
);
605 if (WINDOWP (object
))
607 w
= XWINDOW (object
);
610 if (BUFFERP (object
))
613 Lisp_Object
*overlay_vec
;
614 struct buffer
*obuf
= current_buffer
;
616 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
617 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
618 xsignal1 (Qargs_out_of_range
, position
);
620 set_buffer_temp (XBUFFER (object
));
622 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
623 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
625 set_buffer_temp (obuf
);
627 /* Now check the overlays in order of decreasing priority. */
628 while (--noverlays
>= 0)
630 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
634 /* Return the overlay we got the property from. */
635 *overlay
= overlay_vec
[noverlays
];
642 /* Indicate that the return value is not from an overlay. */
645 /* Not a buffer, or no appropriate overlay, so fall through to the
647 return Fget_text_property (position
, prop
, object
);
650 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
651 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
652 Both overlay properties and text properties are checked.
653 OBJECT is optional and defaults to the current buffer.
654 If POSITION is at the end of OBJECT, the value is nil.
655 If OBJECT is a buffer, then overlay properties are considered as well as
657 If OBJECT is a window, then that window's buffer is used, but window-specific
658 overlays are considered only if they are associated with OBJECT. */)
659 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
661 return get_char_property_and_overlay (position
, prop
, object
, 0);
664 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
665 Sget_char_property_and_overlay
, 2, 3, 0,
666 doc
: /* Like `get-char-property', but with extra overlay information.
667 The value is a cons cell. Its car is the return value of `get-char-property'
668 with the same arguments--that is, the value of POSITION's property
669 PROP in OBJECT. Its cdr is the overlay in which the property was
670 found, or nil, if it was found as a text property or not found at all.
672 OBJECT is optional and defaults to the current buffer. OBJECT may be
673 a string, a buffer or a window. For strings, the cdr of the return
674 value is always nil, since strings do not have overlays. If OBJECT is
675 a window, then that window's buffer is used, but window-specific
676 overlays are considered only if they are associated with OBJECT. If
677 POSITION is at the end of OBJECT, both car and cdr are nil. */)
678 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
682 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
683 return Fcons (val
, overlay
);
687 DEFUN ("next-char-property-change", Fnext_char_property_change
,
688 Snext_char_property_change
, 1, 2, 0,
689 doc
: /* Return the position of next text property or overlay change.
690 This scans characters forward in the current buffer from POSITION till
691 it finds a change in some text property, or the beginning or end of an
692 overlay, and returns the position of that.
693 If none is found up to (point-max), the function returns (point-max).
695 If the optional second argument LIMIT is non-nil, don't search
696 past position LIMIT; return LIMIT if nothing is found before LIMIT.
697 LIMIT is a no-op if it is greater than (point-max). */)
698 (Lisp_Object position
, Lisp_Object limit
)
702 temp
= Fnext_overlay_change (position
);
705 CHECK_NUMBER_COERCE_MARKER (limit
);
706 if (XINT (limit
) < XINT (temp
))
709 return Fnext_property_change (position
, Qnil
, temp
);
712 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
713 Sprevious_char_property_change
, 1, 2, 0,
714 doc
: /* Return the position of previous text property or overlay change.
715 Scans characters backward in the current buffer from POSITION till it
716 finds a change in some text property, or the beginning or end of an
717 overlay, and returns the position of that.
718 If none is found since (point-min), the function returns (point-min).
720 If the optional second argument LIMIT is non-nil, don't search
721 past position LIMIT; return LIMIT if nothing is found before LIMIT.
722 LIMIT is a no-op if it is less than (point-min). */)
723 (Lisp_Object position
, Lisp_Object limit
)
727 temp
= Fprevious_overlay_change (position
);
730 CHECK_NUMBER_COERCE_MARKER (limit
);
731 if (XINT (limit
) > XINT (temp
))
734 return Fprevious_property_change (position
, Qnil
, temp
);
738 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
739 Snext_single_char_property_change
, 2, 4, 0,
740 doc
: /* Return the position of next text property or overlay change for a specific property.
741 Scans characters forward from POSITION till it finds
742 a change in the PROP property, then returns the position of the change.
743 If the optional third argument OBJECT is a buffer (or nil, which means
744 the current buffer), POSITION is a buffer position (integer or marker).
745 If OBJECT is a string, POSITION is a 0-based index into it.
747 In a string, scan runs to the end of the string.
748 In a buffer, it runs to (point-max), and the value cannot exceed that.
750 The property values are compared with `eq'.
751 If the property is constant all the way to the end of OBJECT, return the
752 last valid position in OBJECT.
753 If the optional fourth argument LIMIT is non-nil, don't search
754 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
755 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
757 if (STRINGP (object
))
759 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
763 position
= make_number (SCHARS (object
));
766 CHECK_NUMBER (limit
);
773 Lisp_Object initial_value
, value
;
774 ptrdiff_t count
= SPECPDL_INDEX ();
777 CHECK_BUFFER (object
);
779 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
781 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
782 Fset_buffer (object
);
785 CHECK_NUMBER_COERCE_MARKER (position
);
787 initial_value
= Fget_char_property (position
, prop
, object
);
790 XSETFASTINT (limit
, ZV
);
792 CHECK_NUMBER_COERCE_MARKER (limit
);
794 if (XFASTINT (position
) >= XFASTINT (limit
))
797 if (XFASTINT (position
) > ZV
)
798 XSETFASTINT (position
, ZV
);
803 position
= Fnext_char_property_change (position
, limit
);
804 if (XFASTINT (position
) >= XFASTINT (limit
))
810 value
= Fget_char_property (position
, prop
, object
);
811 if (!EQ (value
, initial_value
))
815 unbind_to (count
, Qnil
);
821 DEFUN ("previous-single-char-property-change",
822 Fprevious_single_char_property_change
,
823 Sprevious_single_char_property_change
, 2, 4, 0,
824 doc
: /* Return the position of previous text property or overlay change for a specific property.
825 Scans characters backward from POSITION till it finds
826 a change in the PROP property, then returns the position of the change.
827 If the optional third argument OBJECT is a buffer (or nil, which means
828 the current buffer), POSITION is a buffer position (integer or marker).
829 If OBJECT is a string, POSITION is a 0-based index into it.
831 In a string, scan runs to the start of the string.
832 In a buffer, it runs to (point-min), and the value cannot be less than that.
834 The property values are compared with `eq'.
835 If the property is constant all the way to the start of OBJECT, return the
836 first valid position in OBJECT.
837 If the optional fourth argument LIMIT is non-nil, don't search back past
838 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
839 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
841 if (STRINGP (object
))
843 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
847 position
= make_number (0);
850 CHECK_NUMBER (limit
);
857 ptrdiff_t count
= SPECPDL_INDEX ();
860 CHECK_BUFFER (object
);
862 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
864 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
865 Fset_buffer (object
);
868 CHECK_NUMBER_COERCE_MARKER (position
);
871 XSETFASTINT (limit
, BEGV
);
873 CHECK_NUMBER_COERCE_MARKER (limit
);
875 if (XFASTINT (position
) <= XFASTINT (limit
))
878 if (XFASTINT (position
) < BEGV
)
879 XSETFASTINT (position
, BEGV
);
883 Lisp_Object initial_value
884 = Fget_char_property (make_number (XFASTINT (position
) - 1),
889 position
= Fprevious_char_property_change (position
, limit
);
891 if (XFASTINT (position
) <= XFASTINT (limit
))
899 = Fget_char_property (make_number (XFASTINT (position
) - 1),
902 if (!EQ (value
, initial_value
))
908 unbind_to (count
, Qnil
);
914 DEFUN ("next-property-change", Fnext_property_change
,
915 Snext_property_change
, 1, 3, 0,
916 doc
: /* Return the position of next property change.
917 Scans characters forward from POSITION in OBJECT till it finds
918 a change in some text property, then returns the position of the change.
919 If the optional second argument OBJECT is a buffer (or nil, which means
920 the current buffer), POSITION is a buffer position (integer or marker).
921 If OBJECT is a string, POSITION is a 0-based index into it.
922 Return nil if the property is constant all the way to the end of OBJECT.
923 If the value is non-nil, it is a position greater than POSITION, never equal.
925 If the optional third argument LIMIT is non-nil, don't search
926 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
927 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
929 register INTERVAL i
, next
;
932 XSETBUFFER (object
, current_buffer
);
934 if (!NILP (limit
) && !EQ (limit
, Qt
))
935 CHECK_NUMBER_COERCE_MARKER (limit
);
937 i
= validate_interval_range (object
, &position
, &position
, soft
);
939 /* If LIMIT is t, return start of next interval--don't
940 bother checking further intervals. */
943 if (NULL_INTERVAL_P (i
))
946 next
= next_interval (i
);
948 if (NULL_INTERVAL_P (next
))
949 XSETFASTINT (position
, (STRINGP (object
)
951 : BUF_ZV (XBUFFER (object
))));
953 XSETFASTINT (position
, next
->position
);
957 if (NULL_INTERVAL_P (i
))
960 next
= next_interval (i
);
962 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
963 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
964 next
= next_interval (next
);
966 if (NULL_INTERVAL_P (next
)
972 : BUF_ZV (XBUFFER (object
))))))
975 return make_number (next
->position
);
978 DEFUN ("next-single-property-change", Fnext_single_property_change
,
979 Snext_single_property_change
, 2, 4, 0,
980 doc
: /* Return the position of next property change for a specific property.
981 Scans characters forward from POSITION till it finds
982 a change in the PROP property, then returns the position of the change.
983 If the optional third argument OBJECT is a buffer (or nil, which means
984 the current buffer), POSITION is a buffer position (integer or marker).
985 If OBJECT is a string, POSITION is a 0-based index into it.
986 The property values are compared with `eq'.
987 Return nil if the property is constant all the way to the end of OBJECT.
988 If the value is non-nil, it is a position greater than POSITION, never equal.
990 If the optional fourth argument LIMIT is non-nil, don't search
991 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
992 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
994 register INTERVAL i
, next
;
995 register Lisp_Object here_val
;
998 XSETBUFFER (object
, current_buffer
);
1001 CHECK_NUMBER_COERCE_MARKER (limit
);
1003 i
= validate_interval_range (object
, &position
, &position
, soft
);
1004 if (NULL_INTERVAL_P (i
))
1007 here_val
= textget (i
->plist
, prop
);
1008 next
= next_interval (i
);
1009 while (! NULL_INTERVAL_P (next
)
1010 && EQ (here_val
, textget (next
->plist
, prop
))
1011 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1012 next
= next_interval (next
);
1014 if (NULL_INTERVAL_P (next
)
1016 >= (INTEGERP (limit
)
1020 : BUF_ZV (XBUFFER (object
))))))
1023 return make_number (next
->position
);
1026 DEFUN ("previous-property-change", Fprevious_property_change
,
1027 Sprevious_property_change
, 1, 3, 0,
1028 doc
: /* Return the position of previous property change.
1029 Scans characters backwards from POSITION in OBJECT till it finds
1030 a change in some text property, then returns the position of the change.
1031 If the optional second argument OBJECT is a buffer (or nil, which means
1032 the current buffer), POSITION is a buffer position (integer or marker).
1033 If OBJECT is a string, POSITION is a 0-based index into it.
1034 Return nil if the property is constant all the way to the start of OBJECT.
1035 If the value is non-nil, it is a position less than POSITION, never equal.
1037 If the optional third argument LIMIT is non-nil, don't search
1038 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1039 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1041 register INTERVAL i
, previous
;
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 /* Start with the interval containing the char before point. */
1054 if (i
->position
== XFASTINT (position
))
1055 i
= previous_interval (i
);
1057 previous
= previous_interval (i
);
1058 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1060 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1061 previous
= previous_interval (previous
);
1063 if (NULL_INTERVAL_P (previous
)
1064 || (previous
->position
+ LENGTH (previous
)
1065 <= (INTEGERP (limit
)
1067 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1070 return make_number (previous
->position
+ LENGTH (previous
));
1073 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1074 Sprevious_single_property_change
, 2, 4, 0,
1075 doc
: /* Return the position of previous property change for a specific property.
1076 Scans characters backward from POSITION till it finds
1077 a change in the PROP property, then returns the position of the change.
1078 If the optional third argument OBJECT is a buffer (or nil, which means
1079 the current buffer), POSITION is a buffer position (integer or marker).
1080 If OBJECT is a string, POSITION is a 0-based index into it.
1081 The property values are compared with `eq'.
1082 Return nil if the property is constant all the way to the start of OBJECT.
1083 If the value is non-nil, it is a position less than POSITION, never equal.
1085 If the optional fourth argument LIMIT is non-nil, don't search
1086 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1087 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1089 register INTERVAL i
, previous
;
1090 register Lisp_Object here_val
;
1093 XSETBUFFER (object
, current_buffer
);
1096 CHECK_NUMBER_COERCE_MARKER (limit
);
1098 i
= validate_interval_range (object
, &position
, &position
, soft
);
1100 /* Start with the interval containing the char before point. */
1101 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1102 i
= previous_interval (i
);
1104 if (NULL_INTERVAL_P (i
))
1107 here_val
= textget (i
->plist
, prop
);
1108 previous
= previous_interval (i
);
1109 while (!NULL_INTERVAL_P (previous
)
1110 && EQ (here_val
, textget (previous
->plist
, prop
))
1112 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1113 previous
= previous_interval (previous
);
1115 if (NULL_INTERVAL_P (previous
)
1116 || (previous
->position
+ LENGTH (previous
)
1117 <= (INTEGERP (limit
)
1119 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1122 return make_number (previous
->position
+ LENGTH (previous
));
1125 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1127 DEFUN ("add-text-properties", Fadd_text_properties
,
1128 Sadd_text_properties
, 3, 4, 0,
1129 doc
: /* Add properties to the text from START to END.
1130 The third argument PROPERTIES is a property list
1131 specifying the property values to add. If the optional fourth argument
1132 OBJECT is a buffer (or nil, which means the current buffer),
1133 START and END are buffer positions (integers or markers).
1134 If OBJECT is a string, START and END are 0-based indices into it.
1135 Return t if any property value actually changed, nil otherwise. */)
1136 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1138 register INTERVAL i
, unchanged
;
1139 register ptrdiff_t s
, len
;
1140 register int modified
= 0;
1141 struct gcpro gcpro1
;
1143 properties
= validate_plist (properties
);
1144 if (NILP (properties
))
1148 XSETBUFFER (object
, current_buffer
);
1150 i
= validate_interval_range (object
, &start
, &end
, hard
);
1151 if (NULL_INTERVAL_P (i
))
1155 len
= XINT (end
) - s
;
1157 /* No need to protect OBJECT, because we GC only if it's a buffer,
1158 and live buffers are always protected. */
1159 GCPRO1 (properties
);
1161 /* If we're not starting on an interval boundary, we have to
1162 split this interval. */
1163 if (i
->position
!= s
)
1165 /* If this interval already has the properties, we can
1167 if (interval_has_all_properties (properties
, i
))
1169 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1171 RETURN_UNGCPRO (Qnil
);
1173 i
= next_interval (i
);
1178 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1179 copy_properties (unchanged
, i
);
1183 if (BUFFERP (object
))
1184 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1186 /* We are at the beginning of interval I, with LEN chars to scan. */
1192 if (LENGTH (i
) >= len
)
1194 /* We can UNGCPRO safely here, because there will be just
1195 one more chance to gc, in the next call to add_properties,
1196 and after that we will not need PROPERTIES or OBJECT again. */
1199 if (interval_has_all_properties (properties
, i
))
1201 if (BUFFERP (object
))
1202 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1203 XINT (end
) - XINT (start
));
1205 return modified
? Qt
: Qnil
;
1208 if (LENGTH (i
) == len
)
1210 add_properties (properties
, i
, object
);
1211 if (BUFFERP (object
))
1212 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1213 XINT (end
) - XINT (start
));
1217 /* i doesn't have the properties, and goes past the change limit */
1219 i
= split_interval_left (unchanged
, len
);
1220 copy_properties (unchanged
, i
);
1221 add_properties (properties
, i
, object
);
1222 if (BUFFERP (object
))
1223 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1224 XINT (end
) - XINT (start
));
1229 modified
+= add_properties (properties
, i
, object
);
1230 i
= next_interval (i
);
1234 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1236 DEFUN ("put-text-property", Fput_text_property
,
1237 Sput_text_property
, 4, 5, 0,
1238 doc
: /* Set one property of the text from START to END.
1239 The third and fourth arguments PROPERTY and VALUE
1240 specify the property to add.
1241 If the optional fifth argument OBJECT is a buffer (or nil, which means
1242 the current buffer), START and END are buffer positions (integers or
1243 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1244 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1246 Fadd_text_properties (start
, end
,
1247 Fcons (property
, Fcons (value
, Qnil
)),
1252 DEFUN ("set-text-properties", Fset_text_properties
,
1253 Sset_text_properties
, 3, 4, 0,
1254 doc
: /* Completely replace properties of text from START to END.
1255 The third argument PROPERTIES is the new property list.
1256 If the optional fourth argument OBJECT is a buffer (or nil, which means
1257 the current buffer), START and END are buffer positions (integers or
1258 markers). If OBJECT is a string, START and END are 0-based indices into it.
1259 If PROPERTIES is nil, the effect is to remove all properties from
1260 the designated part of OBJECT. */)
1261 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1263 return set_text_properties (start
, end
, properties
, object
, Qt
);
1267 /* Replace properties of text from START to END with new list of
1268 properties PROPERTIES. OBJECT is the buffer or string containing
1269 the text. OBJECT nil means use the current buffer.
1270 COHERENT_CHANGE_P nil means this is being called as an internal
1271 subroutine, rather than as a change primitive with checking of
1272 read-only, invoking change hooks, etc.. Value is nil if the
1273 function _detected_ that it did not replace any properties, non-nil
1277 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1279 register INTERVAL i
;
1280 Lisp_Object ostart
, oend
;
1285 properties
= validate_plist (properties
);
1288 XSETBUFFER (object
, current_buffer
);
1290 /* If we want no properties for a whole string,
1291 get rid of its intervals. */
1292 if (NILP (properties
) && STRINGP (object
)
1293 && XFASTINT (start
) == 0
1294 && XFASTINT (end
) == SCHARS (object
))
1296 if (! STRING_INTERVALS (object
))
1299 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1303 i
= validate_interval_range (object
, &start
, &end
, soft
);
1305 if (NULL_INTERVAL_P (i
))
1307 /* If buffer has no properties, and we want none, return now. */
1308 if (NILP (properties
))
1311 /* Restore the original START and END values
1312 because validate_interval_range increments them for strings. */
1316 i
= validate_interval_range (object
, &start
, &end
, hard
);
1317 /* This can return if start == end. */
1318 if (NULL_INTERVAL_P (i
))
1322 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1323 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1325 set_text_properties_1 (start
, end
, properties
, object
, i
);
1327 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1328 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1329 XINT (end
) - XINT (start
));
1333 /* Replace properties of text from START to END with new list of
1334 properties PROPERTIES. BUFFER is the buffer containing
1335 the text. This does not obey any hooks.
1336 You can provide the interval that START is located in as I,
1337 or pass NULL for I and this function will find it.
1338 START and END can be in any order. */
1341 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object buffer
, INTERVAL i
)
1343 register INTERVAL prev_changed
= NULL_INTERVAL
;
1344 register ptrdiff_t s
, len
;
1347 if (XINT (start
) < XINT (end
))
1350 len
= XINT (end
) - s
;
1352 else if (XINT (end
) < XINT (start
))
1355 len
= XINT (start
) - 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 DEFUN ("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 ptrdiff_t 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 ptrdiff_t 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 DEFUN ("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 ptrdiff_t 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 ptrdiff_t 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 DEFUN ("text-property-any", Ftext_property_any
,
1623 Stext_property_any
, 4, 5, 0,
1624 doc
: /* Check text from START to END for property PROPERTY equaling 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 ptrdiff_t 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 equaling 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 ptrdiff_t 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 */
1706 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1709 XSETBUFFER (buffer
, current_buffer
);
1711 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1714 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1715 /* Consider previous character. */
1717 Lisp_Object rear_non_sticky
;
1719 prev_pos
= make_number (XINT (pos
) - 1);
1720 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1722 if (!NILP (CONSP (rear_non_sticky
)
1723 ? Fmemq (prop
, rear_non_sticky
)
1725 /* PROP is rear-non-sticky. */
1731 /* Consider following character. */
1732 /* This signals an arg-out-of-range error if pos is outside the
1733 buffer's accessible range. */
1734 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1736 if (EQ (front_sticky
, Qt
)
1737 || (CONSP (front_sticky
)
1738 && !NILP (Fmemq (prop
, front_sticky
))))
1739 /* PROP is inherited from after. */
1740 is_front_sticky
= 1;
1742 /* Simple cases, where the properties are consistent. */
1743 if (is_rear_sticky
&& !is_front_sticky
)
1745 else if (!is_rear_sticky
&& is_front_sticky
)
1747 else if (!is_rear_sticky
&& !is_front_sticky
)
1750 /* The stickiness properties are inconsistent, so we have to
1751 disambiguate. Basically, rear-sticky wins, _except_ if the
1752 property that would be inherited has a value of nil, in which case
1753 front-sticky wins. */
1754 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1755 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1762 /* Copying properties between objects. */
1764 /* Add properties from START to END of SRC, starting at POS in DEST.
1765 SRC and DEST may each refer to strings or buffers.
1766 Optional sixth argument PROP causes only that property to be copied.
1767 Properties are copied to DEST as if by `add-text-properties'.
1768 Return t if any property value actually changed, nil otherwise. */
1770 /* Note this can GC when DEST is a buffer. */
1773 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1779 ptrdiff_t s
, e
, e2
, p
, len
;
1781 struct gcpro gcpro1
, gcpro2
;
1783 i
= validate_interval_range (src
, &start
, &end
, soft
);
1784 if (NULL_INTERVAL_P (i
))
1787 CHECK_NUMBER_COERCE_MARKER (pos
);
1789 Lisp_Object dest_start
, dest_end
;
1791 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1792 if (MOST_POSITIVE_FIXNUM
< e
)
1793 args_out_of_range (pos
, end
);
1795 XSETFASTINT (dest_end
, e
);
1796 /* Apply this to a copy of pos; it will try to increment its arguments,
1797 which we don't want. */
1798 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1809 e2
= i
->position
+ LENGTH (i
);
1816 while (! NILP (plist
))
1818 if (EQ (Fcar (plist
), prop
))
1820 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1823 plist
= Fcdr (Fcdr (plist
));
1827 /* Must defer modifications to the interval tree in case src
1828 and dest refer to the same string or buffer. */
1829 stuff
= Fcons (Fcons (make_number (p
),
1830 Fcons (make_number (p
+ len
),
1831 Fcons (plist
, Qnil
))),
1835 i
= next_interval (i
);
1836 if (NULL_INTERVAL_P (i
))
1843 GCPRO2 (stuff
, dest
);
1845 while (! NILP (stuff
))
1848 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1849 Fcar (Fcdr (Fcdr (res
))), dest
);
1852 stuff
= Fcdr (stuff
);
1857 return modified
? Qt
: Qnil
;
1861 /* Return a list representing the text properties of OBJECT between
1862 START and END. if PROP is non-nil, report only on that property.
1863 Each result list element has the form (S E PLIST), where S and E
1864 are positions in OBJECT and PLIST is a property list containing the
1865 text properties of OBJECT between S and E. Value is nil if OBJECT
1866 doesn't contain text properties between START and END. */
1869 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1876 i
= validate_interval_range (object
, &start
, &end
, soft
);
1877 if (!NULL_INTERVAL_P (i
))
1879 ptrdiff_t s
= XINT (start
);
1880 ptrdiff_t e
= XINT (end
);
1884 ptrdiff_t interval_end
, len
;
1887 interval_end
= i
->position
+ LENGTH (i
);
1888 if (interval_end
> e
)
1890 len
= interval_end
- s
;
1895 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
1896 if (EQ (XCAR (plist
), prop
))
1898 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
1903 result
= Fcons (Fcons (make_number (s
),
1904 Fcons (make_number (s
+ len
),
1905 Fcons (plist
, Qnil
))),
1908 i
= next_interval (i
);
1909 if (NULL_INTERVAL_P (i
))
1919 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1920 (START END PLIST), where START and END are positions and PLIST is a
1921 property list containing the text properties to add. Adjust START
1922 and END positions by DELTA before adding properties. Value is
1923 non-zero if OBJECT was modified. */
1926 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
1928 struct gcpro gcpro1
, gcpro2
;
1931 GCPRO2 (list
, object
);
1933 for (; CONSP (list
); list
= XCDR (list
))
1935 Lisp_Object item
, start
, end
, plist
, tem
;
1938 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1939 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1940 plist
= XCAR (XCDR (XCDR (item
)));
1942 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1953 /* Modify end-points of ranges in LIST destructively, and return the
1954 new list. LIST is a list as returned from text_property_list.
1955 Discard properties that begin at or after NEW_END, and limit
1956 end-points to NEW_END. */
1959 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
1961 Lisp_Object prev
= Qnil
, head
= list
;
1962 ptrdiff_t max
= XINT (new_end
);
1964 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
1966 Lisp_Object item
, beg
, end
;
1970 end
= XCAR (XCDR (item
));
1972 if (XINT (beg
) >= max
)
1974 /* The start-point is past the end of the new string.
1975 Discard this property. */
1976 if (EQ (head
, list
))
1979 XSETCDR (prev
, XCDR (list
));
1981 else if (XINT (end
) > max
)
1982 /* The end-point is past the end of the new string. */
1983 XSETCAR (XCDR (item
), new_end
);
1991 /* Call the modification hook functions in LIST, each with START and END. */
1994 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
1996 struct gcpro gcpro1
;
1998 while (!NILP (list
))
2000 call2 (Fcar (list
), start
, end
);
2006 /* Check for read-only intervals between character positions START ... END,
2007 in BUF, and signal an error if we find one.
2009 Then check for any modification hooks in the range.
2010 Create a list of all these hooks in lexicographic order,
2011 eliminating consecutive extra copies of the same hook. Then call
2012 those hooks in order, with START and END - 1 as arguments. */
2015 verify_interval_modification (struct buffer
*buf
,
2016 ptrdiff_t start
, ptrdiff_t end
)
2018 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2019 register INTERVAL i
;
2021 register Lisp_Object prev_mod_hooks
;
2022 Lisp_Object mod_hooks
;
2023 struct gcpro gcpro1
;
2026 prev_mod_hooks
= Qnil
;
2029 interval_insert_behind_hooks
= Qnil
;
2030 interval_insert_in_front_hooks
= Qnil
;
2032 if (NULL_INTERVAL_P (intervals
))
2037 ptrdiff_t temp
= start
;
2042 /* For an insert operation, check the two chars around the position. */
2045 INTERVAL prev
= NULL
;
2046 Lisp_Object before
, after
;
2048 /* Set I to the interval containing the char after START,
2049 and PREV to the interval containing the char before START.
2050 Either one may be null. They may be equal. */
2051 i
= find_interval (intervals
, start
);
2053 if (start
== BUF_BEGV (buf
))
2055 else if (i
->position
== start
)
2056 prev
= previous_interval (i
);
2057 else if (i
->position
< start
)
2059 if (start
== BUF_ZV (buf
))
2062 /* If Vinhibit_read_only is set and is not a list, we can
2063 skip the read_only checks. */
2064 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2066 /* If I and PREV differ we need to check for the read-only
2067 property together with its stickiness. If either I or
2068 PREV are 0, this check is all we need.
2069 We have to take special care, since read-only may be
2070 indirectly defined via the category property. */
2073 if (! NULL_INTERVAL_P (i
))
2075 after
= textget (i
->plist
, Qread_only
);
2077 /* If interval I is read-only and read-only is
2078 front-sticky, inhibit insertion.
2079 Check for read-only as well as category. */
2081 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2085 tem
= textget (i
->plist
, Qfront_sticky
);
2086 if (TMEM (Qread_only
, tem
)
2087 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2088 && TMEM (Qcategory
, tem
)))
2089 text_read_only (after
);
2093 if (! NULL_INTERVAL_P (prev
))
2095 before
= textget (prev
->plist
, Qread_only
);
2097 /* If interval PREV is read-only and read-only isn't
2098 rear-nonsticky, inhibit insertion.
2099 Check for read-only as well as category. */
2101 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2105 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2106 if (! TMEM (Qread_only
, tem
)
2107 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2108 || ! TMEM (Qcategory
, tem
)))
2109 text_read_only (before
);
2113 else if (! NULL_INTERVAL_P (i
))
2115 after
= textget (i
->plist
, Qread_only
);
2117 /* If interval I is read-only and read-only is
2118 front-sticky, inhibit insertion.
2119 Check for read-only as well as category. */
2120 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2124 tem
= textget (i
->plist
, Qfront_sticky
);
2125 if (TMEM (Qread_only
, tem
)
2126 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2127 && TMEM (Qcategory
, tem
)))
2128 text_read_only (after
);
2130 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2131 if (! TMEM (Qread_only
, tem
)
2132 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2133 || ! TMEM (Qcategory
, tem
)))
2134 text_read_only (after
);
2139 /* Run both insert hooks (just once if they're the same). */
2140 if (!NULL_INTERVAL_P (prev
))
2141 interval_insert_behind_hooks
2142 = textget (prev
->plist
, Qinsert_behind_hooks
);
2143 if (!NULL_INTERVAL_P (i
))
2144 interval_insert_in_front_hooks
2145 = textget (i
->plist
, Qinsert_in_front_hooks
);
2149 /* Loop over intervals on or next to START...END,
2150 collecting their hooks. */
2152 i
= find_interval (intervals
, start
);
2155 if (! INTERVAL_WRITABLE_P (i
))
2156 text_read_only (textget (i
->plist
, Qread_only
));
2158 if (!inhibit_modification_hooks
)
2160 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2161 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2163 hooks
= Fcons (mod_hooks
, hooks
);
2164 prev_mod_hooks
= mod_hooks
;
2168 i
= next_interval (i
);
2170 /* Keep going thru the interval containing the char before END. */
2171 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2173 if (!inhibit_modification_hooks
)
2176 hooks
= Fnreverse (hooks
);
2177 while (! EQ (hooks
, Qnil
))
2179 call_mod_hooks (Fcar (hooks
), make_number (start
),
2181 hooks
= Fcdr (hooks
);
2188 /* Run the interval hooks for an insertion on character range START ... END.
2189 verify_interval_modification chose which hooks to run;
2190 this function is called after the insertion happens
2191 so it can indicate the range of inserted text. */
2194 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2196 if (! NILP (interval_insert_behind_hooks
))
2197 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2198 if (! NILP (interval_insert_in_front_hooks
)
2199 && ! EQ (interval_insert_in_front_hooks
,
2200 interval_insert_behind_hooks
))
2201 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2205 syms_of_textprop (void)
2207 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2208 doc
: /* Property-list used as default values.
2209 The value of a property in this list is seen as the value for every
2210 character that does not have its own value for that property. */);
2211 Vdefault_text_properties
= Qnil
;
2213 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2214 doc
: /* Alist of alternative properties for properties without a value.
2215 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2216 If a piece of text has no direct value for a particular property, then
2217 this alist is consulted. If that property appears in the alist, then
2218 the first non-nil value from the associated alternative properties is
2220 Vchar_property_alias_alist
= Qnil
;
2222 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2223 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2224 This also inhibits the use of the `intangible' text property. */);
2225 Vinhibit_point_motion_hooks
= Qnil
;
2227 DEFVAR_LISP ("text-property-default-nonsticky",
2228 Vtext_property_default_nonsticky
,
2229 doc
: /* Alist of properties vs the corresponding non-stickiness.
2230 Each element has the form (PROPERTY . NONSTICKINESS).
2232 If a character in a buffer has PROPERTY, new text inserted adjacent to
2233 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2234 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2235 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2236 /* Text properties `syntax-table'and `display' should be nonsticky
2238 Vtext_property_default_nonsticky
2239 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
),
2240 Fcons (Fcons (intern_c_string ("display"), Qt
), Qnil
));
2242 staticpro (&interval_insert_behind_hooks
);
2243 staticpro (&interval_insert_in_front_hooks
);
2244 interval_insert_behind_hooks
= Qnil
;
2245 interval_insert_in_front_hooks
= Qnil
;
2248 /* Common attributes one might give text */
2250 DEFSYM (Qforeground
, "foreground");
2251 DEFSYM (Qbackground
, "background");
2252 DEFSYM (Qfont
, "font");
2253 DEFSYM (Qstipple
, "stipple");
2254 DEFSYM (Qunderline
, "underline");
2255 DEFSYM (Qread_only
, "read-only");
2256 DEFSYM (Qinvisible
, "invisible");
2257 DEFSYM (Qintangible
, "intangible");
2258 DEFSYM (Qcategory
, "category");
2259 DEFSYM (Qlocal_map
, "local-map");
2260 DEFSYM (Qfront_sticky
, "front-sticky");
2261 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2262 DEFSYM (Qmouse_face
, "mouse-face");
2263 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2265 /* Properties that text might use to specify certain actions */
2267 DEFSYM (Qmouse_left
, "mouse-left");
2268 DEFSYM (Qmouse_entered
, "mouse-entered");
2269 DEFSYM (Qpoint_left
, "point-left");
2270 DEFSYM (Qpoint_entered
, "point-entered");
2272 defsubr (&Stext_properties_at
);
2273 defsubr (&Sget_text_property
);
2274 defsubr (&Sget_char_property
);
2275 defsubr (&Sget_char_property_and_overlay
);
2276 defsubr (&Snext_char_property_change
);
2277 defsubr (&Sprevious_char_property_change
);
2278 defsubr (&Snext_single_char_property_change
);
2279 defsubr (&Sprevious_single_char_property_change
);
2280 defsubr (&Snext_property_change
);
2281 defsubr (&Snext_single_property_change
);
2282 defsubr (&Sprevious_property_change
);
2283 defsubr (&Sprevious_single_property_change
);
2284 defsubr (&Sadd_text_properties
);
2285 defsubr (&Sput_text_property
);
2286 defsubr (&Sset_text_properties
);
2287 defsubr (&Sremove_text_properties
);
2288 defsubr (&Sremove_list_of_text_properties
);
2289 defsubr (&Stext_property_any
);
2290 defsubr (&Stext_property_not_all
);