1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include "intervals.h"
27 #define NULL (void *)0
30 /* Test for membership, allowing for t (actually any non-cons) to mean the
33 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
36 /* NOTES: previous- and next- property change will have to skip
37 zero-length intervals if they are implemented. This could be done
38 inside next_interval and previous_interval.
40 set_properties needs to deal with the interval property cache.
42 It is assumed that for any interval plist, a property appears
43 only once on the list. Although some code i.e., remove_properties,
44 handles the more general case, the uniqueness of properties is
45 necessary for the system to remain consistent. This requirement
46 is enforced by the subrs installing properties onto the intervals. */
50 Lisp_Object Qmouse_left
;
51 Lisp_Object Qmouse_entered
;
52 Lisp_Object Qpoint_left
;
53 Lisp_Object Qpoint_entered
;
54 Lisp_Object Qcategory
;
55 Lisp_Object Qlocal_map
;
57 /* Visual properties text (including strings) may have. */
58 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
59 Lisp_Object Qinvisible
, Qread_only
, Qintangible
, Qmouse_face
;
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 Lisp_Object interval_insert_behind_hooks
;
73 Lisp_Object interval_insert_in_front_hooks
;
75 static void text_read_only (Lisp_Object
) NO_RETURN
;
78 /* Signal a `text-read-only' error. This function makes it easier
79 to capture that error in GDB by putting a breakpoint on it. */
82 text_read_only (Lisp_Object propval
)
84 if (STRINGP (propval
))
85 xsignal1 (Qtext_read_only
, propval
);
87 xsignal0 (Qtext_read_only
);
92 /* Extract the interval at the position pointed to by BEGIN from
93 OBJECT, a string or buffer. Additionally, check that the positions
94 pointed to by BEGIN and END are within the bounds of OBJECT, and
95 reverse them if *BEGIN is greater than *END. The objects pointed
96 to by BEGIN and END may be integers or markers; if the latter, they
97 are coerced to integers.
99 When OBJECT is a string, we increment *BEGIN and *END
100 to make them origin-one.
102 Note that buffer points don't correspond to interval indices.
103 For example, point-max is 1 greater than the index of the last
104 character. This difference is handled in the caller, which uses
105 the validated points to determine a length, and operates on that.
106 Exceptions are Ftext_properties_at, Fnext_property_change, and
107 Fprevious_property_change which call this function with BEGIN == END.
108 Handle this case specially.
110 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
111 create an interval tree for OBJECT if one doesn't exist, provided
112 the object actually contains text. In the current design, if there
113 is no text, there can be no text properties. */
119 validate_interval_range (Lisp_Object object
, Lisp_Object
*begin
, Lisp_Object
*end
, int force
)
124 CHECK_STRING_OR_BUFFER (object
);
125 CHECK_NUMBER_COERCE_MARKER (*begin
);
126 CHECK_NUMBER_COERCE_MARKER (*end
);
128 /* If we are asked for a point, but from a subr which operates
129 on a range, then return nothing. */
130 if (EQ (*begin
, *end
) && begin
!= end
)
131 return NULL_INTERVAL
;
133 if (XINT (*begin
) > XINT (*end
))
141 if (BUFFERP (object
))
143 register struct buffer
*b
= XBUFFER (object
);
145 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
146 && XINT (*end
) <= BUF_ZV (b
)))
147 args_out_of_range (*begin
, *end
);
148 i
= BUF_INTERVALS (b
);
150 /* If there's no text, there are no properties. */
151 if (BUF_BEGV (b
) == BUF_ZV (b
))
152 return NULL_INTERVAL
;
154 searchpos
= XINT (*begin
);
158 EMACS_INT len
= SCHARS (object
);
160 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
161 && XINT (*end
) <= len
))
162 args_out_of_range (*begin
, *end
);
163 XSETFASTINT (*begin
, XFASTINT (*begin
));
165 XSETFASTINT (*end
, XFASTINT (*end
));
166 i
= STRING_INTERVALS (object
);
169 return NULL_INTERVAL
;
171 searchpos
= XINT (*begin
);
174 if (NULL_INTERVAL_P (i
))
175 return (force
? create_root_interval (object
) : i
);
177 return find_interval (i
, searchpos
);
180 /* Validate LIST as a property list. If LIST is not a list, then
181 make one consisting of (LIST nil). Otherwise, verify that LIST
182 is even numbered and thus suitable as a plist. */
185 validate_plist (Lisp_Object list
)
193 register Lisp_Object tail
;
194 for (i
= 0, tail
= list
; CONSP (tail
); i
++)
200 error ("Odd length text property list");
204 return Fcons (list
, Fcons (Qnil
, Qnil
));
207 /* Return nonzero if interval I has all the properties,
208 with the same values, of list PLIST. */
211 interval_has_all_properties (Lisp_Object plist
, INTERVAL i
)
213 register Lisp_Object tail1
, tail2
, sym1
;
216 /* Go through each element of PLIST. */
217 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
222 /* Go through I's plist, looking for sym1 */
223 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
224 if (EQ (sym1
, XCAR (tail2
)))
226 /* Found the same property on both lists. If the
227 values are unequal, return zero. */
228 if (! EQ (Fcar (XCDR (tail1
)), Fcar (XCDR (tail2
))))
231 /* Property has same value on both lists; go to next one. */
243 /* Return nonzero if the plist of interval I has any of the
244 properties of PLIST, regardless of their values. */
247 interval_has_some_properties (Lisp_Object plist
, INTERVAL i
)
249 register Lisp_Object tail1
, tail2
, sym
;
251 /* Go through each element of PLIST. */
252 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
256 /* Go through i's plist, looking for tail1 */
257 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
258 if (EQ (sym
, XCAR (tail2
)))
265 /* Return nonzero if the plist of interval I has any of the
266 property names in LIST, regardless of their values. */
269 interval_has_some_properties_list (Lisp_Object list
, INTERVAL i
)
271 register Lisp_Object tail1
, tail2
, sym
;
273 /* Go through each element of LIST. */
274 for (tail1
= list
; CONSP (tail1
); tail1
= XCDR (tail1
))
278 /* Go through i's plist, looking for tail1 */
279 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= XCDR (XCDR (tail2
)))
280 if (EQ (sym
, XCAR (tail2
)))
287 /* Changing the plists of individual intervals. */
289 /* Return the value of PROP in property-list PLIST, or Qunbound if it
292 property_value (Lisp_Object plist
, Lisp_Object prop
)
296 while (PLIST_ELT_P (plist
, value
))
297 if (EQ (XCAR (plist
), prop
))
300 plist
= XCDR (value
);
305 /* Set the properties of INTERVAL to PROPERTIES,
306 and record undo info for the previous values.
307 OBJECT is the string or buffer that INTERVAL belongs to. */
310 set_properties (Lisp_Object properties
, INTERVAL interval
, Lisp_Object object
)
312 Lisp_Object sym
, value
;
314 if (BUFFERP (object
))
316 /* For each property in the old plist which is missing from PROPERTIES,
317 or has a different value in PROPERTIES, make an undo record. */
318 for (sym
= interval
->plist
;
319 PLIST_ELT_P (sym
, value
);
321 if (! EQ (property_value (properties
, XCAR (sym
)),
324 record_property_change (interval
->position
, LENGTH (interval
),
325 XCAR (sym
), XCAR (value
),
329 /* For each new property that has no value at all in the old plist,
330 make an undo record binding it to nil, so it will be removed. */
331 for (sym
= properties
;
332 PLIST_ELT_P (sym
, value
);
334 if (EQ (property_value (interval
->plist
, XCAR (sym
)), Qunbound
))
336 record_property_change (interval
->position
, LENGTH (interval
),
342 /* Store new properties. */
343 interval
->plist
= Fcopy_sequence (properties
);
346 /* Add the properties of PLIST to the interval I, or set
347 the value of I's property to the value of the property on PLIST
348 if they are different.
350 OBJECT should be the string or buffer the interval is in.
352 Return nonzero if this changes I (i.e., if any members of PLIST
353 are actually added to I's plist) */
356 add_properties (Lisp_Object plist
, INTERVAL i
, Lisp_Object object
)
358 Lisp_Object tail1
, tail2
, sym1
, val1
;
359 register int changed
= 0;
361 struct gcpro gcpro1
, gcpro2
, gcpro3
;
366 /* No need to protect OBJECT, because we can GC only in the case
367 where it is a buffer, and live buffers are always protected.
368 I and its plist are also protected, via OBJECT. */
369 GCPRO3 (tail1
, sym1
, val1
);
371 /* Go through each element of PLIST. */
372 for (tail1
= plist
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
375 val1
= Fcar (XCDR (tail1
));
378 /* Go through I's plist, looking for sym1 */
379 for (tail2
= i
->plist
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
380 if (EQ (sym1
, XCAR (tail2
)))
382 /* No need to gcpro, because tail2 protects this
383 and it must be a cons cell (we get an error otherwise). */
384 register Lisp_Object this_cdr
;
386 this_cdr
= XCDR (tail2
);
387 /* Found the property. Now check its value. */
390 /* The properties have the same value on both lists.
391 Continue to the next property. */
392 if (EQ (val1
, Fcar (this_cdr
)))
395 /* Record this change in the buffer, for undo purposes. */
396 if (BUFFERP (object
))
398 record_property_change (i
->position
, LENGTH (i
),
399 sym1
, Fcar (this_cdr
), object
);
402 /* I's property has a different value -- change it */
403 Fsetcar (this_cdr
, val1
);
410 /* Record this change in the buffer, for undo purposes. */
411 if (BUFFERP (object
))
413 record_property_change (i
->position
, LENGTH (i
),
416 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
426 /* For any members of PLIST, or LIST,
427 which are properties of I, remove them from I's plist.
428 (If PLIST is non-nil, use that, otherwise use LIST.)
429 OBJECT is the string or buffer containing I. */
432 remove_properties (Lisp_Object plist
, Lisp_Object list
, INTERVAL i
, Lisp_Object object
)
434 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
435 register int changed
= 0;
437 /* Nonzero means tail1 is a plist, otherwise it is a list. */
440 current_plist
= i
->plist
;
443 tail1
= plist
, use_plist
= 1;
445 tail1
= list
, use_plist
= 0;
447 /* Go through each element of LIST or PLIST. */
448 while (CONSP (tail1
))
452 /* First, remove the symbol if it's at the head of the list */
453 while (CONSP (current_plist
) && EQ (sym
, XCAR (current_plist
)))
455 if (BUFFERP (object
))
456 record_property_change (i
->position
, LENGTH (i
),
457 sym
, XCAR (XCDR (current_plist
)),
460 current_plist
= XCDR (XCDR (current_plist
));
464 /* Go through I's plist, looking for SYM. */
465 tail2
= current_plist
;
466 while (! NILP (tail2
))
468 register Lisp_Object
this;
469 this = XCDR (XCDR (tail2
));
470 if (CONSP (this) && EQ (sym
, XCAR (this)))
472 if (BUFFERP (object
))
473 record_property_change (i
->position
, LENGTH (i
),
474 sym
, XCAR (XCDR (this)), object
);
476 Fsetcdr (XCDR (tail2
), XCDR (XCDR (this)));
482 /* Advance thru TAIL1 one way or the other. */
483 tail1
= XCDR (tail1
);
484 if (use_plist
&& CONSP (tail1
))
485 tail1
= XCDR (tail1
);
489 i
->plist
= current_plist
;
494 /* Remove all properties from interval I. Return non-zero
495 if this changes the interval. */
498 erase_properties (INTERVAL i
)
508 /* Returns the interval of POSITION in OBJECT.
509 POSITION is BEG-based. */
512 interval_of (int position
, Lisp_Object object
)
518 XSETBUFFER (object
, current_buffer
);
519 else if (EQ (object
, Qt
))
520 return NULL_INTERVAL
;
522 CHECK_STRING_OR_BUFFER (object
);
524 if (BUFFERP (object
))
526 register struct buffer
*b
= XBUFFER (object
);
530 i
= BUF_INTERVALS (b
);
535 end
= SCHARS (object
);
536 i
= STRING_INTERVALS (object
);
539 if (!(beg
<= position
&& position
<= end
))
540 args_out_of_range (make_number (position
), make_number (position
));
541 if (beg
== end
|| NULL_INTERVAL_P (i
))
542 return NULL_INTERVAL
;
544 return find_interval (i
, position
);
547 DEFUN ("text-properties-at", Ftext_properties_at
,
548 Stext_properties_at
, 1, 2, 0,
549 doc
: /* Return the list of properties of the character at POSITION in OBJECT.
550 If the optional second argument OBJECT is a buffer (or nil, which means
551 the current buffer), POSITION is a buffer position (integer or marker).
552 If OBJECT is a string, POSITION is a 0-based index into it.
553 If POSITION is at the end of OBJECT, the value is nil. */)
554 (Lisp_Object position
, Lisp_Object object
)
559 XSETBUFFER (object
, current_buffer
);
561 i
= validate_interval_range (object
, &position
, &position
, soft
);
562 if (NULL_INTERVAL_P (i
))
564 /* If POSITION is at the end of the interval,
565 it means it's the end of OBJECT.
566 There are no properties at the very end,
567 since no character follows. */
568 if (XINT (position
) == LENGTH (i
) + i
->position
)
574 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
575 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
576 OBJECT is optional and defaults to the current buffer.
577 If POSITION is at the end of OBJECT, the value is nil. */)
578 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
580 return textget (Ftext_properties_at (position
, object
), prop
);
583 /* Return the value of char's property PROP, in OBJECT at POSITION.
584 OBJECT is optional and defaults to the current buffer.
585 If OVERLAY is non-0, then in the case that the returned property is from
586 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
587 returned in *OVERLAY.
588 If POSITION is at the end of OBJECT, the value is nil.
589 If OBJECT is a buffer, then overlay properties are considered as well as
591 If OBJECT is a window, then that window's buffer is used, but
592 window-specific overlays are considered only if they are associated
595 get_char_property_and_overlay (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
, Lisp_Object
*overlay
)
597 struct window
*w
= 0;
599 CHECK_NUMBER_COERCE_MARKER (position
);
602 XSETBUFFER (object
, current_buffer
);
604 if (WINDOWP (object
))
606 w
= XWINDOW (object
);
609 if (BUFFERP (object
))
612 Lisp_Object
*overlay_vec
;
613 struct buffer
*obuf
= current_buffer
;
615 if (XINT (position
) < BUF_BEGV (XBUFFER (object
))
616 || XINT (position
) > BUF_ZV (XBUFFER (object
)))
617 xsignal1 (Qargs_out_of_range
, position
);
619 set_buffer_temp (XBUFFER (object
));
621 GET_OVERLAYS_AT (XINT (position
), overlay_vec
, noverlays
, NULL
, 0);
622 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
624 set_buffer_temp (obuf
);
626 /* Now check the overlays in order of decreasing priority. */
627 while (--noverlays
>= 0)
629 Lisp_Object tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
633 /* Return the overlay we got the property from. */
634 *overlay
= overlay_vec
[noverlays
];
641 /* Indicate that the return value is not from an overlay. */
644 /* Not a buffer, or no appropriate overlay, so fall through to the
646 return Fget_text_property (position
, prop
, object
);
649 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
650 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
651 Both overlay properties and text properties are checked.
652 OBJECT is optional and defaults to the current buffer.
653 If POSITION is at the end of OBJECT, the value is nil.
654 If OBJECT is a buffer, then overlay properties are considered as well as
656 If OBJECT is a window, then that window's buffer is used, but window-specific
657 overlays are considered only if they are associated with OBJECT. */)
658 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
660 return get_char_property_and_overlay (position
, prop
, object
, 0);
663 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay
,
664 Sget_char_property_and_overlay
, 2, 3, 0,
665 doc
: /* Like `get-char-property', but with extra overlay information.
666 The value is a cons cell. Its car is the return value of `get-char-property'
667 with the same arguments--that is, the value of POSITION's property
668 PROP in OBJECT. Its cdr is the overlay in which the property was
669 found, or nil, if it was found as a text property or not found at all.
671 OBJECT is optional and defaults to the current buffer. OBJECT may be
672 a string, a buffer or a window. For strings, the cdr of the return
673 value is always nil, since strings do not have overlays. If OBJECT is
674 a window, then that window's buffer is used, but window-specific
675 overlays are considered only if they are associated with OBJECT. If
676 POSITION is at the end of OBJECT, both car and cdr are nil. */)
677 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
)
681 = get_char_property_and_overlay (position
, prop
, object
, &overlay
);
682 return Fcons (val
, overlay
);
686 DEFUN ("next-char-property-change", Fnext_char_property_change
,
687 Snext_char_property_change
, 1, 2, 0,
688 doc
: /* Return the position of next text property or overlay change.
689 This scans characters forward in the current buffer from POSITION till
690 it finds a change in some text property, or the beginning or end of an
691 overlay, and returns the position of that.
692 If none is found up to (point-max), the function returns (point-max).
694 If the optional second argument LIMIT is non-nil, don't search
695 past position LIMIT; return LIMIT if nothing is found before LIMIT.
696 LIMIT is a no-op if it is greater than (point-max). */)
697 (Lisp_Object position
, Lisp_Object limit
)
701 temp
= Fnext_overlay_change (position
);
704 CHECK_NUMBER_COERCE_MARKER (limit
);
705 if (XINT (limit
) < XINT (temp
))
708 return Fnext_property_change (position
, Qnil
, temp
);
711 DEFUN ("previous-char-property-change", Fprevious_char_property_change
,
712 Sprevious_char_property_change
, 1, 2, 0,
713 doc
: /* Return the position of previous text property or overlay change.
714 Scans characters backward in the current buffer from POSITION till it
715 finds a change in some text property, or the beginning or end of an
716 overlay, and returns the position of that.
717 If none is found since (point-min), the function returns (point-min).
719 If the optional second argument LIMIT is non-nil, don't search
720 past position LIMIT; return LIMIT if nothing is found before LIMIT.
721 LIMIT is a no-op if it is less than (point-min). */)
722 (Lisp_Object position
, Lisp_Object limit
)
726 temp
= Fprevious_overlay_change (position
);
729 CHECK_NUMBER_COERCE_MARKER (limit
);
730 if (XINT (limit
) > XINT (temp
))
733 return Fprevious_property_change (position
, Qnil
, temp
);
737 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change
,
738 Snext_single_char_property_change
, 2, 4, 0,
739 doc
: /* Return the position of next text property or overlay change for a specific property.
740 Scans characters forward from POSITION till it finds
741 a change in the PROP property, then returns the position of the change.
742 If the optional third argument OBJECT is a buffer (or nil, which means
743 the current buffer), POSITION is a buffer position (integer or marker).
744 If OBJECT is a string, POSITION is a 0-based index into it.
746 In a string, scan runs to the end of the string.
747 In a buffer, it runs to (point-max), and the value cannot exceed that.
749 The property values are compared with `eq'.
750 If the property is constant all the way to the end of OBJECT, return the
751 last valid position in OBJECT.
752 If the optional fourth argument LIMIT is non-nil, don't search
753 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
754 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
756 if (STRINGP (object
))
758 position
= Fnext_single_property_change (position
, prop
, object
, limit
);
762 position
= make_number (SCHARS (object
));
765 CHECK_NUMBER (limit
);
772 Lisp_Object initial_value
, value
;
773 int count
= SPECPDL_INDEX ();
776 CHECK_BUFFER (object
);
778 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
780 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
781 Fset_buffer (object
);
784 CHECK_NUMBER_COERCE_MARKER (position
);
786 initial_value
= Fget_char_property (position
, prop
, object
);
789 XSETFASTINT (limit
, ZV
);
791 CHECK_NUMBER_COERCE_MARKER (limit
);
793 if (XFASTINT (position
) >= XFASTINT (limit
))
796 if (XFASTINT (position
) > ZV
)
797 XSETFASTINT (position
, ZV
);
802 position
= Fnext_char_property_change (position
, limit
);
803 if (XFASTINT (position
) >= XFASTINT (limit
))
809 value
= Fget_char_property (position
, prop
, object
);
810 if (!EQ (value
, initial_value
))
814 unbind_to (count
, Qnil
);
820 DEFUN ("previous-single-char-property-change",
821 Fprevious_single_char_property_change
,
822 Sprevious_single_char_property_change
, 2, 4, 0,
823 doc
: /* Return the position of previous text property or overlay change for a specific property.
824 Scans characters backward from POSITION till it finds
825 a change in the PROP property, then returns the position of the change.
826 If the optional third argument OBJECT is a buffer (or nil, which means
827 the current buffer), POSITION is a buffer position (integer or marker).
828 If OBJECT is a string, POSITION is a 0-based index into it.
830 In a string, scan runs to the start of the string.
831 In a buffer, it runs to (point-min), and the value cannot be less than that.
833 The property values are compared with `eq'.
834 If the property is constant all the way to the start of OBJECT, return the
835 first valid position in OBJECT.
836 If the optional fourth argument LIMIT is non-nil, don't search
837 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
838 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
840 if (STRINGP (object
))
842 position
= Fprevious_single_property_change (position
, prop
, object
, limit
);
846 position
= make_number (0);
849 CHECK_NUMBER (limit
);
856 int count
= SPECPDL_INDEX ();
859 CHECK_BUFFER (object
);
861 if (BUFFERP (object
) && current_buffer
!= XBUFFER (object
))
863 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
864 Fset_buffer (object
);
867 CHECK_NUMBER_COERCE_MARKER (position
);
870 XSETFASTINT (limit
, BEGV
);
872 CHECK_NUMBER_COERCE_MARKER (limit
);
874 if (XFASTINT (position
) <= XFASTINT (limit
))
877 if (XFASTINT (position
) < BEGV
)
878 XSETFASTINT (position
, BEGV
);
882 Lisp_Object initial_value
883 = Fget_char_property (make_number (XFASTINT (position
) - 1),
888 position
= Fprevious_char_property_change (position
, limit
);
890 if (XFASTINT (position
) <= XFASTINT (limit
))
898 = Fget_char_property (make_number (XFASTINT (position
) - 1),
901 if (!EQ (value
, initial_value
))
907 unbind_to (count
, Qnil
);
913 DEFUN ("next-property-change", Fnext_property_change
,
914 Snext_property_change
, 1, 3, 0,
915 doc
: /* Return the position of next property change.
916 Scans characters forward from POSITION in OBJECT till it finds
917 a change in some text property, then returns the position of the change.
918 If the optional second argument OBJECT is a buffer (or nil, which means
919 the current buffer), POSITION is a buffer position (integer or marker).
920 If OBJECT is a string, POSITION is a 0-based index into it.
921 Return nil if the property is constant all the way to the end of OBJECT.
922 If the value is non-nil, it is a position greater than POSITION, never equal.
924 If the optional third argument LIMIT is non-nil, don't search
925 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
926 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
928 register INTERVAL i
, next
;
931 XSETBUFFER (object
, current_buffer
);
933 if (!NILP (limit
) && !EQ (limit
, Qt
))
934 CHECK_NUMBER_COERCE_MARKER (limit
);
936 i
= validate_interval_range (object
, &position
, &position
, soft
);
938 /* If LIMIT is t, return start of next interval--don't
939 bother checking further intervals. */
942 if (NULL_INTERVAL_P (i
))
945 next
= next_interval (i
);
947 if (NULL_INTERVAL_P (next
))
948 XSETFASTINT (position
, (STRINGP (object
)
950 : BUF_ZV (XBUFFER (object
))));
952 XSETFASTINT (position
, next
->position
);
956 if (NULL_INTERVAL_P (i
))
959 next
= next_interval (i
);
961 while (!NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
962 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
963 next
= next_interval (next
);
965 if (NULL_INTERVAL_P (next
)
971 : BUF_ZV (XBUFFER (object
))))))
974 return make_number (next
->position
);
977 DEFUN ("next-single-property-change", Fnext_single_property_change
,
978 Snext_single_property_change
, 2, 4, 0,
979 doc
: /* Return the position of next property change for a specific property.
980 Scans characters forward from POSITION till it finds
981 a change in the PROP property, then returns the position of the change.
982 If the optional third argument OBJECT is a buffer (or nil, which means
983 the current buffer), POSITION is a buffer position (integer or marker).
984 If OBJECT is a string, POSITION is a 0-based index into it.
985 The property values are compared with `eq'.
986 Return nil if the property is constant all the way to the end of OBJECT.
987 If the value is non-nil, it is a position greater than POSITION, never equal.
989 If the optional fourth argument LIMIT is non-nil, don't search
990 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
991 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
993 register INTERVAL i
, next
;
994 register Lisp_Object here_val
;
997 XSETBUFFER (object
, current_buffer
);
1000 CHECK_NUMBER_COERCE_MARKER (limit
);
1002 i
= validate_interval_range (object
, &position
, &position
, soft
);
1003 if (NULL_INTERVAL_P (i
))
1006 here_val
= textget (i
->plist
, prop
);
1007 next
= next_interval (i
);
1008 while (! NULL_INTERVAL_P (next
)
1009 && EQ (here_val
, textget (next
->plist
, prop
))
1010 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
1011 next
= next_interval (next
);
1013 if (NULL_INTERVAL_P (next
)
1015 >= (INTEGERP (limit
)
1019 : BUF_ZV (XBUFFER (object
))))))
1022 return make_number (next
->position
);
1025 DEFUN ("previous-property-change", Fprevious_property_change
,
1026 Sprevious_property_change
, 1, 3, 0,
1027 doc
: /* Return the position of previous property change.
1028 Scans characters backwards from POSITION in OBJECT till it finds
1029 a change in some text property, then returns the position of the change.
1030 If the optional second argument OBJECT is a buffer (or nil, which means
1031 the current buffer), POSITION is a buffer position (integer or marker).
1032 If OBJECT is a string, POSITION is a 0-based index into it.
1033 Return nil if the property is constant all the way to the start of OBJECT.
1034 If the value is non-nil, it is a position less than POSITION, never equal.
1036 If the optional third argument LIMIT is non-nil, don't search
1037 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1038 (Lisp_Object position
, Lisp_Object object
, Lisp_Object limit
)
1040 register INTERVAL i
, previous
;
1043 XSETBUFFER (object
, current_buffer
);
1046 CHECK_NUMBER_COERCE_MARKER (limit
);
1048 i
= validate_interval_range (object
, &position
, &position
, soft
);
1049 if (NULL_INTERVAL_P (i
))
1052 /* Start with the interval containing the char before point. */
1053 if (i
->position
== XFASTINT (position
))
1054 i
= previous_interval (i
);
1056 previous
= previous_interval (i
);
1057 while (!NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
1059 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1060 previous
= previous_interval (previous
);
1062 if (NULL_INTERVAL_P (previous
)
1063 || (previous
->position
+ LENGTH (previous
)
1064 <= (INTEGERP (limit
)
1066 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1069 return make_number (previous
->position
+ LENGTH (previous
));
1072 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
1073 Sprevious_single_property_change
, 2, 4, 0,
1074 doc
: /* Return the position of previous property change for a specific property.
1075 Scans characters backward from POSITION till it finds
1076 a change in the PROP property, then returns the position of the change.
1077 If the optional third argument OBJECT is a buffer (or nil, which means
1078 the current buffer), POSITION is a buffer position (integer or marker).
1079 If OBJECT is a string, POSITION is a 0-based index into it.
1080 The property values are compared with `eq'.
1081 Return nil if the property is constant all the way to the start of OBJECT.
1082 If the value is non-nil, it is a position less than POSITION, never equal.
1084 If the optional fourth argument LIMIT is non-nil, don't search
1085 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1086 (Lisp_Object position
, Lisp_Object prop
, Lisp_Object object
, Lisp_Object limit
)
1088 register INTERVAL i
, previous
;
1089 register Lisp_Object here_val
;
1092 XSETBUFFER (object
, current_buffer
);
1095 CHECK_NUMBER_COERCE_MARKER (limit
);
1097 i
= validate_interval_range (object
, &position
, &position
, soft
);
1099 /* Start with the interval containing the char before point. */
1100 if (!NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (position
))
1101 i
= previous_interval (i
);
1103 if (NULL_INTERVAL_P (i
))
1106 here_val
= textget (i
->plist
, prop
);
1107 previous
= previous_interval (i
);
1108 while (!NULL_INTERVAL_P (previous
)
1109 && EQ (here_val
, textget (previous
->plist
, prop
))
1111 || (previous
->position
+ LENGTH (previous
) > XFASTINT (limit
))))
1112 previous
= previous_interval (previous
);
1114 if (NULL_INTERVAL_P (previous
)
1115 || (previous
->position
+ LENGTH (previous
)
1116 <= (INTEGERP (limit
)
1118 : (STRINGP (object
) ? 0 : BUF_BEGV (XBUFFER (object
))))))
1121 return make_number (previous
->position
+ LENGTH (previous
));
1124 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1126 DEFUN ("add-text-properties", Fadd_text_properties
,
1127 Sadd_text_properties
, 3, 4, 0,
1128 doc
: /* Add properties to the text from START to END.
1129 The third argument PROPERTIES is a property list
1130 specifying the property values to add. If the optional fourth argument
1131 OBJECT is a buffer (or nil, which means the current buffer),
1132 START and END are buffer positions (integers or markers).
1133 If OBJECT is a string, START and END are 0-based indices into it.
1134 Return t if any property value actually changed, nil otherwise. */)
1135 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1137 register INTERVAL i
, unchanged
;
1138 register EMACS_INT s
, len
;
1139 register int modified
= 0;
1140 struct gcpro gcpro1
;
1142 properties
= validate_plist (properties
);
1143 if (NILP (properties
))
1147 XSETBUFFER (object
, current_buffer
);
1149 i
= validate_interval_range (object
, &start
, &end
, hard
);
1150 if (NULL_INTERVAL_P (i
))
1154 len
= XINT (end
) - s
;
1156 /* No need to protect OBJECT, because we GC only if it's a buffer,
1157 and live buffers are always protected. */
1158 GCPRO1 (properties
);
1160 /* If we're not starting on an interval boundary, we have to
1161 split this interval. */
1162 if (i
->position
!= s
)
1164 /* If this interval already has the properties, we can
1166 if (interval_has_all_properties (properties
, i
))
1168 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1170 RETURN_UNGCPRO (Qnil
);
1172 i
= next_interval (i
);
1177 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1178 copy_properties (unchanged
, i
);
1182 if (BUFFERP (object
))
1183 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1185 /* We are at the beginning of interval I, with LEN chars to scan. */
1191 if (LENGTH (i
) >= len
)
1193 /* We can UNGCPRO safely here, because there will be just
1194 one more chance to gc, in the next call to add_properties,
1195 and after that we will not need PROPERTIES or OBJECT again. */
1198 if (interval_has_all_properties (properties
, i
))
1200 if (BUFFERP (object
))
1201 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1202 XINT (end
) - XINT (start
));
1204 return modified
? Qt
: Qnil
;
1207 if (LENGTH (i
) == len
)
1209 add_properties (properties
, i
, object
);
1210 if (BUFFERP (object
))
1211 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1212 XINT (end
) - XINT (start
));
1216 /* i doesn't have the properties, and goes past the change limit */
1218 i
= split_interval_left (unchanged
, len
);
1219 copy_properties (unchanged
, i
);
1220 add_properties (properties
, i
, object
);
1221 if (BUFFERP (object
))
1222 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1223 XINT (end
) - XINT (start
));
1228 modified
+= add_properties (properties
, i
, object
);
1229 i
= next_interval (i
);
1233 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1235 DEFUN ("put-text-property", Fput_text_property
,
1236 Sput_text_property
, 4, 5, 0,
1237 doc
: /* Set one property of the text from START to END.
1238 The third and fourth arguments PROPERTY and VALUE
1239 specify the property to add.
1240 If the optional fifth argument OBJECT is a buffer (or nil, which means
1241 the current buffer), START and END are buffer positions (integers or
1242 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1243 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1245 Fadd_text_properties (start
, end
,
1246 Fcons (property
, Fcons (value
, Qnil
)),
1251 DEFUN ("set-text-properties", Fset_text_properties
,
1252 Sset_text_properties
, 3, 4, 0,
1253 doc
: /* Completely replace properties of text from START to END.
1254 The third argument PROPERTIES is the new property list.
1255 If the optional fourth argument OBJECT is a buffer (or nil, which means
1256 the current buffer), START and END are buffer positions (integers or
1257 markers). If OBJECT is a string, START and END are 0-based indices into it.
1258 If PROPERTIES is nil, the effect is to remove all properties from
1259 the designated part of OBJECT. */)
1260 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1262 return set_text_properties (start
, end
, properties
, object
, Qt
);
1266 /* Replace properties of text from START to END with new list of
1267 properties PROPERTIES. OBJECT is the buffer or string containing
1268 the text. OBJECT nil means use the current buffer.
1269 COHERENT_CHANGE_P nil means this is being called as an internal
1270 subroutine, rather than as a change primitive with checking of
1271 read-only, invoking change hooks, etc.. Value is nil if the
1272 function _detected_ that it did not replace any properties, non-nil
1276 set_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
, Lisp_Object coherent_change_p
)
1278 register INTERVAL i
;
1279 Lisp_Object ostart
, oend
;
1284 properties
= validate_plist (properties
);
1287 XSETBUFFER (object
, current_buffer
);
1289 /* If we want no properties for a whole string,
1290 get rid of its intervals. */
1291 if (NILP (properties
) && STRINGP (object
)
1292 && XFASTINT (start
) == 0
1293 && XFASTINT (end
) == SCHARS (object
))
1295 if (! STRING_INTERVALS (object
))
1298 STRING_SET_INTERVALS (object
, NULL_INTERVAL
);
1302 i
= validate_interval_range (object
, &start
, &end
, soft
);
1304 if (NULL_INTERVAL_P (i
))
1306 /* If buffer has no properties, and we want none, return now. */
1307 if (NILP (properties
))
1310 /* Restore the original START and END values
1311 because validate_interval_range increments them for strings. */
1315 i
= validate_interval_range (object
, &start
, &end
, hard
);
1316 /* This can return if start == end. */
1317 if (NULL_INTERVAL_P (i
))
1321 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1322 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1324 set_text_properties_1 (start
, end
, properties
, object
, i
);
1326 if (BUFFERP (object
) && !NILP (coherent_change_p
))
1327 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1328 XINT (end
) - XINT (start
));
1332 /* Replace properties of text from START to END with new list of
1333 properties PROPERTIES. BUFFER is the buffer containing
1334 the text. This does not obey any hooks.
1335 You can provide the interval that START is located in as I,
1336 or pass NULL for I and this function will find it.
1337 START and END can be in any order. */
1340 set_text_properties_1 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object buffer
, INTERVAL i
)
1342 register INTERVAL prev_changed
= NULL_INTERVAL
;
1343 register EMACS_INT s
, len
;
1347 len
= XINT (end
) - s
;
1357 i
= find_interval (BUF_INTERVALS (XBUFFER (buffer
)), s
);
1359 if (i
->position
!= s
)
1362 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1364 if (LENGTH (i
) > len
)
1366 copy_properties (unchanged
, i
);
1367 i
= split_interval_left (i
, len
);
1368 set_properties (properties
, i
, buffer
);
1372 set_properties (properties
, i
, buffer
);
1374 if (LENGTH (i
) == len
)
1379 i
= next_interval (i
);
1382 /* We are starting at the beginning of an interval I. LEN is positive. */
1388 if (LENGTH (i
) >= len
)
1390 if (LENGTH (i
) > len
)
1391 i
= split_interval_left (i
, len
);
1393 /* We have to call set_properties even if we are going to
1394 merge the intervals, so as to make the undo records
1395 and cause redisplay to happen. */
1396 set_properties (properties
, i
, buffer
);
1397 if (!NULL_INTERVAL_P (prev_changed
))
1398 merge_interval_left (i
);
1404 /* We have to call set_properties even if we are going to
1405 merge the intervals, so as to make the undo records
1406 and cause redisplay to happen. */
1407 set_properties (properties
, i
, buffer
);
1408 if (NULL_INTERVAL_P (prev_changed
))
1411 prev_changed
= i
= merge_interval_left (i
);
1413 i
= next_interval (i
);
1418 DEFUN ("remove-text-properties", Fremove_text_properties
,
1419 Sremove_text_properties
, 3, 4, 0,
1420 doc
: /* Remove some properties from text from START to END.
1421 The third argument PROPERTIES is a property list
1422 whose property names specify the properties to remove.
1423 \(The values stored in PROPERTIES are ignored.)
1424 If the optional fourth argument OBJECT is a buffer (or nil, which means
1425 the current buffer), START and END are buffer positions (integers or
1426 markers). If OBJECT is a string, START and END are 0-based indices into it.
1427 Return t if any property was actually removed, nil otherwise.
1429 Use `set-text-properties' if you want to remove all text properties. */)
1430 (Lisp_Object start
, Lisp_Object end
, Lisp_Object properties
, Lisp_Object object
)
1432 register INTERVAL i
, unchanged
;
1433 register EMACS_INT s
, len
;
1434 register int modified
= 0;
1437 XSETBUFFER (object
, current_buffer
);
1439 i
= validate_interval_range (object
, &start
, &end
, soft
);
1440 if (NULL_INTERVAL_P (i
))
1444 len
= XINT (end
) - s
;
1446 if (i
->position
!= s
)
1448 /* No properties on this first interval -- return if
1449 it covers the entire region. */
1450 if (! interval_has_some_properties (properties
, i
))
1452 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1456 i
= next_interval (i
);
1458 /* Split away the beginning of this interval; what we don't
1463 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1464 copy_properties (unchanged
, i
);
1468 if (BUFFERP (object
))
1469 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1471 /* We are at the beginning of an interval, with len to scan */
1477 if (LENGTH (i
) >= len
)
1479 if (! interval_has_some_properties (properties
, i
))
1480 return modified
? Qt
: Qnil
;
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 EMACS_INT s
, len
;
1520 register int modified
= 0;
1521 Lisp_Object properties
;
1522 properties
= list_of_properties
;
1525 XSETBUFFER (object
, current_buffer
);
1527 i
= validate_interval_range (object
, &start
, &end
, soft
);
1528 if (NULL_INTERVAL_P (i
))
1532 len
= XINT (end
) - s
;
1534 if (i
->position
!= s
)
1536 /* No properties on this first interval -- return if
1537 it covers the entire region. */
1538 if (! interval_has_some_properties_list (properties
, i
))
1540 EMACS_INT got
= (LENGTH (i
) - (s
- i
->position
));
1544 i
= next_interval (i
);
1546 /* Split away the beginning of this interval; what we don't
1551 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1552 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. */
1567 if (LENGTH (i
) >= len
)
1569 if (! interval_has_some_properties_list (properties
, i
))
1573 if (BUFFERP (object
))
1574 signal_after_change (XINT (start
),
1575 XINT (end
) - XINT (start
),
1576 XINT (end
) - XINT (start
));
1582 else if (LENGTH (i
) == len
)
1584 if (!modified
&& BUFFERP (object
))
1585 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1586 remove_properties (Qnil
, properties
, i
, object
);
1587 if (BUFFERP (object
))
1588 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1589 XINT (end
) - XINT (start
));
1593 { /* i has the properties, and goes past the change limit. */
1595 i
= split_interval_left (i
, len
);
1596 copy_properties (unchanged
, i
);
1597 if (!modified
&& BUFFERP (object
))
1598 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1599 remove_properties (Qnil
, properties
, i
, object
);
1600 if (BUFFERP (object
))
1601 signal_after_change (XINT (start
), XINT (end
) - XINT (start
),
1602 XINT (end
) - XINT (start
));
1606 if (interval_has_some_properties_list (properties
, i
))
1608 if (!modified
&& BUFFERP (object
))
1609 modify_region (XBUFFER (object
), XINT (start
), XINT (end
), 1);
1610 remove_properties (Qnil
, properties
, i
, object
);
1614 i
= next_interval (i
);
1618 DEFUN ("text-property-any", Ftext_property_any
,
1619 Stext_property_any
, 4, 5, 0,
1620 doc
: /* Check text from START to END for property PROPERTY equalling VALUE.
1621 If so, return the position of the first character whose property PROPERTY
1622 is `eq' to VALUE. Otherwise return nil.
1623 If the optional fifth argument OBJECT is a buffer (or nil, which means
1624 the current buffer), START and END are buffer positions (integers or
1625 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1626 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1628 register INTERVAL i
;
1629 register EMACS_INT e
, pos
;
1632 XSETBUFFER (object
, current_buffer
);
1633 i
= validate_interval_range (object
, &start
, &end
, soft
);
1634 if (NULL_INTERVAL_P (i
))
1635 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1638 while (! NULL_INTERVAL_P (i
))
1640 if (i
->position
>= e
)
1642 if (EQ (textget (i
->plist
, property
), value
))
1645 if (pos
< XINT (start
))
1647 return make_number (pos
);
1649 i
= next_interval (i
);
1654 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1655 Stext_property_not_all
, 4, 5, 0,
1656 doc
: /* Check text from START to END for property PROPERTY not equalling VALUE.
1657 If so, return the position of the first character whose property PROPERTY
1658 is not `eq' to VALUE. Otherwise, return nil.
1659 If the optional fifth argument OBJECT is a buffer (or nil, which means
1660 the current buffer), START and END are buffer positions (integers or
1661 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1662 (Lisp_Object start
, Lisp_Object end
, Lisp_Object property
, Lisp_Object value
, Lisp_Object object
)
1664 register INTERVAL i
;
1665 register EMACS_INT s
, e
;
1668 XSETBUFFER (object
, current_buffer
);
1669 i
= validate_interval_range (object
, &start
, &end
, soft
);
1670 if (NULL_INTERVAL_P (i
))
1671 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1675 while (! NULL_INTERVAL_P (i
))
1677 if (i
->position
>= e
)
1679 if (! EQ (textget (i
->plist
, property
), value
))
1681 if (i
->position
> s
)
1683 return make_number (s
);
1685 i
= next_interval (i
);
1691 /* Return the direction from which the text-property PROP would be
1692 inherited by any new text inserted at POS: 1 if it would be
1693 inherited from the char after POS, -1 if it would be inherited from
1694 the char before POS, and 0 if from neither.
1695 BUFFER can be either a buffer or nil (meaning current buffer). */
1698 text_property_stickiness (Lisp_Object prop
, Lisp_Object pos
, Lisp_Object buffer
)
1700 Lisp_Object prev_pos
, front_sticky
;
1701 int is_rear_sticky
= 1, is_front_sticky
= 0; /* defaults */
1704 XSETBUFFER (buffer
, current_buffer
);
1706 if (XINT (pos
) > BUF_BEGV (XBUFFER (buffer
)))
1707 /* Consider previous character. */
1709 Lisp_Object rear_non_sticky
;
1711 prev_pos
= make_number (XINT (pos
) - 1);
1712 rear_non_sticky
= Fget_text_property (prev_pos
, Qrear_nonsticky
, buffer
);
1714 if (!NILP (CONSP (rear_non_sticky
)
1715 ? Fmemq (prop
, rear_non_sticky
)
1717 /* PROP is rear-non-sticky. */
1723 /* Consider following character. */
1724 /* This signals an arg-out-of-range error if pos is outside the
1725 buffer's accessible range. */
1726 front_sticky
= Fget_text_property (pos
, Qfront_sticky
, buffer
);
1728 if (EQ (front_sticky
, Qt
)
1729 || (CONSP (front_sticky
)
1730 && !NILP (Fmemq (prop
, front_sticky
))))
1731 /* PROP is inherited from after. */
1732 is_front_sticky
= 1;
1734 /* Simple cases, where the properties are consistent. */
1735 if (is_rear_sticky
&& !is_front_sticky
)
1737 else if (!is_rear_sticky
&& is_front_sticky
)
1739 else if (!is_rear_sticky
&& !is_front_sticky
)
1742 /* The stickiness properties are inconsistent, so we have to
1743 disambiguate. Basically, rear-sticky wins, _except_ if the
1744 property that would be inherited has a value of nil, in which case
1745 front-sticky wins. */
1746 if (XINT (pos
) == BUF_BEGV (XBUFFER (buffer
))
1747 || NILP (Fget_text_property (prev_pos
, prop
, buffer
)))
1754 /* I don't think this is the right interface to export; how often do you
1755 want to do something like this, other than when you're copying objects
1758 I think it would be better to have a pair of functions, one which
1759 returns the text properties of a region as a list of ranges and
1760 plists, and another which applies such a list to another object. */
1762 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1763 SRC and DEST may each refer to strings or buffers.
1764 Optional sixth argument PROP causes only that property to be copied.
1765 Properties are copied to DEST as if by `add-text-properties'.
1766 Return t if any property value actually changed, nil otherwise. */
1768 /* Note this can GC when DEST is a buffer. */
1771 copy_text_properties (Lisp_Object start
, Lisp_Object end
, Lisp_Object src
, Lisp_Object pos
, Lisp_Object dest
, Lisp_Object prop
)
1777 EMACS_INT s
, e
, e2
, p
, len
;
1779 struct gcpro gcpro1
, gcpro2
;
1781 i
= validate_interval_range (src
, &start
, &end
, soft
);
1782 if (NULL_INTERVAL_P (i
))
1785 CHECK_NUMBER_COERCE_MARKER (pos
);
1787 Lisp_Object dest_start
, dest_end
;
1790 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
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
);
1831 if (NULL_INTERVAL_P (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
);
1872 if (!NULL_INTERVAL_P (i
))
1874 EMACS_INT s
= XINT (start
);
1875 EMACS_INT e
= XINT (end
);
1879 EMACS_INT 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
);
1904 if (NULL_INTERVAL_P (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 EMACS_INT 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
, int start
, int end
)
2012 register INTERVAL intervals
= BUF_INTERVALS (buf
);
2013 register INTERVAL i
;
2015 register Lisp_Object prev_mod_hooks
;
2016 Lisp_Object mod_hooks
;
2017 struct gcpro gcpro1
;
2020 prev_mod_hooks
= Qnil
;
2023 interval_insert_behind_hooks
= Qnil
;
2024 interval_insert_in_front_hooks
= Qnil
;
2026 if (NULL_INTERVAL_P (intervals
))
2031 EMACS_INT temp
= start
;
2036 /* For an insert operation, check the two chars around the position. */
2039 INTERVAL prev
= NULL
;
2040 Lisp_Object before
, after
;
2042 /* Set I to the interval containing the char after START,
2043 and PREV to the interval containing the char before START.
2044 Either one may be null. They may be equal. */
2045 i
= find_interval (intervals
, start
);
2047 if (start
== BUF_BEGV (buf
))
2049 else if (i
->position
== start
)
2050 prev
= previous_interval (i
);
2051 else if (i
->position
< start
)
2053 if (start
== BUF_ZV (buf
))
2056 /* If Vinhibit_read_only is set and is not a list, we can
2057 skip the read_only checks. */
2058 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
2060 /* If I and PREV differ we need to check for the read-only
2061 property together with its stickiness. If either I or
2062 PREV are 0, this check is all we need.
2063 We have to take special care, since read-only may be
2064 indirectly defined via the category property. */
2067 if (! NULL_INTERVAL_P (i
))
2069 after
= textget (i
->plist
, Qread_only
);
2071 /* If interval I is read-only and read-only is
2072 front-sticky, inhibit insertion.
2073 Check for read-only as well as category. */
2075 && NILP (Fmemq (after
, Vinhibit_read_only
)))
2079 tem
= textget (i
->plist
, Qfront_sticky
);
2080 if (TMEM (Qread_only
, tem
)
2081 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2082 && TMEM (Qcategory
, tem
)))
2083 text_read_only (after
);
2087 if (! NULL_INTERVAL_P (prev
))
2089 before
= textget (prev
->plist
, Qread_only
);
2091 /* If interval PREV is read-only and read-only isn't
2092 rear-nonsticky, inhibit insertion.
2093 Check for read-only as well as category. */
2095 && NILP (Fmemq (before
, Vinhibit_read_only
)))
2099 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2100 if (! TMEM (Qread_only
, tem
)
2101 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
2102 || ! TMEM (Qcategory
, tem
)))
2103 text_read_only (before
);
2107 else if (! NULL_INTERVAL_P (i
))
2109 after
= textget (i
->plist
, Qread_only
);
2111 /* If interval I is read-only and read-only is
2112 front-sticky, inhibit insertion.
2113 Check for read-only as well as category. */
2114 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
2118 tem
= textget (i
->plist
, Qfront_sticky
);
2119 if (TMEM (Qread_only
, tem
)
2120 || (NILP (Fplist_get (i
->plist
, Qread_only
))
2121 && TMEM (Qcategory
, tem
)))
2122 text_read_only (after
);
2124 tem
= textget (prev
->plist
, Qrear_nonsticky
);
2125 if (! TMEM (Qread_only
, tem
)
2126 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
2127 || ! TMEM (Qcategory
, tem
)))
2128 text_read_only (after
);
2133 /* Run both insert hooks (just once if they're the same). */
2134 if (!NULL_INTERVAL_P (prev
))
2135 interval_insert_behind_hooks
2136 = textget (prev
->plist
, Qinsert_behind_hooks
);
2137 if (!NULL_INTERVAL_P (i
))
2138 interval_insert_in_front_hooks
2139 = textget (i
->plist
, Qinsert_in_front_hooks
);
2143 /* Loop over intervals on or next to START...END,
2144 collecting their hooks. */
2146 i
= find_interval (intervals
, start
);
2149 if (! INTERVAL_WRITABLE_P (i
))
2150 text_read_only (textget (i
->plist
, Qread_only
));
2152 if (!inhibit_modification_hooks
)
2154 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
2155 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
2157 hooks
= Fcons (mod_hooks
, hooks
);
2158 prev_mod_hooks
= mod_hooks
;
2162 i
= next_interval (i
);
2164 /* Keep going thru the interval containing the char before END. */
2165 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
2167 if (!inhibit_modification_hooks
)
2170 hooks
= Fnreverse (hooks
);
2171 while (! EQ (hooks
, Qnil
))
2173 call_mod_hooks (Fcar (hooks
), make_number (start
),
2175 hooks
= Fcdr (hooks
);
2182 /* Run the interval hooks for an insertion on character range START ... END.
2183 verify_interval_modification chose which hooks to run;
2184 this function is called after the insertion happens
2185 so it can indicate the range of inserted text. */
2188 report_interval_modification (Lisp_Object start
, Lisp_Object end
)
2190 if (! NILP (interval_insert_behind_hooks
))
2191 call_mod_hooks (interval_insert_behind_hooks
, start
, end
);
2192 if (! NILP (interval_insert_in_front_hooks
)
2193 && ! EQ (interval_insert_in_front_hooks
,
2194 interval_insert_behind_hooks
))
2195 call_mod_hooks (interval_insert_in_front_hooks
, start
, end
);
2199 syms_of_textprop (void)
2201 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties
,
2202 doc
: /* Property-list used as default values.
2203 The value of a property in this list is seen as the value for every
2204 character that does not have its own value for that property. */);
2205 Vdefault_text_properties
= Qnil
;
2207 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist
,
2208 doc
: /* Alist of alternative properties for properties without a value.
2209 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2210 If a piece of text has no direct value for a particular property, then
2211 this alist is consulted. If that property appears in the alist, then
2212 the first non-nil value from the associated alternative properties is
2214 Vchar_property_alias_alist
= Qnil
;
2216 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks
,
2217 doc
: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2218 This also inhibits the use of the `intangible' text property. */);
2219 Vinhibit_point_motion_hooks
= Qnil
;
2221 DEFVAR_LISP ("text-property-default-nonsticky",
2222 Vtext_property_default_nonsticky
,
2223 doc
: /* Alist of properties vs the corresponding non-stickinesses.
2224 Each element has the form (PROPERTY . NONSTICKINESS).
2226 If a character in a buffer has PROPERTY, new text inserted adjacent to
2227 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2228 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2229 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2230 /* Text property `syntax-table' should be nonsticky by default. */
2231 Vtext_property_default_nonsticky
2232 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt
), Qnil
);
2234 staticpro (&interval_insert_behind_hooks
);
2235 staticpro (&interval_insert_in_front_hooks
);
2236 interval_insert_behind_hooks
= Qnil
;
2237 interval_insert_in_front_hooks
= Qnil
;
2240 /* Common attributes one might give text */
2242 staticpro (&Qforeground
);
2243 Qforeground
= intern_c_string ("foreground");
2244 staticpro (&Qbackground
);
2245 Qbackground
= intern_c_string ("background");
2247 Qfont
= intern_c_string ("font");
2248 staticpro (&Qstipple
);
2249 Qstipple
= intern_c_string ("stipple");
2250 staticpro (&Qunderline
);
2251 Qunderline
= intern_c_string ("underline");
2252 staticpro (&Qread_only
);
2253 Qread_only
= intern_c_string ("read-only");
2254 staticpro (&Qinvisible
);
2255 Qinvisible
= intern_c_string ("invisible");
2256 staticpro (&Qintangible
);
2257 Qintangible
= intern_c_string ("intangible");
2258 staticpro (&Qcategory
);
2259 Qcategory
= intern_c_string ("category");
2260 staticpro (&Qlocal_map
);
2261 Qlocal_map
= intern_c_string ("local-map");
2262 staticpro (&Qfront_sticky
);
2263 Qfront_sticky
= intern_c_string ("front-sticky");
2264 staticpro (&Qrear_nonsticky
);
2265 Qrear_nonsticky
= intern_c_string ("rear-nonsticky");
2266 staticpro (&Qmouse_face
);
2267 Qmouse_face
= intern_c_string ("mouse-face");
2268 staticpro (&Qminibuffer_prompt
);
2269 Qminibuffer_prompt
= intern_c_string ("minibuffer-prompt");
2271 /* Properties that text might use to specify certain actions */
2273 staticpro (&Qmouse_left
);
2274 Qmouse_left
= intern_c_string ("mouse-left");
2275 staticpro (&Qmouse_entered
);
2276 Qmouse_entered
= intern_c_string ("mouse-entered");
2277 staticpro (&Qpoint_left
);
2278 Qpoint_left
= intern_c_string ("point-left");
2279 staticpro (&Qpoint_entered
);
2280 Qpoint_entered
= intern_c_string ("point-entered");
2282 defsubr (&Stext_properties_at
);
2283 defsubr (&Sget_text_property
);
2284 defsubr (&Sget_char_property
);
2285 defsubr (&Sget_char_property_and_overlay
);
2286 defsubr (&Snext_char_property_change
);
2287 defsubr (&Sprevious_char_property_change
);
2288 defsubr (&Snext_single_char_property_change
);
2289 defsubr (&Sprevious_single_char_property_change
);
2290 defsubr (&Snext_property_change
);
2291 defsubr (&Snext_single_property_change
);
2292 defsubr (&Sprevious_property_change
);
2293 defsubr (&Sprevious_single_property_change
);
2294 defsubr (&Sadd_text_properties
);
2295 defsubr (&Sput_text_property
);
2296 defsubr (&Sset_text_properties
);
2297 defsubr (&Sremove_text_properties
);
2298 defsubr (&Sremove_list_of_text_properties
);
2299 defsubr (&Stext_property_any
);
2300 defsubr (&Stext_property_not_all
);
2301 /* defsubr (&Serase_text_properties); */
2302 /* defsubr (&Scopy_text_properties); */