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 1, 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 neccessary 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 Qmodification_hooks
;
47 Lisp_Object Qcategory
;
48 Lisp_Object Qlocal_map
;
50 /* Visual properties text (including strings) may have. */
51 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
52 Lisp_Object Qinvisible
, Qread_only
;
54 /* Extract the interval at the position pointed to by BEGIN from
55 OBJECT, a string or buffer. Additionally, check that the positions
56 pointed to by BEGIN and END are within the bounds of OBJECT, and
57 reverse them if *BEGIN is greater than *END. The objects pointed
58 to by BEGIN and END may be integers or markers; if the latter, they
59 are coerced to integers.
61 When OBJECT is a string, we increment *BEGIN and *END
62 to make them origin-one.
64 Note that buffer points don't correspond to interval indices.
65 For example, point-max is 1 greater than the index of the last
66 character. This difference is handled in the caller, which uses
67 the validated points to determine a length, and operates on that.
68 Exceptions are Ftext_properties_at, Fnext_property_change, and
69 Fprevious_property_change which call this function with BEGIN == END.
70 Handle this case specially.
72 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
73 create an interval tree for OBJECT if one doesn't exist, provided
74 the object actually contains text. In the current design, if there
75 is no text, there can be no text properties. */
81 validate_interval_range (object
, begin
, end
, force
)
82 Lisp_Object object
, *begin
, *end
;
88 CHECK_STRING_OR_BUFFER (object
, 0);
89 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
90 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
92 /* If we are asked for a point, but from a subr which operates
93 on a range, then return nothing. */
94 if (*begin
== *end
&& begin
!= end
)
97 if (XINT (*begin
) > XINT (*end
))
105 if (XTYPE (object
) == Lisp_Buffer
)
107 register struct buffer
*b
= XBUFFER (object
);
109 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
110 && XINT (*end
) <= BUF_ZV (b
)))
111 args_out_of_range (*begin
, *end
);
114 /* If there's no text, there are no properties. */
115 if (BUF_BEGV (b
) == BUF_ZV (b
))
116 return NULL_INTERVAL
;
118 searchpos
= XINT (*begin
);
119 if (searchpos
== BUF_Z (b
))
122 /* Special case for point-max: return the interval for the
124 if (*begin
== *end
&& *begin
== BUF_Z (b
))
130 register struct Lisp_String
*s
= XSTRING (object
);
132 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
133 && XINT (*end
) <= s
->size
))
134 args_out_of_range (*begin
, *end
);
135 /* User-level Positions in strings start with 0,
136 but the interval code always wants positions starting with 1. */
137 XFASTINT (*begin
) += 1;
138 XFASTINT (*end
) += 1;
142 return NULL_INTERVAL
;
144 searchpos
= XINT (*begin
);
145 if (searchpos
> s
->size
)
149 if (NULL_INTERVAL_P (i
))
150 return (force
? create_root_interval (object
) : i
);
152 return find_interval (i
, searchpos
);
155 /* Validate LIST as a property list. If LIST is not a list, then
156 make one consisting of (LIST nil). Otherwise, verify that LIST
157 is even numbered and thus suitable as a plist. */
160 validate_plist (list
)
168 register Lisp_Object tail
;
169 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
172 error ("Odd length text property list");
176 return Fcons (list
, Fcons (Qnil
, Qnil
));
179 /* Return nonzero if interval I has all the properties,
180 with the same values, of list PLIST. */
183 interval_has_all_properties (plist
, i
)
187 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
190 /* Go through each element of PLIST. */
191 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
196 /* Go through I's plist, looking for sym1 */
197 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
198 if (EQ (sym1
, Fcar (tail2
)))
200 /* Found the same property on both lists. If the
201 values are unequal, return zero. */
202 if (! EQ (Fequal (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 /* Set the properties of INTERVAL to PROPERTIES,
243 and record undo info for the previous values.
244 OBJECT is the string or buffer that INTERVAL belongs to. */
247 set_properties (properties
, interval
, object
)
248 Lisp_Object properties
, object
;
251 Lisp_Object oldprops
;
252 oldprops
= interval
->plist
;
254 /* Record undo for old properties. */
255 while (XTYPE (oldprops
) == Lisp_Cons
)
258 sym
= Fcar (oldprops
);
259 record_property_change (interval
->position
, LENGTH (interval
),
260 sym
, Fcar_safe (Fcdr (oldprops
)),
263 oldprops
= Fcdr_safe (Fcdr (oldprops
));
266 /* Store new properties. */
267 interval
->plist
= Fcopy_sequence (properties
);
270 /* Add the properties of PLIST to the interval I, or set
271 the value of I's property to the value of the property on PLIST
272 if they are different.
274 OBJECT should be the string or buffer the interval is in.
276 Return nonzero if this changes I (i.e., if any members of PLIST
277 are actually added to I's plist) */
280 add_properties (plist
, i
, object
)
285 register Lisp_Object tail1
, tail2
, sym1
, val1
;
286 register int changed
= 0;
289 /* Go through each element of PLIST. */
290 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
293 val1
= Fcar (Fcdr (tail1
));
296 /* Go through I's plist, looking for sym1 */
297 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
298 if (EQ (sym1
, Fcar (tail2
)))
300 register Lisp_Object this_cdr
= Fcdr (tail2
);
302 /* Found the property. Now check its value. */
305 /* The properties have the same value on both lists.
306 Continue to the next property. */
307 if (!NILP (Fequal (val1
, Fcar (this_cdr
))))
310 /* Record this change in the buffer, for undo purposes. */
311 if (XTYPE (object
) == Lisp_Buffer
)
313 record_property_change (i
->position
, LENGTH (i
),
314 sym1
, Fcar (this_cdr
), object
);
315 modify_region (XBUFFER (object
),
316 make_number (i
->position
),
317 make_number (i
->position
+ LENGTH (i
)));
320 /* I's property has a different value -- change it */
321 Fsetcar (this_cdr
, val1
);
328 /* Record this change in the buffer, for undo purposes. */
329 if (XTYPE (object
) == Lisp_Buffer
)
331 record_property_change (i
->position
, LENGTH (i
),
333 modify_region (XBUFFER (object
),
334 make_number (i
->position
),
335 make_number (i
->position
+ LENGTH (i
)));
337 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
345 /* For any members of PLIST which are properties of I, remove them
347 OBJECT is the string or buffer containing I. */
350 remove_properties (plist
, i
, object
)
355 register Lisp_Object tail1
, tail2
, sym
;
356 register Lisp_Object current_plist
= i
->plist
;
357 register int changed
= 0;
359 /* Go through each element of plist. */
360 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
364 /* First, remove the symbol if its at the head of the list */
365 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
367 if (XTYPE (object
) == Lisp_Buffer
)
369 record_property_change (i
->position
, LENGTH (i
),
370 sym
, Fcar (Fcdr (current_plist
)),
372 modify_region (XBUFFER (object
),
373 make_number (i
->position
),
374 make_number (i
->position
+ LENGTH (i
)));
377 current_plist
= Fcdr (Fcdr (current_plist
));
381 /* Go through i's plist, looking for sym */
382 tail2
= current_plist
;
383 while (! NILP (tail2
))
385 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
386 if (EQ (sym
, Fcar (this)))
388 if (XTYPE (object
) == Lisp_Buffer
)
390 record_property_change (i
->position
, LENGTH (i
),
391 sym
, Fcar (Fcdr (this)), object
);
392 modify_region (XBUFFER (object
),
393 make_number (i
->position
),
394 make_number (i
->position
+ LENGTH (i
)));
397 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
405 i
->plist
= current_plist
;
410 /* Remove all properties from interval I. Return non-zero
411 if this changes the interval. */
425 DEFUN ("text-properties-at", Ftext_properties_at
,
426 Stext_properties_at
, 1, 2, 0,
427 "Return the list of properties held by the character at POSITION\n\
428 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
429 defaults to the current buffer.\n\
430 If POSITION is at the end of OBJECT, the value is nil.")
432 Lisp_Object pos
, object
;
437 XSET (object
, Lisp_Buffer
, current_buffer
);
439 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
440 if (NULL_INTERVAL_P (i
))
442 /* If POS is at the end of the interval,
443 it means it's the end of OBJECT.
444 There are no properties at the very end,
445 since no character follows. */
446 if (XINT (pos
) == LENGTH (i
) + i
->position
)
452 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
453 "Return the value of position POS's property PROP, in OBJECT.\n\
454 OBJECT is optional and defaults to the current buffer.\n\
455 If POSITION is at the end of OBJECT, the value is nil.")
457 Lisp_Object pos
, object
;
458 register Lisp_Object prop
;
461 register Lisp_Object tail
;
464 XSET (object
, Lisp_Buffer
, current_buffer
);
465 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
466 if (NULL_INTERVAL_P (i
))
469 /* If POS is at the end of the interval,
470 it means it's the end of OBJECT.
471 There are no properties at the very end,
472 since no character follows. */
473 if (XINT (pos
) == LENGTH (i
) + i
->position
)
476 return textget (i
->plist
, prop
);
479 DEFUN ("next-property-change", Fnext_property_change
,
480 Snext_property_change
, 1, 2, 0,
481 "Return the position of next property change.\n\
482 Scans characters forward from POS in OBJECT till it finds\n\
483 a change in some text property, then returns the position of the change.\n\
484 The optional second argument OBJECT is the string or buffer to scan.\n\
485 Return nil if the property is constant all the way to the end of OBJECT.\n\
486 If the value is non-nil, it is a position greater than POS, never equal.")
488 Lisp_Object pos
, object
;
490 register INTERVAL i
, next
;
493 XSET (object
, Lisp_Buffer
, current_buffer
);
495 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
496 if (NULL_INTERVAL_P (i
))
499 next
= next_interval (i
);
500 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
501 next
= next_interval (next
);
503 if (NULL_INTERVAL_P (next
))
506 return next
->position
- (XTYPE (object
) == Lisp_String
);
510 DEFUN ("next-single-property-change", Fnext_single_property_change
,
511 Snext_single_property_change
, 1, 3, 0,
512 "Return the position of next property change for a specific property.\n\
513 Scans characters forward from POS till it finds\n\
514 a change in the PROP property, then returns the position of the change.\n\
515 The optional third argument OBJECT is the string or buffer to scan.\n\
516 Return nil if the property is constant all the way to the end of OBJECT.\n\
517 If the value is non-nil, it is a position greater than POS, never equal.")
519 Lisp_Object pos
, prop
, object
;
521 register INTERVAL i
, next
;
522 register Lisp_Object here_val
;
525 XSET (object
, Lisp_Buffer
, current_buffer
);
527 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
528 if (NULL_INTERVAL_P (i
))
531 here_val
= textget (i
->plist
, prop
);
532 next
= next_interval (i
);
533 while (! NULL_INTERVAL_P (next
)
534 && EQ (here_val
, textget (next
->plist
, prop
)))
535 next
= next_interval (next
);
537 if (NULL_INTERVAL_P (next
))
540 return next
->position
- (XTYPE (object
) == Lisp_String
);
543 DEFUN ("previous-property-change", Fprevious_property_change
,
544 Sprevious_property_change
, 1, 2, 0,
545 "Return the position of previous property change.\n\
546 Scans characters backwards from POS in OBJECT till it finds\n\
547 a change in some text property, then returns the position of the change.\n\
548 The optional second argument OBJECT is the string or buffer to scan.\n\
549 Return nil if the property is constant all the way to the start of OBJECT.\n\
550 If the value is non-nil, it is a position less than POS, never equal.")
552 Lisp_Object pos
, object
;
554 register INTERVAL i
, previous
;
557 XSET (object
, Lisp_Buffer
, current_buffer
);
559 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
560 if (NULL_INTERVAL_P (i
))
563 previous
= previous_interval (i
);
564 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
565 previous
= previous_interval (previous
);
566 if (NULL_INTERVAL_P (previous
))
569 return (previous
->position
+ LENGTH (previous
) - 1
570 - (XTYPE (object
) == Lisp_String
));
573 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
574 Sprevious_single_property_change
, 2, 3, 0,
575 "Return the position of previous property change for a specific property.\n\
576 Scans characters backward from POS till it finds\n\
577 a change in the PROP property, then returns the position of the change.\n\
578 The optional third argument OBJECT is the string or buffer to scan.\n\
579 Return nil if the property is constant all the way to the start of OBJECT.\n\
580 If the value is non-nil, it is a position less than POS, never equal.")
582 Lisp_Object pos
, prop
, object
;
584 register INTERVAL i
, previous
;
585 register Lisp_Object here_val
;
588 XSET (object
, Lisp_Buffer
, current_buffer
);
590 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
591 if (NULL_INTERVAL_P (i
))
594 here_val
= textget (i
->plist
, prop
);
595 previous
= previous_interval (i
);
596 while (! NULL_INTERVAL_P (previous
)
597 && EQ (here_val
, textget (previous
->plist
, prop
)))
598 previous
= previous_interval (previous
);
599 if (NULL_INTERVAL_P (previous
))
602 return (previous
->position
+ LENGTH (previous
) - 1
603 - (XTYPE (object
) == Lisp_String
));
606 DEFUN ("add-text-properties", Fadd_text_properties
,
607 Sadd_text_properties
, 3, 4, 0,
608 "Add properties to the text from START to END.\n\
609 The third argument PROPS is a property list\n\
610 specifying the property values to add.\n\
611 The optional fourth argument, OBJECT,\n\
612 is the string or buffer containing the text.\n\
613 Return t if any property value actually changed, nil otherwise.")
614 (start
, end
, properties
, object
)
615 Lisp_Object start
, end
, properties
, object
;
617 register INTERVAL i
, unchanged
;
618 register int s
, len
, modified
= 0;
620 properties
= validate_plist (properties
);
621 if (NILP (properties
))
625 XSET (object
, Lisp_Buffer
, current_buffer
);
627 i
= validate_interval_range (object
, &start
, &end
, hard
);
628 if (NULL_INTERVAL_P (i
))
632 len
= XINT (end
) - s
;
634 /* If we're not starting on an interval boundary, we have to
635 split this interval. */
636 if (i
->position
!= s
)
638 /* If this interval already has the properties, we can
640 if (interval_has_all_properties (properties
, i
))
642 int got
= (LENGTH (i
) - (s
- i
->position
));
650 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
651 copy_properties (unchanged
, i
);
652 if (LENGTH (i
) > len
)
654 i
= split_interval_left (i
, len
+ 1);
655 copy_properties (unchanged
, i
);
656 add_properties (properties
, i
, object
);
660 add_properties (properties
, i
, object
);
663 i
= next_interval (i
);
667 /* We are at the beginning of an interval, with len to scan */
673 if (LENGTH (i
) >= len
)
675 if (interval_has_all_properties (properties
, i
))
676 return modified
? Qt
: Qnil
;
678 if (LENGTH (i
) == len
)
680 add_properties (properties
, i
, object
);
684 /* i doesn't have the properties, and goes past the change limit */
686 i
= split_interval_left (unchanged
, len
+ 1);
687 copy_properties (unchanged
, i
);
688 add_properties (properties
, i
, object
);
693 modified
+= add_properties (properties
, i
, object
);
694 i
= next_interval (i
);
698 DEFUN ("put-text-property", Fput_text_property
,
699 Sput_text_property
, 4, 5, 0,
700 "Set one property of the text from START to END.\n\
701 The third and fourth arguments PROP and VALUE\n\
702 specify the property to add.\n\
703 The optional fifth argument, OBJECT,\n\
704 is the string or buffer containing the text.")
705 (start
, end
, prop
, value
, object
)
706 Lisp_Object start
, end
, prop
, value
, object
;
708 Fadd_text_properties (start
, end
,
709 Fcons (prop
, Fcons (value
, Qnil
)),
714 DEFUN ("set-text-properties", Fset_text_properties
,
715 Sset_text_properties
, 3, 4, 0,
716 "Completely replace properties of text from START to END.\n\
717 The third argument PROPS is the new property list.\n\
718 The optional fourth argument, OBJECT,\n\
719 is the string or buffer containing the text.")
720 (start
, end
, props
, object
)
721 Lisp_Object start
, end
, props
, object
;
723 register INTERVAL i
, unchanged
;
724 register INTERVAL prev_changed
= NULL_INTERVAL
;
727 props
= validate_plist (props
);
732 XSET (object
, Lisp_Buffer
, current_buffer
);
734 i
= validate_interval_range (object
, &start
, &end
, hard
);
735 if (NULL_INTERVAL_P (i
))
739 len
= XINT (end
) - s
;
741 if (i
->position
!= s
)
744 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
745 set_properties (props
, i
, object
);
747 if (LENGTH (i
) > len
)
749 i
= split_interval_right (i
, len
);
750 copy_properties (unchanged
, i
);
754 if (LENGTH (i
) == len
)
759 i
= next_interval (i
);
762 /* We are starting at the beginning of an interval, I */
768 if (LENGTH (i
) >= len
)
770 if (LENGTH (i
) > len
)
771 i
= split_interval_left (i
, len
+ 1);
773 if (NULL_INTERVAL_P (prev_changed
))
774 set_properties (props
, i
, object
);
776 merge_interval_left (i
);
781 if (NULL_INTERVAL_P (prev_changed
))
783 set_properties (props
, i
, object
);
787 prev_changed
= i
= merge_interval_left (i
);
789 i
= next_interval (i
);
795 DEFUN ("remove-text-properties", Fremove_text_properties
,
796 Sremove_text_properties
, 3, 4, 0,
797 "Remove some properties from text from START to END.\n\
798 The third argument PROPS is a property list\n\
799 whose property names specify the properties to remove.\n\
800 \(The values stored in PROPS are ignored.)\n\
801 The optional fourth argument, OBJECT,\n\
802 is the string or buffer containing the text.\n\
803 Return t if any property was actually removed, nil otherwise.")
804 (start
, end
, props
, object
)
805 Lisp_Object start
, end
, props
, object
;
807 register INTERVAL i
, unchanged
;
808 register int s
, len
, modified
= 0;
811 XSET (object
, Lisp_Buffer
, current_buffer
);
813 i
= validate_interval_range (object
, &start
, &end
, soft
);
814 if (NULL_INTERVAL_P (i
))
818 len
= XINT (end
) - s
;
820 if (i
->position
!= s
)
822 /* No properties on this first interval -- return if
823 it covers the entire region. */
824 if (! interval_has_some_properties (props
, i
))
826 int got
= (LENGTH (i
) - (s
- i
->position
));
831 /* Remove the properties from this interval. If it's short
832 enough, return, splitting it if it's too short. */
836 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
837 copy_properties (unchanged
, i
);
838 if (LENGTH (i
) > len
)
840 i
= split_interval_left (i
, len
+ 1);
841 copy_properties (unchanged
, i
);
842 remove_properties (props
, i
, object
);
846 remove_properties (props
, i
, object
);
849 i
= next_interval (i
);
853 /* We are at the beginning of an interval, with len to scan */
859 if (LENGTH (i
) >= len
)
861 if (! interval_has_some_properties (props
, i
))
862 return modified
? Qt
: Qnil
;
864 if (LENGTH (i
) == len
)
866 remove_properties (props
, i
, object
);
870 /* i has the properties, and goes past the change limit */
871 unchanged
= split_interval_right (i
, len
+ 1);
872 copy_properties (unchanged
, i
);
873 remove_properties (props
, i
, object
);
878 modified
+= remove_properties (props
, i
, object
);
879 i
= next_interval (i
);
883 #if 0 /* You can use set-text-properties for this. */
885 DEFUN ("erase-text-properties", Ferase_text_properties
,
886 Serase_text_properties
, 2, 3, 0,
887 "Remove all properties from the text from START to END.\n\
888 The optional third argument, OBJECT,\n\
889 is the string or buffer containing the text.")
891 Lisp_Object start
, end
, object
;
894 register INTERVAL prev_changed
= NULL_INTERVAL
;
895 register int s
, len
, modified
;
898 XSET (object
, Lisp_Buffer
, current_buffer
);
900 i
= validate_interval_range (object
, &start
, &end
, soft
);
901 if (NULL_INTERVAL_P (i
))
905 len
= XINT (end
) - s
;
907 if (i
->position
!= s
)
910 register INTERVAL unchanged
= i
;
912 /* If there are properties here, then this text will be modified. */
913 if (! NILP (i
->plist
))
915 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
919 if (LENGTH (i
) > len
)
921 i
= split_interval_right (i
, len
+ 1);
922 copy_properties (unchanged
, i
);
926 if (LENGTH (i
) == len
)
931 /* If the text of I is without any properties, and contains
932 LEN or more characters, then we may return without changing
934 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
936 /* The amount of text to change extends past I, so just note
937 how much we've gotten. */
939 got
= LENGTH (i
) - (s
- i
->position
);
943 i
= next_interval (i
);
946 /* We are starting at the beginning of an interval, I. */
949 if (LENGTH (i
) >= len
)
951 /* If I has no properties, simply merge it if possible. */
954 if (! NULL_INTERVAL_P (prev_changed
))
955 merge_interval_left (i
);
957 return modified
? Qt
: Qnil
;
960 if (LENGTH (i
) > len
)
961 i
= split_interval_left (i
, len
+ 1);
962 if (! NULL_INTERVAL_P (prev_changed
))
963 merge_interval_left (i
);
970 /* Here if we still need to erase past the end of I */
972 if (NULL_INTERVAL_P (prev_changed
))
974 modified
+= erase_properties (i
);
979 modified
+= ! NILP (i
->plist
);
980 /* Merging I will give it the properties of PREV_CHANGED. */
981 prev_changed
= i
= merge_interval_left (i
);
984 i
= next_interval (i
);
987 return modified
? Qt
: Qnil
;
994 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
995 "Threshold for rebalancing interval trees, expressed as the\n\
996 percentage by which the left interval tree should not differ from the right.");
997 interval_balance_threshold
= 8;
999 /* Common attributes one might give text */
1001 staticpro (&Qforeground
);
1002 Qforeground
= intern ("foreground");
1003 staticpro (&Qbackground
);
1004 Qbackground
= intern ("background");
1006 Qfont
= intern ("font");
1007 staticpro (&Qstipple
);
1008 Qstipple
= intern ("stipple");
1009 staticpro (&Qunderline
);
1010 Qunderline
= intern ("underline");
1011 staticpro (&Qread_only
);
1012 Qread_only
= intern ("read-only");
1013 staticpro (&Qinvisible
);
1014 Qinvisible
= intern ("invisible");
1015 staticpro (&Qcategory
);
1016 Qcategory
= intern ("category");
1017 staticpro (&Qlocal_map
);
1018 Qlocal_map
= intern ("local-map");
1020 /* Properties that text might use to specify certain actions */
1022 staticpro (&Qmouse_left
);
1023 Qmouse_left
= intern ("mouse-left");
1024 staticpro (&Qmouse_entered
);
1025 Qmouse_entered
= intern ("mouse-entered");
1026 staticpro (&Qpoint_left
);
1027 Qpoint_left
= intern ("point-left");
1028 staticpro (&Qpoint_entered
);
1029 Qpoint_entered
= intern ("point-entered");
1030 staticpro (&Qmodification_hooks
);
1031 Qmodification_hooks
= intern ("modification-hooks");
1033 defsubr (&Stext_properties_at
);
1034 defsubr (&Sget_text_property
);
1035 defsubr (&Snext_property_change
);
1036 defsubr (&Snext_single_property_change
);
1037 defsubr (&Sprevious_property_change
);
1038 defsubr (&Sprevious_single_property_change
);
1039 defsubr (&Sadd_text_properties
);
1040 defsubr (&Sput_text_property
);
1041 defsubr (&Sset_text_properties
);
1042 defsubr (&Sremove_text_properties
);
1043 /* defsubr (&Serase_text_properties); */
1048 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1050 #endif /* USE_TEXT_PROPERTIES */