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
)
170 register Lisp_Object tail
;
171 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
177 error ("Odd length text property list");
181 return Fcons (list
, Fcons (Qnil
, Qnil
));
184 /* Return nonzero if interval I has all the properties,
185 with the same values, of list PLIST. */
188 interval_has_all_properties (plist
, i
)
192 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
195 /* Go through each element of PLIST. */
196 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
201 /* Go through I's plist, looking for sym1 */
202 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
203 if (EQ (sym1
, Fcar (tail2
)))
205 /* Found the same property on both lists. If the
206 values are unequal, return zero. */
207 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
210 /* Property has same value on both lists; go to next one. */
222 /* Return nonzero if the plist of interval I has any of the
223 properties of PLIST, regardless of their values. */
226 interval_has_some_properties (plist
, i
)
230 register Lisp_Object tail1
, tail2
, sym
;
232 /* Go through each element of PLIST. */
233 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
237 /* Go through i's plist, looking for tail1 */
238 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
239 if (EQ (sym
, Fcar (tail2
)))
246 /* Changing the plists of individual intervals. */
248 /* Return the value of PROP in property-list PLIST, or Qunbound if it
251 property_value (plist
, prop
)
255 while (PLIST_ELT_P (plist
, value
))
256 if (EQ (XCONS (plist
)->car
, prop
))
257 return XCONS (value
)->car
;
259 plist
= XCONS (value
)->cdr
;
264 /* Set the properties of INTERVAL to PROPERTIES,
265 and record undo info for the previous values.
266 OBJECT is the string or buffer that INTERVAL belongs to. */
269 set_properties (properties
, interval
, object
)
270 Lisp_Object properties
, object
;
273 Lisp_Object sym
, value
;
275 if (BUFFERP (object
))
277 /* For each property in the old plist which is missing from PROPERTIES,
278 or has a different value in PROPERTIES, make an undo record. */
279 for (sym
= interval
->plist
;
280 PLIST_ELT_P (sym
, value
);
281 sym
= XCONS (value
)->cdr
)
282 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
285 modify_region (XBUFFER (object
),
286 make_number (interval
->position
),
287 make_number (interval
->position
+ LENGTH (interval
)));
288 record_property_change (interval
->position
, LENGTH (interval
),
289 XCONS (sym
)->car
, XCONS (value
)->car
,
293 /* For each new property that has no value at all in the old plist,
294 make an undo record binding it to nil, so it will be removed. */
295 for (sym
= properties
;
296 PLIST_ELT_P (sym
, value
);
297 sym
= XCONS (value
)->cdr
)
298 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
300 modify_region (XBUFFER (object
),
301 make_number (interval
->position
),
302 make_number (interval
->position
+ LENGTH (interval
)));
303 record_property_change (interval
->position
, LENGTH (interval
),
304 XCONS (sym
)->car
, Qnil
,
309 /* Store new properties. */
310 interval
->plist
= Fcopy_sequence (properties
);
313 /* Add the properties of PLIST to the interval I, or set
314 the value of I's property to the value of the property on PLIST
315 if they are different.
317 OBJECT should be the string or buffer the interval is in.
319 Return nonzero if this changes I (i.e., if any members of PLIST
320 are actually added to I's plist) */
323 add_properties (plist
, i
, object
)
328 register Lisp_Object tail1
, tail2
, sym1
, val1
;
329 register int changed
= 0;
332 /* Go through each element of PLIST. */
333 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
336 val1
= Fcar (Fcdr (tail1
));
339 /* Go through I's plist, looking for sym1 */
340 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
341 if (EQ (sym1
, Fcar (tail2
)))
343 register Lisp_Object this_cdr
= Fcdr (tail2
);
345 /* Found the property. Now check its value. */
348 /* The properties have the same value on both lists.
349 Continue to the next property. */
350 if (EQ (val1
, Fcar (this_cdr
)))
353 /* Record this change in the buffer, for undo purposes. */
354 if (XTYPE (object
) == Lisp_Buffer
)
356 modify_region (XBUFFER (object
),
357 make_number (i
->position
),
358 make_number (i
->position
+ LENGTH (i
)));
359 record_property_change (i
->position
, LENGTH (i
),
360 sym1
, Fcar (this_cdr
), object
);
363 /* I's property has a different value -- change it */
364 Fsetcar (this_cdr
, val1
);
371 /* Record this change in the buffer, for undo purposes. */
372 if (XTYPE (object
) == Lisp_Buffer
)
374 modify_region (XBUFFER (object
),
375 make_number (i
->position
),
376 make_number (i
->position
+ LENGTH (i
)));
377 record_property_change (i
->position
, LENGTH (i
),
380 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
388 /* For any members of PLIST which are properties of I, remove them
390 OBJECT is the string or buffer containing I. */
393 remove_properties (plist
, i
, object
)
398 register Lisp_Object tail1
, tail2
, sym
;
399 register Lisp_Object current_plist
= i
->plist
;
400 register int changed
= 0;
402 /* Go through each element of plist. */
403 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
407 /* First, remove the symbol if its at the head of the list */
408 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
410 if (XTYPE (object
) == Lisp_Buffer
)
412 modify_region (XBUFFER (object
),
413 make_number (i
->position
),
414 make_number (i
->position
+ LENGTH (i
)));
415 record_property_change (i
->position
, LENGTH (i
),
416 sym
, Fcar (Fcdr (current_plist
)),
420 current_plist
= Fcdr (Fcdr (current_plist
));
424 /* Go through i's plist, looking for sym */
425 tail2
= current_plist
;
426 while (! NILP (tail2
))
428 register Lisp_Object
this = Fcdr (Fcdr (tail2
));
429 if (EQ (sym
, Fcar (this)))
431 if (XTYPE (object
) == Lisp_Buffer
)
433 modify_region (XBUFFER (object
),
434 make_number (i
->position
),
435 make_number (i
->position
+ LENGTH (i
)));
436 record_property_change (i
->position
, LENGTH (i
),
437 sym
, Fcar (Fcdr (this)), object
);
440 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
448 i
->plist
= current_plist
;
453 /* Remove all properties from interval I. Return non-zero
454 if this changes the interval. */
468 DEFUN ("text-properties-at", Ftext_properties_at
,
469 Stext_properties_at
, 1, 2, 0,
470 "Return the list of properties held by the character at POSITION\n\
471 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
472 defaults to the current buffer.\n\
473 If POSITION is at the end of OBJECT, the value is nil.")
475 Lisp_Object pos
, object
;
480 XSET (object
, Lisp_Buffer
, current_buffer
);
482 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
483 if (NULL_INTERVAL_P (i
))
485 /* If POS is at the end of the interval,
486 it means it's the end of OBJECT.
487 There are no properties at the very end,
488 since no character follows. */
489 if (XINT (pos
) == LENGTH (i
) + i
->position
)
495 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
496 "Return the value of position POS's property PROP, in OBJECT.\n\
497 OBJECT is optional and defaults to the current buffer.\n\
498 If POSITION is at the end of OBJECT, the value is nil.")
500 Lisp_Object pos
, object
;
501 register Lisp_Object prop
;
504 register Lisp_Object tail
;
507 XSET (object
, Lisp_Buffer
, current_buffer
);
508 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
509 if (NULL_INTERVAL_P (i
))
512 /* If POS is at the end of the interval,
513 it means it's the end of OBJECT.
514 There are no properties at the very end,
515 since no character follows. */
516 if (XINT (pos
) == LENGTH (i
) + i
->position
)
519 return textget (i
->plist
, prop
);
522 DEFUN ("next-property-change", Fnext_property_change
,
523 Snext_property_change
, 1, 3, 0,
524 "Return the position of next property change.\n\
525 Scans characters forward from POS in OBJECT till it finds\n\
526 a change in some text property, then returns the position of the change.\n\
527 The optional second argument OBJECT is the string or buffer to scan.\n\
528 Return nil if the property is constant all the way to the end of OBJECT.\n\
529 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
530 If the optional third argument LIMIT is non-nil, don't search\n\
531 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
533 Lisp_Object pos
, object
, limit
;
535 register INTERVAL i
, next
;
538 XSET (object
, Lisp_Buffer
, current_buffer
);
540 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
541 if (NULL_INTERVAL_P (i
))
544 next
= next_interval (i
);
545 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
546 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
547 next
= next_interval (next
);
549 if (NULL_INTERVAL_P (next
))
551 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
554 return next
->position
- (XTYPE (object
) == Lisp_String
);
557 /* Return 1 if there's a change in some property between BEG and END. */
560 property_change_between_p (beg
, end
)
563 register INTERVAL i
, next
;
564 Lisp_Object object
, pos
;
566 XSET (object
, Lisp_Buffer
, current_buffer
);
567 XFASTINT (pos
) = beg
;
569 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
570 if (NULL_INTERVAL_P (i
))
573 next
= next_interval (i
);
574 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
576 next
= next_interval (next
);
577 if (NULL_INTERVAL_P (next
))
579 if (next
->position
>= end
)
583 if (NULL_INTERVAL_P (next
))
589 DEFUN ("next-single-property-change", Fnext_single_property_change
,
590 Snext_single_property_change
, 2, 4, 0,
591 "Return the position of next property change for a specific property.\n\
592 Scans characters forward from POS till it finds\n\
593 a change in the PROP property, then returns the position of the change.\n\
594 The optional third argument OBJECT is the string or buffer to scan.\n\
595 The property values are compared with `eq'.\n\
596 Return nil if the property is constant all the way to the end of OBJECT.\n\
597 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
598 If the optional fourth argument LIMIT is non-nil, don't search\n\
599 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
600 (pos
, prop
, object
, limit
)
601 Lisp_Object pos
, prop
, object
, limit
;
603 register INTERVAL i
, next
;
604 register Lisp_Object here_val
;
607 XSET (object
, Lisp_Buffer
, current_buffer
);
609 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
610 if (NULL_INTERVAL_P (i
))
613 here_val
= textget (i
->plist
, prop
);
614 next
= next_interval (i
);
615 while (! NULL_INTERVAL_P (next
)
616 && EQ (here_val
, textget (next
->plist
, prop
))
617 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
618 next
= next_interval (next
);
620 if (NULL_INTERVAL_P (next
))
622 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
625 return next
->position
- (XTYPE (object
) == Lisp_String
);
628 DEFUN ("previous-property-change", Fprevious_property_change
,
629 Sprevious_property_change
, 1, 3, 0,
630 "Return the position of previous property change.\n\
631 Scans characters backwards from POS in OBJECT till it finds\n\
632 a change in some text property, then returns the position of the change.\n\
633 The optional second argument OBJECT is the string or buffer to scan.\n\
634 Return nil if the property is constant all the way to the start of OBJECT.\n\
635 If the value is non-nil, it is a position less than POS, never equal.\n\n\
636 If the optional third argument LIMIT is non-nil, don't search\n\
637 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
639 Lisp_Object pos
, object
, limit
;
641 register INTERVAL i
, previous
;
644 XSET (object
, Lisp_Buffer
, current_buffer
);
646 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
647 if (NULL_INTERVAL_P (i
))
650 /* Start with the interval containing the char before point. */
651 if (i
->position
== XFASTINT (pos
))
652 i
= previous_interval (i
);
654 previous
= previous_interval (i
);
655 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
657 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
658 previous
= previous_interval (previous
);
659 if (NULL_INTERVAL_P (previous
))
662 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
665 return (previous
->position
+ LENGTH (previous
)
666 - (XTYPE (object
) == Lisp_String
));
669 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
670 Sprevious_single_property_change
, 2, 4, 0,
671 "Return the position of previous property change for a specific property.\n\
672 Scans characters backward from POS till it finds\n\
673 a change in the PROP property, then returns the position of the change.\n\
674 The optional third argument OBJECT is the string or buffer to scan.\n\
675 The property values are compared with `eq'.\n\
676 Return nil if the property is constant all the way to the start of OBJECT.\n\
677 If the value is non-nil, it is a position less than POS, never equal.\n\n\
678 If the optional fourth argument LIMIT is non-nil, don't search\n\
679 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
680 (pos
, prop
, object
, limit
)
681 Lisp_Object pos
, prop
, object
, limit
;
683 register INTERVAL i
, previous
;
684 register Lisp_Object here_val
;
687 XSET (object
, Lisp_Buffer
, current_buffer
);
689 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
690 if (NULL_INTERVAL_P (i
))
693 /* Start with the interval containing the char before point. */
694 if (i
->position
== XFASTINT (pos
))
695 i
= previous_interval (i
);
697 here_val
= textget (i
->plist
, prop
);
698 previous
= previous_interval (i
);
699 while (! NULL_INTERVAL_P (previous
)
700 && EQ (here_val
, textget (previous
->plist
, prop
))
702 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
703 previous
= previous_interval (previous
);
704 if (NULL_INTERVAL_P (previous
))
707 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
710 return (previous
->position
+ LENGTH (previous
)
711 - (XTYPE (object
) == Lisp_String
));
714 DEFUN ("add-text-properties", Fadd_text_properties
,
715 Sadd_text_properties
, 3, 4, 0,
716 "Add properties to the text from START to END.\n\
717 The third argument PROPS is a property list\n\
718 specifying the property values to add.\n\
719 The optional fourth argument, OBJECT,\n\
720 is the string or buffer containing the text.\n\
721 Return t if any property value actually changed, nil otherwise.")
722 (start
, end
, properties
, object
)
723 Lisp_Object start
, end
, properties
, object
;
725 register INTERVAL i
, unchanged
;
726 register int s
, len
, modified
= 0;
728 properties
= validate_plist (properties
);
729 if (NILP (properties
))
733 XSET (object
, Lisp_Buffer
, current_buffer
);
735 i
= validate_interval_range (object
, &start
, &end
, hard
);
736 if (NULL_INTERVAL_P (i
))
740 len
= XINT (end
) - s
;
742 /* If we're not starting on an interval boundary, we have to
743 split this interval. */
744 if (i
->position
!= s
)
746 /* If this interval already has the properties, we can
748 if (interval_has_all_properties (properties
, i
))
750 int got
= (LENGTH (i
) - (s
- i
->position
));
754 i
= next_interval (i
);
759 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
760 copy_properties (unchanged
, i
);
764 /* We are at the beginning of interval I, with LEN chars to scan. */
770 if (LENGTH (i
) >= len
)
772 if (interval_has_all_properties (properties
, i
))
773 return modified
? Qt
: Qnil
;
775 if (LENGTH (i
) == len
)
777 add_properties (properties
, i
, object
);
781 /* i doesn't have the properties, and goes past the change limit */
783 i
= split_interval_left (unchanged
, len
);
784 copy_properties (unchanged
, i
);
785 add_properties (properties
, i
, object
);
790 modified
+= add_properties (properties
, i
, object
);
791 i
= next_interval (i
);
795 DEFUN ("put-text-property", Fput_text_property
,
796 Sput_text_property
, 4, 5, 0,
797 "Set one property of the text from START to END.\n\
798 The third and fourth arguments PROP and VALUE\n\
799 specify the property to add.\n\
800 The optional fifth argument, OBJECT,\n\
801 is the string or buffer containing the text.")
802 (start
, end
, prop
, value
, object
)
803 Lisp_Object start
, end
, prop
, value
, object
;
805 Fadd_text_properties (start
, end
,
806 Fcons (prop
, Fcons (value
, Qnil
)),
811 DEFUN ("set-text-properties", Fset_text_properties
,
812 Sset_text_properties
, 3, 4, 0,
813 "Completely replace properties of text from START to END.\n\
814 The third argument PROPS is the new property list.\n\
815 The optional fourth argument, OBJECT,\n\
816 is the string or buffer containing the text.")
817 (start
, end
, props
, object
)
818 Lisp_Object start
, end
, props
, object
;
820 register INTERVAL i
, unchanged
;
821 register INTERVAL prev_changed
= NULL_INTERVAL
;
824 props
= validate_plist (props
);
827 XSET (object
, Lisp_Buffer
, current_buffer
);
829 i
= validate_interval_range (object
, &start
, &end
, hard
);
830 if (NULL_INTERVAL_P (i
))
834 len
= XINT (end
) - s
;
836 if (i
->position
!= s
)
839 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
841 if (LENGTH (i
) > len
)
843 copy_properties (unchanged
, i
);
844 i
= split_interval_left (i
, len
);
845 set_properties (props
, i
, object
);
849 set_properties (props
, i
, object
);
851 if (LENGTH (i
) == len
)
856 i
= next_interval (i
);
859 /* We are starting at the beginning of an interval, I */
865 if (LENGTH (i
) >= len
)
867 if (LENGTH (i
) > len
)
868 i
= split_interval_left (i
, len
);
870 if (NULL_INTERVAL_P (prev_changed
))
871 set_properties (props
, i
, object
);
873 merge_interval_left (i
);
878 if (NULL_INTERVAL_P (prev_changed
))
880 set_properties (props
, i
, object
);
884 prev_changed
= i
= merge_interval_left (i
);
886 i
= next_interval (i
);
892 DEFUN ("remove-text-properties", Fremove_text_properties
,
893 Sremove_text_properties
, 3, 4, 0,
894 "Remove some properties from text from START to END.\n\
895 The third argument PROPS is a property list\n\
896 whose property names specify the properties to remove.\n\
897 \(The values stored in PROPS are ignored.)\n\
898 The optional fourth argument, OBJECT,\n\
899 is the string or buffer containing the text.\n\
900 Return t if any property was actually removed, nil otherwise.")
901 (start
, end
, props
, object
)
902 Lisp_Object start
, end
, props
, object
;
904 register INTERVAL i
, unchanged
;
905 register int s
, len
, modified
= 0;
908 XSET (object
, Lisp_Buffer
, current_buffer
);
910 i
= validate_interval_range (object
, &start
, &end
, soft
);
911 if (NULL_INTERVAL_P (i
))
915 len
= XINT (end
) - s
;
917 if (i
->position
!= s
)
919 /* No properties on this first interval -- return if
920 it covers the entire region. */
921 if (! interval_has_some_properties (props
, i
))
923 int got
= (LENGTH (i
) - (s
- i
->position
));
927 i
= next_interval (i
);
929 /* Split away the beginning of this interval; what we don't
934 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
935 copy_properties (unchanged
, i
);
939 /* We are at the beginning of an interval, with len to scan */
945 if (LENGTH (i
) >= len
)
947 if (! interval_has_some_properties (props
, i
))
948 return modified
? Qt
: Qnil
;
950 if (LENGTH (i
) == len
)
952 remove_properties (props
, i
, object
);
956 /* i has the properties, and goes past the change limit */
958 i
= split_interval_left (i
, len
);
959 copy_properties (unchanged
, i
);
960 remove_properties (props
, i
, object
);
965 modified
+= remove_properties (props
, i
, object
);
966 i
= next_interval (i
);
970 DEFUN ("text-property-any", Ftext_property_any
,
971 Stext_property_any
, 4, 5, 0,
972 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
973 If so, return the position of the first character whose PROP is `eq'\n\
974 to VALUE. Otherwise return nil.\n\
975 The optional fifth argument, OBJECT, is the string or buffer\n\
976 containing the text.")
977 (start
, end
, prop
, value
, object
)
978 Lisp_Object start
, end
, prop
, value
, object
;
984 XSET (object
, Lisp_Buffer
, current_buffer
);
985 i
= validate_interval_range (object
, &start
, &end
, soft
);
988 while (! NULL_INTERVAL_P (i
))
990 if (i
->position
>= e
)
992 if (EQ (textget (i
->plist
, prop
), value
))
995 if (pos
< XINT (start
))
997 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
999 i
= next_interval (i
);
1004 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1005 Stext_property_not_all
, 4, 5, 0,
1006 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1007 If so, return the position of the first character whose PROP is not\n\
1008 `eq' to VALUE. Otherwise, return nil.\n\
1009 The optional fifth argument, OBJECT, is the string or buffer\n\
1010 containing the text.")
1011 (start
, end
, prop
, value
, object
)
1012 Lisp_Object start
, end
, prop
, value
, object
;
1014 register INTERVAL i
;
1018 XSET (object
, Lisp_Buffer
, current_buffer
);
1019 i
= validate_interval_range (object
, &start
, &end
, soft
);
1020 if (NULL_INTERVAL_P (i
))
1021 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1025 while (! NULL_INTERVAL_P (i
))
1027 if (i
->position
>= e
)
1029 if (! EQ (textget (i
->plist
, prop
), value
))
1031 if (i
->position
> s
)
1033 return make_number (s
- (XTYPE (object
) == Lisp_String
));
1035 i
= next_interval (i
);
1040 #if 0 /* You can use set-text-properties for this. */
1042 DEFUN ("erase-text-properties", Ferase_text_properties
,
1043 Serase_text_properties
, 2, 3, 0,
1044 "Remove all properties from the text from START to END.\n\
1045 The optional third argument, OBJECT,\n\
1046 is the string or buffer containing the text.")
1047 (start
, end
, object
)
1048 Lisp_Object start
, end
, object
;
1050 register INTERVAL i
;
1051 register INTERVAL prev_changed
= NULL_INTERVAL
;
1052 register int s
, len
, modified
;
1055 XSET (object
, Lisp_Buffer
, current_buffer
);
1057 i
= validate_interval_range (object
, &start
, &end
, soft
);
1058 if (NULL_INTERVAL_P (i
))
1062 len
= XINT (end
) - s
;
1064 if (i
->position
!= s
)
1067 register INTERVAL unchanged
= i
;
1069 /* If there are properties here, then this text will be modified. */
1070 if (! NILP (i
->plist
))
1072 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1076 if (LENGTH (i
) > len
)
1078 i
= split_interval_right (i
, len
);
1079 copy_properties (unchanged
, i
);
1083 if (LENGTH (i
) == len
)
1088 /* If the text of I is without any properties, and contains
1089 LEN or more characters, then we may return without changing
1091 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1093 /* The amount of text to change extends past I, so just note
1094 how much we've gotten. */
1096 got
= LENGTH (i
) - (s
- i
->position
);
1100 i
= next_interval (i
);
1103 /* We are starting at the beginning of an interval, I. */
1106 if (LENGTH (i
) >= len
)
1108 /* If I has no properties, simply merge it if possible. */
1109 if (NILP (i
->plist
))
1111 if (! NULL_INTERVAL_P (prev_changed
))
1112 merge_interval_left (i
);
1114 return modified
? Qt
: Qnil
;
1117 if (LENGTH (i
) > len
)
1118 i
= split_interval_left (i
, len
);
1119 if (! NULL_INTERVAL_P (prev_changed
))
1120 merge_interval_left (i
);
1127 /* Here if we still need to erase past the end of I */
1129 if (NULL_INTERVAL_P (prev_changed
))
1131 modified
+= erase_properties (i
);
1136 modified
+= ! NILP (i
->plist
);
1137 /* Merging I will give it the properties of PREV_CHANGED. */
1138 prev_changed
= i
= merge_interval_left (i
);
1141 i
= next_interval (i
);
1144 return modified
? Qt
: Qnil
;
1148 /* I don't think this is the right interface to export; how often do you
1149 want to do something like this, other than when you're copying objects
1152 I think it would be better to have a pair of functions, one which
1153 returns the text properties of a region as a list of ranges and
1154 plists, and another which applies such a list to another object. */
1156 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1157 Scopy_text_properties, 5, 6, 0,
1158 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1159 SRC and DEST may each refer to strings or buffers.\n\
1160 Optional sixth argument PROP causes only that property to be copied.\n\
1161 Properties are copied to DEST as if by `add-text-properties'.\n\
1162 Return t if any property value actually changed, nil otherwise.") */
1165 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1166 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1172 int s
, e
, e2
, p
, len
, modified
= 0;
1174 i
= validate_interval_range (src
, &start
, &end
, soft
);
1175 if (NULL_INTERVAL_P (i
))
1178 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1180 Lisp_Object dest_start
, dest_end
;
1183 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1184 /* Apply this to a copy of pos; it will try to increment its arguments,
1185 which we don't want. */
1186 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1197 e2
= i
->position
+ LENGTH (i
);
1204 while (! NILP (plist
))
1206 if (EQ (Fcar (plist
), prop
))
1208 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1211 plist
= Fcdr (Fcdr (plist
));
1215 /* Must defer modifications to the interval tree in case src
1216 and dest refer to the same string or buffer. */
1217 stuff
= Fcons (Fcons (make_number (p
),
1218 Fcons (make_number (p
+ len
),
1219 Fcons (plist
, Qnil
))),
1223 i
= next_interval (i
);
1224 if (NULL_INTERVAL_P (i
))
1231 while (! NILP (stuff
))
1234 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1235 Fcar (Fcdr (Fcdr (res
))), dest
);
1238 stuff
= Fcdr (stuff
);
1241 return modified
? Qt
: Qnil
;
1247 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1248 "Threshold for rebalancing interval trees, expressed as the\n\
1249 percentage by which the left interval tree should not differ from the right.");
1250 interval_balance_threshold
= 8;
1252 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1253 "If non-nil, don't call the text property values of\n\
1254 `point-left' and `point-entered'.");
1255 Vinhibit_point_motion_hooks
= Qnil
;
1257 /* Common attributes one might give text */
1259 staticpro (&Qforeground
);
1260 Qforeground
= intern ("foreground");
1261 staticpro (&Qbackground
);
1262 Qbackground
= intern ("background");
1264 Qfont
= intern ("font");
1265 staticpro (&Qstipple
);
1266 Qstipple
= intern ("stipple");
1267 staticpro (&Qunderline
);
1268 Qunderline
= intern ("underline");
1269 staticpro (&Qread_only
);
1270 Qread_only
= intern ("read-only");
1271 staticpro (&Qinvisible
);
1272 Qinvisible
= intern ("invisible");
1273 staticpro (&Qhidden
);
1274 Qhidden
= intern ("hidden");
1275 staticpro (&Qcategory
);
1276 Qcategory
= intern ("category");
1277 staticpro (&Qlocal_map
);
1278 Qlocal_map
= intern ("local-map");
1279 staticpro (&Qfront_sticky
);
1280 Qfront_sticky
= intern ("front-sticky");
1281 staticpro (&Qrear_nonsticky
);
1282 Qrear_nonsticky
= intern ("rear-nonsticky");
1284 /* Properties that text might use to specify certain actions */
1286 staticpro (&Qmouse_left
);
1287 Qmouse_left
= intern ("mouse-left");
1288 staticpro (&Qmouse_entered
);
1289 Qmouse_entered
= intern ("mouse-entered");
1290 staticpro (&Qpoint_left
);
1291 Qpoint_left
= intern ("point-left");
1292 staticpro (&Qpoint_entered
);
1293 Qpoint_entered
= intern ("point-entered");
1295 defsubr (&Stext_properties_at
);
1296 defsubr (&Sget_text_property
);
1297 defsubr (&Snext_property_change
);
1298 defsubr (&Snext_single_property_change
);
1299 defsubr (&Sprevious_property_change
);
1300 defsubr (&Sprevious_single_property_change
);
1301 defsubr (&Sadd_text_properties
);
1302 defsubr (&Sput_text_property
);
1303 defsubr (&Sset_text_properties
);
1304 defsubr (&Sremove_text_properties
);
1305 defsubr (&Stext_property_any
);
1306 defsubr (&Stext_property_not_all
);
1307 /* defsubr (&Serase_text_properties); */
1308 /* defsubr (&Scopy_text_properties); */
1313 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1315 #endif /* USE_TEXT_PROPERTIES */