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 #define NULL (void *)0
31 /* NOTES: previous- and next- property change will have to skip
32 zero-length intervals if they are implemented. This could be done
33 inside next_interval and previous_interval.
35 set_properties needs to deal with the interval property cache.
37 It is assumed that for any interval plist, a property appears
38 only once on the list. Although some code i.e., remove_properties,
39 handles the more general case, the uniqueness of properties is
40 necessary for the system to remain consistent. This requirement
41 is enforced by the subrs installing properties onto the intervals. */
43 /* The rest of the file is within this conditional */
44 #ifdef USE_TEXT_PROPERTIES
47 Lisp_Object Qmouse_left
;
48 Lisp_Object Qmouse_entered
;
49 Lisp_Object Qpoint_left
;
50 Lisp_Object Qpoint_entered
;
51 Lisp_Object Qcategory
;
52 Lisp_Object Qlocal_map
;
54 /* Visual properties text (including strings) may have. */
55 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
56 Lisp_Object Qinvisible
, Qread_only
, Qintangible
;
58 /* Sticky properties */
59 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
61 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
62 the o1's cdr. Otherwise, return zero. This is handy for
64 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCONS (o1)->cdr, CONSP (o2)))
66 Lisp_Object Vinhibit_point_motion_hooks
;
69 /* Extract the interval at the position pointed to by BEGIN from
70 OBJECT, a string or buffer. Additionally, check that the positions
71 pointed to by BEGIN and END are within the bounds of OBJECT, and
72 reverse them if *BEGIN is greater than *END. The objects pointed
73 to by BEGIN and END may be integers or markers; if the latter, they
74 are coerced to integers.
76 When OBJECT is a string, we increment *BEGIN and *END
77 to make them origin-one.
79 Note that buffer points don't correspond to interval indices.
80 For example, point-max is 1 greater than the index of the last
81 character. This difference is handled in the caller, which uses
82 the validated points to determine a length, and operates on that.
83 Exceptions are Ftext_properties_at, Fnext_property_change, and
84 Fprevious_property_change which call this function with BEGIN == END.
85 Handle this case specially.
87 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
88 create an interval tree for OBJECT if one doesn't exist, provided
89 the object actually contains text. In the current design, if there
90 is no text, there can be no text properties. */
96 validate_interval_range (object
, begin
, end
, force
)
97 Lisp_Object object
, *begin
, *end
;
103 CHECK_STRING_OR_BUFFER (object
, 0);
104 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
105 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
107 /* If we are asked for a point, but from a subr which operates
108 on a range, then return nothing. */
109 if (EQ (*begin
, *end
) && begin
!= end
)
110 return NULL_INTERVAL
;
112 if (XINT (*begin
) > XINT (*end
))
120 if (BUFFERP (object
))
122 register struct buffer
*b
= XBUFFER (object
);
124 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
125 && XINT (*end
) <= BUF_ZV (b
)))
126 args_out_of_range (*begin
, *end
);
129 /* If there's no text, there are no properties. */
130 if (BUF_BEGV (b
) == BUF_ZV (b
))
131 return NULL_INTERVAL
;
133 searchpos
= XINT (*begin
);
137 register struct Lisp_String
*s
= XSTRING (object
);
139 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
140 && XINT (*end
) <= s
->size
))
141 args_out_of_range (*begin
, *end
);
142 /* User-level Positions in strings start with 0,
143 but the interval code always wants positions starting with 1. */
144 XSETFASTINT (*begin
, XFASTINT (*begin
) + 1);
146 XSETFASTINT (*end
, XFASTINT (*end
) + 1);
150 return NULL_INTERVAL
;
152 searchpos
= XINT (*begin
);
155 if (NULL_INTERVAL_P (i
))
156 return (force
? create_root_interval (object
) : i
);
158 return find_interval (i
, searchpos
);
161 /* Validate LIST as a property list. If LIST is not a list, then
162 make one consisting of (LIST nil). Otherwise, verify that LIST
163 is even numbered and thus suitable as a plist. */
166 validate_plist (list
)
175 register Lisp_Object tail
;
176 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
182 error ("Odd length text property list");
186 return Fcons (list
, Fcons (Qnil
, Qnil
));
189 /* Return nonzero if interval I has all the properties,
190 with the same values, of list PLIST. */
193 interval_has_all_properties (plist
, i
)
197 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
200 /* Go through each element of PLIST. */
201 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
206 /* Go through I's plist, looking for sym1 */
207 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
208 if (EQ (sym1
, Fcar (tail2
)))
210 /* Found the same property on both lists. If the
211 values are unequal, return zero. */
212 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
215 /* Property has same value on both lists; go to next one. */
227 /* Return nonzero if the plist of interval I has any of the
228 properties of PLIST, regardless of their values. */
231 interval_has_some_properties (plist
, i
)
235 register Lisp_Object tail1
, tail2
, sym
;
237 /* Go through each element of PLIST. */
238 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
242 /* Go through i's plist, looking for tail1 */
243 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
244 if (EQ (sym
, Fcar (tail2
)))
251 /* Changing the plists of individual intervals. */
253 /* Return the value of PROP in property-list PLIST, or Qunbound if it
256 property_value (plist
, prop
)
257 Lisp_Object plist
, prop
;
261 while (PLIST_ELT_P (plist
, value
))
262 if (EQ (XCONS (plist
)->car
, prop
))
263 return XCONS (value
)->car
;
265 plist
= XCONS (value
)->cdr
;
270 /* Set the properties of INTERVAL to PROPERTIES,
271 and record undo info for the previous values.
272 OBJECT is the string or buffer that INTERVAL belongs to. */
275 set_properties (properties
, interval
, object
)
276 Lisp_Object properties
, object
;
279 Lisp_Object sym
, value
;
281 if (BUFFERP (object
))
283 /* For each property in the old plist which is missing from PROPERTIES,
284 or has a different value in PROPERTIES, make an undo record. */
285 for (sym
= interval
->plist
;
286 PLIST_ELT_P (sym
, value
);
287 sym
= XCONS (value
)->cdr
)
288 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
291 modify_region (XBUFFER (object
),
292 make_number (interval
->position
),
293 make_number (interval
->position
+ LENGTH (interval
)));
294 record_property_change (interval
->position
, LENGTH (interval
),
295 XCONS (sym
)->car
, XCONS (value
)->car
,
299 /* For each new property that has no value at all in the old plist,
300 make an undo record binding it to nil, so it will be removed. */
301 for (sym
= properties
;
302 PLIST_ELT_P (sym
, value
);
303 sym
= XCONS (value
)->cdr
)
304 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
306 modify_region (XBUFFER (object
),
307 make_number (interval
->position
),
308 make_number (interval
->position
+ LENGTH (interval
)));
309 record_property_change (interval
->position
, LENGTH (interval
),
310 XCONS (sym
)->car
, Qnil
,
315 /* Store new properties. */
316 interval
->plist
= Fcopy_sequence (properties
);
319 /* Add the properties of PLIST to the interval I, or set
320 the value of I's property to the value of the property on PLIST
321 if they are different.
323 OBJECT should be the string or buffer the interval is in.
325 Return nonzero if this changes I (i.e., if any members of PLIST
326 are actually added to I's plist) */
329 add_properties (plist
, i
, object
)
334 register Lisp_Object tail1
, tail2
, sym1
, val1
;
335 register int changed
= 0;
338 /* Go through each element of PLIST. */
339 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
342 val1
= Fcar (Fcdr (tail1
));
345 /* Go through I's plist, looking for sym1 */
346 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
347 if (EQ (sym1
, Fcar (tail2
)))
349 register Lisp_Object this_cdr
;
351 this_cdr
= Fcdr (tail2
);
352 /* Found the property. Now check its value. */
355 /* The properties have the same value on both lists.
356 Continue to the next property. */
357 if (EQ (val1
, Fcar (this_cdr
)))
360 /* Record this change in the buffer, for undo purposes. */
361 if (BUFFERP (object
))
363 modify_region (XBUFFER (object
),
364 make_number (i
->position
),
365 make_number (i
->position
+ LENGTH (i
)));
366 record_property_change (i
->position
, LENGTH (i
),
367 sym1
, Fcar (this_cdr
), object
);
370 /* I's property has a different value -- change it */
371 Fsetcar (this_cdr
, val1
);
378 /* Record this change in the buffer, for undo purposes. */
379 if (BUFFERP (object
))
381 modify_region (XBUFFER (object
),
382 make_number (i
->position
),
383 make_number (i
->position
+ LENGTH (i
)));
384 record_property_change (i
->position
, LENGTH (i
),
387 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
395 /* For any members of PLIST which are properties of I, remove them
397 OBJECT is the string or buffer containing I. */
400 remove_properties (plist
, i
, object
)
405 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
406 register int changed
= 0;
408 current_plist
= i
->plist
;
409 /* Go through each element of plist. */
410 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
414 /* First, remove the symbol if its at the head of the list */
415 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
417 if (BUFFERP (object
))
419 modify_region (XBUFFER (object
),
420 make_number (i
->position
),
421 make_number (i
->position
+ LENGTH (i
)));
422 record_property_change (i
->position
, LENGTH (i
),
423 sym
, Fcar (Fcdr (current_plist
)),
427 current_plist
= Fcdr (Fcdr (current_plist
));
431 /* Go through i's plist, looking for sym */
432 tail2
= current_plist
;
433 while (! NILP (tail2
))
435 register Lisp_Object
this;
436 this = Fcdr (Fcdr (tail2
));
437 if (EQ (sym
, Fcar (this)))
439 if (BUFFERP (object
))
441 modify_region (XBUFFER (object
),
442 make_number (i
->position
),
443 make_number (i
->position
+ LENGTH (i
)));
444 record_property_change (i
->position
, LENGTH (i
),
445 sym
, Fcar (Fcdr (this)), object
);
448 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
456 i
->plist
= current_plist
;
461 /* Remove all properties from interval I. Return non-zero
462 if this changes the interval. */
476 DEFUN ("text-properties-at", Ftext_properties_at
,
477 Stext_properties_at
, 1, 2, 0,
478 "Return the list of properties held by the character at POSITION\n\
479 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
480 defaults to the current buffer.\n\
481 If POSITION is at the end of OBJECT, the value is nil.")
483 Lisp_Object pos
, object
;
488 XSETBUFFER (object
, current_buffer
);
490 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
491 if (NULL_INTERVAL_P (i
))
493 /* If POS is at the end of the interval,
494 it means it's the end of OBJECT.
495 There are no properties at the very end,
496 since no character follows. */
497 if (XINT (pos
) == LENGTH (i
) + i
->position
)
503 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
504 "Return the value of position POS's property PROP, in OBJECT.\n\
505 OBJECT is optional and defaults to the current buffer.\n\
506 If POSITION is at the end of OBJECT, the value is nil.")
508 Lisp_Object pos
, object
;
511 return textget (Ftext_properties_at (pos
, object
), prop
);
514 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
515 "Return the value of position POS's property PROP, in OBJECT.\n\
516 OBJECT is optional and defaults to the current buffer.\n\
517 If POS is at the end of OBJECT, the value is nil.\n\
518 If OBJECT is a buffer, then overlay properties are considered as well as\n\
520 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
521 overlays are considered only if they are associated with OBJECT.")
523 Lisp_Object pos
, object
;
524 register Lisp_Object prop
;
526 struct window
*w
= 0;
528 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
531 XSETBUFFER (object
, current_buffer
);
533 if (WINDOWP (object
))
535 w
= XWINDOW (object
);
538 if (BUFFERP (object
))
540 int posn
= XINT (pos
);
542 Lisp_Object
*overlay_vec
, tem
;
546 /* First try with room for 40 overlays. */
548 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
550 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
551 &next_overlay
, NULL
);
553 /* If there are more than 40,
554 make enough space for all, and try again. */
558 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
559 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
560 &next_overlay
, NULL
);
562 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
564 /* Now check the overlays in order of decreasing priority. */
565 while (--noverlays
>= 0)
567 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
572 /* Not a buffer, or no appropriate overlay, so fall through to the
574 return (Fget_text_property (pos
, prop
, object
));
577 DEFUN ("next-property-change", Fnext_property_change
,
578 Snext_property_change
, 1, 3, 0,
579 "Return the position of next property change.\n\
580 Scans characters forward from POS in OBJECT till it finds\n\
581 a change in some text property, then returns the position of the change.\n\
582 The optional second argument OBJECT is the string or buffer to scan.\n\
583 Return nil if the property is constant all the way to the end of OBJECT.\n\
584 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
585 If the optional third argument LIMIT is non-nil, don't search\n\
586 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
588 Lisp_Object pos
, object
, limit
;
590 register INTERVAL i
, next
;
593 XSETBUFFER (object
, current_buffer
);
596 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
598 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
599 if (NULL_INTERVAL_P (i
))
602 next
= next_interval (i
);
603 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
604 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
605 next
= next_interval (next
);
607 if (NULL_INTERVAL_P (next
))
609 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
612 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
616 /* Return 1 if there's a change in some property between BEG and END. */
619 property_change_between_p (beg
, end
)
622 register INTERVAL i
, next
;
623 Lisp_Object object
, pos
;
625 XSETBUFFER (object
, current_buffer
);
626 XSETFASTINT (pos
, beg
);
628 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
629 if (NULL_INTERVAL_P (i
))
632 next
= next_interval (i
);
633 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
635 next
= next_interval (next
);
636 if (NULL_INTERVAL_P (next
))
638 if (next
->position
>= end
)
642 if (NULL_INTERVAL_P (next
))
648 DEFUN ("next-single-property-change", Fnext_single_property_change
,
649 Snext_single_property_change
, 2, 4, 0,
650 "Return the position of next property change for a specific property.\n\
651 Scans characters forward from POS till it finds\n\
652 a change in the PROP property, then returns the position of the change.\n\
653 The optional third argument OBJECT is the string or buffer to scan.\n\
654 The property values are compared with `eq'.\n\
655 Return nil if the property is constant all the way to the end of OBJECT.\n\
656 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
657 If the optional fourth argument LIMIT is non-nil, don't search\n\
658 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
659 (pos
, prop
, object
, limit
)
660 Lisp_Object pos
, prop
, object
, limit
;
662 register INTERVAL i
, next
;
663 register Lisp_Object here_val
;
666 XSETBUFFER (object
, current_buffer
);
669 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
671 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
672 if (NULL_INTERVAL_P (i
))
675 here_val
= textget (i
->plist
, prop
);
676 next
= next_interval (i
);
677 while (! NULL_INTERVAL_P (next
)
678 && EQ (here_val
, textget (next
->plist
, prop
))
679 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
680 next
= next_interval (next
);
682 if (NULL_INTERVAL_P (next
))
684 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
687 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
691 DEFUN ("previous-property-change", Fprevious_property_change
,
692 Sprevious_property_change
, 1, 3, 0,
693 "Return the position of previous property change.\n\
694 Scans characters backwards from POS in OBJECT till it finds\n\
695 a change in some text property, then returns the position of the change.\n\
696 The optional second argument OBJECT is the string or buffer to scan.\n\
697 Return nil if the property is constant all the way to the start of OBJECT.\n\
698 If the value is non-nil, it is a position less than POS, never equal.\n\n\
699 If the optional third argument LIMIT is non-nil, don't search\n\
700 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
702 Lisp_Object pos
, object
, limit
;
704 register INTERVAL i
, previous
;
707 XSETBUFFER (object
, current_buffer
);
710 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
712 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
713 if (NULL_INTERVAL_P (i
))
716 /* Start with the interval containing the char before point. */
717 if (i
->position
== XFASTINT (pos
))
718 i
= previous_interval (i
);
720 previous
= previous_interval (i
);
721 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
723 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
724 previous
= previous_interval (previous
);
725 if (NULL_INTERVAL_P (previous
))
728 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
731 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
732 - (STRINGP (object
))));
736 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
737 Sprevious_single_property_change
, 2, 4, 0,
738 "Return the position of previous property change for a specific property.\n\
739 Scans characters backward from POS till it finds\n\
740 a change in the PROP property, then returns the position of the change.\n\
741 The optional third argument OBJECT is the string or buffer to scan.\n\
742 The property values are compared with `eq'.\n\
743 Return nil if the property is constant all the way to the start of OBJECT.\n\
744 If the value is non-nil, it is a position less than POS, never equal.\n\n\
745 If the optional fourth argument LIMIT is non-nil, don't search\n\
746 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
747 (pos
, prop
, object
, limit
)
748 Lisp_Object pos
, prop
, object
, limit
;
750 register INTERVAL i
, previous
;
751 register Lisp_Object here_val
;
754 XSETBUFFER (object
, current_buffer
);
757 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
759 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
761 /* Start with the interval containing the char before point. */
762 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (pos
))
763 i
= previous_interval (i
);
765 if (NULL_INTERVAL_P (i
))
768 here_val
= textget (i
->plist
, prop
);
769 previous
= previous_interval (i
);
770 while (! NULL_INTERVAL_P (previous
)
771 && EQ (here_val
, textget (previous
->plist
, prop
))
773 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
774 previous
= previous_interval (previous
);
775 if (NULL_INTERVAL_P (previous
))
778 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
781 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
782 - (STRINGP (object
))));
786 DEFUN ("add-text-properties", Fadd_text_properties
,
787 Sadd_text_properties
, 3, 4, 0,
788 "Add properties to the text from START to END.\n\
789 The third argument PROPS is a property list\n\
790 specifying the property values to add.\n\
791 The optional fourth argument, OBJECT,\n\
792 is the string or buffer containing the text.\n\
793 Return t if any property value actually changed, nil otherwise.")
794 (start
, end
, properties
, object
)
795 Lisp_Object start
, end
, properties
, object
;
797 register INTERVAL i
, unchanged
;
798 register int s
, len
, modified
= 0;
800 properties
= validate_plist (properties
);
801 if (NILP (properties
))
805 XSETBUFFER (object
, current_buffer
);
807 i
= validate_interval_range (object
, &start
, &end
, hard
);
808 if (NULL_INTERVAL_P (i
))
812 len
= XINT (end
) - s
;
814 /* If we're not starting on an interval boundary, we have to
815 split this interval. */
816 if (i
->position
!= s
)
818 /* If this interval already has the properties, we can
820 if (interval_has_all_properties (properties
, i
))
822 int got
= (LENGTH (i
) - (s
- i
->position
));
826 i
= next_interval (i
);
831 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
832 copy_properties (unchanged
, i
);
836 /* We are at the beginning of interval I, with LEN chars to scan. */
842 if (LENGTH (i
) >= len
)
844 if (interval_has_all_properties (properties
, i
))
845 return modified
? Qt
: Qnil
;
847 if (LENGTH (i
) == len
)
849 add_properties (properties
, i
, object
);
853 /* i doesn't have the properties, and goes past the change limit */
855 i
= split_interval_left (unchanged
, len
);
856 copy_properties (unchanged
, i
);
857 add_properties (properties
, i
, object
);
862 modified
+= add_properties (properties
, i
, object
);
863 i
= next_interval (i
);
867 DEFUN ("put-text-property", Fput_text_property
,
868 Sput_text_property
, 4, 5, 0,
869 "Set one property of the text from START to END.\n\
870 The third and fourth arguments PROP and VALUE\n\
871 specify the property to add.\n\
872 The optional fifth argument, OBJECT,\n\
873 is the string or buffer containing the text.")
874 (start
, end
, prop
, value
, object
)
875 Lisp_Object start
, end
, prop
, value
, object
;
877 Fadd_text_properties (start
, end
,
878 Fcons (prop
, Fcons (value
, Qnil
)),
883 DEFUN ("set-text-properties", Fset_text_properties
,
884 Sset_text_properties
, 3, 4, 0,
885 "Completely replace properties of text from START to END.\n\
886 The third argument PROPS is the new property list.\n\
887 The optional fourth argument, OBJECT,\n\
888 is the string or buffer containing the text.")
889 (start
, end
, props
, object
)
890 Lisp_Object start
, end
, props
, object
;
892 register INTERVAL i
, unchanged
;
893 register INTERVAL prev_changed
= NULL_INTERVAL
;
895 Lisp_Object ostart
, oend
;
900 props
= validate_plist (props
);
903 XSETBUFFER (object
, current_buffer
);
905 /* If we want no properties for a whole string,
906 get rid of its intervals. */
907 if (NILP (props
) && STRINGP (object
)
908 && XFASTINT (start
) == 0
909 && XFASTINT (end
) == XSTRING (object
)->size
)
911 XSTRING (object
)->intervals
= 0;
915 i
= validate_interval_range (object
, &start
, &end
, soft
);
917 if (NULL_INTERVAL_P (i
))
919 /* If buffer has no props, and we want none, return now. */
923 /* Restore the original START and END values
924 because validate_interval_range increments them for strings. */
928 i
= validate_interval_range (object
, &start
, &end
, hard
);
929 /* This can return if start == end. */
930 if (NULL_INTERVAL_P (i
))
935 len
= XINT (end
) - s
;
937 if (i
->position
!= s
)
940 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
942 if (LENGTH (i
) > len
)
944 copy_properties (unchanged
, i
);
945 i
= split_interval_left (i
, len
);
946 set_properties (props
, i
, object
);
950 set_properties (props
, i
, object
);
952 if (LENGTH (i
) == len
)
957 i
= next_interval (i
);
960 /* We are starting at the beginning of an interval, I */
966 if (LENGTH (i
) >= len
)
968 if (LENGTH (i
) > len
)
969 i
= split_interval_left (i
, len
);
971 if (NULL_INTERVAL_P (prev_changed
))
972 set_properties (props
, i
, object
);
974 merge_interval_left (i
);
979 if (NULL_INTERVAL_P (prev_changed
))
981 set_properties (props
, i
, object
);
985 prev_changed
= i
= merge_interval_left (i
);
987 i
= next_interval (i
);
993 DEFUN ("remove-text-properties", Fremove_text_properties
,
994 Sremove_text_properties
, 3, 4, 0,
995 "Remove some properties from text from START to END.\n\
996 The third argument PROPS is a property list\n\
997 whose property names specify the properties to remove.\n\
998 \(The values stored in PROPS are ignored.)\n\
999 The optional fourth argument, OBJECT,\n\
1000 is the string or buffer containing the text.\n\
1001 Return t if any property was actually removed, nil otherwise.")
1002 (start
, end
, props
, object
)
1003 Lisp_Object start
, end
, props
, object
;
1005 register INTERVAL i
, unchanged
;
1006 register int s
, len
, modified
= 0;
1009 XSETBUFFER (object
, current_buffer
);
1011 i
= validate_interval_range (object
, &start
, &end
, soft
);
1012 if (NULL_INTERVAL_P (i
))
1016 len
= XINT (end
) - s
;
1018 if (i
->position
!= s
)
1020 /* No properties on this first interval -- return if
1021 it covers the entire region. */
1022 if (! interval_has_some_properties (props
, i
))
1024 int got
= (LENGTH (i
) - (s
- i
->position
));
1028 i
= next_interval (i
);
1030 /* Split away the beginning of this interval; what we don't
1035 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1036 copy_properties (unchanged
, i
);
1040 /* We are at the beginning of an interval, with len to scan */
1046 if (LENGTH (i
) >= len
)
1048 if (! interval_has_some_properties (props
, i
))
1049 return modified
? Qt
: Qnil
;
1051 if (LENGTH (i
) == len
)
1053 remove_properties (props
, i
, object
);
1057 /* i has the properties, and goes past the change limit */
1059 i
= split_interval_left (i
, len
);
1060 copy_properties (unchanged
, i
);
1061 remove_properties (props
, i
, object
);
1066 modified
+= remove_properties (props
, i
, object
);
1067 i
= next_interval (i
);
1071 DEFUN ("text-property-any", Ftext_property_any
,
1072 Stext_property_any
, 4, 5, 0,
1073 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1074 If so, return the position of the first character whose PROP is `eq'\n\
1075 to VALUE. Otherwise return nil.\n\
1076 The optional fifth argument, OBJECT, is the string or buffer\n\
1077 containing the text.")
1078 (start
, end
, prop
, value
, object
)
1079 Lisp_Object start
, end
, prop
, value
, object
;
1081 register INTERVAL i
;
1082 register int e
, pos
;
1085 XSETBUFFER (object
, current_buffer
);
1086 i
= validate_interval_range (object
, &start
, &end
, soft
);
1089 while (! NULL_INTERVAL_P (i
))
1091 if (i
->position
>= e
)
1093 if (EQ (textget (i
->plist
, prop
), value
))
1096 if (pos
< XINT (start
))
1098 return make_number (pos
- (STRINGP (object
)));
1100 i
= next_interval (i
);
1105 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1106 Stext_property_not_all
, 4, 5, 0,
1107 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1108 If so, return the position of the first character whose PROP is not\n\
1109 `eq' to VALUE. Otherwise, return nil.\n\
1110 The optional fifth argument, OBJECT, is the string or buffer\n\
1111 containing the text.")
1112 (start
, end
, prop
, value
, object
)
1113 Lisp_Object start
, end
, prop
, value
, object
;
1115 register INTERVAL i
;
1119 XSETBUFFER (object
, current_buffer
);
1120 i
= validate_interval_range (object
, &start
, &end
, soft
);
1121 if (NULL_INTERVAL_P (i
))
1122 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1126 while (! NULL_INTERVAL_P (i
))
1128 if (i
->position
>= e
)
1130 if (! EQ (textget (i
->plist
, prop
), value
))
1132 if (i
->position
> s
)
1134 return make_number (s
- (STRINGP (object
)));
1136 i
= next_interval (i
);
1141 #if 0 /* You can use set-text-properties for this. */
1143 DEFUN ("erase-text-properties", Ferase_text_properties
,
1144 Serase_text_properties
, 2, 3, 0,
1145 "Remove all properties from the text from START to END.\n\
1146 The optional third argument, OBJECT,\n\
1147 is the string or buffer containing the text.")
1148 (start
, end
, object
)
1149 Lisp_Object start
, end
, object
;
1151 register INTERVAL i
;
1152 register INTERVAL prev_changed
= NULL_INTERVAL
;
1153 register int s
, len
, modified
;
1156 XSETBUFFER (object
, current_buffer
);
1158 i
= validate_interval_range (object
, &start
, &end
, soft
);
1159 if (NULL_INTERVAL_P (i
))
1163 len
= XINT (end
) - s
;
1165 if (i
->position
!= s
)
1168 register INTERVAL unchanged
= i
;
1170 /* If there are properties here, then this text will be modified. */
1171 if (! NILP (i
->plist
))
1173 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1177 if (LENGTH (i
) > len
)
1179 i
= split_interval_right (i
, len
);
1180 copy_properties (unchanged
, i
);
1184 if (LENGTH (i
) == len
)
1189 /* If the text of I is without any properties, and contains
1190 LEN or more characters, then we may return without changing
1192 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1194 /* The amount of text to change extends past I, so just note
1195 how much we've gotten. */
1197 got
= LENGTH (i
) - (s
- i
->position
);
1201 i
= next_interval (i
);
1204 /* We are starting at the beginning of an interval, I. */
1207 if (LENGTH (i
) >= len
)
1209 /* If I has no properties, simply merge it if possible. */
1210 if (NILP (i
->plist
))
1212 if (! NULL_INTERVAL_P (prev_changed
))
1213 merge_interval_left (i
);
1215 return modified
? Qt
: Qnil
;
1218 if (LENGTH (i
) > len
)
1219 i
= split_interval_left (i
, len
);
1220 if (! NULL_INTERVAL_P (prev_changed
))
1221 merge_interval_left (i
);
1228 /* Here if we still need to erase past the end of I */
1230 if (NULL_INTERVAL_P (prev_changed
))
1232 modified
+= erase_properties (i
);
1237 modified
+= ! NILP (i
->plist
);
1238 /* Merging I will give it the properties of PREV_CHANGED. */
1239 prev_changed
= i
= merge_interval_left (i
);
1242 i
= next_interval (i
);
1245 return modified
? Qt
: Qnil
;
1249 /* I don't think this is the right interface to export; how often do you
1250 want to do something like this, other than when you're copying objects
1253 I think it would be better to have a pair of functions, one which
1254 returns the text properties of a region as a list of ranges and
1255 plists, and another which applies such a list to another object. */
1257 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1258 Scopy_text_properties, 5, 6, 0,
1259 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1260 SRC and DEST may each refer to strings or buffers.\n\
1261 Optional sixth argument PROP causes only that property to be copied.\n\
1262 Properties are copied to DEST as if by `add-text-properties'.\n\
1263 Return t if any property value actually changed, nil otherwise.") */
1266 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1267 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1273 int s
, e
, e2
, p
, len
, modified
= 0;
1275 i
= validate_interval_range (src
, &start
, &end
, soft
);
1276 if (NULL_INTERVAL_P (i
))
1279 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1281 Lisp_Object dest_start
, dest_end
;
1284 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1285 /* Apply this to a copy of pos; it will try to increment its arguments,
1286 which we don't want. */
1287 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1298 e2
= i
->position
+ LENGTH (i
);
1305 while (! NILP (plist
))
1307 if (EQ (Fcar (plist
), prop
))
1309 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1312 plist
= Fcdr (Fcdr (plist
));
1316 /* Must defer modifications to the interval tree in case src
1317 and dest refer to the same string or buffer. */
1318 stuff
= Fcons (Fcons (make_number (p
),
1319 Fcons (make_number (p
+ len
),
1320 Fcons (plist
, Qnil
))),
1324 i
= next_interval (i
);
1325 if (NULL_INTERVAL_P (i
))
1332 while (! NILP (stuff
))
1335 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1336 Fcar (Fcdr (Fcdr (res
))), dest
);
1339 stuff
= Fcdr (stuff
);
1342 return modified
? Qt
: Qnil
;
1348 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1349 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1350 This also inhibits the use of the `intangible' text property.");
1351 Vinhibit_point_motion_hooks
= Qnil
;
1353 /* Common attributes one might give text */
1355 staticpro (&Qforeground
);
1356 Qforeground
= intern ("foreground");
1357 staticpro (&Qbackground
);
1358 Qbackground
= intern ("background");
1360 Qfont
= intern ("font");
1361 staticpro (&Qstipple
);
1362 Qstipple
= intern ("stipple");
1363 staticpro (&Qunderline
);
1364 Qunderline
= intern ("underline");
1365 staticpro (&Qread_only
);
1366 Qread_only
= intern ("read-only");
1367 staticpro (&Qinvisible
);
1368 Qinvisible
= intern ("invisible");
1369 staticpro (&Qintangible
);
1370 Qintangible
= intern ("intangible");
1371 staticpro (&Qcategory
);
1372 Qcategory
= intern ("category");
1373 staticpro (&Qlocal_map
);
1374 Qlocal_map
= intern ("local-map");
1375 staticpro (&Qfront_sticky
);
1376 Qfront_sticky
= intern ("front-sticky");
1377 staticpro (&Qrear_nonsticky
);
1378 Qrear_nonsticky
= intern ("rear-nonsticky");
1380 /* Properties that text might use to specify certain actions */
1382 staticpro (&Qmouse_left
);
1383 Qmouse_left
= intern ("mouse-left");
1384 staticpro (&Qmouse_entered
);
1385 Qmouse_entered
= intern ("mouse-entered");
1386 staticpro (&Qpoint_left
);
1387 Qpoint_left
= intern ("point-left");
1388 staticpro (&Qpoint_entered
);
1389 Qpoint_entered
= intern ("point-entered");
1391 defsubr (&Stext_properties_at
);
1392 defsubr (&Sget_text_property
);
1393 defsubr (&Sget_char_property
);
1394 defsubr (&Snext_property_change
);
1395 defsubr (&Snext_single_property_change
);
1396 defsubr (&Sprevious_property_change
);
1397 defsubr (&Sprevious_single_property_change
);
1398 defsubr (&Sadd_text_properties
);
1399 defsubr (&Sput_text_property
);
1400 defsubr (&Sset_text_properties
);
1401 defsubr (&Sremove_text_properties
);
1402 defsubr (&Stext_property_any
);
1403 defsubr (&Stext_property_not_all
);
1404 /* defsubr (&Serase_text_properties); */
1405 /* defsubr (&Scopy_text_properties); */
1410 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1412 #endif /* USE_TEXT_PROPERTIES */