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
);
88 /* Prepare to modify the region of BUFFER from START to END. */
91 modify_region (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
93 struct buffer
*buf
= XBUFFER (buffer
), *old
= current_buffer
;
95 set_buffer_internal (buf
);
96 modify_region_1 (XINT (start
), XINT (end
), true);
97 set_buffer_internal (old
);
100 /* Extract the interval at the position pointed to by BEGIN from
101 OBJECT, a string or buffer. Additionally, check that the positions
102 pointed to by BEGIN and END are within the bounds of OBJECT, and
103 reverse them if *BEGIN is greater than *END. The objects pointed
104 to by BEGIN and END may be integers or markers; if the latter, they
105 are coerced to integers.
107 When OBJECT is a string, we increment *BEGIN and *END
108 to make them origin-one.
110 Note that buffer points don't correspond to interval indices.
111 For example, point-max is 1 greater than the index of the last
112 character. This difference is handled in the caller, which uses
113 the validated points to determine a length, and operates on that.
114 Exceptions are Ftext_properties_at, Fnext_property_change, and
115 Fprevious_property_change which call this function with BEGIN == END.
116 Handle this case specially.
118 If FORCE is soft (0), it's OK to return NULL. Otherwise,
119 create an interval tree for OBJECT if one doesn't exist, provided
120 the object actually contains text. In the current design, if there
121 is no text, there can be no text properties. */
127 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
132 CHECK_STRING_OR_BUFFER (object
);
133 CHECK_NUMBER_COERCE_MARKER (*begin
);
134 CHECK_NUMBER_COERCE_MARKER (*end
);
136 /* If we are asked for a point, but from a subr which operates
137 on a range, then return nothing. */
138 if (EQ (*begin
, *end
) && begin
!= end
)
141 if (XINT (*begin
) > XINT (*end
))
149 if (BUFFERP (object
))
151 register struct buffer
*b
= XBUFFER (object
);
153 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
154 && XINT (*end
) <= BUF_ZV (b
)))
155 args_out_of_range (*begin
, *end
);
156 i
= buffer_intervals (b
);
158 /* If there's no text, there are no properties. */
159 if (BUF_BEGV (b
) == BUF_ZV (b
))
162 searchpos
= XINT (*begin
);
166 ptrdiff_t len
= SCHARS (object
);
168 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
169 && XINT (*end
) <= len
))
170 args_out_of_range (*begin
, *end
);
171 XSETFASTINT (*begin
, XFASTINT (*begin
));
173 XSETFASTINT (*end
, XFASTINT (*end
));
174 i
= string_intervals (object
);
179 searchpos
= XINT (*begin
);
183 return (force
? create_root_interval (object
) : i
);
185 return find_interval (i
, searchpos
);
188 /* Validate LIST as a property list. If LIST is not a list, then
189 make one consisting of (LIST nil). Otherwise, verify that LIST
190 is even numbered and thus suitable as a plist. */
193 validate_plist (Lisp_Object list
)
201 register Lisp_Object tail
;
202 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
208 error ("Odd length text property list");
212 return Fcons (list
, Fcons (Qnil
, Qnil
));
215 /* Return nonzero if interval I has all the properties,
216 with the same values, of list PLIST. */
219 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
221 register Lisp_Object tail1
, tail2
, sym1
;
224 /* Go through each element of PLIST. */
225 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
230 /* Go through I's plist, looking for sym1 */
231 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
232 if (EQ (sym1
, XCAR (tail2
)))
234 /* Found the same property on both lists. If the
235 values are unequal, return zero. */
236 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
239 /* Property has same value on both lists; go to next one. */
251 /* Return nonzero if the plist of interval I has any of the
252 properties of PLIST, regardless of their values. */
255 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
257 register Lisp_Object tail1
, tail2
, sym
;
259 /* Go through each element of PLIST. */
260 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
264 /* Go through i's plist, looking for tail1 */
265 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
266 if (EQ (sym
, XCAR (tail2
)))
273 /* Return nonzero if the plist of interval I has any of the
274 property names in LIST, regardless of their values. */
277 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
279 register Lisp_Object tail1
, tail2
, sym
;
281 /* Go through each element of LIST. */
282 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
286 /* Go through i's plist, looking for tail1 */
287 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
288 if (EQ (sym
, XCAR (tail2
)))
295 /* Changing the plists of individual intervals. */
297 /* Return the value of PROP in property-list PLIST, or Qunbound if it
300 property_value (Lisp_Object plist
, Lisp_Object prop
)
304 while (PLIST_ELT_P (plist
, value
))
305 if (EQ (XCAR (plist
), prop
))
308 plist
= XCDR (value
);
313 /* Set the properties of INTERVAL to PROPERTIES,
314 and record undo info for the previous values.
315 OBJECT is the string or buffer that INTERVAL belongs to. */
318 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
320 Lisp_Object sym
, value
;
322 if (BUFFERP (object
))
324 /* For each property in the old plist which is missing from PROPERTIES,
325 or has a different value in PROPERTIES, make an undo record. */
326 for (sym
= interval
->plist
;
327 PLIST_ELT_P (sym
, value
);
329 if (! EQ (property_value (properties
, XCAR (sym
)),
332 record_property_change (interval
->position
, LENGTH (interval
),
333 XCAR (sym
), XCAR (value
),
337 /* For each new property that has no value at all in the old plist,
338 make an undo record binding it to nil, so it will be removed. */
339 for (sym
= properties
;
340 PLIST_ELT_P (sym
, value
);
342 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
344 record_property_change (interval
->position
, LENGTH (interval
),
350 /* Store new properties. */
351 set_interval_plist (interval
, Fcopy_sequence (properties
));
354 /* Add the properties of PLIST to the interval I, or set
355 the value of I's property to the value of the property on PLIST
356 if they are different.
358 OBJECT should be the string or buffer the interval is in.
360 Return nonzero if this changes I (i.e., if any members of PLIST
361 are actually added to I's plist) */
364 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
366 Lisp_Object tail1
, tail2
, sym1
, val1
;
367 register int changed
= 0;
369 struct gcpro gcpro1
, gcpro2
, gcpro3
;
374 /* No need to protect OBJECT, because we can GC only in the case
375 where it is a buffer, and live buffers are always protected.
376 I and its plist are also protected, via OBJECT. */
377 GCPRO3 (tail1
, sym1
, val1
);
379 /* Go through each element of PLIST. */
380 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
383 val1
= Fcar (XCDR (tail1
));
386 /* Go through I's plist, looking for sym1 */
387 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
388 if (EQ (sym1
, XCAR (tail2
)))
390 /* No need to gcpro, because tail2 protects this
391 and it must be a cons cell (we get an error otherwise). */
392 register Lisp_Object this_cdr
;
394 this_cdr
= XCDR (tail2
);
395 /* Found the property. Now check its value. */
398 /* The properties have the same value on both lists.
399 Continue to the next property. */
400 if (EQ (val1
, Fcar (this_cdr
)))
403 /* Record this change in the buffer, for undo purposes. */
404 if (BUFFERP (object
))
406 record_property_change (i
->position
, LENGTH (i
),
407 sym1
, Fcar (this_cdr
), object
);
410 /* I's property has a different value -- change it */
411 Fsetcar (this_cdr
, val1
);
418 /* Record this change in the buffer, for undo purposes. */
419 if (BUFFERP (object
))
421 record_property_change (i
->position
, LENGTH (i
),
424 set_interval_plist (i
, Fcons (sym1
, Fcons (val1
, i
->plist
)));
434 /* For any members of PLIST, or LIST,
435 which are properties of I, remove them from I's plist.
436 (If PLIST is non-nil, use that, otherwise use LIST.)
437 OBJECT is the string or buffer containing I. */
440 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
442 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
443 register int changed
= 0;
445 /* Nonzero means tail1 is a plist, otherwise it is a list. */
448 current_plist
= i
->plist
;
451 tail1
= plist
, use_plist
= 1;
453 tail1
= list
, use_plist
= 0;
455 /* Go through each element of LIST or PLIST. */
456 while (CONSP (tail1
))
460 /* First, remove the symbol if it's at the head of the list */
461 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
463 if (BUFFERP (object
))
464 record_property_change (i
->position
, LENGTH (i
),
465 sym
, XCAR (XCDR (current_plist
)),
468 current_plist
= XCDR (XCDR (current_plist
));
472 /* Go through I's plist, looking for SYM. */
473 tail2
= current_plist
;
474 while (! NILP (tail2
))
476 register Lisp_Object
this;
477 this = XCDR (XCDR (tail2
));
478 if (CONSP (this) && EQ (sym
, XCAR (this)))
480 if (BUFFERP (object
))
481 record_property_change (i
->position
, LENGTH (i
),
482 sym
, XCAR (XCDR (this)), object
);
484 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
490 /* Advance thru TAIL1 one way or the other. */
491 tail1
= XCDR (tail1
);
492 if (use_plist
&& CONSP (tail1
))
493 tail1
= XCDR (tail1
);
497 set_interval_plist (i
, current_plist
);
501 /* Returns the interval of POSITION in OBJECT.
502 POSITION is BEG-based. */
505 interval_of (ptrdiff_t position
, Lisp_Object object
)
511 XSETBUFFER (object
, current_buffer
);
512 else if (EQ (object
, Qt
))
515 CHECK_STRING_OR_BUFFER (object
);
517 if (BUFFERP (object
))
519 register struct buffer
*b
= XBUFFER (object
);
523 i
= buffer_intervals (b
);
528 end
= SCHARS (object
);
529 i
= string_intervals (object
);
532 if (!(beg
<= position
&& position
<= end
))
533 args_out_of_range (make_number (position
), make_number (position
));
534 if (beg
== end
|| !i
)
537 return find_interval (i
, position
);
540 DEFUN ("text-properties-at", Ftext_properties_at
,
541 Stext_properties_at
, 1, 2, 0,
542 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
543 If the optional second argument OBJECT is a buffer (or nil, which means
544 the current buffer), POSITION is a buffer position (integer or marker).
545 If OBJECT is a string, POSITION is a 0-based index into it.
546 If POSITION is at the end of OBJECT, the value is nil. */)
547 (Lisp_Object position
, Lisp_Object object
)
552 XSETBUFFER (object
, current_buffer
);
554 i
= validate_interval_range (object
, &position
, &position
, soft
);
557 /* If POSITION is at the end of the interval,
558 it means it's the end of OBJECT.
559 There are no properties at the very end,
560 since no character follows. */
561 if (XINT (position
) == LENGTH (i
) + i
->position
)
567 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
568 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
569 OBJECT should be a buffer or a string; if omitted or nil, it defaults
570 to the current buffer.
571 If POSITION is at the end of OBJECT, the value is nil. */)
572 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
574 return textget (Ftext_properties_at (position
, object
), prop
);
577 /* Return the value of char's property PROP, in OBJECT at POSITION.
578 OBJECT is optional and defaults to the current buffer.
579 If OVERLAY is non-0, then in the case that the returned property is from
580 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
581 returned in *OVERLAY.
582 If POSITION is at the end of OBJECT, the value is nil.
583 If OBJECT is a buffer, then overlay properties are considered as well as
585 If OBJECT is a window, then that window's buffer is used, but
586 window-specific overlays are considered only if they are associated
589 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
591 struct window
*w
= 0;
593 CHECK_NUMBER_COERCE_MARKER (position
);
596 XSETBUFFER (object
, current_buffer
);
598 if (WINDOWP (object
))
600 w
= XWINDOW (object
);
603 if (BUFFERP (object
))
606 Lisp_Object
*overlay_vec
;
607 struct buffer
*obuf
= current_buffer
;
609 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
610 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
611 xsignal1 (Qargs_out_of_range
, position
);
613 set_buffer_temp (XBUFFER (object
));
615 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
616 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
618 set_buffer_temp (obuf
);
620 /* Now check the overlays in order of decreasing priority. */
621 while (--noverlays
>= 0)
623 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
627 /* Return the overlay we got the property from. */
628 *overlay
= overlay_vec
[noverlays
];
635 /* Indicate that the return value is not from an overlay. */
638 /* Not a buffer, or no appropriate overlay, so fall through to the
640 return Fget_text_property (position
, prop
, object
);
643 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
644 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
645 Both overlay properties and text properties are checked.
646 OBJECT is optional and defaults to the current buffer.
647 If POSITION is at the end of OBJECT, the value is nil.
648 If OBJECT is a buffer, then overlay properties are considered as well as
650 If OBJECT is a window, then that window's buffer is used, but window-specific
651 overlays are considered only if they are associated with OBJECT. */)
652 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
654 return get_char_property_and_overlay (position
, prop
, object
, 0);
657 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
658 Sget_char_property_and_overlay
, 2, 3, 0,
659 doc
: /* Like `get-char-property', but with extra overlay information.
660 The value is a cons cell. Its car is the return value of `get-char-property'
661 with the same arguments--that is, the value of POSITION's property
662 PROP in OBJECT. Its cdr is the overlay in which the property was
663 found, or nil, if it was found as a text property or not found at all.
665 OBJECT is optional and defaults to the current buffer. OBJECT may be
666 a string, a buffer or a window. For strings, the cdr of the return
667 value is always nil, since strings do not have overlays. If OBJECT is
668 a window, then that window's buffer is used, but window-specific
669 overlays are considered only if they are associated with OBJECT. If
670 POSITION is at the end of OBJECT, both car and cdr are nil. */)
671 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
675 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
676 return Fcons (val
, overlay
);
680 DEFUN ("next-char-property-change", Fnext_char_property_change
,
681 Snext_char_property_change
, 1, 2, 0,
682 doc
: /* Return the position of next text property or overlay change.
683 This scans characters forward in the current buffer from POSITION till
684 it finds a change in some text property, or the beginning or end of an
685 overlay, and returns the position of that.
686 If none is found up to (point-max), the function returns (point-max).
688 If the optional second argument LIMIT is non-nil, don't search
689 past position LIMIT; return LIMIT if nothing is found before LIMIT.
690 LIMIT is a no-op if it is greater than (point-max). */)
691 (Lisp_Object position
, Lisp_Object limit
)
695 temp
= Fnext_overlay_change (position
);
698 CHECK_NUMBER_COERCE_MARKER (limit
);
699 if (XINT (limit
) < XINT (temp
))
702 return Fnext_property_change (position
, Qnil
, temp
);
705 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
706 Sprevious_char_property_change
, 1, 2, 0,
707 doc
: /* Return the position of previous text property or overlay change.
708 Scans characters backward in the current buffer from POSITION till it
709 finds a change in some text property, or the beginning or end of an
710 overlay, and returns the position of that.
711 If none is found since (point-min), the function returns (point-min).
713 If the optional second argument LIMIT is non-nil, don't search
714 past position LIMIT; return LIMIT if nothing is found before LIMIT.
715 LIMIT is a no-op if it is less than (point-min). */)
716 (Lisp_Object position
, Lisp_Object limit
)
720 temp
= Fprevious_overlay_change (position
);
723 CHECK_NUMBER_COERCE_MARKER (limit
);
724 if (XINT (limit
) > XINT (temp
))
727 return Fprevious_property_change (position
, Qnil
, temp
);
731 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
732 Snext_single_char_property_change
, 2, 4, 0,
733 doc
: /* Return the position of next text property or overlay change for a specific property.
734 Scans characters forward from POSITION till it finds
735 a change in the PROP property, then returns the position of the change.
736 If the optional third argument OBJECT is a buffer (or nil, which means
737 the current buffer), POSITION is a buffer position (integer or marker).
738 If OBJECT is a string, POSITION is a 0-based index into it.
740 In a string, scan runs to the end of the string.
741 In a buffer, it runs to (point-max), and the value cannot exceed that.
743 The property values are compared with `eq'.
744 If the property is constant all the way to the end of OBJECT, return the
745 last valid position in OBJECT.
746 If the optional fourth argument LIMIT is non-nil, don't search
747 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
748 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
750 if (STRINGP (object
))
752 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
756 position
= make_number (SCHARS (object
));
759 CHECK_NUMBER (limit
);
766 Lisp_Object initial_value
, value
;
767 ptrdiff_t count
= SPECPDL_INDEX ();
770 CHECK_BUFFER (object
);
772 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
774 record_unwind_current_buffer ();
775 Fset_buffer (object
);
778 CHECK_NUMBER_COERCE_MARKER (position
);
780 initial_value
= Fget_char_property (position
, prop
, object
);
783 XSETFASTINT (limit
, ZV
);
785 CHECK_NUMBER_COERCE_MARKER (limit
);
787 if (XFASTINT (position
) >= XFASTINT (limit
))
790 if (XFASTINT (position
) > ZV
)
791 XSETFASTINT (position
, ZV
);
796 position
= Fnext_char_property_change (position
, limit
);
797 if (XFASTINT (position
) >= XFASTINT (limit
))
803 value
= Fget_char_property (position
, prop
, object
);
804 if (!EQ (value
, initial_value
))
808 unbind_to (count
, Qnil
);
814 DEFUN ("previous-single-char-property-change",
815 Fprevious_single_char_property_change
,
816 Sprevious_single_char_property_change
, 2, 4, 0,
817 doc
: /* Return the position of previous text property or overlay change for a specific property.
818 Scans characters backward from POSITION till it finds
819 a change in the PROP property, then returns the position of the change.
820 If the optional third argument OBJECT is a buffer (or nil, which means
821 the current buffer), POSITION is a buffer position (integer or marker).
822 If OBJECT is a string, POSITION is a 0-based index into it.
824 In a string, scan runs to the start of the string.
825 In a buffer, it runs to (point-min), and the value cannot be less than that.
827 The property values are compared with `eq'.
828 If the property is constant all the way to the start of OBJECT, return the
829 first valid position in OBJECT.
830 If the optional fourth argument LIMIT is non-nil, don't search back past
831 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
832 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
834 if (STRINGP (object
))
836 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
840 position
= make_number (0);
843 CHECK_NUMBER (limit
);
850 ptrdiff_t count
= SPECPDL_INDEX ();
853 CHECK_BUFFER (object
);
855 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
857 record_unwind_current_buffer ();
858 Fset_buffer (object
);
861 CHECK_NUMBER_COERCE_MARKER (position
);
864 XSETFASTINT (limit
, BEGV
);
866 CHECK_NUMBER_COERCE_MARKER (limit
);
868 if (XFASTINT (position
) <= XFASTINT (limit
))
871 if (XFASTINT (position
) < BEGV
)
872 XSETFASTINT (position
, BEGV
);
876 Lisp_Object initial_value
877 = Fget_char_property (make_number (XFASTINT (position
) - 1),
882 position
= Fprevious_char_property_change (position
, limit
);
884 if (XFASTINT (position
) <= XFASTINT (limit
))
892 = Fget_char_property (make_number (XFASTINT (position
) - 1),
895 if (!EQ (value
, initial_value
))
901 unbind_to (count
, Qnil
);
907 DEFUN ("next-property-change", Fnext_property_change
,
908 Snext_property_change
, 1, 3, 0,
909 doc
: /* Return the position of next property change.
910 Scans characters forward from POSITION in OBJECT till it finds
911 a change in some text property, then returns the position of the change.
912 If the optional second argument OBJECT is a buffer (or nil, which means
913 the current buffer), POSITION is a buffer position (integer or marker).
914 If OBJECT is a string, POSITION is a 0-based index into it.
915 Return nil if the property is constant all the way to the end of OBJECT.
916 If the value is non-nil, it is a position greater than POSITION, never equal.
918 If the optional third argument LIMIT is non-nil, don't search
919 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
920 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
922 register INTERVAL i
, next
;
925 XSETBUFFER (object
, current_buffer
);
927 if (!NILP (limit
) && !EQ (limit
, Qt
))
928 CHECK_NUMBER_COERCE_MARKER (limit
);
930 i
= validate_interval_range (object
, &position
, &position
, soft
);
932 /* If LIMIT is t, return start of next interval--don't
933 bother checking further intervals. */
939 next
= next_interval (i
);
942 XSETFASTINT (position
, (STRINGP (object
)
944 : BUF_ZV (XBUFFER (object
))));
946 XSETFASTINT (position
, next
->position
);
953 next
= next_interval (i
);
955 while (next
&& intervals_equal (i
, next
)
956 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
957 next
= next_interval (next
);
965 : BUF_ZV (XBUFFER (object
))))))
968 return make_number (next
->position
);
971 DEFUN ("next-single-property-change", Fnext_single_property_change
,
972 Snext_single_property_change
, 2, 4, 0,
973 doc
: /* Return the position of next property change for a specific property.
974 Scans characters forward from POSITION till it finds
975 a change in the PROP property, then returns the position of the change.
976 If the optional third argument OBJECT is a buffer (or nil, which means
977 the current buffer), POSITION is a buffer position (integer or marker).
978 If OBJECT is a string, POSITION is a 0-based index into it.
979 The property values are compared with `eq'.
980 Return nil if the property is constant all the way to the end of OBJECT.
981 If the value is non-nil, it is a position greater than POSITION, never equal.
983 If the optional fourth argument LIMIT is non-nil, don't search
984 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
985 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
987 register INTERVAL i
, next
;
988 register Lisp_Object here_val
;
991 XSETBUFFER (object
, current_buffer
);
994 CHECK_NUMBER_COERCE_MARKER (limit
);
996 i
= validate_interval_range (object
, &position
, &position
, soft
);
1000 here_val
= textget (i
->plist
, prop
);
1001 next
= next_interval (i
);
1003 && EQ (here_val
, textget (next
->plist
, prop
))
1004 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1005 next
= next_interval (next
);
1009 >= (INTEGERP (limit
)
1013 : BUF_ZV (XBUFFER (object
))))))
1016 return make_number (next
->position
);
1019 DEFUN ("previous-property-change", Fprevious_property_change
,
1020 Sprevious_property_change
, 1, 3, 0,
1021 doc
: /* Return the position of previous property change.
1022 Scans characters backwards from POSITION in OBJECT till it finds
1023 a change in some text property, then returns the position of the change.
1024 If the optional second argument OBJECT is a buffer (or nil, which means
1025 the current buffer), POSITION is a buffer position (integer or marker).
1026 If OBJECT is a string, POSITION is a 0-based index into it.
1027 Return nil if the property is constant all the way to the start of OBJECT.
1028 If the value is non-nil, it is a position less than POSITION, never equal.
1030 If the optional third argument LIMIT is non-nil, don't search
1031 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1032 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1034 register INTERVAL i
, previous
;
1037 XSETBUFFER (object
, current_buffer
);
1040 CHECK_NUMBER_COERCE_MARKER (limit
);
1042 i
= validate_interval_range (object
, &position
, &position
, soft
);
1046 /* Start with the interval containing the char before point. */
1047 if (i
->position
== XFASTINT (position
))
1048 i
= previous_interval (i
);
1050 previous
= previous_interval (i
);
1051 while (previous
&& intervals_equal (previous
, i
)
1053 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1054 previous
= previous_interval (previous
);
1057 || (previous
->position
+ LENGTH (previous
)
1058 <= (INTEGERP (limit
)
1060 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1063 return make_number (previous
->position
+ LENGTH (previous
));
1066 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1067 Sprevious_single_property_change
, 2, 4, 0,
1068 doc
: /* Return the position of previous property change for a specific property.
1069 Scans characters backward from POSITION till it finds
1070 a change in the PROP property, then returns the position of the change.
1071 If the optional third argument OBJECT is a buffer (or nil, which means
1072 the current buffer), POSITION is a buffer position (integer or marker).
1073 If OBJECT is a string, POSITION is a 0-based index into it.
1074 The property values are compared with `eq'.
1075 Return nil if the property is constant all the way to the start of OBJECT.
1076 If the value is non-nil, it is a position less than POSITION, never equal.
1078 If the optional fourth argument LIMIT is non-nil, don't search
1079 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1080 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1082 register INTERVAL i
, previous
;
1083 register Lisp_Object here_val
;
1086 XSETBUFFER (object
, current_buffer
);
1089 CHECK_NUMBER_COERCE_MARKER (limit
);
1091 i
= validate_interval_range (object
, &position
, &position
, soft
);
1093 /* Start with the interval containing the char before point. */
1094 if (i
&& i
->position
== XFASTINT (position
))
1095 i
= previous_interval (i
);
1100 here_val
= textget (i
->plist
, prop
);
1101 previous
= previous_interval (i
);
1103 && EQ (here_val
, textget (previous
->plist
, prop
))
1105 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1106 previous
= previous_interval (previous
);
1109 || (previous
->position
+ LENGTH (previous
)
1110 <= (INTEGERP (limit
)
1112 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1115 return make_number (previous
->position
+ LENGTH (previous
));
1118 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1120 DEFUN ("add-text-properties", Fadd_text_properties
,
1121 Sadd_text_properties
, 3, 4, 0,
1122 doc
: /* Add properties to the text from START to END.
1123 The third argument PROPERTIES is a property list
1124 specifying the property values to add. If the optional fourth argument
1125 OBJECT is a buffer (or nil, which means the current buffer),
1126 START and END are buffer positions (integers or markers).
1127 If OBJECT is a string, START and END are 0-based indices into it.
1128 Return t if any property value actually changed, nil otherwise. */)
1129 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1131 register INTERVAL i
, unchanged
;
1132 register ptrdiff_t s
, len
;
1133 register int modified
= 0;
1134 struct gcpro gcpro1
;
1136 properties
= validate_plist (properties
);
1137 if (NILP (properties
))
1141 XSETBUFFER (object
, current_buffer
);
1143 i
= validate_interval_range (object
, &start
, &end
, hard
);
1148 len
= XINT (end
) - s
;
1150 /* No need to protect OBJECT, because we GC only if it's a buffer,
1151 and live buffers are always protected. */
1152 GCPRO1 (properties
);
1154 /* If we're not starting on an interval boundary, we have to
1155 split this interval. */
1156 if (i
->position
!= s
)
1158 /* If this interval already has the properties, we can
1160 if (interval_has_all_properties (properties
, i
))
1162 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1164 RETURN_UNGCPRO (Qnil
);
1166 i
= next_interval (i
);
1171 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1172 copy_properties (unchanged
, i
);
1176 if (BUFFERP (object
))
1177 modify_region (object
, start
, end
);
1179 /* We are at the beginning of interval I, with LEN chars to scan. */
1184 if (LENGTH (i
) >= len
)
1186 /* We can UNGCPRO safely here, because there will be just
1187 one more chance to gc, in the next call to add_properties,
1188 and after that we will not need PROPERTIES or OBJECT again. */
1191 if (interval_has_all_properties (properties
, i
))
1193 if (BUFFERP (object
))
1194 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1195 XINT (end
) - XINT (start
));
1197 return modified
? Qt
: Qnil
;
1200 if (LENGTH (i
) == len
)
1202 add_properties (properties
, i
, object
);
1203 if (BUFFERP (object
))
1204 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1205 XINT (end
) - XINT (start
));
1209 /* i doesn't have the properties, and goes past the change limit */
1211 i
= split_interval_left (unchanged
, len
);
1212 copy_properties (unchanged
, i
);
1213 add_properties (properties
, i
, object
);
1214 if (BUFFERP (object
))
1215 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1216 XINT (end
) - XINT (start
));
1221 modified
+= add_properties (properties
, i
, object
);
1222 i
= next_interval (i
);
1226 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1228 DEFUN ("put-text-property", Fput_text_property
,
1229 Sput_text_property
, 4, 5, 0,
1230 doc
: /* Set one property of the text from START to END.
1231 The third and fourth arguments PROPERTY and VALUE
1232 specify the property to add.
1233 If the optional fifth argument OBJECT is a buffer (or nil, which means
1234 the current buffer), START and END are buffer positions (integers or
1235 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1236 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1238 Fadd_text_properties (start
, end
,
1239 Fcons (property
, Fcons (value
, Qnil
)),
1244 DEFUN ("set-text-properties", Fset_text_properties
,
1245 Sset_text_properties
, 3, 4, 0,
1246 doc
: /* Completely replace properties of text from START to END.
1247 The third argument PROPERTIES is the new property list.
1248 If the optional fourth argument OBJECT is a buffer (or nil, which means
1249 the current buffer), START and END are buffer positions (integers or
1250 markers). If OBJECT is a string, START and END are 0-based indices into it.
1251 If PROPERTIES is nil, the effect is to remove all properties from
1252 the designated part of OBJECT. */)
1253 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1255 return set_text_properties (start
, end
, properties
, object
, Qt
);
1259 /* Replace properties of text from START to END with new list of
1260 properties PROPERTIES. OBJECT is the buffer or string containing
1261 the text. OBJECT nil means use the current buffer.
1262 COHERENT_CHANGE_P nil means this is being called as an internal
1263 subroutine, rather than as a change primitive with checking of
1264 read-only, invoking change hooks, etc.. Value is nil if the
1265 function _detected_ that it did not replace any properties, non-nil
1269 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1271 register INTERVAL i
;
1272 Lisp_Object ostart
, oend
;
1277 properties
= validate_plist (properties
);
1280 XSETBUFFER (object
, current_buffer
);
1282 /* If we want no properties for a whole string,
1283 get rid of its intervals. */
1284 if (NILP (properties
) && STRINGP (object
)
1285 && XFASTINT (start
) == 0
1286 && XFASTINT (end
) == SCHARS (object
))
1288 if (!string_intervals (object
))
1291 set_string_intervals (object
, NULL
);
1295 i
= validate_interval_range (object
, &start
, &end
, soft
);
1299 /* If buffer has no properties, and we want none, return now. */
1300 if (NILP (properties
))
1303 /* Restore the original START and END values
1304 because validate_interval_range increments them for strings. */
1308 i
= validate_interval_range (object
, &start
, &end
, hard
);
1309 /* This can return if start == end. */
1314 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1315 modify_region (object
, start
, end
);
1317 set_text_properties_1 (start
, end
, properties
, object
, i
);
1319 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1320 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1321 XINT (end
) - XINT (start
));
1325 /* Replace properties of text from START to END with new list of
1326 properties PROPERTIES. OBJECT is the buffer or string containing
1327 the text. This does not obey any hooks.
1328 You should provide the interval that START is located in as I.
1329 START and END can be in any order. */
1332 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, INTERVAL i
)
1334 register INTERVAL prev_changed
= NULL
;
1335 register ptrdiff_t s
, len
;
1338 if (XINT (start
) < XINT (end
))
1341 len
= XINT (end
) - s
;
1343 else if (XINT (end
) < XINT (start
))
1346 len
= XINT (start
) - s
;
1353 if (i
->position
!= s
)
1356 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1358 if (LENGTH (i
) > len
)
1360 copy_properties (unchanged
, i
);
1361 i
= split_interval_left (i
, len
);
1362 set_properties (properties
, i
, object
);
1366 set_properties (properties
, i
, object
);
1368 if (LENGTH (i
) == len
)
1373 i
= next_interval (i
);
1376 /* We are starting at the beginning of an interval I. LEN is positive. */
1381 if (LENGTH (i
) >= len
)
1383 if (LENGTH (i
) > len
)
1384 i
= split_interval_left (i
, len
);
1386 /* We have to call set_properties even if we are going to
1387 merge the intervals, so as to make the undo records
1388 and cause redisplay to happen. */
1389 set_properties (properties
, i
, object
);
1391 merge_interval_left (i
);
1397 /* We have to call set_properties even if we are going to
1398 merge the intervals, so as to make the undo records
1399 and cause redisplay to happen. */
1400 set_properties (properties
, i
, object
);
1404 prev_changed
= i
= merge_interval_left (i
);
1406 i
= next_interval (i
);
1411 DEFUN ("remove-text-properties", Fremove_text_properties
,
1412 Sremove_text_properties
, 3, 4, 0,
1413 doc
: /* Remove some properties from text from START to END.
1414 The third argument PROPERTIES is a property list
1415 whose property names specify the properties to remove.
1416 \(The values stored in PROPERTIES are ignored.)
1417 If the optional fourth argument OBJECT is a buffer (or nil, which means
1418 the current buffer), START and END are buffer positions (integers or
1419 markers). If OBJECT is a string, START and END are 0-based indices into it.
1420 Return t if any property was actually removed, nil otherwise.
1422 Use `set-text-properties' if you want to remove all text properties. */)
1423 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1425 register INTERVAL i
, unchanged
;
1426 register ptrdiff_t s
, len
;
1427 register int modified
= 0;
1430 XSETBUFFER (object
, current_buffer
);
1432 i
= validate_interval_range (object
, &start
, &end
, soft
);
1437 len
= XINT (end
) - s
;
1439 if (i
->position
!= s
)
1441 /* No properties on this first interval -- return if
1442 it covers the entire region. */
1443 if (! interval_has_some_properties (properties
, i
))
1445 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1449 i
= next_interval (i
);
1451 /* Split away the beginning of this interval; what we don't
1456 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1457 copy_properties (unchanged
, i
);
1461 if (BUFFERP (object
))
1462 modify_region (object
, start
, end
);
1464 /* We are at the beginning of an interval, with len to scan */
1469 if (LENGTH (i
) >= len
)
1471 if (! interval_has_some_properties (properties
, i
))
1472 return modified
? Qt
: Qnil
;
1474 if (LENGTH (i
) == len
)
1476 remove_properties (properties
, Qnil
, i
, object
);
1477 if (BUFFERP (object
))
1478 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1479 XINT (end
) - XINT (start
));
1483 /* i has the properties, and goes past the change limit */
1485 i
= split_interval_left (i
, len
);
1486 copy_properties (unchanged
, i
);
1487 remove_properties (properties
, Qnil
, i
, object
);
1488 if (BUFFERP (object
))
1489 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1490 XINT (end
) - XINT (start
));
1495 modified
+= remove_properties (properties
, Qnil
, i
, object
);
1496 i
= next_interval (i
);
1500 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties
,
1501 Sremove_list_of_text_properties
, 3, 4, 0,
1502 doc
: /* Remove some properties from text from START to END.
1503 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1504 If the optional fourth argument OBJECT is a buffer (or nil, which means
1505 the current buffer), START and END are buffer positions (integers or
1506 markers). If OBJECT is a string, START and END are 0-based indices into it.
1507 Return t if any property was actually removed, nil otherwise. */)
1508 (Lisp_Object start
, Lisp_Object end
, Lisp_Object list_of_properties
, Lisp_Object object
)
1510 register INTERVAL i
, unchanged
;
1511 register ptrdiff_t s
, len
;
1512 register int modified
= 0;
1513 Lisp_Object properties
;
1514 properties
= list_of_properties
;
1517 XSETBUFFER (object
, current_buffer
);
1519 i
= validate_interval_range (object
, &start
, &end
, soft
);
1524 len
= XINT (end
) - s
;
1526 if (i
->position
!= s
)
1528 /* No properties on this first interval -- return if
1529 it covers the entire region. */
1530 if (! interval_has_some_properties_list (properties
, i
))
1532 ptrdiff_t got
= (LENGTH (i
) - (s
- i
->position
));
1536 i
= next_interval (i
);
1538 /* Split away the beginning of this interval; what we don't
1543 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1544 copy_properties (unchanged
, i
);
1548 /* We are at the beginning of an interval, with len to scan.
1549 The flag `modified' records if changes have been made.
1550 When object is a buffer, we must call modify_region before changes are
1551 made and signal_after_change when we are done.
1552 We call modify_region before calling remove_properties if modified == 0,
1553 and we call signal_after_change before returning if modified != 0. */
1558 if (LENGTH (i
) >= len
)
1560 if (! interval_has_some_properties_list (properties
, i
))
1564 if (BUFFERP (object
))
1565 signal_after_change (XINT (start
),
1566 XINT (end
) - XINT (start
),
1567 XINT (end
) - XINT (start
));
1573 else if (LENGTH (i
) == len
)
1575 if (!modified
&& BUFFERP (object
))
1576 modify_region (object
, start
, end
);
1577 remove_properties (Qnil
, properties
, i
, object
);
1578 if (BUFFERP (object
))
1579 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1580 XINT (end
) - XINT (start
));
1584 { /* i has the properties, and goes past the change limit. */
1586 i
= split_interval_left (i
, len
);
1587 copy_properties (unchanged
, i
);
1588 if (!modified
&& BUFFERP (object
))
1589 modify_region (object
, start
, end
);
1590 remove_properties (Qnil
, properties
, i
, object
);
1591 if (BUFFERP (object
))
1592 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1593 XINT (end
) - XINT (start
));
1597 if (interval_has_some_properties_list (properties
, i
))
1599 if (!modified
&& BUFFERP (object
))
1600 modify_region (object
, start
, end
);
1601 remove_properties (Qnil
, properties
, i
, object
);
1605 i
= next_interval (i
);
1609 DEFUN ("text-property-any", Ftext_property_any
,
1610 Stext_property_any
, 4, 5, 0,
1611 doc
: /* Check text from START to END for property PROPERTY equaling VALUE.
1612 If so, return the position of the first character whose property PROPERTY
1613 is `eq' to VALUE. Otherwise return nil.
1614 If the optional fifth argument OBJECT is a buffer (or nil, which means
1615 the current buffer), START and END are buffer positions (integers or
1616 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1617 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1619 register INTERVAL i
;
1620 register ptrdiff_t e
, pos
;
1623 XSETBUFFER (object
, current_buffer
);
1624 i
= validate_interval_range (object
, &start
, &end
, soft
);
1626 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1631 if (i
->position
>= e
)
1633 if (EQ (textget (i
->plist
, property
), value
))
1636 if (pos
< XINT (start
))
1638 return make_number (pos
);
1640 i
= next_interval (i
);
1645 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1646 Stext_property_not_all
, 4, 5, 0,
1647 doc
: /* Check text from START to END for property PROPERTY not equaling VALUE.
1648 If so, return the position of the first character whose property PROPERTY
1649 is not `eq' to VALUE. Otherwise, return nil.
1650 If the optional fifth argument OBJECT is a buffer (or nil, which means
1651 the current buffer), START and END are buffer positions (integers or
1652 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1653 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1655 register INTERVAL i
;
1656 register ptrdiff_t s
, e
;
1659 XSETBUFFER (object
, current_buffer
);
1660 i
= validate_interval_range (object
, &start
, &end
, soft
);
1662 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1668 if (i
->position
>= e
)
1670 if (! EQ (textget (i
->plist
, property
), value
))
1672 if (i
->position
> s
)
1674 return make_number (s
);
1676 i
= next_interval (i
);
1682 /* Return the direction from which the text-property PROP would be
1683 inherited by any new text inserted at POS: 1 if it would be
1684 inherited from the char after POS, -1 if it would be inherited from
1685 the char before POS, and 0 if from neither.
1686 BUFFER can be either a buffer or nil (meaning current buffer). */
1689 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1691 Lisp_Object prev_pos
, front_sticky
;
1692 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1693 Lisp_Object defalt
= Fassq (prop
, Vtext_property_default_nonsticky
);
1696 XSETBUFFER (buffer
, current_buffer
);
1698 if (CONSP (defalt
) && !NILP (XCDR (defalt
)))
1701 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1702 /* Consider previous character. */
1704 Lisp_Object rear_non_sticky
;
1706 prev_pos
= make_number (XINT (pos
) - 1);
1707 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1709 if (!NILP (CONSP (rear_non_sticky
)
1710 ? Fmemq (prop
, rear_non_sticky
)
1712 /* PROP is rear-non-sticky. */
1718 /* Consider following character. */
1719 /* This signals an arg-out-of-range error if pos is outside the
1720 buffer's accessible range. */
1721 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1723 if (EQ (front_sticky
, Qt
)
1724 || (CONSP (front_sticky
)
1725 && !NILP (Fmemq (prop
, front_sticky
))))
1726 /* PROP is inherited from after. */
1727 is_front_sticky
= 1;
1729 /* Simple cases, where the properties are consistent. */
1730 if (is_rear_sticky
&& !is_front_sticky
)
1732 else if (!is_rear_sticky
&& is_front_sticky
)
1734 else if (!is_rear_sticky
&& !is_front_sticky
)
1737 /* The stickiness properties are inconsistent, so we have to
1738 disambiguate. Basically, rear-sticky wins, _except_ if the
1739 property that would be inherited has a value of nil, in which case
1740 front-sticky wins. */
1741 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1742 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1749 /* Copying properties between objects. */
1751 /* Add properties from START to END of SRC, starting at POS in DEST.
1752 SRC and DEST may each refer to strings or buffers.
1753 Optional sixth argument PROP causes only that property to be copied.
1754 Properties are copied to DEST as if by `add-text-properties'.
1755 Return t if any property value actually changed, nil otherwise. */
1757 /* Note this can GC when DEST is a buffer. */
1760 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1766 ptrdiff_t s
, e
, e2
, p
, len
;
1768 struct gcpro gcpro1
, gcpro2
;
1770 i
= validate_interval_range (src
, &start
, &end
, soft
);
1774 CHECK_NUMBER_COERCE_MARKER (pos
);
1776 Lisp_Object dest_start
, dest_end
;
1778 e
= XINT (pos
) + (XINT (end
) - XINT (start
));
1779 if (MOST_POSITIVE_FIXNUM
< e
)
1780 args_out_of_range (pos
, end
);
1782 XSETFASTINT (dest_end
, e
);
1783 /* Apply this to a copy of pos; it will try to increment its arguments,
1784 which we don't want. */
1785 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1796 e2
= i
->position
+ LENGTH (i
);
1803 while (! NILP (plist
))
1805 if (EQ (Fcar (plist
), prop
))
1807 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1810 plist
= Fcdr (Fcdr (plist
));
1814 /* Must defer modifications to the interval tree in case src
1815 and dest refer to the same string or buffer. */
1816 stuff
= Fcons (Fcons (make_number (p
),
1817 Fcons (make_number (p
+ len
),
1818 Fcons (plist
, Qnil
))),
1822 i
= next_interval (i
);
1830 GCPRO2 (stuff
, dest
);
1832 while (! NILP (stuff
))
1835 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1836 Fcar (Fcdr (Fcdr (res
))), dest
);
1839 stuff
= Fcdr (stuff
);
1844 return modified
? Qt
: Qnil
;
1848 /* Return a list representing the text properties of OBJECT between
1849 START and END. if PROP is non-nil, report only on that property.
1850 Each result list element has the form (S E PLIST), where S and E
1851 are positions in OBJECT and PLIST is a property list containing the
1852 text properties of OBJECT between S and E. Value is nil if OBJECT
1853 doesn't contain text properties between START and END. */
1856 text_property_list (Lisp_Object object
, Lisp_Object start
, Lisp_Object end
, Lisp_Object prop
)
1863 i
= validate_interval_range (object
, &start
, &end
, soft
);
1866 ptrdiff_t s
= XINT (start
);
1867 ptrdiff_t e
= XINT (end
);
1871 ptrdiff_t interval_end
, len
;
1874 interval_end
= i
->position
+ LENGTH (i
);
1875 if (interval_end
> e
)
1877 len
= interval_end
- s
;
1882 for (; CONSP (plist
); plist
= Fcdr (XCDR (plist
)))
1883 if (EQ (XCAR (plist
), prop
))
1885 plist
= Fcons (prop
, Fcons (Fcar (XCDR (plist
)), Qnil
));
1890 result
= Fcons (Fcons (make_number (s
),
1891 Fcons (make_number (s
+ len
),
1892 Fcons (plist
, Qnil
))),
1895 i
= next_interval (i
);
1906 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1907 (START END PLIST), where START and END are positions and PLIST is a
1908 property list containing the text properties to add. Adjust START
1909 and END positions by DELTA before adding properties. Value is
1910 non-zero if OBJECT was modified. */
1913 add_text_properties_from_list (Lisp_Object object
, Lisp_Object list
, Lisp_Object delta
)
1915 struct gcpro gcpro1
, gcpro2
;
1918 GCPRO2 (list
, object
);
1920 for (; CONSP (list
); list
= XCDR (list
))
1922 Lisp_Object item
, start
, end
, plist
, tem
;
1925 start
= make_number (XINT (XCAR (item
)) + XINT (delta
));
1926 end
= make_number (XINT (XCAR (XCDR (item
))) + XINT (delta
));
1927 plist
= XCAR (XCDR (XCDR (item
)));
1929 tem
= Fadd_text_properties (start
, end
, plist
, object
);
1940 /* Modify end-points of ranges in LIST destructively, and return the
1941 new list. LIST is a list as returned from text_property_list.
1942 Discard properties that begin at or after NEW_END, and limit
1943 end-points to NEW_END. */
1946 extend_property_ranges (Lisp_Object list
, Lisp_Object new_end
)
1948 Lisp_Object prev
= Qnil
, head
= list
;
1949 ptrdiff_t max
= XINT (new_end
);
1951 for (; CONSP (list
); prev
= list
, list
= XCDR (list
))
1953 Lisp_Object item
, beg
, end
;
1957 end
= XCAR (XCDR (item
));
1959 if (XINT (beg
) >= max
)
1961 /* The start-point is past the end of the new string.
1962 Discard this property. */
1963 if (EQ (head
, list
))
1966 XSETCDR (prev
, XCDR (list
));
1968 else if (XINT (end
) > max
)
1969 /* The end-point is past the end of the new string. */
1970 XSETCAR (XCDR (item
), new_end
);
1978 /* Call the modification hook functions in LIST, each with START and END. */
1981 call_mod_hooks (Lisp_Object list
, Lisp_Object start
, Lisp_Object end
)
1983 struct gcpro gcpro1
;
1985 while (!NILP (list
))
1987 call2 (Fcar (list
), start
, end
);
1993 /* Check for read-only intervals between character positions START ... END,
1994 in BUF, and signal an error if we find one.
1996 Then check for any modification hooks in the range.
1997 Create a list of all these hooks in lexicographic order,
1998 eliminating consecutive extra copies of the same hook. Then call
1999 those hooks in order, with START and END - 1 as arguments. */
2002 verify_interval_modification (struct buffer
*buf
,
2003 ptrdiff_t start
, ptrdiff_t end
)
2005 INTERVAL intervals
= buffer_intervals (buf
);
2008 Lisp_Object prev_mod_hooks
;
2009 Lisp_Object mod_hooks
;
2010 struct gcpro gcpro1
;
2013 prev_mod_hooks
= Qnil
;
2016 interval_insert_behind_hooks
= Qnil
;
2017 interval_insert_in_front_hooks
= Qnil
;
2024 ptrdiff_t temp
= start
;
2029 /* For an insert operation, check the two chars around the position. */
2032 INTERVAL prev
= NULL
;
2033 Lisp_Object before
, after
;
2035 /* Set I to the interval containing the char after START,
2036 and PREV to the interval containing the char before START.
2037 Either one may be null. They may be equal. */
2038 i
= find_interval (intervals
, start
);
2040 if (start
== BUF_BEGV (buf
))
2042 else if (i
->position
== start
)
2043 prev
= previous_interval (i
);
2044 else if (i
->position
< start
)
2046 if (start
== BUF_ZV (buf
))
2049 /* If Vinhibit_read_only is set and is not a list, we can
2050 skip the read_only checks. */
2051 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2053 /* If I and PREV differ we need to check for the read-only
2054 property together with its stickiness. If either I or
2055 PREV are 0, this check is all we need.
2056 We have to take special care, since read-only may be
2057 indirectly defined via the category property. */
2062 after
= textget (i
->plist
, Qread_only
);
2064 /* If interval I is read-only and read-only is
2065 front-sticky, inhibit insertion.
2066 Check for read-only as well as category. */
2068 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2072 tem
= textget (i
->plist
, Qfront_sticky
);
2073 if (TMEM (Qread_only
, tem
)
2074 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2075 && TMEM (Qcategory
, tem
)))
2076 text_read_only (after
);
2082 before
= textget (prev
->plist
, Qread_only
);
2084 /* If interval PREV is read-only and read-only isn't
2085 rear-nonsticky, inhibit insertion.
2086 Check for read-only as well as category. */
2088 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2092 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2093 if (! TMEM (Qread_only
, tem
)
2094 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2095 || ! TMEM (Qcategory
, tem
)))
2096 text_read_only (before
);
2102 after
= textget (i
->plist
, Qread_only
);
2104 /* If interval I is read-only and read-only is
2105 front-sticky, inhibit insertion.
2106 Check for read-only as well as category. */
2107 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2111 tem
= textget (i
->plist
, Qfront_sticky
);
2112 if (TMEM (Qread_only
, tem
)
2113 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2114 && TMEM (Qcategory
, tem
)))
2115 text_read_only (after
);
2117 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2118 if (! TMEM (Qread_only
, tem
)
2119 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2120 || ! TMEM (Qcategory
, tem
)))
2121 text_read_only (after
);
2126 /* Run both insert hooks (just once if they're the same). */
2128 interval_insert_behind_hooks
2129 = textget (prev
->plist
, Qinsert_behind_hooks
);
2131 interval_insert_in_front_hooks
2132 = textget (i
->plist
, Qinsert_in_front_hooks
);
2136 /* Loop over intervals on or next to START...END,
2137 collecting their hooks. */
2139 i
= find_interval (intervals
, start
);
2142 if (! INTERVAL_WRITABLE_P (i
))
2143 text_read_only (textget (i
->plist
, Qread_only
));
2145 if (!inhibit_modification_hooks
)
2147 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2148 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2150 hooks
= Fcons (mod_hooks
, hooks
);
2151 prev_mod_hooks
= mod_hooks
;
2155 i
= next_interval (i
);
2157 /* Keep going thru the interval containing the char before END. */
2158 while (i
&& i
->position
< end
);
2160 if (!inhibit_modification_hooks
)
2163 hooks
= Fnreverse (hooks
);
2164 while (! EQ (hooks
, Qnil
))
2166 call_mod_hooks (Fcar (hooks
), make_number (start
),
2168 hooks
= Fcdr (hooks
);
2175 /* Run the interval hooks for an insertion on character range START ... END.
2176 verify_interval_modification chose which hooks to run;
2177 this function is called after the insertion happens
2178 so it can indicate the range of inserted text. */
2181 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2183 if (! NILP (interval_insert_behind_hooks
))
2184 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2185 if (! NILP (interval_insert_in_front_hooks
)
2186 && ! EQ (interval_insert_in_front_hooks
,
2187 interval_insert_behind_hooks
))
2188 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2192 syms_of_textprop (void)
2194 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2195 doc
: /* Property-list used as default values.
2196 The value of a property in this list is seen as the value for every
2197 character that does not have its own value for that property. */);
2198 Vdefault_text_properties
= Qnil
;
2200 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2201 doc
: /* Alist of alternative properties for properties without a value.
2202 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2203 If a piece of text has no direct value for a particular property, then
2204 this alist is consulted. If that property appears in the alist, then
2205 the first non-nil value from the associated alternative properties is
2207 Vchar_property_alias_alist
= Qnil
;
2209 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2210 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2211 This also inhibits the use of the `intangible' text property. */);
2212 Vinhibit_point_motion_hooks
= Qnil
;
2214 DEFVAR_LISP ("text-property-default-nonsticky",
2215 Vtext_property_default_nonsticky
,
2216 doc
: /* Alist of properties vs the corresponding non-stickiness.
2217 Each element has the form (PROPERTY . NONSTICKINESS).
2219 If a character in a buffer has PROPERTY, new text inserted adjacent to
2220 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2221 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2222 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2223 /* Text properties `syntax-table'and `display' should be nonsticky
2225 Vtext_property_default_nonsticky
2226 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
),
2227 Fcons (Fcons (intern_c_string ("display"), Qt
), Qnil
));
2229 staticpro (&interval_insert_behind_hooks
);
2230 staticpro (&interval_insert_in_front_hooks
);
2231 interval_insert_behind_hooks
= Qnil
;
2232 interval_insert_in_front_hooks
= Qnil
;
2235 /* Common attributes one might give text */
2237 DEFSYM (Qforeground
, "foreground");
2238 DEFSYM (Qbackground
, "background");
2239 DEFSYM (Qfont
, "font");
2240 DEFSYM (Qstipple
, "stipple");
2241 DEFSYM (Qunderline
, "underline");
2242 DEFSYM (Qread_only
, "read-only");
2243 DEFSYM (Qinvisible
, "invisible");
2244 DEFSYM (Qintangible
, "intangible");
2245 DEFSYM (Qcategory
, "category");
2246 DEFSYM (Qlocal_map
, "local-map");
2247 DEFSYM (Qfront_sticky
, "front-sticky");
2248 DEFSYM (Qrear_nonsticky
, "rear-nonsticky");
2249 DEFSYM (Qmouse_face
, "mouse-face");
2250 DEFSYM (Qminibuffer_prompt
, "minibuffer-prompt");
2252 /* Properties that text might use to specify certain actions */
2254 DEFSYM (Qmouse_left
, "mouse-left");
2255 DEFSYM (Qmouse_entered
, "mouse-entered");
2256 DEFSYM (Qpoint_left
, "point-left");
2257 DEFSYM (Qpoint_entered
, "point-entered");
2259 defsubr (&Stext_properties_at
);
2260 defsubr (&Sget_text_property
);
2261 defsubr (&Sget_char_property
);
2262 defsubr (&Sget_char_property_and_overlay
);
2263 defsubr (&Snext_char_property_change
);
2264 defsubr (&Sprevious_char_property_change
);
2265 defsubr (&Snext_single_char_property_change
);
2266 defsubr (&Sprevious_single_char_property_change
);
2267 defsubr (&Snext_property_change
);
2268 defsubr (&Snext_single_property_change
);
2269 defsubr (&Sprevious_property_change
);
2270 defsubr (&Sprevious_single_property_change
);
2271 defsubr (&Sadd_text_properties
);
2272 defsubr (&Sput_text_property
);
2273 defsubr (&Sset_text_properties
);
2274 defsubr (&Sremove_text_properties
);
2275 defsubr (&Sremove_list_of_text_properties
);
2276 defsubr (&Stext_property_any
);
2277 defsubr (&Stext_property_not_all
);