1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993 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 2, or (at your option)
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; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include "intervals.h"
26 /* NOTES: previous- and next- property change will have to skip
27 zero-length intervals if they are implemented. This could be done
28 inside next_interval and previous_interval.
30 set_properties needs to deal with the interval property cache.
32 It is assumed that for any interval plist, a property appears
33 only once on the list. Although some code i.e., remove_properties,
34 handles the more general case, the uniqueness of properties is
35 necessary for the system to remain consistent. This requirement
36 is enforced by the subrs installing properties onto the intervals. */
38 /* The rest of the file is within this conditional */
39 #ifdef USE_TEXT_PROPERTIES
42 Lisp_Object Qmouse_left
;
43 Lisp_Object Qmouse_entered
;
44 Lisp_Object Qpoint_left
;
45 Lisp_Object Qpoint_entered
;
46 Lisp_Object Qcategory
;
47 Lisp_Object Qlocal_map
;
49 /* Visual properties text (including strings) may have. */
50 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
51 Lisp_Object Qinvisible
, Qread_only
;
53 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
54 the o1's cdr. Otherwise, return zero. This is handy for
56 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr))
58 Lisp_Object Vinhibit_point_motion_hooks
;
61 /* Extract the interval at the position pointed to by BEGIN from
62 OBJECT, a string or buffer. Additionally, check that the positions
63 pointed to by BEGIN and END are within the bounds of OBJECT, and
64 reverse them if *BEGIN is greater than *END. The objects pointed
65 to by BEGIN and END may be integers or markers; if the latter, they
66 are coerced to integers.
68 When OBJECT is a string, we increment *BEGIN and *END
69 to make them origin-one.
71 Note that buffer points don't correspond to interval indices.
72 For example, point-max is 1 greater than the index of the last
73 character. This difference is handled in the caller, which uses
74 the validated points to determine a length, and operates on that.
75 Exceptions are Ftext_properties_at, Fnext_property_change, and
76 Fprevious_property_change which call this function with BEGIN == END.
77 Handle this case specially.
79 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
80 create an interval tree for OBJECT if one doesn't exist, provided
81 the object actually contains text. In the current design, if there
82 is no text, there can be no text properties. */
88 validate_interval_range (object
, begin
, end
, force
)
89 Lisp_Object object
, *begin
, *end
;
95 CHECK_STRING_OR_BUFFER (object
, 0);
96 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
97 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
99 /* If we are asked for a point, but from a subr which operates
100 on a range, then return nothing. */
101 if (*begin
== *end
&& begin
!= end
)
102 return NULL_INTERVAL
;
104 if (XINT (*begin
) > XINT (*end
))
112 if (XTYPE (object
) == Lisp_Buffer
)
114 register struct buffer
*b
= XBUFFER (object
);
116 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
117 && XINT (*end
) <= BUF_ZV (b
)))
118 args_out_of_range (*begin
, *end
);
121 /* If there's no text, there are no properties. */
122 if (BUF_BEGV (b
) == BUF_ZV (b
))
123 return NULL_INTERVAL
;
125 searchpos
= XINT (*begin
);
129 register struct Lisp_String
*s
= XSTRING (object
);
131 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
132 && XINT (*end
) <= s
->size
))
133 args_out_of_range (*begin
, *end
);
134 /* User-level Positions in strings start with 0,
135 but the interval code always wants positions starting with 1. */
136 XFASTINT (*begin
) += 1;
138 XFASTINT (*end
) += 1;
142 return NULL_INTERVAL
;
144 searchpos
= XINT (*begin
);
147 if (NULL_INTERVAL_P (i
))
148 return (force
? create_root_interval (object
) : i
);
150 return find_interval (i
, searchpos
);
153 /* Validate LIST as a property list. If LIST is not a list, then
154 make one consisting of (LIST nil). Otherwise, verify that LIST
155 is even numbered and thus suitable as a plist. */
158 validate_plist (list
)
166 register Lisp_Object tail
;
167 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
173 error ("Odd length text property list");
177 return Fcons (list
, Fcons (Qnil
, Qnil
));
180 /* Return nonzero if interval I has all the properties,
181 with the same values, of list PLIST. */
184 interval_has_all_properties (plist
, i
)
188 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
191 /* Go through each element of PLIST. */
192 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
197 /* Go through I's plist, looking for sym1 */
198 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
199 if (EQ (sym1
, Fcar (tail2
)))
201 /* Found the same property on both lists. If the
202 values are unequal, return zero. */
203 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
206 /* Property has same value on both lists; go to next one. */
218 /* Return nonzero if the plist of interval I has any of the
219 properties of PLIST, regardless of their values. */
222 interval_has_some_properties (plist
, i
)
226 register Lisp_Object tail1
, tail2
, sym
;
228 /* Go through each element of PLIST. */
229 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
233 /* Go through i's plist, looking for tail1 */
234 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
235 if (EQ (sym
, Fcar (tail2
)))
242 /* Changing the plists of individual intervals. */
244 /* Return the value of PROP in property-list PLIST, or Qunbound if it
247 property_value (plist
, prop
)
251 while (PLIST_ELT_P (plist
, value
))
252 if (EQ (XCONS (plist
)->car
, prop
))
253 return XCONS (value
)->car
;
255 plist
= XCONS (value
)->cdr
;
260 /* Set the properties of INTERVAL to PROPERTIES,
261 and record undo info for the previous values.
262 OBJECT is the string or buffer that INTERVAL belongs to. */
265 set_properties (properties
, interval
, object
)
266 Lisp_Object properties
, object
;
269 Lisp_Object sym
, value
;
271 if (BUFFERP (object
))
273 /* For each property in the old plist which is missing from PROPERTIES,
274 or has a different value in PROPERTIES, make an undo record. */
275 for (sym
= interval
->plist
;
276 PLIST_ELT_P (sym
, value
);
277 sym
= XCONS (value
)->cdr
)
278 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
281 modify_region (XBUFFER (object
),
282 make_number (interval
->position
),
283 make_number (interval
->position
+ LENGTH (interval
)));
284 record_property_change (interval
->position
, LENGTH (interval
),
285 XCONS (sym
)->car
, XCONS (value
)->car
,
289 /* For each new property that has no value at all in the old plist,
290 make an undo record binding it to nil, so it will be removed. */
291 for (sym
= properties
;
292 PLIST_ELT_P (sym
, value
);
293 sym
= XCONS (value
)->cdr
)
294 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
296 modify_region (XBUFFER (object
),
297 make_number (interval
->position
),
298 make_number (interval
->position
+ LENGTH (interval
)));
299 record_property_change (interval
->position
, LENGTH (interval
),
300 XCONS (sym
)->car
, Qnil
,
305 /* Store new properties. */
306 interval
->plist
= Fcopy_sequence (properties
);
309 /* Add the properties of PLIST to the interval I, or set
310 the value of I's property to the value of the property on PLIST
311 if they are different.
313 OBJECT should be the string or buffer the interval is in.
315 Return nonzero if this changes I (i.e., if any members of PLIST
316 are actually added to I's plist) */
319 add_properties (plist
, i
, object
)
324 register Lisp_Object tail1
, tail2
, sym1
, val1
;
325 register int changed
= 0;
328 /* Go through each element of PLIST. */
329 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
332 val1
= Fcar (Fcdr (tail1
));
335 /* Go through I's plist, looking for sym1 */
336 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
337 if (EQ (sym1
, Fcar (tail2
)))
339 register Lisp_Object this_cdr
= Fcdr (tail2
);
341 /* Found the property. Now check its value. */
344 /* The properties have the same value on both lists.
345 Continue to the next property. */
346 if (EQ (val1
, Fcar (this_cdr
)))
349 /* Record this change in the buffer, for undo purposes. */
350 if (XTYPE (object
) == Lisp_Buffer
)
352 modify_region (XBUFFER (object
),
353 make_number (i
->position
),
354 make_number (i
->position
+ LENGTH (i
)));
355 record_property_change (i
->position
, LENGTH (i
),
356 sym1
, Fcar (this_cdr
), object
);
359 /* I's property has a different value -- change it */
360 Fsetcar (this_cdr
, val1
);
367 /* Record this change in the buffer, for undo purposes. */
368 if (XTYPE (object
) == Lisp_Buffer
)
370 modify_region (XBUFFER (object
),
371 make_number (i
->position
),
372 make_number (i
->position
+ LENGTH (i
)));
373 record_property_change (i
->position
, LENGTH (i
),
376 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
384 /* For any members of PLIST which are properties of I, remove them
386 OBJECT is the string or buffer containing I. */
389 remove_properties (plist
, i
, object
)
394 register Lisp_Object tail1
, tail2
, sym
;
395 register Lisp_Object current_plist
= i
->plist
;
396 register int changed
= 0;
398 /* Go through each element of plist. */
399 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
403 /* First, remove the symbol if its at the head of the list */
404 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
406 if (XTYPE (object
) == Lisp_Buffer
)
408 modify_region (XBUFFER (object
),
409 make_number (i
->position
),
410 make_number (i
->position
+ LENGTH (i
)));
411 record_property_change (i
->position
, LENGTH (i
),
412 sym
, Fcar (Fcdr (current_plist
)),
416 current_plist
= Fcdr (Fcdr (current_plist
));
420 /* Go through i's plist, looking for sym */
421 tail2
= current_plist
;
422 while (! NILP (tail2
))
424 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
425 if (EQ (sym
, Fcar (this)))
427 if (XTYPE (object
) == Lisp_Buffer
)
429 modify_region (XBUFFER (object
),
430 make_number (i
->position
),
431 make_number (i
->position
+ LENGTH (i
)));
432 record_property_change (i
->position
, LENGTH (i
),
433 sym
, Fcar (Fcdr (this)), object
);
436 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
444 i
->plist
= current_plist
;
449 /* Remove all properties from interval I. Return non-zero
450 if this changes the interval. */
464 DEFUN ("text-properties-at", Ftext_properties_at
,
465 Stext_properties_at
, 1, 2, 0,
466 "Return the list of properties held by the character at POSITION\n\
467 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
468 defaults to the current buffer.\n\
469 If POSITION is at the end of OBJECT, the value is nil.")
471 Lisp_Object pos
, object
;
476 XSET (object
, Lisp_Buffer
, current_buffer
);
478 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
479 if (NULL_INTERVAL_P (i
))
481 /* If POS is at the end of the interval,
482 it means it's the end of OBJECT.
483 There are no properties at the very end,
484 since no character follows. */
485 if (XINT (pos
) == LENGTH (i
) + i
->position
)
491 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
492 "Return the value of position POS's property PROP, in OBJECT.\n\
493 OBJECT is optional and defaults to the current buffer.\n\
494 If POSITION is at the end of OBJECT, the value is nil.")
496 Lisp_Object pos
, object
;
497 register Lisp_Object prop
;
500 register Lisp_Object tail
;
503 XSET (object
, Lisp_Buffer
, current_buffer
);
504 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
505 if (NULL_INTERVAL_P (i
))
508 /* If POS is at the end of the interval,
509 it means it's the end of OBJECT.
510 There are no properties at the very end,
511 since no character follows. */
512 if (XINT (pos
) == LENGTH (i
) + i
->position
)
515 return textget (i
->plist
, prop
);
518 DEFUN ("next-property-change", Fnext_property_change
,
519 Snext_property_change
, 1, 2, 0,
520 "Return the position of next property change.\n\
521 Scans characters forward from POS in OBJECT till it finds\n\
522 a change in some text property, then returns the position of the change.\n\
523 The optional second argument OBJECT is the string or buffer to scan.\n\
524 Return nil if the property is constant all the way to the end of OBJECT.\n\
525 If the value is non-nil, it is a position greater than POS, never equal.")
527 Lisp_Object pos
, object
;
529 register INTERVAL i
, next
;
532 XSET (object
, Lisp_Buffer
, current_buffer
);
534 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
535 if (NULL_INTERVAL_P (i
))
538 next
= next_interval (i
);
539 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
540 next
= next_interval (next
);
542 if (NULL_INTERVAL_P (next
))
545 return next
->position
- (XTYPE (object
) == Lisp_String
);
549 DEFUN ("next-single-property-change", Fnext_single_property_change
,
550 Snext_single_property_change
, 1, 3, 0,
551 "Return the position of next property change for a specific property.\n\
552 Scans characters forward from POS till it finds\n\
553 a change in the PROP property, then returns the position of the change.\n\
554 The optional third argument OBJECT is the string or buffer to scan.\n\
555 Return nil if the property is constant all the way to the end of OBJECT.\n\
556 If the value is non-nil, it is a position greater than POS, never equal.")
558 Lisp_Object pos
, prop
, object
;
560 register INTERVAL i
, next
;
561 register Lisp_Object here_val
;
564 XSET (object
, Lisp_Buffer
, current_buffer
);
566 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
567 if (NULL_INTERVAL_P (i
))
570 here_val
= textget (i
->plist
, prop
);
571 next
= next_interval (i
);
572 while (! NULL_INTERVAL_P (next
)
573 && EQ (here_val
, textget (next
->plist
, prop
)))
574 next
= next_interval (next
);
576 if (NULL_INTERVAL_P (next
))
579 return next
->position
- (XTYPE (object
) == Lisp_String
);
582 DEFUN ("previous-property-change", Fprevious_property_change
,
583 Sprevious_property_change
, 1, 2, 0,
584 "Return the position of previous property change.\n\
585 Scans characters backwards from POS in OBJECT till it finds\n\
586 a change in some text property, then returns the position of the change.\n\
587 The optional second argument OBJECT is the string or buffer to scan.\n\
588 Return nil if the property is constant all the way to the start of OBJECT.\n\
589 If the value is non-nil, it is a position less than POS, never equal.")
591 Lisp_Object pos
, object
;
593 register INTERVAL i
, previous
;
596 XSET (object
, Lisp_Buffer
, current_buffer
);
598 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
599 if (NULL_INTERVAL_P (i
))
602 previous
= previous_interval (i
);
603 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
604 previous
= previous_interval (previous
);
605 if (NULL_INTERVAL_P (previous
))
608 return (previous
->position
+ LENGTH (previous
) - 1
609 - (XTYPE (object
) == Lisp_String
));
612 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
613 Sprevious_single_property_change
, 2, 3, 0,
614 "Return the position of previous property change for a specific property.\n\
615 Scans characters backward from POS till it finds\n\
616 a change in the PROP property, then returns the position of the change.\n\
617 The optional third argument OBJECT is the string or buffer to scan.\n\
618 Return nil if the property is constant all the way to the start of OBJECT.\n\
619 If the value is non-nil, it is a position less than POS, never equal.")
621 Lisp_Object pos
, prop
, object
;
623 register INTERVAL i
, previous
;
624 register Lisp_Object here_val
;
627 XSET (object
, Lisp_Buffer
, current_buffer
);
629 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
630 if (NULL_INTERVAL_P (i
))
633 here_val
= textget (i
->plist
, prop
);
634 previous
= previous_interval (i
);
635 while (! NULL_INTERVAL_P (previous
)
636 && EQ (here_val
, textget (previous
->plist
, prop
)))
637 previous
= previous_interval (previous
);
638 if (NULL_INTERVAL_P (previous
))
641 return (previous
->position
+ LENGTH (previous
) - 1
642 - (XTYPE (object
) == Lisp_String
));
645 DEFUN ("add-text-properties", Fadd_text_properties
,
646 Sadd_text_properties
, 3, 4, 0,
647 "Add properties to the text from START to END.\n\
648 The third argument PROPS is a property list\n\
649 specifying the property values to add.\n\
650 The optional fourth argument, OBJECT,\n\
651 is the string or buffer containing the text.\n\
652 Return t if any property value actually changed, nil otherwise.")
653 (start
, end
, properties
, object
)
654 Lisp_Object start
, end
, properties
, object
;
656 register INTERVAL i
, unchanged
;
657 register int s
, len
, modified
= 0;
659 properties
= validate_plist (properties
);
660 if (NILP (properties
))
664 XSET (object
, Lisp_Buffer
, current_buffer
);
666 i
= validate_interval_range (object
, &start
, &end
, hard
);
667 if (NULL_INTERVAL_P (i
))
671 len
= XINT (end
) - s
;
673 /* If we're not starting on an interval boundary, we have to
674 split this interval. */
675 if (i
->position
!= s
)
677 /* If this interval already has the properties, we can
679 if (interval_has_all_properties (properties
, i
))
681 int got
= (LENGTH (i
) - (s
- i
->position
));
685 i
= next_interval (i
);
690 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
691 copy_properties (unchanged
, i
);
695 /* We are at the beginning of interval I, with LEN chars to scan. */
701 if (LENGTH (i
) >= len
)
703 if (interval_has_all_properties (properties
, i
))
704 return modified
? Qt
: Qnil
;
706 if (LENGTH (i
) == len
)
708 add_properties (properties
, i
, object
);
712 /* i doesn't have the properties, and goes past the change limit */
714 i
= split_interval_left (unchanged
, len
);
715 copy_properties (unchanged
, i
);
716 add_properties (properties
, i
, object
);
721 modified
+= add_properties (properties
, i
, object
);
722 i
= next_interval (i
);
726 DEFUN ("put-text-property", Fput_text_property
,
727 Sput_text_property
, 4, 5, 0,
728 "Set one property of the text from START to END.\n\
729 The third and fourth arguments PROP and VALUE\n\
730 specify the property to add.\n\
731 The optional fifth argument, OBJECT,\n\
732 is the string or buffer containing the text.")
733 (start
, end
, prop
, value
, object
)
734 Lisp_Object start
, end
, prop
, value
, object
;
736 Fadd_text_properties (start
, end
,
737 Fcons (prop
, Fcons (value
, Qnil
)),
742 DEFUN ("set-text-properties", Fset_text_properties
,
743 Sset_text_properties
, 3, 4, 0,
744 "Completely replace properties of text from START to END.\n\
745 The third argument PROPS is the new property list.\n\
746 The optional fourth argument, OBJECT,\n\
747 is the string or buffer containing the text.")
748 (start
, end
, props
, object
)
749 Lisp_Object start
, end
, props
, object
;
751 register INTERVAL i
, unchanged
;
752 register INTERVAL prev_changed
= NULL_INTERVAL
;
755 props
= validate_plist (props
);
758 XSET (object
, Lisp_Buffer
, current_buffer
);
760 i
= validate_interval_range (object
, &start
, &end
, hard
);
761 if (NULL_INTERVAL_P (i
))
765 len
= XINT (end
) - s
;
767 if (i
->position
!= s
)
770 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
772 if (LENGTH (i
) > len
)
774 copy_properties (unchanged
, i
);
775 i
= split_interval_left (i
, len
);
776 set_properties (props
, i
, object
);
780 set_properties (props
, i
, object
);
782 if (LENGTH (i
) == len
)
787 i
= next_interval (i
);
790 /* We are starting at the beginning of an interval, I */
796 if (LENGTH (i
) >= len
)
798 if (LENGTH (i
) > len
)
799 i
= split_interval_left (i
, len
);
801 if (NULL_INTERVAL_P (prev_changed
))
802 set_properties (props
, i
, object
);
804 merge_interval_left (i
);
809 if (NULL_INTERVAL_P (prev_changed
))
811 set_properties (props
, i
, object
);
815 prev_changed
= i
= merge_interval_left (i
);
817 i
= next_interval (i
);
823 DEFUN ("remove-text-properties", Fremove_text_properties
,
824 Sremove_text_properties
, 3, 4, 0,
825 "Remove some properties from text from START to END.\n\
826 The third argument PROPS is a property list\n\
827 whose property names specify the properties to remove.\n\
828 \(The values stored in PROPS are ignored.)\n\
829 The optional fourth argument, OBJECT,\n\
830 is the string or buffer containing the text.\n\
831 Return t if any property was actually removed, nil otherwise.")
832 (start
, end
, props
, object
)
833 Lisp_Object start
, end
, props
, object
;
835 register INTERVAL i
, unchanged
;
836 register int s
, len
, modified
= 0;
839 XSET (object
, Lisp_Buffer
, current_buffer
);
841 i
= validate_interval_range (object
, &start
, &end
, soft
);
842 if (NULL_INTERVAL_P (i
))
846 len
= XINT (end
) - s
;
848 if (i
->position
!= s
)
850 /* No properties on this first interval -- return if
851 it covers the entire region. */
852 if (! interval_has_some_properties (props
, i
))
854 int got
= (LENGTH (i
) - (s
- i
->position
));
858 i
= next_interval (i
);
860 /* Split away the beginning of this interval; what we don't
865 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
866 copy_properties (unchanged
, i
);
870 /* We are at the beginning of an interval, with len to scan */
876 if (LENGTH (i
) >= len
)
878 if (! interval_has_some_properties (props
, i
))
879 return modified
? Qt
: Qnil
;
881 if (LENGTH (i
) == len
)
883 remove_properties (props
, i
, object
);
887 /* i has the properties, and goes past the change limit */
889 i
= split_interval_left (i
, len
);
890 copy_properties (unchanged
, i
);
891 remove_properties (props
, i
, object
);
896 modified
+= remove_properties (props
, i
, object
);
897 i
= next_interval (i
);
901 DEFUN ("text-property-any", Ftext_property_any
,
902 Stext_property_any
, 4, 5, 0,
903 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
904 If so, return the position of the first character whose PROP is `eq'\n\
905 to VALUE. Otherwise return nil.\n\
906 The optional fifth argument, OBJECT, is the string or buffer\n\
907 containing the text.")
908 (start
, end
, prop
, value
, object
)
909 Lisp_Object start
, end
, prop
, value
, object
;
915 XSET (object
, Lisp_Buffer
, current_buffer
);
916 i
= validate_interval_range (object
, &start
, &end
, soft
);
919 while (! NULL_INTERVAL_P (i
))
921 if (i
->position
>= e
)
923 if (EQ (textget (i
->plist
, prop
), value
))
926 if (pos
< XINT (start
))
928 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
930 i
= next_interval (i
);
935 DEFUN ("text-property-not-all", Ftext_property_not_all
,
936 Stext_property_not_all
, 4, 5, 0,
937 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
938 If so, return the position of the first character whose PROP is not\n\
939 `eq' to VALUE. Otherwise, return nil.\n\
940 The optional fifth argument, OBJECT, is the string or buffer\n\
941 containing the text.")
942 (start
, end
, prop
, value
, object
)
943 Lisp_Object start
, end
, prop
, value
, object
;
949 XSET (object
, Lisp_Buffer
, current_buffer
);
950 i
= validate_interval_range (object
, &start
, &end
, soft
);
951 if (NULL_INTERVAL_P (i
))
952 return (NILP (value
) || EQ (start
, end
)) ? Qt
: Qnil
;
956 while (! NULL_INTERVAL_P (i
))
958 if (i
->position
>= e
)
960 if (! EQ (textget (i
->plist
, prop
), value
))
964 return make_number (s
- (XTYPE (object
) == Lisp_String
));
966 i
= next_interval (i
);
971 #if 0 /* You can use set-text-properties for this. */
973 DEFUN ("erase-text-properties", Ferase_text_properties
,
974 Serase_text_properties
, 2, 3, 0,
975 "Remove all properties from the text from START to END.\n\
976 The optional third argument, OBJECT,\n\
977 is the string or buffer containing the text.")
979 Lisp_Object start
, end
, object
;
982 register INTERVAL prev_changed
= NULL_INTERVAL
;
983 register int s
, len
, modified
;
986 XSET (object
, Lisp_Buffer
, current_buffer
);
988 i
= validate_interval_range (object
, &start
, &end
, soft
);
989 if (NULL_INTERVAL_P (i
))
993 len
= XINT (end
) - s
;
995 if (i
->position
!= s
)
998 register INTERVAL unchanged
= i
;
1000 /* If there are properties here, then this text will be modified. */
1001 if (! NILP (i
->plist
))
1003 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1007 if (LENGTH (i
) > len
)
1009 i
= split_interval_right (i
, len
);
1010 copy_properties (unchanged
, i
);
1014 if (LENGTH (i
) == len
)
1019 /* If the text of I is without any properties, and contains
1020 LEN or more characters, then we may return without changing
1022 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1024 /* The amount of text to change extends past I, so just note
1025 how much we've gotten. */
1027 got
= LENGTH (i
) - (s
- i
->position
);
1031 i
= next_interval (i
);
1034 /* We are starting at the beginning of an interval, I. */
1037 if (LENGTH (i
) >= len
)
1039 /* If I has no properties, simply merge it if possible. */
1040 if (NILP (i
->plist
))
1042 if (! NULL_INTERVAL_P (prev_changed
))
1043 merge_interval_left (i
);
1045 return modified
? Qt
: Qnil
;
1048 if (LENGTH (i
) > len
)
1049 i
= split_interval_left (i
, len
);
1050 if (! NULL_INTERVAL_P (prev_changed
))
1051 merge_interval_left (i
);
1058 /* Here if we still need to erase past the end of I */
1060 if (NULL_INTERVAL_P (prev_changed
))
1062 modified
+= erase_properties (i
);
1067 modified
+= ! NILP (i
->plist
);
1068 /* Merging I will give it the properties of PREV_CHANGED. */
1069 prev_changed
= i
= merge_interval_left (i
);
1072 i
= next_interval (i
);
1075 return modified
? Qt
: Qnil
;
1079 /* I don't think this is the right interface to export; how often do you
1080 want to do something like this, other than when you're copying objects
1083 I think it would be better to have a pair of functions, one which
1084 returns the text properties of a region as a list of ranges and
1085 plists, and another which applies such a list to another object. */
1087 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1088 Scopy_text_properties, 5, 6, 0,
1089 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1090 SRC and DEST may each refer to strings or buffers.\n\
1091 Optional sixth argument PROP causes only that property to be copied.\n\
1092 Properties are copied to DEST as if by `add-text-properties'.\n\
1093 Return t if any property value actually changed, nil otherwise.") */
1096 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1097 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1103 int s
, e
, e2
, p
, len
, modified
= 0;
1105 i
= validate_interval_range (src
, &start
, &end
, soft
);
1106 if (NULL_INTERVAL_P (i
))
1109 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1111 Lisp_Object dest_start
, dest_end
;
1114 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1115 /* Apply this to a copy of pos; it will try to increment its arguments,
1116 which we don't want. */
1117 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1128 e2
= i
->position
+ LENGTH (i
);
1135 while (! NILP (plist
))
1137 if (EQ (Fcar (plist
), prop
))
1139 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1142 plist
= Fcdr (Fcdr (plist
));
1146 /* Must defer modifications to the interval tree in case src
1147 and dest refer to the same string or buffer. */
1148 stuff
= Fcons (Fcons (make_number (p
),
1149 Fcons (make_number (p
+ len
),
1150 Fcons (plist
, Qnil
))),
1154 i
= next_interval (i
);
1155 if (NULL_INTERVAL_P (i
))
1162 while (! NILP (stuff
))
1165 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1166 Fcar (Fcdr (Fcdr (res
))), dest
);
1169 stuff
= Fcdr (stuff
);
1172 return modified
? Qt
: Qnil
;
1178 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1179 "Threshold for rebalancing interval trees, expressed as the\n\
1180 percentage by which the left interval tree should not differ from the right.");
1181 interval_balance_threshold
= 8;
1183 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1184 "If nonnil, don't call the text property values of\n\
1185 `point-left' and `point-entered'.");
1186 Vinhibit_point_motion_hooks
= Qnil
;
1188 /* Common attributes one might give text */
1190 staticpro (&Qforeground
);
1191 Qforeground
= intern ("foreground");
1192 staticpro (&Qbackground
);
1193 Qbackground
= intern ("background");
1195 Qfont
= intern ("font");
1196 staticpro (&Qstipple
);
1197 Qstipple
= intern ("stipple");
1198 staticpro (&Qunderline
);
1199 Qunderline
= intern ("underline");
1200 staticpro (&Qread_only
);
1201 Qread_only
= intern ("read-only");
1202 staticpro (&Qinvisible
);
1203 Qinvisible
= intern ("invisible");
1204 staticpro (&Qcategory
);
1205 Qcategory
= intern ("category");
1206 staticpro (&Qlocal_map
);
1207 Qlocal_map
= intern ("local-map");
1209 /* Properties that text might use to specify certain actions */
1211 staticpro (&Qmouse_left
);
1212 Qmouse_left
= intern ("mouse-left");
1213 staticpro (&Qmouse_entered
);
1214 Qmouse_entered
= intern ("mouse-entered");
1215 staticpro (&Qpoint_left
);
1216 Qpoint_left
= intern ("point-left");
1217 staticpro (&Qpoint_entered
);
1218 Qpoint_entered
= intern ("point-entered");
1220 defsubr (&Stext_properties_at
);
1221 defsubr (&Sget_text_property
);
1222 defsubr (&Snext_property_change
);
1223 defsubr (&Snext_single_property_change
);
1224 defsubr (&Sprevious_property_change
);
1225 defsubr (&Sprevious_single_property_change
);
1226 defsubr (&Sadd_text_properties
);
1227 defsubr (&Sput_text_property
);
1228 defsubr (&Sset_text_properties
);
1229 defsubr (&Sremove_text_properties
);
1230 defsubr (&Stext_property_any
);
1231 defsubr (&Stext_property_not_all
);
1232 /* defsubr (&Serase_text_properties); */
1233 /* defsubr (&Scopy_text_properties); */
1238 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1240 #endif /* USE_TEXT_PROPERTIES */