*** empty log message ***
[emacs.git] / src / textprop.c
blob5342cc2380f6b13cd59dfe6dcb3d81ae30ef8810
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 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)
9 any later version.
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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 #include <config.h>
22 #include "lisp.h"
23 #include "intervals.h"
24 #include "buffer.h"
25 #include "window.h"
27 #ifndef NULL
28 #define NULL (void *)0
29 #endif
31 /* Test for membership, allowing for t (actually any non-cons) to mean the
32 universal set. */
34 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
37 /* NOTES: previous- and next- property change will have to skip
38 zero-length intervals if they are implemented. This could be done
39 inside next_interval and previous_interval.
41 set_properties needs to deal with the interval property cache.
43 It is assumed that for any interval plist, a property appears
44 only once on the list. Although some code i.e., remove_properties,
45 handles the more general case, the uniqueness of properties is
46 necessary for the system to remain consistent. This requirement
47 is enforced by the subrs installing properties onto the intervals. */
50 /* Types of hooks. */
51 Lisp_Object Qmouse_left;
52 Lisp_Object Qmouse_entered;
53 Lisp_Object Qpoint_left;
54 Lisp_Object Qpoint_entered;
55 Lisp_Object Qcategory;
56 Lisp_Object Qlocal_map;
58 /* Visual properties text (including strings) may have. */
59 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
60 Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky, Qrear_nonsticky;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
67 traversing plists. */
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 Lisp_Object Vinhibit_point_motion_hooks;
71 Lisp_Object Vdefault_text_properties;
72 Lisp_Object Vtext_property_default_nonsticky;
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;
80 /* Signal a `text-read-only' error. This function makes it easier
81 to capture that error in GDB by putting a breakpoint on it. */
83 static void
84 text_read_only ()
86 Fsignal (Qtext_read_only, Qnil);
91 /* Extract the interval at the position pointed to by BEGIN from
92 OBJECT, a string or buffer. Additionally, check that the positions
93 pointed to by BEGIN and END are within the bounds of OBJECT, and
94 reverse them if *BEGIN is greater than *END. The objects pointed
95 to by BEGIN and END may be integers or markers; if the latter, they
96 are coerced to integers.
98 When OBJECT is a string, we increment *BEGIN and *END
99 to make them origin-one.
101 Note that buffer points don't correspond to interval indices.
102 For example, point-max is 1 greater than the index of the last
103 character. This difference is handled in the caller, which uses
104 the validated points to determine a length, and operates on that.
105 Exceptions are Ftext_properties_at, Fnext_property_change, and
106 Fprevious_property_change which call this function with BEGIN == END.
107 Handle this case specially.
109 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
110 create an interval tree for OBJECT if one doesn't exist, provided
111 the object actually contains text. In the current design, if there
112 is no text, there can be no text properties. */
114 #define soft 0
115 #define hard 1
117 INTERVAL
118 validate_interval_range (object, begin, end, force)
119 Lisp_Object object, *begin, *end;
120 int force;
122 register INTERVAL i;
123 int searchpos;
125 CHECK_STRING_OR_BUFFER (object, 0);
126 CHECK_NUMBER_COERCE_MARKER (*begin, 0);
127 CHECK_NUMBER_COERCE_MARKER (*end, 0);
129 /* If we are asked for a point, but from a subr which operates
130 on a range, then return nothing. */
131 if (EQ (*begin, *end) && begin != end)
132 return NULL_INTERVAL;
134 if (XINT (*begin) > XINT (*end))
136 Lisp_Object n;
137 n = *begin;
138 *begin = *end;
139 *end = n;
142 if (BUFFERP (object))
144 register struct buffer *b = XBUFFER (object);
146 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
147 && XINT (*end) <= BUF_ZV (b)))
148 args_out_of_range (*begin, *end);
149 i = BUF_INTERVALS (b);
151 /* If there's no text, there are no properties. */
152 if (BUF_BEGV (b) == BUF_ZV (b))
153 return NULL_INTERVAL;
155 searchpos = XINT (*begin);
157 else
159 register struct Lisp_String *s = XSTRING (object);
161 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
162 && XINT (*end) <= s->size))
163 args_out_of_range (*begin, *end);
164 XSETFASTINT (*begin, XFASTINT (*begin));
165 if (begin != end)
166 XSETFASTINT (*end, XFASTINT (*end));
167 i = s->intervals;
169 if (s->size == 0)
170 return NULL_INTERVAL;
172 searchpos = XINT (*begin);
175 if (NULL_INTERVAL_P (i))
176 return (force ? create_root_interval (object) : i);
178 return find_interval (i, searchpos);
181 /* Validate LIST as a property list. If LIST is not a list, then
182 make one consisting of (LIST nil). Otherwise, verify that LIST
183 is even numbered and thus suitable as a plist. */
185 static Lisp_Object
186 validate_plist (list)
187 Lisp_Object list;
189 if (NILP (list))
190 return Qnil;
192 if (CONSP (list))
194 register int i;
195 register Lisp_Object tail;
196 for (i = 0, tail = list; !NILP (tail); i++)
198 tail = Fcdr (tail);
199 QUIT;
201 if (i & 1)
202 error ("Odd length text property list");
203 return list;
206 return Fcons (list, Fcons (Qnil, Qnil));
209 /* Return nonzero if interval I has all the properties,
210 with the same values, of list PLIST. */
212 static int
213 interval_has_all_properties (plist, i)
214 Lisp_Object plist;
215 INTERVAL i;
217 register Lisp_Object tail1, tail2, sym1;
218 register int found;
220 /* Go through each element of PLIST. */
221 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
223 sym1 = Fcar (tail1);
224 found = 0;
226 /* Go through I's plist, looking for sym1 */
227 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
228 if (EQ (sym1, Fcar (tail2)))
230 /* Found the same property on both lists. If the
231 values are unequal, return zero. */
232 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
233 return 0;
235 /* Property has same value on both lists; go to next one. */
236 found = 1;
237 break;
240 if (! found)
241 return 0;
244 return 1;
247 /* Return nonzero if the plist of interval I has any of the
248 properties of PLIST, regardless of their values. */
250 static INLINE int
251 interval_has_some_properties (plist, i)
252 Lisp_Object plist;
253 INTERVAL i;
255 register Lisp_Object tail1, tail2, sym;
257 /* Go through each element of PLIST. */
258 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
260 sym = Fcar (tail1);
262 /* Go through i's plist, looking for tail1 */
263 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
264 if (EQ (sym, Fcar (tail2)))
265 return 1;
268 return 0;
271 /* Changing the plists of individual intervals. */
273 /* Return the value of PROP in property-list PLIST, or Qunbound if it
274 has none. */
275 static Lisp_Object
276 property_value (plist, prop)
277 Lisp_Object plist, prop;
279 Lisp_Object value;
281 while (PLIST_ELT_P (plist, value))
282 if (EQ (XCAR (plist), prop))
283 return XCAR (value);
284 else
285 plist = XCDR (value);
287 return Qunbound;
290 /* Set the properties of INTERVAL to PROPERTIES,
291 and record undo info for the previous values.
292 OBJECT is the string or buffer that INTERVAL belongs to. */
294 static void
295 set_properties (properties, interval, object)
296 Lisp_Object properties, object;
297 INTERVAL interval;
299 Lisp_Object sym, value;
301 if (BUFFERP (object))
303 /* For each property in the old plist which is missing from PROPERTIES,
304 or has a different value in PROPERTIES, make an undo record. */
305 for (sym = interval->plist;
306 PLIST_ELT_P (sym, value);
307 sym = XCDR (value))
308 if (! EQ (property_value (properties, XCAR (sym)),
309 XCAR (value)))
311 record_property_change (interval->position, LENGTH (interval),
312 XCAR (sym), XCAR (value),
313 object);
316 /* For each new property that has no value at all in the old plist,
317 make an undo record binding it to nil, so it will be removed. */
318 for (sym = properties;
319 PLIST_ELT_P (sym, value);
320 sym = XCDR (value))
321 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
323 record_property_change (interval->position, LENGTH (interval),
324 XCAR (sym), Qnil,
325 object);
329 /* Store new properties. */
330 interval->plist = Fcopy_sequence (properties);
333 /* Add the properties of PLIST to the interval I, or set
334 the value of I's property to the value of the property on PLIST
335 if they are different.
337 OBJECT should be the string or buffer the interval is in.
339 Return nonzero if this changes I (i.e., if any members of PLIST
340 are actually added to I's plist) */
342 static int
343 add_properties (plist, i, object)
344 Lisp_Object plist;
345 INTERVAL i;
346 Lisp_Object object;
348 Lisp_Object tail1, tail2, sym1, val1;
349 register int changed = 0;
350 register int found;
351 struct gcpro gcpro1, gcpro2, gcpro3;
353 tail1 = plist;
354 sym1 = Qnil;
355 val1 = Qnil;
356 /* No need to protect OBJECT, because we can GC only in the case
357 where it is a buffer, and live buffers are always protected.
358 I and its plist are also protected, via OBJECT. */
359 GCPRO3 (tail1, sym1, val1);
361 /* Go through each element of PLIST. */
362 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
364 sym1 = Fcar (tail1);
365 val1 = Fcar (Fcdr (tail1));
366 found = 0;
368 /* Go through I's plist, looking for sym1 */
369 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
370 if (EQ (sym1, Fcar (tail2)))
372 /* No need to gcpro, because tail2 protects this
373 and it must be a cons cell (we get an error otherwise). */
374 register Lisp_Object this_cdr;
376 this_cdr = Fcdr (tail2);
377 /* Found the property. Now check its value. */
378 found = 1;
380 /* The properties have the same value on both lists.
381 Continue to the next property. */
382 if (EQ (val1, Fcar (this_cdr)))
383 break;
385 /* Record this change in the buffer, for undo purposes. */
386 if (BUFFERP (object))
388 record_property_change (i->position, LENGTH (i),
389 sym1, Fcar (this_cdr), object);
392 /* I's property has a different value -- change it */
393 Fsetcar (this_cdr, val1);
394 changed++;
395 break;
398 if (! found)
400 /* Record this change in the buffer, for undo purposes. */
401 if (BUFFERP (object))
403 record_property_change (i->position, LENGTH (i),
404 sym1, Qnil, object);
406 i->plist = Fcons (sym1, Fcons (val1, i->plist));
407 changed++;
411 UNGCPRO;
413 return changed;
416 /* For any members of PLIST which are properties of I, remove them
417 from I's plist.
418 OBJECT is the string or buffer containing I. */
420 static int
421 remove_properties (plist, i, object)
422 Lisp_Object plist;
423 INTERVAL i;
424 Lisp_Object object;
426 register Lisp_Object tail1, tail2, sym, current_plist;
427 register int changed = 0;
429 current_plist = i->plist;
430 /* Go through each element of plist. */
431 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
433 sym = Fcar (tail1);
435 /* First, remove the symbol if its at the head of the list */
436 while (! NILP (current_plist) && EQ (sym, Fcar (current_plist)))
438 if (BUFFERP (object))
440 record_property_change (i->position, LENGTH (i),
441 sym, Fcar (Fcdr (current_plist)),
442 object);
445 current_plist = Fcdr (Fcdr (current_plist));
446 changed++;
449 /* Go through i's plist, looking for sym */
450 tail2 = current_plist;
451 while (! NILP (tail2))
453 register Lisp_Object this;
454 this = Fcdr (Fcdr (tail2));
455 if (EQ (sym, Fcar (this)))
457 if (BUFFERP (object))
459 record_property_change (i->position, LENGTH (i),
460 sym, Fcar (Fcdr (this)), object);
463 Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this)));
464 changed++;
466 tail2 = this;
470 if (changed)
471 i->plist = current_plist;
472 return changed;
475 #if 0
476 /* Remove all properties from interval I. Return non-zero
477 if this changes the interval. */
479 static INLINE int
480 erase_properties (i)
481 INTERVAL i;
483 if (NILP (i->plist))
484 return 0;
486 i->plist = Qnil;
487 return 1;
489 #endif
491 /* Returns the interval of POSITION in OBJECT.
492 POSITION is BEG-based. */
494 INTERVAL
495 interval_of (position, object)
496 int position;
497 Lisp_Object object;
499 register INTERVAL i;
500 int beg, end;
502 if (NILP (object))
503 XSETBUFFER (object, current_buffer);
504 else if (EQ (object, Qt))
505 return NULL_INTERVAL;
507 CHECK_STRING_OR_BUFFER (object, 0);
509 if (BUFFERP (object))
511 register struct buffer *b = XBUFFER (object);
513 beg = BUF_BEGV (b);
514 end = BUF_ZV (b);
515 i = BUF_INTERVALS (b);
517 else
519 register struct Lisp_String *s = XSTRING (object);
521 beg = 0;
522 end = s->size;
523 i = s->intervals;
526 if (!(beg <= position && position <= end))
527 args_out_of_range (make_number (position), make_number (position));
528 if (beg == end || NULL_INTERVAL_P (i))
529 return NULL_INTERVAL;
531 return find_interval (i, position);
534 DEFUN ("text-properties-at", Ftext_properties_at,
535 Stext_properties_at, 1, 2, 0,
536 "Return the list of properties of the character at POSITION in OBJECT.\n\
537 OBJECT is the string or buffer to look for the properties in;\n\
538 nil means the current buffer.\n\
539 If POSITION is at the end of OBJECT, the value is nil.")
540 (position, object)
541 Lisp_Object position, object;
543 register INTERVAL i;
545 if (NILP (object))
546 XSETBUFFER (object, current_buffer);
548 i = validate_interval_range (object, &position, &position, soft);
549 if (NULL_INTERVAL_P (i))
550 return Qnil;
551 /* If POSITION is at the end of the interval,
552 it means it's the end of OBJECT.
553 There are no properties at the very end,
554 since no character follows. */
555 if (XINT (position) == LENGTH (i) + i->position)
556 return Qnil;
558 return i->plist;
561 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
562 "Return the value of POSITION's property PROP, in OBJECT.\n\
563 OBJECT is optional and defaults to the current buffer.\n\
564 If POSITION is at the end of OBJECT, the value is nil.")
565 (position, prop, object)
566 Lisp_Object position, object;
567 Lisp_Object prop;
569 return textget (Ftext_properties_at (position, object), prop);
572 /* Return the value of POSITION's property PROP, in OBJECT.
573 OBJECT is optional and defaults to the current buffer.
574 If OVERLAY is non-0, then in the case that the returned property is from
575 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
576 returned in *OVERLAY.
577 If POSITION is at the end of OBJECT, the value is nil.
578 If OBJECT is a buffer, then overlay properties are considered as well as
579 text properties.
580 If OBJECT is a window, then that window's buffer is used, but
581 window-specific overlays are considered only if they are associated
582 with OBJECT. */
583 Lisp_Object
584 get_char_property_and_overlay (position, prop, object, overlay)
585 Lisp_Object position, object;
586 register Lisp_Object prop;
587 Lisp_Object *overlay;
589 struct window *w = 0;
591 CHECK_NUMBER_COERCE_MARKER (position, 0);
593 if (NILP (object))
594 XSETBUFFER (object, current_buffer);
596 if (WINDOWP (object))
598 w = XWINDOW (object);
599 object = w->buffer;
601 if (BUFFERP (object))
603 int posn = XINT (position);
604 int noverlays;
605 Lisp_Object *overlay_vec, tem;
606 int next_overlay;
607 int len;
608 struct buffer *obuf = current_buffer;
610 set_buffer_temp (XBUFFER (object));
612 /* First try with room for 40 overlays. */
613 len = 40;
614 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
616 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
617 &next_overlay, NULL, 0);
619 /* If there are more than 40,
620 make enough space for all, and try again. */
621 if (noverlays > len)
623 len = noverlays;
624 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
625 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
626 &next_overlay, NULL, 0);
628 noverlays = sort_overlays (overlay_vec, noverlays, w);
630 set_buffer_temp (obuf);
632 /* Now check the overlays in order of decreasing priority. */
633 while (--noverlays >= 0)
635 tem = Foverlay_get (overlay_vec[noverlays], prop);
636 if (!NILP (tem))
638 if (overlay)
639 /* Return the overlay we got the property from. */
640 *overlay = overlay_vec[noverlays];
641 return tem;
646 if (overlay)
647 /* Indicate that the return value is not from an overlay. */
648 *overlay = Qnil;
650 /* Not a buffer, or no appropriate overlay, so fall through to the
651 simpler case. */
652 return Fget_text_property (position, prop, object);
655 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
656 "Return the value of POSITION's property PROP, in OBJECT.\n\
657 OBJECT is optional and defaults to the current buffer.\n\
658 If POSITION is at the end of OBJECT, the value is nil.\n\
659 If OBJECT is a buffer, then overlay properties are considered as well as\n\
660 text properties.\n\
661 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
662 overlays are considered only if they are associated with OBJECT.")
663 (position, prop, object)
664 Lisp_Object position, object;
665 register Lisp_Object prop;
667 return get_char_property_and_overlay (position, prop, object, 0);
670 DEFUN ("next-char-property-change", Fnext_char_property_change,
671 Snext_char_property_change, 1, 2, 0,
672 "Return the position of next text property or overlay change.\n\
673 This scans characters forward from POSITION in OBJECT till it finds\n\
674 a change in some text property, or the beginning or end of an overlay,\n\
675 and returns the position of that.\n\
676 If none is found, the function returns (point-max).\n\
678 If the optional third argument LIMIT is non-nil, don't search\n\
679 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
680 (position, limit)
681 Lisp_Object position, limit;
683 Lisp_Object temp;
685 temp = Fnext_overlay_change (position);
686 if (! NILP (limit))
688 CHECK_NUMBER (limit, 2);
689 if (XINT (limit) < XINT (temp))
690 temp = limit;
692 return Fnext_property_change (position, Qnil, temp);
695 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
696 Sprevious_char_property_change, 1, 2, 0,
697 "Return the position of previous text property or overlay change.\n\
698 Scans characters backward from POSITION in OBJECT till it finds\n\
699 a change in some text property, or the beginning or end of an overlay,\n\
700 and returns the position of that.\n\
701 If none is found, the function returns (point-max).\n\
703 If the optional third argument LIMIT is non-nil, don't search\n\
704 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
705 (position, limit)
706 Lisp_Object position, limit;
708 Lisp_Object temp;
710 temp = Fprevious_overlay_change (position);
711 if (! NILP (limit))
713 CHECK_NUMBER (limit, 2);
714 if (XINT (limit) > XINT (temp))
715 temp = limit;
717 return Fprevious_property_change (position, Qnil, temp);
721 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
722 Snext_single_char_property_change, 2, 4, 0,
723 "Return the position of next text property or overlay change for a specific property.\n\
724 Scans characters forward from POSITION till it finds\n\
725 a change in the PROP property, then returns the position of the change.\n\
726 The optional third argument OBJECT is the string or buffer to scan.\n\
727 The property values are compared with `eq'.\n\
728 Return nil if the property is constant all the way to the end of OBJECT.\n\
729 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
730 If the optional fourth argument LIMIT is non-nil, don't search\n\
731 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
732 (position, prop, object, limit)
733 Lisp_Object prop, position, object, limit;
735 if (STRINGP (object))
737 position = Fnext_single_property_change (position, prop, object, limit);
738 if (NILP (position))
740 if (NILP (limit))
741 position = make_number (XSTRING (object)->size);
742 else
743 position = limit;
746 else
748 Lisp_Object initial_value, value;
749 int count = specpdl_ptr - specpdl;
751 if (! NILP (object))
752 CHECK_BUFFER (object, 0);
754 if (BUFFERP (object) && current_buffer != XBUFFER (object))
756 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
757 Fset_buffer (object);
760 initial_value = Fget_char_property (position, prop, object);
762 if (NILP (limit))
763 XSETFASTINT (limit, BUF_ZV (current_buffer));
764 else
765 CHECK_NUMBER_COERCE_MARKER (limit, 0);
767 for (;;)
769 position = Fnext_char_property_change (position, limit);
770 if (XFASTINT (position) >= XFASTINT (limit)) {
771 position = limit;
772 break;
775 value = Fget_char_property (position, prop, object);
776 if (!EQ (value, initial_value))
777 break;
780 unbind_to (count, Qnil);
783 return position;
786 DEFUN ("previous-single-char-property-change",
787 Fprevious_single_char_property_change,
788 Sprevious_single_char_property_change, 2, 4, 0,
789 "Return the position of previous text property or overlay change for a specific property.\n\
790 Scans characters backward from POSITION till it finds\n\
791 a change in the PROP property, then returns the position of the change.\n\
792 The optional third argument OBJECT is the string or buffer to scan.\n\
793 The property values are compared with `eq'.\n\
794 Return nil if the property is constant all the way to the start of OBJECT.\n\
795 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
796 If the optional fourth argument LIMIT is non-nil, don't search\n\
797 back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
798 (position, prop, object, limit)
799 Lisp_Object prop, position, object, limit;
801 if (STRINGP (object))
803 position = Fprevious_single_property_change (position, prop, object, limit);
804 if (NILP (position))
806 if (NILP (limit))
807 position = make_number (XSTRING (object)->size);
808 else
809 position = limit;
812 else
814 int count = specpdl_ptr - specpdl;
816 if (! NILP (object))
817 CHECK_BUFFER (object, 0);
819 if (BUFFERP (object) && current_buffer != XBUFFER (object))
821 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
822 Fset_buffer (object);
825 if (NILP (limit))
826 XSETFASTINT (limit, BUF_BEGV (current_buffer));
827 else
828 CHECK_NUMBER_COERCE_MARKER (limit, 0);
830 if (XFASTINT (position) <= XFASTINT (limit))
831 position = limit;
832 else
834 Lisp_Object initial_value =
835 Fget_char_property (make_number (XFASTINT (position) - 1),
836 prop, object);
838 for (;;)
840 position = Fprevious_char_property_change (position, limit);
842 if (XFASTINT (position) <= XFASTINT (limit))
844 position = limit;
845 break;
847 else
849 Lisp_Object value =
850 Fget_char_property (make_number (XFASTINT (position) - 1),
851 prop, object);
853 if (!EQ (value, initial_value))
854 break;
859 unbind_to (count, Qnil);
862 return position;
865 DEFUN ("next-property-change", Fnext_property_change,
866 Snext_property_change, 1, 3, 0,
867 "Return the position of next property change.\n\
868 Scans characters forward from POSITION in OBJECT till it finds\n\
869 a change in some text property, then returns the position of the change.\n\
870 The optional second argument OBJECT is the string or buffer to scan.\n\
871 Return nil if the property is constant all the way to the end of OBJECT.\n\
872 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
873 If the optional third argument LIMIT is non-nil, don't search\n\
874 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
875 (position, object, limit)
876 Lisp_Object position, object, limit;
878 register INTERVAL i, next;
880 if (NILP (object))
881 XSETBUFFER (object, current_buffer);
883 if (! NILP (limit) && ! EQ (limit, Qt))
884 CHECK_NUMBER_COERCE_MARKER (limit, 0);
886 i = validate_interval_range (object, &position, &position, soft);
888 /* If LIMIT is t, return start of next interval--don't
889 bother checking further intervals. */
890 if (EQ (limit, Qt))
892 if (NULL_INTERVAL_P (i))
893 next = i;
894 else
895 next = next_interval (i);
897 if (NULL_INTERVAL_P (next))
898 XSETFASTINT (position, (STRINGP (object)
899 ? XSTRING (object)->size
900 : BUF_ZV (XBUFFER (object))));
901 else
902 XSETFASTINT (position, next->position);
903 return position;
906 if (NULL_INTERVAL_P (i))
907 return limit;
909 next = next_interval (i);
911 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
912 && (NILP (limit) || next->position < XFASTINT (limit)))
913 next = next_interval (next);
915 if (NULL_INTERVAL_P (next))
916 return limit;
917 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
918 return limit;
920 XSETFASTINT (position, next->position);
921 return position;
924 /* Return 1 if there's a change in some property between BEG and END. */
927 property_change_between_p (beg, end)
928 int beg, end;
930 register INTERVAL i, next;
931 Lisp_Object object, pos;
933 XSETBUFFER (object, current_buffer);
934 XSETFASTINT (pos, beg);
936 i = validate_interval_range (object, &pos, &pos, soft);
937 if (NULL_INTERVAL_P (i))
938 return 0;
940 next = next_interval (i);
941 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
943 next = next_interval (next);
944 if (NULL_INTERVAL_P (next))
945 return 0;
946 if (next->position >= end)
947 return 0;
950 if (NULL_INTERVAL_P (next))
951 return 0;
953 return 1;
956 DEFUN ("next-single-property-change", Fnext_single_property_change,
957 Snext_single_property_change, 2, 4, 0,
958 "Return the position of next property change for a specific property.\n\
959 Scans characters forward from POSITION till it finds\n\
960 a change in the PROP property, then returns the position of the change.\n\
961 The optional third argument OBJECT is the string or buffer to scan.\n\
962 The property values are compared with `eq'.\n\
963 Return nil if the property is constant all the way to the end of OBJECT.\n\
964 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
965 If the optional fourth argument LIMIT is non-nil, don't search\n\
966 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
967 (position, prop, object, limit)
968 Lisp_Object position, prop, object, limit;
970 register INTERVAL i, next;
971 register Lisp_Object here_val;
973 if (NILP (object))
974 XSETBUFFER (object, current_buffer);
976 if (!NILP (limit))
977 CHECK_NUMBER_COERCE_MARKER (limit, 0);
979 i = validate_interval_range (object, &position, &position, soft);
980 if (NULL_INTERVAL_P (i))
981 return limit;
983 here_val = textget (i->plist, prop);
984 next = next_interval (i);
985 while (! NULL_INTERVAL_P (next)
986 && EQ (here_val, textget (next->plist, prop))
987 && (NILP (limit) || next->position < XFASTINT (limit)))
988 next = next_interval (next);
990 if (NULL_INTERVAL_P (next))
991 return limit;
992 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
993 return limit;
995 return make_number (next->position);
998 DEFUN ("previous-property-change", Fprevious_property_change,
999 Sprevious_property_change, 1, 3, 0,
1000 "Return the position of previous property change.\n\
1001 Scans characters backwards from POSITION in OBJECT till it finds\n\
1002 a change in some text property, then returns the position of the change.\n\
1003 The optional second argument OBJECT is the string or buffer to scan.\n\
1004 Return nil if the property is constant all the way to the start of OBJECT.\n\
1005 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
1006 If the optional third argument LIMIT is non-nil, don't search\n\
1007 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
1008 (position, object, limit)
1009 Lisp_Object position, object, limit;
1011 register INTERVAL i, previous;
1013 if (NILP (object))
1014 XSETBUFFER (object, current_buffer);
1016 if (!NILP (limit))
1017 CHECK_NUMBER_COERCE_MARKER (limit, 0);
1019 i = validate_interval_range (object, &position, &position, soft);
1020 if (NULL_INTERVAL_P (i))
1021 return limit;
1023 /* Start with the interval containing the char before point. */
1024 if (i->position == XFASTINT (position))
1025 i = previous_interval (i);
1027 previous = previous_interval (i);
1028 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
1029 && (NILP (limit)
1030 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1031 previous = previous_interval (previous);
1032 if (NULL_INTERVAL_P (previous))
1033 return limit;
1034 if (!NILP (limit)
1035 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
1036 return limit;
1038 return make_number (previous->position + LENGTH (previous));
1041 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1042 Sprevious_single_property_change, 2, 4, 0,
1043 "Return the position of previous property change for a specific property.\n\
1044 Scans characters backward from POSITION till it finds\n\
1045 a change in the PROP property, then returns the position of the change.\n\
1046 The optional third argument OBJECT is the string or buffer to scan.\n\
1047 The property values are compared with `eq'.\n\
1048 Return nil if the property is constant all the way to the start of OBJECT.\n\
1049 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
1050 If the optional fourth argument LIMIT is non-nil, don't search\n\
1051 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
1052 (position, prop, object, limit)
1053 Lisp_Object position, prop, object, limit;
1055 register INTERVAL i, previous;
1056 register Lisp_Object here_val;
1058 if (NILP (object))
1059 XSETBUFFER (object, current_buffer);
1061 if (!NILP (limit))
1062 CHECK_NUMBER_COERCE_MARKER (limit, 0);
1064 i = validate_interval_range (object, &position, &position, soft);
1066 /* Start with the interval containing the char before point. */
1067 if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (position))
1068 i = previous_interval (i);
1070 if (NULL_INTERVAL_P (i))
1071 return limit;
1073 here_val = textget (i->plist, prop);
1074 previous = previous_interval (i);
1075 while (! NULL_INTERVAL_P (previous)
1076 && EQ (here_val, textget (previous->plist, prop))
1077 && (NILP (limit)
1078 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1079 previous = previous_interval (previous);
1080 if (NULL_INTERVAL_P (previous))
1081 return limit;
1082 if (!NILP (limit)
1083 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
1084 return limit;
1086 return make_number (previous->position + LENGTH (previous));
1089 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1091 DEFUN ("add-text-properties", Fadd_text_properties,
1092 Sadd_text_properties, 3, 4, 0,
1093 "Add properties to the text from START to END.\n\
1094 The third argument PROPERTIES is a property list\n\
1095 specifying the property values to add.\n\
1096 The optional fourth argument, OBJECT,\n\
1097 is the string or buffer containing the text.\n\
1098 Return t if any property value actually changed, nil otherwise.")
1099 (start, end, properties, object)
1100 Lisp_Object start, end, properties, object;
1102 register INTERVAL i, unchanged;
1103 register int s, len, modified = 0;
1104 struct gcpro gcpro1;
1106 properties = validate_plist (properties);
1107 if (NILP (properties))
1108 return Qnil;
1110 if (NILP (object))
1111 XSETBUFFER (object, current_buffer);
1113 i = validate_interval_range (object, &start, &end, hard);
1114 if (NULL_INTERVAL_P (i))
1115 return Qnil;
1117 s = XINT (start);
1118 len = XINT (end) - s;
1120 /* No need to protect OBJECT, because we GC only if it's a buffer,
1121 and live buffers are always protected. */
1122 GCPRO1 (properties);
1124 /* If we're not starting on an interval boundary, we have to
1125 split this interval. */
1126 if (i->position != s)
1128 /* If this interval already has the properties, we can
1129 skip it. */
1130 if (interval_has_all_properties (properties, i))
1132 int got = (LENGTH (i) - (s - i->position));
1133 if (got >= len)
1134 RETURN_UNGCPRO (Qnil);
1135 len -= got;
1136 i = next_interval (i);
1138 else
1140 unchanged = i;
1141 i = split_interval_right (unchanged, s - unchanged->position);
1142 copy_properties (unchanged, i);
1146 if (BUFFERP (object))
1147 modify_region (XBUFFER (object), XINT (start), XINT (end));
1149 /* We are at the beginning of interval I, with LEN chars to scan. */
1150 for (;;)
1152 if (i == 0)
1153 abort ();
1155 if (LENGTH (i) >= len)
1157 /* We can UNGCPRO safely here, because there will be just
1158 one more chance to gc, in the next call to add_properties,
1159 and after that we will not need PROPERTIES or OBJECT again. */
1160 UNGCPRO;
1162 if (interval_has_all_properties (properties, i))
1164 if (BUFFERP (object))
1165 signal_after_change (XINT (start), XINT (end) - XINT (start),
1166 XINT (end) - XINT (start));
1168 return modified ? Qt : Qnil;
1171 if (LENGTH (i) == len)
1173 add_properties (properties, i, object);
1174 if (BUFFERP (object))
1175 signal_after_change (XINT (start), XINT (end) - XINT (start),
1176 XINT (end) - XINT (start));
1177 return Qt;
1180 /* i doesn't have the properties, and goes past the change limit */
1181 unchanged = i;
1182 i = split_interval_left (unchanged, len);
1183 copy_properties (unchanged, i);
1184 add_properties (properties, i, object);
1185 if (BUFFERP (object))
1186 signal_after_change (XINT (start), XINT (end) - XINT (start),
1187 XINT (end) - XINT (start));
1188 return Qt;
1191 len -= LENGTH (i);
1192 modified += add_properties (properties, i, object);
1193 i = next_interval (i);
1197 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1199 DEFUN ("put-text-property", Fput_text_property,
1200 Sput_text_property, 4, 5, 0,
1201 "Set one property of the text from START to END.\n\
1202 The third and fourth arguments PROPERTY and VALUE\n\
1203 specify the property to add.\n\
1204 The optional fifth argument, OBJECT,\n\
1205 is the string or buffer containing the text.")
1206 (start, end, property, value, object)
1207 Lisp_Object start, end, property, value, object;
1209 Fadd_text_properties (start, end,
1210 Fcons (property, Fcons (value, Qnil)),
1211 object);
1212 return Qnil;
1215 DEFUN ("set-text-properties", Fset_text_properties,
1216 Sset_text_properties, 3, 4, 0,
1217 "Completely replace properties of text from START to END.\n\
1218 The third argument PROPERTIES is the new property list.\n\
1219 The optional fourth argument, OBJECT,\n\
1220 is the string or buffer containing the text.")
1221 (start, end, properties, object)
1222 Lisp_Object start, end, properties, object;
1224 return set_text_properties (start, end, properties, object, Qt);
1228 /* Replace properties of text from START to END with new list of
1229 properties PROPERTIES. OBJECT is the buffer or string containing
1230 the text. OBJECT nil means use the current buffer.
1231 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1232 is non-nil if properties were replaced; it is nil if there weren't
1233 any properties to replace. */
1235 Lisp_Object
1236 set_text_properties (start, end, properties, object, signal_after_change_p)
1237 Lisp_Object start, end, properties, object, signal_after_change_p;
1239 register INTERVAL i, unchanged;
1240 register INTERVAL prev_changed = NULL_INTERVAL;
1241 register int s, len;
1242 Lisp_Object ostart, oend;
1244 ostart = start;
1245 oend = end;
1247 properties = validate_plist (properties);
1249 if (NILP (object))
1250 XSETBUFFER (object, current_buffer);
1252 /* If we want no properties for a whole string,
1253 get rid of its intervals. */
1254 if (NILP (properties) && STRINGP (object)
1255 && XFASTINT (start) == 0
1256 && XFASTINT (end) == XSTRING (object)->size)
1258 if (! XSTRING (object)->intervals)
1259 return Qt;
1261 XSTRING (object)->intervals = 0;
1262 return Qt;
1265 i = validate_interval_range (object, &start, &end, soft);
1267 if (NULL_INTERVAL_P (i))
1269 /* If buffer has no properties, and we want none, return now. */
1270 if (NILP (properties))
1271 return Qnil;
1273 /* Restore the original START and END values
1274 because validate_interval_range increments them for strings. */
1275 start = ostart;
1276 end = oend;
1278 i = validate_interval_range (object, &start, &end, hard);
1279 /* This can return if start == end. */
1280 if (NULL_INTERVAL_P (i))
1281 return Qnil;
1284 s = XINT (start);
1285 len = XINT (end) - s;
1287 if (BUFFERP (object))
1288 modify_region (XBUFFER (object), XINT (start), XINT (end));
1290 if (i->position != s)
1292 unchanged = i;
1293 i = split_interval_right (unchanged, s - unchanged->position);
1295 if (LENGTH (i) > len)
1297 copy_properties (unchanged, i);
1298 i = split_interval_left (i, len);
1299 set_properties (properties, i, object);
1300 if (BUFFERP (object) && !NILP (signal_after_change_p))
1301 signal_after_change (XINT (start), XINT (end) - XINT (start),
1302 XINT (end) - XINT (start));
1304 return Qt;
1307 set_properties (properties, i, object);
1309 if (LENGTH (i) == len)
1311 if (BUFFERP (object) && !NILP (signal_after_change_p))
1312 signal_after_change (XINT (start), XINT (end) - XINT (start),
1313 XINT (end) - XINT (start));
1315 return Qt;
1318 prev_changed = i;
1319 len -= LENGTH (i);
1320 i = next_interval (i);
1323 /* We are starting at the beginning of an interval, I */
1324 while (len > 0)
1326 if (i == 0)
1327 abort ();
1329 if (LENGTH (i) >= len)
1331 if (LENGTH (i) > len)
1332 i = split_interval_left (i, len);
1334 /* We have to call set_properties even if we are going to
1335 merge the intervals, so as to make the undo records
1336 and cause redisplay to happen. */
1337 set_properties (properties, i, object);
1338 if (!NULL_INTERVAL_P (prev_changed))
1339 merge_interval_left (i);
1340 if (BUFFERP (object) && !NILP (signal_after_change_p))
1341 signal_after_change (XINT (start), XINT (end) - XINT (start),
1342 XINT (end) - XINT (start));
1343 return Qt;
1346 len -= LENGTH (i);
1348 /* We have to call set_properties even if we are going to
1349 merge the intervals, so as to make the undo records
1350 and cause redisplay to happen. */
1351 set_properties (properties, i, object);
1352 if (NULL_INTERVAL_P (prev_changed))
1353 prev_changed = i;
1354 else
1355 prev_changed = i = merge_interval_left (i);
1357 i = next_interval (i);
1360 if (BUFFERP (object) && !NILP (signal_after_change_p))
1361 signal_after_change (XINT (start), XINT (end) - XINT (start),
1362 XINT (end) - XINT (start));
1363 return Qt;
1366 DEFUN ("remove-text-properties", Fremove_text_properties,
1367 Sremove_text_properties, 3, 4, 0,
1368 "Remove some properties from text from START to END.\n\
1369 The third argument PROPERTIES is a property list\n\
1370 whose property names specify the properties to remove.\n\
1371 \(The values stored in PROPERTIES are ignored.)\n\
1372 The optional fourth argument, OBJECT,\n\
1373 is the string or buffer containing the text.\n\
1374 Return t if any property was actually removed, nil otherwise.")
1375 (start, end, properties, object)
1376 Lisp_Object start, end, properties, object;
1378 register INTERVAL i, unchanged;
1379 register int s, len, modified = 0;
1381 if (NILP (object))
1382 XSETBUFFER (object, current_buffer);
1384 i = validate_interval_range (object, &start, &end, soft);
1385 if (NULL_INTERVAL_P (i))
1386 return Qnil;
1388 s = XINT (start);
1389 len = XINT (end) - s;
1391 if (i->position != s)
1393 /* No properties on this first interval -- return if
1394 it covers the entire region. */
1395 if (! interval_has_some_properties (properties, i))
1397 int got = (LENGTH (i) - (s - i->position));
1398 if (got >= len)
1399 return Qnil;
1400 len -= got;
1401 i = next_interval (i);
1403 /* Split away the beginning of this interval; what we don't
1404 want to modify. */
1405 else
1407 unchanged = i;
1408 i = split_interval_right (unchanged, s - unchanged->position);
1409 copy_properties (unchanged, i);
1413 if (BUFFERP (object))
1414 modify_region (XBUFFER (object), XINT (start), XINT (end));
1416 /* We are at the beginning of an interval, with len to scan */
1417 for (;;)
1419 if (i == 0)
1420 abort ();
1422 if (LENGTH (i) >= len)
1424 if (! interval_has_some_properties (properties, i))
1425 return modified ? Qt : Qnil;
1427 if (LENGTH (i) == len)
1429 remove_properties (properties, i, object);
1430 if (BUFFERP (object))
1431 signal_after_change (XINT (start), XINT (end) - XINT (start),
1432 XINT (end) - XINT (start));
1433 return Qt;
1436 /* i has the properties, and goes past the change limit */
1437 unchanged = i;
1438 i = split_interval_left (i, len);
1439 copy_properties (unchanged, i);
1440 remove_properties (properties, i, object);
1441 if (BUFFERP (object))
1442 signal_after_change (XINT (start), XINT (end) - XINT (start),
1443 XINT (end) - XINT (start));
1444 return Qt;
1447 len -= LENGTH (i);
1448 modified += remove_properties (properties, i, object);
1449 i = next_interval (i);
1453 DEFUN ("text-property-any", Ftext_property_any,
1454 Stext_property_any, 4, 5, 0,
1455 "Check text from START to END for property PROPERTY equalling VALUE.\n\
1456 If so, return the position of the first character whose property PROPERTY\n\
1457 is `eq' to VALUE. Otherwise return nil.\n\
1458 The optional fifth argument, OBJECT, is the string or buffer\n\
1459 containing the text.")
1460 (start, end, property, value, object)
1461 Lisp_Object start, end, property, value, object;
1463 register INTERVAL i;
1464 register int e, pos;
1466 if (NILP (object))
1467 XSETBUFFER (object, current_buffer);
1468 i = validate_interval_range (object, &start, &end, soft);
1469 if (NULL_INTERVAL_P (i))
1470 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1471 e = XINT (end);
1473 while (! NULL_INTERVAL_P (i))
1475 if (i->position >= e)
1476 break;
1477 if (EQ (textget (i->plist, property), value))
1479 pos = i->position;
1480 if (pos < XINT (start))
1481 pos = XINT (start);
1482 return make_number (pos);
1484 i = next_interval (i);
1486 return Qnil;
1489 DEFUN ("text-property-not-all", Ftext_property_not_all,
1490 Stext_property_not_all, 4, 5, 0,
1491 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
1492 If so, return the position of the first character whose property PROPERTY\n\
1493 is not `eq' to VALUE. Otherwise, return nil.\n\
1494 The optional fifth argument, OBJECT, is the string or buffer\n\
1495 containing the text.")
1496 (start, end, property, value, object)
1497 Lisp_Object start, end, property, value, object;
1499 register INTERVAL i;
1500 register int s, e;
1502 if (NILP (object))
1503 XSETBUFFER (object, current_buffer);
1504 i = validate_interval_range (object, &start, &end, soft);
1505 if (NULL_INTERVAL_P (i))
1506 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1507 s = XINT (start);
1508 e = XINT (end);
1510 while (! NULL_INTERVAL_P (i))
1512 if (i->position >= e)
1513 break;
1514 if (! EQ (textget (i->plist, property), value))
1516 if (i->position > s)
1517 s = i->position;
1518 return make_number (s);
1520 i = next_interval (i);
1522 return Qnil;
1525 /* I don't think this is the right interface to export; how often do you
1526 want to do something like this, other than when you're copying objects
1527 around?
1529 I think it would be better to have a pair of functions, one which
1530 returns the text properties of a region as a list of ranges and
1531 plists, and another which applies such a list to another object. */
1533 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1534 SRC and DEST may each refer to strings or buffers.
1535 Optional sixth argument PROP causes only that property to be copied.
1536 Properties are copied to DEST as if by `add-text-properties'.
1537 Return t if any property value actually changed, nil otherwise. */
1539 /* Note this can GC when DEST is a buffer. */
1541 Lisp_Object
1542 copy_text_properties (start, end, src, pos, dest, prop)
1543 Lisp_Object start, end, src, pos, dest, prop;
1545 INTERVAL i;
1546 Lisp_Object res;
1547 Lisp_Object stuff;
1548 Lisp_Object plist;
1549 int s, e, e2, p, len, modified = 0;
1550 struct gcpro gcpro1, gcpro2;
1552 i = validate_interval_range (src, &start, &end, soft);
1553 if (NULL_INTERVAL_P (i))
1554 return Qnil;
1556 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1558 Lisp_Object dest_start, dest_end;
1560 dest_start = pos;
1561 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
1562 /* Apply this to a copy of pos; it will try to increment its arguments,
1563 which we don't want. */
1564 validate_interval_range (dest, &dest_start, &dest_end, soft);
1567 s = XINT (start);
1568 e = XINT (end);
1569 p = XINT (pos);
1571 stuff = Qnil;
1573 while (s < e)
1575 e2 = i->position + LENGTH (i);
1576 if (e2 > e)
1577 e2 = e;
1578 len = e2 - s;
1580 plist = i->plist;
1581 if (! NILP (prop))
1582 while (! NILP (plist))
1584 if (EQ (Fcar (plist), prop))
1586 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1587 break;
1589 plist = Fcdr (Fcdr (plist));
1591 if (! NILP (plist))
1593 /* Must defer modifications to the interval tree in case src
1594 and dest refer to the same string or buffer. */
1595 stuff = Fcons (Fcons (make_number (p),
1596 Fcons (make_number (p + len),
1597 Fcons (plist, Qnil))),
1598 stuff);
1601 i = next_interval (i);
1602 if (NULL_INTERVAL_P (i))
1603 break;
1605 p += len;
1606 s = i->position;
1609 GCPRO2 (stuff, dest);
1611 while (! NILP (stuff))
1613 res = Fcar (stuff);
1614 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1615 Fcar (Fcdr (Fcdr (res))), dest);
1616 if (! NILP (res))
1617 modified++;
1618 stuff = Fcdr (stuff);
1621 UNGCPRO;
1623 return modified ? Qt : Qnil;
1627 /* Return a list representing the text properties of OBJECT between
1628 START and END. if PROP is non-nil, report only on that property.
1629 Each result list element has the form (S E PLIST), where S and E
1630 are positions in OBJECT and PLIST is a property list containing the
1631 text properties of OBJECT between S and E. Value is nil if OBJECT
1632 doesn't contain text properties between START and END. */
1634 Lisp_Object
1635 text_property_list (object, start, end, prop)
1636 Lisp_Object object, start, end, prop;
1638 struct interval *i;
1639 Lisp_Object result;
1641 result = Qnil;
1643 i = validate_interval_range (object, &start, &end, soft);
1644 if (!NULL_INTERVAL_P (i))
1646 int s = XINT (start);
1647 int e = XINT (end);
1649 while (s < e)
1651 int interval_end, len;
1652 Lisp_Object plist;
1654 interval_end = i->position + LENGTH (i);
1655 if (interval_end > e)
1656 interval_end = e;
1657 len = interval_end - s;
1659 plist = i->plist;
1661 if (!NILP (prop))
1662 for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
1663 if (EQ (Fcar (plist), prop))
1665 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1666 break;
1669 if (!NILP (plist))
1670 result = Fcons (Fcons (make_number (s),
1671 Fcons (make_number (s + len),
1672 Fcons (plist, Qnil))),
1673 result);
1675 i = next_interval (i);
1676 if (NULL_INTERVAL_P (i))
1677 break;
1678 s = i->position;
1682 return result;
1686 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1687 (START END PLIST), where START and END are positions and PLIST is a
1688 property list containing the text properties to add. Adjust START
1689 and END positions by DELTA before adding properties. Value is
1690 non-zero if OBJECT was modified. */
1693 add_text_properties_from_list (object, list, delta)
1694 Lisp_Object object, list, delta;
1696 struct gcpro gcpro1, gcpro2;
1697 int modified_p = 0;
1699 GCPRO2 (list, object);
1701 for (; CONSP (list); list = XCDR (list))
1703 Lisp_Object item, start, end, plist, tem;
1705 item = XCAR (list);
1706 start = make_number (XINT (XCAR (item)) + XINT (delta));
1707 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
1708 plist = XCAR (XCDR (XCDR (item)));
1710 tem = Fadd_text_properties (start, end, plist, object);
1711 if (!NILP (tem))
1712 modified_p = 1;
1715 UNGCPRO;
1716 return modified_p;
1721 /* Modify end-points of ranges in LIST destructively. LIST is a list
1722 as returned from text_property_list. Change end-points equal to
1723 OLD_END to NEW_END. */
1725 void
1726 extend_property_ranges (list, old_end, new_end)
1727 Lisp_Object list, old_end, new_end;
1729 for (; CONSP (list); list = XCDR (list))
1731 Lisp_Object item, end;
1733 item = XCAR (list);
1734 end = XCAR (XCDR (item));
1736 if (EQ (end, old_end))
1737 XCAR (XCDR (item)) = new_end;
1743 /* Call the modification hook functions in LIST, each with START and END. */
1745 static void
1746 call_mod_hooks (list, start, end)
1747 Lisp_Object list, start, end;
1749 struct gcpro gcpro1;
1750 GCPRO1 (list);
1751 while (!NILP (list))
1753 call2 (Fcar (list), start, end);
1754 list = Fcdr (list);
1756 UNGCPRO;
1759 /* Check for read-only intervals between character positions START ... END,
1760 in BUF, and signal an error if we find one.
1762 Then check for any modification hooks in the range.
1763 Create a list of all these hooks in lexicographic order,
1764 eliminating consecutive extra copies of the same hook. Then call
1765 those hooks in order, with START and END - 1 as arguments. */
1767 void
1768 verify_interval_modification (buf, start, end)
1769 struct buffer *buf;
1770 int start, end;
1772 register INTERVAL intervals = BUF_INTERVALS (buf);
1773 register INTERVAL i;
1774 Lisp_Object hooks;
1775 register Lisp_Object prev_mod_hooks;
1776 Lisp_Object mod_hooks;
1777 struct gcpro gcpro1;
1779 hooks = Qnil;
1780 prev_mod_hooks = Qnil;
1781 mod_hooks = Qnil;
1783 interval_insert_behind_hooks = Qnil;
1784 interval_insert_in_front_hooks = Qnil;
1786 if (NULL_INTERVAL_P (intervals))
1787 return;
1789 if (start > end)
1791 int temp = start;
1792 start = end;
1793 end = temp;
1796 /* For an insert operation, check the two chars around the position. */
1797 if (start == end)
1799 INTERVAL prev = NULL;
1800 Lisp_Object before, after;
1802 /* Set I to the interval containing the char after START,
1803 and PREV to the interval containing the char before START.
1804 Either one may be null. They may be equal. */
1805 i = find_interval (intervals, start);
1807 if (start == BUF_BEGV (buf))
1808 prev = 0;
1809 else if (i->position == start)
1810 prev = previous_interval (i);
1811 else if (i->position < start)
1812 prev = i;
1813 if (start == BUF_ZV (buf))
1814 i = 0;
1816 /* If Vinhibit_read_only is set and is not a list, we can
1817 skip the read_only checks. */
1818 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
1820 /* If I and PREV differ we need to check for the read-only
1821 property together with its stickiness. If either I or
1822 PREV are 0, this check is all we need.
1823 We have to take special care, since read-only may be
1824 indirectly defined via the category property. */
1825 if (i != prev)
1827 if (! NULL_INTERVAL_P (i))
1829 after = textget (i->plist, Qread_only);
1831 /* If interval I is read-only and read-only is
1832 front-sticky, inhibit insertion.
1833 Check for read-only as well as category. */
1834 if (! NILP (after)
1835 && NILP (Fmemq (after, Vinhibit_read_only)))
1837 Lisp_Object tem;
1839 tem = textget (i->plist, Qfront_sticky);
1840 if (TMEM (Qread_only, tem)
1841 || (NILP (Fplist_get (i->plist, Qread_only))
1842 && TMEM (Qcategory, tem)))
1843 text_read_only ();
1847 if (! NULL_INTERVAL_P (prev))
1849 before = textget (prev->plist, Qread_only);
1851 /* If interval PREV is read-only and read-only isn't
1852 rear-nonsticky, inhibit insertion.
1853 Check for read-only as well as category. */
1854 if (! NILP (before)
1855 && NILP (Fmemq (before, Vinhibit_read_only)))
1857 Lisp_Object tem;
1859 tem = textget (prev->plist, Qrear_nonsticky);
1860 if (! TMEM (Qread_only, tem)
1861 && (! NILP (Fplist_get (prev->plist,Qread_only))
1862 || ! TMEM (Qcategory, tem)))
1863 text_read_only ();
1867 else if (! NULL_INTERVAL_P (i))
1869 after = textget (i->plist, Qread_only);
1871 /* If interval I is read-only and read-only is
1872 front-sticky, inhibit insertion.
1873 Check for read-only as well as category. */
1874 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
1876 Lisp_Object tem;
1878 tem = textget (i->plist, Qfront_sticky);
1879 if (TMEM (Qread_only, tem)
1880 || (NILP (Fplist_get (i->plist, Qread_only))
1881 && TMEM (Qcategory, tem)))
1882 text_read_only ();
1884 tem = textget (prev->plist, Qrear_nonsticky);
1885 if (! TMEM (Qread_only, tem)
1886 && (! NILP (Fplist_get (prev->plist, Qread_only))
1887 || ! TMEM (Qcategory, tem)))
1888 text_read_only ();
1893 /* Run both insert hooks (just once if they're the same). */
1894 if (!NULL_INTERVAL_P (prev))
1895 interval_insert_behind_hooks
1896 = textget (prev->plist, Qinsert_behind_hooks);
1897 if (!NULL_INTERVAL_P (i))
1898 interval_insert_in_front_hooks
1899 = textget (i->plist, Qinsert_in_front_hooks);
1901 else
1903 /* Loop over intervals on or next to START...END,
1904 collecting their hooks. */
1906 i = find_interval (intervals, start);
1909 if (! INTERVAL_WRITABLE_P (i))
1910 text_read_only ();
1912 mod_hooks = textget (i->plist, Qmodification_hooks);
1913 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
1915 hooks = Fcons (mod_hooks, hooks);
1916 prev_mod_hooks = mod_hooks;
1919 i = next_interval (i);
1921 /* Keep going thru the interval containing the char before END. */
1922 while (! NULL_INTERVAL_P (i) && i->position < end);
1924 GCPRO1 (hooks);
1925 hooks = Fnreverse (hooks);
1926 while (! EQ (hooks, Qnil))
1928 call_mod_hooks (Fcar (hooks), make_number (start),
1929 make_number (end));
1930 hooks = Fcdr (hooks);
1932 UNGCPRO;
1936 /* Run the interval hooks for an insertion on character range START ... END.
1937 verify_interval_modification chose which hooks to run;
1938 this function is called after the insertion happens
1939 so it can indicate the range of inserted text. */
1941 void
1942 report_interval_modification (start, end)
1943 Lisp_Object start, end;
1945 if (! NILP (interval_insert_behind_hooks))
1946 call_mod_hooks (interval_insert_behind_hooks, start, end);
1947 if (! NILP (interval_insert_in_front_hooks)
1948 && ! EQ (interval_insert_in_front_hooks,
1949 interval_insert_behind_hooks))
1950 call_mod_hooks (interval_insert_in_front_hooks, start, end);
1953 void
1954 syms_of_textprop ()
1956 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
1957 "Property-list used as default values.\n\
1958 The value of a property in this list is seen as the value for every\n\
1959 character that does not have its own value for that property.");
1960 Vdefault_text_properties = Qnil;
1962 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
1963 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1964 This also inhibits the use of the `intangible' text property.");
1965 Vinhibit_point_motion_hooks = Qnil;
1967 DEFVAR_LISP ("text-property-default-nonsticky",
1968 &Vtext_property_default_nonsticky,
1969 "Alist of properties vs the corresponding non-stickinesses.\n\
1970 Each element has the form (PROPERTY . NONSTICKINESS).\n\
1972 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
1973 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
1974 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
1975 rear-nonsticky properties of the character overrides NONSTICKINESS.");
1976 Vtext_property_default_nonsticky = Qnil;
1978 staticpro (&interval_insert_behind_hooks);
1979 staticpro (&interval_insert_in_front_hooks);
1980 interval_insert_behind_hooks = Qnil;
1981 interval_insert_in_front_hooks = Qnil;
1984 /* Common attributes one might give text */
1986 staticpro (&Qforeground);
1987 Qforeground = intern ("foreground");
1988 staticpro (&Qbackground);
1989 Qbackground = intern ("background");
1990 staticpro (&Qfont);
1991 Qfont = intern ("font");
1992 staticpro (&Qstipple);
1993 Qstipple = intern ("stipple");
1994 staticpro (&Qunderline);
1995 Qunderline = intern ("underline");
1996 staticpro (&Qread_only);
1997 Qread_only = intern ("read-only");
1998 staticpro (&Qinvisible);
1999 Qinvisible = intern ("invisible");
2000 staticpro (&Qintangible);
2001 Qintangible = intern ("intangible");
2002 staticpro (&Qcategory);
2003 Qcategory = intern ("category");
2004 staticpro (&Qlocal_map);
2005 Qlocal_map = intern ("local-map");
2006 staticpro (&Qfront_sticky);
2007 Qfront_sticky = intern ("front-sticky");
2008 staticpro (&Qrear_nonsticky);
2009 Qrear_nonsticky = intern ("rear-nonsticky");
2010 staticpro (&Qmouse_face);
2011 Qmouse_face = intern ("mouse-face");
2013 /* Properties that text might use to specify certain actions */
2015 staticpro (&Qmouse_left);
2016 Qmouse_left = intern ("mouse-left");
2017 staticpro (&Qmouse_entered);
2018 Qmouse_entered = intern ("mouse-entered");
2019 staticpro (&Qpoint_left);
2020 Qpoint_left = intern ("point-left");
2021 staticpro (&Qpoint_entered);
2022 Qpoint_entered = intern ("point-entered");
2024 defsubr (&Stext_properties_at);
2025 defsubr (&Sget_text_property);
2026 defsubr (&Sget_char_property);
2027 defsubr (&Snext_char_property_change);
2028 defsubr (&Sprevious_char_property_change);
2029 defsubr (&Snext_single_char_property_change);
2030 defsubr (&Sprevious_single_char_property_change);
2031 defsubr (&Snext_property_change);
2032 defsubr (&Snext_single_property_change);
2033 defsubr (&Sprevious_property_change);
2034 defsubr (&Sprevious_single_property_change);
2035 defsubr (&Sadd_text_properties);
2036 defsubr (&Sput_text_property);
2037 defsubr (&Sset_text_properties);
2038 defsubr (&Sremove_text_properties);
2039 defsubr (&Stext_property_any);
2040 defsubr (&Stext_property_not_all);
2041 /* defsubr (&Serase_text_properties); */
2042 /* defsubr (&Scopy_text_properties); */