1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994 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"
27 /* NOTES: previous- and next- property change will have to skip
28 zero-length intervals if they are implemented. This could be done
29 inside next_interval and previous_interval.
31 set_properties needs to deal with the interval property cache.
33 It is assumed that for any interval plist, a property appears
34 only once on the list. Although some code i.e., remove_properties,
35 handles the more general case, the uniqueness of properties is
36 necessary for the system to remain consistent. This requirement
37 is enforced by the subrs installing properties onto the intervals. */
39 /* The rest of the file is within this conditional */
40 #ifdef USE_TEXT_PROPERTIES
43 Lisp_Object Qmouse_left
;
44 Lisp_Object Qmouse_entered
;
45 Lisp_Object Qpoint_left
;
46 Lisp_Object Qpoint_entered
;
47 Lisp_Object Qcategory
;
48 Lisp_Object Qlocal_map
;
50 /* Visual properties text (including strings) may have. */
51 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
52 Lisp_Object Qinvisible
, Qread_only
, Qintangible
;
54 /* Sticky properties */
55 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
57 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
58 the o1's cdr. Otherwise, return zero. This is handy for
60 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr))
62 Lisp_Object Vinhibit_point_motion_hooks
;
65 /* Extract the interval at the position pointed to by BEGIN from
66 OBJECT, a string or buffer. Additionally, check that the positions
67 pointed to by BEGIN and END are within the bounds of OBJECT, and
68 reverse them if *BEGIN is greater than *END. The objects pointed
69 to by BEGIN and END may be integers or markers; if the latter, they
70 are coerced to integers.
72 When OBJECT is a string, we increment *BEGIN and *END
73 to make them origin-one.
75 Note that buffer points don't correspond to interval indices.
76 For example, point-max is 1 greater than the index of the last
77 character. This difference is handled in the caller, which uses
78 the validated points to determine a length, and operates on that.
79 Exceptions are Ftext_properties_at, Fnext_property_change, and
80 Fprevious_property_change which call this function with BEGIN == END.
81 Handle this case specially.
83 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
84 create an interval tree for OBJECT if one doesn't exist, provided
85 the object actually contains text. In the current design, if there
86 is no text, there can be no text properties. */
92 validate_interval_range (object
, begin
, end
, force
)
93 Lisp_Object object
, *begin
, *end
;
99 CHECK_STRING_OR_BUFFER (object
, 0);
100 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
101 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
103 /* If we are asked for a point, but from a subr which operates
104 on a range, then return nothing. */
105 if (*begin
== *end
&& begin
!= end
)
106 return NULL_INTERVAL
;
108 if (XINT (*begin
) > XINT (*end
))
116 if (XTYPE (object
) == Lisp_Buffer
)
118 register struct buffer
*b
= XBUFFER (object
);
120 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
121 && XINT (*end
) <= BUF_ZV (b
)))
122 args_out_of_range (*begin
, *end
);
125 /* If there's no text, there are no properties. */
126 if (BUF_BEGV (b
) == BUF_ZV (b
))
127 return NULL_INTERVAL
;
129 searchpos
= XINT (*begin
);
133 register struct Lisp_String
*s
= XSTRING (object
);
135 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
136 && XINT (*end
) <= s
->size
))
137 args_out_of_range (*begin
, *end
);
138 /* User-level Positions in strings start with 0,
139 but the interval code always wants positions starting with 1. */
140 XFASTINT (*begin
) += 1;
142 XFASTINT (*end
) += 1;
146 return NULL_INTERVAL
;
148 searchpos
= XINT (*begin
);
151 if (NULL_INTERVAL_P (i
))
152 return (force
? create_root_interval (object
) : i
);
154 return find_interval (i
, searchpos
);
157 /* Validate LIST as a property list. If LIST is not a list, then
158 make one consisting of (LIST nil). Otherwise, verify that LIST
159 is even numbered and thus suitable as a plist. */
162 validate_plist (list
)
171 register Lisp_Object tail
;
172 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
178 error ("Odd length text property list");
182 return Fcons (list
, Fcons (Qnil
, Qnil
));
185 /* Return nonzero if interval I has all the properties,
186 with the same values, of list PLIST. */
189 interval_has_all_properties (plist
, i
)
193 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
196 /* Go through each element of PLIST. */
197 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
202 /* Go through I's plist, looking for sym1 */
203 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
204 if (EQ (sym1
, Fcar (tail2
)))
206 /* Found the same property on both lists. If the
207 values are unequal, return zero. */
208 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
211 /* Property has same value on both lists; go to next one. */
223 /* Return nonzero if the plist of interval I has any of the
224 properties of PLIST, regardless of their values. */
227 interval_has_some_properties (plist
, i
)
231 register Lisp_Object tail1
, tail2
, sym
;
233 /* Go through each element of PLIST. */
234 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
238 /* Go through i's plist, looking for tail1 */
239 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
240 if (EQ (sym
, Fcar (tail2
)))
247 /* Changing the plists of individual intervals. */
249 /* Return the value of PROP in property-list PLIST, or Qunbound if it
252 property_value (plist
, prop
)
256 while (PLIST_ELT_P (plist
, value
))
257 if (EQ (XCONS (plist
)->car
, prop
))
258 return XCONS (value
)->car
;
260 plist
= XCONS (value
)->cdr
;
265 /* Set the properties of INTERVAL to PROPERTIES,
266 and record undo info for the previous values.
267 OBJECT is the string or buffer that INTERVAL belongs to. */
270 set_properties (properties
, interval
, object
)
271 Lisp_Object properties
, object
;
274 Lisp_Object sym
, value
;
276 if (BUFFERP (object
))
278 /* For each property in the old plist which is missing from PROPERTIES,
279 or has a different value in PROPERTIES, make an undo record. */
280 for (sym
= interval
->plist
;
281 PLIST_ELT_P (sym
, value
);
282 sym
= XCONS (value
)->cdr
)
283 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
286 modify_region (XBUFFER (object
),
287 make_number (interval
->position
),
288 make_number (interval
->position
+ LENGTH (interval
)));
289 record_property_change (interval
->position
, LENGTH (interval
),
290 XCONS (sym
)->car
, XCONS (value
)->car
,
294 /* For each new property that has no value at all in the old plist,
295 make an undo record binding it to nil, so it will be removed. */
296 for (sym
= properties
;
297 PLIST_ELT_P (sym
, value
);
298 sym
= XCONS (value
)->cdr
)
299 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
301 modify_region (XBUFFER (object
),
302 make_number (interval
->position
),
303 make_number (interval
->position
+ LENGTH (interval
)));
304 record_property_change (interval
->position
, LENGTH (interval
),
305 XCONS (sym
)->car
, Qnil
,
310 /* Store new properties. */
311 interval
->plist
= Fcopy_sequence (properties
);
314 /* Add the properties of PLIST to the interval I, or set
315 the value of I's property to the value of the property on PLIST
316 if they are different.
318 OBJECT should be the string or buffer the interval is in.
320 Return nonzero if this changes I (i.e., if any members of PLIST
321 are actually added to I's plist) */
324 add_properties (plist
, i
, object
)
329 register Lisp_Object tail1
, tail2
, sym1
, val1
;
330 register int changed
= 0;
333 /* Go through each element of PLIST. */
334 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
337 val1
= Fcar (Fcdr (tail1
));
340 /* Go through I's plist, looking for sym1 */
341 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
342 if (EQ (sym1
, Fcar (tail2
)))
344 register Lisp_Object this_cdr
;
346 this_cdr
= Fcdr (tail2
);
347 /* Found the property. Now check its value. */
350 /* The properties have the same value on both lists.
351 Continue to the next property. */
352 if (EQ (val1
, Fcar (this_cdr
)))
355 /* Record this change in the buffer, for undo purposes. */
356 if (XTYPE (object
) == Lisp_Buffer
)
358 modify_region (XBUFFER (object
),
359 make_number (i
->position
),
360 make_number (i
->position
+ LENGTH (i
)));
361 record_property_change (i
->position
, LENGTH (i
),
362 sym1
, Fcar (this_cdr
), object
);
365 /* I's property has a different value -- change it */
366 Fsetcar (this_cdr
, val1
);
373 /* Record this change in the buffer, for undo purposes. */
374 if (XTYPE (object
) == Lisp_Buffer
)
376 modify_region (XBUFFER (object
),
377 make_number (i
->position
),
378 make_number (i
->position
+ LENGTH (i
)));
379 record_property_change (i
->position
, LENGTH (i
),
382 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
390 /* For any members of PLIST which are properties of I, remove them
392 OBJECT is the string or buffer containing I. */
395 remove_properties (plist
, i
, object
)
400 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
401 register int changed
= 0;
403 current_plist
= i
->plist
;
404 /* Go through each element of plist. */
405 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
409 /* First, remove the symbol if its at the head of the list */
410 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
412 if (XTYPE (object
) == Lisp_Buffer
)
414 modify_region (XBUFFER (object
),
415 make_number (i
->position
),
416 make_number (i
->position
+ LENGTH (i
)));
417 record_property_change (i
->position
, LENGTH (i
),
418 sym
, Fcar (Fcdr (current_plist
)),
422 current_plist
= Fcdr (Fcdr (current_plist
));
426 /* Go through i's plist, looking for sym */
427 tail2
= current_plist
;
428 while (! NILP (tail2
))
430 register Lisp_Object
this;
431 this = Fcdr (Fcdr (tail2
));
432 if (EQ (sym
, Fcar (this)))
434 if (XTYPE (object
) == Lisp_Buffer
)
436 modify_region (XBUFFER (object
),
437 make_number (i
->position
),
438 make_number (i
->position
+ LENGTH (i
)));
439 record_property_change (i
->position
, LENGTH (i
),
440 sym
, Fcar (Fcdr (this)), object
);
443 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
451 i
->plist
= current_plist
;
456 /* Remove all properties from interval I. Return non-zero
457 if this changes the interval. */
471 DEFUN ("text-properties-at", Ftext_properties_at
,
472 Stext_properties_at
, 1, 2, 0,
473 "Return the list of properties held by the character at POSITION\n\
474 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
475 defaults to the current buffer.\n\
476 If POSITION is at the end of OBJECT, the value is nil.")
478 Lisp_Object pos
, object
;
483 XSET (object
, Lisp_Buffer
, current_buffer
);
485 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
486 if (NULL_INTERVAL_P (i
))
488 /* If POS is at the end of the interval,
489 it means it's the end of OBJECT.
490 There are no properties at the very end,
491 since no character follows. */
492 if (XINT (pos
) == LENGTH (i
) + i
->position
)
498 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
499 "Return the value of position POS's property PROP, in OBJECT.\n\
500 OBJECT is optional and defaults to the current buffer.\n\
501 If POSITION is at the end of OBJECT, the value is nil.")
503 Lisp_Object pos
, object
;
504 register Lisp_Object prop
;
507 register Lisp_Object tail
;
510 XSET (object
, Lisp_Buffer
, current_buffer
);
511 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
512 if (NULL_INTERVAL_P (i
))
515 /* If POS is at the end of the interval,
516 it means it's the end of OBJECT.
517 There are no properties at the very end,
518 since no character follows. */
519 if (XINT (pos
) == LENGTH (i
) + i
->position
)
522 return textget (i
->plist
, prop
);
525 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
526 "Return the value of position POS's property PROP, in OBJECT.\n\
527 OBJECT is optional and defaults to the current buffer.\n\
528 If POS is at the end of OBJECT, the value is nil.\n\
529 If OBJECT is a buffer, then overlay properties are considered as well as\n\
531 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
532 overlays are considered only if they are associated with OBJECT.")
534 Lisp_Object pos
, object
;
535 register Lisp_Object prop
;
537 struct window
*w
= 0;
539 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
542 XSET (object
, Lisp_Buffer
, current_buffer
);
544 if (WINDOWP (object
))
546 w
= XWINDOW (object
);
547 XSET (object
, Lisp_Buffer
, w
->buffer
);
549 if (BUFFERP (object
))
551 int posn
= XINT (pos
);
553 Lisp_Object
*overlay_vec
, tem
;
557 /* First try with room for 40 overlays. */
559 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
561 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
, &next_overlay
);
563 /* If there are more than 40,
564 make enough space for all, and try again. */
568 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
569 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
, &next_overlay
);
571 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
573 /* Now check the overlays in order of decreasing priority. */
574 while (--noverlays
>= 0)
576 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
581 /* Not a buffer, or no appropriate overlay, so fall through to the
583 return (Fget_text_property (pos
, prop
, object
));
586 DEFUN ("next-property-change", Fnext_property_change
,
587 Snext_property_change
, 1, 3, 0,
588 "Return the position of next property change.\n\
589 Scans characters forward from POS in OBJECT till it finds\n\
590 a change in some text property, then returns the position of the change.\n\
591 The optional second argument OBJECT is the string or buffer to scan.\n\
592 Return nil if the property is constant all the way to the end of OBJECT.\n\
593 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
594 If the optional third argument LIMIT is non-nil, don't search\n\
595 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
597 Lisp_Object pos
, object
, limit
;
599 register INTERVAL i
, next
;
602 XSET (object
, Lisp_Buffer
, current_buffer
);
605 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
607 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
608 if (NULL_INTERVAL_P (i
))
611 next
= next_interval (i
);
612 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
613 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
614 next
= next_interval (next
);
616 if (NULL_INTERVAL_P (next
))
618 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
621 return next
->position
- (XTYPE (object
) == Lisp_String
);
624 /* Return 1 if there's a change in some property between BEG and END. */
627 property_change_between_p (beg
, end
)
630 register INTERVAL i
, next
;
631 Lisp_Object object
, pos
;
633 XSET (object
, Lisp_Buffer
, current_buffer
);
634 XFASTINT (pos
) = beg
;
636 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
637 if (NULL_INTERVAL_P (i
))
640 next
= next_interval (i
);
641 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
643 next
= next_interval (next
);
644 if (NULL_INTERVAL_P (next
))
646 if (next
->position
>= end
)
650 if (NULL_INTERVAL_P (next
))
656 DEFUN ("next-single-property-change", Fnext_single_property_change
,
657 Snext_single_property_change
, 2, 4, 0,
658 "Return the position of next property change for a specific property.\n\
659 Scans characters forward from POS till it finds\n\
660 a change in the PROP property, then returns the position of the change.\n\
661 The optional third argument OBJECT is the string or buffer to scan.\n\
662 The property values are compared with `eq'.\n\
663 Return nil if the property is constant all the way to the end of OBJECT.\n\
664 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
665 If the optional fourth argument LIMIT is non-nil, don't search\n\
666 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
667 (pos
, prop
, object
, limit
)
668 Lisp_Object pos
, prop
, object
, limit
;
670 register INTERVAL i
, next
;
671 register Lisp_Object here_val
;
674 XSET (object
, Lisp_Buffer
, current_buffer
);
677 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
679 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
680 if (NULL_INTERVAL_P (i
))
683 here_val
= textget (i
->plist
, prop
);
684 next
= next_interval (i
);
685 while (! NULL_INTERVAL_P (next
)
686 && EQ (here_val
, textget (next
->plist
, prop
))
687 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
688 next
= next_interval (next
);
690 if (NULL_INTERVAL_P (next
))
692 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
695 return next
->position
- (XTYPE (object
) == Lisp_String
);
698 DEFUN ("previous-property-change", Fprevious_property_change
,
699 Sprevious_property_change
, 1, 3, 0,
700 "Return the position of previous property change.\n\
701 Scans characters backwards from POS in OBJECT till it finds\n\
702 a change in some text property, then returns the position of the change.\n\
703 The optional second argument OBJECT is the string or buffer to scan.\n\
704 Return nil if the property is constant all the way to the start of OBJECT.\n\
705 If the value is non-nil, it is a position less than POS, never equal.\n\n\
706 If the optional third argument LIMIT is non-nil, don't search\n\
707 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
709 Lisp_Object pos
, object
, limit
;
711 register INTERVAL i
, previous
;
714 XSET (object
, Lisp_Buffer
, current_buffer
);
717 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
719 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
720 if (NULL_INTERVAL_P (i
))
723 /* Start with the interval containing the char before point. */
724 if (i
->position
== XFASTINT (pos
))
725 i
= previous_interval (i
);
727 previous
= previous_interval (i
);
728 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
730 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
731 previous
= previous_interval (previous
);
732 if (NULL_INTERVAL_P (previous
))
735 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
738 return (previous
->position
+ LENGTH (previous
)
739 - (XTYPE (object
) == Lisp_String
));
742 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
743 Sprevious_single_property_change
, 2, 4, 0,
744 "Return the position of previous property change for a specific property.\n\
745 Scans characters backward from POS till it finds\n\
746 a change in the PROP property, then returns the position of the change.\n\
747 The optional third argument OBJECT is the string or buffer to scan.\n\
748 The property values are compared with `eq'.\n\
749 Return nil if the property is constant all the way to the start of OBJECT.\n\
750 If the value is non-nil, it is a position less than POS, never equal.\n\n\
751 If the optional fourth argument LIMIT is non-nil, don't search\n\
752 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
753 (pos
, prop
, object
, limit
)
754 Lisp_Object pos
, prop
, object
, limit
;
756 register INTERVAL i
, previous
;
757 register Lisp_Object here_val
;
760 XSET (object
, Lisp_Buffer
, current_buffer
);
763 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
765 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
767 /* Start with the interval containing the char before point. */
768 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (pos
))
769 i
= previous_interval (i
);
771 if (NULL_INTERVAL_P (i
))
774 here_val
= textget (i
->plist
, prop
);
775 previous
= previous_interval (i
);
776 while (! NULL_INTERVAL_P (previous
)
777 && EQ (here_val
, textget (previous
->plist
, prop
))
779 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
780 previous
= previous_interval (previous
);
781 if (NULL_INTERVAL_P (previous
))
784 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
787 return (previous
->position
+ LENGTH (previous
)
788 - (XTYPE (object
) == Lisp_String
));
791 DEFUN ("add-text-properties", Fadd_text_properties
,
792 Sadd_text_properties
, 3, 4, 0,
793 "Add properties to the text from START to END.\n\
794 The third argument PROPS is a property list\n\
795 specifying the property values to add.\n\
796 The optional fourth argument, OBJECT,\n\
797 is the string or buffer containing the text.\n\
798 Return t if any property value actually changed, nil otherwise.")
799 (start
, end
, properties
, object
)
800 Lisp_Object start
, end
, properties
, object
;
802 register INTERVAL i
, unchanged
;
803 register int s
, len
, modified
= 0;
805 properties
= validate_plist (properties
);
806 if (NILP (properties
))
810 XSET (object
, Lisp_Buffer
, current_buffer
);
812 i
= validate_interval_range (object
, &start
, &end
, hard
);
813 if (NULL_INTERVAL_P (i
))
817 len
= XINT (end
) - s
;
819 /* If we're not starting on an interval boundary, we have to
820 split this interval. */
821 if (i
->position
!= s
)
823 /* If this interval already has the properties, we can
825 if (interval_has_all_properties (properties
, i
))
827 int got
= (LENGTH (i
) - (s
- i
->position
));
831 i
= next_interval (i
);
836 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
837 copy_properties (unchanged
, i
);
841 /* We are at the beginning of interval I, with LEN chars to scan. */
847 if (LENGTH (i
) >= len
)
849 if (interval_has_all_properties (properties
, i
))
850 return modified
? Qt
: Qnil
;
852 if (LENGTH (i
) == len
)
854 add_properties (properties
, i
, object
);
858 /* i doesn't have the properties, and goes past the change limit */
860 i
= split_interval_left (unchanged
, len
);
861 copy_properties (unchanged
, i
);
862 add_properties (properties
, i
, object
);
867 modified
+= add_properties (properties
, i
, object
);
868 i
= next_interval (i
);
872 DEFUN ("put-text-property", Fput_text_property
,
873 Sput_text_property
, 4, 5, 0,
874 "Set one property of the text from START to END.\n\
875 The third and fourth arguments PROP and VALUE\n\
876 specify the property to add.\n\
877 The optional fifth argument, OBJECT,\n\
878 is the string or buffer containing the text.")
879 (start
, end
, prop
, value
, object
)
880 Lisp_Object start
, end
, prop
, value
, object
;
882 Fadd_text_properties (start
, end
,
883 Fcons (prop
, Fcons (value
, Qnil
)),
888 DEFUN ("set-text-properties", Fset_text_properties
,
889 Sset_text_properties
, 3, 4, 0,
890 "Completely replace properties of text from START to END.\n\
891 The third argument PROPS is the new property list.\n\
892 The optional fourth argument, OBJECT,\n\
893 is the string or buffer containing the text.")
894 (start
, end
, props
, object
)
895 Lisp_Object start
, end
, props
, object
;
897 register INTERVAL i
, unchanged
;
898 register INTERVAL prev_changed
= NULL_INTERVAL
;
901 props
= validate_plist (props
);
904 XSET (object
, Lisp_Buffer
, current_buffer
);
906 i
= validate_interval_range (object
, &start
, &end
, hard
);
907 if (NULL_INTERVAL_P (i
))
911 len
= XINT (end
) - s
;
913 if (i
->position
!= s
)
916 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
918 if (LENGTH (i
) > len
)
920 copy_properties (unchanged
, i
);
921 i
= split_interval_left (i
, len
);
922 set_properties (props
, i
, object
);
926 set_properties (props
, i
, object
);
928 if (LENGTH (i
) == len
)
933 i
= next_interval (i
);
936 /* We are starting at the beginning of an interval, I */
942 if (LENGTH (i
) >= len
)
944 if (LENGTH (i
) > len
)
945 i
= split_interval_left (i
, len
);
947 if (NULL_INTERVAL_P (prev_changed
))
948 set_properties (props
, i
, object
);
950 merge_interval_left (i
);
955 if (NULL_INTERVAL_P (prev_changed
))
957 set_properties (props
, i
, object
);
961 prev_changed
= i
= merge_interval_left (i
);
963 i
= next_interval (i
);
969 DEFUN ("remove-text-properties", Fremove_text_properties
,
970 Sremove_text_properties
, 3, 4, 0,
971 "Remove some properties from text from START to END.\n\
972 The third argument PROPS is a property list\n\
973 whose property names specify the properties to remove.\n\
974 \(The values stored in PROPS are ignored.)\n\
975 The optional fourth argument, OBJECT,\n\
976 is the string or buffer containing the text.\n\
977 Return t if any property was actually removed, nil otherwise.")
978 (start
, end
, props
, object
)
979 Lisp_Object start
, end
, props
, object
;
981 register INTERVAL i
, unchanged
;
982 register int s
, len
, modified
= 0;
985 XSET (object
, Lisp_Buffer
, current_buffer
);
987 i
= validate_interval_range (object
, &start
, &end
, soft
);
988 if (NULL_INTERVAL_P (i
))
992 len
= XINT (end
) - s
;
994 if (i
->position
!= s
)
996 /* No properties on this first interval -- return if
997 it covers the entire region. */
998 if (! interval_has_some_properties (props
, i
))
1000 int got
= (LENGTH (i
) - (s
- i
->position
));
1004 i
= next_interval (i
);
1006 /* Split away the beginning of this interval; what we don't
1011 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1012 copy_properties (unchanged
, i
);
1016 /* We are at the beginning of an interval, with len to scan */
1022 if (LENGTH (i
) >= len
)
1024 if (! interval_has_some_properties (props
, i
))
1025 return modified
? Qt
: Qnil
;
1027 if (LENGTH (i
) == len
)
1029 remove_properties (props
, i
, object
);
1033 /* i has the properties, and goes past the change limit */
1035 i
= split_interval_left (i
, len
);
1036 copy_properties (unchanged
, i
);
1037 remove_properties (props
, i
, object
);
1042 modified
+= remove_properties (props
, i
, object
);
1043 i
= next_interval (i
);
1047 DEFUN ("text-property-any", Ftext_property_any
,
1048 Stext_property_any
, 4, 5, 0,
1049 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1050 If so, return the position of the first character whose PROP is `eq'\n\
1051 to VALUE. Otherwise return nil.\n\
1052 The optional fifth argument, OBJECT, is the string or buffer\n\
1053 containing the text.")
1054 (start
, end
, prop
, value
, object
)
1055 Lisp_Object start
, end
, prop
, value
, object
;
1057 register INTERVAL i
;
1058 register int e
, pos
;
1061 XSET (object
, Lisp_Buffer
, current_buffer
);
1062 i
= validate_interval_range (object
, &start
, &end
, soft
);
1065 while (! NULL_INTERVAL_P (i
))
1067 if (i
->position
>= e
)
1069 if (EQ (textget (i
->plist
, prop
), value
))
1072 if (pos
< XINT (start
))
1074 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
1076 i
= next_interval (i
);
1081 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1082 Stext_property_not_all
, 4, 5, 0,
1083 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1084 If so, return the position of the first character whose PROP is not\n\
1085 `eq' to VALUE. Otherwise, return nil.\n\
1086 The optional fifth argument, OBJECT, is the string or buffer\n\
1087 containing the text.")
1088 (start
, end
, prop
, value
, object
)
1089 Lisp_Object start
, end
, prop
, value
, object
;
1091 register INTERVAL i
;
1095 XSET (object
, Lisp_Buffer
, current_buffer
);
1096 i
= validate_interval_range (object
, &start
, &end
, soft
);
1097 if (NULL_INTERVAL_P (i
))
1098 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1102 while (! NULL_INTERVAL_P (i
))
1104 if (i
->position
>= e
)
1106 if (! EQ (textget (i
->plist
, prop
), value
))
1108 if (i
->position
> s
)
1110 return make_number (s
- (XTYPE (object
) == Lisp_String
));
1112 i
= next_interval (i
);
1117 #if 0 /* You can use set-text-properties for this. */
1119 DEFUN ("erase-text-properties", Ferase_text_properties
,
1120 Serase_text_properties
, 2, 3, 0,
1121 "Remove all properties from the text from START to END.\n\
1122 The optional third argument, OBJECT,\n\
1123 is the string or buffer containing the text.")
1124 (start
, end
, object
)
1125 Lisp_Object start
, end
, object
;
1127 register INTERVAL i
;
1128 register INTERVAL prev_changed
= NULL_INTERVAL
;
1129 register int s
, len
, modified
;
1132 XSET (object
, Lisp_Buffer
, current_buffer
);
1134 i
= validate_interval_range (object
, &start
, &end
, soft
);
1135 if (NULL_INTERVAL_P (i
))
1139 len
= XINT (end
) - s
;
1141 if (i
->position
!= s
)
1144 register INTERVAL unchanged
= i
;
1146 /* If there are properties here, then this text will be modified. */
1147 if (! NILP (i
->plist
))
1149 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1153 if (LENGTH (i
) > len
)
1155 i
= split_interval_right (i
, len
);
1156 copy_properties (unchanged
, i
);
1160 if (LENGTH (i
) == len
)
1165 /* If the text of I is without any properties, and contains
1166 LEN or more characters, then we may return without changing
1168 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1170 /* The amount of text to change extends past I, so just note
1171 how much we've gotten. */
1173 got
= LENGTH (i
) - (s
- i
->position
);
1177 i
= next_interval (i
);
1180 /* We are starting at the beginning of an interval, I. */
1183 if (LENGTH (i
) >= len
)
1185 /* If I has no properties, simply merge it if possible. */
1186 if (NILP (i
->plist
))
1188 if (! NULL_INTERVAL_P (prev_changed
))
1189 merge_interval_left (i
);
1191 return modified
? Qt
: Qnil
;
1194 if (LENGTH (i
) > len
)
1195 i
= split_interval_left (i
, len
);
1196 if (! NULL_INTERVAL_P (prev_changed
))
1197 merge_interval_left (i
);
1204 /* Here if we still need to erase past the end of I */
1206 if (NULL_INTERVAL_P (prev_changed
))
1208 modified
+= erase_properties (i
);
1213 modified
+= ! NILP (i
->plist
);
1214 /* Merging I will give it the properties of PREV_CHANGED. */
1215 prev_changed
= i
= merge_interval_left (i
);
1218 i
= next_interval (i
);
1221 return modified
? Qt
: Qnil
;
1225 /* I don't think this is the right interface to export; how often do you
1226 want to do something like this, other than when you're copying objects
1229 I think it would be better to have a pair of functions, one which
1230 returns the text properties of a region as a list of ranges and
1231 plists, and another which applies such a list to another object. */
1233 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1234 Scopy_text_properties, 5, 6, 0,
1235 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1236 SRC and DEST may each refer to strings or buffers.\n\
1237 Optional sixth argument PROP causes only that property to be copied.\n\
1238 Properties are copied to DEST as if by `add-text-properties'.\n\
1239 Return t if any property value actually changed, nil otherwise.") */
1242 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1243 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1249 int s
, e
, e2
, p
, len
, modified
= 0;
1251 i
= validate_interval_range (src
, &start
, &end
, soft
);
1252 if (NULL_INTERVAL_P (i
))
1255 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1257 Lisp_Object dest_start
, dest_end
;
1260 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1261 /* Apply this to a copy of pos; it will try to increment its arguments,
1262 which we don't want. */
1263 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1274 e2
= i
->position
+ LENGTH (i
);
1281 while (! NILP (plist
))
1283 if (EQ (Fcar (plist
), prop
))
1285 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1288 plist
= Fcdr (Fcdr (plist
));
1292 /* Must defer modifications to the interval tree in case src
1293 and dest refer to the same string or buffer. */
1294 stuff
= Fcons (Fcons (make_number (p
),
1295 Fcons (make_number (p
+ len
),
1296 Fcons (plist
, Qnil
))),
1300 i
= next_interval (i
);
1301 if (NULL_INTERVAL_P (i
))
1308 while (! NILP (stuff
))
1311 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1312 Fcar (Fcdr (Fcdr (res
))), dest
);
1315 stuff
= Fcdr (stuff
);
1318 return modified
? Qt
: Qnil
;
1324 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold
,
1325 "Threshold for rebalancing interval trees, expressed as the\n\
1326 percentage by which the left interval tree should not differ from the right.");
1327 interval_balance_threshold
= 8;
1329 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1330 "If non-nil, don't call the text property values of\n\
1331 `point-left' and `point-entered'.");
1332 Vinhibit_point_motion_hooks
= Qnil
;
1334 /* Common attributes one might give text */
1336 staticpro (&Qforeground
);
1337 Qforeground
= intern ("foreground");
1338 staticpro (&Qbackground
);
1339 Qbackground
= intern ("background");
1341 Qfont
= intern ("font");
1342 staticpro (&Qstipple
);
1343 Qstipple
= intern ("stipple");
1344 staticpro (&Qunderline
);
1345 Qunderline
= intern ("underline");
1346 staticpro (&Qread_only
);
1347 Qread_only
= intern ("read-only");
1348 staticpro (&Qinvisible
);
1349 Qinvisible
= intern ("invisible");
1350 staticpro (&Qintangible
);
1351 Qintangible
= intern ("intangible");
1352 staticpro (&Qcategory
);
1353 Qcategory
= intern ("category");
1354 staticpro (&Qlocal_map
);
1355 Qlocal_map
= intern ("local-map");
1356 staticpro (&Qfront_sticky
);
1357 Qfront_sticky
= intern ("front-sticky");
1358 staticpro (&Qrear_nonsticky
);
1359 Qrear_nonsticky
= intern ("rear-nonsticky");
1361 /* Properties that text might use to specify certain actions */
1363 staticpro (&Qmouse_left
);
1364 Qmouse_left
= intern ("mouse-left");
1365 staticpro (&Qmouse_entered
);
1366 Qmouse_entered
= intern ("mouse-entered");
1367 staticpro (&Qpoint_left
);
1368 Qpoint_left
= intern ("point-left");
1369 staticpro (&Qpoint_entered
);
1370 Qpoint_entered
= intern ("point-entered");
1372 defsubr (&Stext_properties_at
);
1373 defsubr (&Sget_text_property
);
1374 defsubr (&Sget_char_property
);
1375 defsubr (&Snext_property_change
);
1376 defsubr (&Snext_single_property_change
);
1377 defsubr (&Sprevious_property_change
);
1378 defsubr (&Sprevious_single_property_change
);
1379 defsubr (&Sadd_text_properties
);
1380 defsubr (&Sput_text_property
);
1381 defsubr (&Sset_text_properties
);
1382 defsubr (&Sremove_text_properties
);
1383 defsubr (&Stext_property_any
);
1384 defsubr (&Stext_property_not_all
);
1385 /* defsubr (&Serase_text_properties); */
1386 /* defsubr (&Scopy_text_properties); */
1391 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1393 #endif /* USE_TEXT_PROPERTIES */