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 Return nil if the property is constant all the way to the end of OBJECT.\n\
590 If the value is non-nil, it is a position greater than POS, never equal.")
592 Lisp_Object pos
, prop
, object
;
594 register INTERVAL i
, next
;
595 register Lisp_Object here_val
;
598 XSET (object
, Lisp_Buffer
, current_buffer
);
600 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
601 if (NULL_INTERVAL_P (i
))
604 here_val
= textget (i
->plist
, prop
);
605 next
= next_interval (i
);
606 while (! NULL_INTERVAL_P (next
)
607 && EQ (here_val
, textget (next
->plist
, prop
)))
608 next
= next_interval (next
);
610 if (NULL_INTERVAL_P (next
))
613 return next
->position
- (XTYPE (object
) == Lisp_String
);
616 DEFUN ("previous-property-change", Fprevious_property_change
,
617 Sprevious_property_change
, 1, 2, 0,
618 "Return the position of previous property change.\n\
619 Scans characters backwards from POS in OBJECT till it finds\n\
620 a change in some text property, then returns the position of the change.\n\
621 The optional second argument OBJECT is the string or buffer to scan.\n\
622 Return nil if the property is constant all the way to the start of OBJECT.\n\
623 If the value is non-nil, it is a position less than POS, never equal.")
625 Lisp_Object pos
, object
;
627 register INTERVAL i
, previous
;
630 XSET (object
, Lisp_Buffer
, current_buffer
);
632 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
633 if (NULL_INTERVAL_P (i
))
636 previous
= previous_interval (i
);
637 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
))
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 ("previous-single-property-change", Fprevious_single_property_change
,
647 Sprevious_single_property_change
, 2, 3, 0,
648 "Return the position of previous property change for a specific property.\n\
649 Scans characters backward from POS till it finds\n\
650 a change in the PROP property, then returns the position of the change.\n\
651 The optional third argument OBJECT is the string or buffer to scan.\n\
652 Return nil if the property is constant all the way to the start of OBJECT.\n\
653 If the value is non-nil, it is a position less than POS, never equal.")
655 Lisp_Object pos
, prop
, object
;
657 register INTERVAL i
, previous
;
658 register Lisp_Object here_val
;
661 XSET (object
, Lisp_Buffer
, current_buffer
);
663 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
664 if (NULL_INTERVAL_P (i
))
667 here_val
= textget (i
->plist
, prop
);
668 previous
= previous_interval (i
);
669 while (! NULL_INTERVAL_P (previous
)
670 && EQ (here_val
, textget (previous
->plist
, prop
)))
671 previous
= previous_interval (previous
);
672 if (NULL_INTERVAL_P (previous
))
675 return (previous
->position
+ LENGTH (previous
) - 1
676 - (XTYPE (object
) == Lisp_String
));
679 DEFUN ("add-text-properties", Fadd_text_properties
,
680 Sadd_text_properties
, 3, 4, 0,
681 "Add properties to the text from START to END.\n\
682 The third argument PROPS is a property list\n\
683 specifying the property values to add.\n\
684 The optional fourth argument, OBJECT,\n\
685 is the string or buffer containing the text.\n\
686 Return t if any property value actually changed, nil otherwise.")
687 (start
, end
, properties
, object
)
688 Lisp_Object start
, end
, properties
, object
;
690 register INTERVAL i
, unchanged
;
691 register int s
, len
, modified
= 0;
693 properties
= validate_plist (properties
);
694 if (NILP (properties
))
698 XSET (object
, Lisp_Buffer
, current_buffer
);
700 i
= validate_interval_range (object
, &start
, &end
, hard
);
701 if (NULL_INTERVAL_P (i
))
705 len
= XINT (end
) - s
;
707 /* If we're not starting on an interval boundary, we have to
708 split this interval. */
709 if (i
->position
!= s
)
711 /* If this interval already has the properties, we can
713 if (interval_has_all_properties (properties
, i
))
715 int got
= (LENGTH (i
) - (s
- i
->position
));
719 i
= next_interval (i
);
724 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
725 copy_properties (unchanged
, i
);
729 /* We are at the beginning of interval I, with LEN chars to scan. */
735 if (LENGTH (i
) >= len
)
737 if (interval_has_all_properties (properties
, i
))
738 return modified
? Qt
: Qnil
;
740 if (LENGTH (i
) == len
)
742 add_properties (properties
, i
, object
);
746 /* i doesn't have the properties, and goes past the change limit */
748 i
= split_interval_left (unchanged
, len
);
749 copy_properties (unchanged
, i
);
750 add_properties (properties
, i
, object
);
755 modified
+= add_properties (properties
, i
, object
);
756 i
= next_interval (i
);
760 DEFUN ("put-text-property", Fput_text_property
,
761 Sput_text_property
, 4, 5, 0,
762 "Set one property of the text from START to END.\n\
763 The third and fourth arguments PROP and VALUE\n\
764 specify the property to add.\n\
765 The optional fifth argument, OBJECT,\n\
766 is the string or buffer containing the text.")
767 (start
, end
, prop
, value
, object
)
768 Lisp_Object start
, end
, prop
, value
, object
;
770 Fadd_text_properties (start
, end
,
771 Fcons (prop
, Fcons (value
, Qnil
)),
776 DEFUN ("set-text-properties", Fset_text_properties
,
777 Sset_text_properties
, 3, 4, 0,
778 "Completely replace properties of text from START to END.\n\
779 The third argument PROPS is the new property list.\n\
780 The optional fourth argument, OBJECT,\n\
781 is the string or buffer containing the text.")
782 (start
, end
, props
, object
)
783 Lisp_Object start
, end
, props
, object
;
785 register INTERVAL i
, unchanged
;
786 register INTERVAL prev_changed
= NULL_INTERVAL
;
789 props
= validate_plist (props
);
792 XSET (object
, Lisp_Buffer
, current_buffer
);
794 i
= validate_interval_range (object
, &start
, &end
, hard
);
795 if (NULL_INTERVAL_P (i
))
799 len
= XINT (end
) - s
;
801 if (i
->position
!= s
)
804 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
806 if (LENGTH (i
) > len
)
808 copy_properties (unchanged
, i
);
809 i
= split_interval_left (i
, len
);
810 set_properties (props
, i
, object
);
814 set_properties (props
, i
, object
);
816 if (LENGTH (i
) == len
)
821 i
= next_interval (i
);
824 /* We are starting at the beginning of an interval, I */
830 if (LENGTH (i
) >= len
)
832 if (LENGTH (i
) > len
)
833 i
= split_interval_left (i
, len
);
835 if (NULL_INTERVAL_P (prev_changed
))
836 set_properties (props
, i
, object
);
838 merge_interval_left (i
);
843 if (NULL_INTERVAL_P (prev_changed
))
845 set_properties (props
, i
, object
);
849 prev_changed
= i
= merge_interval_left (i
);
851 i
= next_interval (i
);
857 DEFUN ("remove-text-properties", Fremove_text_properties
,
858 Sremove_text_properties
, 3, 4, 0,
859 "Remove some properties from text from START to END.\n\
860 The third argument PROPS is a property list\n\
861 whose property names specify the properties to remove.\n\
862 \(The values stored in PROPS are ignored.)\n\
863 The optional fourth argument, OBJECT,\n\
864 is the string or buffer containing the text.\n\
865 Return t if any property was actually removed, nil otherwise.")
866 (start
, end
, props
, object
)
867 Lisp_Object start
, end
, props
, object
;
869 register INTERVAL i
, unchanged
;
870 register int s
, len
, modified
= 0;
873 XSET (object
, Lisp_Buffer
, current_buffer
);
875 i
= validate_interval_range (object
, &start
, &end
, soft
);
876 if (NULL_INTERVAL_P (i
))
880 len
= XINT (end
) - s
;
882 if (i
->position
!= s
)
884 /* No properties on this first interval -- return if
885 it covers the entire region. */
886 if (! interval_has_some_properties (props
, i
))
888 int got
= (LENGTH (i
) - (s
- i
->position
));
892 i
= next_interval (i
);
894 /* Split away the beginning of this interval; what we don't
899 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
900 copy_properties (unchanged
, i
);
904 /* We are at the beginning of an interval, with len to scan */
910 if (LENGTH (i
) >= len
)
912 if (! interval_has_some_properties (props
, i
))
913 return modified
? Qt
: Qnil
;
915 if (LENGTH (i
) == len
)
917 remove_properties (props
, i
, object
);
921 /* i has the properties, and goes past the change limit */
923 i
= split_interval_left (i
, len
);
924 copy_properties (unchanged
, i
);
925 remove_properties (props
, i
, object
);
930 modified
+= remove_properties (props
, i
, object
);
931 i
= next_interval (i
);
935 DEFUN ("text-property-any", Ftext_property_any
,
936 Stext_property_any
, 4, 5, 0,
937 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
938 If so, return the position of the first character whose PROP is `eq'\n\
939 to VALUE. Otherwise return nil.\n\
940 The optional fifth argument, OBJECT, is the string or buffer\n\
941 containing the text.")
942 (start
, end
, prop
, value
, object
)
943 Lisp_Object start
, end
, prop
, value
, object
;
949 XSET (object
, Lisp_Buffer
, current_buffer
);
950 i
= validate_interval_range (object
, &start
, &end
, soft
);
953 while (! NULL_INTERVAL_P (i
))
955 if (i
->position
>= e
)
957 if (EQ (textget (i
->plist
, prop
), value
))
960 if (pos
< XINT (start
))
962 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
964 i
= next_interval (i
);
969 DEFUN ("text-property-not-all", Ftext_property_not_all
,
970 Stext_property_not_all
, 4, 5, 0,
971 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
972 If so, return the position of the first character whose PROP is not\n\
973 `eq' to VALUE. Otherwise, return nil.\n\
974 The optional fifth argument, OBJECT, is the string or buffer\n\
975 containing the text.")
976 (start
, end
, prop
, value
, object
)
977 Lisp_Object start
, end
, prop
, value
, object
;
983 XSET (object
, Lisp_Buffer
, current_buffer
);
984 i
= validate_interval_range (object
, &start
, &end
, soft
);
985 if (NULL_INTERVAL_P (i
))
986 return (NILP (value
) || EQ (start
, end
)) ? Qt
: Qnil
;
990 while (! NULL_INTERVAL_P (i
))
992 if (i
->position
>= e
)
994 if (! EQ (textget (i
->plist
, prop
), value
))
998 return make_number (s
- (XTYPE (object
) == Lisp_String
));
1000 i
= next_interval (i
);
1005 #if 0 /* You can use set-text-properties for this. */
1007 DEFUN ("erase-text-properties", Ferase_text_properties
,
1008 Serase_text_properties
, 2, 3, 0,
1009 "Remove all properties from the text from START to END.\n\
1010 The optional third argument, OBJECT,\n\
1011 is the string or buffer containing the text.")
1012 (start
, end
, object
)
1013 Lisp_Object start
, end
, object
;
1015 register INTERVAL i
;
1016 register INTERVAL prev_changed
= NULL_INTERVAL
;
1017 register int s
, len
, modified
;
1020 XSET (object
, Lisp_Buffer
, current_buffer
);
1022 i
= validate_interval_range (object
, &start
, &end
, soft
);
1023 if (NULL_INTERVAL_P (i
))
1027 len
= XINT (end
) - s
;
1029 if (i
->position
!= s
)
1032 register INTERVAL unchanged
= i
;
1034 /* If there are properties here, then this text will be modified. */
1035 if (! NILP (i
->plist
))
1037 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1041 if (LENGTH (i
) > len
)
1043 i
= split_interval_right (i
, len
);
1044 copy_properties (unchanged
, i
);
1048 if (LENGTH (i
) == len
)
1053 /* If the text of I is without any properties, and contains
1054 LEN or more characters, then we may return without changing
1056 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1058 /* The amount of text to change extends past I, so just note
1059 how much we've gotten. */
1061 got
= LENGTH (i
) - (s
- i
->position
);
1065 i
= next_interval (i
);
1068 /* We are starting at the beginning of an interval, I. */
1071 if (LENGTH (i
) >= len
)
1073 /* If I has no properties, simply merge it if possible. */
1074 if (NILP (i
->plist
))
1076 if (! NULL_INTERVAL_P (prev_changed
))
1077 merge_interval_left (i
);
1079 return modified
? Qt
: Qnil
;
1082 if (LENGTH (i
) > len
)
1083 i
= split_interval_left (i
, len
);
1084 if (! NULL_INTERVAL_P (prev_changed
))
1085 merge_interval_left (i
);
1092 /* Here if we still need to erase past the end of I */
1094 if (NULL_INTERVAL_P (prev_changed
))
1096 modified
+= erase_properties (i
);
1101 modified
+= ! NILP (i
->plist
);
1102 /* Merging I will give it the properties of PREV_CHANGED. */
1103 prev_changed
= i
= merge_interval_left (i
);
1106 i
= next_interval (i
);
1109 return modified
? Qt
: Qnil
;
1113 /* I don't think this is the right interface to export; how often do you
1114 want to do something like this, other than when you're copying objects
1117 I think it would be better to have a pair of functions, one which
1118 returns the text properties of a region as a list of ranges and
1119 plists, and another which applies such a list to another object. */
1121 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1122 Scopy_text_properties, 5, 6, 0,
1123 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1124 SRC and DEST may each refer to strings or buffers.\n\
1125 Optional sixth argument PROP causes only that property to be copied.\n\
1126 Properties are copied to DEST as if by `add-text-properties'.\n\
1127 Return t if any property value actually changed, nil otherwise.") */
1130 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1131 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1137 int s
, e
, e2
, p
, len
, modified
= 0;
1139 i
= validate_interval_range (src
, &start
, &end
, soft
);
1140 if (NULL_INTERVAL_P (i
))
1143 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1145 Lisp_Object dest_start
, dest_end
;
1148 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1149 /* Apply this to a copy of pos; it will try to increment its arguments,
1150 which we don't want. */
1151 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1162 e2
= i
->position
+ LENGTH (i
);
1169 while (! NILP (plist
))
1171 if (EQ (Fcar (plist
), prop
))
1173 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1176 plist
= Fcdr (Fcdr (plist
));
1180 /* Must defer modifications to the interval tree in case src
1181 and dest refer to the same string or buffer. */
1182 stuff
= Fcons (Fcons (make_number (p
),
1183 Fcons (make_number (p
+ len
),
1184 Fcons (plist
, Qnil
))),
1188 i
= next_interval (i
);
1189 if (NULL_INTERVAL_P (i
))
1196 while (! NILP (stuff
))
1199 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1200 Fcar (Fcdr (Fcdr (res
))), dest
);
1203 stuff
= Fcdr (stuff
);
1206 return modified
? Qt
: Qnil
;
1212 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1213 "Threshold for rebalancing interval trees, expressed as the\n\
1214 percentage by which the left interval tree should not differ from the right.");
1215 interval_balance_threshold
= 8;
1217 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1218 "If nonnil, don't call the text property values of\n\
1219 `point-left' and `point-entered'.");
1220 Vinhibit_point_motion_hooks
= Qnil
;
1222 /* Common attributes one might give text */
1224 staticpro (&Qforeground
);
1225 Qforeground
= intern ("foreground");
1226 staticpro (&Qbackground
);
1227 Qbackground
= intern ("background");
1229 Qfont
= intern ("font");
1230 staticpro (&Qstipple
);
1231 Qstipple
= intern ("stipple");
1232 staticpro (&Qunderline
);
1233 Qunderline
= intern ("underline");
1234 staticpro (&Qread_only
);
1235 Qread_only
= intern ("read-only");
1236 staticpro (&Qinvisible
);
1237 Qinvisible
= intern ("invisible");
1238 staticpro (&Qhidden
);
1239 Qhidden
= intern ("hidden");
1240 staticpro (&Qcategory
);
1241 Qcategory
= intern ("category");
1242 staticpro (&Qlocal_map
);
1243 Qlocal_map
= intern ("local-map");
1244 staticpro (&Qfront_sticky
);
1245 Qfront_sticky
= intern ("front-sticky");
1246 staticpro (&Qrear_nonsticky
);
1247 Qrear_nonsticky
= intern ("rear-nonsticky");
1249 /* Properties that text might use to specify certain actions */
1251 staticpro (&Qmouse_left
);
1252 Qmouse_left
= intern ("mouse-left");
1253 staticpro (&Qmouse_entered
);
1254 Qmouse_entered
= intern ("mouse-entered");
1255 staticpro (&Qpoint_left
);
1256 Qpoint_left
= intern ("point-left");
1257 staticpro (&Qpoint_entered
);
1258 Qpoint_entered
= intern ("point-entered");
1260 defsubr (&Stext_properties_at
);
1261 defsubr (&Sget_text_property
);
1262 defsubr (&Snext_property_change
);
1263 defsubr (&Snext_single_property_change
);
1264 defsubr (&Sprevious_property_change
);
1265 defsubr (&Sprevious_single_property_change
);
1266 defsubr (&Sadd_text_properties
);
1267 defsubr (&Sput_text_property
);
1268 defsubr (&Sset_text_properties
);
1269 defsubr (&Sremove_text_properties
);
1270 defsubr (&Stext_property_any
);
1271 defsubr (&Stext_property_not_all
);
1272 /* defsubr (&Serase_text_properties); */
1273 /* defsubr (&Scopy_text_properties); */
1278 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1280 #endif /* USE_TEXT_PROPERTIES */