1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include "intervals.h"
24 #include "character.h"
28 /* Test for membership, allowing for t (actually any non-cons) to mean the
31 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
34 /* NOTES: previous- and next- property change will have to skip
35 zero-length intervals if they are implemented. This could be done
36 inside next_interval and previous_interval.
38 set_properties needs to deal with the interval property cache.
40 It is assumed that for any interval plist, a property appears
41 only once on the list. Although some code i.e., remove_properties,
42 handles the more general case, the uniqueness of properties is
43 necessary for the system to remain consistent. This requirement
44 is enforced by the subrs installing properties onto the intervals. */
48 static Lisp_Object Qmouse_left
;
49 static Lisp_Object Qmouse_entered
;
50 Lisp_Object Qpoint_left
;
51 Lisp_Object Qpoint_entered
;
52 Lisp_Object Qcategory
;
53 Lisp_Object Qlocal_map
;
55 /* Visual properties text (including strings) may have. */
56 static Lisp_Object Qforeground
, Qbackground
, Qunderline
;
58 static Lisp_Object Qstipple
;
59 Lisp_Object Qinvisible
, Qintangible
, Qmouse_face
;
60 static Lisp_Object Qread_only
;
61 Lisp_Object Qminibuffer_prompt
;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
71 /* verify_interval_modification saves insertion hooks here
72 to be run later by report_interval_modification. */
73 static Lisp_Object interval_insert_behind_hooks
;
74 static Lisp_Object interval_insert_in_front_hooks
;
77 /* Signal a `text-read-only' error. This function makes it easier
78 to capture that error in GDB by putting a breakpoint on it. */
81 text_read_only (Lisp_Object propval
)
83 if (STRINGP (propval
))
84 xsignal1 (Qtext_read_only
, propval
);
86 xsignal0 (Qtext_read_only
);
89 /* Prepare to modify the region of BUFFER from START to END. */
92 modify_region (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
94 struct buffer
*buf
= XBUFFER (buffer
), *old
= current_buffer
;
96 set_buffer_internal (buf
);
97 modify_region_1 (XINT (start
), XINT (end
), true);
98 set_buffer_internal (old
);
101 /* Extract the interval at the position pointed to by BEGIN from
102 OBJECT, a string or buffer. Additionally, check that the positions
103 pointed to by BEGIN and END are within the bounds of OBJECT, and
104 reverse them if *BEGIN is greater than *END. The objects pointed
105 to by BEGIN and END may be integers or markers; if the latter, they
106 are coerced to integers.
108 When OBJECT is a string, we increment *BEGIN and *END
109 to make them origin-one.
111 Note that buffer points don't correspond to interval indices.
112 For example, point-max is 1 greater than the index of the last
113 character. This difference is handled in the caller, which uses
114 the validated points to determine a length, and operates on that.
115 Exceptions are Ftext_properties_at, Fnext_property_change, and
116 Fprevious_property_change which call this function with BEGIN == END.
117 Handle this case specially.
119 If FORCE is soft (0), it's OK to return NULL. Otherwise,
120 create an interval tree for OBJECT if one doesn't exist, provided
121 the object actually contains text. In the current design, if there
122 is no text, there can be no text properties. */
128 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
133 CHECK_STRING_OR_BUFFER (object
);
134 CHECK_NUMBER_COERCE_MARKER (*begin
);
135 CHECK_NUMBER_COERCE_MARKER (*end
);
137 /* If we are asked for a point, but from a subr which operates
138 on a range, then return nothing. */
139 if (EQ (*begin
, *end
) && begin
!= end
)
142 if (XINT (*begin
) > XINT (*end
))
150 if (BUFFERP (object
))
152 register struct buffer
*b
= XBUFFER (object
);
154 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
155 && XINT (*end
) <= BUF_ZV (b
)))
156 args_out_of_range (*begin
, *end
);
157 i
= buffer_intervals (b
);
159 /* If there's no text, there are no properties. */
160 if (BUF_BEGV (b
) == BUF_ZV (b
))
163 searchpos
= XINT (*begin
);
167 ptrdiff_t len
= SCHARS (object
);
169 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
170 && XINT (*end
) <= len
))
171 args_out_of_range (*begin
, *end
);
172 XSETFASTINT (*begin
, XFASTINT (*begin
));
174 XSETFASTINT (*end
, XFASTINT (*end
));
175 i
= string_intervals (object
);
180 searchpos
= XINT (*begin
);
184 return (force
? create_root_interval (object
) : i
);
186 return find_interval (i
, searchpos
);
189 /* Validate LIST as a property list. If LIST is not a list, then
190 make one consisting of (LIST nil). Otherwise, verify that LIST
191 is even numbered and thus suitable as a plist. */
194 validate_plist (Lisp_Object list
)
202 register Lisp_Object tail
;
203 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
209 error ("Odd length text property list");
213 return Fcons (list
, Fcons (Qnil
, Qnil
));
216 /* Return nonzero if interval I has all the properties,
217 with the same values, of list PLIST. */
220 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
222 register Lisp_Object tail1
, tail2
, sym1
;
225 /* Go through each element of PLIST. */
226 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
231 /* Go through I's plist, looking for sym1 */
232 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
233 if (EQ (sym1
, XCAR (tail2
)))
235 /* Found the same property on both lists. If the
236 values are unequal, return zero. */
237 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
240 /* Property has same value on both lists; go to next one. */
252 /* Return nonzero if the plist of interval I has any of the
253 properties of PLIST, regardless of their values. */
256 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
258 register Lisp_Object tail1
, tail2
, sym
;
260 /* Go through each element of PLIST. */
261 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
265 /* Go through i's plist, looking for tail1 */
266 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
267 if (EQ (sym
, XCAR (tail2
)))
274 /* Return nonzero if the plist of interval I has any of the
275 property names in LIST, regardless of their values. */
278 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
280 register Lisp_Object tail1
, tail2
, sym
;
282 /* Go through each element of LIST. */
283 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
287 /* Go through i's plist, looking for tail1 */
288 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
289 if (EQ (sym
, XCAR (tail2
)))
296 /* Changing the plists of individual intervals. */
298 /* Return the value of PROP in property-list PLIST, or Qunbound if it
301 property_value (Lisp_Object plist
, Lisp_Object prop
)
305 while (PLIST_ELT_P (plist
, value
))
306 if (EQ (XCAR (plist
), prop
))
309 plist
= XCDR (value
);
314 /* Set the properties of INTERVAL to PROPERTIES,
315 and record undo info for the previous values.
316 OBJECT is the string or buffer that INTERVAL belongs to. */
319 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
321 Lisp_Object sym
, value
;
323 if (BUFFERP (object
))
325 /* For each property in the old plist which is missing from PROPERTIES,
326 or has a different value in PROPERTIES, make an undo record. */
327 for (sym
= interval
->plist
;
328 PLIST_ELT_P (sym
, value
);
330 if (! EQ (property_value (properties
, XCAR (sym
)),
333 record_property_change (interval
->position
, LENGTH (interval
),
334 XCAR (sym
), XCAR (value
),
338 /* For each new property that has no value at all in the old plist,
339 make an undo record binding it to nil, so it will be removed. */
340 for (sym
= properties
;
341 PLIST_ELT_P (sym
, value
);
343 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
345 record_property_change (interval
->position
, LENGTH (interval
),
351 /* Store new properties. */
352 set_interval_plist (interval
, Fcopy_sequence (properties
));
355 /* Add the properties of PLIST to the interval I, or set
356 the value of I's property to the value of the property on PLIST
357 if they are different.
359 OBJECT should be the string or buffer the interval is in.
361 Return nonzero if this changes I (i.e., if any members of PLIST
362 are actually added to I's plist) */
365 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
367 Lisp_Object tail1
, tail2
, sym1
, val1
;
368 register int changed
= 0;
370 struct gcpro gcpro1
, gcpro2
, gcpro3
;
375 /* No need to protect OBJECT, because we can GC only in the case
376 where it is a buffer, and live buffers are always protected.
377 I and its plist are also protected, via OBJECT. */
378 GCPRO3 (tail1
, sym1
, val1
);
380 /* Go through each element of PLIST. */
381 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
384 val1
= Fcar (XCDR (tail1
));
387 /* Go through I's plist, looking for sym1 */
388 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
389 if (EQ (sym1
, XCAR (tail2
)))
391 /* No need to gcpro, because tail2 protects this
392 and it must be a cons cell (we get an error otherwise). */
393 register Lisp_Object this_cdr
;
395 this_cdr
= XCDR (tail2
);
396 /* Found the property. Now check its value. */
399 /* The properties have the same value on both lists.
400 Continue to the next property. */
401 if (EQ (val1
, Fcar (this_cdr
)))
404 /* Record this change in the buffer, for undo purposes. */
405 if (BUFFERP (object
))
407 record_property_change (i
->position
, LENGTH (i
),
408 sym1
, Fcar (this_cdr
), object
);
411 /* I's property has a different value -- change it */
412 Fsetcar (this_cdr
, val1
);
419 /* Record this change in the buffer, for undo purposes. */
420 if (BUFFERP (object
))
422 record_property_change (i
->position
, LENGTH (i
),
425 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
435 /* For any members of PLIST, or LIST,
436 which are properties of I, remove them from I's plist.
437 (If PLIST is non-nil, use that, otherwise use LIST.)
438 OBJECT is the string or buffer containing I. */
441 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
443 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
444 register int changed
= 0;
446 /* Nonzero means tail1 is a plist, otherwise it is a list. */
449 current_plist
= i
->plist
;
452 tail1
= plist
, use_plist
= 1;
454 tail1
= list
, use_plist
= 0;
456 /* Go through each element of LIST or PLIST. */
457 while (CONSP (tail1
))
461 /* First, remove the symbol if it's at the head of the list */
462 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
464 if (BUFFERP (object
))
465 record_property_change (i
->position
, LENGTH (i
),
466 sym
, XCAR (XCDR (current_plist
)),
469 current_plist
= XCDR (XCDR (current_plist
));
473 /* Go through I's plist, looking for SYM. */
474 tail2
= current_plist
;
475 while (! NILP (tail2
))
477 register Lisp_Object
this;
478 this = XCDR (XCDR (tail2
));
479 if (CONSP (this) && EQ (sym
, XCAR (this)))
481 if (BUFFERP (object
))
482 record_property_change (i
->position
, LENGTH (i
),
483 sym
, XCAR (XCDR (this)), object
);
485 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
491 /* Advance thru TAIL1 one way or the other. */
492 tail1
= XCDR (tail1
);
493 if (use_plist
&& CONSP (tail1
))
494 tail1
= XCDR (tail1
);
498 set_interval_plist (i
, current_plist
);
502 /* Returns the interval of POSITION in OBJECT.
503 POSITION is BEG-based. */
506 interval_of (ptrdiff_t position
, Lisp_Object object
)
512 XSETBUFFER (object
, current_buffer
);
513 else if (EQ (object
, Qt
))
516 CHECK_STRING_OR_BUFFER (object
);
518 if (BUFFERP (object
))
520 register struct buffer
*b
= XBUFFER (object
);
524 i
= buffer_intervals (b
);
529 end
= SCHARS (object
);
530 i
= string_intervals (object
);
533 if (!(beg
<= position
&& position
<= end
))
534 args_out_of_range (make_number (position
), make_number (position
));
535 if (beg
== end
|| !i
)
538 return find_interval (i
, position
);
541 DEFUN ("text-properties-at", Ftext_properties_at
,
542 Stext_properties_at
, 1, 2, 0,
543 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
544 If the optional second argument OBJECT is a buffer (or nil, which means
545 the current buffer), POSITION is a buffer position (integer or marker).
546 If OBJECT is a string, POSITION is a 0-based index into it.
547 If POSITION is at the end of OBJECT, the value is nil. */)
548 (Lisp_Object position
, Lisp_Object object
)
553 XSETBUFFER (object
, current_buffer
);
555 i
= validate_interval_range (object
, &position
, &position
, soft
);
558 /* If POSITION is at the end of the interval,
559 it means it's the end of OBJECT.
560 There are no properties at the very end,
561 since no character follows. */
562 if (XINT (position
) == LENGTH (i
) + i
->position
)
568 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
569 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
570 OBJECT should be a buffer or a string; if omitted or nil, it defaults
571 to the current buffer.
572 If POSITION is at the end of OBJECT, the value is nil. */)
573 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
575 return textget (Ftext_properties_at (position
, object
), prop
);
578 /* Return the value of char's property PROP, in OBJECT at POSITION.
579 OBJECT is optional and defaults to the current buffer.
580 If OVERLAY is non-0, then in the case that the returned property is from
581 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
582 returned in *OVERLAY.
583 If POSITION is at the end of OBJECT, the value is nil.
584 If OBJECT is a buffer, then overlay properties are considered as well as
586 If OBJECT is a window, then that window's buffer is used, but
587 window-specific overlays are considered only if they are associated
590 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
592 struct window
*w
= 0;
594 CHECK_NUMBER_COERCE_MARKER (position
);
597 XSETBUFFER (object
, current_buffer
);
599 if (WINDOWP (object
))
601 w
= XWINDOW (object
);
604 if (BUFFERP (object
))
607 Lisp_Object
*overlay_vec
;
608 struct buffer
*obuf
= current_buffer
;
610 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
611 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
612 xsignal1 (Qargs_out_of_range
, position
);
614 set_buffer_temp (XBUFFER (object
));
616 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
617 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
619 set_buffer_temp (obuf
);
621 /* Now check the overlays in order of decreasing priority. */
622 while (--noverlays
>= 0)
624 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
628 /* Return the overlay we got the property from. */
629 *overlay
= overlay_vec
[noverlays
];
636 /* Indicate that the return value is not from an overlay. */
639 /* Not a buffer, or no appropriate overlay, so fall through to the
641 return Fget_text_property (position
, prop
, object
);
644 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
645 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
646 Both overlay properties and text properties are checked.
647 OBJECT is optional and defaults to the current buffer.
648 If POSITION is at the end of OBJECT, the value is nil.
649 If OBJECT is a buffer, then overlay properties are considered as well as
651 If OBJECT is a window, then that window's buffer is used, but window-specific
652 overlays are considered only if they are associated with OBJECT. */)
653 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
655 return get_char_property_and_overlay (position
, prop
, object
, 0);
658 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
659 Sget_char_property_and_overlay
, 2, 3, 0,
660 doc
: /* Like `get-char-property', but with extra overlay information.
661 The value is a cons cell. Its car is the return value of `get-char-property'
662 with the same arguments--that is, the value of POSITION's property
663 PROP in OBJECT. Its cdr is the overlay in which the property was
664 found, or nil, if it was found as a text property or not found at all.
666 OBJECT is optional and defaults to the current buffer. OBJECT may be
667 a string, a buffer or a window. For strings, the cdr of the return
668 value is always nil, since strings do not have overlays. If OBJECT is
669 a window, then that window's buffer is used, but window-specific
670 overlays are considered only if they are associated with OBJECT. If
671 POSITION is at the end of OBJECT, both car and cdr are nil. */)
672 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
676 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
677 return Fcons (val
, overlay
);
681 DEFUN ("next-char-property-change", Fnext_char_property_change
,
682 Snext_char_property_change
, 1, 2, 0,
683 doc
: /* Return the position of next text property or overlay change.
684 This scans characters forward in the current buffer from POSITION till
685 it finds a change in some text property, or the beginning or end of an
686 overlay, and returns the position of that.
687 If none is found up to (point-max), the function returns (point-max).
689 If the optional second argument LIMIT is non-nil, don't search
690 past position LIMIT; return LIMIT if nothing is found before LIMIT.
691 LIMIT is a no-op if it is greater than (point-max). */)
692 (Lisp_Object position
, Lisp_Object limit
)
696 temp
= Fnext_overlay_change (position
);
699 CHECK_NUMBER_COERCE_MARKER (limit
);
700 if (XINT (limit
) < XINT (temp
))
703 return Fnext_property_change (position
, Qnil
, temp
);
706 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
707 Sprevious_char_property_change
, 1, 2, 0,
708 doc
: /* Return the position of previous text property or overlay change.
709 Scans characters backward in the current buffer from POSITION till it
710 finds a change in some text property, or the beginning or end of an
711 overlay, and returns the position of that.
712 If none is found since (point-min), the function returns (point-min).
714 If the optional second argument LIMIT is non-nil, don't search
715 past position LIMIT; return LIMIT if nothing is found before LIMIT.
716 LIMIT is a no-op if it is less than (point-min). */)
717 (Lisp_Object position
, Lisp_Object limit
)
721 temp
= Fprevious_overlay_change (position
);
724 CHECK_NUMBER_COERCE_MARKER (limit
);
725 if (XINT (limit
) > XINT (temp
))
728 return Fprevious_property_change (position
, Qnil
, temp
);
732 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
733 Snext_single_char_property_change
, 2, 4, 0,
734 doc
: /* Return the position of next text property or overlay change for a specific property.
735 Scans characters forward from POSITION till it finds
736 a change in the PROP property, then returns the position of the change.
737 If the optional third argument OBJECT is a buffer (or nil, which means
738 the current buffer), POSITION is a buffer position (integer or marker).
739 If OBJECT is a string, POSITION is a 0-based index into it.
741 In a string, scan runs to the end of the string.
742 In a buffer, it runs to (point-max), and the value cannot exceed that.
744 The property values are compared with `eq'.
745 If the property is constant all the way to the end of OBJECT, return the
746 last valid position in OBJECT.
747 If the optional fourth argument LIMIT is non-nil, don't search
748 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
749 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
751 if (STRINGP (object
))
753 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
757 position
= make_number (SCHARS (object
));
760 CHECK_NUMBER (limit
);
767 Lisp_Object initial_value
, value
;
768 ptrdiff_t count
= SPECPDL_INDEX ();
771 CHECK_BUFFER (object
);
773 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
775 record_unwind_current_buffer ();
776 Fset_buffer (object
);
779 CHECK_NUMBER_COERCE_MARKER (position
);
781 initial_value
= Fget_char_property (position
, prop
, object
);
784 XSETFASTINT (limit
, ZV
);
786 CHECK_NUMBER_COERCE_MARKER (limit
);
788 if (XFASTINT (position
) >= XFASTINT (limit
))
791 if (XFASTINT (position
) > ZV
)
792 XSETFASTINT (position
, ZV
);
797 position
= Fnext_char_property_change (position
, limit
);
798 if (XFASTINT (position
) >= XFASTINT (limit
))
804 value
= Fget_char_property (position
, prop
, object
);
805 if (!EQ (value
, initial_value
))
809 unbind_to (count
, Qnil
);
815 DEFUN ("previous-single-char-property-change",
816 Fprevious_single_char_property_change
,
817 Sprevious_single_char_property_change
, 2, 4, 0,
818 doc
: /* Return the position of previous text property or overlay change for a specific property.
819 Scans characters backward from POSITION till it finds
820 a change in the PROP property, then returns the position of the change.
821 If the optional third argument OBJECT is a buffer (or nil, which means
822 the current buffer), POSITION is a buffer position (integer or marker).
823 If OBJECT is a string, POSITION is a 0-based index into it.
825 In a string, scan runs to the start of the string.
826 In a buffer, it runs to (point-min), and the value cannot be less than that.
828 The property values are compared with `eq'.
829 If the property is constant all the way to the start of OBJECT, return the
830 first valid position in OBJECT.
831 If the optional fourth argument LIMIT is non-nil, don't search back past
832 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
833 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
835 if (STRINGP (object
))
837 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
841 position
= make_number (0);
844 CHECK_NUMBER (limit
);
851 ptrdiff_t count
= SPECPDL_INDEX ();
854 CHECK_BUFFER (object
);
856 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
858 record_unwind_current_buffer ();
859 Fset_buffer (object
);
862 CHECK_NUMBER_COERCE_MARKER (position
);
865 XSETFASTINT (limit
, BEGV
);
867 CHECK_NUMBER_COERCE_MARKER (limit
);
869 if (XFASTINT (position
) <= XFASTINT (limit
))
872 if (XFASTINT (position
) < BEGV
)
873 XSETFASTINT (position
, BEGV
);
877 Lisp_Object initial_value
878 = Fget_char_property (make_number (XFASTINT (position
) - 1),
883 position
= Fprevious_char_property_change (position
, limit
);
885 if (XFASTINT (position
) <= XFASTINT (limit
))
893 = Fget_char_property (make_number (XFASTINT (position
) - 1),
896 if (!EQ (value
, initial_value
))
902 unbind_to (count
, Qnil
);
908 DEFUN ("next-property-change", Fnext_property_change
,
909 Snext_property_change
, 1, 3, 0,
910 doc
: /* Return the position of next property change.
911 Scans characters forward from POSITION in OBJECT till it finds
912 a change in some text property, then returns the position of the change.
913 If the optional second argument OBJECT is a buffer (or nil, which means
914 the current buffer), POSITION is a buffer position (integer or marker).
915 If OBJECT is a string, POSITION is a 0-based index into it.
916 Return nil if the property is constant all the way to the end of OBJECT.
917 If the value is non-nil, it is a position greater than POSITION, never equal.
919 If the optional third argument LIMIT is non-nil, don't search
920 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
921 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
923 register INTERVAL i
, next
;
926 XSETBUFFER (object
, current_buffer
);
928 if (!NILP (limit
) && !EQ (limit
, Qt
))
929 CHECK_NUMBER_COERCE_MARKER (limit
);
931 i
= validate_interval_range (object
, &position
, &position
, soft
);
933 /* If LIMIT is t, return start of next interval--don't
934 bother checking further intervals. */
940 next
= next_interval (i
);
943 XSETFASTINT (position
, (STRINGP (object
)
945 : BUF_ZV (XBUFFER (object
))));
947 XSETFASTINT (position
, next
->position
);
954 next
= next_interval (i
);
956 while (next
&& intervals_equal (i
, next
)
957 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
958 next
= next_interval (next
);
966 : BUF_ZV (XBUFFER (object
))))))
969 return make_number (next
->position
);
972 DEFUN ("next-single-property-change", Fnext_single_property_change
,
973 Snext_single_property_change
, 2, 4, 0,
974 doc
: /* Return the position of next property change for a specific property.
975 Scans characters forward from POSITION till it finds
976 a change in the PROP property, then returns the position of the change.
977 If the optional third argument OBJECT is a buffer (or nil, which means
978 the current buffer), POSITION is a buffer position (integer or marker).
979 If OBJECT is a string, POSITION is a 0-based index into it.
980 The property values are compared with `eq'.
981 Return nil if the property is constant all the way to the end of OBJECT.
982 If the value is non-nil, it is a position greater than POSITION, never equal.
984 If the optional fourth argument LIMIT is non-nil, don't search
985 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
986 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
988 register INTERVAL i
, next
;
989 register Lisp_Object here_val
;
992 XSETBUFFER (object
, current_buffer
);
995 CHECK_NUMBER_COERCE_MARKER (limit
);
997 i
= validate_interval_range (object
, &position
, &position
, soft
);
1001 here_val
= textget (i
->plist
, prop
);
1002 next
= next_interval (i
);
1004 && EQ (here_val
, textget (next
->plist
, prop
))
1005 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1006 next
= next_interval (next
);
1010 >= (INTEGERP (limit
)
1014 : BUF_ZV (XBUFFER (object
))))))
1017 return make_number (next
->position
);
1020 DEFUN ("previous-property-change", Fprevious_property_change
,
1021 Sprevious_property_change
, 1, 3, 0,
1022 doc
: /* Return the position of previous property change.
1023 Scans characters backwards from POSITION in OBJECT till it finds
1024 a change in some text property, then returns the position of the change.
1025 If the optional second argument OBJECT is a buffer (or nil, which means
1026 the current buffer), POSITION is a buffer position (integer or marker).
1027 If OBJECT is a string, POSITION is a 0-based index into it.
1028 Return nil if the property is constant all the way to the start of OBJECT.
1029 If the value is non-nil, it is a position less than POSITION, never equal.
1031 If the optional third argument LIMIT is non-nil, don't search
1032 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1033 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1035 register INTERVAL i
, previous
;
1038 XSETBUFFER (object
, current_buffer
);
1041 CHECK_NUMBER_COERCE_MARKER (limit
);
1043 i
= validate_interval_range (object
, &position
, &position
, soft
);
1047 /* Start with the interval containing the char before point. */
1048 if (i
->position
== XFASTINT (position
))
1049 i
= previous_interval (i
);
1051 previous
= previous_interval (i
);
1052 while (previous
&& intervals_equal (previous
, i
)
1054 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1055 previous
= previous_interval (previous
);
1058 || (previous
->position
+ LENGTH (previous
)
1059 <= (INTEGERP (limit
)
1061 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1064 return make_number (previous
->position
+ LENGTH (previous
));
1067 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1068 Sprevious_single_property_change
, 2, 4, 0,
1069 doc
: /* Return the position of previous property change for a specific property.
1070 Scans characters backward from POSITION till it finds
1071 a change in the PROP property, then returns the position of the change.
1072 If the optional third argument OBJECT is a buffer (or nil, which means
1073 the current buffer), POSITION is a buffer position (integer or marker).
1074 If OBJECT is a string, POSITION is a 0-based index into it.
1075 The property values are compared with `eq'.
1076 Return nil if the property is constant all the way to the start of OBJECT.
1077 If the value is non-nil, it is a position less than POSITION, never equal.
1079 If the optional fourth argument LIMIT is non-nil, don't search
1080 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1081 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1083 register INTERVAL i
, previous
;
1084 register Lisp_Object here_val
;
1087 XSETBUFFER (object
, current_buffer
);
1090 CHECK_NUMBER_COERCE_MARKER (limit
);
1092 i
= validate_interval_range (object
, &position
, &position
, soft
);
1094 /* Start with the interval containing the char before point. */
1095 if (i
&& i
->position
== XFASTINT (position
))
1096 i
= previous_interval (i
);
1101 here_val
= textget (i
->plist
, prop
);
1102 previous
= previous_interval (i
);
1104 && EQ (here_val
, textget (previous
->plist
, prop
))
1106 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1107 previous
= previous_interval (previous
);
1110 || (previous
->position
+ LENGTH (previous
)
1111 <= (INTEGERP (limit
)
1113 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1116 return make_number (previous
->position
+ LENGTH (previous
));
1119 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1121 DEFUN ("add-text-properties", Fadd_text_properties
,
1122 Sadd_text_properties
, 3, 4, 0,
1123 doc
: /* Add properties to the text from START to END.
1124 The third argument PROPERTIES is a property list
1125 specifying the property values to add. If the optional fourth argument
1126 OBJECT is a buffer (or nil, which means the current buffer),
1127 START and END are buffer positions (integers or markers).
1128 If OBJECT is a string, START and END are 0-based indices into it.
1129 Return t if any property value actually changed, nil otherwise. */)
1130 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1132 register INTERVAL i
, unchanged
;
1133 register ptrdiff_t s
, len
;
1134 register int modified
= 0;
1135 struct gcpro gcpro1
;
1138 properties
= validate_plist (properties
);
1139 if (NILP (properties
))
1143 XSETBUFFER (object
, current_buffer
);
1145 i
= validate_interval_range (object
, &start
, &end
, hard
);
1150 len
= XINT (end
) - s
;
1152 /* No need to protect OBJECT, because we GC only if it's a buffer,
1153 and live buffers are always protected. */
1154 GCPRO1 (properties
);
1156 /* If this interval already has the properties, we can skip it. */
1157 if (interval_has_all_properties (properties
, i
))
1159 got
= LENGTH (i
) - (s
- i
->position
);
1162 RETURN_UNGCPRO (Qnil
);
1164 i
= next_interval (i
);
1166 } while (interval_has_all_properties (properties
, i
));
1168 else if (i
->position
!= s
)
1170 /* If we're not starting on an interval boundary, we have to
1171 split this interval. */
1173 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1174 copy_properties (unchanged
, i
);
1177 if (BUFFERP (object
))
1178 modify_region (object
, start
, end
);
1180 /* We are at the beginning of interval I, with LEN chars to scan. */
1185 if (LENGTH (i
) >= len
)
1187 /* We can UNGCPRO safely here, because there will be just
1188 one more chance to gc, in the next call to add_properties,
1189 and after that we will not need PROPERTIES or OBJECT again. */
1192 if (interval_has_all_properties (properties
, i
))
1194 if (BUFFERP (object
))
1195 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1196 XINT (end
) - XINT (start
));
1202 if (LENGTH (i
) == len
)
1204 add_properties (properties
, i
, object
);
1205 if (BUFFERP (object
))
1206 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1207 XINT (end
) - XINT (start
));
1211 /* i doesn't have the properties, and goes past the change limit */
1213 i
= split_interval_left (unchanged
, len
);
1214 copy_properties (unchanged
, i
);
1215 add_properties (properties
, i
, object
);
1216 if (BUFFERP (object
))
1217 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1218 XINT (end
) - XINT (start
));
1223 modified
+= add_properties (properties
, i
, object
);
1224 i
= next_interval (i
);
1228 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1230 DEFUN ("put-text-property", Fput_text_property
,
1231 Sput_text_property
, 4, 5, 0,
1232 doc
: /* Set one property of the text from START to END.
1233 The third and fourth arguments PROPERTY and VALUE
1234 specify the property to add.
1235 If the optional fifth argument OBJECT is a buffer (or nil, which means
1236 the current buffer), START and END are buffer positions (integers or
1237 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1238 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1240 Fadd_text_properties (start
, end
,
1241 Fcons (property
, Fcons (value
, Qnil
)),
1246 DEFUN ("set-text-properties", Fset_text_properties
,
1247 Sset_text_properties
, 3, 4, 0,
1248 doc
: /* Completely replace properties of text from START to END.
1249 The third argument PROPERTIES is the new property list.
1250 If the optional fourth argument OBJECT is a buffer (or nil, which means
1251 the current buffer), START and END are buffer positions (integers or
1252 markers). If OBJECT is a string, START and END are 0-based indices into it.
1253 If PROPERTIES is nil, the effect is to remove all properties from
1254 the designated part of OBJECT. */)
1255 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1257 return set_text_properties (start
, end
, properties
, object
, Qt
);
1261 /* Replace properties of text from START to END with new list of
1262 properties PROPERTIES. OBJECT is the buffer or string containing
1263 the text. OBJECT nil means use the current buffer.
1264 COHERENT_CHANGE_P nil means this is being called as an internal
1265 subroutine, rather than as a change primitive with checking of
1266 read-only, invoking change hooks, etc.. Value is nil if the
1267 function _detected_ that it did not replace any properties, non-nil
1271 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1273 register INTERVAL i
;
1274 Lisp_Object ostart
, oend
;
1279 properties
= validate_plist (properties
);
1282 XSETBUFFER (object
, current_buffer
);
1284 /* If we want no properties for a whole string,
1285 get rid of its intervals. */
1286 if (NILP (properties
) && STRINGP (object
)
1287 && XFASTINT (start
) == 0
1288 && XFASTINT (end
) == SCHARS (object
))
1290 if (!string_intervals (object
))
1293 set_string_intervals (object
, NULL
);
1297 i
= validate_interval_range (object
, &start
, &end
, soft
);
1301 /* If buffer has no properties, and we want none, return now. */
1302 if (NILP (properties
))
1305 /* Restore the original START and END values
1306 because validate_interval_range increments them for strings. */
1310 i
= validate_interval_range (object
, &start
, &end
, hard
);
1311 /* This can return if start == end. */
1316 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1317 modify_region (object
, start
, end
);
1319 set_text_properties_1 (start
, end
, properties
, object
, i
);
1321 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1322 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1323 XINT (end
) - XINT (start
));
1327 /* Replace properties of text from START to END with new list of
1328 properties PROPERTIES. OBJECT is the buffer or string containing
1329 the text. This does not obey any hooks.
1330 You should provide the interval that START is located in as I.
1331 START and END can be in any order. */
1334 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1336 register INTERVAL prev_changed
= NULL
;
1337 register ptrdiff_t s
, len
;
1340 if (XINT (start
) < XINT (end
))
1343 len
= XINT (end
) - s
;
1345 else if (XINT (end
) < XINT (start
))
1348 len
= XINT (start
) - s
;
1355 if (i
->position
!= s
)
1358 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1360 if (LENGTH (i
) > len
)
1362 copy_properties (unchanged
, i
);
1363 i
= split_interval_left (i
, len
);
1364 set_properties (properties
, i
, object
);
1368 set_properties (properties
, i
, object
);
1370 if (LENGTH (i
) == len
)
1375 i
= next_interval (i
);
1378 /* We are starting at the beginning of an interval I. LEN is positive. */
1383 if (LENGTH (i
) >= len
)
1385 if (LENGTH (i
) > len
)
1386 i
= split_interval_left (i
, len
);
1388 /* We have to call set_properties even if we are going to
1389 merge the intervals, so as to make the undo records
1390 and cause redisplay to happen. */
1391 set_properties (properties
, i
, object
);
1393 merge_interval_left (i
);
1399 /* We have to call set_properties even if we are going to
1400 merge the intervals, so as to make the undo records
1401 and cause redisplay to happen. */
1402 set_properties (properties
, i
, object
);
1406 prev_changed
= i
= merge_interval_left (i
);
1408 i
= next_interval (i
);
1413 DEFUN ("remove-text-properties", Fremove_text_properties
,
1414 Sremove_text_properties
, 3, 4, 0,
1415 doc
: /* Remove some properties from text from START to END.
1416 The third argument PROPERTIES is a property list
1417 whose property names specify the properties to remove.
1418 \(The values stored in PROPERTIES are ignored.)
1419 If the optional fourth argument OBJECT is a buffer (or nil, which means
1420 the current buffer), START and END are buffer positions (integers or
1421 markers). If OBJECT is a string, START and END are 0-based indices into it.
1422 Return t if any property was actually removed, nil otherwise.
1424 Use `set-text-properties' if you want to remove all text properties. */)
1425 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1427 register INTERVAL i
, unchanged
;
1428 register ptrdiff_t s
, len
;
1429 register int modified
= 0;
1433 XSETBUFFER (object
, current_buffer
);
1435 i
= validate_interval_range (object
, &start
, &end
, soft
);
1440 len
= XINT (end
) - s
;
1442 /* If there are no properties on this entire interval, return. */
1443 if (! interval_has_some_properties (properties
, i
))
1445 got
= (LENGTH (i
) - (s
- i
->position
));
1450 i
= next_interval (i
);
1452 } while (! interval_has_some_properties (properties
, i
));
1454 /* Split away the beginning of this interval; what we don't
1456 else if (i
->position
!= s
)
1459 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1460 copy_properties (unchanged
, i
);
1463 if (BUFFERP (object
))
1464 modify_region (object
, start
, end
);
1466 /* We are at the beginning of an interval, with len to scan */
1471 if (LENGTH (i
) >= len
)
1473 if (! interval_has_some_properties (properties
, i
))
1476 if (BUFFERP (object
))
1477 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1478 XINT (end
) - XINT (start
));
1482 if (LENGTH (i
) == len
)
1484 remove_properties (properties
, Qnil
, i
, object
);
1485 if (BUFFERP (object
))
1486 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1487 XINT (end
) - XINT (start
));
1491 /* i has the properties, and goes past the change limit */
1493 i
= split_interval_left (i
, len
);
1494 copy_properties (unchanged
, i
);
1495 remove_properties (properties
, Qnil
, i
, object
);
1496 if (BUFFERP (object
))
1497 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1498 XINT (end
) - XINT (start
));
1503 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1504 i
= next_interval (i
);
1508 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1509 Sremove_list_of_text_properties
, 3, 4, 0,
1510 doc
: /* Remove some properties from text from START to END.
1511 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1512 If the optional fourth argument OBJECT is a buffer (or nil, which means
1513 the current buffer), START and END are buffer positions (integers or
1514 markers). If OBJECT is a string, START and END are 0-based indices into it.
1515 Return t if any property was actually removed, nil otherwise. */)
1516 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1518 register INTERVAL i
, unchanged
;
1519 register ptrdiff_t s
, len
;
1520 register int modified
= 0;
1521 Lisp_Object properties
;
1523 properties
= list_of_properties
;
1526 XSETBUFFER (object
, current_buffer
);
1528 i
= validate_interval_range (object
, &start
, &end
, soft
);
1533 len
= XINT (end
) - s
;
1535 /* If there are no properties on the interval, return. */
1536 if (! interval_has_some_properties_list (properties
, i
))
1538 got
= (LENGTH (i
) - (s
- i
->position
));
1543 i
= next_interval (i
);
1545 } while (! interval_has_some_properties_list (properties
, i
));
1547 /* Split away the beginning of this interval; what we don't
1549 else if (i
->position
!= s
)
1552 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1553 copy_properties (unchanged
, i
);
1556 /* We are at the beginning of an interval, with len to scan.
1557 The flag `modified' records if changes have been made.
1558 When object is a buffer, we must call modify_region before changes are
1559 made and signal_after_change when we are done.
1560 We call modify_region before calling remove_properties if modified == 0,
1561 and we call signal_after_change before returning if modified != 0. */
1566 if (LENGTH (i
) >= len
)
1568 if (! interval_has_some_properties_list (properties
, i
))
1572 if (BUFFERP (object
))
1573 signal_after_change (XINT (start
),
1574 XINT (end
) - XINT (start
),
1575 XINT (end
) - XINT (start
));
1581 else if (LENGTH (i
) == len
)
1583 if (!modified
&& BUFFERP (object
))
1584 modify_region (object
, start
, end
);
1585 remove_properties (Qnil
, properties
, i
, object
);
1586 if (BUFFERP (object
))
1587 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1588 XINT (end
) - XINT (start
));
1592 { /* i has the properties, and goes past the change limit. */
1594 i
= split_interval_left (i
, len
);
1595 copy_properties (unchanged
, i
);
1596 if (!modified
&& BUFFERP (object
))
1597 modify_region (object
, start
, end
);
1598 remove_properties (Qnil
, properties
, i
, object
);
1599 if (BUFFERP (object
))
1600 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1601 XINT (end
) - XINT (start
));
1605 if (interval_has_some_properties_list (properties
, i
))
1607 if (!modified
&& BUFFERP (object
))
1608 modify_region (object
, start
, end
);
1609 remove_properties (Qnil
, properties
, i
, object
);
1613 i
= next_interval (i
);
1617 DEFUN ("text-property-any", Ftext_property_any
,
1618 Stext_property_any
, 4, 5, 0,
1619 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1620 If so, return the position of the first character whose property PROPERTY
1621 is `eq' to VALUE. Otherwise return nil.
1622 If the optional fifth argument OBJECT is a buffer (or nil, which means
1623 the current buffer), START and END are buffer positions (integers or
1624 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1625 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1627 register INTERVAL i
;
1628 register ptrdiff_t e
, pos
;
1631 XSETBUFFER (object
, current_buffer
);
1632 i
= validate_interval_range (object
, &start
, &end
, soft
);
1634 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1639 if (i
->position
>= e
)
1641 if (EQ (textget (i
->plist
, property
), value
))
1644 if (pos
< XINT (start
))
1646 return make_number (pos
);
1648 i
= next_interval (i
);
1653 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1654 Stext_property_not_all
, 4, 5, 0,
1655 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1656 If so, return the position of the first character whose property PROPERTY
1657 is not `eq' to VALUE. Otherwise, return nil.
1658 If the optional fifth argument OBJECT is a buffer (or nil, which means
1659 the current buffer), START and END are buffer positions (integers or
1660 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1661 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1663 register INTERVAL i
;
1664 register ptrdiff_t s
, e
;
1667 XSETBUFFER (object
, current_buffer
);
1668 i
= validate_interval_range (object
, &start
, &end
, soft
);
1670 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1676 if (i
->position
>= e
)
1678 if (! EQ (textget (i
->plist
, property
), value
))
1680 if (i
->position
> s
)
1682 return make_number (s
);
1684 i
= next_interval (i
);
1690 /* Return the direction from which the text-property PROP would be
1691 inherited by any new text inserted at POS: 1 if it would be
1692 inherited from the char after POS, -1 if it would be inherited from
1693 the char before POS, and 0 if from neither.
1694 BUFFER can be either a buffer or nil (meaning current buffer). */
1697 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1699 Lisp_Object prev_pos
, front_sticky
;
1700 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1701 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1704 XSETBUFFER (buffer
, current_buffer
);
1706 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1709 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1710 /* Consider previous character. */
1712 Lisp_Object rear_non_sticky
;
1714 prev_pos
= make_number (XINT (pos
) - 1);
1715 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1717 if (!NILP (CONSP (rear_non_sticky
)
1718 ? Fmemq (prop
, rear_non_sticky
)
1720 /* PROP is rear-non-sticky. */
1726 /* Consider following character. */
1727 /* This signals an arg-out-of-range error if pos is outside the
1728 buffer's accessible range. */
1729 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1731 if (EQ (front_sticky
, Qt
)
1732 || (CONSP (front_sticky
)
1733 && !NILP (Fmemq (prop
, front_sticky
))))
1734 /* PROP is inherited from after. */
1735 is_front_sticky
= 1;
1737 /* Simple cases, where the properties are consistent. */
1738 if (is_rear_sticky
&& !is_front_sticky
)
1740 else if (!is_rear_sticky
&& is_front_sticky
)
1742 else if (!is_rear_sticky
&& !is_front_sticky
)
1745 /* The stickiness properties are inconsistent, so we have to
1746 disambiguate. Basically, rear-sticky wins, _except_ if the
1747 property that would be inherited has a value of nil, in which case
1748 front-sticky wins. */
1749 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1750 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1757 /* Copying properties between objects. */
1759 /* Add properties from START to END of SRC, starting at POS in DEST.
1760 SRC and DEST may each refer to strings or buffers.
1761 Optional sixth argument PROP causes only that property to be copied.
1762 Properties are copied to DEST as if by `add-text-properties'.
1763 Return t if any property value actually changed, nil otherwise. */
1765 /* Note this can GC when DEST is a buffer. */
1768 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1774 ptrdiff_t s
, e
, e2
, p
, len
;
1776 struct gcpro gcpro1
, gcpro2
;
1778 i
= validate_interval_range (src
, &start
, &end
, soft
);
1782 CHECK_NUMBER_COERCE_MARKER (pos
);
1784 Lisp_Object dest_start
, dest_end
;
1786 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1787 if (MOST_POSITIVE_FIXNUM
< e
)
1788 args_out_of_range (pos
, end
);
1790 XSETFASTINT (dest_end
, e
);
1791 /* Apply this to a copy of pos; it will try to increment its arguments,
1792 which we don't want. */
1793 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1804 e2
= i
->position
+ LENGTH (i
);
1811 while (! NILP (plist
))
1813 if (EQ (Fcar (plist
), prop
))
1815 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1818 plist
= Fcdr (Fcdr (plist
));
1822 /* Must defer modifications to the interval tree in case src
1823 and dest refer to the same string or buffer. */
1824 stuff
= Fcons (Fcons (make_number (p
),
1825 Fcons (make_number (p
+ len
),
1826 Fcons (plist
, Qnil
))),
1830 i
= next_interval (i
);
1838 GCPRO2 (stuff
, dest
);
1840 while (! NILP (stuff
))
1843 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1844 Fcar (Fcdr (Fcdr (res
))), dest
);
1847 stuff
= Fcdr (stuff
);
1852 return modified
? Qt
: Qnil
;
1856 /* Return a list representing the text properties of OBJECT between
1857 START and END. if PROP is non-nil, report only on that property.
1858 Each result list element has the form (S E PLIST), where S and E
1859 are positions in OBJECT and PLIST is a property list containing the
1860 text properties of OBJECT between S and E. Value is nil if OBJECT
1861 doesn't contain text properties between START and END. */
1864 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1871 i
= validate_interval_range (object
, &start
, &end
, soft
);
1874 ptrdiff_t s
= XINT (start
);
1875 ptrdiff_t e
= XINT (end
);
1879 ptrdiff_t interval_end
, len
;
1882 interval_end
= i
->position
+ LENGTH (i
);
1883 if (interval_end
> e
)
1885 len
= interval_end
- s
;
1890 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
1891 if (EQ (XCAR (plist
), prop
))
1893 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
1898 result
= Fcons (Fcons (make_number (s
),
1899 Fcons (make_number (s
+ len
),
1900 Fcons (plist
, Qnil
))),
1903 i
= next_interval (i
);
1914 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1915 (START END PLIST), where START and END are positions and PLIST is a
1916 property list containing the text properties to add. Adjust START
1917 and END positions by DELTA before adding properties. Value is
1918 non-zero if OBJECT was modified. */
1921 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
1923 struct gcpro gcpro1
, gcpro2
;
1926 GCPRO2 (list
, object
);
1928 for (; CONSP (list
); list
= XCDR (list
))
1930 Lisp_Object item
, start
, end
, plist
, tem
;
1933 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1934 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1935 plist
= XCAR (XCDR (XCDR (item
)));
1937 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1948 /* Modify end-points of ranges in LIST destructively, and return the
1949 new list. LIST is a list as returned from text_property_list.
1950 Discard properties that begin at or after NEW_END, and limit
1951 end-points to NEW_END. */
1954 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
1956 Lisp_Object prev
= Qnil
, head
= list
;
1957 ptrdiff_t max
= XINT (new_end
);
1959 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
1961 Lisp_Object item
, beg
, end
;
1965 end
= XCAR (XCDR (item
));
1967 if (XINT (beg
) >= max
)
1969 /* The start-point is past the end of the new string.
1970 Discard this property. */
1971 if (EQ (head
, list
))
1974 XSETCDR (prev
, XCDR (list
));
1976 else if (XINT (end
) > max
)
1977 /* The end-point is past the end of the new string. */
1978 XSETCAR (XCDR (item
), new_end
);
1986 /* Call the modification hook functions in LIST, each with START and END. */
1989 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
1991 struct gcpro gcpro1
;
1993 while (!NILP (list
))
1995 call2 (Fcar (list
), start
, end
);
2001 /* Check for read-only intervals between character positions START ... END,
2002 in BUF, and signal an error if we find one.
2004 Then check for any modification hooks in the range.
2005 Create a list of all these hooks in lexicographic order,
2006 eliminating consecutive extra copies of the same hook. Then call
2007 those hooks in order, with START and END - 1 as arguments. */
2010 verify_interval_modification (struct buffer
*buf
,
2011 ptrdiff_t start
, ptrdiff_t end
)
2013 INTERVAL intervals
= buffer_intervals (buf
);
2016 Lisp_Object prev_mod_hooks
;
2017 Lisp_Object mod_hooks
;
2018 struct gcpro gcpro1
;
2021 prev_mod_hooks
= Qnil
;
2024 interval_insert_behind_hooks
= Qnil
;
2025 interval_insert_in_front_hooks
= Qnil
;
2032 ptrdiff_t temp
= start
;
2037 /* For an insert operation, check the two chars around the position. */
2040 INTERVAL prev
= NULL
;
2041 Lisp_Object before
, after
;
2043 /* Set I to the interval containing the char after START,
2044 and PREV to the interval containing the char before START.
2045 Either one may be null. They may be equal. */
2046 i
= find_interval (intervals
, start
);
2048 if (start
== BUF_BEGV (buf
))
2050 else if (i
->position
== start
)
2051 prev
= previous_interval (i
);
2052 else if (i
->position
< start
)
2054 if (start
== BUF_ZV (buf
))
2057 /* If Vinhibit_read_only is set and is not a list, we can
2058 skip the read_only checks. */
2059 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2061 /* If I and PREV differ we need to check for the read-only
2062 property together with its stickiness. If either I or
2063 PREV are 0, this check is all we need.
2064 We have to take special care, since read-only may be
2065 indirectly defined via the category property. */
2070 after
= textget (i
->plist
, Qread_only
);
2072 /* If interval I is read-only and read-only is
2073 front-sticky, inhibit insertion.
2074 Check for read-only as well as category. */
2076 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2080 tem
= textget (i
->plist
, Qfront_sticky
);
2081 if (TMEM (Qread_only
, tem
)
2082 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2083 && TMEM (Qcategory
, tem
)))
2084 text_read_only (after
);
2090 before
= textget (prev
->plist
, Qread_only
);
2092 /* If interval PREV is read-only and read-only isn't
2093 rear-nonsticky, inhibit insertion.
2094 Check for read-only as well as category. */
2096 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2100 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2101 if (! TMEM (Qread_only
, tem
)
2102 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2103 || ! TMEM (Qcategory
, tem
)))
2104 text_read_only (before
);
2110 after
= textget (i
->plist
, Qread_only
);
2112 /* If interval I is read-only and read-only is
2113 front-sticky, inhibit insertion.
2114 Check for read-only as well as category. */
2115 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2119 tem
= textget (i
->plist
, Qfront_sticky
);
2120 if (TMEM (Qread_only
, tem
)
2121 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2122 && TMEM (Qcategory
, tem
)))
2123 text_read_only (after
);
2125 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2126 if (! TMEM (Qread_only
, tem
)
2127 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2128 || ! TMEM (Qcategory
, tem
)))
2129 text_read_only (after
);
2134 /* Run both insert hooks (just once if they're the same). */
2136 interval_insert_behind_hooks
2137 = textget (prev
->plist
, Qinsert_behind_hooks
);
2139 interval_insert_in_front_hooks
2140 = textget (i
->plist
, Qinsert_in_front_hooks
);
2144 /* Loop over intervals on or next to START...END,
2145 collecting their hooks. */
2147 i
= find_interval (intervals
, start
);
2150 if (! INTERVAL_WRITABLE_P (i
))
2151 text_read_only (textget (i
->plist
, Qread_only
));
2153 if (!inhibit_modification_hooks
)
2155 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2156 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2158 hooks
= Fcons (mod_hooks
, hooks
);
2159 prev_mod_hooks
= mod_hooks
;
2163 i
= next_interval (i
);
2165 /* Keep going thru the interval containing the char before END. */
2166 while (i
&& i
->position
< end
);
2168 if (!inhibit_modification_hooks
)
2171 hooks
= Fnreverse (hooks
);
2172 while (! EQ (hooks
, Qnil
))
2174 call_mod_hooks (Fcar (hooks
), make_number (start
),
2176 hooks
= Fcdr (hooks
);
2183 /* Run the interval hooks for an insertion on character range START ... END.
2184 verify_interval_modification chose which hooks to run;
2185 this function is called after the insertion happens
2186 so it can indicate the range of inserted text. */
2189 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2191 if (! NILP (interval_insert_behind_hooks
))
2192 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2193 if (! NILP (interval_insert_in_front_hooks
)
2194 && ! EQ (interval_insert_in_front_hooks
,
2195 interval_insert_behind_hooks
))
2196 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2200 syms_of_textprop (void)
2202 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2203 doc
: /* Property-list used as default values.
2204 The value of a property in this list is seen as the value for every
2205 character that does not have its own value for that property. */);
2206 Vdefault_text_properties
= Qnil
;
2208 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2209 doc
: /* Alist of alternative properties for properties without a value.
2210 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2211 If a piece of text has no direct value for a particular property, then
2212 this alist is consulted. If that property appears in the alist, then
2213 the first non-nil value from the associated alternative properties is
2215 Vchar_property_alias_alist
= Qnil
;
2217 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2218 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2219 This also inhibits the use of the `intangible' text property. */);
2220 Vinhibit_point_motion_hooks
= Qnil
;
2222 DEFVAR_LISP ("text-property-default-nonsticky",
2223 Vtext_property_default_nonsticky
,
2224 doc
: /* Alist of properties vs the corresponding non-stickiness.
2225 Each element has the form (PROPERTY . NONSTICKINESS).
2227 If a character in a buffer has PROPERTY, new text inserted adjacent to
2228 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2229 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2230 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2231 /* Text properties `syntax-table'and `display' should be nonsticky
2233 Vtext_property_default_nonsticky
2234 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
),
2235 Fcons (Fcons (intern_c_string ("display"), Qt
), Qnil
));
2237 staticpro (&interval_insert_behind_hooks
);
2238 staticpro (&interval_insert_in_front_hooks
);
2239 interval_insert_behind_hooks
= Qnil
;
2240 interval_insert_in_front_hooks
= Qnil
;
2243 /* Common attributes one might give text */
2245 DEFSYM (Qforeground
, "foreground");
2246 DEFSYM (Qbackground
, "background");
2247 DEFSYM (Qfont
, "font");
2248 DEFSYM (Qstipple
, "stipple");
2249 DEFSYM (Qunderline
, "underline");
2250 DEFSYM (Qread_only
, "read-only");
2251 DEFSYM (Qinvisible
, "invisible");
2252 DEFSYM (Qintangible
, "intangible");
2253 DEFSYM (Qcategory
, "category");
2254 DEFSYM (Qlocal_map
, "local-map");
2255 DEFSYM (Qfront_sticky
, "front-sticky");
2256 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2257 DEFSYM (Qmouse_face
, "mouse-face");
2258 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2260 /* Properties that text might use to specify certain actions */
2262 DEFSYM (Qmouse_left
, "mouse-left");
2263 DEFSYM (Qmouse_entered
, "mouse-entered");
2264 DEFSYM (Qpoint_left
, "point-left");
2265 DEFSYM (Qpoint_entered
, "point-entered");
2267 defsubr (&Stext_properties_at
);
2268 defsubr (&Sget_text_property
);
2269 defsubr (&Sget_char_property
);
2270 defsubr (&Sget_char_property_and_overlay
);
2271 defsubr (&Snext_char_property_change
);
2272 defsubr (&Sprevious_char_property_change
);
2273 defsubr (&Snext_single_char_property_change
);
2274 defsubr (&Sprevious_single_char_property_change
);
2275 defsubr (&Snext_property_change
);
2276 defsubr (&Snext_single_property_change
);
2277 defsubr (&Sprevious_property_change
);
2278 defsubr (&Sprevious_single_property_change
);
2279 defsubr (&Sadd_text_properties
);
2280 defsubr (&Sput_text_property
);
2281 defsubr (&Sset_text_properties
);
2282 defsubr (&Sremove_text_properties
);
2283 defsubr (&Sremove_list_of_text_properties
);
2284 defsubr (&Stext_property_any
);
2285 defsubr (&Stext_property_not_all
);