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
, Qhidden
;
53 /* Sticky properties */
54 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
56 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
57 the o1's cdr. Otherwise, return zero. This is handy for
59 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr))
61 Lisp_Object Vinhibit_point_motion_hooks
;
64 /* Extract the interval at the position pointed to by BEGIN from
65 OBJECT, a string or buffer. Additionally, check that the positions
66 pointed to by BEGIN and END are within the bounds of OBJECT, and
67 reverse them if *BEGIN is greater than *END. The objects pointed
68 to by BEGIN and END may be integers or markers; if the latter, they
69 are coerced to integers.
71 When OBJECT is a string, we increment *BEGIN and *END
72 to make them origin-one.
74 Note that buffer points don't correspond to interval indices.
75 For example, point-max is 1 greater than the index of the last
76 character. This difference is handled in the caller, which uses
77 the validated points to determine a length, and operates on that.
78 Exceptions are Ftext_properties_at, Fnext_property_change, and
79 Fprevious_property_change which call this function with BEGIN == END.
80 Handle this case specially.
82 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
83 create an interval tree for OBJECT if one doesn't exist, provided
84 the object actually contains text. In the current design, if there
85 is no text, there can be no text properties. */
91 validate_interval_range (object
, begin
, end
, force
)
92 Lisp_Object object
, *begin
, *end
;
98 CHECK_STRING_OR_BUFFER (object
, 0);
99 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
100 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
102 /* If we are asked for a point, but from a subr which operates
103 on a range, then return nothing. */
104 if (*begin
== *end
&& begin
!= end
)
105 return NULL_INTERVAL
;
107 if (XINT (*begin
) > XINT (*end
))
115 if (XTYPE (object
) == Lisp_Buffer
)
117 register struct buffer
*b
= XBUFFER (object
);
119 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
120 && XINT (*end
) <= BUF_ZV (b
)))
121 args_out_of_range (*begin
, *end
);
124 /* If there's no text, there are no properties. */
125 if (BUF_BEGV (b
) == BUF_ZV (b
))
126 return NULL_INTERVAL
;
128 searchpos
= XINT (*begin
);
132 register struct Lisp_String
*s
= XSTRING (object
);
134 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
135 && XINT (*end
) <= s
->size
))
136 args_out_of_range (*begin
, *end
);
137 /* User-level Positions in strings start with 0,
138 but the interval code always wants positions starting with 1. */
139 XFASTINT (*begin
) += 1;
141 XFASTINT (*end
) += 1;
145 return NULL_INTERVAL
;
147 searchpos
= XINT (*begin
);
150 if (NULL_INTERVAL_P (i
))
151 return (force
? create_root_interval (object
) : i
);
153 return find_interval (i
, searchpos
);
156 /* Validate LIST as a property list. If LIST is not a list, then
157 make one consisting of (LIST nil). Otherwise, verify that LIST
158 is even numbered and thus suitable as a plist. */
161 validate_plist (list
)
169 register Lisp_Object tail
;
170 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
176 error ("Odd length text property list");
180 return Fcons (list
, Fcons (Qnil
, Qnil
));
183 /* Return nonzero if interval I has all the properties,
184 with the same values, of list PLIST. */
187 interval_has_all_properties (plist
, i
)
191 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
194 /* Go through each element of PLIST. */
195 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
200 /* Go through I's plist, looking for sym1 */
201 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
202 if (EQ (sym1
, Fcar (tail2
)))
204 /* Found the same property on both lists. If the
205 values are unequal, return zero. */
206 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
209 /* Property has same value on both lists; go to next one. */
221 /* Return nonzero if the plist of interval I has any of the
222 properties of PLIST, regardless of their values. */
225 interval_has_some_properties (plist
, i
)
229 register Lisp_Object tail1
, tail2
, sym
;
231 /* Go through each element of PLIST. */
232 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
236 /* Go through i's plist, looking for tail1 */
237 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
238 if (EQ (sym
, Fcar (tail2
)))
245 /* Changing the plists of individual intervals. */
247 /* Return the value of PROP in property-list PLIST, or Qunbound if it
250 property_value (plist
, prop
)
254 while (PLIST_ELT_P (plist
, value
))
255 if (EQ (XCONS (plist
)->car
, prop
))
256 return XCONS (value
)->car
;
258 plist
= XCONS (value
)->cdr
;
263 /* Set the properties of INTERVAL to PROPERTIES,
264 and record undo info for the previous values.
265 OBJECT is the string or buffer that INTERVAL belongs to. */
268 set_properties (properties
, interval
, object
)
269 Lisp_Object properties
, object
;
272 Lisp_Object sym
, value
;
274 if (BUFFERP (object
))
276 /* For each property in the old plist which is missing from PROPERTIES,
277 or has a different value in PROPERTIES, make an undo record. */
278 for (sym
= interval
->plist
;
279 PLIST_ELT_P (sym
, value
);
280 sym
= XCONS (value
)->cdr
)
281 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
284 modify_region (XBUFFER (object
),
285 make_number (interval
->position
),
286 make_number (interval
->position
+ LENGTH (interval
)));
287 record_property_change (interval
->position
, LENGTH (interval
),
288 XCONS (sym
)->car
, XCONS (value
)->car
,
292 /* For each new property that has no value at all in the old plist,
293 make an undo record binding it to nil, so it will be removed. */
294 for (sym
= properties
;
295 PLIST_ELT_P (sym
, value
);
296 sym
= XCONS (value
)->cdr
)
297 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
299 modify_region (XBUFFER (object
),
300 make_number (interval
->position
),
301 make_number (interval
->position
+ LENGTH (interval
)));
302 record_property_change (interval
->position
, LENGTH (interval
),
303 XCONS (sym
)->car
, Qnil
,
308 /* Store new properties. */
309 interval
->plist
= Fcopy_sequence (properties
);
312 /* Add the properties of PLIST to the interval I, or set
313 the value of I's property to the value of the property on PLIST
314 if they are different.
316 OBJECT should be the string or buffer the interval is in.
318 Return nonzero if this changes I (i.e., if any members of PLIST
319 are actually added to I's plist) */
322 add_properties (plist
, i
, object
)
327 register Lisp_Object tail1
, tail2
, sym1
, val1
;
328 register int changed
= 0;
331 /* Go through each element of PLIST. */
332 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
335 val1
= Fcar (Fcdr (tail1
));
338 /* Go through I's plist, looking for sym1 */
339 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
340 if (EQ (sym1
, Fcar (tail2
)))
342 register Lisp_Object this_cdr
= Fcdr (tail2
);
344 /* Found the property. Now check its value. */
347 /* The properties have the same value on both lists.
348 Continue to the next property. */
349 if (EQ (val1
, Fcar (this_cdr
)))
352 /* Record this change in the buffer, for undo purposes. */
353 if (XTYPE (object
) == Lisp_Buffer
)
355 modify_region (XBUFFER (object
),
356 make_number (i
->position
),
357 make_number (i
->position
+ LENGTH (i
)));
358 record_property_change (i
->position
, LENGTH (i
),
359 sym1
, Fcar (this_cdr
), object
);
362 /* I's property has a different value -- change it */
363 Fsetcar (this_cdr
, val1
);
370 /* Record this change in the buffer, for undo purposes. */
371 if (XTYPE (object
) == Lisp_Buffer
)
373 modify_region (XBUFFER (object
),
374 make_number (i
->position
),
375 make_number (i
->position
+ LENGTH (i
)));
376 record_property_change (i
->position
, LENGTH (i
),
379 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
387 /* For any members of PLIST which are properties of I, remove them
389 OBJECT is the string or buffer containing I. */
392 remove_properties (plist
, i
, object
)
397 register Lisp_Object tail1
, tail2
, sym
;
398 register Lisp_Object current_plist
= i
->plist
;
399 register int changed
= 0;
401 /* Go through each element of plist. */
402 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
406 /* First, remove the symbol if its at the head of the list */
407 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
409 if (XTYPE (object
) == Lisp_Buffer
)
411 modify_region (XBUFFER (object
),
412 make_number (i
->position
),
413 make_number (i
->position
+ LENGTH (i
)));
414 record_property_change (i
->position
, LENGTH (i
),
415 sym
, Fcar (Fcdr (current_plist
)),
419 current_plist
= Fcdr (Fcdr (current_plist
));
423 /* Go through i's plist, looking for sym */
424 tail2
= current_plist
;
425 while (! NILP (tail2
))
427 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
428 if (EQ (sym
, Fcar (this)))
430 if (XTYPE (object
) == Lisp_Buffer
)
432 modify_region (XBUFFER (object
),
433 make_number (i
->position
),
434 make_number (i
->position
+ LENGTH (i
)));
435 record_property_change (i
->position
, LENGTH (i
),
436 sym
, Fcar (Fcdr (this)), object
);
439 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
447 i
->plist
= current_plist
;
452 /* Remove all properties from interval I. Return non-zero
453 if this changes the interval. */
467 DEFUN ("text-properties-at", Ftext_properties_at
,
468 Stext_properties_at
, 1, 2, 0,
469 "Return the list of properties held by the character at POSITION\n\
470 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
471 defaults to the current buffer.\n\
472 If POSITION is at the end of OBJECT, the value is nil.")
474 Lisp_Object pos
, object
;
479 XSET (object
, Lisp_Buffer
, current_buffer
);
481 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
482 if (NULL_INTERVAL_P (i
))
484 /* If POS is at the end of the interval,
485 it means it's the end of OBJECT.
486 There are no properties at the very end,
487 since no character follows. */
488 if (XINT (pos
) == LENGTH (i
) + i
->position
)
494 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
495 "Return the value of position POS's property PROP, in OBJECT.\n\
496 OBJECT is optional and defaults to the current buffer.\n\
497 If POSITION is at the end of OBJECT, the value is nil.")
499 Lisp_Object pos
, object
;
500 register Lisp_Object prop
;
503 register Lisp_Object tail
;
506 XSET (object
, Lisp_Buffer
, current_buffer
);
507 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
508 if (NULL_INTERVAL_P (i
))
511 /* If POS is at the end of the interval,
512 it means it's the end of OBJECT.
513 There are no properties at the very end,
514 since no character follows. */
515 if (XINT (pos
) == LENGTH (i
) + i
->position
)
518 return textget (i
->plist
, prop
);
521 DEFUN ("next-property-change", Fnext_property_change
,
522 Snext_property_change
, 1, 2, 0,
523 "Return the position of next property change.\n\
524 Scans characters forward from POS in OBJECT till it finds\n\
525 a change in some text property, then returns the position of the change.\n\
526 The optional second argument OBJECT is the string or buffer to scan.\n\
527 Return nil if the property is constant all the way to the end of OBJECT.\n\
528 If the value is non-nil, it is a position greater than POS, never equal.")
530 Lisp_Object pos
, object
;
532 register INTERVAL i
, next
;
535 XSET (object
, Lisp_Buffer
, current_buffer
);
537 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
538 if (NULL_INTERVAL_P (i
))
541 next
= next_interval (i
);
542 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
543 next
= next_interval (next
);
545 if (NULL_INTERVAL_P (next
))
548 return next
->position
- (XTYPE (object
) == Lisp_String
);
551 /* Return 1 if there's a change in some property between BEG and END. */
554 property_change_between_p (beg
, end
)
557 register INTERVAL i
, next
;
558 Lisp_Object object
, pos
;
560 XSET (object
, Lisp_Buffer
, current_buffer
);
561 XFASTINT (pos
) = beg
;
563 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
564 if (NULL_INTERVAL_P (i
))
567 next
= next_interval (i
);
568 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
570 next
= next_interval (next
);
571 if (NULL_INTERVAL_P (next
))
573 if (next
->position
>= end
)
577 if (NULL_INTERVAL_P (next
))
583 DEFUN ("next-single-property-change", Fnext_single_property_change
,
584 Snext_single_property_change
, 1, 3, 0,
585 "Return the position of next property change for a specific property.\n\
586 Scans characters forward from POS till it finds\n\
587 a change in the PROP property, then returns the position of the change.\n\
588 The optional third argument OBJECT is the string or buffer to scan.\n\
589 The property values are compared with `eq'.
590 Return nil if the property is constant all the way to the end of OBJECT.\n\
591 If the value is non-nil, it is a position greater than POS, never equal.")
593 Lisp_Object pos
, prop
, object
;
595 register INTERVAL i
, next
;
596 register Lisp_Object here_val
;
599 XSET (object
, Lisp_Buffer
, current_buffer
);
601 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
602 if (NULL_INTERVAL_P (i
))
605 here_val
= textget (i
->plist
, prop
);
606 next
= next_interval (i
);
607 while (! NULL_INTERVAL_P (next
)
608 && EQ (here_val
, textget (next
->plist
, prop
)))
609 next
= next_interval (next
);
611 if (NULL_INTERVAL_P (next
))
614 return next
->position
- (XTYPE (object
) == Lisp_String
);
617 DEFUN ("previous-property-change", Fprevious_property_change
,
618 Sprevious_property_change
, 1, 2, 0,
619 "Return the position of previous property change.\n\
620 Scans characters backwards from POS in OBJECT till it finds\n\
621 a change in some text property, then returns the position of the change.\n\
622 The optional second argument OBJECT is the string or buffer to scan.\n\
623 Return nil if the property is constant all the way to the start of OBJECT.\n\
624 If the value is non-nil, it is a position less than POS, never equal.")
626 Lisp_Object pos
, object
;
628 register INTERVAL i
, previous
;
631 XSET (object
, Lisp_Buffer
, current_buffer
);
633 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
634 if (NULL_INTERVAL_P (i
))
637 previous
= previous_interval (i
);
638 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
639 previous
= previous_interval (previous
);
640 if (NULL_INTERVAL_P (previous
))
643 return (previous
->position
+ LENGTH (previous
) - 1
644 - (XTYPE (object
) == Lisp_String
));
647 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
648 Sprevious_single_property_change
, 2, 3, 0,
649 "Return the position of previous property change for a specific property.\n\
650 Scans characters backward from POS till it finds\n\
651 a change in the PROP property, then returns the position of the change.\n\
652 The optional third argument OBJECT is the string or buffer to scan.\n\
653 The property values are compared with `eq'.
654 Return nil if the property is constant all the way to the start of OBJECT.\n\
655 If the value is non-nil, it is a position less than POS, never equal.")
657 Lisp_Object pos
, prop
, object
;
659 register INTERVAL i
, previous
;
660 register Lisp_Object here_val
;
663 XSET (object
, Lisp_Buffer
, current_buffer
);
665 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
666 if (NULL_INTERVAL_P (i
))
669 here_val
= textget (i
->plist
, prop
);
670 previous
= previous_interval (i
);
671 while (! NULL_INTERVAL_P (previous
)
672 && EQ (here_val
, textget (previous
->plist
, prop
)))
673 previous
= previous_interval (previous
);
674 if (NULL_INTERVAL_P (previous
))
677 return (previous
->position
+ LENGTH (previous
) - 1
678 - (XTYPE (object
) == Lisp_String
));
681 DEFUN ("add-text-properties", Fadd_text_properties
,
682 Sadd_text_properties
, 3, 4, 0,
683 "Add properties to the text from START to END.\n\
684 The third argument PROPS is a property list\n\
685 specifying the property values to add.\n\
686 The optional fourth argument, OBJECT,\n\
687 is the string or buffer containing the text.\n\
688 Return t if any property value actually changed, nil otherwise.")
689 (start
, end
, properties
, object
)
690 Lisp_Object start
, end
, properties
, object
;
692 register INTERVAL i
, unchanged
;
693 register int s
, len
, modified
= 0;
695 properties
= validate_plist (properties
);
696 if (NILP (properties
))
700 XSET (object
, Lisp_Buffer
, current_buffer
);
702 i
= validate_interval_range (object
, &start
, &end
, hard
);
703 if (NULL_INTERVAL_P (i
))
707 len
= XINT (end
) - s
;
709 /* If we're not starting on an interval boundary, we have to
710 split this interval. */
711 if (i
->position
!= s
)
713 /* If this interval already has the properties, we can
715 if (interval_has_all_properties (properties
, i
))
717 int got
= (LENGTH (i
) - (s
- i
->position
));
721 i
= next_interval (i
);
726 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
727 copy_properties (unchanged
, i
);
731 /* We are at the beginning of interval I, with LEN chars to scan. */
737 if (LENGTH (i
) >= len
)
739 if (interval_has_all_properties (properties
, i
))
740 return modified
? Qt
: Qnil
;
742 if (LENGTH (i
) == len
)
744 add_properties (properties
, i
, object
);
748 /* i doesn't have the properties, and goes past the change limit */
750 i
= split_interval_left (unchanged
, len
);
751 copy_properties (unchanged
, i
);
752 add_properties (properties
, i
, object
);
757 modified
+= add_properties (properties
, i
, object
);
758 i
= next_interval (i
);
762 DEFUN ("put-text-property", Fput_text_property
,
763 Sput_text_property
, 4, 5, 0,
764 "Set one property of the text from START to END.\n\
765 The third and fourth arguments PROP and VALUE\n\
766 specify the property to add.\n\
767 The optional fifth argument, OBJECT,\n\
768 is the string or buffer containing the text.")
769 (start
, end
, prop
, value
, object
)
770 Lisp_Object start
, end
, prop
, value
, object
;
772 Fadd_text_properties (start
, end
,
773 Fcons (prop
, Fcons (value
, Qnil
)),
778 DEFUN ("set-text-properties", Fset_text_properties
,
779 Sset_text_properties
, 3, 4, 0,
780 "Completely replace properties of text from START to END.\n\
781 The third argument PROPS is the new property list.\n\
782 The optional fourth argument, OBJECT,\n\
783 is the string or buffer containing the text.")
784 (start
, end
, props
, object
)
785 Lisp_Object start
, end
, props
, object
;
787 register INTERVAL i
, unchanged
;
788 register INTERVAL prev_changed
= NULL_INTERVAL
;
791 props
= validate_plist (props
);
794 XSET (object
, Lisp_Buffer
, current_buffer
);
796 i
= validate_interval_range (object
, &start
, &end
, hard
);
797 if (NULL_INTERVAL_P (i
))
801 len
= XINT (end
) - s
;
803 if (i
->position
!= s
)
806 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
808 if (LENGTH (i
) > len
)
810 copy_properties (unchanged
, i
);
811 i
= split_interval_left (i
, len
);
812 set_properties (props
, i
, object
);
816 set_properties (props
, i
, object
);
818 if (LENGTH (i
) == len
)
823 i
= next_interval (i
);
826 /* We are starting at the beginning of an interval, I */
832 if (LENGTH (i
) >= len
)
834 if (LENGTH (i
) > len
)
835 i
= split_interval_left (i
, len
);
837 if (NULL_INTERVAL_P (prev_changed
))
838 set_properties (props
, i
, object
);
840 merge_interval_left (i
);
845 if (NULL_INTERVAL_P (prev_changed
))
847 set_properties (props
, i
, object
);
851 prev_changed
= i
= merge_interval_left (i
);
853 i
= next_interval (i
);
859 DEFUN ("remove-text-properties", Fremove_text_properties
,
860 Sremove_text_properties
, 3, 4, 0,
861 "Remove some properties from text from START to END.\n\
862 The third argument PROPS is a property list\n\
863 whose property names specify the properties to remove.\n\
864 \(The values stored in PROPS are ignored.)\n\
865 The optional fourth argument, OBJECT,\n\
866 is the string or buffer containing the text.\n\
867 Return t if any property was actually removed, nil otherwise.")
868 (start
, end
, props
, object
)
869 Lisp_Object start
, end
, props
, object
;
871 register INTERVAL i
, unchanged
;
872 register int s
, len
, modified
= 0;
875 XSET (object
, Lisp_Buffer
, current_buffer
);
877 i
= validate_interval_range (object
, &start
, &end
, soft
);
878 if (NULL_INTERVAL_P (i
))
882 len
= XINT (end
) - s
;
884 if (i
->position
!= s
)
886 /* No properties on this first interval -- return if
887 it covers the entire region. */
888 if (! interval_has_some_properties (props
, i
))
890 int got
= (LENGTH (i
) - (s
- i
->position
));
894 i
= next_interval (i
);
896 /* Split away the beginning of this interval; what we don't
901 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
902 copy_properties (unchanged
, i
);
906 /* We are at the beginning of an interval, with len to scan */
912 if (LENGTH (i
) >= len
)
914 if (! interval_has_some_properties (props
, i
))
915 return modified
? Qt
: Qnil
;
917 if (LENGTH (i
) == len
)
919 remove_properties (props
, i
, object
);
923 /* i has the properties, and goes past the change limit */
925 i
= split_interval_left (i
, len
);
926 copy_properties (unchanged
, i
);
927 remove_properties (props
, i
, object
);
932 modified
+= remove_properties (props
, i
, object
);
933 i
= next_interval (i
);
937 DEFUN ("text-property-any", Ftext_property_any
,
938 Stext_property_any
, 4, 5, 0,
939 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
940 If so, return the position of the first character whose PROP is `eq'\n\
941 to VALUE. Otherwise return nil.\n\
942 The optional fifth argument, OBJECT, is the string or buffer\n\
943 containing the text.")
944 (start
, end
, prop
, value
, object
)
945 Lisp_Object start
, end
, prop
, value
, object
;
951 XSET (object
, Lisp_Buffer
, current_buffer
);
952 i
= validate_interval_range (object
, &start
, &end
, soft
);
955 while (! NULL_INTERVAL_P (i
))
957 if (i
->position
>= e
)
959 if (EQ (textget (i
->plist
, prop
), value
))
962 if (pos
< XINT (start
))
964 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
966 i
= next_interval (i
);
971 DEFUN ("text-property-not-all", Ftext_property_not_all
,
972 Stext_property_not_all
, 4, 5, 0,
973 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
974 If so, return the position of the first character whose PROP is not\n\
975 `eq' to VALUE. Otherwise, return nil.\n\
976 The optional fifth argument, OBJECT, is the string or buffer\n\
977 containing the text.")
978 (start
, end
, prop
, value
, object
)
979 Lisp_Object start
, end
, prop
, value
, object
;
985 XSET (object
, Lisp_Buffer
, current_buffer
);
986 i
= validate_interval_range (object
, &start
, &end
, soft
);
987 if (NULL_INTERVAL_P (i
))
988 return (NILP (value
) || EQ (start
, end
)) ? Qt
: Qnil
;
992 while (! NULL_INTERVAL_P (i
))
994 if (i
->position
>= e
)
996 if (! EQ (textget (i
->plist
, prop
), value
))
1000 return make_number (s
- (XTYPE (object
) == Lisp_String
));
1002 i
= next_interval (i
);
1007 #if 0 /* You can use set-text-properties for this. */
1009 DEFUN ("erase-text-properties", Ferase_text_properties
,
1010 Serase_text_properties
, 2, 3, 0,
1011 "Remove all properties from the text from START to END.\n\
1012 The optional third argument, OBJECT,\n\
1013 is the string or buffer containing the text.")
1014 (start
, end
, object
)
1015 Lisp_Object start
, end
, object
;
1017 register INTERVAL i
;
1018 register INTERVAL prev_changed
= NULL_INTERVAL
;
1019 register int s
, len
, modified
;
1022 XSET (object
, Lisp_Buffer
, current_buffer
);
1024 i
= validate_interval_range (object
, &start
, &end
, soft
);
1025 if (NULL_INTERVAL_P (i
))
1029 len
= XINT (end
) - s
;
1031 if (i
->position
!= s
)
1034 register INTERVAL unchanged
= i
;
1036 /* If there are properties here, then this text will be modified. */
1037 if (! NILP (i
->plist
))
1039 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1043 if (LENGTH (i
) > len
)
1045 i
= split_interval_right (i
, len
);
1046 copy_properties (unchanged
, i
);
1050 if (LENGTH (i
) == len
)
1055 /* If the text of I is without any properties, and contains
1056 LEN or more characters, then we may return without changing
1058 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1060 /* The amount of text to change extends past I, so just note
1061 how much we've gotten. */
1063 got
= LENGTH (i
) - (s
- i
->position
);
1067 i
= next_interval (i
);
1070 /* We are starting at the beginning of an interval, I. */
1073 if (LENGTH (i
) >= len
)
1075 /* If I has no properties, simply merge it if possible. */
1076 if (NILP (i
->plist
))
1078 if (! NULL_INTERVAL_P (prev_changed
))
1079 merge_interval_left (i
);
1081 return modified
? Qt
: Qnil
;
1084 if (LENGTH (i
) > len
)
1085 i
= split_interval_left (i
, len
);
1086 if (! NULL_INTERVAL_P (prev_changed
))
1087 merge_interval_left (i
);
1094 /* Here if we still need to erase past the end of I */
1096 if (NULL_INTERVAL_P (prev_changed
))
1098 modified
+= erase_properties (i
);
1103 modified
+= ! NILP (i
->plist
);
1104 /* Merging I will give it the properties of PREV_CHANGED. */
1105 prev_changed
= i
= merge_interval_left (i
);
1108 i
= next_interval (i
);
1111 return modified
? Qt
: Qnil
;
1115 /* I don't think this is the right interface to export; how often do you
1116 want to do something like this, other than when you're copying objects
1119 I think it would be better to have a pair of functions, one which
1120 returns the text properties of a region as a list of ranges and
1121 plists, and another which applies such a list to another object. */
1123 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1124 Scopy_text_properties, 5, 6, 0,
1125 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1126 SRC and DEST may each refer to strings or buffers.\n\
1127 Optional sixth argument PROP causes only that property to be copied.\n\
1128 Properties are copied to DEST as if by `add-text-properties'.\n\
1129 Return t if any property value actually changed, nil otherwise.") */
1132 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1133 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1139 int s
, e
, e2
, p
, len
, modified
= 0;
1141 i
= validate_interval_range (src
, &start
, &end
, soft
);
1142 if (NULL_INTERVAL_P (i
))
1145 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1147 Lisp_Object dest_start
, dest_end
;
1150 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1151 /* Apply this to a copy of pos; it will try to increment its arguments,
1152 which we don't want. */
1153 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1164 e2
= i
->position
+ LENGTH (i
);
1171 while (! NILP (plist
))
1173 if (EQ (Fcar (plist
), prop
))
1175 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1178 plist
= Fcdr (Fcdr (plist
));
1182 /* Must defer modifications to the interval tree in case src
1183 and dest refer to the same string or buffer. */
1184 stuff
= Fcons (Fcons (make_number (p
),
1185 Fcons (make_number (p
+ len
),
1186 Fcons (plist
, Qnil
))),
1190 i
= next_interval (i
);
1191 if (NULL_INTERVAL_P (i
))
1198 while (! NILP (stuff
))
1201 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1202 Fcar (Fcdr (Fcdr (res
))), dest
);
1205 stuff
= Fcdr (stuff
);
1208 return modified
? Qt
: Qnil
;
1214 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1215 "Threshold for rebalancing interval trees, expressed as the\n\
1216 percentage by which the left interval tree should not differ from the right.");
1217 interval_balance_threshold
= 8;
1219 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1220 "If nonnil, don't call the text property values of\n\
1221 `point-left' and `point-entered'.");
1222 Vinhibit_point_motion_hooks
= Qnil
;
1224 /* Common attributes one might give text */
1226 staticpro (&Qforeground
);
1227 Qforeground
= intern ("foreground");
1228 staticpro (&Qbackground
);
1229 Qbackground
= intern ("background");
1231 Qfont
= intern ("font");
1232 staticpro (&Qstipple
);
1233 Qstipple
= intern ("stipple");
1234 staticpro (&Qunderline
);
1235 Qunderline
= intern ("underline");
1236 staticpro (&Qread_only
);
1237 Qread_only
= intern ("read-only");
1238 staticpro (&Qinvisible
);
1239 Qinvisible
= intern ("invisible");
1240 staticpro (&Qhidden
);
1241 Qhidden
= intern ("hidden");
1242 staticpro (&Qcategory
);
1243 Qcategory
= intern ("category");
1244 staticpro (&Qlocal_map
);
1245 Qlocal_map
= intern ("local-map");
1246 staticpro (&Qfront_sticky
);
1247 Qfront_sticky
= intern ("front-sticky");
1248 staticpro (&Qrear_nonsticky
);
1249 Qrear_nonsticky
= intern ("rear-nonsticky");
1251 /* Properties that text might use to specify certain actions */
1253 staticpro (&Qmouse_left
);
1254 Qmouse_left
= intern ("mouse-left");
1255 staticpro (&Qmouse_entered
);
1256 Qmouse_entered
= intern ("mouse-entered");
1257 staticpro (&Qpoint_left
);
1258 Qpoint_left
= intern ("point-left");
1259 staticpro (&Qpoint_entered
);
1260 Qpoint_entered
= intern ("point-entered");
1262 defsubr (&Stext_properties_at
);
1263 defsubr (&Sget_text_property
);
1264 defsubr (&Snext_property_change
);
1265 defsubr (&Snext_single_property_change
);
1266 defsubr (&Sprevious_property_change
);
1267 defsubr (&Sprevious_single_property_change
);
1268 defsubr (&Sadd_text_properties
);
1269 defsubr (&Sput_text_property
);
1270 defsubr (&Sset_text_properties
);
1271 defsubr (&Sremove_text_properties
);
1272 defsubr (&Stext_property_any
);
1273 defsubr (&Stext_property_not_all
);
1274 /* defsubr (&Serase_text_properties); */
1275 /* defsubr (&Scopy_text_properties); */
1280 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1282 #endif /* USE_TEXT_PROPERTIES */