1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995 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
30 /* Test for membership, allowing for t (actually any non-cons) to mean the
33 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
36 /* NOTES: previous- and next- property change will have to skip
37 zero-length intervals if they are implemented. This could be done
38 inside next_interval and previous_interval.
40 set_properties needs to deal with the interval property cache.
42 It is assumed that for any interval plist, a property appears
43 only once on the list. Although some code i.e., remove_properties,
44 handles the more general case, the uniqueness of properties is
45 necessary for the system to remain consistent. This requirement
46 is enforced by the subrs installing properties onto the intervals. */
48 /* The rest of the file is within this conditional */
49 #ifdef USE_TEXT_PROPERTIES
52 Lisp_Object Qmouse_left
;
53 Lisp_Object Qmouse_entered
;
54 Lisp_Object Qpoint_left
;
55 Lisp_Object Qpoint_entered
;
56 Lisp_Object Qcategory
;
57 Lisp_Object Qlocal_map
;
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground
, Qbackground
, Qfont
, Qunderline
, Qstipple
;
61 Lisp_Object Qinvisible
, Qread_only
, Qintangible
;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky
, Qrear_nonsticky
;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCONS (o1)->cdr, CONSP (o2)))
71 Lisp_Object Vinhibit_point_motion_hooks
;
72 Lisp_Object Vdefault_text_properties
;
74 /* verify_interval_modification saves insertion hooks here
75 to be run later by report_interval_modification. */
76 Lisp_Object interval_insert_behind_hooks
;
77 Lisp_Object interval_insert_in_front_hooks
;
79 /* Extract the interval at the position pointed to by BEGIN from
80 OBJECT, a string or buffer. Additionally, check that the positions
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
82 reverse them if *BEGIN is greater than *END. The objects pointed
83 to by BEGIN and END may be integers or markers; if the latter, they
84 are coerced to integers.
86 When OBJECT is a string, we increment *BEGIN and *END
87 to make them origin-one.
89 Note that buffer points don't correspond to interval indices.
90 For example, point-max is 1 greater than the index of the last
91 character. This difference is handled in the caller, which uses
92 the validated points to determine a length, and operates on that.
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
94 Fprevious_property_change which call this function with BEGIN == END.
95 Handle this case specially.
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
98 create an interval tree for OBJECT if one doesn't exist, provided
99 the object actually contains text. In the current design, if there
100 is no text, there can be no text properties. */
106 validate_interval_range (object
, begin
, end
, force
)
107 Lisp_Object object
, *begin
, *end
;
113 CHECK_STRING_OR_BUFFER (object
, 0);
114 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
115 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
117 /* If we are asked for a point, but from a subr which operates
118 on a range, then return nothing. */
119 if (EQ (*begin
, *end
) && begin
!= end
)
120 return NULL_INTERVAL
;
122 if (XINT (*begin
) > XINT (*end
))
130 if (BUFFERP (object
))
132 register struct buffer
*b
= XBUFFER (object
);
134 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
135 && XINT (*end
) <= BUF_ZV (b
)))
136 args_out_of_range (*begin
, *end
);
137 i
= BUF_INTERVALS (b
);
139 /* If there's no text, there are no properties. */
140 if (BUF_BEGV (b
) == BUF_ZV (b
))
141 return NULL_INTERVAL
;
143 searchpos
= XINT (*begin
);
147 register struct Lisp_String
*s
= XSTRING (object
);
149 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
150 && XINT (*end
) <= s
->size
))
151 args_out_of_range (*begin
, *end
);
152 /* User-level Positions in strings start with 0,
153 but the interval code always wants positions starting with 1. */
154 XSETFASTINT (*begin
, XFASTINT (*begin
) + 1);
156 XSETFASTINT (*end
, XFASTINT (*end
) + 1);
160 return NULL_INTERVAL
;
162 searchpos
= XINT (*begin
);
165 if (NULL_INTERVAL_P (i
))
166 return (force
? create_root_interval (object
) : i
);
168 return find_interval (i
, searchpos
);
171 /* Validate LIST as a property list. If LIST is not a list, then
172 make one consisting of (LIST nil). Otherwise, verify that LIST
173 is even numbered and thus suitable as a plist. */
176 validate_plist (list
)
185 register Lisp_Object tail
;
186 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
192 error ("Odd length text property list");
196 return Fcons (list
, Fcons (Qnil
, Qnil
));
199 /* Return nonzero if interval I has all the properties,
200 with the same values, of list PLIST. */
203 interval_has_all_properties (plist
, i
)
207 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
210 /* Go through each element of PLIST. */
211 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
216 /* Go through I's plist, looking for sym1 */
217 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
218 if (EQ (sym1
, Fcar (tail2
)))
220 /* Found the same property on both lists. If the
221 values are unequal, return zero. */
222 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
225 /* Property has same value on both lists; go to next one. */
237 /* Return nonzero if the plist of interval I has any of the
238 properties of PLIST, regardless of their values. */
241 interval_has_some_properties (plist
, i
)
245 register Lisp_Object tail1
, tail2
, sym
;
247 /* Go through each element of PLIST. */
248 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
252 /* Go through i's plist, looking for tail1 */
253 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
254 if (EQ (sym
, Fcar (tail2
)))
261 /* Changing the plists of individual intervals. */
263 /* Return the value of PROP in property-list PLIST, or Qunbound if it
266 property_value (plist
, prop
)
267 Lisp_Object plist
, prop
;
271 while (PLIST_ELT_P (plist
, value
))
272 if (EQ (XCONS (plist
)->car
, prop
))
273 return XCONS (value
)->car
;
275 plist
= XCONS (value
)->cdr
;
280 /* Set the properties of INTERVAL to PROPERTIES,
281 and record undo info for the previous values.
282 OBJECT is the string or buffer that INTERVAL belongs to. */
285 set_properties (properties
, interval
, object
)
286 Lisp_Object properties
, object
;
289 Lisp_Object sym
, value
;
291 if (BUFFERP (object
))
293 /* For each property in the old plist which is missing from PROPERTIES,
294 or has a different value in PROPERTIES, make an undo record. */
295 for (sym
= interval
->plist
;
296 PLIST_ELT_P (sym
, value
);
297 sym
= XCONS (value
)->cdr
)
298 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
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
, XCONS (value
)->car
,
309 /* For each new property that has no value at all in the old plist,
310 make an undo record binding it to nil, so it will be removed. */
311 for (sym
= properties
;
312 PLIST_ELT_P (sym
, value
);
313 sym
= XCONS (value
)->cdr
)
314 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
316 modify_region (XBUFFER (object
),
317 make_number (interval
->position
),
318 make_number (interval
->position
+ LENGTH (interval
)));
319 record_property_change (interval
->position
, LENGTH (interval
),
320 XCONS (sym
)->car
, Qnil
,
325 /* Store new properties. */
326 interval
->plist
= Fcopy_sequence (properties
);
329 /* Add the properties of PLIST to the interval I, or set
330 the value of I's property to the value of the property on PLIST
331 if they are different.
333 OBJECT should be the string or buffer the interval is in.
335 Return nonzero if this changes I (i.e., if any members of PLIST
336 are actually added to I's plist) */
339 add_properties (plist
, i
, object
)
344 Lisp_Object tail1
, tail2
, sym1
, val1
;
345 register int changed
= 0;
347 struct gcpro gcpro1
, gcpro2
, gcpro3
;
352 /* No need to protect OBJECT, because we can GC only in the case
353 where it is a buffer, and live buffers are always protected.
354 I and its plist are also protected, via OBJECT. */
355 GCPRO3 (tail1
, sym1
, val1
);
357 /* Go through each element of PLIST. */
358 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
361 val1
= Fcar (Fcdr (tail1
));
364 /* Go through I's plist, looking for sym1 */
365 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
366 if (EQ (sym1
, Fcar (tail2
)))
368 /* No need to gcpro, because tail2 protects this
369 and it must be a cons cell (we get an error otherwise). */
370 register Lisp_Object this_cdr
;
372 this_cdr
= Fcdr (tail2
);
373 /* Found the property. Now check its value. */
376 /* The properties have the same value on both lists.
377 Continue to the next property. */
378 if (EQ (val1
, Fcar (this_cdr
)))
381 /* Record this change in the buffer, for undo purposes. */
382 if (BUFFERP (object
))
384 modify_region (XBUFFER (object
),
385 make_number (i
->position
),
386 make_number (i
->position
+ LENGTH (i
)));
387 record_property_change (i
->position
, LENGTH (i
),
388 sym1
, Fcar (this_cdr
), object
);
391 /* I's property has a different value -- change it */
392 Fsetcar (this_cdr
, val1
);
399 /* Record this change in the buffer, for undo purposes. */
400 if (BUFFERP (object
))
402 modify_region (XBUFFER (object
),
403 make_number (i
->position
),
404 make_number (i
->position
+ LENGTH (i
)));
405 record_property_change (i
->position
, LENGTH (i
),
408 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
418 /* For any members of PLIST which are properties of I, remove them
420 OBJECT is the string or buffer containing I. */
423 remove_properties (plist
, i
, object
)
428 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
429 register int changed
= 0;
431 current_plist
= i
->plist
;
432 /* Go through each element of plist. */
433 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
437 /* First, remove the symbol if its at the head of the list */
438 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
440 if (BUFFERP (object
))
442 modify_region (XBUFFER (object
),
443 make_number (i
->position
),
444 make_number (i
->position
+ LENGTH (i
)));
445 record_property_change (i
->position
, LENGTH (i
),
446 sym
, Fcar (Fcdr (current_plist
)),
450 current_plist
= Fcdr (Fcdr (current_plist
));
454 /* Go through i's plist, looking for sym */
455 tail2
= current_plist
;
456 while (! NILP (tail2
))
458 register Lisp_Object
this;
459 this = Fcdr (Fcdr (tail2
));
460 if (EQ (sym
, Fcar (this)))
462 if (BUFFERP (object
))
464 modify_region (XBUFFER (object
),
465 make_number (i
->position
),
466 make_number (i
->position
+ LENGTH (i
)));
467 record_property_change (i
->position
, LENGTH (i
),
468 sym
, Fcar (Fcdr (this)), object
);
471 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
479 i
->plist
= current_plist
;
484 /* Remove all properties from interval I. Return non-zero
485 if this changes the interval. */
499 DEFUN ("text-properties-at", Ftext_properties_at
,
500 Stext_properties_at
, 1, 2, 0,
501 "Return the list of properties held by the character at POSITION\n\
502 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
503 defaults to the current buffer.\n\
504 If POSITION is at the end of OBJECT, the value is nil.")
506 Lisp_Object pos
, object
;
511 XSETBUFFER (object
, current_buffer
);
513 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
514 if (NULL_INTERVAL_P (i
))
516 /* If POS is at the end of the interval,
517 it means it's the end of OBJECT.
518 There are no properties at the very end,
519 since no character follows. */
520 if (XINT (pos
) == LENGTH (i
) + i
->position
)
526 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
527 "Return the value of position POS's property PROP, in OBJECT.\n\
528 OBJECT is optional and defaults to the current buffer.\n\
529 If POSITION is at the end of OBJECT, the value is nil.")
531 Lisp_Object pos
, object
;
534 return textget (Ftext_properties_at (pos
, object
), prop
);
537 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
538 "Return the value of position POS's property PROP, in OBJECT.\n\
539 OBJECT is optional and defaults to the current buffer.\n\
540 If POS is at the end of OBJECT, the value is nil.\n\
541 If OBJECT is a buffer, then overlay properties are considered as well as\n\
543 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
544 overlays are considered only if they are associated with OBJECT.")
546 Lisp_Object pos
, object
;
547 register Lisp_Object prop
;
549 struct window
*w
= 0;
551 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
554 XSETBUFFER (object
, current_buffer
);
556 if (WINDOWP (object
))
558 w
= XWINDOW (object
);
561 if (BUFFERP (object
))
563 int posn
= XINT (pos
);
565 Lisp_Object
*overlay_vec
, tem
;
568 struct buffer
*obuf
= current_buffer
;
570 set_buffer_temp (XBUFFER (object
));
572 /* First try with room for 40 overlays. */
574 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
576 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
577 &next_overlay
, NULL
);
579 /* If there are more than 40,
580 make enough space for all, and try again. */
584 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
585 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
586 &next_overlay
, NULL
);
588 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
590 set_buffer_temp (obuf
);
592 /* Now check the overlays in order of decreasing priority. */
593 while (--noverlays
>= 0)
595 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
600 /* Not a buffer, or no appropriate overlay, so fall through to the
602 return (Fget_text_property (pos
, prop
, object
));
605 DEFUN ("next-property-change", Fnext_property_change
,
606 Snext_property_change
, 1, 3, 0,
607 "Return the position of next property change.\n\
608 Scans characters forward from POS in OBJECT till it finds\n\
609 a change in some text property, then returns the position of the change.\n\
610 The optional second argument OBJECT is the string or buffer to scan.\n\
611 Return nil if the property is constant all the way to the end of OBJECT.\n\
612 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
613 If the optional third argument LIMIT is non-nil, don't search\n\
614 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
616 Lisp_Object pos
, object
, limit
;
618 register INTERVAL i
, next
;
621 XSETBUFFER (object
, current_buffer
);
623 if (! NILP (limit
) && ! EQ (limit
, Qt
))
624 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
626 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
628 /* If LIMIT is t, return start of next interval--don't
629 bother checking further intervals. */
632 if (NULL_INTERVAL_P (i
))
635 next
= next_interval (i
);
637 if (NULL_INTERVAL_P (next
))
638 XSETFASTINT (pos
, (STRINGP (object
)
639 ? XSTRING (object
)->size
640 : BUF_ZV (XBUFFER (object
))));
642 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
646 if (NULL_INTERVAL_P (i
))
649 next
= next_interval (i
);
651 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
652 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
653 next
= next_interval (next
);
655 if (NULL_INTERVAL_P (next
))
657 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
660 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
664 /* Return 1 if there's a change in some property between BEG and END. */
667 property_change_between_p (beg
, end
)
670 register INTERVAL i
, next
;
671 Lisp_Object object
, pos
;
673 XSETBUFFER (object
, current_buffer
);
674 XSETFASTINT (pos
, beg
);
676 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
677 if (NULL_INTERVAL_P (i
))
680 next
= next_interval (i
);
681 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
683 next
= next_interval (next
);
684 if (NULL_INTERVAL_P (next
))
686 if (next
->position
>= end
)
690 if (NULL_INTERVAL_P (next
))
696 DEFUN ("next-single-property-change", Fnext_single_property_change
,
697 Snext_single_property_change
, 2, 4, 0,
698 "Return the position of next property change for a specific property.\n\
699 Scans characters forward from POS till it finds\n\
700 a change in the PROP property, then returns the position of the change.\n\
701 The optional third argument OBJECT is the string or buffer to scan.\n\
702 The property values are compared with `eq'.\n\
703 Return nil if the property is constant all the way to the end of OBJECT.\n\
704 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
705 If the optional fourth argument LIMIT is non-nil, don't search\n\
706 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
707 (pos
, prop
, object
, limit
)
708 Lisp_Object pos
, prop
, object
, limit
;
710 register INTERVAL i
, next
;
711 register Lisp_Object here_val
;
714 XSETBUFFER (object
, 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 here_val
= textget (i
->plist
, prop
);
724 next
= next_interval (i
);
725 while (! NULL_INTERVAL_P (next
)
726 && EQ (here_val
, textget (next
->plist
, prop
))
727 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
728 next
= next_interval (next
);
730 if (NULL_INTERVAL_P (next
))
732 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
735 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
739 DEFUN ("previous-property-change", Fprevious_property_change
,
740 Sprevious_property_change
, 1, 3, 0,
741 "Return the position of previous property change.\n\
742 Scans characters backwards from POS in OBJECT till it finds\n\
743 a change in some text property, then returns the position of the change.\n\
744 The optional second argument OBJECT is the string or buffer to scan.\n\
745 Return nil if the property is constant all the way to the start of OBJECT.\n\
746 If the value is non-nil, it is a position less than POS, never equal.\n\n\
747 If the optional third argument LIMIT is non-nil, don't search\n\
748 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
750 Lisp_Object pos
, object
, limit
;
752 register INTERVAL i
, previous
;
755 XSETBUFFER (object
, current_buffer
);
758 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
760 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
761 if (NULL_INTERVAL_P (i
))
764 /* Start with the interval containing the char before point. */
765 if (i
->position
== XFASTINT (pos
))
766 i
= previous_interval (i
);
768 previous
= previous_interval (i
);
769 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
771 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
772 previous
= previous_interval (previous
);
773 if (NULL_INTERVAL_P (previous
))
776 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
779 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
780 - (STRINGP (object
))));
784 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
785 Sprevious_single_property_change
, 2, 4, 0,
786 "Return the position of previous property change for a specific property.\n\
787 Scans characters backward from POS till it finds\n\
788 a change in the PROP property, then returns the position of the change.\n\
789 The optional third argument OBJECT is the string or buffer to scan.\n\
790 The property values are compared with `eq'.\n\
791 Return nil if the property is constant all the way to the start of OBJECT.\n\
792 If the value is non-nil, it is a position less than POS, never equal.\n\n\
793 If the optional fourth argument LIMIT is non-nil, don't search\n\
794 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
795 (pos
, prop
, object
, limit
)
796 Lisp_Object pos
, prop
, object
, limit
;
798 register INTERVAL i
, previous
;
799 register Lisp_Object here_val
;
802 XSETBUFFER (object
, current_buffer
);
805 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
807 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
809 /* Start with the interval containing the char before point. */
810 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (pos
))
811 i
= previous_interval (i
);
813 if (NULL_INTERVAL_P (i
))
816 here_val
= textget (i
->plist
, prop
);
817 previous
= previous_interval (i
);
818 while (! NULL_INTERVAL_P (previous
)
819 && EQ (here_val
, textget (previous
->plist
, prop
))
821 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
822 previous
= previous_interval (previous
);
823 if (NULL_INTERVAL_P (previous
))
826 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
829 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
830 - (STRINGP (object
))));
834 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
836 DEFUN ("add-text-properties", Fadd_text_properties
,
837 Sadd_text_properties
, 3, 4, 0,
838 "Add properties to the text from START to END.\n\
839 The third argument PROPS is a property list\n\
840 specifying the property values to add.\n\
841 The optional fourth argument, OBJECT,\n\
842 is the string or buffer containing the text.\n\
843 Return t if any property value actually changed, nil otherwise.")
844 (start
, end
, properties
, object
)
845 Lisp_Object start
, end
, properties
, object
;
847 register INTERVAL i
, unchanged
;
848 register int s
, len
, modified
= 0;
851 properties
= validate_plist (properties
);
852 if (NILP (properties
))
856 XSETBUFFER (object
, current_buffer
);
858 i
= validate_interval_range (object
, &start
, &end
, hard
);
859 if (NULL_INTERVAL_P (i
))
863 len
= XINT (end
) - s
;
865 /* No need to protect OBJECT, because we GC only if it's a buffer,
866 and live buffers are always protected. */
869 /* If we're not starting on an interval boundary, we have to
870 split this interval. */
871 if (i
->position
!= s
)
873 /* If this interval already has the properties, we can
875 if (interval_has_all_properties (properties
, i
))
877 int got
= (LENGTH (i
) - (s
- i
->position
));
881 i
= next_interval (i
);
886 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
887 copy_properties (unchanged
, i
);
891 /* We are at the beginning of interval I, with LEN chars to scan. */
897 if (LENGTH (i
) >= len
)
899 /* We can UNGCPRO safely here, because there will be just
900 one more chance to gc, in the next call to add_properties,
901 and after that we will not need PROPERTIES or OBJECT again. */
904 if (interval_has_all_properties (properties
, i
))
905 return modified
? Qt
: Qnil
;
907 if (LENGTH (i
) == len
)
909 add_properties (properties
, i
, object
);
913 /* i doesn't have the properties, and goes past the change limit */
915 i
= split_interval_left (unchanged
, len
);
916 copy_properties (unchanged
, i
);
917 add_properties (properties
, i
, object
);
922 modified
+= add_properties (properties
, i
, object
);
923 i
= next_interval (i
);
927 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
929 DEFUN ("put-text-property", Fput_text_property
,
930 Sput_text_property
, 4, 5, 0,
931 "Set one property of the text from START to END.\n\
932 The third and fourth arguments PROP and VALUE\n\
933 specify the property to add.\n\
934 The optional fifth argument, OBJECT,\n\
935 is the string or buffer containing the text.")
936 (start
, end
, prop
, value
, object
)
937 Lisp_Object start
, end
, prop
, value
, object
;
939 Fadd_text_properties (start
, end
,
940 Fcons (prop
, Fcons (value
, Qnil
)),
945 DEFUN ("set-text-properties", Fset_text_properties
,
946 Sset_text_properties
, 3, 4, 0,
947 "Completely replace properties of text from START to END.\n\
948 The third argument PROPS is the new property list.\n\
949 The optional fourth argument, OBJECT,\n\
950 is the string or buffer containing the text.")
951 (start
, end
, props
, object
)
952 Lisp_Object start
, end
, props
, object
;
954 register INTERVAL i
, unchanged
;
955 register INTERVAL prev_changed
= NULL_INTERVAL
;
957 Lisp_Object ostart
, oend
;
962 props
= validate_plist (props
);
965 XSETBUFFER (object
, current_buffer
);
967 /* If we want no properties for a whole string,
968 get rid of its intervals. */
969 if (NILP (props
) && STRINGP (object
)
970 && XFASTINT (start
) == 0
971 && XFASTINT (end
) == XSTRING (object
)->size
)
973 XSTRING (object
)->intervals
= 0;
977 i
= validate_interval_range (object
, &start
, &end
, soft
);
979 if (NULL_INTERVAL_P (i
))
981 /* If buffer has no props, and we want none, return now. */
985 /* Restore the original START and END values
986 because validate_interval_range increments them for strings. */
990 i
= validate_interval_range (object
, &start
, &end
, hard
);
991 /* This can return if start == end. */
992 if (NULL_INTERVAL_P (i
))
997 len
= XINT (end
) - s
;
999 if (i
->position
!= s
)
1002 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1004 if (LENGTH (i
) > len
)
1006 copy_properties (unchanged
, i
);
1007 i
= split_interval_left (i
, len
);
1008 set_properties (props
, i
, object
);
1012 set_properties (props
, i
, object
);
1014 if (LENGTH (i
) == len
)
1019 i
= next_interval (i
);
1022 /* We are starting at the beginning of an interval, I */
1028 if (LENGTH (i
) >= len
)
1030 if (LENGTH (i
) > len
)
1031 i
= split_interval_left (i
, len
);
1033 /* We have to call set_properties even if we are going to
1034 merge the intervals, so as to make the undo records
1035 and cause redisplay to happen. */
1036 set_properties (props
, i
, object
);
1037 if (!NULL_INTERVAL_P (prev_changed
))
1038 merge_interval_left (i
);
1044 /* We have to call set_properties even if we are going to
1045 merge the intervals, so as to make the undo records
1046 and cause redisplay to happen. */
1047 set_properties (props
, i
, object
);
1048 if (NULL_INTERVAL_P (prev_changed
))
1051 prev_changed
= i
= merge_interval_left (i
);
1053 i
= next_interval (i
);
1059 DEFUN ("remove-text-properties", Fremove_text_properties
,
1060 Sremove_text_properties
, 3, 4, 0,
1061 "Remove some properties from text from START to END.\n\
1062 The third argument PROPS is a property list\n\
1063 whose property names specify the properties to remove.\n\
1064 \(The values stored in PROPS are ignored.)\n\
1065 The optional fourth argument, OBJECT,\n\
1066 is the string or buffer containing the text.\n\
1067 Return t if any property was actually removed, nil otherwise.")
1068 (start
, end
, props
, object
)
1069 Lisp_Object start
, end
, props
, object
;
1071 register INTERVAL i
, unchanged
;
1072 register int s
, len
, modified
= 0;
1075 XSETBUFFER (object
, current_buffer
);
1077 i
= validate_interval_range (object
, &start
, &end
, soft
);
1078 if (NULL_INTERVAL_P (i
))
1082 len
= XINT (end
) - s
;
1084 if (i
->position
!= s
)
1086 /* No properties on this first interval -- return if
1087 it covers the entire region. */
1088 if (! interval_has_some_properties (props
, i
))
1090 int got
= (LENGTH (i
) - (s
- i
->position
));
1094 i
= next_interval (i
);
1096 /* Split away the beginning of this interval; what we don't
1101 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1102 copy_properties (unchanged
, i
);
1106 /* We are at the beginning of an interval, with len to scan */
1112 if (LENGTH (i
) >= len
)
1114 if (! interval_has_some_properties (props
, i
))
1115 return modified
? Qt
: Qnil
;
1117 if (LENGTH (i
) == len
)
1119 remove_properties (props
, i
, object
);
1123 /* i has the properties, and goes past the change limit */
1125 i
= split_interval_left (i
, len
);
1126 copy_properties (unchanged
, i
);
1127 remove_properties (props
, i
, object
);
1132 modified
+= remove_properties (props
, i
, object
);
1133 i
= next_interval (i
);
1137 DEFUN ("text-property-any", Ftext_property_any
,
1138 Stext_property_any
, 4, 5, 0,
1139 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1140 If so, return the position of the first character whose PROP is `eq'\n\
1141 to VALUE. Otherwise return nil.\n\
1142 The optional fifth argument, OBJECT, is the string or buffer\n\
1143 containing the text.")
1144 (start
, end
, prop
, value
, object
)
1145 Lisp_Object start
, end
, prop
, value
, object
;
1147 register INTERVAL i
;
1148 register int e
, pos
;
1151 XSETBUFFER (object
, current_buffer
);
1152 i
= validate_interval_range (object
, &start
, &end
, soft
);
1153 if (NULL_INTERVAL_P (i
))
1154 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1157 while (! NULL_INTERVAL_P (i
))
1159 if (i
->position
>= e
)
1161 if (EQ (textget (i
->plist
, prop
), value
))
1164 if (pos
< XINT (start
))
1166 return make_number (pos
- (STRINGP (object
)));
1168 i
= next_interval (i
);
1173 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1174 Stext_property_not_all
, 4, 5, 0,
1175 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1176 If so, return the position of the first character whose PROP is not\n\
1177 `eq' to VALUE. Otherwise, return nil.\n\
1178 The optional fifth argument, OBJECT, is the string or buffer\n\
1179 containing the text.")
1180 (start
, end
, prop
, value
, object
)
1181 Lisp_Object start
, end
, prop
, value
, object
;
1183 register INTERVAL i
;
1187 XSETBUFFER (object
, current_buffer
);
1188 i
= validate_interval_range (object
, &start
, &end
, soft
);
1189 if (NULL_INTERVAL_P (i
))
1190 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1194 while (! NULL_INTERVAL_P (i
))
1196 if (i
->position
>= e
)
1198 if (! EQ (textget (i
->plist
, prop
), value
))
1200 if (i
->position
> s
)
1202 return make_number (s
- (STRINGP (object
)));
1204 i
= next_interval (i
);
1209 #if 0 /* You can use set-text-properties for this. */
1211 DEFUN ("erase-text-properties", Ferase_text_properties
,
1212 Serase_text_properties
, 2, 3, 0,
1213 "Remove all properties from the text from START to END.\n\
1214 The optional third argument, OBJECT,\n\
1215 is the string or buffer containing the text.")
1216 (start
, end
, object
)
1217 Lisp_Object start
, end
, object
;
1219 register INTERVAL i
;
1220 register INTERVAL prev_changed
= NULL_INTERVAL
;
1221 register int s
, len
, modified
;
1224 XSETBUFFER (object
, current_buffer
);
1226 i
= validate_interval_range (object
, &start
, &end
, soft
);
1227 if (NULL_INTERVAL_P (i
))
1231 len
= XINT (end
) - s
;
1233 if (i
->position
!= s
)
1236 register INTERVAL unchanged
= i
;
1238 /* If there are properties here, then this text will be modified. */
1239 if (! NILP (i
->plist
))
1241 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1245 if (LENGTH (i
) > len
)
1247 i
= split_interval_right (i
, len
);
1248 copy_properties (unchanged
, i
);
1252 if (LENGTH (i
) == len
)
1257 /* If the text of I is without any properties, and contains
1258 LEN or more characters, then we may return without changing
1260 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1262 /* The amount of text to change extends past I, so just note
1263 how much we've gotten. */
1265 got
= LENGTH (i
) - (s
- i
->position
);
1269 i
= next_interval (i
);
1272 /* We are starting at the beginning of an interval, I. */
1275 if (LENGTH (i
) >= len
)
1277 /* If I has no properties, simply merge it if possible. */
1278 if (NILP (i
->plist
))
1280 if (! NULL_INTERVAL_P (prev_changed
))
1281 merge_interval_left (i
);
1283 return modified
? Qt
: Qnil
;
1286 if (LENGTH (i
) > len
)
1287 i
= split_interval_left (i
, len
);
1288 if (! NULL_INTERVAL_P (prev_changed
))
1289 merge_interval_left (i
);
1296 /* Here if we still need to erase past the end of I */
1298 if (NULL_INTERVAL_P (prev_changed
))
1300 modified
+= erase_properties (i
);
1305 modified
+= ! NILP (i
->plist
);
1306 /* Merging I will give it the properties of PREV_CHANGED. */
1307 prev_changed
= i
= merge_interval_left (i
);
1310 i
= next_interval (i
);
1313 return modified
? Qt
: Qnil
;
1317 /* I don't think this is the right interface to export; how often do you
1318 want to do something like this, other than when you're copying objects
1321 I think it would be better to have a pair of functions, one which
1322 returns the text properties of a region as a list of ranges and
1323 plists, and another which applies such a list to another object. */
1325 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1326 SRC and DEST may each refer to strings or buffers.
1327 Optional sixth argument PROP causes only that property to be copied.
1328 Properties are copied to DEST as if by `add-text-properties'.
1329 Return t if any property value actually changed, nil otherwise. */
1331 /* Note this can GC when DEST is a buffer. */
1334 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1335 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1341 int s
, e
, e2
, p
, len
, modified
= 0;
1342 struct gcpro gcpro1
, gcpro2
;
1344 i
= validate_interval_range (src
, &start
, &end
, soft
);
1345 if (NULL_INTERVAL_P (i
))
1348 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1350 Lisp_Object dest_start
, dest_end
;
1353 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1354 /* Apply this to a copy of pos; it will try to increment its arguments,
1355 which we don't want. */
1356 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1367 e2
= i
->position
+ LENGTH (i
);
1374 while (! NILP (plist
))
1376 if (EQ (Fcar (plist
), prop
))
1378 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1381 plist
= Fcdr (Fcdr (plist
));
1385 /* Must defer modifications to the interval tree in case src
1386 and dest refer to the same string or buffer. */
1387 stuff
= Fcons (Fcons (make_number (p
),
1388 Fcons (make_number (p
+ len
),
1389 Fcons (plist
, Qnil
))),
1393 i
= next_interval (i
);
1394 if (NULL_INTERVAL_P (i
))
1401 GCPRO2 (stuff
, dest
);
1403 while (! NILP (stuff
))
1406 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1407 Fcar (Fcdr (Fcdr (res
))), dest
);
1410 stuff
= Fcdr (stuff
);
1415 return modified
? Qt
: Qnil
;
1418 /* Call the modification hook functions in LIST, each with START and END. */
1421 call_mod_hooks (list
, start
, end
)
1422 Lisp_Object list
, start
, end
;
1424 struct gcpro gcpro1
;
1426 while (!NILP (list
))
1428 call2 (Fcar (list
), start
, end
);
1434 /* Check for read-only intervals and signal an error if we find one.
1435 Then check for any modification hooks in the range START up to
1436 (but not including) END. Create a list of all these hooks in
1437 lexicographic order, eliminating consecutive extra copies of the
1438 same hook. Then call those hooks in order, with START and END - 1
1442 verify_interval_modification (buf
, start
, end
)
1446 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1447 register INTERVAL i
, prev
;
1449 register Lisp_Object prev_mod_hooks
;
1450 Lisp_Object mod_hooks
;
1451 struct gcpro gcpro1
;
1454 prev_mod_hooks
= Qnil
;
1457 interval_insert_behind_hooks
= Qnil
;
1458 interval_insert_in_front_hooks
= Qnil
;
1460 if (NULL_INTERVAL_P (intervals
))
1470 /* For an insert operation, check the two chars around the position. */
1474 Lisp_Object before
, after
;
1476 /* Set I to the interval containing the char after START,
1477 and PREV to the interval containing the char before START.
1478 Either one may be null. They may be equal. */
1479 i
= find_interval (intervals
, start
);
1481 if (start
== BUF_BEGV (buf
))
1483 else if (i
->position
== start
)
1484 prev
= previous_interval (i
);
1485 else if (i
->position
< start
)
1487 if (start
== BUF_ZV (buf
))
1490 /* If Vinhibit_read_only is set and is not a list, we can
1491 skip the read_only checks. */
1492 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1494 /* If I and PREV differ we need to check for the read-only
1495 property together with its stickyness. If either I or
1496 PREV are 0, this check is all we need.
1497 We have to take special care, since read-only may be
1498 indirectly defined via the category property. */
1501 if (! NULL_INTERVAL_P (i
))
1503 after
= textget (i
->plist
, Qread_only
);
1505 /* If interval I is read-only and read-only is
1506 front-sticky, inhibit insertion.
1507 Check for read-only as well as category. */
1509 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1513 tem
= textget (i
->plist
, Qfront_sticky
);
1514 if (TMEM (Qread_only
, tem
)
1515 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1516 && TMEM (Qcategory
, tem
)))
1517 error ("Attempt to insert within read-only text");
1521 if (! NULL_INTERVAL_P (prev
))
1523 before
= textget (prev
->plist
, Qread_only
);
1525 /* If interval PREV is read-only and read-only isn't
1526 rear-nonsticky, inhibit insertion.
1527 Check for read-only as well as category. */
1529 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1533 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1534 if (! TMEM (Qread_only
, tem
)
1535 && (! NILP (Fplist_get (prev
->plist
,Qread_only
))
1536 || ! TMEM (Qcategory
, tem
)))
1537 error ("Attempt to insert within read-only text");
1541 else if (! NULL_INTERVAL_P (i
))
1543 after
= textget (i
->plist
, Qread_only
);
1545 /* If interval I is read-only and read-only is
1546 front-sticky, inhibit insertion.
1547 Check for read-only as well as category. */
1548 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1552 tem
= textget (i
->plist
, Qfront_sticky
);
1553 if (TMEM (Qread_only
, tem
)
1554 || (NILP (Fplist_get (i
->plist
, Qread_only
))
1555 && TMEM (Qcategory
, tem
)))
1556 error ("Attempt to insert within read-only text");
1558 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1559 if (! TMEM (Qread_only
, tem
)
1560 && (! NILP (Fplist_get (prev
->plist
, Qread_only
))
1561 || ! TMEM (Qcategory
, tem
)))
1562 error ("Attempt to insert within read-only text");
1567 /* Run both insert hooks (just once if they're the same). */
1568 if (!NULL_INTERVAL_P (prev
))
1569 interval_insert_behind_hooks
1570 = textget (prev
->plist
, Qinsert_behind_hooks
);
1571 if (!NULL_INTERVAL_P (i
))
1572 interval_insert_in_front_hooks
1573 = textget (i
->plist
, Qinsert_in_front_hooks
);
1577 /* Loop over intervals on or next to START...END,
1578 collecting their hooks. */
1580 i
= find_interval (intervals
, start
);
1583 if (! INTERVAL_WRITABLE_P (i
))
1584 error ("Attempt to modify read-only text");
1586 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1587 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1589 hooks
= Fcons (mod_hooks
, hooks
);
1590 prev_mod_hooks
= mod_hooks
;
1593 i
= next_interval (i
);
1595 /* Keep going thru the interval containing the char before END. */
1596 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1599 hooks
= Fnreverse (hooks
);
1600 while (! EQ (hooks
, Qnil
))
1602 call_mod_hooks (Fcar (hooks
), make_number (start
),
1604 hooks
= Fcdr (hooks
);
1610 /* Run the interval hooks for an insertion.
1611 verify_interval_modification chose which hooks to run;
1612 this function is called after the insertion happens
1613 so it can indicate the range of inserted text. */
1616 report_interval_modification (start
, end
)
1617 Lisp_Object start
, end
;
1619 if (! NILP (interval_insert_behind_hooks
))
1620 call_mod_hooks (interval_insert_behind_hooks
,
1621 make_number (start
), make_number (end
));
1622 if (! NILP (interval_insert_in_front_hooks
)
1623 && ! EQ (interval_insert_in_front_hooks
,
1624 interval_insert_behind_hooks
))
1625 call_mod_hooks (interval_insert_in_front_hooks
,
1626 make_number (start
), make_number (end
));
1632 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1633 "Property-list used as default values.\n\
1634 The value of a property in this list is seen as the value for every\n\
1635 character that does not have its own value for that property.");
1636 Vdefault_text_properties
= Qnil
;
1638 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1639 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1640 This also inhibits the use of the `intangible' text property.");
1641 Vinhibit_point_motion_hooks
= Qnil
;
1643 staticpro (&interval_insert_behind_hooks
);
1644 staticpro (&interval_insert_in_front_hooks
);
1645 interval_insert_behind_hooks
= Qnil
;
1646 interval_insert_in_front_hooks
= Qnil
;
1649 /* Common attributes one might give text */
1651 staticpro (&Qforeground
);
1652 Qforeground
= intern ("foreground");
1653 staticpro (&Qbackground
);
1654 Qbackground
= intern ("background");
1656 Qfont
= intern ("font");
1657 staticpro (&Qstipple
);
1658 Qstipple
= intern ("stipple");
1659 staticpro (&Qunderline
);
1660 Qunderline
= intern ("underline");
1661 staticpro (&Qread_only
);
1662 Qread_only
= intern ("read-only");
1663 staticpro (&Qinvisible
);
1664 Qinvisible
= intern ("invisible");
1665 staticpro (&Qintangible
);
1666 Qintangible
= intern ("intangible");
1667 staticpro (&Qcategory
);
1668 Qcategory
= intern ("category");
1669 staticpro (&Qlocal_map
);
1670 Qlocal_map
= intern ("local-map");
1671 staticpro (&Qfront_sticky
);
1672 Qfront_sticky
= intern ("front-sticky");
1673 staticpro (&Qrear_nonsticky
);
1674 Qrear_nonsticky
= intern ("rear-nonsticky");
1676 /* Properties that text might use to specify certain actions */
1678 staticpro (&Qmouse_left
);
1679 Qmouse_left
= intern ("mouse-left");
1680 staticpro (&Qmouse_entered
);
1681 Qmouse_entered
= intern ("mouse-entered");
1682 staticpro (&Qpoint_left
);
1683 Qpoint_left
= intern ("point-left");
1684 staticpro (&Qpoint_entered
);
1685 Qpoint_entered
= intern ("point-entered");
1687 defsubr (&Stext_properties_at
);
1688 defsubr (&Sget_text_property
);
1689 defsubr (&Sget_char_property
);
1690 defsubr (&Snext_property_change
);
1691 defsubr (&Snext_single_property_change
);
1692 defsubr (&Sprevious_property_change
);
1693 defsubr (&Sprevious_single_property_change
);
1694 defsubr (&Sadd_text_properties
);
1695 defsubr (&Sput_text_property
);
1696 defsubr (&Sset_text_properties
);
1697 defsubr (&Sremove_text_properties
);
1698 defsubr (&Stext_property_any
);
1699 defsubr (&Stext_property_not_all
);
1700 /* defsubr (&Serase_text_properties); */
1701 /* defsubr (&Scopy_text_properties); */
1706 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1708 #endif /* USE_TEXT_PROPERTIES */