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 Qmodification_hooks
;
47 Lisp_Object Qinsert_in_front_hooks
;
48 Lisp_Object Qinsert_behind_hooks
;
49 Lisp_Object Qcategory
;
50 Lisp_Object Qlocal_map
;
52 /* Visual properties text (including strings) may have. */
53 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
54 Lisp_Object Qinvisible
, Qread_only
;
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))
62 /* Extract the interval at the position pointed to by BEGIN from
63 OBJECT, a string or buffer. Additionally, check that the positions
64 pointed to by BEGIN and END are within the bounds of OBJECT, and
65 reverse them if *BEGIN is greater than *END. The objects pointed
66 to by BEGIN and END may be integers or markers; if the latter, they
67 are coerced to integers.
69 When OBJECT is a string, we increment *BEGIN and *END
70 to make them origin-one.
72 Note that buffer points don't correspond to interval indices.
73 For example, point-max is 1 greater than the index of the last
74 character. This difference is handled in the caller, which uses
75 the validated points to determine a length, and operates on that.
76 Exceptions are Ftext_properties_at, Fnext_property_change, and
77 Fprevious_property_change which call this function with BEGIN == END.
78 Handle this case specially.
80 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
81 create an interval tree for OBJECT if one doesn't exist, provided
82 the object actually contains text. In the current design, if there
83 is no text, there can be no text properties. */
89 validate_interval_range (object
, begin
, end
, force
)
90 Lisp_Object object
, *begin
, *end
;
96 CHECK_STRING_OR_BUFFER (object
, 0);
97 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
98 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
100 /* If we are asked for a point, but from a subr which operates
101 on a range, then return nothing. */
102 if (*begin
== *end
&& begin
!= end
)
103 return NULL_INTERVAL
;
105 if (XINT (*begin
) > XINT (*end
))
113 if (XTYPE (object
) == Lisp_Buffer
)
115 register struct buffer
*b
= XBUFFER (object
);
117 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
118 && XINT (*end
) <= BUF_ZV (b
)))
119 args_out_of_range (*begin
, *end
);
122 /* If there's no text, there are no properties. */
123 if (BUF_BEGV (b
) == BUF_ZV (b
))
124 return NULL_INTERVAL
;
126 searchpos
= XINT (*begin
);
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;
139 XFASTINT (*end
) += 1;
143 return NULL_INTERVAL
;
145 searchpos
= XINT (*begin
);
148 if (NULL_INTERVAL_P (i
))
149 return (force
? create_root_interval (object
) : i
);
151 return find_interval (i
, searchpos
);
154 /* Validate LIST as a property list. If LIST is not a list, then
155 make one consisting of (LIST nil). Otherwise, verify that LIST
156 is even numbered and thus suitable as a plist. */
159 validate_plist (list
)
167 register Lisp_Object tail
;
168 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
174 error ("Odd length text property list");
178 return Fcons (list
, Fcons (Qnil
, Qnil
));
181 /* Return nonzero if interval I has all the properties,
182 with the same values, of list PLIST. */
185 interval_has_all_properties (plist
, i
)
189 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
192 /* Go through each element of PLIST. */
193 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
198 /* Go through I's plist, looking for sym1 */
199 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
200 if (EQ (sym1
, Fcar (tail2
)))
202 /* Found the same property on both lists. If the
203 values are unequal, return zero. */
204 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
207 /* Property has same value on both lists; go to next one. */
219 /* Return nonzero if the plist of interval I has any of the
220 properties of PLIST, regardless of their values. */
223 interval_has_some_properties (plist
, i
)
227 register Lisp_Object tail1
, tail2
, sym
;
229 /* Go through each element of PLIST. */
230 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
234 /* Go through i's plist, looking for tail1 */
235 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
236 if (EQ (sym
, Fcar (tail2
)))
243 /* Changing the plists of individual intervals. */
245 /* Return the value of PROP in property-list PLIST, or Qunbound if it
248 property_value (plist
, prop
)
252 while (PLIST_ELT_P (plist
, value
))
253 if (EQ (XCONS (plist
)->car
, prop
))
254 return XCONS (value
)->car
;
256 plist
= XCONS (value
)->cdr
;
261 /* Set the properties of INTERVAL to PROPERTIES,
262 and record undo info for the previous values.
263 OBJECT is the string or buffer that INTERVAL belongs to. */
266 set_properties (properties
, interval
, object
)
267 Lisp_Object properties
, object
;
270 Lisp_Object sym
, value
;
272 if (BUFFERP (object
))
274 /* For each property in the old plist which is missing from PROPERTIES,
275 or has a different value in PROPERTIES, make an undo record. */
276 for (sym
= interval
->plist
;
277 PLIST_ELT_P (sym
, value
);
278 sym
= XCONS (value
)->cdr
)
279 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
282 modify_region (XBUFFER (object
),
283 make_number (interval
->position
),
284 make_number (interval
->position
+ LENGTH (interval
)));
285 record_property_change (interval
->position
, LENGTH (interval
),
286 XCONS (sym
)->car
, XCONS (value
)->car
,
290 /* For each new property that has no value at all in the old plist,
291 make an undo record binding it to nil, so it will be removed. */
292 for (sym
= properties
;
293 PLIST_ELT_P (sym
, value
);
294 sym
= XCONS (value
)->cdr
)
295 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
297 modify_region (XBUFFER (object
),
298 make_number (interval
->position
),
299 make_number (interval
->position
+ LENGTH (interval
)));
300 record_property_change (interval
->position
, LENGTH (interval
),
301 XCONS (sym
)->car
, Qnil
,
306 /* Store new properties. */
307 interval
->plist
= Fcopy_sequence (properties
);
310 /* Add the properties of PLIST to the interval I, or set
311 the value of I's property to the value of the property on PLIST
312 if they are different.
314 OBJECT should be the string or buffer the interval is in.
316 Return nonzero if this changes I (i.e., if any members of PLIST
317 are actually added to I's plist) */
320 add_properties (plist
, i
, object
)
325 register Lisp_Object tail1
, tail2
, sym1
, val1
;
326 register int changed
= 0;
329 /* Go through each element of PLIST. */
330 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
333 val1
= Fcar (Fcdr (tail1
));
336 /* Go through I's plist, looking for sym1 */
337 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
338 if (EQ (sym1
, Fcar (tail2
)))
340 register Lisp_Object this_cdr
= Fcdr (tail2
);
342 /* Found the property. Now check its value. */
345 /* The properties have the same value on both lists.
346 Continue to the next property. */
347 if (EQ (val1
, Fcar (this_cdr
)))
350 /* Record this change in the buffer, for undo purposes. */
351 if (XTYPE (object
) == Lisp_Buffer
)
353 modify_region (XBUFFER (object
),
354 make_number (i
->position
),
355 make_number (i
->position
+ LENGTH (i
)));
356 record_property_change (i
->position
, LENGTH (i
),
357 sym1
, Fcar (this_cdr
), object
);
360 /* I's property has a different value -- change it */
361 Fsetcar (this_cdr
, val1
);
368 /* Record this change in the buffer, for undo purposes. */
369 if (XTYPE (object
) == Lisp_Buffer
)
371 modify_region (XBUFFER (object
),
372 make_number (i
->position
),
373 make_number (i
->position
+ LENGTH (i
)));
374 record_property_change (i
->position
, LENGTH (i
),
377 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
385 /* For any members of PLIST which are properties of I, remove them
387 OBJECT is the string or buffer containing I. */
390 remove_properties (plist
, i
, object
)
395 register Lisp_Object tail1
, tail2
, sym
;
396 register Lisp_Object current_plist
= i
->plist
;
397 register int changed
= 0;
399 /* Go through each element of plist. */
400 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
404 /* First, remove the symbol if its at the head of the list */
405 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
407 if (XTYPE (object
) == Lisp_Buffer
)
409 modify_region (XBUFFER (object
),
410 make_number (i
->position
),
411 make_number (i
->position
+ LENGTH (i
)));
412 record_property_change (i
->position
, LENGTH (i
),
413 sym
, Fcar (Fcdr (current_plist
)),
417 current_plist
= Fcdr (Fcdr (current_plist
));
421 /* Go through i's plist, looking for sym */
422 tail2
= current_plist
;
423 while (! NILP (tail2
))
425 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
426 if (EQ (sym
, Fcar (this)))
428 if (XTYPE (object
) == Lisp_Buffer
)
430 modify_region (XBUFFER (object
),
431 make_number (i
->position
),
432 make_number (i
->position
+ LENGTH (i
)));
433 record_property_change (i
->position
, LENGTH (i
),
434 sym
, Fcar (Fcdr (this)), object
);
437 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
445 i
->plist
= current_plist
;
450 /* Remove all properties from interval I. Return non-zero
451 if this changes the interval. */
465 DEFUN ("text-properties-at", Ftext_properties_at
,
466 Stext_properties_at
, 1, 2, 0,
467 "Return the list of properties held by the character at POSITION\n\
468 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
469 defaults to the current buffer.\n\
470 If POSITION is at the end of OBJECT, the value is nil.")
472 Lisp_Object pos
, object
;
477 XSET (object
, Lisp_Buffer
, current_buffer
);
479 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
480 if (NULL_INTERVAL_P (i
))
482 /* If POS is at the end of the interval,
483 it means it's the end of OBJECT.
484 There are no properties at the very end,
485 since no character follows. */
486 if (XINT (pos
) == LENGTH (i
) + i
->position
)
492 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
493 "Return the value of position POS's property PROP, in OBJECT.\n\
494 OBJECT is optional and defaults to the current buffer.\n\
495 If POSITION is at the end of OBJECT, the value is nil.")
497 Lisp_Object pos
, object
;
498 register Lisp_Object prop
;
501 register Lisp_Object tail
;
504 XSET (object
, Lisp_Buffer
, current_buffer
);
505 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
506 if (NULL_INTERVAL_P (i
))
509 /* If POS is at the end of the interval,
510 it means it's the end of OBJECT.
511 There are no properties at the very end,
512 since no character follows. */
513 if (XINT (pos
) == LENGTH (i
) + i
->position
)
516 return textget (i
->plist
, prop
);
519 DEFUN ("next-property-change", Fnext_property_change
,
520 Snext_property_change
, 1, 2, 0,
521 "Return the position of next property change.\n\
522 Scans characters forward from POS in OBJECT till it finds\n\
523 a change in some text property, then returns the position of the change.\n\
524 The optional second argument OBJECT is the string or buffer to scan.\n\
525 Return nil if the property is constant all the way to the end of OBJECT.\n\
526 If the value is non-nil, it is a position greater than POS, never equal.")
528 Lisp_Object pos
, object
;
530 register INTERVAL i
, next
;
533 XSET (object
, Lisp_Buffer
, current_buffer
);
535 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
536 if (NULL_INTERVAL_P (i
))
539 next
= next_interval (i
);
540 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
541 next
= next_interval (next
);
543 if (NULL_INTERVAL_P (next
))
546 return next
->position
- (XTYPE (object
) == Lisp_String
);
550 DEFUN ("next-single-property-change", Fnext_single_property_change
,
551 Snext_single_property_change
, 1, 3, 0,
552 "Return the position of next property change for a specific property.\n\
553 Scans characters forward from POS till it finds\n\
554 a change in the PROP property, then returns the position of the change.\n\
555 The optional third argument OBJECT is the string or buffer to scan.\n\
556 Return nil if the property is constant all the way to the end of OBJECT.\n\
557 If the value is non-nil, it is a position greater than POS, never equal.")
559 Lisp_Object pos
, prop
, object
;
561 register INTERVAL i
, next
;
562 register Lisp_Object here_val
;
565 XSET (object
, Lisp_Buffer
, current_buffer
);
567 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
568 if (NULL_INTERVAL_P (i
))
571 here_val
= textget (i
->plist
, prop
);
572 next
= next_interval (i
);
573 while (! NULL_INTERVAL_P (next
)
574 && EQ (here_val
, textget (next
->plist
, prop
)))
575 next
= next_interval (next
);
577 if (NULL_INTERVAL_P (next
))
580 return next
->position
- (XTYPE (object
) == Lisp_String
);
583 DEFUN ("previous-property-change", Fprevious_property_change
,
584 Sprevious_property_change
, 1, 2, 0,
585 "Return the position of previous property change.\n\
586 Scans characters backwards from POS in OBJECT till it finds\n\
587 a change in some text property, then returns the position of the change.\n\
588 The optional second argument OBJECT is the string or buffer to scan.\n\
589 Return nil if the property is constant all the way to the start of OBJECT.\n\
590 If the value is non-nil, it is a position less than POS, never equal.")
592 Lisp_Object pos
, object
;
594 register INTERVAL i
, previous
;
597 XSET (object
, Lisp_Buffer
, current_buffer
);
599 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
600 if (NULL_INTERVAL_P (i
))
603 previous
= previous_interval (i
);
604 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
605 previous
= previous_interval (previous
);
606 if (NULL_INTERVAL_P (previous
))
609 return (previous
->position
+ LENGTH (previous
) - 1
610 - (XTYPE (object
) == Lisp_String
));
613 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
614 Sprevious_single_property_change
, 2, 3, 0,
615 "Return the position of previous property change for a specific property.\n\
616 Scans characters backward from POS till it finds\n\
617 a change in the PROP property, then returns the position of the change.\n\
618 The optional third argument OBJECT is the string or buffer to scan.\n\
619 Return nil if the property is constant all the way to the start of OBJECT.\n\
620 If the value is non-nil, it is a position less than POS, never equal.")
622 Lisp_Object pos
, prop
, object
;
624 register INTERVAL i
, previous
;
625 register Lisp_Object here_val
;
628 XSET (object
, Lisp_Buffer
, current_buffer
);
630 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
631 if (NULL_INTERVAL_P (i
))
634 here_val
= textget (i
->plist
, prop
);
635 previous
= previous_interval (i
);
636 while (! NULL_INTERVAL_P (previous
)
637 && EQ (here_val
, textget (previous
->plist
, prop
)))
638 previous
= previous_interval (previous
);
639 if (NULL_INTERVAL_P (previous
))
642 return (previous
->position
+ LENGTH (previous
) - 1
643 - (XTYPE (object
) == Lisp_String
));
646 DEFUN ("add-text-properties", Fadd_text_properties
,
647 Sadd_text_properties
, 3, 4, 0,
648 "Add properties to the text from START to END.\n\
649 The third argument PROPS is a property list\n\
650 specifying the property values to add.\n\
651 The optional fourth argument, OBJECT,\n\
652 is the string or buffer containing the text.\n\
653 Return t if any property value actually changed, nil otherwise.")
654 (start
, end
, properties
, object
)
655 Lisp_Object start
, end
, properties
, object
;
657 register INTERVAL i
, unchanged
;
658 register int s
, len
, modified
= 0;
660 properties
= validate_plist (properties
);
661 if (NILP (properties
))
665 XSET (object
, Lisp_Buffer
, current_buffer
);
667 i
= validate_interval_range (object
, &start
, &end
, hard
);
668 if (NULL_INTERVAL_P (i
))
672 len
= XINT (end
) - s
;
674 /* If we're not starting on an interval boundary, we have to
675 split this interval. */
676 if (i
->position
!= s
)
678 /* If this interval already has the properties, we can
680 if (interval_has_all_properties (properties
, i
))
682 int got
= (LENGTH (i
) - (s
- i
->position
));
686 i
= next_interval (i
);
691 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
692 copy_properties (unchanged
, i
);
696 /* We are at the beginning of interval I, with LEN chars to scan. */
702 if (LENGTH (i
) >= len
)
704 if (interval_has_all_properties (properties
, i
))
705 return modified
? Qt
: Qnil
;
707 if (LENGTH (i
) == len
)
709 add_properties (properties
, i
, object
);
713 /* i doesn't have the properties, and goes past the change limit */
715 i
= split_interval_left (unchanged
, len
+ 1);
716 copy_properties (unchanged
, i
);
717 add_properties (properties
, i
, object
);
722 modified
+= add_properties (properties
, i
, object
);
723 i
= next_interval (i
);
727 DEFUN ("put-text-property", Fput_text_property
,
728 Sput_text_property
, 4, 5, 0,
729 "Set one property of the text from START to END.\n\
730 The third and fourth arguments PROP and VALUE\n\
731 specify the property to add.\n\
732 The optional fifth argument, OBJECT,\n\
733 is the string or buffer containing the text.")
734 (start
, end
, prop
, value
, object
)
735 Lisp_Object start
, end
, prop
, value
, object
;
737 Fadd_text_properties (start
, end
,
738 Fcons (prop
, Fcons (value
, Qnil
)),
743 DEFUN ("set-text-properties", Fset_text_properties
,
744 Sset_text_properties
, 3, 4, 0,
745 "Completely replace properties of text from START to END.\n\
746 The third argument PROPS is the new property list.\n\
747 The optional fourth argument, OBJECT,\n\
748 is the string or buffer containing the text.")
749 (start
, end
, props
, object
)
750 Lisp_Object start
, end
, props
, object
;
752 register INTERVAL i
, unchanged
;
753 register INTERVAL prev_changed
= NULL_INTERVAL
;
756 props
= validate_plist (props
);
759 XSET (object
, Lisp_Buffer
, current_buffer
);
761 i
= validate_interval_range (object
, &start
, &end
, hard
);
762 if (NULL_INTERVAL_P (i
))
766 len
= XINT (end
) - s
;
768 if (i
->position
!= s
)
771 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
773 if (LENGTH (i
) > len
)
775 copy_properties (unchanged
, i
);
776 i
= split_interval_left (i
, len
+ 1);
777 set_properties (props
, i
, object
);
781 set_properties (props
, i
, object
);
783 if (LENGTH (i
) == len
)
788 i
= next_interval (i
);
791 /* We are starting at the beginning of an interval, I */
797 if (LENGTH (i
) >= len
)
799 if (LENGTH (i
) > len
)
800 i
= split_interval_left (i
, len
+ 1);
802 if (NULL_INTERVAL_P (prev_changed
))
803 set_properties (props
, i
, object
);
805 merge_interval_left (i
);
810 if (NULL_INTERVAL_P (prev_changed
))
812 set_properties (props
, i
, object
);
816 prev_changed
= i
= merge_interval_left (i
);
818 i
= next_interval (i
);
824 DEFUN ("remove-text-properties", Fremove_text_properties
,
825 Sremove_text_properties
, 3, 4, 0,
826 "Remove some properties from text from START to END.\n\
827 The third argument PROPS is a property list\n\
828 whose property names specify the properties to remove.\n\
829 \(The values stored in PROPS are ignored.)\n\
830 The optional fourth argument, OBJECT,\n\
831 is the string or buffer containing the text.\n\
832 Return t if any property was actually removed, nil otherwise.")
833 (start
, end
, props
, object
)
834 Lisp_Object start
, end
, props
, object
;
836 register INTERVAL i
, unchanged
;
837 register int s
, len
, modified
= 0;
840 XSET (object
, Lisp_Buffer
, current_buffer
);
842 i
= validate_interval_range (object
, &start
, &end
, soft
);
843 if (NULL_INTERVAL_P (i
))
847 len
= XINT (end
) - s
;
849 if (i
->position
!= s
)
851 /* No properties on this first interval -- return if
852 it covers the entire region. */
853 if (! interval_has_some_properties (props
, i
))
855 int got
= (LENGTH (i
) - (s
- i
->position
));
859 i
= next_interval (i
);
861 /* Split away the beginning of this interval; what we don't
866 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
867 copy_properties (unchanged
, i
);
871 /* We are at the beginning of an interval, with len to scan */
877 if (LENGTH (i
) >= len
)
879 if (! interval_has_some_properties (props
, i
))
880 return modified
? Qt
: Qnil
;
882 if (LENGTH (i
) == len
)
884 remove_properties (props
, i
, object
);
888 /* i has the properties, and goes past the change limit */
890 i
= split_interval_left (i
, len
+ 1);
891 copy_properties (unchanged
, i
);
892 remove_properties (props
, i
, object
);
897 modified
+= remove_properties (props
, i
, object
);
898 i
= next_interval (i
);
902 #if 0 /* You can use set-text-properties for this. */
904 DEFUN ("erase-text-properties", Ferase_text_properties
,
905 Serase_text_properties
, 2, 3, 0,
906 "Remove all properties from the text from START to END.\n\
907 The optional third argument, OBJECT,\n\
908 is the string or buffer containing the text.")
910 Lisp_Object start
, end
, object
;
913 register INTERVAL prev_changed
= NULL_INTERVAL
;
914 register int s
, len
, modified
;
917 XSET (object
, Lisp_Buffer
, current_buffer
);
919 i
= validate_interval_range (object
, &start
, &end
, soft
);
920 if (NULL_INTERVAL_P (i
))
924 len
= XINT (end
) - s
;
926 if (i
->position
!= s
)
929 register INTERVAL unchanged
= i
;
931 /* If there are properties here, then this text will be modified. */
932 if (! NILP (i
->plist
))
934 i
= split_interval_right (unchanged
, s
- unchanged
->position
+ 1);
938 if (LENGTH (i
) > len
)
940 i
= split_interval_right (i
, len
+ 1);
941 copy_properties (unchanged
, i
);
945 if (LENGTH (i
) == len
)
950 /* If the text of I is without any properties, and contains
951 LEN or more characters, then we may return without changing
953 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
955 /* The amount of text to change extends past I, so just note
956 how much we've gotten. */
958 got
= LENGTH (i
) - (s
- i
->position
);
962 i
= next_interval (i
);
965 /* We are starting at the beginning of an interval, I. */
968 if (LENGTH (i
) >= len
)
970 /* If I has no properties, simply merge it if possible. */
973 if (! NULL_INTERVAL_P (prev_changed
))
974 merge_interval_left (i
);
976 return modified
? Qt
: Qnil
;
979 if (LENGTH (i
) > len
)
980 i
= split_interval_left (i
, len
+ 1);
981 if (! NULL_INTERVAL_P (prev_changed
))
982 merge_interval_left (i
);
989 /* Here if we still need to erase past the end of I */
991 if (NULL_INTERVAL_P (prev_changed
))
993 modified
+= erase_properties (i
);
998 modified
+= ! NILP (i
->plist
);
999 /* Merging I will give it the properties of PREV_CHANGED. */
1000 prev_changed
= i
= merge_interval_left (i
);
1003 i
= next_interval (i
);
1006 return modified
? Qt
: Qnil
;
1010 /* I don't think this is the right interface to export; how often do you
1011 want to do something like this, other than when you're copying objects
1014 I think it would be better to have a pair of functions, one which
1015 returns the text properties of a region as a list of ranges and
1016 plists, and another which applies such a list to another object. */
1018 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1019 Scopy_text_properties, 5, 6, 0,
1020 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1021 SRC and DEST may each refer to strings or buffers.\n\
1022 Optional sixth argument PROP causes only that property to be copied.\n\
1023 Properties are copied to DEST as if by `add-text-properties'.\n\
1024 Return t if any property value actually changed, nil otherwise.") */
1027 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1028 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1034 int s
, e
, e2
, p
, len
, modified
= 0;
1036 i
= validate_interval_range (src
, &start
, &end
, soft
);
1037 if (NULL_INTERVAL_P (i
))
1040 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1042 Lisp_Object dest_start
, dest_end
;
1045 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1046 /* Apply this to a copy of pos; it will try to increment its arguments,
1047 which we don't want. */
1048 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1059 e2
= i
->position
+ LENGTH (i
);
1066 while (! NILP (plist
))
1068 if (EQ (Fcar (plist
), prop
))
1070 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1073 plist
= Fcdr (Fcdr (plist
));
1077 /* Must defer modifications to the interval tree in case src
1078 and dest refer to the same string or buffer. */
1079 stuff
= Fcons (Fcons (make_number (p
),
1080 Fcons (make_number (p
+ len
),
1081 Fcons (plist
, Qnil
))),
1085 i
= next_interval (i
);
1086 if (NULL_INTERVAL_P (i
))
1093 while (! NILP (stuff
))
1096 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1097 Fcar (Fcdr (Fcdr (res
))), dest
);
1100 stuff
= Fcdr (stuff
);
1103 return modified
? Qt
: Qnil
;
1109 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1110 "Threshold for rebalancing interval trees, expressed as the\n\
1111 percentage by which the left interval tree should not differ from the right.");
1112 interval_balance_threshold
= 8;
1114 /* Common attributes one might give text */
1116 staticpro (&Qforeground
);
1117 Qforeground
= intern ("foreground");
1118 staticpro (&Qbackground
);
1119 Qbackground
= intern ("background");
1121 Qfont
= intern ("font");
1122 staticpro (&Qstipple
);
1123 Qstipple
= intern ("stipple");
1124 staticpro (&Qunderline
);
1125 Qunderline
= intern ("underline");
1126 staticpro (&Qread_only
);
1127 Qread_only
= intern ("read-only");
1128 staticpro (&Qinvisible
);
1129 Qinvisible
= intern ("invisible");
1130 staticpro (&Qcategory
);
1131 Qcategory
= intern ("category");
1132 staticpro (&Qlocal_map
);
1133 Qlocal_map
= intern ("local-map");
1135 /* Properties that text might use to specify certain actions */
1137 staticpro (&Qmouse_left
);
1138 Qmouse_left
= intern ("mouse-left");
1139 staticpro (&Qmouse_entered
);
1140 Qmouse_entered
= intern ("mouse-entered");
1141 staticpro (&Qpoint_left
);
1142 Qpoint_left
= intern ("point-left");
1143 staticpro (&Qpoint_entered
);
1144 Qpoint_entered
= intern ("point-entered");
1145 staticpro (&Qmodification_hooks
);
1146 Qmodification_hooks
= intern ("modification-hooks");
1147 staticpro (&Qinsert_in_front_hooks
);
1148 Qinsert_in_front_hooks
= intern ("insert-in-front-hooks");
1149 staticpro (&Qinsert_behind_hooks
);
1150 Qinsert_behind_hooks
= intern ("insert-behind-hooks");
1152 defsubr (&Stext_properties_at
);
1153 defsubr (&Sget_text_property
);
1154 defsubr (&Snext_property_change
);
1155 defsubr (&Snext_single_property_change
);
1156 defsubr (&Sprevious_property_change
);
1157 defsubr (&Sprevious_single_property_change
);
1158 defsubr (&Sadd_text_properties
);
1159 defsubr (&Sput_text_property
);
1160 defsubr (&Sset_text_properties
);
1161 defsubr (&Sremove_text_properties
);
1162 /* defsubr (&Serase_text_properties); */
1163 /* defsubr (&Scopy_text_properties); */
1168 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1170 #endif /* USE_TEXT_PROPERTIES */