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) && CONSP ((o2) = XCONS (o1)->cdr))
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 (XTYPE (object
) == Lisp_Buffer
)
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 XFASTINT (*begin
) += 1;
146 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 (XTYPE (object
) == Lisp_Buffer
)
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 (XTYPE (object
) == Lisp_Buffer
)
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 (XTYPE (object
) == Lisp_Buffer
)
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 (XTYPE (object
) == Lisp_Buffer
)
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 XSET (object
, Lisp_Buffer
, 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 XSET (object
, Lisp_Buffer
, 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 XSET (object
, Lisp_Buffer
, 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 XFASTINT (pos
) = next
->position
- (XTYPE (object
) == Lisp_String
);
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 XSET (object
, Lisp_Buffer
, current_buffer
);
626 XFASTINT (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 XSET (object
, Lisp_Buffer
, 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 XFASTINT (pos
) = next
->position
- (XTYPE (object
) == Lisp_String
);
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 XSET (object
, Lisp_Buffer
, 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 XFASTINT (pos
) = (previous
->position
+ LENGTH (previous
)
732 - (XTYPE (object
) == Lisp_String
));
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 XSET (object
, Lisp_Buffer
, 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 XFASTINT (pos
) = (previous
->position
+ LENGTH (previous
)
782 - (XTYPE (object
) == Lisp_String
));
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 XSET (object
, Lisp_Buffer
, 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 XSET (object
, Lisp_Buffer
, current_buffer
);
905 i
= validate_interval_range (object
, &start
, &end
, soft
);
906 if (NULL_INTERVAL_P (i
))
908 /* If buffer has no props, and we want none, return now. */
912 /* Restore the original START and END values
913 because validate_interval_range increments them for strings. */
917 i
= validate_interval_range (object
, &start
, &end
, hard
);
918 /* This can return if start == end. */
919 if (NULL_INTERVAL_P (i
))
924 len
= XINT (end
) - s
;
926 if (i
->position
!= s
)
929 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
931 if (LENGTH (i
) > len
)
933 copy_properties (unchanged
, i
);
934 i
= split_interval_left (i
, len
);
935 set_properties (props
, i
, object
);
939 set_properties (props
, i
, object
);
941 if (LENGTH (i
) == len
)
946 i
= next_interval (i
);
949 /* We are starting at the beginning of an interval, I */
955 if (LENGTH (i
) >= len
)
957 if (LENGTH (i
) > len
)
958 i
= split_interval_left (i
, len
);
960 if (NULL_INTERVAL_P (prev_changed
))
961 set_properties (props
, i
, object
);
963 merge_interval_left (i
);
968 if (NULL_INTERVAL_P (prev_changed
))
970 set_properties (props
, i
, object
);
974 prev_changed
= i
= merge_interval_left (i
);
976 i
= next_interval (i
);
982 DEFUN ("remove-text-properties", Fremove_text_properties
,
983 Sremove_text_properties
, 3, 4, 0,
984 "Remove some properties from text from START to END.\n\
985 The third argument PROPS is a property list\n\
986 whose property names specify the properties to remove.\n\
987 \(The values stored in PROPS are ignored.)\n\
988 The optional fourth argument, OBJECT,\n\
989 is the string or buffer containing the text.\n\
990 Return t if any property was actually removed, nil otherwise.")
991 (start
, end
, props
, object
)
992 Lisp_Object start
, end
, props
, object
;
994 register INTERVAL i
, unchanged
;
995 register int s
, len
, modified
= 0;
998 XSET (object
, Lisp_Buffer
, current_buffer
);
1000 i
= validate_interval_range (object
, &start
, &end
, soft
);
1001 if (NULL_INTERVAL_P (i
))
1005 len
= XINT (end
) - s
;
1007 if (i
->position
!= s
)
1009 /* No properties on this first interval -- return if
1010 it covers the entire region. */
1011 if (! interval_has_some_properties (props
, i
))
1013 int got
= (LENGTH (i
) - (s
- i
->position
));
1017 i
= next_interval (i
);
1019 /* Split away the beginning of this interval; what we don't
1024 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1025 copy_properties (unchanged
, i
);
1029 /* We are at the beginning of an interval, with len to scan */
1035 if (LENGTH (i
) >= len
)
1037 if (! interval_has_some_properties (props
, i
))
1038 return modified
? Qt
: Qnil
;
1040 if (LENGTH (i
) == len
)
1042 remove_properties (props
, i
, object
);
1046 /* i has the properties, and goes past the change limit */
1048 i
= split_interval_left (i
, len
);
1049 copy_properties (unchanged
, i
);
1050 remove_properties (props
, i
, object
);
1055 modified
+= remove_properties (props
, i
, object
);
1056 i
= next_interval (i
);
1060 DEFUN ("text-property-any", Ftext_property_any
,
1061 Stext_property_any
, 4, 5, 0,
1062 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1063 If so, return the position of the first character whose PROP is `eq'\n\
1064 to VALUE. Otherwise return nil.\n\
1065 The optional fifth argument, OBJECT, is the string or buffer\n\
1066 containing the text.")
1067 (start
, end
, prop
, value
, object
)
1068 Lisp_Object start
, end
, prop
, value
, object
;
1070 register INTERVAL i
;
1071 register int e
, pos
;
1074 XSET (object
, Lisp_Buffer
, current_buffer
);
1075 i
= validate_interval_range (object
, &start
, &end
, soft
);
1078 while (! NULL_INTERVAL_P (i
))
1080 if (i
->position
>= e
)
1082 if (EQ (textget (i
->plist
, prop
), value
))
1085 if (pos
< XINT (start
))
1087 return make_number (pos
- (XTYPE (object
) == Lisp_String
));
1089 i
= next_interval (i
);
1094 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1095 Stext_property_not_all
, 4, 5, 0,
1096 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1097 If so, return the position of the first character whose PROP is not\n\
1098 `eq' to VALUE. Otherwise, return nil.\n\
1099 The optional fifth argument, OBJECT, is the string or buffer\n\
1100 containing the text.")
1101 (start
, end
, prop
, value
, object
)
1102 Lisp_Object start
, end
, prop
, value
, object
;
1104 register INTERVAL i
;
1108 XSET (object
, Lisp_Buffer
, current_buffer
);
1109 i
= validate_interval_range (object
, &start
, &end
, soft
);
1110 if (NULL_INTERVAL_P (i
))
1111 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1115 while (! NULL_INTERVAL_P (i
))
1117 if (i
->position
>= e
)
1119 if (! EQ (textget (i
->plist
, prop
), value
))
1121 if (i
->position
> s
)
1123 return make_number (s
- (XTYPE (object
) == Lisp_String
));
1125 i
= next_interval (i
);
1130 #if 0 /* You can use set-text-properties for this. */
1132 DEFUN ("erase-text-properties", Ferase_text_properties
,
1133 Serase_text_properties
, 2, 3, 0,
1134 "Remove all properties from the text from START to END.\n\
1135 The optional third argument, OBJECT,\n\
1136 is the string or buffer containing the text.")
1137 (start
, end
, object
)
1138 Lisp_Object start
, end
, object
;
1140 register INTERVAL i
;
1141 register INTERVAL prev_changed
= NULL_INTERVAL
;
1142 register int s
, len
, modified
;
1145 XSET (object
, Lisp_Buffer
, current_buffer
);
1147 i
= validate_interval_range (object
, &start
, &end
, soft
);
1148 if (NULL_INTERVAL_P (i
))
1152 len
= XINT (end
) - s
;
1154 if (i
->position
!= s
)
1157 register INTERVAL unchanged
= i
;
1159 /* If there are properties here, then this text will be modified. */
1160 if (! NILP (i
->plist
))
1162 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1166 if (LENGTH (i
) > len
)
1168 i
= split_interval_right (i
, len
);
1169 copy_properties (unchanged
, i
);
1173 if (LENGTH (i
) == len
)
1178 /* If the text of I is without any properties, and contains
1179 LEN or more characters, then we may return without changing
1181 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1183 /* The amount of text to change extends past I, so just note
1184 how much we've gotten. */
1186 got
= LENGTH (i
) - (s
- i
->position
);
1190 i
= next_interval (i
);
1193 /* We are starting at the beginning of an interval, I. */
1196 if (LENGTH (i
) >= len
)
1198 /* If I has no properties, simply merge it if possible. */
1199 if (NILP (i
->plist
))
1201 if (! NULL_INTERVAL_P (prev_changed
))
1202 merge_interval_left (i
);
1204 return modified
? Qt
: Qnil
;
1207 if (LENGTH (i
) > len
)
1208 i
= split_interval_left (i
, len
);
1209 if (! NULL_INTERVAL_P (prev_changed
))
1210 merge_interval_left (i
);
1217 /* Here if we still need to erase past the end of I */
1219 if (NULL_INTERVAL_P (prev_changed
))
1221 modified
+= erase_properties (i
);
1226 modified
+= ! NILP (i
->plist
);
1227 /* Merging I will give it the properties of PREV_CHANGED. */
1228 prev_changed
= i
= merge_interval_left (i
);
1231 i
= next_interval (i
);
1234 return modified
? Qt
: Qnil
;
1238 /* I don't think this is the right interface to export; how often do you
1239 want to do something like this, other than when you're copying objects
1242 I think it would be better to have a pair of functions, one which
1243 returns the text properties of a region as a list of ranges and
1244 plists, and another which applies such a list to another object. */
1246 /* DEFUN ("copy-text-properties", Fcopy_text_properties,
1247 Scopy_text_properties, 5, 6, 0,
1248 "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
1249 SRC and DEST may each refer to strings or buffers.\n\
1250 Optional sixth argument PROP causes only that property to be copied.\n\
1251 Properties are copied to DEST as if by `add-text-properties'.\n\
1252 Return t if any property value actually changed, nil otherwise.") */
1255 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1256 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1262 int s
, e
, e2
, p
, len
, modified
= 0;
1264 i
= validate_interval_range (src
, &start
, &end
, soft
);
1265 if (NULL_INTERVAL_P (i
))
1268 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1270 Lisp_Object dest_start
, dest_end
;
1273 XFASTINT (dest_end
) = XINT (dest_start
) + (XINT (end
) - XINT (start
));
1274 /* Apply this to a copy of pos; it will try to increment its arguments,
1275 which we don't want. */
1276 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1287 e2
= i
->position
+ LENGTH (i
);
1294 while (! NILP (plist
))
1296 if (EQ (Fcar (plist
), prop
))
1298 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1301 plist
= Fcdr (Fcdr (plist
));
1305 /* Must defer modifications to the interval tree in case src
1306 and dest refer to the same string or buffer. */
1307 stuff
= Fcons (Fcons (make_number (p
),
1308 Fcons (make_number (p
+ len
),
1309 Fcons (plist
, Qnil
))),
1313 i
= next_interval (i
);
1314 if (NULL_INTERVAL_P (i
))
1321 while (! NILP (stuff
))
1324 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1325 Fcar (Fcdr (Fcdr (res
))), dest
);
1328 stuff
= Fcdr (stuff
);
1331 return modified
? Qt
: Qnil
;
1337 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1338 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1339 This also inhibits the use of the `intangible' text property.");
1340 Vinhibit_point_motion_hooks
= Qnil
;
1342 /* Common attributes one might give text */
1344 staticpro (&Qforeground
);
1345 Qforeground
= intern ("foreground");
1346 staticpro (&Qbackground
);
1347 Qbackground
= intern ("background");
1349 Qfont
= intern ("font");
1350 staticpro (&Qstipple
);
1351 Qstipple
= intern ("stipple");
1352 staticpro (&Qunderline
);
1353 Qunderline
= intern ("underline");
1354 staticpro (&Qread_only
);
1355 Qread_only
= intern ("read-only");
1356 staticpro (&Qinvisible
);
1357 Qinvisible
= intern ("invisible");
1358 staticpro (&Qintangible
);
1359 Qintangible
= intern ("intangible");
1360 staticpro (&Qcategory
);
1361 Qcategory
= intern ("category");
1362 staticpro (&Qlocal_map
);
1363 Qlocal_map
= intern ("local-map");
1364 staticpro (&Qfront_sticky
);
1365 Qfront_sticky
= intern ("front-sticky");
1366 staticpro (&Qrear_nonsticky
);
1367 Qrear_nonsticky
= intern ("rear-nonsticky");
1369 /* Properties that text might use to specify certain actions */
1371 staticpro (&Qmouse_left
);
1372 Qmouse_left
= intern ("mouse-left");
1373 staticpro (&Qmouse_entered
);
1374 Qmouse_entered
= intern ("mouse-entered");
1375 staticpro (&Qpoint_left
);
1376 Qpoint_left
= intern ("point-left");
1377 staticpro (&Qpoint_entered
);
1378 Qpoint_entered
= intern ("point-entered");
1380 defsubr (&Stext_properties_at
);
1381 defsubr (&Sget_text_property
);
1382 defsubr (&Sget_char_property
);
1383 defsubr (&Snext_property_change
);
1384 defsubr (&Snext_single_property_change
);
1385 defsubr (&Sprevious_property_change
);
1386 defsubr (&Sprevious_single_property_change
);
1387 defsubr (&Sadd_text_properties
);
1388 defsubr (&Sput_text_property
);
1389 defsubr (&Sset_text_properties
);
1390 defsubr (&Sremove_text_properties
);
1391 defsubr (&Stext_property_any
);
1392 defsubr (&Stext_property_not_all
);
1393 /* defsubr (&Serase_text_properties); */
1394 /* defsubr (&Scopy_text_properties); */
1399 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1401 #endif /* USE_TEXT_PROPERTIES */