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"
23 #include "character.h"
27 /* Test for membership, allowing for t (actually any non-cons) to mean the
30 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
33 /* NOTES: previous- and next- property change will have to skip
34 zero-length intervals if they are implemented. This could be done
35 inside next_interval and previous_interval.
37 set_properties needs to deal with the interval property cache.
39 It is assumed that for any interval plist, a property appears
40 only once on the list. Although some code i.e., remove_properties,
41 handles the more general case, the uniqueness of properties is
42 necessary for the system to remain consistent. This requirement
43 is enforced by the subrs installing properties onto the intervals. */
47 static Lisp_Object Qmouse_left
;
48 static Lisp_Object Qmouse_entered
;
49 Lisp_Object Qpoint_left
;
50 Lisp_Object Qpoint_entered
;
51 Lisp_Object Qcategory
;
52 Lisp_Object Qlocal_map
;
54 /* Visual properties text (including strings) may have. */
55 static Lisp_Object Qforeground
, Qbackground
, Qunderline
;
57 static Lisp_Object Qstipple
;
58 Lisp_Object Qinvisible
, Qintangible
, Qmouse_face
;
59 static Lisp_Object Qread_only
;
60 Lisp_Object Qminibuffer_prompt
;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 /* verify_interval_modification saves insertion hooks here
71 to be run later by report_interval_modification. */
72 static Lisp_Object interval_insert_behind_hooks
;
73 static Lisp_Object interval_insert_in_front_hooks
;
76 /* Signal a `text-read-only' error. This function makes it easier
77 to capture that error in GDB by putting a breakpoint on it. */
80 text_read_only (Lisp_Object propval
)
82 if (STRINGP (propval
))
83 xsignal1 (Qtext_read_only
, propval
);
85 xsignal0 (Qtext_read_only
);
90 /* Extract the interval at the position pointed to by BEGIN from
91 OBJECT, a string or buffer. Additionally, check that the positions
92 pointed to by BEGIN and END are within the bounds of OBJECT, and
93 reverse them if *BEGIN is greater than *END. The objects pointed
94 to by BEGIN and END may be integers or markers; if the latter, they
95 are coerced to integers.
97 When OBJECT is a string, we increment *BEGIN and *END
98 to make them origin-one.
100 Note that buffer points don't correspond to interval indices.
101 For example, point-max is 1 greater than the index of the last
102 character. This difference is handled in the caller, which uses
103 the validated points to determine a length, and operates on that.
104 Exceptions are Ftext_properties_at, Fnext_property_change, and
105 Fprevious_property_change which call this function with BEGIN == END.
106 Handle this case specially.
108 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
109 create an interval tree for OBJECT if one doesn't exist, provided
110 the object actually contains text. In the current design, if there
111 is no text, there can be no text properties. */
117 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
122 CHECK_STRING_OR_BUFFER (object
);
123 CHECK_NUMBER_COERCE_MARKER (*begin
);
124 CHECK_NUMBER_COERCE_MARKER (*end
);
126 /* If we are asked for a point, but from a subr which operates
127 on a range, then return nothing. */
128 if (EQ (*begin
, *end
) && begin
!= end
)
129 return NULL_INTERVAL
;
131 if (XINT (*begin
) > XINT (*end
))
139 if (BUFFERP (object
))
141 register struct buffer
*b
= XBUFFER (object
);
143 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
144 && XINT (*end
) <= BUF_ZV (b
)))
145 args_out_of_range (*begin
, *end
);
146 i
= BUF_INTERVALS (b
);
148 /* If there's no text, there are no properties. */
149 if (BUF_BEGV (b
) == BUF_ZV (b
))
150 return NULL_INTERVAL
;
152 searchpos
= XINT (*begin
);
156 ptrdiff_t len
= SCHARS (object
);
158 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
159 && XINT (*end
) <= len
))
160 args_out_of_range (*begin
, *end
);
161 XSETFASTINT (*begin
, XFASTINT (*begin
));
163 XSETFASTINT (*end
, XFASTINT (*end
));
164 i
= STRING_INTERVALS (object
);
167 return NULL_INTERVAL
;
169 searchpos
= XINT (*begin
);
172 if (NULL_INTERVAL_P (i
))
173 return (force
? create_root_interval (object
) : i
);
175 return find_interval (i
, searchpos
);
178 /* Validate LIST as a property list. If LIST is not a list, then
179 make one consisting of (LIST nil). Otherwise, verify that LIST
180 is even numbered and thus suitable as a plist. */
183 validate_plist (Lisp_Object list
)
191 register Lisp_Object tail
;
192 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
198 error ("Odd length text property list");
202 return Fcons (list
, Fcons (Qnil
, Qnil
));
205 /* Return nonzero if interval I has all the properties,
206 with the same values, of list PLIST. */
209 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
211 register Lisp_Object tail1
, tail2
, sym1
;
214 /* Go through each element of PLIST. */
215 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
220 /* Go through I's plist, looking for sym1 */
221 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
222 if (EQ (sym1
, XCAR (tail2
)))
224 /* Found the same property on both lists. If the
225 values are unequal, return zero. */
226 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
229 /* Property has same value on both lists; go to next one. */
241 /* Return nonzero if the plist of interval I has any of the
242 properties of PLIST, regardless of their values. */
245 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
247 register Lisp_Object tail1
, tail2
, sym
;
249 /* Go through each element of PLIST. */
250 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
254 /* Go through i's plist, looking for tail1 */
255 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
256 if (EQ (sym
, XCAR (tail2
)))
263 /* Return nonzero if the plist of interval I has any of the
264 property names in LIST, regardless of their values. */
267 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
269 register Lisp_Object tail1
, tail2
, sym
;
271 /* Go through each element of LIST. */
272 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
276 /* Go through i's plist, looking for tail1 */
277 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
278 if (EQ (sym
, XCAR (tail2
)))
285 /* Changing the plists of individual intervals. */
287 /* Return the value of PROP in property-list PLIST, or Qunbound if it
290 property_value (Lisp_Object plist
, Lisp_Object prop
)
294 while (PLIST_ELT_P (plist
, value
))
295 if (EQ (XCAR (plist
), prop
))
298 plist
= XCDR (value
);
303 /* Set the properties of INTERVAL to PROPERTIES,
304 and record undo info for the previous values.
305 OBJECT is the string or buffer that INTERVAL belongs to. */
308 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
310 Lisp_Object sym
, value
;
312 if (BUFFERP (object
))
314 /* For each property in the old plist which is missing from PROPERTIES,
315 or has a different value in PROPERTIES, make an undo record. */
316 for (sym
= interval
->plist
;
317 PLIST_ELT_P (sym
, value
);
319 if (! EQ (property_value (properties
, XCAR (sym
)),
322 record_property_change (interval
->position
, LENGTH (interval
),
323 XCAR (sym
), XCAR (value
),
327 /* For each new property that has no value at all in the old plist,
328 make an undo record binding it to nil, so it will be removed. */
329 for (sym
= properties
;
330 PLIST_ELT_P (sym
, value
);
332 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
334 record_property_change (interval
->position
, LENGTH (interval
),
340 /* Store new properties. */
341 interval
->plist
= Fcopy_sequence (properties
);
344 /* Add the properties of PLIST to the interval I, or set
345 the value of I's property to the value of the property on PLIST
346 if they are different.
348 OBJECT should be the string or buffer the interval is in.
350 Return nonzero if this changes I (i.e., if any members of PLIST
351 are actually added to I's plist) */
354 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
356 Lisp_Object tail1
, tail2
, sym1
, val1
;
357 register int changed
= 0;
359 struct gcpro gcpro1
, gcpro2
, gcpro3
;
364 /* No need to protect OBJECT, because we can GC only in the case
365 where it is a buffer, and live buffers are always protected.
366 I and its plist are also protected, via OBJECT. */
367 GCPRO3 (tail1
, sym1
, val1
);
369 /* Go through each element of PLIST. */
370 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
373 val1
= Fcar (XCDR (tail1
));
376 /* Go through I's plist, looking for sym1 */
377 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
378 if (EQ (sym1
, XCAR (tail2
)))
380 /* No need to gcpro, because tail2 protects this
381 and it must be a cons cell (we get an error otherwise). */
382 register Lisp_Object this_cdr
;
384 this_cdr
= XCDR (tail2
);
385 /* Found the property. Now check its value. */
388 /* The properties have the same value on both lists.
389 Continue to the next property. */
390 if (EQ (val1
, Fcar (this_cdr
)))
393 /* Record this change in the buffer, for undo purposes. */
394 if (BUFFERP (object
))
396 record_property_change (i
->position
, LENGTH (i
),
397 sym1
, Fcar (this_cdr
), object
);
400 /* I's property has a different value -- change it */
401 Fsetcar (this_cdr
, val1
);
408 /* Record this change in the buffer, for undo purposes. */
409 if (BUFFERP (object
))
411 record_property_change (i
->position
, LENGTH (i
),
414 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
424 /* For any members of PLIST, or LIST,
425 which are properties of I, remove them from I's plist.
426 (If PLIST is non-nil, use that, otherwise use LIST.)
427 OBJECT is the string or buffer containing I. */
430 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
432 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
433 register int changed
= 0;
435 /* Nonzero means tail1 is a plist, otherwise it is a list. */
438 current_plist
= i
->plist
;
441 tail1
= plist
, use_plist
= 1;
443 tail1
= list
, use_plist
= 0;
445 /* Go through each element of LIST or PLIST. */
446 while (CONSP (tail1
))
450 /* First, remove the symbol if it's at the head of the list */
451 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
453 if (BUFFERP (object
))
454 record_property_change (i
->position
, LENGTH (i
),
455 sym
, XCAR (XCDR (current_plist
)),
458 current_plist
= XCDR (XCDR (current_plist
));
462 /* Go through I's plist, looking for SYM. */
463 tail2
= current_plist
;
464 while (! NILP (tail2
))
466 register Lisp_Object
this;
467 this = XCDR (XCDR (tail2
));
468 if (CONSP (this) && EQ (sym
, XCAR (this)))
470 if (BUFFERP (object
))
471 record_property_change (i
->position
, LENGTH (i
),
472 sym
, XCAR (XCDR (this)), object
);
474 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
480 /* Advance thru TAIL1 one way or the other. */
481 tail1
= XCDR (tail1
);
482 if (use_plist
&& CONSP (tail1
))
483 tail1
= XCDR (tail1
);
487 i
->plist
= current_plist
;
492 /* Remove all properties from interval I. Return non-zero
493 if this changes the interval. */
496 erase_properties (INTERVAL i
)
506 /* Returns the interval of POSITION in OBJECT.
507 POSITION is BEG-based. */
510 interval_of (ptrdiff_t position
, Lisp_Object object
)
516 XSETBUFFER (object
, current_buffer
);
517 else if (EQ (object
, Qt
))
518 return NULL_INTERVAL
;
520 CHECK_STRING_OR_BUFFER (object
);
522 if (BUFFERP (object
))
524 register struct buffer
*b
= XBUFFER (object
);
528 i
= BUF_INTERVALS (b
);
533 end
= SCHARS (object
);
534 i
= STRING_INTERVALS (object
);
537 if (!(beg
<= position
&& position
<= end
))
538 args_out_of_range (make_number (position
), make_number (position
));
539 if (beg
== end
|| NULL_INTERVAL_P (i
))
540 return NULL_INTERVAL
;
542 return find_interval (i
, position
);
545 DEFUN ("text-properties-at", Ftext_properties_at
,
546 Stext_properties_at
, 1, 2, 0,
547 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
548 If the optional second argument OBJECT is a buffer (or nil, which means
549 the current buffer), POSITION is a buffer position (integer or marker).
550 If OBJECT is a string, POSITION is a 0-based index into it.
551 If POSITION is at the end of OBJECT, the value is nil. */)
552 (Lisp_Object position
, Lisp_Object object
)
557 XSETBUFFER (object
, current_buffer
);
559 i
= validate_interval_range (object
, &position
, &position
, soft
);
560 if (NULL_INTERVAL_P (i
))
562 /* If POSITION is at the end of the interval,
563 it means it's the end of OBJECT.
564 There are no properties at the very end,
565 since no character follows. */
566 if (XINT (position
) == LENGTH (i
) + i
->position
)
572 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
573 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
574 OBJECT is optional and defaults to the current buffer.
575 If POSITION is at the end of OBJECT, the value is nil. */)
576 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
578 return textget (Ftext_properties_at (position
, object
), prop
);
581 /* Return the value of char's property PROP, in OBJECT at POSITION.
582 OBJECT is optional and defaults to the current buffer.
583 If OVERLAY is non-0, then in the case that the returned property is from
584 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
585 returned in *OVERLAY.
586 If POSITION is at the end of OBJECT, the value is nil.
587 If OBJECT is a buffer, then overlay properties are considered as well as
589 If OBJECT is a window, then that window's buffer is used, but
590 window-specific overlays are considered only if they are associated
593 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
595 struct window
*w
= 0;
597 CHECK_NUMBER_COERCE_MARKER (position
);
600 XSETBUFFER (object
, current_buffer
);
602 if (WINDOWP (object
))
604 w
= XWINDOW (object
);
607 if (BUFFERP (object
))
610 Lisp_Object
*overlay_vec
;
611 struct buffer
*obuf
= current_buffer
;
613 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
614 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
615 xsignal1 (Qargs_out_of_range
, position
);
617 set_buffer_temp (XBUFFER (object
));
619 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
620 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
622 set_buffer_temp (obuf
);
624 /* Now check the overlays in order of decreasing priority. */
625 while (--noverlays
>= 0)
627 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
631 /* Return the overlay we got the property from. */
632 *overlay
= overlay_vec
[noverlays
];
639 /* Indicate that the return value is not from an overlay. */
642 /* Not a buffer, or no appropriate overlay, so fall through to the
644 return Fget_text_property (position
, prop
, object
);
647 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
648 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
649 Both overlay properties and text properties are checked.
650 OBJECT is optional and defaults to the current buffer.
651 If POSITION is at the end of OBJECT, the value is nil.
652 If OBJECT is a buffer, then overlay properties are considered as well as
654 If OBJECT is a window, then that window's buffer is used, but window-specific
655 overlays are considered only if they are associated with OBJECT. */)
656 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
658 return get_char_property_and_overlay (position
, prop
, object
, 0);
661 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
662 Sget_char_property_and_overlay
, 2, 3, 0,
663 doc
: /* Like `get-char-property', but with extra overlay information.
664 The value is a cons cell. Its car is the return value of `get-char-property'
665 with the same arguments--that is, the value of POSITION's property
666 PROP in OBJECT. Its cdr is the overlay in which the property was
667 found, or nil, if it was found as a text property or not found at all.
669 OBJECT is optional and defaults to the current buffer. OBJECT may be
670 a string, a buffer or a window. For strings, the cdr of the return
671 value is always nil, since strings do not have overlays. If OBJECT is
672 a window, then that window's buffer is used, but window-specific
673 overlays are considered only if they are associated with OBJECT. If
674 POSITION is at the end of OBJECT, both car and cdr are nil. */)
675 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
679 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
680 return Fcons (val
, overlay
);
684 DEFUN ("next-char-property-change", Fnext_char_property_change
,
685 Snext_char_property_change
, 1, 2, 0,
686 doc
: /* Return the position of next text property or overlay change.
687 This scans characters forward in the current buffer from POSITION till
688 it finds a change in some text property, or the beginning or end of an
689 overlay, and returns the position of that.
690 If none is found up to (point-max), the function returns (point-max).
692 If the optional second argument LIMIT is non-nil, don't search
693 past position LIMIT; return LIMIT if nothing is found before LIMIT.
694 LIMIT is a no-op if it is greater than (point-max). */)
695 (Lisp_Object position
, Lisp_Object limit
)
699 temp
= Fnext_overlay_change (position
);
702 CHECK_NUMBER_COERCE_MARKER (limit
);
703 if (XINT (limit
) < XINT (temp
))
706 return Fnext_property_change (position
, Qnil
, temp
);
709 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
710 Sprevious_char_property_change
, 1, 2, 0,
711 doc
: /* Return the position of previous text property or overlay change.
712 Scans characters backward in the current buffer from POSITION till it
713 finds a change in some text property, or the beginning or end of an
714 overlay, and returns the position of that.
715 If none is found since (point-min), the function returns (point-min).
717 If the optional second argument LIMIT is non-nil, don't search
718 past position LIMIT; return LIMIT if nothing is found before LIMIT.
719 LIMIT is a no-op if it is less than (point-min). */)
720 (Lisp_Object position
, Lisp_Object limit
)
724 temp
= Fprevious_overlay_change (position
);
727 CHECK_NUMBER_COERCE_MARKER (limit
);
728 if (XINT (limit
) > XINT (temp
))
731 return Fprevious_property_change (position
, Qnil
, temp
);
735 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
736 Snext_single_char_property_change
, 2, 4, 0,
737 doc
: /* Return the position of next text property or overlay change for a specific property.
738 Scans characters forward from POSITION till it finds
739 a change in the PROP property, then returns the position of the change.
740 If the optional third argument OBJECT is a buffer (or nil, which means
741 the current buffer), POSITION is a buffer position (integer or marker).
742 If OBJECT is a string, POSITION is a 0-based index into it.
744 In a string, scan runs to the end of the string.
745 In a buffer, it runs to (point-max), and the value cannot exceed that.
747 The property values are compared with `eq'.
748 If the property is constant all the way to the end of OBJECT, return the
749 last valid position in OBJECT.
750 If the optional fourth argument LIMIT is non-nil, don't search
751 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
752 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
754 if (STRINGP (object
))
756 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
760 position
= make_number (SCHARS (object
));
763 CHECK_NUMBER (limit
);
770 Lisp_Object initial_value
, value
;
771 ptrdiff_t count
= SPECPDL_INDEX ();
774 CHECK_BUFFER (object
);
776 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
778 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
779 Fset_buffer (object
);
782 CHECK_NUMBER_COERCE_MARKER (position
);
784 initial_value
= Fget_char_property (position
, prop
, object
);
787 XSETFASTINT (limit
, ZV
);
789 CHECK_NUMBER_COERCE_MARKER (limit
);
791 if (XFASTINT (position
) >= XFASTINT (limit
))
794 if (XFASTINT (position
) > ZV
)
795 XSETFASTINT (position
, ZV
);
800 position
= Fnext_char_property_change (position
, limit
);
801 if (XFASTINT (position
) >= XFASTINT (limit
))
807 value
= Fget_char_property (position
, prop
, object
);
808 if (!EQ (value
, initial_value
))
812 unbind_to (count
, Qnil
);
818 DEFUN ("previous-single-char-property-change",
819 Fprevious_single_char_property_change
,
820 Sprevious_single_char_property_change
, 2, 4, 0,
821 doc
: /* Return the position of previous text property or overlay change for a specific property.
822 Scans characters backward from POSITION till it finds
823 a change in the PROP property, then returns the position of the change.
824 If the optional third argument OBJECT is a buffer (or nil, which means
825 the current buffer), POSITION is a buffer position (integer or marker).
826 If OBJECT is a string, POSITION is a 0-based index into it.
828 In a string, scan runs to the start of the string.
829 In a buffer, it runs to (point-min), and the value cannot be less than that.
831 The property values are compared with `eq'.
832 If the property is constant all the way to the start of OBJECT, return the
833 first valid position in OBJECT.
834 If the optional fourth argument LIMIT is non-nil, don't search back past
835 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
836 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
838 if (STRINGP (object
))
840 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
844 position
= make_number (0);
847 CHECK_NUMBER (limit
);
854 ptrdiff_t count
= SPECPDL_INDEX ();
857 CHECK_BUFFER (object
);
859 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
861 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
862 Fset_buffer (object
);
865 CHECK_NUMBER_COERCE_MARKER (position
);
868 XSETFASTINT (limit
, BEGV
);
870 CHECK_NUMBER_COERCE_MARKER (limit
);
872 if (XFASTINT (position
) <= XFASTINT (limit
))
875 if (XFASTINT (position
) < BEGV
)
876 XSETFASTINT (position
, BEGV
);
880 Lisp_Object initial_value
881 = Fget_char_property (make_number (XFASTINT (position
) - 1),
886 position
= Fprevious_char_property_change (position
, limit
);
888 if (XFASTINT (position
) <= XFASTINT (limit
))
896 = Fget_char_property (make_number (XFASTINT (position
) - 1),
899 if (!EQ (value
, initial_value
))
905 unbind_to (count
, Qnil
);
911 DEFUN ("next-property-change", Fnext_property_change
,
912 Snext_property_change
, 1, 3, 0,
913 doc
: /* Return the position of next property change.
914 Scans characters forward from POSITION in OBJECT till it finds
915 a change in some text property, then returns the position of the change.
916 If the optional second argument OBJECT is a buffer (or nil, which means
917 the current buffer), POSITION is a buffer position (integer or marker).
918 If OBJECT is a string, POSITION is a 0-based index into it.
919 Return nil if the property is constant all the way to the end of OBJECT.
920 If the value is non-nil, it is a position greater than POSITION, never equal.
922 If the optional third argument LIMIT is non-nil, don't search
923 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
924 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
926 register INTERVAL i
, next
;
929 XSETBUFFER (object
, current_buffer
);
931 if (!NILP (limit
) && !EQ (limit
, Qt
))
932 CHECK_NUMBER_COERCE_MARKER (limit
);
934 i
= validate_interval_range (object
, &position
, &position
, soft
);
936 /* If LIMIT is t, return start of next interval--don't
937 bother checking further intervals. */
940 if (NULL_INTERVAL_P (i
))
943 next
= next_interval (i
);
945 if (NULL_INTERVAL_P (next
))
946 XSETFASTINT (position
, (STRINGP (object
)
948 : BUF_ZV (XBUFFER (object
))));
950 XSETFASTINT (position
, next
->position
);
954 if (NULL_INTERVAL_P (i
))
957 next
= next_interval (i
);
959 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
960 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
961 next
= next_interval (next
);
963 if (NULL_INTERVAL_P (next
)
969 : BUF_ZV (XBUFFER (object
))))))
972 return make_number (next
->position
);
975 DEFUN ("next-single-property-change", Fnext_single_property_change
,
976 Snext_single_property_change
, 2, 4, 0,
977 doc
: /* Return the position of next property change for a specific property.
978 Scans characters forward from POSITION till it finds
979 a change in the PROP property, then returns the position of the change.
980 If the optional third argument OBJECT is a buffer (or nil, which means
981 the current buffer), POSITION is a buffer position (integer or marker).
982 If OBJECT is a string, POSITION is a 0-based index into it.
983 The property values are compared with `eq'.
984 Return nil if the property is constant all the way to the end of OBJECT.
985 If the value is non-nil, it is a position greater than POSITION, never equal.
987 If the optional fourth argument LIMIT is non-nil, don't search
988 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
989 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
991 register INTERVAL i
, next
;
992 register Lisp_Object here_val
;
995 XSETBUFFER (object
, current_buffer
);
998 CHECK_NUMBER_COERCE_MARKER (limit
);
1000 i
= validate_interval_range (object
, &position
, &position
, soft
);
1001 if (NULL_INTERVAL_P (i
))
1004 here_val
= textget (i
->plist
, prop
);
1005 next
= next_interval (i
);
1006 while (! NULL_INTERVAL_P (next
)
1007 && EQ (here_val
, textget (next
->plist
, prop
))
1008 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1009 next
= next_interval (next
);
1011 if (NULL_INTERVAL_P (next
)
1013 >= (INTEGERP (limit
)
1017 : BUF_ZV (XBUFFER (object
))))))
1020 return make_number (next
->position
);
1023 DEFUN ("previous-property-change", Fprevious_property_change
,
1024 Sprevious_property_change
, 1, 3, 0,
1025 doc
: /* Return the position of previous property change.
1026 Scans characters backwards from POSITION in OBJECT till it finds
1027 a change in some text property, then returns the position of the change.
1028 If the optional second argument OBJECT is a buffer (or nil, which means
1029 the current buffer), POSITION is a buffer position (integer or marker).
1030 If OBJECT is a string, POSITION is a 0-based index into it.
1031 Return nil if the property is constant all the way to the start of OBJECT.
1032 If the value is non-nil, it is a position less than POSITION, never equal.
1034 If the optional third argument LIMIT is non-nil, don't search
1035 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1036 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1038 register INTERVAL i
, previous
;
1041 XSETBUFFER (object
, current_buffer
);
1044 CHECK_NUMBER_COERCE_MARKER (limit
);
1046 i
= validate_interval_range (object
, &position
, &position
, soft
);
1047 if (NULL_INTERVAL_P (i
))
1050 /* Start with the interval containing the char before point. */
1051 if (i
->position
== XFASTINT (position
))
1052 i
= previous_interval (i
);
1054 previous
= previous_interval (i
);
1055 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1057 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1058 previous
= previous_interval (previous
);
1060 if (NULL_INTERVAL_P (previous
)
1061 || (previous
->position
+ LENGTH (previous
)
1062 <= (INTEGERP (limit
)
1064 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1067 return make_number (previous
->position
+ LENGTH (previous
));
1070 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1071 Sprevious_single_property_change
, 2, 4, 0,
1072 doc
: /* Return the position of previous property change for a specific property.
1073 Scans characters backward from POSITION till it finds
1074 a change in the PROP property, then returns the position of the change.
1075 If the optional third argument OBJECT is a buffer (or nil, which means
1076 the current buffer), POSITION is a buffer position (integer or marker).
1077 If OBJECT is a string, POSITION is a 0-based index into it.
1078 The property values are compared with `eq'.
1079 Return nil if the property is constant all the way to the start of OBJECT.
1080 If the value is non-nil, it is a position less than POSITION, never equal.
1082 If the optional fourth argument LIMIT is non-nil, don't search
1083 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1084 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1086 register INTERVAL i
, previous
;
1087 register Lisp_Object here_val
;
1090 XSETBUFFER (object
, current_buffer
);
1093 CHECK_NUMBER_COERCE_MARKER (limit
);
1095 i
= validate_interval_range (object
, &position
, &position
, soft
);
1097 /* Start with the interval containing the char before point. */
1098 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1099 i
= previous_interval (i
);
1101 if (NULL_INTERVAL_P (i
))
1104 here_val
= textget (i
->plist
, prop
);
1105 previous
= previous_interval (i
);
1106 while (!NULL_INTERVAL_P (previous
)
1107 && EQ (here_val
, textget (previous
->plist
, prop
))
1109 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1110 previous
= previous_interval (previous
);
1112 if (NULL_INTERVAL_P (previous
)
1113 || (previous
->position
+ LENGTH (previous
)
1114 <= (INTEGERP (limit
)
1116 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1119 return make_number (previous
->position
+ LENGTH (previous
));
1122 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1124 DEFUN ("add-text-properties", Fadd_text_properties
,
1125 Sadd_text_properties
, 3, 4, 0,
1126 doc
: /* Add properties to the text from START to END.
1127 The third argument PROPERTIES is a property list
1128 specifying the property values to add. If the optional fourth argument
1129 OBJECT is a buffer (or nil, which means the current buffer),
1130 START and END are buffer positions (integers or markers).
1131 If OBJECT is a string, START and END are 0-based indices into it.
1132 Return t if any property value actually changed, nil otherwise. */)
1133 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1135 register INTERVAL i
, unchanged
;
1136 register ptrdiff_t s
, len
;
1137 register int modified
= 0;
1138 struct gcpro gcpro1
;
1140 properties
= validate_plist (properties
);
1141 if (NILP (properties
))
1145 XSETBUFFER (object
, current_buffer
);
1147 i
= validate_interval_range (object
, &start
, &end
, hard
);
1148 if (NULL_INTERVAL_P (i
))
1152 len
= XINT (end
) - s
;
1154 /* No need to protect OBJECT, because we GC only if it's a buffer,
1155 and live buffers are always protected. */
1156 GCPRO1 (properties
);
1158 /* If we're not starting on an interval boundary, we have to
1159 split this interval. */
1160 if (i
->position
!= s
)
1162 /* If this interval already has the properties, we can
1164 if (interval_has_all_properties (properties
, i
))
1166 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1168 RETURN_UNGCPRO (Qnil
);
1170 i
= next_interval (i
);
1175 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1176 copy_properties (unchanged
, i
);
1180 if (BUFFERP (object
))
1181 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1183 /* We are at the beginning of interval I, with LEN chars to scan. */
1189 if (LENGTH (i
) >= len
)
1191 /* We can UNGCPRO safely here, because there will be just
1192 one more chance to gc, in the next call to add_properties,
1193 and after that we will not need PROPERTIES or OBJECT again. */
1196 if (interval_has_all_properties (properties
, i
))
1198 if (BUFFERP (object
))
1199 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1200 XINT (end
) - XINT (start
));
1202 return modified
? Qt
: Qnil
;
1205 if (LENGTH (i
) == len
)
1207 add_properties (properties
, i
, object
);
1208 if (BUFFERP (object
))
1209 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1210 XINT (end
) - XINT (start
));
1214 /* i doesn't have the properties, and goes past the change limit */
1216 i
= split_interval_left (unchanged
, len
);
1217 copy_properties (unchanged
, i
);
1218 add_properties (properties
, i
, object
);
1219 if (BUFFERP (object
))
1220 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1221 XINT (end
) - XINT (start
));
1226 modified
+= add_properties (properties
, i
, object
);
1227 i
= next_interval (i
);
1231 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1233 DEFUN ("put-text-property", Fput_text_property
,
1234 Sput_text_property
, 4, 5, 0,
1235 doc
: /* Set one property of the text from START to END.
1236 The third and fourth arguments PROPERTY and VALUE
1237 specify the property to add.
1238 If the optional fifth argument OBJECT is a buffer (or nil, which means
1239 the current buffer), START and END are buffer positions (integers or
1240 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1241 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1243 Fadd_text_properties (start
, end
,
1244 Fcons (property
, Fcons (value
, Qnil
)),
1249 DEFUN ("set-text-properties", Fset_text_properties
,
1250 Sset_text_properties
, 3, 4, 0,
1251 doc
: /* Completely replace properties of text from START to END.
1252 The third argument PROPERTIES is the new property list.
1253 If the optional fourth argument OBJECT is a buffer (or nil, which means
1254 the current buffer), START and END are buffer positions (integers or
1255 markers). If OBJECT is a string, START and END are 0-based indices into it.
1256 If PROPERTIES is nil, the effect is to remove all properties from
1257 the designated part of OBJECT. */)
1258 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1260 return set_text_properties (start
, end
, properties
, object
, Qt
);
1264 /* Replace properties of text from START to END with new list of
1265 properties PROPERTIES. OBJECT is the buffer or string containing
1266 the text. OBJECT nil means use the current buffer.
1267 COHERENT_CHANGE_P nil means this is being called as an internal
1268 subroutine, rather than as a change primitive with checking of
1269 read-only, invoking change hooks, etc.. Value is nil if the
1270 function _detected_ that it did not replace any properties, non-nil
1274 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1276 register INTERVAL i
;
1277 Lisp_Object ostart
, oend
;
1282 properties
= validate_plist (properties
);
1285 XSETBUFFER (object
, current_buffer
);
1287 /* If we want no properties for a whole string,
1288 get rid of its intervals. */
1289 if (NILP (properties
) && STRINGP (object
)
1290 && XFASTINT (start
) == 0
1291 && XFASTINT (end
) == SCHARS (object
))
1293 if (! STRING_INTERVALS (object
))
1296 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1300 i
= validate_interval_range (object
, &start
, &end
, soft
);
1302 if (NULL_INTERVAL_P (i
))
1304 /* If buffer has no properties, and we want none, return now. */
1305 if (NILP (properties
))
1308 /* Restore the original START and END values
1309 because validate_interval_range increments them for strings. */
1313 i
= validate_interval_range (object
, &start
, &end
, hard
);
1314 /* This can return if start == end. */
1315 if (NULL_INTERVAL_P (i
))
1319 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1320 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1322 set_text_properties_1 (start
, end
, properties
, object
, i
);
1324 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1325 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1326 XINT (end
) - XINT (start
));
1330 /* Replace properties of text from START to END with new list of
1331 properties PROPERTIES. BUFFER is the buffer containing
1332 the text. This does not obey any hooks.
1333 You can provide the interval that START is located in as I,
1334 or pass NULL for I and this function will find it.
1335 START and END can be in any order. */
1338 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object buffer
, INTERVAL i
)
1340 register INTERVAL prev_changed
= NULL_INTERVAL
;
1341 register ptrdiff_t s
, len
;
1344 if (XINT (start
) < XINT (end
))
1347 len
= XINT (end
) - s
;
1349 else if (XINT (end
) < XINT (start
))
1352 len
= XINT (start
) - s
;
1358 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1360 if (i
->position
!= s
)
1363 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1365 if (LENGTH (i
) > len
)
1367 copy_properties (unchanged
, i
);
1368 i
= split_interval_left (i
, len
);
1369 set_properties (properties
, i
, buffer
);
1373 set_properties (properties
, i
, buffer
);
1375 if (LENGTH (i
) == len
)
1380 i
= next_interval (i
);
1383 /* We are starting at the beginning of an interval I. LEN is positive. */
1389 if (LENGTH (i
) >= len
)
1391 if (LENGTH (i
) > len
)
1392 i
= split_interval_left (i
, len
);
1394 /* We have to call set_properties even if we are going to
1395 merge the intervals, so as to make the undo records
1396 and cause redisplay to happen. */
1397 set_properties (properties
, i
, buffer
);
1398 if (!NULL_INTERVAL_P (prev_changed
))
1399 merge_interval_left (i
);
1405 /* We have to call set_properties even if we are going to
1406 merge the intervals, so as to make the undo records
1407 and cause redisplay to happen. */
1408 set_properties (properties
, i
, buffer
);
1409 if (NULL_INTERVAL_P (prev_changed
))
1412 prev_changed
= i
= merge_interval_left (i
);
1414 i
= next_interval (i
);
1419 DEFUN ("remove-text-properties", Fremove_text_properties
,
1420 Sremove_text_properties
, 3, 4, 0,
1421 doc
: /* Remove some properties from text from START to END.
1422 The third argument PROPERTIES is a property list
1423 whose property names specify the properties to remove.
1424 \(The values stored in PROPERTIES are ignored.)
1425 If the optional fourth argument OBJECT is a buffer (or nil, which means
1426 the current buffer), START and END are buffer positions (integers or
1427 markers). If OBJECT is a string, START and END are 0-based indices into it.
1428 Return t if any property was actually removed, nil otherwise.
1430 Use `set-text-properties' if you want to remove all text properties. */)
1431 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1433 register INTERVAL i
, unchanged
;
1434 register ptrdiff_t s
, len
;
1435 register int modified
= 0;
1438 XSETBUFFER (object
, current_buffer
);
1440 i
= validate_interval_range (object
, &start
, &end
, soft
);
1441 if (NULL_INTERVAL_P (i
))
1445 len
= XINT (end
) - s
;
1447 if (i
->position
!= s
)
1449 /* No properties on this first interval -- return if
1450 it covers the entire region. */
1451 if (! interval_has_some_properties (properties
, i
))
1453 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1457 i
= next_interval (i
);
1459 /* Split away the beginning of this interval; what we don't
1464 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1465 copy_properties (unchanged
, i
);
1469 if (BUFFERP (object
))
1470 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1472 /* We are at the beginning of an interval, with len to scan */
1478 if (LENGTH (i
) >= len
)
1480 if (! interval_has_some_properties (properties
, i
))
1481 return modified
? Qt
: Qnil
;
1483 if (LENGTH (i
) == len
)
1485 remove_properties (properties
, Qnil
, i
, object
);
1486 if (BUFFERP (object
))
1487 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1488 XINT (end
) - XINT (start
));
1492 /* i has the properties, and goes past the change limit */
1494 i
= split_interval_left (i
, len
);
1495 copy_properties (unchanged
, i
);
1496 remove_properties (properties
, Qnil
, i
, object
);
1497 if (BUFFERP (object
))
1498 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1499 XINT (end
) - XINT (start
));
1504 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1505 i
= next_interval (i
);
1509 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1510 Sremove_list_of_text_properties
, 3, 4, 0,
1511 doc
: /* Remove some properties from text from START to END.
1512 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1513 If the optional fourth argument OBJECT is a buffer (or nil, which means
1514 the current buffer), START and END are buffer positions (integers or
1515 markers). If OBJECT is a string, START and END are 0-based indices into it.
1516 Return t if any property was actually removed, nil otherwise. */)
1517 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1519 register INTERVAL i
, unchanged
;
1520 register ptrdiff_t s
, len
;
1521 register int modified
= 0;
1522 Lisp_Object properties
;
1523 properties
= list_of_properties
;
1526 XSETBUFFER (object
, current_buffer
);
1528 i
= validate_interval_range (object
, &start
, &end
, soft
);
1529 if (NULL_INTERVAL_P (i
))
1533 len
= XINT (end
) - s
;
1535 if (i
->position
!= s
)
1537 /* No properties on this first interval -- return if
1538 it covers the entire region. */
1539 if (! interval_has_some_properties_list (properties
, i
))
1541 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1545 i
= next_interval (i
);
1547 /* Split away the beginning of this interval; what we don't
1552 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1553 copy_properties (unchanged
, i
);
1557 /* We are at the beginning of an interval, with len to scan.
1558 The flag `modified' records if changes have been made.
1559 When object is a buffer, we must call modify_region before changes are
1560 made and signal_after_change when we are done.
1561 We call modify_region before calling remove_properties if modified == 0,
1562 and we call signal_after_change before returning if modified != 0. */
1568 if (LENGTH (i
) >= len
)
1570 if (! interval_has_some_properties_list (properties
, i
))
1574 if (BUFFERP (object
))
1575 signal_after_change (XINT (start
),
1576 XINT (end
) - XINT (start
),
1577 XINT (end
) - XINT (start
));
1583 else if (LENGTH (i
) == len
)
1585 if (!modified
&& BUFFERP (object
))
1586 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1587 remove_properties (Qnil
, properties
, i
, object
);
1588 if (BUFFERP (object
))
1589 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1590 XINT (end
) - XINT (start
));
1594 { /* i has the properties, and goes past the change limit. */
1596 i
= split_interval_left (i
, len
);
1597 copy_properties (unchanged
, i
);
1598 if (!modified
&& BUFFERP (object
))
1599 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1600 remove_properties (Qnil
, properties
, i
, object
);
1601 if (BUFFERP (object
))
1602 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1603 XINT (end
) - XINT (start
));
1607 if (interval_has_some_properties_list (properties
, i
))
1609 if (!modified
&& BUFFERP (object
))
1610 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1611 remove_properties (Qnil
, properties
, i
, object
);
1615 i
= next_interval (i
);
1619 DEFUN ("text-property-any", Ftext_property_any
,
1620 Stext_property_any
, 4, 5, 0,
1621 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1622 If so, return the position of the first character whose property PROPERTY
1623 is `eq' to VALUE. Otherwise return nil.
1624 If the optional fifth argument OBJECT is a buffer (or nil, which means
1625 the current buffer), START and END are buffer positions (integers or
1626 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1627 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1629 register INTERVAL i
;
1630 register ptrdiff_t e
, pos
;
1633 XSETBUFFER (object
, current_buffer
);
1634 i
= validate_interval_range (object
, &start
, &end
, soft
);
1635 if (NULL_INTERVAL_P (i
))
1636 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1639 while (! NULL_INTERVAL_P (i
))
1641 if (i
->position
>= e
)
1643 if (EQ (textget (i
->plist
, property
), value
))
1646 if (pos
< XINT (start
))
1648 return make_number (pos
);
1650 i
= next_interval (i
);
1655 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1656 Stext_property_not_all
, 4, 5, 0,
1657 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1658 If so, return the position of the first character whose property PROPERTY
1659 is not `eq' to VALUE. Otherwise, return nil.
1660 If the optional fifth argument OBJECT is a buffer (or nil, which means
1661 the current buffer), START and END are buffer positions (integers or
1662 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1663 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1665 register INTERVAL i
;
1666 register ptrdiff_t s
, e
;
1669 XSETBUFFER (object
, current_buffer
);
1670 i
= validate_interval_range (object
, &start
, &end
, soft
);
1671 if (NULL_INTERVAL_P (i
))
1672 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1676 while (! NULL_INTERVAL_P (i
))
1678 if (i
->position
>= e
)
1680 if (! EQ (textget (i
->plist
, property
), value
))
1682 if (i
->position
> s
)
1684 return make_number (s
);
1686 i
= next_interval (i
);
1692 /* Return the direction from which the text-property PROP would be
1693 inherited by any new text inserted at POS: 1 if it would be
1694 inherited from the char after POS, -1 if it would be inherited from
1695 the char before POS, and 0 if from neither.
1696 BUFFER can be either a buffer or nil (meaning current buffer). */
1699 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1701 Lisp_Object prev_pos
, front_sticky
;
1702 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1703 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1706 XSETBUFFER (buffer
, current_buffer
);
1708 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1711 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1712 /* Consider previous character. */
1714 Lisp_Object rear_non_sticky
;
1716 prev_pos
= make_number (XINT (pos
) - 1);
1717 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1719 if (!NILP (CONSP (rear_non_sticky
)
1720 ? Fmemq (prop
, rear_non_sticky
)
1722 /* PROP is rear-non-sticky. */
1728 /* Consider following character. */
1729 /* This signals an arg-out-of-range error if pos is outside the
1730 buffer's accessible range. */
1731 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1733 if (EQ (front_sticky
, Qt
)
1734 || (CONSP (front_sticky
)
1735 && !NILP (Fmemq (prop
, front_sticky
))))
1736 /* PROP is inherited from after. */
1737 is_front_sticky
= 1;
1739 /* Simple cases, where the properties are consistent. */
1740 if (is_rear_sticky
&& !is_front_sticky
)
1742 else if (!is_rear_sticky
&& is_front_sticky
)
1744 else if (!is_rear_sticky
&& !is_front_sticky
)
1747 /* The stickiness properties are inconsistent, so we have to
1748 disambiguate. Basically, rear-sticky wins, _except_ if the
1749 property that would be inherited has a value of nil, in which case
1750 front-sticky wins. */
1751 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1752 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1759 /* Copying properties between objects. */
1761 /* Add properties from START to END of SRC, starting at POS in DEST.
1762 SRC and DEST may each refer to strings or buffers.
1763 Optional sixth argument PROP causes only that property to be copied.
1764 Properties are copied to DEST as if by `add-text-properties'.
1765 Return t if any property value actually changed, nil otherwise. */
1767 /* Note this can GC when DEST is a buffer. */
1770 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1776 ptrdiff_t s
, e
, e2
, p
, len
;
1778 struct gcpro gcpro1
, gcpro2
;
1780 i
= validate_interval_range (src
, &start
, &end
, soft
);
1781 if (NULL_INTERVAL_P (i
))
1784 CHECK_NUMBER_COERCE_MARKER (pos
);
1786 Lisp_Object dest_start
, dest_end
;
1788 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1789 if (MOST_POSITIVE_FIXNUM
< e
)
1790 args_out_of_range (pos
, end
);
1792 XSETFASTINT (dest_end
, e
);
1793 /* Apply this to a copy of pos; it will try to increment its arguments,
1794 which we don't want. */
1795 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1806 e2
= i
->position
+ LENGTH (i
);
1813 while (! NILP (plist
))
1815 if (EQ (Fcar (plist
), prop
))
1817 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1820 plist
= Fcdr (Fcdr (plist
));
1824 /* Must defer modifications to the interval tree in case src
1825 and dest refer to the same string or buffer. */
1826 stuff
= Fcons (Fcons (make_number (p
),
1827 Fcons (make_number (p
+ len
),
1828 Fcons (plist
, Qnil
))),
1832 i
= next_interval (i
);
1833 if (NULL_INTERVAL_P (i
))
1840 GCPRO2 (stuff
, dest
);
1842 while (! NILP (stuff
))
1845 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1846 Fcar (Fcdr (Fcdr (res
))), dest
);
1849 stuff
= Fcdr (stuff
);
1854 return modified
? Qt
: Qnil
;
1858 /* Return a list representing the text properties of OBJECT between
1859 START and END. if PROP is non-nil, report only on that property.
1860 Each result list element has the form (S E PLIST), where S and E
1861 are positions in OBJECT and PLIST is a property list containing the
1862 text properties of OBJECT between S and E. Value is nil if OBJECT
1863 doesn't contain text properties between START and END. */
1866 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1873 i
= validate_interval_range (object
, &start
, &end
, soft
);
1874 if (!NULL_INTERVAL_P (i
))
1876 ptrdiff_t s
= XINT (start
);
1877 ptrdiff_t e
= XINT (end
);
1881 ptrdiff_t interval_end
, len
;
1884 interval_end
= i
->position
+ LENGTH (i
);
1885 if (interval_end
> e
)
1887 len
= interval_end
- s
;
1892 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
1893 if (EQ (XCAR (plist
), prop
))
1895 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
1900 result
= Fcons (Fcons (make_number (s
),
1901 Fcons (make_number (s
+ len
),
1902 Fcons (plist
, Qnil
))),
1905 i
= next_interval (i
);
1906 if (NULL_INTERVAL_P (i
))
1916 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1917 (START END PLIST), where START and END are positions and PLIST is a
1918 property list containing the text properties to add. Adjust START
1919 and END positions by DELTA before adding properties. Value is
1920 non-zero if OBJECT was modified. */
1923 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
1925 struct gcpro gcpro1
, gcpro2
;
1928 GCPRO2 (list
, object
);
1930 for (; CONSP (list
); list
= XCDR (list
))
1932 Lisp_Object item
, start
, end
, plist
, tem
;
1935 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1936 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1937 plist
= XCAR (XCDR (XCDR (item
)));
1939 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1950 /* Modify end-points of ranges in LIST destructively, and return the
1951 new list. LIST is a list as returned from text_property_list.
1952 Discard properties that begin at or after NEW_END, and limit
1953 end-points to NEW_END. */
1956 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
1958 Lisp_Object prev
= Qnil
, head
= list
;
1959 ptrdiff_t max
= XINT (new_end
);
1961 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
1963 Lisp_Object item
, beg
, end
;
1967 end
= XCAR (XCDR (item
));
1969 if (XINT (beg
) >= max
)
1971 /* The start-point is past the end of the new string.
1972 Discard this property. */
1973 if (EQ (head
, list
))
1976 XSETCDR (prev
, XCDR (list
));
1978 else if (XINT (end
) > max
)
1979 /* The end-point is past the end of the new string. */
1980 XSETCAR (XCDR (item
), new_end
);
1988 /* Call the modification hook functions in LIST, each with START and END. */
1991 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
1993 struct gcpro gcpro1
;
1995 while (!NILP (list
))
1997 call2 (Fcar (list
), start
, end
);
2003 /* Check for read-only intervals between character positions START ... END,
2004 in BUF, and signal an error if we find one.
2006 Then check for any modification hooks in the range.
2007 Create a list of all these hooks in lexicographic order,
2008 eliminating consecutive extra copies of the same hook. Then call
2009 those hooks in order, with START and END - 1 as arguments. */
2012 verify_interval_modification (struct buffer
*buf
,
2013 ptrdiff_t start
, ptrdiff_t end
)
2015 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2016 register INTERVAL i
;
2018 register Lisp_Object prev_mod_hooks
;
2019 Lisp_Object mod_hooks
;
2020 struct gcpro gcpro1
;
2023 prev_mod_hooks
= Qnil
;
2026 interval_insert_behind_hooks
= Qnil
;
2027 interval_insert_in_front_hooks
= Qnil
;
2029 if (NULL_INTERVAL_P (intervals
))
2034 ptrdiff_t temp
= start
;
2039 /* For an insert operation, check the two chars around the position. */
2042 INTERVAL prev
= NULL
;
2043 Lisp_Object before
, after
;
2045 /* Set I to the interval containing the char after START,
2046 and PREV to the interval containing the char before START.
2047 Either one may be null. They may be equal. */
2048 i
= find_interval (intervals
, start
);
2050 if (start
== BUF_BEGV (buf
))
2052 else if (i
->position
== start
)
2053 prev
= previous_interval (i
);
2054 else if (i
->position
< start
)
2056 if (start
== BUF_ZV (buf
))
2059 /* If Vinhibit_read_only is set and is not a list, we can
2060 skip the read_only checks. */
2061 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2063 /* If I and PREV differ we need to check for the read-only
2064 property together with its stickiness. If either I or
2065 PREV are 0, this check is all we need.
2066 We have to take special care, since read-only may be
2067 indirectly defined via the category property. */
2070 if (! NULL_INTERVAL_P (i
))
2072 after
= textget (i
->plist
, Qread_only
);
2074 /* If interval I is read-only and read-only is
2075 front-sticky, inhibit insertion.
2076 Check for read-only as well as category. */
2078 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2082 tem
= textget (i
->plist
, Qfront_sticky
);
2083 if (TMEM (Qread_only
, tem
)
2084 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2085 && TMEM (Qcategory
, tem
)))
2086 text_read_only (after
);
2090 if (! NULL_INTERVAL_P (prev
))
2092 before
= textget (prev
->plist
, Qread_only
);
2094 /* If interval PREV is read-only and read-only isn't
2095 rear-nonsticky, inhibit insertion.
2096 Check for read-only as well as category. */
2098 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2102 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2103 if (! TMEM (Qread_only
, tem
)
2104 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2105 || ! TMEM (Qcategory
, tem
)))
2106 text_read_only (before
);
2110 else if (! NULL_INTERVAL_P (i
))
2112 after
= textget (i
->plist
, Qread_only
);
2114 /* If interval I is read-only and read-only is
2115 front-sticky, inhibit insertion.
2116 Check for read-only as well as category. */
2117 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2121 tem
= textget (i
->plist
, Qfront_sticky
);
2122 if (TMEM (Qread_only
, tem
)
2123 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2124 && TMEM (Qcategory
, tem
)))
2125 text_read_only (after
);
2127 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2128 if (! TMEM (Qread_only
, tem
)
2129 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2130 || ! TMEM (Qcategory
, tem
)))
2131 text_read_only (after
);
2136 /* Run both insert hooks (just once if they're the same). */
2137 if (!NULL_INTERVAL_P (prev
))
2138 interval_insert_behind_hooks
2139 = textget (prev
->plist
, Qinsert_behind_hooks
);
2140 if (!NULL_INTERVAL_P (i
))
2141 interval_insert_in_front_hooks
2142 = textget (i
->plist
, Qinsert_in_front_hooks
);
2146 /* Loop over intervals on or next to START...END,
2147 collecting their hooks. */
2149 i
= find_interval (intervals
, start
);
2152 if (! INTERVAL_WRITABLE_P (i
))
2153 text_read_only (textget (i
->plist
, Qread_only
));
2155 if (!inhibit_modification_hooks
)
2157 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2158 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2160 hooks
= Fcons (mod_hooks
, hooks
);
2161 prev_mod_hooks
= mod_hooks
;
2165 i
= next_interval (i
);
2167 /* Keep going thru the interval containing the char before END. */
2168 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2170 if (!inhibit_modification_hooks
)
2173 hooks
= Fnreverse (hooks
);
2174 while (! EQ (hooks
, Qnil
))
2176 call_mod_hooks (Fcar (hooks
), make_number (start
),
2178 hooks
= Fcdr (hooks
);
2185 /* Run the interval hooks for an insertion on character range START ... END.
2186 verify_interval_modification chose which hooks to run;
2187 this function is called after the insertion happens
2188 so it can indicate the range of inserted text. */
2191 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2193 if (! NILP (interval_insert_behind_hooks
))
2194 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2195 if (! NILP (interval_insert_in_front_hooks
)
2196 && ! EQ (interval_insert_in_front_hooks
,
2197 interval_insert_behind_hooks
))
2198 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2202 syms_of_textprop (void)
2204 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2205 doc
: /* Property-list used as default values.
2206 The value of a property in this list is seen as the value for every
2207 character that does not have its own value for that property. */);
2208 Vdefault_text_properties
= Qnil
;
2210 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2211 doc
: /* Alist of alternative properties for properties without a value.
2212 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2213 If a piece of text has no direct value for a particular property, then
2214 this alist is consulted. If that property appears in the alist, then
2215 the first non-nil value from the associated alternative properties is
2217 Vchar_property_alias_alist
= Qnil
;
2219 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2220 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2221 This also inhibits the use of the `intangible' text property. */);
2222 Vinhibit_point_motion_hooks
= Qnil
;
2224 DEFVAR_LISP ("text-property-default-nonsticky",
2225 Vtext_property_default_nonsticky
,
2226 doc
: /* Alist of properties vs the corresponding non-stickiness.
2227 Each element has the form (PROPERTY . NONSTICKINESS).
2229 If a character in a buffer has PROPERTY, new text inserted adjacent to
2230 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2231 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2232 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2233 /* Text properties `syntax-table'and `display' should be nonsticky
2235 Vtext_property_default_nonsticky
2236 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
),
2237 Fcons (Fcons (intern_c_string ("display"), Qt
), Qnil
));
2239 staticpro (&interval_insert_behind_hooks
);
2240 staticpro (&interval_insert_in_front_hooks
);
2241 interval_insert_behind_hooks
= Qnil
;
2242 interval_insert_in_front_hooks
= Qnil
;
2245 /* Common attributes one might give text */
2247 DEFSYM (Qforeground
, "foreground");
2248 DEFSYM (Qbackground
, "background");
2249 DEFSYM (Qfont
, "font");
2250 DEFSYM (Qstipple
, "stipple");
2251 DEFSYM (Qunderline
, "underline");
2252 DEFSYM (Qread_only
, "read-only");
2253 DEFSYM (Qinvisible
, "invisible");
2254 DEFSYM (Qintangible
, "intangible");
2255 DEFSYM (Qcategory
, "category");
2256 DEFSYM (Qlocal_map
, "local-map");
2257 DEFSYM (Qfront_sticky
, "front-sticky");
2258 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2259 DEFSYM (Qmouse_face
, "mouse-face");
2260 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2262 /* Properties that text might use to specify certain actions */
2264 DEFSYM (Qmouse_left
, "mouse-left");
2265 DEFSYM (Qmouse_entered
, "mouse-entered");
2266 DEFSYM (Qpoint_left
, "point-left");
2267 DEFSYM (Qpoint_entered
, "point-entered");
2269 defsubr (&Stext_properties_at
);
2270 defsubr (&Sget_text_property
);
2271 defsubr (&Sget_char_property
);
2272 defsubr (&Sget_char_property_and_overlay
);
2273 defsubr (&Snext_char_property_change
);
2274 defsubr (&Sprevious_char_property_change
);
2275 defsubr (&Snext_single_char_property_change
);
2276 defsubr (&Sprevious_single_char_property_change
);
2277 defsubr (&Snext_property_change
);
2278 defsubr (&Snext_single_property_change
);
2279 defsubr (&Sprevious_property_change
);
2280 defsubr (&Sprevious_single_property_change
);
2281 defsubr (&Sadd_text_properties
);
2282 defsubr (&Sput_text_property
);
2283 defsubr (&Sset_text_properties
);
2284 defsubr (&Sremove_text_properties
);
2285 defsubr (&Sremove_list_of_text_properties
);
2286 defsubr (&Stext_property_any
);
2287 defsubr (&Stext_property_not_all
);