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
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
;
67 Lisp_Object Vdefault_text_properties
;
70 /* Extract the interval at the position pointed to by BEGIN from
71 OBJECT, a string or buffer. Additionally, check that the positions
72 pointed to by BEGIN and END are within the bounds of OBJECT, and
73 reverse them if *BEGIN is greater than *END. The objects pointed
74 to by BEGIN and END may be integers or markers; if the latter, they
75 are coerced to integers.
77 When OBJECT is a string, we increment *BEGIN and *END
78 to make them origin-one.
80 Note that buffer points don't correspond to interval indices.
81 For example, point-max is 1 greater than the index of the last
82 character. This difference is handled in the caller, which uses
83 the validated points to determine a length, and operates on that.
84 Exceptions are Ftext_properties_at, Fnext_property_change, and
85 Fprevious_property_change which call this function with BEGIN == END.
86 Handle this case specially.
88 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
89 create an interval tree for OBJECT if one doesn't exist, provided
90 the object actually contains text. In the current design, if there
91 is no text, there can be no text properties. */
97 validate_interval_range (object
, begin
, end
, force
)
98 Lisp_Object object
, *begin
, *end
;
104 CHECK_STRING_OR_BUFFER (object
, 0);
105 CHECK_NUMBER_COERCE_MARKER (*begin
, 0);
106 CHECK_NUMBER_COERCE_MARKER (*end
, 0);
108 /* If we are asked for a point, but from a subr which operates
109 on a range, then return nothing. */
110 if (EQ (*begin
, *end
) && begin
!= end
)
111 return NULL_INTERVAL
;
113 if (XINT (*begin
) > XINT (*end
))
121 if (BUFFERP (object
))
123 register struct buffer
*b
= XBUFFER (object
);
125 if (!(BUF_BEGV (b
) <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
126 && XINT (*end
) <= BUF_ZV (b
)))
127 args_out_of_range (*begin
, *end
);
128 i
= BUF_INTERVALS (b
);
130 /* If there's no text, there are no properties. */
131 if (BUF_BEGV (b
) == BUF_ZV (b
))
132 return NULL_INTERVAL
;
134 searchpos
= XINT (*begin
);
138 register struct Lisp_String
*s
= XSTRING (object
);
140 if (! (0 <= XINT (*begin
) && XINT (*begin
) <= XINT (*end
)
141 && XINT (*end
) <= s
->size
))
142 args_out_of_range (*begin
, *end
);
143 /* User-level Positions in strings start with 0,
144 but the interval code always wants positions starting with 1. */
145 XSETFASTINT (*begin
, XFASTINT (*begin
) + 1);
147 XSETFASTINT (*end
, XFASTINT (*end
) + 1);
151 return NULL_INTERVAL
;
153 searchpos
= XINT (*begin
);
156 if (NULL_INTERVAL_P (i
))
157 return (force
? create_root_interval (object
) : i
);
159 return find_interval (i
, searchpos
);
162 /* Validate LIST as a property list. If LIST is not a list, then
163 make one consisting of (LIST nil). Otherwise, verify that LIST
164 is even numbered and thus suitable as a plist. */
167 validate_plist (list
)
176 register Lisp_Object tail
;
177 for (i
= 0, tail
= list
; !NILP (tail
); i
++)
183 error ("Odd length text property list");
187 return Fcons (list
, Fcons (Qnil
, Qnil
));
190 /* Return nonzero if interval I has all the properties,
191 with the same values, of list PLIST. */
194 interval_has_all_properties (plist
, i
)
198 register Lisp_Object tail1
, tail2
, sym1
, sym2
;
201 /* Go through each element of PLIST. */
202 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
207 /* Go through I's plist, looking for sym1 */
208 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
209 if (EQ (sym1
, Fcar (tail2
)))
211 /* Found the same property on both lists. If the
212 values are unequal, return zero. */
213 if (! EQ (Fcar (Fcdr (tail1
)), Fcar (Fcdr (tail2
))))
216 /* Property has same value on both lists; go to next one. */
228 /* Return nonzero if the plist of interval I has any of the
229 properties of PLIST, regardless of their values. */
232 interval_has_some_properties (plist
, i
)
236 register Lisp_Object tail1
, tail2
, sym
;
238 /* Go through each element of PLIST. */
239 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
243 /* Go through i's plist, looking for tail1 */
244 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
245 if (EQ (sym
, Fcar (tail2
)))
252 /* Changing the plists of individual intervals. */
254 /* Return the value of PROP in property-list PLIST, or Qunbound if it
257 property_value (plist
, prop
)
258 Lisp_Object plist
, prop
;
262 while (PLIST_ELT_P (plist
, value
))
263 if (EQ (XCONS (plist
)->car
, prop
))
264 return XCONS (value
)->car
;
266 plist
= XCONS (value
)->cdr
;
271 /* Set the properties of INTERVAL to PROPERTIES,
272 and record undo info for the previous values.
273 OBJECT is the string or buffer that INTERVAL belongs to. */
276 set_properties (properties
, interval
, object
)
277 Lisp_Object properties
, object
;
280 Lisp_Object sym
, value
;
282 if (BUFFERP (object
))
284 /* For each property in the old plist which is missing from PROPERTIES,
285 or has a different value in PROPERTIES, make an undo record. */
286 for (sym
= interval
->plist
;
287 PLIST_ELT_P (sym
, value
);
288 sym
= XCONS (value
)->cdr
)
289 if (! EQ (property_value (properties
, XCONS (sym
)->car
),
292 modify_region (XBUFFER (object
),
293 make_number (interval
->position
),
294 make_number (interval
->position
+ LENGTH (interval
)));
295 record_property_change (interval
->position
, LENGTH (interval
),
296 XCONS (sym
)->car
, XCONS (value
)->car
,
300 /* For each new property that has no value at all in the old plist,
301 make an undo record binding it to nil, so it will be removed. */
302 for (sym
= properties
;
303 PLIST_ELT_P (sym
, value
);
304 sym
= XCONS (value
)->cdr
)
305 if (EQ (property_value (interval
->plist
, XCONS (sym
)->car
), Qunbound
))
307 modify_region (XBUFFER (object
),
308 make_number (interval
->position
),
309 make_number (interval
->position
+ LENGTH (interval
)));
310 record_property_change (interval
->position
, LENGTH (interval
),
311 XCONS (sym
)->car
, Qnil
,
316 /* Store new properties. */
317 interval
->plist
= Fcopy_sequence (properties
);
320 /* Add the properties of PLIST to the interval I, or set
321 the value of I's property to the value of the property on PLIST
322 if they are different.
324 OBJECT should be the string or buffer the interval is in.
326 Return nonzero if this changes I (i.e., if any members of PLIST
327 are actually added to I's plist) */
330 add_properties (plist
, i
, object
)
335 Lisp_Object tail1
, tail2
, sym1
, val1
;
336 register int changed
= 0;
338 struct gcpro gcpro1
, gcpro2
, gcpro3
;
343 /* No need to protect OBJECT, because we can GC only in the case
344 where it is a buffer, and live buffers are always protected.
345 I and its plist are also protected, via OBJECT. */
346 GCPRO3 (tail1
, sym1
, val1
);
348 /* Go through each element of PLIST. */
349 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
352 val1
= Fcar (Fcdr (tail1
));
355 /* Go through I's plist, looking for sym1 */
356 for (tail2
= i
->plist
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
357 if (EQ (sym1
, Fcar (tail2
)))
359 /* No need to gcpro, because tail2 protects this
360 and it must be a cons cell (we get an error otherwise). */
361 register Lisp_Object this_cdr
;
363 this_cdr
= Fcdr (tail2
);
364 /* Found the property. Now check its value. */
367 /* The properties have the same value on both lists.
368 Continue to the next property. */
369 if (EQ (val1
, Fcar (this_cdr
)))
372 /* Record this change in the buffer, for undo purposes. */
373 if (BUFFERP (object
))
375 modify_region (XBUFFER (object
),
376 make_number (i
->position
),
377 make_number (i
->position
+ LENGTH (i
)));
378 record_property_change (i
->position
, LENGTH (i
),
379 sym1
, Fcar (this_cdr
), object
);
382 /* I's property has a different value -- change it */
383 Fsetcar (this_cdr
, val1
);
390 /* Record this change in the buffer, for undo purposes. */
391 if (BUFFERP (object
))
393 modify_region (XBUFFER (object
),
394 make_number (i
->position
),
395 make_number (i
->position
+ LENGTH (i
)));
396 record_property_change (i
->position
, LENGTH (i
),
399 i
->plist
= Fcons (sym1
, Fcons (val1
, i
->plist
));
409 /* For any members of PLIST which are properties of I, remove them
411 OBJECT is the string or buffer containing I. */
414 remove_properties (plist
, i
, object
)
419 register Lisp_Object tail1
, tail2
, sym
, current_plist
;
420 register int changed
= 0;
422 current_plist
= i
->plist
;
423 /* Go through each element of plist. */
424 for (tail1
= plist
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
428 /* First, remove the symbol if its at the head of the list */
429 while (! NILP (current_plist
) && EQ (sym
, Fcar (current_plist
)))
431 if (BUFFERP (object
))
433 modify_region (XBUFFER (object
),
434 make_number (i
->position
),
435 make_number (i
->position
+ LENGTH (i
)));
436 record_property_change (i
->position
, LENGTH (i
),
437 sym
, Fcar (Fcdr (current_plist
)),
441 current_plist
= Fcdr (Fcdr (current_plist
));
445 /* Go through i's plist, looking for sym */
446 tail2
= current_plist
;
447 while (! NILP (tail2
))
449 register Lisp_Object
this;
450 this = Fcdr (Fcdr (tail2
));
451 if (EQ (sym
, Fcar (this)))
453 if (BUFFERP (object
))
455 modify_region (XBUFFER (object
),
456 make_number (i
->position
),
457 make_number (i
->position
+ LENGTH (i
)));
458 record_property_change (i
->position
, LENGTH (i
),
459 sym
, Fcar (Fcdr (this)), object
);
462 Fsetcdr (Fcdr (tail2
), Fcdr (Fcdr (this)));
470 i
->plist
= current_plist
;
475 /* Remove all properties from interval I. Return non-zero
476 if this changes the interval. */
490 DEFUN ("text-properties-at", Ftext_properties_at
,
491 Stext_properties_at
, 1, 2, 0,
492 "Return the list of properties held by the character at POSITION\n\
493 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
494 defaults to the current buffer.\n\
495 If POSITION is at the end of OBJECT, the value is nil.")
497 Lisp_Object pos
, object
;
502 XSETBUFFER (object
, current_buffer
);
504 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
505 if (NULL_INTERVAL_P (i
))
507 /* If POS is at the end of the interval,
508 it means it's the end of OBJECT.
509 There are no properties at the very end,
510 since no character follows. */
511 if (XINT (pos
) == LENGTH (i
) + i
->position
)
517 DEFUN ("get-text-property", Fget_text_property
, Sget_text_property
, 2, 3, 0,
518 "Return the value of position POS's property PROP, in OBJECT.\n\
519 OBJECT is optional and defaults to the current buffer.\n\
520 If POSITION is at the end of OBJECT, the value is nil.")
522 Lisp_Object pos
, object
;
525 return textget (Ftext_properties_at (pos
, object
), prop
);
528 DEFUN ("get-char-property", Fget_char_property
, Sget_char_property
, 2, 3, 0,
529 "Return the value of position POS's property PROP, in OBJECT.\n\
530 OBJECT is optional and defaults to the current buffer.\n\
531 If POS is at the end of OBJECT, the value is nil.\n\
532 If OBJECT is a buffer, then overlay properties are considered as well as\n\
534 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
535 overlays are considered only if they are associated with OBJECT.")
537 Lisp_Object pos
, object
;
538 register Lisp_Object prop
;
540 struct window
*w
= 0;
542 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
545 XSETBUFFER (object
, current_buffer
);
547 if (WINDOWP (object
))
549 w
= XWINDOW (object
);
552 if (BUFFERP (object
))
554 int posn
= XINT (pos
);
556 Lisp_Object
*overlay_vec
, tem
;
559 struct buffer
*obuf
= current_buffer
;
561 set_buffer_temp (XBUFFER (object
));
563 /* First try with room for 40 overlays. */
565 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
567 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
568 &next_overlay
, NULL
);
570 /* If there are more than 40,
571 make enough space for all, and try again. */
575 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
576 noverlays
= overlays_at (posn
, 0, &overlay_vec
, &len
,
577 &next_overlay
, NULL
);
579 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
581 set_buffer_temp (obuf
);
583 /* Now check the overlays in order of decreasing priority. */
584 while (--noverlays
>= 0)
586 tem
= Foverlay_get (overlay_vec
[noverlays
], prop
);
591 /* Not a buffer, or no appropriate overlay, so fall through to the
593 return (Fget_text_property (pos
, prop
, object
));
596 DEFUN ("next-property-change", Fnext_property_change
,
597 Snext_property_change
, 1, 3, 0,
598 "Return the position of next property change.\n\
599 Scans characters forward from POS in OBJECT till it finds\n\
600 a change in some text property, then returns the position of the change.\n\
601 The optional second argument OBJECT is the string or buffer to scan.\n\
602 Return nil if the property is constant all the way to the end of OBJECT.\n\
603 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
604 If the optional third argument LIMIT is non-nil, don't search\n\
605 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
607 Lisp_Object pos
, object
, limit
;
609 register INTERVAL i
, next
;
612 XSETBUFFER (object
, current_buffer
);
614 if (! NILP (limit
) && ! EQ (limit
, Qt
))
615 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
617 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
618 if (NULL_INTERVAL_P (i
))
621 next
= next_interval (i
);
622 /* If LIMIT is t, return start of next interval--don't
623 bother checking further intervals. */
626 if (NULL_INTERVAL_P (next
))
627 XSETFASTINT (pos
, (STRINGP (object
)
628 ? XSTRING (object
)->size
629 : BUF_ZV (XBUFFER (object
))));
631 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
635 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
)
636 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
637 next
= next_interval (next
);
639 if (NULL_INTERVAL_P (next
))
641 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
644 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
648 /* Return 1 if there's a change in some property between BEG and END. */
651 property_change_between_p (beg
, end
)
654 register INTERVAL i
, next
;
655 Lisp_Object object
, pos
;
657 XSETBUFFER (object
, current_buffer
);
658 XSETFASTINT (pos
, beg
);
660 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
661 if (NULL_INTERVAL_P (i
))
664 next
= next_interval (i
);
665 while (! NULL_INTERVAL_P (next
) && intervals_equal (i
, next
))
667 next
= next_interval (next
);
668 if (NULL_INTERVAL_P (next
))
670 if (next
->position
>= end
)
674 if (NULL_INTERVAL_P (next
))
680 DEFUN ("next-single-property-change", Fnext_single_property_change
,
681 Snext_single_property_change
, 2, 4, 0,
682 "Return the position of next property change for a specific property.\n\
683 Scans characters forward from POS till it finds\n\
684 a change in the PROP property, then returns the position of the change.\n\
685 The optional third argument OBJECT is the string or buffer to scan.\n\
686 The property values are compared with `eq'.\n\
687 Return nil if the property is constant all the way to the end of OBJECT.\n\
688 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
689 If the optional fourth argument LIMIT is non-nil, don't search\n\
690 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
691 (pos
, prop
, object
, limit
)
692 Lisp_Object pos
, prop
, object
, limit
;
694 register INTERVAL i
, next
;
695 register Lisp_Object here_val
;
698 XSETBUFFER (object
, current_buffer
);
701 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
703 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
704 if (NULL_INTERVAL_P (i
))
707 here_val
= textget (i
->plist
, prop
);
708 next
= next_interval (i
);
709 while (! NULL_INTERVAL_P (next
)
710 && EQ (here_val
, textget (next
->plist
, prop
))
711 && (NILP (limit
) || next
->position
< XFASTINT (limit
)))
712 next
= next_interval (next
);
714 if (NULL_INTERVAL_P (next
))
716 if (! NILP (limit
) && !(next
->position
< XFASTINT (limit
)))
719 XSETFASTINT (pos
, next
->position
- (STRINGP (object
)));
723 DEFUN ("previous-property-change", Fprevious_property_change
,
724 Sprevious_property_change
, 1, 3, 0,
725 "Return the position of previous property change.\n\
726 Scans characters backwards from POS in OBJECT till it finds\n\
727 a change in some text property, then returns the position of the change.\n\
728 The optional second argument OBJECT is the string or buffer to scan.\n\
729 Return nil if the property is constant all the way to the start of OBJECT.\n\
730 If the value is non-nil, it is a position less than POS, never equal.\n\n\
731 If the optional third argument LIMIT is non-nil, don't search\n\
732 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
734 Lisp_Object pos
, object
, limit
;
736 register INTERVAL i
, previous
;
739 XSETBUFFER (object
, current_buffer
);
742 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
744 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
745 if (NULL_INTERVAL_P (i
))
748 /* Start with the interval containing the char before point. */
749 if (i
->position
== XFASTINT (pos
))
750 i
= previous_interval (i
);
752 previous
= previous_interval (i
);
753 while (! NULL_INTERVAL_P (previous
) && intervals_equal (previous
, i
)
755 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
756 previous
= previous_interval (previous
);
757 if (NULL_INTERVAL_P (previous
))
760 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
763 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
764 - (STRINGP (object
))));
768 DEFUN ("previous-single-property-change", Fprevious_single_property_change
,
769 Sprevious_single_property_change
, 2, 4, 0,
770 "Return the position of previous property change for a specific property.\n\
771 Scans characters backward from POS till it finds\n\
772 a change in the PROP property, then returns the position of the change.\n\
773 The optional third argument OBJECT is the string or buffer to scan.\n\
774 The property values are compared with `eq'.\n\
775 Return nil if the property is constant all the way to the start of OBJECT.\n\
776 If the value is non-nil, it is a position less than POS, never equal.\n\n\
777 If the optional fourth argument LIMIT is non-nil, don't search\n\
778 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
779 (pos
, prop
, object
, limit
)
780 Lisp_Object pos
, prop
, object
, limit
;
782 register INTERVAL i
, previous
;
783 register Lisp_Object here_val
;
786 XSETBUFFER (object
, current_buffer
);
789 CHECK_NUMBER_COERCE_MARKER (limit
, 0);
791 i
= validate_interval_range (object
, &pos
, &pos
, soft
);
793 /* Start with the interval containing the char before point. */
794 if (! NULL_INTERVAL_P (i
) && i
->position
== XFASTINT (pos
))
795 i
= previous_interval (i
);
797 if (NULL_INTERVAL_P (i
))
800 here_val
= textget (i
->plist
, prop
);
801 previous
= previous_interval (i
);
802 while (! NULL_INTERVAL_P (previous
)
803 && EQ (here_val
, textget (previous
->plist
, prop
))
805 || previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
806 previous
= previous_interval (previous
);
807 if (NULL_INTERVAL_P (previous
))
810 && !(previous
->position
+ LENGTH (previous
) > XFASTINT (limit
)))
813 XSETFASTINT (pos
, (previous
->position
+ LENGTH (previous
)
814 - (STRINGP (object
))));
818 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
820 DEFUN ("add-text-properties", Fadd_text_properties
,
821 Sadd_text_properties
, 3, 4, 0,
822 "Add properties to the text from START to END.\n\
823 The third argument PROPS is a property list\n\
824 specifying the property values to add.\n\
825 The optional fourth argument, OBJECT,\n\
826 is the string or buffer containing the text.\n\
827 Return t if any property value actually changed, nil otherwise.")
828 (start
, end
, properties
, object
)
829 Lisp_Object start
, end
, properties
, object
;
831 register INTERVAL i
, unchanged
;
832 register int s
, len
, modified
= 0;
835 properties
= validate_plist (properties
);
836 if (NILP (properties
))
840 XSETBUFFER (object
, current_buffer
);
842 i
= validate_interval_range (object
, &start
, &end
, hard
);
843 if (NULL_INTERVAL_P (i
))
847 len
= XINT (end
) - s
;
849 /* No need to protect OBJECT, because we GC only if it's a buffer,
850 and live buffers are always protected. */
853 /* If we're not starting on an interval boundary, we have to
854 split this interval. */
855 if (i
->position
!= s
)
857 /* If this interval already has the properties, we can
859 if (interval_has_all_properties (properties
, i
))
861 int got
= (LENGTH (i
) - (s
- i
->position
));
865 i
= next_interval (i
);
870 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
871 copy_properties (unchanged
, i
);
875 /* We are at the beginning of interval I, with LEN chars to scan. */
881 if (LENGTH (i
) >= len
)
883 /* We can UNGCPRO safely here, because there will be just
884 one more chance to gc, in the next call to add_properties,
885 and after that we will not need PROPERTIES or OBJECT again. */
888 if (interval_has_all_properties (properties
, i
))
889 return modified
? Qt
: Qnil
;
891 if (LENGTH (i
) == len
)
893 add_properties (properties
, i
, object
);
897 /* i doesn't have the properties, and goes past the change limit */
899 i
= split_interval_left (unchanged
, len
);
900 copy_properties (unchanged
, i
);
901 add_properties (properties
, i
, object
);
906 modified
+= add_properties (properties
, i
, object
);
907 i
= next_interval (i
);
911 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
913 DEFUN ("put-text-property", Fput_text_property
,
914 Sput_text_property
, 4, 5, 0,
915 "Set one property of the text from START to END.\n\
916 The third and fourth arguments PROP and VALUE\n\
917 specify the property to add.\n\
918 The optional fifth argument, OBJECT,\n\
919 is the string or buffer containing the text.")
920 (start
, end
, prop
, value
, object
)
921 Lisp_Object start
, end
, prop
, value
, object
;
923 Fadd_text_properties (start
, end
,
924 Fcons (prop
, Fcons (value
, Qnil
)),
929 DEFUN ("set-text-properties", Fset_text_properties
,
930 Sset_text_properties
, 3, 4, 0,
931 "Completely replace properties of text from START to END.\n\
932 The third argument PROPS is the new property list.\n\
933 The optional fourth argument, OBJECT,\n\
934 is the string or buffer containing the text.")
935 (start
, end
, props
, object
)
936 Lisp_Object start
, end
, props
, object
;
938 register INTERVAL i
, unchanged
;
939 register INTERVAL prev_changed
= NULL_INTERVAL
;
941 Lisp_Object ostart
, oend
;
946 props
= validate_plist (props
);
949 XSETBUFFER (object
, current_buffer
);
951 /* If we want no properties for a whole string,
952 get rid of its intervals. */
953 if (NILP (props
) && STRINGP (object
)
954 && XFASTINT (start
) == 0
955 && XFASTINT (end
) == XSTRING (object
)->size
)
957 XSTRING (object
)->intervals
= 0;
961 i
= validate_interval_range (object
, &start
, &end
, soft
);
963 if (NULL_INTERVAL_P (i
))
965 /* If buffer has no props, and we want none, return now. */
969 /* Restore the original START and END values
970 because validate_interval_range increments them for strings. */
974 i
= validate_interval_range (object
, &start
, &end
, hard
);
975 /* This can return if start == end. */
976 if (NULL_INTERVAL_P (i
))
981 len
= XINT (end
) - s
;
983 if (i
->position
!= s
)
986 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
988 if (LENGTH (i
) > len
)
990 copy_properties (unchanged
, i
);
991 i
= split_interval_left (i
, len
);
992 set_properties (props
, i
, object
);
996 set_properties (props
, i
, object
);
998 if (LENGTH (i
) == len
)
1003 i
= next_interval (i
);
1006 /* We are starting at the beginning of an interval, I */
1012 if (LENGTH (i
) >= len
)
1014 if (LENGTH (i
) > len
)
1015 i
= split_interval_left (i
, len
);
1017 if (NULL_INTERVAL_P (prev_changed
))
1018 set_properties (props
, i
, object
);
1020 merge_interval_left (i
);
1025 if (NULL_INTERVAL_P (prev_changed
))
1027 set_properties (props
, i
, object
);
1031 prev_changed
= i
= merge_interval_left (i
);
1033 i
= next_interval (i
);
1039 DEFUN ("remove-text-properties", Fremove_text_properties
,
1040 Sremove_text_properties
, 3, 4, 0,
1041 "Remove some properties from text from START to END.\n\
1042 The third argument PROPS is a property list\n\
1043 whose property names specify the properties to remove.\n\
1044 \(The values stored in PROPS are ignored.)\n\
1045 The optional fourth argument, OBJECT,\n\
1046 is the string or buffer containing the text.\n\
1047 Return t if any property was actually removed, nil otherwise.")
1048 (start
, end
, props
, object
)
1049 Lisp_Object start
, end
, props
, object
;
1051 register INTERVAL i
, unchanged
;
1052 register int s
, len
, modified
= 0;
1055 XSETBUFFER (object
, current_buffer
);
1057 i
= validate_interval_range (object
, &start
, &end
, soft
);
1058 if (NULL_INTERVAL_P (i
))
1062 len
= XINT (end
) - s
;
1064 if (i
->position
!= s
)
1066 /* No properties on this first interval -- return if
1067 it covers the entire region. */
1068 if (! interval_has_some_properties (props
, i
))
1070 int got
= (LENGTH (i
) - (s
- i
->position
));
1074 i
= next_interval (i
);
1076 /* Split away the beginning of this interval; what we don't
1081 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1082 copy_properties (unchanged
, i
);
1086 /* We are at the beginning of an interval, with len to scan */
1092 if (LENGTH (i
) >= len
)
1094 if (! interval_has_some_properties (props
, i
))
1095 return modified
? Qt
: Qnil
;
1097 if (LENGTH (i
) == len
)
1099 remove_properties (props
, i
, object
);
1103 /* i has the properties, and goes past the change limit */
1105 i
= split_interval_left (i
, len
);
1106 copy_properties (unchanged
, i
);
1107 remove_properties (props
, i
, object
);
1112 modified
+= remove_properties (props
, i
, object
);
1113 i
= next_interval (i
);
1117 DEFUN ("text-property-any", Ftext_property_any
,
1118 Stext_property_any
, 4, 5, 0,
1119 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1120 If so, return the position of the first character whose PROP is `eq'\n\
1121 to VALUE. Otherwise return nil.\n\
1122 The optional fifth argument, OBJECT, is the string or buffer\n\
1123 containing the text.")
1124 (start
, end
, prop
, value
, object
)
1125 Lisp_Object start
, end
, prop
, value
, object
;
1127 register INTERVAL i
;
1128 register int e
, pos
;
1131 XSETBUFFER (object
, current_buffer
);
1132 i
= validate_interval_range (object
, &start
, &end
, soft
);
1133 if (NULL_INTERVAL_P (i
))
1134 return (!NILP (value
) || EQ (start
, end
) ? Qnil
: start
);
1137 while (! NULL_INTERVAL_P (i
))
1139 if (i
->position
>= e
)
1141 if (EQ (textget (i
->plist
, prop
), value
))
1144 if (pos
< XINT (start
))
1146 return make_number (pos
- (STRINGP (object
)));
1148 i
= next_interval (i
);
1153 DEFUN ("text-property-not-all", Ftext_property_not_all
,
1154 Stext_property_not_all
, 4, 5, 0,
1155 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1156 If so, return the position of the first character whose PROP is not\n\
1157 `eq' to VALUE. Otherwise, return nil.\n\
1158 The optional fifth argument, OBJECT, is the string or buffer\n\
1159 containing the text.")
1160 (start
, end
, prop
, value
, object
)
1161 Lisp_Object start
, end
, prop
, value
, object
;
1163 register INTERVAL i
;
1167 XSETBUFFER (object
, current_buffer
);
1168 i
= validate_interval_range (object
, &start
, &end
, soft
);
1169 if (NULL_INTERVAL_P (i
))
1170 return (NILP (value
) || EQ (start
, end
)) ? Qnil
: start
;
1174 while (! NULL_INTERVAL_P (i
))
1176 if (i
->position
>= e
)
1178 if (! EQ (textget (i
->plist
, prop
), value
))
1180 if (i
->position
> s
)
1182 return make_number (s
- (STRINGP (object
)));
1184 i
= next_interval (i
);
1189 #if 0 /* You can use set-text-properties for this. */
1191 DEFUN ("erase-text-properties", Ferase_text_properties
,
1192 Serase_text_properties
, 2, 3, 0,
1193 "Remove all properties from the text from START to END.\n\
1194 The optional third argument, OBJECT,\n\
1195 is the string or buffer containing the text.")
1196 (start
, end
, object
)
1197 Lisp_Object start
, end
, object
;
1199 register INTERVAL i
;
1200 register INTERVAL prev_changed
= NULL_INTERVAL
;
1201 register int s
, len
, modified
;
1204 XSETBUFFER (object
, current_buffer
);
1206 i
= validate_interval_range (object
, &start
, &end
, soft
);
1207 if (NULL_INTERVAL_P (i
))
1211 len
= XINT (end
) - s
;
1213 if (i
->position
!= s
)
1216 register INTERVAL unchanged
= i
;
1218 /* If there are properties here, then this text will be modified. */
1219 if (! NILP (i
->plist
))
1221 i
= split_interval_right (unchanged
, s
- unchanged
->position
);
1225 if (LENGTH (i
) > len
)
1227 i
= split_interval_right (i
, len
);
1228 copy_properties (unchanged
, i
);
1232 if (LENGTH (i
) == len
)
1237 /* If the text of I is without any properties, and contains
1238 LEN or more characters, then we may return without changing
1240 else if (LENGTH (i
) - (s
- i
->position
) <= len
)
1242 /* The amount of text to change extends past I, so just note
1243 how much we've gotten. */
1245 got
= LENGTH (i
) - (s
- i
->position
);
1249 i
= next_interval (i
);
1252 /* We are starting at the beginning of an interval, I. */
1255 if (LENGTH (i
) >= len
)
1257 /* If I has no properties, simply merge it if possible. */
1258 if (NILP (i
->plist
))
1260 if (! NULL_INTERVAL_P (prev_changed
))
1261 merge_interval_left (i
);
1263 return modified
? Qt
: Qnil
;
1266 if (LENGTH (i
) > len
)
1267 i
= split_interval_left (i
, len
);
1268 if (! NULL_INTERVAL_P (prev_changed
))
1269 merge_interval_left (i
);
1276 /* Here if we still need to erase past the end of I */
1278 if (NULL_INTERVAL_P (prev_changed
))
1280 modified
+= erase_properties (i
);
1285 modified
+= ! NILP (i
->plist
);
1286 /* Merging I will give it the properties of PREV_CHANGED. */
1287 prev_changed
= i
= merge_interval_left (i
);
1290 i
= next_interval (i
);
1293 return modified
? Qt
: Qnil
;
1297 /* I don't think this is the right interface to export; how often do you
1298 want to do something like this, other than when you're copying objects
1301 I think it would be better to have a pair of functions, one which
1302 returns the text properties of a region as a list of ranges and
1303 plists, and another which applies such a list to another object. */
1305 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1306 SRC and DEST may each refer to strings or buffers.
1307 Optional sixth argument PROP causes only that property to be copied.
1308 Properties are copied to DEST as if by `add-text-properties'.
1309 Return t if any property value actually changed, nil otherwise. */
1311 /* Note this can GC when DEST is a buffer. */
1314 copy_text_properties (start
, end
, src
, pos
, dest
, prop
)
1315 Lisp_Object start
, end
, src
, pos
, dest
, prop
;
1321 int s
, e
, e2
, p
, len
, modified
= 0;
1322 struct gcpro gcpro1
, gcpro2
;
1324 i
= validate_interval_range (src
, &start
, &end
, soft
);
1325 if (NULL_INTERVAL_P (i
))
1328 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
1330 Lisp_Object dest_start
, dest_end
;
1333 XSETFASTINT (dest_end
, XINT (dest_start
) + (XINT (end
) - XINT (start
)));
1334 /* Apply this to a copy of pos; it will try to increment its arguments,
1335 which we don't want. */
1336 validate_interval_range (dest
, &dest_start
, &dest_end
, soft
);
1347 e2
= i
->position
+ LENGTH (i
);
1354 while (! NILP (plist
))
1356 if (EQ (Fcar (plist
), prop
))
1358 plist
= Fcons (prop
, Fcons (Fcar (Fcdr (plist
)), Qnil
));
1361 plist
= Fcdr (Fcdr (plist
));
1365 /* Must defer modifications to the interval tree in case src
1366 and dest refer to the same string or buffer. */
1367 stuff
= Fcons (Fcons (make_number (p
),
1368 Fcons (make_number (p
+ len
),
1369 Fcons (plist
, Qnil
))),
1373 i
= next_interval (i
);
1374 if (NULL_INTERVAL_P (i
))
1381 GCPRO2 (stuff
, dest
);
1383 while (! NILP (stuff
))
1386 res
= Fadd_text_properties (Fcar (res
), Fcar (Fcdr (res
)),
1387 Fcar (Fcdr (Fcdr (res
))), dest
);
1390 stuff
= Fcdr (stuff
);
1395 return modified
? Qt
: Qnil
;
1401 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties
,
1402 "Property-list used as default values.\n\
1403 The value of a property in this list is seen as the value for every\n\
1404 character that does not have its own value for that property.");
1405 Vdefault_text_properties
= Qnil
;
1407 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks
,
1408 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1409 This also inhibits the use of the `intangible' text property.");
1410 Vinhibit_point_motion_hooks
= Qnil
;
1412 /* Common attributes one might give text */
1414 staticpro (&Qforeground
);
1415 Qforeground
= intern ("foreground");
1416 staticpro (&Qbackground
);
1417 Qbackground
= intern ("background");
1419 Qfont
= intern ("font");
1420 staticpro (&Qstipple
);
1421 Qstipple
= intern ("stipple");
1422 staticpro (&Qunderline
);
1423 Qunderline
= intern ("underline");
1424 staticpro (&Qread_only
);
1425 Qread_only
= intern ("read-only");
1426 staticpro (&Qinvisible
);
1427 Qinvisible
= intern ("invisible");
1428 staticpro (&Qintangible
);
1429 Qintangible
= intern ("intangible");
1430 staticpro (&Qcategory
);
1431 Qcategory
= intern ("category");
1432 staticpro (&Qlocal_map
);
1433 Qlocal_map
= intern ("local-map");
1434 staticpro (&Qfront_sticky
);
1435 Qfront_sticky
= intern ("front-sticky");
1436 staticpro (&Qrear_nonsticky
);
1437 Qrear_nonsticky
= intern ("rear-nonsticky");
1439 /* Properties that text might use to specify certain actions */
1441 staticpro (&Qmouse_left
);
1442 Qmouse_left
= intern ("mouse-left");
1443 staticpro (&Qmouse_entered
);
1444 Qmouse_entered
= intern ("mouse-entered");
1445 staticpro (&Qpoint_left
);
1446 Qpoint_left
= intern ("point-left");
1447 staticpro (&Qpoint_entered
);
1448 Qpoint_entered
= intern ("point-entered");
1450 defsubr (&Stext_properties_at
);
1451 defsubr (&Sget_text_property
);
1452 defsubr (&Sget_char_property
);
1453 defsubr (&Snext_property_change
);
1454 defsubr (&Snext_single_property_change
);
1455 defsubr (&Sprevious_property_change
);
1456 defsubr (&Sprevious_single_property_change
);
1457 defsubr (&Sadd_text_properties
);
1458 defsubr (&Sput_text_property
);
1459 defsubr (&Sset_text_properties
);
1460 defsubr (&Sremove_text_properties
);
1461 defsubr (&Stext_property_any
);
1462 defsubr (&Stext_property_not_all
);
1463 /* defsubr (&Serase_text_properties); */
1464 /* defsubr (&Scopy_text_properties); */
1469 lose
-- this shouldn
't be compiled if USE_TEXT_PROPERTIES isn't defined
1471 #endif /* USE_TEXT_PROPERTIES */