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))
59 /* Extract the interval at the position pointed to by BEGIN from
60 OBJECT, a string or buffer. Additionally, check that the positions
61 pointed to by BEGIN and END are within the bounds of OBJECT, and
62 reverse them if *BEGIN is greater than *END. The objects pointed
63 to by BEGIN and END may be integers or markers; if the latter, they
64 are coerced to integers.
66 When OBJECT is a string, we increment *BEGIN and *END
67 to make them origin-one.
69 Note that buffer points don't correspond to interval indices.
70 For example, point-max is 1 greater than the index of the last
71 character. This difference is handled in the caller, which uses
72 the validated points to determine a length, and operates on that.
73 Exceptions are Ftext_properties_at, Fnext_property_change, and
74 Fprevious_property_change which call this function with BEGIN == END.
75 Handle this case specially.
77 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
78 create an interval tree for OBJECT if one doesn't exist, provided
79 the object actually contains text. In the current design, if there
80 is no text, there can be no text properties. */
86 validate_interval_range (object
, begin
, end
, force
)
87 Lisp_Object object
, *begin
, *end
;
93 CHECK_STRING_OR_BUFFER (object
, 0);
94 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
95 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
97 /* If we are asked for a point, but from a subr which operates
98 on a range, then return nothing. */
99 if (*begin
== *end
&& begin
!= end
)
100 return NULL_INTERVAL
;
102 if (XINT (*begin
) > XINT (*end
))
110 if (XTYPE (object
) == Lisp_Buffer
)
112 register struct buffer
*b
= XBUFFER (object
);
114 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
115 && XINT (*end
) <= BUF_ZV (b
)))
116 args_out_of_range (*begin
, *end
);
119 /* If there's no text, there are no properties. */
120 if (BUF_BEGV (b
) == BUF_ZV (b
))
121 return NULL_INTERVAL
;
123 searchpos
= XINT (*begin
);
127 register struct Lisp_String
*s
= XSTRING (object
);
129 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
130 && XINT (*end
) <= s
->size
))
131 args_out_of_range (*begin
, *end
);
132 /* User-level Positions in strings start with 0,
133 but the interval code always wants positions starting with 1. */
134 XFASTINT (*begin
) += 1;
136 XFASTINT (*end
) += 1;
140 return NULL_INTERVAL
;
142 searchpos
= XINT (*begin
);
145 if (NULL_INTERVAL_P (i
))
146 return (force
? create_root_interval (object
) : i
);
148 return find_interval (i
, searchpos
);
151 /* Validate LIST as a property list. If LIST is not a list, then
152 make one consisting of (LIST nil). Otherwise, verify that LIST
153 is even numbered and thus suitable as a plist. */
156 validate_plist (list
)
164 register Lisp_Object tail
;
165 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
171 error ("Odd length text property list");
175 return Fcons (list
, Fcons (Qnil
, Qnil
));
178 /* Return nonzero if interval I has all the properties,
179 with the same values, of list PLIST. */
182 interval_has_all_properties (plist
, i
)
186 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
189 /* Go through each element of PLIST. */
190 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
195 /* Go through I's plist, looking for sym1 */
196 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
197 if (EQ (sym1
, Fcar (tail2
)))
199 /* Found the same property on both lists. If the
200 values are unequal, return zero. */
201 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
204 /* Property has same value on both lists; go to next one. */
216 /* Return nonzero if the plist of interval I has any of the
217 properties of PLIST, regardless of their values. */
220 interval_has_some_properties (plist
, i
)
224 register Lisp_Object tail1
, tail2
, sym
;
226 /* Go through each element of PLIST. */
227 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
231 /* Go through i's plist, looking for tail1 */
232 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
233 if (EQ (sym
, Fcar (tail2
)))
240 /* Changing the plists of individual intervals. */
242 /* Return the value of PROP in property-list PLIST, or Qunbound if it
245 property_value (plist
, prop
)
249 while (PLIST_ELT_P (plist
, value
))
250 if (EQ (XCONS (plist
)->car
, prop
))
251 return XCONS (value
)->car
;
253 plist
= XCONS (value
)->cdr
;
258 /* Set the properties of INTERVAL to PROPERTIES,
259 and record undo info for the previous values.
260 OBJECT is the string or buffer that INTERVAL belongs to. */
263 set_properties (properties
, interval
, object
)
264 Lisp_Object properties
, object
;
267 Lisp_Object sym
, value
;
269 if (BUFFERP (object
))
271 /* For each property in the old plist which is missing from PROPERTIES,
272 or has a different value in PROPERTIES, make an undo record. */
273 for (sym
= interval
->plist
;
274 PLIST_ELT_P (sym
, value
);
275 sym
= XCONS (value
)->cdr
)
276 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
279 modify_region (XBUFFER (object
),
280 make_number (interval
->position
),
281 make_number (interval
->position
+ LENGTH (interval
)));
282 record_property_change (interval
->position
, LENGTH (interval
),
283 XCONS (sym
)->car
, XCONS (value
)->car
,
287 /* For each new property that has no value at all in the old plist,
288 make an undo record binding it to nil, so it will be removed. */
289 for (sym
= properties
;
290 PLIST_ELT_P (sym
, value
);
291 sym
= XCONS (value
)->cdr
)
292 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
294 modify_region (XBUFFER (object
),
295 make_number (interval
->position
),
296 make_number (interval
->position
+ LENGTH (interval
)));
297 record_property_change (interval
->position
, LENGTH (interval
),
298 XCONS (sym
)->car
, Qnil
,
303 /* Store new properties. */
304 interval
->plist
= Fcopy_sequence (properties
);
307 /* Add the properties of PLIST to the interval I, or set
308 the value of I's property to the value of the property on PLIST
309 if they are different.
311 OBJECT should be the string or buffer the interval is in.
313 Return nonzero if this changes I (i.e., if any members of PLIST
314 are actually added to I's plist) */
317 add_properties (plist
, i
, object
)
322 register Lisp_Object tail1
, tail2
, sym1
, val1
;
323 register int changed
= 0;
326 /* Go through each element of PLIST. */
327 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
330 val1
= Fcar (Fcdr (tail1
));
333 /* Go through I's plist, looking for sym1 */
334 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
335 if (EQ (sym1
, Fcar (tail2
)))
337 register Lisp_Object this_cdr
= Fcdr (tail2
);
339 /* Found the property. Now check its value. */
342 /* The properties have the same value on both lists.
343 Continue to the next property. */
344 if (EQ (val1
, Fcar (this_cdr
)))
347 /* Record this change in the buffer, for undo purposes. */
348 if (XTYPE (object
) == Lisp_Buffer
)
350 modify_region (XBUFFER (object
),
351 make_number (i
->position
),
352 make_number (i
->position
+ LENGTH (i
)));
353 record_property_change (i
->position
, LENGTH (i
),
354 sym1
, Fcar (this_cdr
), object
);
357 /* I's property has a different value -- change it */
358 Fsetcar (this_cdr
, val1
);
365 /* Record this change in the buffer, for undo purposes. */
366 if (XTYPE (object
) == Lisp_Buffer
)
368 modify_region (XBUFFER (object
),
369 make_number (i
->position
),
370 make_number (i
->position
+ LENGTH (i
)));
371 record_property_change (i
->position
, LENGTH (i
),
374 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
382 /* For any members of PLIST which are properties of I, remove them
384 OBJECT is the string or buffer containing I. */
387 remove_properties (plist
, i
, object
)
392 register Lisp_Object tail1
, tail2
, sym
;
393 register Lisp_Object current_plist
= i
->plist
;
394 register int changed
= 0;
396 /* Go through each element of plist. */
397 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
401 /* First, remove the symbol if its at the head of the list */
402 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
404 if (XTYPE (object
) == Lisp_Buffer
)
406 modify_region (XBUFFER (object
),
407 make_number (i
->position
),
408 make_number (i
->position
+ LENGTH (i
)));
409 record_property_change (i
->position
, LENGTH (i
),
410 sym
, Fcar (Fcdr (current_plist
)),
414 current_plist
= Fcdr (Fcdr (current_plist
));
418 /* Go through i's plist, looking for sym */
419 tail2
= current_plist
;
420 while (! NILP (tail2
))
422 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
423 if (EQ (sym
, Fcar (this)))
425 if (XTYPE (object
) == Lisp_Buffer
)
427 modify_region (XBUFFER (object
),
428 make_number (i
->position
),
429 make_number (i
->position
+ LENGTH (i
)));
430 record_property_change (i
->position
, LENGTH (i
),
431 sym
, Fcar (Fcdr (this)), object
);
434 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
442 i
->plist
= current_plist
;
447 /* Remove all properties from interval I. Return non-zero
448 if this changes the interval. */
462 DEFUN ("text-properties-at", Ftext_properties_at
,
463 Stext_properties_at
, 1, 2, 0,
464 "Return the list of properties held by the character at POSITION\n\
465 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
466 defaults to the current buffer.\n\
467 If POSITION is at the end of OBJECT, the value is nil.")
469 Lisp_Object pos
, object
;
474 XSET (object
, Lisp_Buffer
, current_buffer
);
476 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
477 if (NULL_INTERVAL_P (i
))
479 /* If POS is at the end of the interval,
480 it means it's the end of OBJECT.
481 There are no properties at the very end,
482 since no character follows. */
483 if (XINT (pos
) == LENGTH (i
) + i
->position
)
489 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
490 "Return the value of position POS's property PROP, in OBJECT.\n\
491 OBJECT is optional and defaults to the current buffer.\n\
492 If POSITION is at the end of OBJECT, the value is nil.")
494 Lisp_Object pos
, object
;
495 register Lisp_Object prop
;
498 register Lisp_Object tail
;
501 XSET (object
, Lisp_Buffer
, current_buffer
);
502 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
503 if (NULL_INTERVAL_P (i
))
506 /* If POS is at the end of the interval,
507 it means it's the end of OBJECT.
508 There are no properties at the very end,
509 since no character follows. */
510 if (XINT (pos
) == LENGTH (i
) + i
->position
)
513 return textget (i
->plist
, prop
);
516 DEFUN ("next-property-change", Fnext_property_change
,
517 Snext_property_change
, 1, 2, 0,
518 "Return the position of next property change.\n\
519 Scans characters forward from POS in OBJECT till it finds\n\
520 a change in some text property, then returns the position of the change.\n\
521 The optional second argument OBJECT is the string or buffer to scan.\n\
522 Return nil if the property is constant all the way to the end of OBJECT.\n\
523 If the value is non-nil, it is a position greater than POS, never equal.")
525 Lisp_Object pos
, object
;
527 register INTERVAL i
, next
;
530 XSET (object
, Lisp_Buffer
, current_buffer
);
532 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
533 if (NULL_INTERVAL_P (i
))
536 next
= next_interval (i
);
537 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
538 next
= next_interval (next
);
540 if (NULL_INTERVAL_P (next
))
543 return next
->position
- (XTYPE (object
) == Lisp_String
);
547 DEFUN ("next-single-property-change", Fnext_single_property_change
,
548 Snext_single_property_change
, 1, 3, 0,
549 "Return the position of next property change for a specific property.\n\
550 Scans characters forward from POS till it finds\n\
551 a change in the PROP property, then returns the position of the change.\n\
552 The optional third argument OBJECT is the string or buffer to scan.\n\
553 Return nil if the property is constant all the way to the end of OBJECT.\n\
554 If the value is non-nil, it is a position greater than POS, never equal.")
556 Lisp_Object pos
, prop
, object
;
558 register INTERVAL i
, next
;
559 register Lisp_Object here_val
;
562 XSET (object
, Lisp_Buffer
, current_buffer
);
564 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
565 if (NULL_INTERVAL_P (i
))
568 here_val
= textget (i
->plist
, prop
);
569 next
= next_interval (i
);
570 while (! NULL_INTERVAL_P (next
)
571 && EQ (here_val
, textget (next
->plist
, prop
)))
572 next
= next_interval (next
);
574 if (NULL_INTERVAL_P (next
))
577 return next
->position
- (XTYPE (object
) == Lisp_String
);
580 DEFUN ("previous-property-change", Fprevious_property_change
,
581 Sprevious_property_change
, 1, 2, 0,
582 "Return the position of previous property change.\n\
583 Scans characters backwards from POS in OBJECT till it finds\n\
584 a change in some text property, then returns the position of the change.\n\
585 The optional second argument OBJECT is the string or buffer to scan.\n\
586 Return nil if the property is constant all the way to the start of OBJECT.\n\
587 If the value is non-nil, it is a position less than POS, never equal.")
589 Lisp_Object pos
, object
;
591 register INTERVAL i
, previous
;
594 XSET (object
, Lisp_Buffer
, current_buffer
);
596 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
597 if (NULL_INTERVAL_P (i
))
600 previous
= previous_interval (i
);
601 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
602 previous
= previous_interval (previous
);
603 if (NULL_INTERVAL_P (previous
))
606 return (previous
->position
+ LENGTH (previous
) - 1
607 - (XTYPE (object
) == Lisp_String
));
610 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
611 Sprevious_single_property_change
, 2, 3, 0,
612 "Return the position of previous property change for a specific property.\n\
613 Scans characters backward from POS till it finds\n\
614 a change in the PROP property, then returns the position of the change.\n\
615 The optional third argument OBJECT is the string or buffer to scan.\n\
616 Return nil if the property is constant all the way to the start of OBJECT.\n\
617 If the value is non-nil, it is a position less than POS, never equal.")
619 Lisp_Object pos
, prop
, object
;
621 register INTERVAL i
, previous
;
622 register Lisp_Object here_val
;
625 XSET (object
, Lisp_Buffer
, current_buffer
);
627 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
628 if (NULL_INTERVAL_P (i
))
631 here_val
= textget (i
->plist
, prop
);
632 previous
= previous_interval (i
);
633 while (! NULL_INTERVAL_P (previous
)
634 && EQ (here_val
, textget (previous
->plist
, prop
)))
635 previous
= previous_interval (previous
);
636 if (NULL_INTERVAL_P (previous
))
639 return (previous
->position
+ LENGTH (previous
) - 1
640 - (XTYPE (object
) == Lisp_String
));
643 DEFUN ("add-text-properties", Fadd_text_properties
,
644 Sadd_text_properties
, 3, 4, 0,
645 "Add properties to the text from START to END.\n\
646 The third argument PROPS is a property list\n\
647 specifying the property values to add.\n\
648 The optional fourth argument, OBJECT,\n\
649 is the string or buffer containing the text.\n\
650 Return t if any property value actually changed, nil otherwise.")
651 (start
, end
, properties
, object
)
652 Lisp_Object start
, end
, properties
, object
;
654 register INTERVAL i
, unchanged
;
655 register int s
, len
, modified
= 0;
657 properties
= validate_plist (properties
);
658 if (NILP (properties
))
662 XSET (object
, Lisp_Buffer
, current_buffer
);
664 i
= validate_interval_range (object
, &start
, &end
, hard
);
665 if (NULL_INTERVAL_P (i
))
669 len
= XINT (end
) - s
;
671 /* If we're not starting on an interval boundary, we have to
672 split this interval. */
673 if (i
->position
!= s
)
675 /* If this interval already has the properties, we can
677 if (interval_has_all_properties (properties
, i
))
679 int got
= (LENGTH (i
) - (s
- i
->position
));
683 i
= next_interval (i
);
688 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
689 copy_properties (unchanged
, i
);
693 /* We are at the beginning of interval I, with LEN chars to scan. */
699 if (LENGTH (i
) >= len
)
701 if (interval_has_all_properties (properties
, i
))
702 return modified
? Qt
: Qnil
;
704 if (LENGTH (i
) == len
)
706 add_properties (properties
, i
, object
);
710 /* i doesn't have the properties, and goes past the change limit */
712 i
= split_interval_left (unchanged
, len
);
713 copy_properties (unchanged
, i
);
714 add_properties (properties
, i
, object
);
719 modified
+= add_properties (properties
, i
, object
);
720 i
= next_interval (i
);
724 DEFUN ("put-text-property", Fput_text_property
,
725 Sput_text_property
, 4, 5, 0,
726 "Set one property of the text from START to END.\n\
727 The third and fourth arguments PROP and VALUE\n\
728 specify the property to add.\n\
729 The optional fifth argument, OBJECT,\n\
730 is the string or buffer containing the text.")
731 (start
, end
, prop
, value
, object
)
732 Lisp_Object start
, end
, prop
, value
, object
;
734 Fadd_text_properties (start
, end
,
735 Fcons (prop
, Fcons (value
, Qnil
)),
740 DEFUN ("set-text-properties", Fset_text_properties
,
741 Sset_text_properties
, 3, 4, 0,
742 "Completely replace properties of text from START to END.\n\
743 The third argument PROPS is the new property list.\n\
744 The optional fourth argument, OBJECT,\n\
745 is the string or buffer containing the text.")
746 (start
, end
, props
, object
)
747 Lisp_Object start
, end
, props
, object
;
749 register INTERVAL i
, unchanged
;
750 register INTERVAL prev_changed
= NULL_INTERVAL
;
753 props
= validate_plist (props
);
756 XSET (object
, Lisp_Buffer
, current_buffer
);
758 i
= validate_interval_range (object
, &start
, &end
, hard
);
759 if (NULL_INTERVAL_P (i
))
763 len
= XINT (end
) - s
;
765 if (i
->position
!= s
)
768 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
770 if (LENGTH (i
) > len
)
772 copy_properties (unchanged
, i
);
773 i
= split_interval_left (i
, len
);
774 set_properties (props
, i
, object
);
778 set_properties (props
, i
, object
);
780 if (LENGTH (i
) == len
)
785 i
= next_interval (i
);
788 /* We are starting at the beginning of an interval, I */
794 if (LENGTH (i
) >= len
)
796 if (LENGTH (i
) > len
)
797 i
= split_interval_left (i
, len
);
799 if (NULL_INTERVAL_P (prev_changed
))
800 set_properties (props
, i
, object
);
802 merge_interval_left (i
);
807 if (NULL_INTERVAL_P (prev_changed
))
809 set_properties (props
, i
, object
);
813 prev_changed
= i
= merge_interval_left (i
);
815 i
= next_interval (i
);
821 DEFUN ("remove-text-properties", Fremove_text_properties
,
822 Sremove_text_properties
, 3, 4, 0,
823 "Remove some properties from text from START to END.\n\
824 The third argument PROPS is a property list\n\
825 whose property names specify the properties to remove.\n\
826 \(The values stored in PROPS are ignored.)\n\
827 The optional fourth argument, OBJECT,\n\
828 is the string or buffer containing the text.\n\
829 Return t if any property was actually removed, nil otherwise.")
830 (start
, end
, props
, object
)
831 Lisp_Object start
, end
, props
, object
;
833 register INTERVAL i
, unchanged
;
834 register int s
, len
, modified
= 0;
837 XSET (object
, Lisp_Buffer
, current_buffer
);
839 i
= validate_interval_range (object
, &start
, &end
, soft
);
840 if (NULL_INTERVAL_P (i
))
844 len
= XINT (end
) - s
;
846 if (i
->position
!= s
)
848 /* No properties on this first interval -- return if
849 it covers the entire region. */
850 if (! interval_has_some_properties (props
, i
))
852 int got
= (LENGTH (i
) - (s
- i
->position
));
856 i
= next_interval (i
);
858 /* Split away the beginning of this interval; what we don't
863 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
864 copy_properties (unchanged
, i
);
868 /* We are at the beginning of an interval, with len to scan */
874 if (LENGTH (i
) >= len
)
876 if (! interval_has_some_properties (props
, i
))
877 return modified
? Qt
: Qnil
;
879 if (LENGTH (i
) == len
)
881 remove_properties (props
, i
, object
);
885 /* i has the properties, and goes past the change limit */
887 i
= split_interval_left (i
, len
);
888 copy_properties (unchanged
, i
);
889 remove_properties (props
, i
, object
);
894 modified
+= remove_properties (props
, i
, object
);
895 i
= next_interval (i
);
899 DEFUN ("text-property-any", Ftext_property_any
,
900 Stext_property_any
, 4, 5, 0,
901 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
902 If so, return the position of the first character whose PROP is `eq'\n\
903 to VALUE. Otherwise return nil.\n\
904 The optional fifth argument, OBJECT, is the string or buffer\n\
905 containing the text.")
906 (start
, end
, prop
, value
, object
)
907 Lisp_Object start
, end
, prop
, value
, object
;
913 XSET (object
, Lisp_Buffer
, current_buffer
);
914 i
= validate_interval_range (object
, &start
, &end
, soft
);
917 while (! NULL_INTERVAL_P (i
))
919 if (i
->position
>= e
)
921 if (EQ (textget (i
->plist
, prop
), value
))
924 if (pos
< XINT (start
))
926 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
928 i
= next_interval (i
);
933 DEFUN ("text-property-not-all", Ftext_property_not_all
,
934 Stext_property_not_all
, 4, 5, 0,
935 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
936 If so, return the position of the first character whose PROP is not\n\
937 `eq' to VALUE. Otherwise, return nil.\n\
938 The optional fifth argument, OBJECT, is the string or buffer\n\
939 containing the text.")
940 (start
, end
, prop
, value
, object
)
941 Lisp_Object start
, end
, prop
, value
, object
;
947 XSET (object
, Lisp_Buffer
, current_buffer
);
948 i
= validate_interval_range (object
, &start
, &end
, soft
);
949 if (NULL_INTERVAL_P (i
))
950 return (NILP (value
) || EQ (start
, end
)) ? Qt
: Qnil
;
954 while (! NULL_INTERVAL_P (i
))
956 if (i
->position
>= e
)
958 if (! EQ (textget (i
->plist
, prop
), value
))
962 return make_number (s
- (XTYPE (object
) == Lisp_String
));
964 i
= next_interval (i
);
969 #if 0 /* You can use set-text-properties for this. */
971 DEFUN ("erase-text-properties", Ferase_text_properties
,
972 Serase_text_properties
, 2, 3, 0,
973 "Remove all properties from the text from START to END.\n\
974 The optional third argument, OBJECT,\n\
975 is the string or buffer containing the text.")
977 Lisp_Object start
, end
, object
;
980 register INTERVAL prev_changed
= NULL_INTERVAL
;
981 register int s
, len
, modified
;
984 XSET (object
, Lisp_Buffer
, current_buffer
);
986 i
= validate_interval_range (object
, &start
, &end
, soft
);
987 if (NULL_INTERVAL_P (i
))
991 len
= XINT (end
) - s
;
993 if (i
->position
!= s
)
996 register INTERVAL unchanged
= i
;
998 /* If there are properties here, then this text will be modified. */
999 if (! NILP (i
->plist
))
1001 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1005 if (LENGTH (i
) > len
)
1007 i
= split_interval_right (i
, len
);
1008 copy_properties (unchanged
, i
);
1012 if (LENGTH (i
) == len
)
1017 /* If the text of I is without any properties, and contains
1018 LEN or more characters, then we may return without changing
1020 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1022 /* The amount of text to change extends past I, so just note
1023 how much we've gotten. */
1025 got
= LENGTH (i
) - (s
- i
->position
);
1029 i
= next_interval (i
);
1032 /* We are starting at the beginning of an interval, I. */
1035 if (LENGTH (i
) >= len
)
1037 /* If I has no properties, simply merge it if possible. */
1038 if (NILP (i
->plist
))
1040 if (! NULL_INTERVAL_P (prev_changed
))
1041 merge_interval_left (i
);
1043 return modified
? Qt
: Qnil
;
1046 if (LENGTH (i
) > len
)
1047 i
= split_interval_left (i
, len
);
1048 if (! NULL_INTERVAL_P (prev_changed
))
1049 merge_interval_left (i
);
1056 /* Here if we still need to erase past the end of I */
1058 if (NULL_INTERVAL_P (prev_changed
))
1060 modified
+= erase_properties (i
);
1065 modified
+= ! NILP (i
->plist
);
1066 /* Merging I will give it the properties of PREV_CHANGED. */
1067 prev_changed
= i
= merge_interval_left (i
);
1070 i
= next_interval (i
);
1073 return modified
? Qt
: Qnil
;
1077 /* I don't think this is the right interface to export; how often do you
1078 want to do something like this, other than when you're copying objects
1081 I think it would be better to have a pair of functions, one which
1082 returns the text properties of a region as a list of ranges and
1083 plists, and another which applies such a list to another object. */
1085 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1086 Scopy_text_properties, 5, 6, 0,
1087 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1088 SRC and DEST may each refer to strings or buffers.\n\
1089 Optional sixth argument PROP causes only that property to be copied.\n\
1090 Properties are copied to DEST as if by `add-text-properties'.\n\
1091 Return t if any property value actually changed, nil otherwise.") */
1094 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1095 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1101 int s
, e
, e2
, p
, len
, modified
= 0;
1103 i
= validate_interval_range (src
, &start
, &end
, soft
);
1104 if (NULL_INTERVAL_P (i
))
1107 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1109 Lisp_Object dest_start
, dest_end
;
1112 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1113 /* Apply this to a copy of pos; it will try to increment its arguments,
1114 which we don't want. */
1115 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1126 e2
= i
->position
+ LENGTH (i
);
1133 while (! NILP (plist
))
1135 if (EQ (Fcar (plist
), prop
))
1137 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1140 plist
= Fcdr (Fcdr (plist
));
1144 /* Must defer modifications to the interval tree in case src
1145 and dest refer to the same string or buffer. */
1146 stuff
= Fcons (Fcons (make_number (p
),
1147 Fcons (make_number (p
+ len
),
1148 Fcons (plist
, Qnil
))),
1152 i
= next_interval (i
);
1153 if (NULL_INTERVAL_P (i
))
1160 while (! NILP (stuff
))
1163 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1164 Fcar (Fcdr (Fcdr (res
))), dest
);
1167 stuff
= Fcdr (stuff
);
1170 return modified
? Qt
: Qnil
;
1176 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1177 "Threshold for rebalancing interval trees, expressed as the\n\
1178 percentage by which the left interval tree should not differ from the right.");
1179 interval_balance_threshold
= 8;
1181 /* Common attributes one might give text */
1183 staticpro (&Qforeground
);
1184 Qforeground
= intern ("foreground");
1185 staticpro (&Qbackground
);
1186 Qbackground
= intern ("background");
1188 Qfont
= intern ("font");
1189 staticpro (&Qstipple
);
1190 Qstipple
= intern ("stipple");
1191 staticpro (&Qunderline
);
1192 Qunderline
= intern ("underline");
1193 staticpro (&Qread_only
);
1194 Qread_only
= intern ("read-only");
1195 staticpro (&Qinvisible
);
1196 Qinvisible
= intern ("invisible");
1197 staticpro (&Qcategory
);
1198 Qcategory
= intern ("category");
1199 staticpro (&Qlocal_map
);
1200 Qlocal_map
= intern ("local-map");
1202 /* Properties that text might use to specify certain actions */
1204 staticpro (&Qmouse_left
);
1205 Qmouse_left
= intern ("mouse-left");
1206 staticpro (&Qmouse_entered
);
1207 Qmouse_entered
= intern ("mouse-entered");
1208 staticpro (&Qpoint_left
);
1209 Qpoint_left
= intern ("point-left");
1210 staticpro (&Qpoint_entered
);
1211 Qpoint_entered
= intern ("point-entered");
1213 defsubr (&Stext_properties_at
);
1214 defsubr (&Sget_text_property
);
1215 defsubr (&Snext_property_change
);
1216 defsubr (&Snext_single_property_change
);
1217 defsubr (&Sprevious_property_change
);
1218 defsubr (&Sprevious_single_property_change
);
1219 defsubr (&Sadd_text_properties
);
1220 defsubr (&Sput_text_property
);
1221 defsubr (&Sset_text_properties
);
1222 defsubr (&Sremove_text_properties
);
1223 defsubr (&Stext_property_any
);
1224 defsubr (&Stext_property_not_all
);
1225 /* defsubr (&Serase_text_properties); */
1226 /* defsubr (&Scopy_text_properties); */
1231 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1233 #endif /* USE_TEXT_PROPERTIES */