(5x5-new-game): Set up the buffer even if not interactive.
[emacs.git] / src / textprop.c
blob317f8fa6aa3819f5f1e15a181daae5e9f76f880b
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, 2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "intervals.h"
25 #include "buffer.h"
26 #include "window.h"
28 #ifndef NULL
29 #define NULL (void *)0
30 #endif
32 /* Test for membership, allowing for t (actually any non-cons) to mean the
33 universal set. */
35 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
38 /* NOTES: previous- and next- property change will have to skip
39 zero-length intervals if they are implemented. This could be done
40 inside next_interval and previous_interval.
42 set_properties needs to deal with the interval property cache.
44 It is assumed that for any interval plist, a property appears
45 only once on the list. Although some code i.e., remove_properties,
46 handles the more general case, the uniqueness of properties is
47 necessary for the system to remain consistent. This requirement
48 is enforced by the subrs installing properties onto the intervals. */
51 /* Types of hooks. */
52 Lisp_Object Qmouse_left;
53 Lisp_Object Qmouse_entered;
54 Lisp_Object Qpoint_left;
55 Lisp_Object Qpoint_entered;
56 Lisp_Object Qcategory;
57 Lisp_Object Qlocal_map;
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
61 Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky, Qrear_nonsticky;
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
68 traversing plists. */
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
71 Lisp_Object Vinhibit_point_motion_hooks;
72 Lisp_Object Vdefault_text_properties;
73 Lisp_Object Vchar_property_alias_alist;
74 Lisp_Object Vtext_property_default_nonsticky;
76 /* verify_interval_modification saves insertion hooks here
77 to be run later by report_interval_modification. */
78 Lisp_Object interval_insert_behind_hooks;
79 Lisp_Object interval_insert_in_front_hooks;
82 /* Signal a `text-read-only' error. This function makes it easier
83 to capture that error in GDB by putting a breakpoint on it. */
85 static void
86 text_read_only (propval)
87 Lisp_Object propval;
89 Fsignal (Qtext_read_only, STRINGP (propval) ? Fcons (propval, Qnil) : Qnil);
94 /* Extract the interval at the position pointed to by BEGIN from
95 OBJECT, a string or buffer. Additionally, check that the positions
96 pointed to by BEGIN and END are within the bounds of OBJECT, and
97 reverse them if *BEGIN is greater than *END. The objects pointed
98 to by BEGIN and END may be integers or markers; if the latter, they
99 are coerced to integers.
101 When OBJECT is a string, we increment *BEGIN and *END
102 to make them origin-one.
104 Note that buffer points don't correspond to interval indices.
105 For example, point-max is 1 greater than the index of the last
106 character. This difference is handled in the caller, which uses
107 the validated points to determine a length, and operates on that.
108 Exceptions are Ftext_properties_at, Fnext_property_change, and
109 Fprevious_property_change which call this function with BEGIN == END.
110 Handle this case specially.
112 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
113 create an interval tree for OBJECT if one doesn't exist, provided
114 the object actually contains text. In the current design, if there
115 is no text, there can be no text properties. */
117 #define soft 0
118 #define hard 1
120 INTERVAL
121 validate_interval_range (object, begin, end, force)
122 Lisp_Object object, *begin, *end;
123 int force;
125 register INTERVAL i;
126 int searchpos;
128 CHECK_STRING_OR_BUFFER (object);
129 CHECK_NUMBER_COERCE_MARKER (*begin);
130 CHECK_NUMBER_COERCE_MARKER (*end);
132 /* If we are asked for a point, but from a subr which operates
133 on a range, then return nothing. */
134 if (EQ (*begin, *end) && begin != end)
135 return NULL_INTERVAL;
137 if (XINT (*begin) > XINT (*end))
139 Lisp_Object n;
140 n = *begin;
141 *begin = *end;
142 *end = n;
145 if (BUFFERP (object))
147 register struct buffer *b = XBUFFER (object);
149 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
150 && XINT (*end) <= BUF_ZV (b)))
151 args_out_of_range (*begin, *end);
152 i = BUF_INTERVALS (b);
154 /* If there's no text, there are no properties. */
155 if (BUF_BEGV (b) == BUF_ZV (b))
156 return NULL_INTERVAL;
158 searchpos = XINT (*begin);
160 else
162 int len = SCHARS (object);
164 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
165 && XINT (*end) <= len))
166 args_out_of_range (*begin, *end);
167 XSETFASTINT (*begin, XFASTINT (*begin));
168 if (begin != end)
169 XSETFASTINT (*end, XFASTINT (*end));
170 i = STRING_INTERVALS (object);
172 if (len == 0)
173 return NULL_INTERVAL;
175 searchpos = XINT (*begin);
178 if (NULL_INTERVAL_P (i))
179 return (force ? create_root_interval (object) : i);
181 return find_interval (i, searchpos);
184 /* Validate LIST as a property list. If LIST is not a list, then
185 make one consisting of (LIST nil). Otherwise, verify that LIST
186 is even numbered and thus suitable as a plist. */
188 static Lisp_Object
189 validate_plist (list)
190 Lisp_Object list;
192 if (NILP (list))
193 return Qnil;
195 if (CONSP (list))
197 register int i;
198 register Lisp_Object tail;
199 for (i = 0, tail = list; !NILP (tail); i++)
201 tail = Fcdr (tail);
202 QUIT;
204 if (i & 1)
205 error ("Odd length text property list");
206 return list;
209 return Fcons (list, Fcons (Qnil, Qnil));
212 /* Return nonzero if interval I has all the properties,
213 with the same values, of list PLIST. */
215 static int
216 interval_has_all_properties (plist, i)
217 Lisp_Object plist;
218 INTERVAL i;
220 register Lisp_Object tail1, tail2, sym1;
221 register int found;
223 /* Go through each element of PLIST. */
224 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
226 sym1 = Fcar (tail1);
227 found = 0;
229 /* Go through I's plist, looking for sym1 */
230 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
231 if (EQ (sym1, Fcar (tail2)))
233 /* Found the same property on both lists. If the
234 values are unequal, return zero. */
235 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
236 return 0;
238 /* Property has same value on both lists; go to next one. */
239 found = 1;
240 break;
243 if (! found)
244 return 0;
247 return 1;
250 /* Return nonzero if the plist of interval I has any of the
251 properties of PLIST, regardless of their values. */
253 static INLINE int
254 interval_has_some_properties (plist, i)
255 Lisp_Object plist;
256 INTERVAL i;
258 register Lisp_Object tail1, tail2, sym;
260 /* Go through each element of PLIST. */
261 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
263 sym = Fcar (tail1);
265 /* Go through i's plist, looking for tail1 */
266 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
267 if (EQ (sym, Fcar (tail2)))
268 return 1;
271 return 0;
274 /* Return nonzero if the plist of interval I has any of the
275 property names in LIST, regardless of their values. */
277 static INLINE int
278 interval_has_some_properties_list (list, i)
279 Lisp_Object list;
280 INTERVAL i;
282 register Lisp_Object tail1, tail2, sym;
284 /* Go through each element of LIST. */
285 for (tail1 = list; ! NILP (tail1); tail1 = XCDR (tail1))
287 sym = Fcar (tail1);
289 /* Go through i's plist, looking for tail1 */
290 for (tail2 = i->plist; ! NILP (tail2); tail2 = XCDR (XCDR (tail2)))
291 if (EQ (sym, XCAR (tail2)))
292 return 1;
295 return 0;
298 /* Changing the plists of individual intervals. */
300 /* Return the value of PROP in property-list PLIST, or Qunbound if it
301 has none. */
302 static Lisp_Object
303 property_value (plist, prop)
304 Lisp_Object plist, prop;
306 Lisp_Object value;
308 while (PLIST_ELT_P (plist, value))
309 if (EQ (XCAR (plist), prop))
310 return XCAR (value);
311 else
312 plist = XCDR (value);
314 return Qunbound;
317 /* Set the properties of INTERVAL to PROPERTIES,
318 and record undo info for the previous values.
319 OBJECT is the string or buffer that INTERVAL belongs to. */
321 static void
322 set_properties (properties, interval, object)
323 Lisp_Object properties, object;
324 INTERVAL interval;
326 Lisp_Object sym, value;
328 if (BUFFERP (object))
330 /* For each property in the old plist which is missing from PROPERTIES,
331 or has a different value in PROPERTIES, make an undo record. */
332 for (sym = interval->plist;
333 PLIST_ELT_P (sym, value);
334 sym = XCDR (value))
335 if (! EQ (property_value (properties, XCAR (sym)),
336 XCAR (value)))
338 record_property_change (interval->position, LENGTH (interval),
339 XCAR (sym), XCAR (value),
340 object);
343 /* For each new property that has no value at all in the old plist,
344 make an undo record binding it to nil, so it will be removed. */
345 for (sym = properties;
346 PLIST_ELT_P (sym, value);
347 sym = XCDR (value))
348 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
350 record_property_change (interval->position, LENGTH (interval),
351 XCAR (sym), Qnil,
352 object);
356 /* Store new properties. */
357 interval->plist = Fcopy_sequence (properties);
360 /* Add the properties of PLIST to the interval I, or set
361 the value of I's property to the value of the property on PLIST
362 if they are different.
364 OBJECT should be the string or buffer the interval is in.
366 Return nonzero if this changes I (i.e., if any members of PLIST
367 are actually added to I's plist) */
369 static int
370 add_properties (plist, i, object)
371 Lisp_Object plist;
372 INTERVAL i;
373 Lisp_Object object;
375 Lisp_Object tail1, tail2, sym1, val1;
376 register int changed = 0;
377 register int found;
378 struct gcpro gcpro1, gcpro2, gcpro3;
380 tail1 = plist;
381 sym1 = Qnil;
382 val1 = Qnil;
383 /* No need to protect OBJECT, because we can GC only in the case
384 where it is a buffer, and live buffers are always protected.
385 I and its plist are also protected, via OBJECT. */
386 GCPRO3 (tail1, sym1, val1);
388 /* Go through each element of PLIST. */
389 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
391 sym1 = Fcar (tail1);
392 val1 = Fcar (Fcdr (tail1));
393 found = 0;
395 /* Go through I's plist, looking for sym1 */
396 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
397 if (EQ (sym1, Fcar (tail2)))
399 /* No need to gcpro, because tail2 protects this
400 and it must be a cons cell (we get an error otherwise). */
401 register Lisp_Object this_cdr;
403 this_cdr = Fcdr (tail2);
404 /* Found the property. Now check its value. */
405 found = 1;
407 /* The properties have the same value on both lists.
408 Continue to the next property. */
409 if (EQ (val1, Fcar (this_cdr)))
410 break;
412 /* Record this change in the buffer, for undo purposes. */
413 if (BUFFERP (object))
415 record_property_change (i->position, LENGTH (i),
416 sym1, Fcar (this_cdr), object);
419 /* I's property has a different value -- change it */
420 Fsetcar (this_cdr, val1);
421 changed++;
422 break;
425 if (! found)
427 /* Record this change in the buffer, for undo purposes. */
428 if (BUFFERP (object))
430 record_property_change (i->position, LENGTH (i),
431 sym1, Qnil, object);
433 i->plist = Fcons (sym1, Fcons (val1, i->plist));
434 changed++;
438 UNGCPRO;
440 return changed;
443 /* For any members of PLIST, or LIST,
444 which are properties of I, remove them from I's plist.
445 (If PLIST is non-nil, use that, otherwise use LIST.)
446 OBJECT is the string or buffer containing I. */
448 static int
449 remove_properties (plist, list, i, object)
450 Lisp_Object plist, list;
451 INTERVAL i;
452 Lisp_Object object;
454 register Lisp_Object tail1, tail2, sym, current_plist;
455 register int changed = 0;
457 /* Nonzero means tail1 is a plist, otherwise it is a list. */
458 int use_plist;
460 current_plist = i->plist;
462 if (! NILP (plist))
463 tail1 = plist, use_plist = 1;
464 else
465 tail1 = list, use_plist = 0;
467 /* Go through each element of LIST or PLIST. */
468 while (CONSP (tail1))
470 sym = XCAR (tail1);
472 /* First, remove the symbol if it's at the head of the list */
473 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
475 if (BUFFERP (object))
476 record_property_change (i->position, LENGTH (i),
477 sym, XCAR (XCDR (current_plist)),
478 object);
480 current_plist = XCDR (XCDR (current_plist));
481 changed++;
484 /* Go through I's plist, looking for SYM. */
485 tail2 = current_plist;
486 while (! NILP (tail2))
488 register Lisp_Object this;
489 this = XCDR (XCDR (tail2));
490 if (CONSP (this) && EQ (sym, XCAR (this)))
492 if (BUFFERP (object))
493 record_property_change (i->position, LENGTH (i),
494 sym, XCAR (XCDR (this)), object);
496 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
497 changed++;
499 tail2 = this;
502 /* Advance thru TAIL1 one way or the other. */
503 tail1 = XCDR (tail1);
504 if (use_plist && CONSP (tail1))
505 tail1 = XCDR (tail1);
508 if (changed)
509 i->plist = current_plist;
510 return changed;
513 #if 0
514 /* Remove all properties from interval I. Return non-zero
515 if this changes the interval. */
517 static INLINE int
518 erase_properties (i)
519 INTERVAL i;
521 if (NILP (i->plist))
522 return 0;
524 i->plist = Qnil;
525 return 1;
527 #endif
529 /* Returns the interval of POSITION in OBJECT.
530 POSITION is BEG-based. */
532 INTERVAL
533 interval_of (position, object)
534 int position;
535 Lisp_Object object;
537 register INTERVAL i;
538 int beg, end;
540 if (NILP (object))
541 XSETBUFFER (object, current_buffer);
542 else if (EQ (object, Qt))
543 return NULL_INTERVAL;
545 CHECK_STRING_OR_BUFFER (object);
547 if (BUFFERP (object))
549 register struct buffer *b = XBUFFER (object);
551 beg = BUF_BEGV (b);
552 end = BUF_ZV (b);
553 i = BUF_INTERVALS (b);
555 else
557 beg = 0;
558 end = SCHARS (object);
559 i = STRING_INTERVALS (object);
562 if (!(beg <= position && position <= end))
563 args_out_of_range (make_number (position), make_number (position));
564 if (beg == end || NULL_INTERVAL_P (i))
565 return NULL_INTERVAL;
567 return find_interval (i, position);
570 DEFUN ("text-properties-at", Ftext_properties_at,
571 Stext_properties_at, 1, 2, 0,
572 doc: /* Return the list of properties of the character at POSITION in OBJECT.
573 If the optional second argument OBJECT is a buffer (or nil, which means
574 the current buffer), POSITION is a buffer position (integer or marker).
575 If OBJECT is a string, POSITION is a 0-based index into it.
576 If POSITION is at the end of OBJECT, the value is nil. */)
577 (position, object)
578 Lisp_Object position, object;
580 register INTERVAL i;
582 if (NILP (object))
583 XSETBUFFER (object, current_buffer);
585 i = validate_interval_range (object, &position, &position, soft);
586 if (NULL_INTERVAL_P (i))
587 return Qnil;
588 /* If POSITION is at the end of the interval,
589 it means it's the end of OBJECT.
590 There are no properties at the very end,
591 since no character follows. */
592 if (XINT (position) == LENGTH (i) + i->position)
593 return Qnil;
595 return i->plist;
598 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
599 doc: /* Return the value of POSITION's property PROP, in OBJECT.
600 OBJECT is optional and defaults to the current buffer.
601 If POSITION is at the end of OBJECT, the value is nil. */)
602 (position, prop, object)
603 Lisp_Object position, object;
604 Lisp_Object prop;
606 return textget (Ftext_properties_at (position, object), prop);
609 /* Return the value of char's property PROP, in OBJECT at POSITION.
610 OBJECT is optional and defaults to the current buffer.
611 If OVERLAY is non-0, then in the case that the returned property is from
612 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
613 returned in *OVERLAY.
614 If POSITION is at the end of OBJECT, the value is nil.
615 If OBJECT is a buffer, then overlay properties are considered as well as
616 text properties.
617 If OBJECT is a window, then that window's buffer is used, but
618 window-specific overlays are considered only if they are associated
619 with OBJECT. */
620 Lisp_Object
621 get_char_property_and_overlay (position, prop, object, overlay)
622 Lisp_Object position, object;
623 register Lisp_Object prop;
624 Lisp_Object *overlay;
626 struct window *w = 0;
628 CHECK_NUMBER_COERCE_MARKER (position);
630 if (NILP (object))
631 XSETBUFFER (object, current_buffer);
633 if (WINDOWP (object))
635 w = XWINDOW (object);
636 object = w->buffer;
638 if (BUFFERP (object))
640 int noverlays;
641 Lisp_Object *overlay_vec;
642 struct buffer *obuf = current_buffer;
644 set_buffer_temp (XBUFFER (object));
646 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
647 noverlays = sort_overlays (overlay_vec, noverlays, w);
649 set_buffer_temp (obuf);
651 /* Now check the overlays in order of decreasing priority. */
652 while (--noverlays >= 0)
654 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
655 if (!NILP (tem))
657 if (overlay)
658 /* Return the overlay we got the property from. */
659 *overlay = overlay_vec[noverlays];
660 return tem;
665 if (overlay)
666 /* Indicate that the return value is not from an overlay. */
667 *overlay = Qnil;
669 /* Not a buffer, or no appropriate overlay, so fall through to the
670 simpler case. */
671 return Fget_text_property (position, prop, object);
674 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
675 doc: /* Return the value of POSITION's property PROP, in OBJECT.
676 Both overlay properties and text properties are checked.
677 OBJECT is optional and defaults to the current buffer.
678 If POSITION is at the end of OBJECT, the value is nil.
679 If OBJECT is a buffer, then overlay properties are considered as well as
680 text properties.
681 If OBJECT is a window, then that window's buffer is used, but window-specific
682 overlays are considered only if they are associated with OBJECT. */)
683 (position, prop, object)
684 Lisp_Object position, object;
685 register Lisp_Object prop;
687 return get_char_property_and_overlay (position, prop, object, 0);
690 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
691 Sget_char_property_and_overlay, 2, 3, 0,
692 doc: /* Like `get-char-property', but with extra overlay information.
693 Return a cons whose car is the return value of `get-char-property'
694 with the same arguments, that is, the value of POSITION's property
695 PROP in OBJECT, and whose cdr is the overlay in which the property was
696 found, or nil, if it was found as a text property or not found at all.
697 OBJECT is optional and defaults to the current buffer. OBJECT may be
698 a string, a buffer or a window. For strings, the cdr of the return
699 value is always nil, since strings do not have overlays. If OBJECT is
700 a window, then that window's buffer is used, but window-specific
701 overlays are considered only if they are associated with OBJECT. If
702 POSITION is at the end of OBJECT, both car and cdr are nil. */)
703 (position, prop, object)
704 Lisp_Object position, object;
705 register Lisp_Object prop;
707 Lisp_Object overlay;
708 Lisp_Object val
709 = get_char_property_and_overlay (position, prop, object, &overlay);
710 return Fcons(val, overlay);
714 DEFUN ("next-char-property-change", Fnext_char_property_change,
715 Snext_char_property_change, 1, 2, 0,
716 doc: /* Return the position of next text property or overlay change.
717 This scans characters forward in the current buffer from POSITION till
718 it finds a change in some text property, or the beginning or end of an
719 overlay, and returns the position of that.
720 If none is found, the function returns (point-max).
722 If the optional third argument LIMIT is non-nil, don't search
723 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
724 (position, limit)
725 Lisp_Object position, limit;
727 Lisp_Object temp;
729 temp = Fnext_overlay_change (position);
730 if (! NILP (limit))
732 CHECK_NUMBER (limit);
733 if (XINT (limit) < XINT (temp))
734 temp = limit;
736 return Fnext_property_change (position, Qnil, temp);
739 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
740 Sprevious_char_property_change, 1, 2, 0,
741 doc: /* Return the position of previous text property or overlay change.
742 Scans characters backward in the current buffer from POSITION till it
743 finds a change in some text property, or the beginning or end of an
744 overlay, and returns the position of that.
745 If none is found, the function returns (point-max).
747 If the optional third argument LIMIT is non-nil, don't search
748 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
749 (position, limit)
750 Lisp_Object position, limit;
752 Lisp_Object temp;
754 temp = Fprevious_overlay_change (position);
755 if (! NILP (limit))
757 CHECK_NUMBER (limit);
758 if (XINT (limit) > XINT (temp))
759 temp = limit;
761 return Fprevious_property_change (position, Qnil, temp);
765 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
766 Snext_single_char_property_change, 2, 4, 0,
767 doc: /* Return the position of next text property or overlay change for a specific property.
768 Scans characters forward from POSITION till it finds
769 a change in the PROP property, then returns the position of the change.
770 If the optional third argument OBJECT is a buffer (or nil, which means
771 the current buffer), POSITION is a buffer position (integer or marker).
772 If OBJECT is a string, POSITION is a 0-based index into it.
774 The property values are compared with `eq'.
775 If the property is constant all the way to the end of OBJECT, return the
776 last valid position in OBJECT.
777 If the optional fourth argument LIMIT is non-nil, don't search
778 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
779 (position, prop, object, limit)
780 Lisp_Object prop, position, object, limit;
782 if (STRINGP (object))
784 position = Fnext_single_property_change (position, prop, object, limit);
785 if (NILP (position))
787 if (NILP (limit))
788 position = make_number (SCHARS (object));
789 else
790 position = limit;
793 else
795 Lisp_Object initial_value, value;
796 int count = SPECPDL_INDEX ();
798 if (! NILP (object))
799 CHECK_BUFFER (object);
801 if (BUFFERP (object) && current_buffer != XBUFFER (object))
803 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
804 Fset_buffer (object);
807 initial_value = Fget_char_property (position, prop, object);
809 if (NILP (limit))
810 XSETFASTINT (limit, BUF_ZV (current_buffer));
811 else
812 CHECK_NUMBER_COERCE_MARKER (limit);
814 for (;;)
816 position = Fnext_char_property_change (position, limit);
817 if (XFASTINT (position) >= XFASTINT (limit)) {
818 position = limit;
819 break;
822 value = Fget_char_property (position, prop, object);
823 if (!EQ (value, initial_value))
824 break;
827 unbind_to (count, Qnil);
830 return position;
833 DEFUN ("previous-single-char-property-change",
834 Fprevious_single_char_property_change,
835 Sprevious_single_char_property_change, 2, 4, 0,
836 doc: /* Return the position of previous text property or overlay change for a specific property.
837 Scans characters backward from POSITION till it finds
838 a change in the PROP property, then returns the position of the change.
839 If the optional third argument OBJECT is a buffer (or nil, which means
840 the current buffer), POSITION is a buffer position (integer or marker).
841 If OBJECT is a string, POSITION is a 0-based index into it.
843 The property values are compared with `eq'.
844 If the property is constant all the way to the start of OBJECT, return the
845 first valid position in OBJECT.
846 If the optional fourth argument LIMIT is non-nil, don't search
847 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
848 (position, prop, object, limit)
849 Lisp_Object prop, position, object, limit;
851 if (STRINGP (object))
853 position = Fprevious_single_property_change (position, prop, object, limit);
854 if (NILP (position))
856 if (NILP (limit))
857 position = make_number (SCHARS (object));
858 else
859 position = limit;
862 else
864 int count = SPECPDL_INDEX ();
866 if (! NILP (object))
867 CHECK_BUFFER (object);
869 if (BUFFERP (object) && current_buffer != XBUFFER (object))
871 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
872 Fset_buffer (object);
875 if (NILP (limit))
876 XSETFASTINT (limit, BUF_BEGV (current_buffer));
877 else
878 CHECK_NUMBER_COERCE_MARKER (limit);
880 if (XFASTINT (position) <= XFASTINT (limit))
881 position = limit;
882 else
884 Lisp_Object initial_value =
885 Fget_char_property (make_number (XFASTINT (position) - 1),
886 prop, object);
888 for (;;)
890 position = Fprevious_char_property_change (position, limit);
892 if (XFASTINT (position) <= XFASTINT (limit))
894 position = limit;
895 break;
897 else
899 Lisp_Object value =
900 Fget_char_property (make_number (XFASTINT (position) - 1),
901 prop, object);
903 if (!EQ (value, initial_value))
904 break;
909 unbind_to (count, Qnil);
912 return position;
915 DEFUN ("next-property-change", Fnext_property_change,
916 Snext_property_change, 1, 3, 0,
917 doc: /* Return the position of next property change.
918 Scans characters forward from POSITION in OBJECT till it finds
919 a change in some text property, then returns the position of the change.
920 If the optional second argument OBJECT is a buffer (or nil, which means
921 the current buffer), POSITION is a buffer position (integer or marker).
922 If OBJECT is a string, POSITION is a 0-based index into it.
923 Return nil if the property is constant all the way to the end of OBJECT.
924 If the value is non-nil, it is a position greater than POSITION, never equal.
926 If the optional third argument LIMIT is non-nil, don't search
927 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
928 (position, object, limit)
929 Lisp_Object position, object, limit;
931 register INTERVAL i, next;
933 if (NILP (object))
934 XSETBUFFER (object, current_buffer);
936 if (!NILP (limit) && !EQ (limit, Qt))
937 CHECK_NUMBER_COERCE_MARKER (limit);
939 i = validate_interval_range (object, &position, &position, soft);
941 /* If LIMIT is t, return start of next interval--don't
942 bother checking further intervals. */
943 if (EQ (limit, Qt))
945 if (NULL_INTERVAL_P (i))
946 next = i;
947 else
948 next = next_interval (i);
950 if (NULL_INTERVAL_P (next))
951 XSETFASTINT (position, (STRINGP (object)
952 ? SCHARS (object)
953 : BUF_ZV (XBUFFER (object))));
954 else
955 XSETFASTINT (position, next->position);
956 return position;
959 if (NULL_INTERVAL_P (i))
960 return limit;
962 next = next_interval (i);
964 while (!NULL_INTERVAL_P (next) && intervals_equal (i, next)
965 && (NILP (limit) || next->position < XFASTINT (limit)))
966 next = next_interval (next);
968 if (NULL_INTERVAL_P (next))
969 return limit;
970 if (NILP (limit))
971 XSETFASTINT (limit, (STRINGP (object)
972 ? SCHARS (object)
973 : BUF_ZV (XBUFFER (object))));
974 if (!(next->position < XFASTINT (limit)))
975 return limit;
977 XSETFASTINT (position, next->position);
978 return position;
981 /* Return 1 if there's a change in some property between BEG and END. */
984 property_change_between_p (beg, end)
985 int beg, end;
987 register INTERVAL i, next;
988 Lisp_Object object, pos;
990 XSETBUFFER (object, current_buffer);
991 XSETFASTINT (pos, beg);
993 i = validate_interval_range (object, &pos, &pos, soft);
994 if (NULL_INTERVAL_P (i))
995 return 0;
997 next = next_interval (i);
998 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
1000 next = next_interval (next);
1001 if (NULL_INTERVAL_P (next))
1002 return 0;
1003 if (next->position >= end)
1004 return 0;
1007 if (NULL_INTERVAL_P (next))
1008 return 0;
1010 return 1;
1013 DEFUN ("next-single-property-change", Fnext_single_property_change,
1014 Snext_single_property_change, 2, 4, 0,
1015 doc: /* Return the position of next property change for a specific property.
1016 Scans characters forward from POSITION till it finds
1017 a change in the PROP property, then returns the position of the change.
1018 If the optional third argument OBJECT is a buffer (or nil, which means
1019 the current buffer), POSITION is a buffer position (integer or marker).
1020 If OBJECT is a string, POSITION is a 0-based index into it.
1021 The property values are compared with `eq'.
1022 Return nil if the property is constant all the way to the end of OBJECT.
1023 If the value is non-nil, it is a position greater than POSITION, never equal.
1025 If the optional fourth argument LIMIT is non-nil, don't search
1026 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1027 (position, prop, object, limit)
1028 Lisp_Object position, prop, object, limit;
1030 register INTERVAL i, next;
1031 register Lisp_Object here_val;
1033 if (NILP (object))
1034 XSETBUFFER (object, current_buffer);
1036 if (!NILP (limit))
1037 CHECK_NUMBER_COERCE_MARKER (limit);
1039 i = validate_interval_range (object, &position, &position, soft);
1040 if (NULL_INTERVAL_P (i))
1041 return limit;
1043 here_val = textget (i->plist, prop);
1044 next = next_interval (i);
1045 while (! NULL_INTERVAL_P (next)
1046 && EQ (here_val, textget (next->plist, prop))
1047 && (NILP (limit) || next->position < XFASTINT (limit)))
1048 next = next_interval (next);
1050 if (NULL_INTERVAL_P (next))
1051 return limit;
1052 if (NILP (limit))
1053 XSETFASTINT (limit, (STRINGP (object)
1054 ? SCHARS (object)
1055 : BUF_ZV (XBUFFER (object))));
1056 if (!(next->position < XFASTINT (limit)))
1057 return limit;
1059 return make_number (next->position);
1062 DEFUN ("previous-property-change", Fprevious_property_change,
1063 Sprevious_property_change, 1, 3, 0,
1064 doc: /* Return the position of previous property change.
1065 Scans characters backwards from POSITION in OBJECT till it finds
1066 a change in some text property, then returns the position of the change.
1067 If the optional second argument OBJECT is a buffer (or nil, which means
1068 the current buffer), POSITION is a buffer position (integer or marker).
1069 If OBJECT is a string, POSITION is a 0-based index into it.
1070 Return nil if the property is constant all the way to the start of OBJECT.
1071 If the value is non-nil, it is a position less than POSITION, never equal.
1073 If the optional third argument LIMIT is non-nil, don't search
1074 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1075 (position, object, limit)
1076 Lisp_Object position, object, limit;
1078 register INTERVAL i, previous;
1080 if (NILP (object))
1081 XSETBUFFER (object, current_buffer);
1083 if (!NILP (limit))
1084 CHECK_NUMBER_COERCE_MARKER (limit);
1086 i = validate_interval_range (object, &position, &position, soft);
1087 if (NULL_INTERVAL_P (i))
1088 return limit;
1090 /* Start with the interval containing the char before point. */
1091 if (i->position == XFASTINT (position))
1092 i = previous_interval (i);
1094 previous = previous_interval (i);
1095 while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
1096 && (NILP (limit)
1097 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1098 previous = previous_interval (previous);
1099 if (NULL_INTERVAL_P (previous))
1100 return limit;
1101 if (NILP (limit))
1102 XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
1103 if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
1104 return limit;
1106 return make_number (previous->position + LENGTH (previous));
1109 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1110 Sprevious_single_property_change, 2, 4, 0,
1111 doc: /* Return the position of previous property change for a specific property.
1112 Scans characters backward from POSITION till it finds
1113 a change in the PROP property, then returns the position of the change.
1114 If the optional third argument OBJECT is a buffer (or nil, which means
1115 the current buffer), POSITION is a buffer position (integer or marker).
1116 If OBJECT is a string, POSITION is a 0-based index into it.
1117 The property values are compared with `eq'.
1118 Return nil if the property is constant all the way to the start of OBJECT.
1119 If the value is non-nil, it is a position less than POSITION, never equal.
1121 If the optional fourth argument LIMIT is non-nil, don't search
1122 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1123 (position, prop, object, limit)
1124 Lisp_Object position, prop, object, limit;
1126 register INTERVAL i, previous;
1127 register Lisp_Object here_val;
1129 if (NILP (object))
1130 XSETBUFFER (object, current_buffer);
1132 if (!NILP (limit))
1133 CHECK_NUMBER_COERCE_MARKER (limit);
1135 i = validate_interval_range (object, &position, &position, soft);
1137 /* Start with the interval containing the char before point. */
1138 if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position))
1139 i = previous_interval (i);
1141 if (NULL_INTERVAL_P (i))
1142 return limit;
1144 here_val = textget (i->plist, prop);
1145 previous = previous_interval (i);
1146 while (!NULL_INTERVAL_P (previous)
1147 && EQ (here_val, textget (previous->plist, prop))
1148 && (NILP (limit)
1149 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1150 previous = previous_interval (previous);
1151 if (NULL_INTERVAL_P (previous))
1152 return limit;
1153 if (NILP (limit))
1154 XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
1155 if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
1156 return limit;
1158 return make_number (previous->position + LENGTH (previous));
1161 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1163 DEFUN ("add-text-properties", Fadd_text_properties,
1164 Sadd_text_properties, 3, 4, 0,
1165 doc: /* Add properties to the text from START to END.
1166 The third argument PROPERTIES is a property list
1167 specifying the property values to add. If the optional fourth argument
1168 OBJECT is a buffer (or nil, which means the current buffer),
1169 START and END are buffer positions (integers or markers).
1170 If OBJECT is a string, START and END are 0-based indices into it.
1171 Return t if any property value actually changed, nil otherwise. */)
1172 (start, end, properties, object)
1173 Lisp_Object start, end, properties, object;
1175 register INTERVAL i, unchanged;
1176 register int s, len, modified = 0;
1177 struct gcpro gcpro1;
1179 properties = validate_plist (properties);
1180 if (NILP (properties))
1181 return Qnil;
1183 if (NILP (object))
1184 XSETBUFFER (object, current_buffer);
1186 i = validate_interval_range (object, &start, &end, hard);
1187 if (NULL_INTERVAL_P (i))
1188 return Qnil;
1190 s = XINT (start);
1191 len = XINT (end) - s;
1193 /* No need to protect OBJECT, because we GC only if it's a buffer,
1194 and live buffers are always protected. */
1195 GCPRO1 (properties);
1197 /* If we're not starting on an interval boundary, we have to
1198 split this interval. */
1199 if (i->position != s)
1201 /* If this interval already has the properties, we can
1202 skip it. */
1203 if (interval_has_all_properties (properties, i))
1205 int got = (LENGTH (i) - (s - i->position));
1206 if (got >= len)
1207 RETURN_UNGCPRO (Qnil);
1208 len -= got;
1209 i = next_interval (i);
1211 else
1213 unchanged = i;
1214 i = split_interval_right (unchanged, s - unchanged->position);
1215 copy_properties (unchanged, i);
1219 if (BUFFERP (object))
1220 modify_region (XBUFFER (object), XINT (start), XINT (end));
1222 /* We are at the beginning of interval I, with LEN chars to scan. */
1223 for (;;)
1225 if (i == 0)
1226 abort ();
1228 if (LENGTH (i) >= len)
1230 /* We can UNGCPRO safely here, because there will be just
1231 one more chance to gc, in the next call to add_properties,
1232 and after that we will not need PROPERTIES or OBJECT again. */
1233 UNGCPRO;
1235 if (interval_has_all_properties (properties, i))
1237 if (BUFFERP (object))
1238 signal_after_change (XINT (start), XINT (end) - XINT (start),
1239 XINT (end) - XINT (start));
1241 return modified ? Qt : Qnil;
1244 if (LENGTH (i) == len)
1246 add_properties (properties, i, object);
1247 if (BUFFERP (object))
1248 signal_after_change (XINT (start), XINT (end) - XINT (start),
1249 XINT (end) - XINT (start));
1250 return Qt;
1253 /* i doesn't have the properties, and goes past the change limit */
1254 unchanged = i;
1255 i = split_interval_left (unchanged, len);
1256 copy_properties (unchanged, i);
1257 add_properties (properties, i, object);
1258 if (BUFFERP (object))
1259 signal_after_change (XINT (start), XINT (end) - XINT (start),
1260 XINT (end) - XINT (start));
1261 return Qt;
1264 len -= LENGTH (i);
1265 modified += add_properties (properties, i, object);
1266 i = next_interval (i);
1270 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1272 DEFUN ("put-text-property", Fput_text_property,
1273 Sput_text_property, 4, 5, 0,
1274 doc: /* Set one property of the text from START to END.
1275 The third and fourth arguments PROPERTY and VALUE
1276 specify the property to add.
1277 If the optional fifth argument OBJECT is a buffer (or nil, which means
1278 the current buffer), START and END are buffer positions (integers or
1279 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1280 (start, end, property, value, object)
1281 Lisp_Object start, end, property, value, object;
1283 Fadd_text_properties (start, end,
1284 Fcons (property, Fcons (value, Qnil)),
1285 object);
1286 return Qnil;
1289 DEFUN ("set-text-properties", Fset_text_properties,
1290 Sset_text_properties, 3, 4, 0,
1291 doc: /* Completely replace properties of text from START to END.
1292 The third argument PROPERTIES is the new property list.
1293 If the optional fourth argument OBJECT is a buffer (or nil, which means
1294 the current buffer), START and END are buffer positions (integers or
1295 markers). If OBJECT is a string, START and END are 0-based indices into it.
1296 If PROPERTIES is nil, the effect is to remove all properties from
1297 the designated part of OBJECT. */)
1298 (start, end, properties, object)
1299 Lisp_Object start, end, properties, object;
1301 return set_text_properties (start, end, properties, object, Qt);
1305 /* Replace properties of text from START to END with new list of
1306 properties PROPERTIES. OBJECT is the buffer or string containing
1307 the text. OBJECT nil means use the current buffer.
1308 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
1309 is non-nil if properties were replaced; it is nil if there weren't
1310 any properties to replace. */
1312 Lisp_Object
1313 set_text_properties (start, end, properties, object, signal_after_change_p)
1314 Lisp_Object start, end, properties, object, signal_after_change_p;
1316 register INTERVAL i;
1317 Lisp_Object ostart, oend;
1319 ostart = start;
1320 oend = end;
1322 properties = validate_plist (properties);
1324 if (NILP (object))
1325 XSETBUFFER (object, current_buffer);
1327 /* If we want no properties for a whole string,
1328 get rid of its intervals. */
1329 if (NILP (properties) && STRINGP (object)
1330 && XFASTINT (start) == 0
1331 && XFASTINT (end) == SCHARS (object))
1333 if (! STRING_INTERVALS (object))
1334 return Qt;
1336 STRING_SET_INTERVALS (object, NULL_INTERVAL);
1337 return Qt;
1340 i = validate_interval_range (object, &start, &end, soft);
1342 if (NULL_INTERVAL_P (i))
1344 /* If buffer has no properties, and we want none, return now. */
1345 if (NILP (properties))
1346 return Qnil;
1348 /* Restore the original START and END values
1349 because validate_interval_range increments them for strings. */
1350 start = ostart;
1351 end = oend;
1353 i = validate_interval_range (object, &start, &end, hard);
1354 /* This can return if start == end. */
1355 if (NULL_INTERVAL_P (i))
1356 return Qnil;
1359 if (BUFFERP (object))
1360 modify_region (XBUFFER (object), XINT (start), XINT (end));
1362 set_text_properties_1 (start, end, properties, object, i);
1364 if (BUFFERP (object) && !NILP (signal_after_change_p))
1365 signal_after_change (XINT (start), XINT (end) - XINT (start),
1366 XINT (end) - XINT (start));
1367 return Qt;
1370 /* Replace properties of text from START to END with new list of
1371 properties PROPERTIES. BUFFER is the buffer containing
1372 the text. This does not obey any hooks.
1373 You can provide the interval that START is located in as I,
1374 or pass NULL for I and this function will find it.
1375 START and END can be in any order. */
1377 void
1378 set_text_properties_1 (start, end, properties, buffer, i)
1379 Lisp_Object start, end, properties, buffer;
1380 INTERVAL i;
1382 register INTERVAL prev_changed = NULL_INTERVAL;
1383 register int s, len;
1384 INTERVAL unchanged;
1386 s = XINT (start);
1387 len = XINT (end) - s;
1388 if (len == 0)
1389 return;
1390 if (len < 0)
1392 s = s + len;
1393 len = - len;
1396 if (i == 0)
1397 i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
1399 if (i->position != s)
1401 unchanged = i;
1402 i = split_interval_right (unchanged, s - unchanged->position);
1404 if (LENGTH (i) > len)
1406 copy_properties (unchanged, i);
1407 i = split_interval_left (i, len);
1408 set_properties (properties, i, buffer);
1409 return;
1412 set_properties (properties, i, buffer);
1414 if (LENGTH (i) == len)
1415 return;
1417 prev_changed = i;
1418 len -= LENGTH (i);
1419 i = next_interval (i);
1422 /* We are starting at the beginning of an interval, I */
1423 while (len > 0)
1425 if (i == 0)
1426 abort ();
1428 if (LENGTH (i) >= len)
1430 if (LENGTH (i) > len)
1431 i = split_interval_left (i, len);
1433 /* We have to call set_properties even if we are going to
1434 merge the intervals, so as to make the undo records
1435 and cause redisplay to happen. */
1436 set_properties (properties, i, buffer);
1437 if (!NULL_INTERVAL_P (prev_changed))
1438 merge_interval_left (i);
1439 return;
1442 len -= LENGTH (i);
1444 /* We have to call set_properties even if we are going to
1445 merge the intervals, so as to make the undo records
1446 and cause redisplay to happen. */
1447 set_properties (properties, i, buffer);
1448 if (NULL_INTERVAL_P (prev_changed))
1449 prev_changed = i;
1450 else
1451 prev_changed = i = merge_interval_left (i);
1453 i = next_interval (i);
1457 DEFUN ("remove-text-properties", Fremove_text_properties,
1458 Sremove_text_properties, 3, 4, 0,
1459 doc: /* Remove some properties from text from START to END.
1460 The third argument PROPERTIES is a property list
1461 whose property names specify the properties to remove.
1462 \(The values stored in PROPERTIES are ignored.)
1463 If the optional fourth argument OBJECT is a buffer (or nil, which means
1464 the current buffer), START and END are buffer positions (integers or
1465 markers). If OBJECT is a string, START and END are 0-based indices into it.
1466 Return t if any property was actually removed, nil otherwise.
1468 Use set-text-properties if you want to remove all text properties. */)
1469 (start, end, properties, object)
1470 Lisp_Object start, end, properties, object;
1472 register INTERVAL i, unchanged;
1473 register int s, len, modified = 0;
1475 if (NILP (object))
1476 XSETBUFFER (object, current_buffer);
1478 i = validate_interval_range (object, &start, &end, soft);
1479 if (NULL_INTERVAL_P (i))
1480 return Qnil;
1482 s = XINT (start);
1483 len = XINT (end) - s;
1485 if (i->position != s)
1487 /* No properties on this first interval -- return if
1488 it covers the entire region. */
1489 if (! interval_has_some_properties (properties, i))
1491 int got = (LENGTH (i) - (s - i->position));
1492 if (got >= len)
1493 return Qnil;
1494 len -= got;
1495 i = next_interval (i);
1497 /* Split away the beginning of this interval; what we don't
1498 want to modify. */
1499 else
1501 unchanged = i;
1502 i = split_interval_right (unchanged, s - unchanged->position);
1503 copy_properties (unchanged, i);
1507 if (BUFFERP (object))
1508 modify_region (XBUFFER (object), XINT (start), XINT (end));
1510 /* We are at the beginning of an interval, with len to scan */
1511 for (;;)
1513 if (i == 0)
1514 abort ();
1516 if (LENGTH (i) >= len)
1518 if (! interval_has_some_properties (properties, i))
1519 return modified ? Qt : Qnil;
1521 if (LENGTH (i) == len)
1523 remove_properties (properties, Qnil, i, object);
1524 if (BUFFERP (object))
1525 signal_after_change (XINT (start), XINT (end) - XINT (start),
1526 XINT (end) - XINT (start));
1527 return Qt;
1530 /* i has the properties, and goes past the change limit */
1531 unchanged = i;
1532 i = split_interval_left (i, len);
1533 copy_properties (unchanged, i);
1534 remove_properties (properties, Qnil, i, object);
1535 if (BUFFERP (object))
1536 signal_after_change (XINT (start), XINT (end) - XINT (start),
1537 XINT (end) - XINT (start));
1538 return Qt;
1541 len -= LENGTH (i);
1542 modified += remove_properties (properties, Qnil, i, object);
1543 i = next_interval (i);
1547 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1548 Sremove_list_of_text_properties, 3, 4, 0,
1549 doc: /* Remove some properties from text from START to END.
1550 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1551 If the optional fourth argument OBJECT is a buffer (or nil, which means
1552 the current buffer), START and END are buffer positions (integers or
1553 markers). If OBJECT is a string, START and END are 0-based indices into it.
1554 Return t if any property was actually removed, nil otherwise. */)
1555 (start, end, list_of_properties, object)
1556 Lisp_Object start, end, list_of_properties, object;
1558 register INTERVAL i, unchanged;
1559 register int s, len, modified = 0;
1560 Lisp_Object properties;
1561 properties = list_of_properties;
1563 if (NILP (object))
1564 XSETBUFFER (object, current_buffer);
1566 i = validate_interval_range (object, &start, &end, soft);
1567 if (NULL_INTERVAL_P (i))
1568 return Qnil;
1570 s = XINT (start);
1571 len = XINT (end) - s;
1573 if (i->position != s)
1575 /* No properties on this first interval -- return if
1576 it covers the entire region. */
1577 if (! interval_has_some_properties_list (properties, i))
1579 int got = (LENGTH (i) - (s - i->position));
1580 if (got >= len)
1581 return Qnil;
1582 len -= got;
1583 i = next_interval (i);
1585 /* Split away the beginning of this interval; what we don't
1586 want to modify. */
1587 else
1589 unchanged = i;
1590 i = split_interval_right (unchanged, s - unchanged->position);
1591 copy_properties (unchanged, i);
1595 if (BUFFERP (object))
1596 modify_region (XBUFFER (object), XINT (start), XINT (end));
1598 /* We are at the beginning of an interval, with len to scan */
1599 for (;;)
1601 if (i == 0)
1602 abort ();
1604 if (LENGTH (i) >= len)
1606 if (! interval_has_some_properties_list (properties, i))
1607 return modified ? Qt : Qnil;
1609 if (LENGTH (i) == len)
1611 remove_properties (Qnil, properties, i, object);
1612 if (BUFFERP (object))
1613 signal_after_change (XINT (start), XINT (end) - XINT (start),
1614 XINT (end) - XINT (start));
1615 return Qt;
1618 /* i has the properties, and goes past the change limit */
1619 unchanged = i;
1620 i = split_interval_left (i, len);
1621 copy_properties (unchanged, i);
1622 remove_properties (Qnil, properties, i, object);
1623 if (BUFFERP (object))
1624 signal_after_change (XINT (start), XINT (end) - XINT (start),
1625 XINT (end) - XINT (start));
1626 return Qt;
1629 len -= LENGTH (i);
1630 modified += remove_properties (Qnil, properties, i, object);
1631 i = next_interval (i);
1635 DEFUN ("text-property-any", Ftext_property_any,
1636 Stext_property_any, 4, 5, 0,
1637 doc: /* Check text from START to END for property PROPERTY equalling VALUE.
1638 If so, return the position of the first character whose property PROPERTY
1639 is `eq' to VALUE. Otherwise return nil.
1640 If the optional fifth argument OBJECT is a buffer (or nil, which means
1641 the current buffer), START and END are buffer positions (integers or
1642 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1643 (start, end, property, value, object)
1644 Lisp_Object start, end, property, value, object;
1646 register INTERVAL i;
1647 register int e, pos;
1649 if (NILP (object))
1650 XSETBUFFER (object, current_buffer);
1651 i = validate_interval_range (object, &start, &end, soft);
1652 if (NULL_INTERVAL_P (i))
1653 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1654 e = XINT (end);
1656 while (! NULL_INTERVAL_P (i))
1658 if (i->position >= e)
1659 break;
1660 if (EQ (textget (i->plist, property), value))
1662 pos = i->position;
1663 if (pos < XINT (start))
1664 pos = XINT (start);
1665 return make_number (pos);
1667 i = next_interval (i);
1669 return Qnil;
1672 DEFUN ("text-property-not-all", Ftext_property_not_all,
1673 Stext_property_not_all, 4, 5, 0,
1674 doc: /* Check text from START to END for property PROPERTY not equalling VALUE.
1675 If so, return the position of the first character whose property PROPERTY
1676 is not `eq' to VALUE. Otherwise, return nil.
1677 If the optional fifth argument OBJECT is a buffer (or nil, which means
1678 the current buffer), START and END are buffer positions (integers or
1679 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1680 (start, end, property, value, object)
1681 Lisp_Object start, end, property, value, object;
1683 register INTERVAL i;
1684 register int s, e;
1686 if (NILP (object))
1687 XSETBUFFER (object, current_buffer);
1688 i = validate_interval_range (object, &start, &end, soft);
1689 if (NULL_INTERVAL_P (i))
1690 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1691 s = XINT (start);
1692 e = XINT (end);
1694 while (! NULL_INTERVAL_P (i))
1696 if (i->position >= e)
1697 break;
1698 if (! EQ (textget (i->plist, property), value))
1700 if (i->position > s)
1701 s = i->position;
1702 return make_number (s);
1704 i = next_interval (i);
1706 return Qnil;
1710 /* Return the direction from which the text-property PROP would be
1711 inherited by any new text inserted at POS: 1 if it would be
1712 inherited from the char after POS, -1 if it would be inherited from
1713 the char before POS, and 0 if from neither.
1714 BUFFER can be either a buffer or nil (meaning current buffer). */
1717 text_property_stickiness (prop, pos, buffer)
1718 Lisp_Object prop, pos, buffer;
1720 Lisp_Object prev_pos, front_sticky;
1721 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
1723 if (NILP (buffer))
1724 XSETBUFFER (buffer, current_buffer);
1726 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
1727 /* Consider previous character. */
1729 Lisp_Object rear_non_sticky;
1731 prev_pos = make_number (XINT (pos) - 1);
1732 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1734 if (!NILP (CONSP (rear_non_sticky)
1735 ? Fmemq (prop, rear_non_sticky)
1736 : rear_non_sticky))
1737 /* PROP is rear-non-sticky. */
1738 is_rear_sticky = 0;
1741 /* Consider following character. */
1742 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1744 if (EQ (front_sticky, Qt)
1745 || (CONSP (front_sticky)
1746 && !NILP (Fmemq (prop, front_sticky))))
1747 /* PROP is inherited from after. */
1748 is_front_sticky = 1;
1750 /* Simple cases, where the properties are consistent. */
1751 if (is_rear_sticky && !is_front_sticky)
1752 return -1;
1753 else if (!is_rear_sticky && is_front_sticky)
1754 return 1;
1755 else if (!is_rear_sticky && !is_front_sticky)
1756 return 0;
1758 /* The stickiness properties are inconsistent, so we have to
1759 disambiguate. Basically, rear-sticky wins, _except_ if the
1760 property that would be inherited has a value of nil, in which case
1761 front-sticky wins. */
1762 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1763 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1764 return 1;
1765 else
1766 return -1;
1770 /* I don't think this is the right interface to export; how often do you
1771 want to do something like this, other than when you're copying objects
1772 around?
1774 I think it would be better to have a pair of functions, one which
1775 returns the text properties of a region as a list of ranges and
1776 plists, and another which applies such a list to another object. */
1778 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1779 SRC and DEST may each refer to strings or buffers.
1780 Optional sixth argument PROP causes only that property to be copied.
1781 Properties are copied to DEST as if by `add-text-properties'.
1782 Return t if any property value actually changed, nil otherwise. */
1784 /* Note this can GC when DEST is a buffer. */
1786 Lisp_Object
1787 copy_text_properties (start, end, src, pos, dest, prop)
1788 Lisp_Object start, end, src, pos, dest, prop;
1790 INTERVAL i;
1791 Lisp_Object res;
1792 Lisp_Object stuff;
1793 Lisp_Object plist;
1794 int s, e, e2, p, len, modified = 0;
1795 struct gcpro gcpro1, gcpro2;
1797 i = validate_interval_range (src, &start, &end, soft);
1798 if (NULL_INTERVAL_P (i))
1799 return Qnil;
1801 CHECK_NUMBER_COERCE_MARKER (pos);
1803 Lisp_Object dest_start, dest_end;
1805 dest_start = pos;
1806 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
1807 /* Apply this to a copy of pos; it will try to increment its arguments,
1808 which we don't want. */
1809 validate_interval_range (dest, &dest_start, &dest_end, soft);
1812 s = XINT (start);
1813 e = XINT (end);
1814 p = XINT (pos);
1816 stuff = Qnil;
1818 while (s < e)
1820 e2 = i->position + LENGTH (i);
1821 if (e2 > e)
1822 e2 = e;
1823 len = e2 - s;
1825 plist = i->plist;
1826 if (! NILP (prop))
1827 while (! NILP (plist))
1829 if (EQ (Fcar (plist), prop))
1831 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1832 break;
1834 plist = Fcdr (Fcdr (plist));
1836 if (! NILP (plist))
1838 /* Must defer modifications to the interval tree in case src
1839 and dest refer to the same string or buffer. */
1840 stuff = Fcons (Fcons (make_number (p),
1841 Fcons (make_number (p + len),
1842 Fcons (plist, Qnil))),
1843 stuff);
1846 i = next_interval (i);
1847 if (NULL_INTERVAL_P (i))
1848 break;
1850 p += len;
1851 s = i->position;
1854 GCPRO2 (stuff, dest);
1856 while (! NILP (stuff))
1858 res = Fcar (stuff);
1859 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1860 Fcar (Fcdr (Fcdr (res))), dest);
1861 if (! NILP (res))
1862 modified++;
1863 stuff = Fcdr (stuff);
1866 UNGCPRO;
1868 return modified ? Qt : Qnil;
1872 /* Return a list representing the text properties of OBJECT between
1873 START and END. if PROP is non-nil, report only on that property.
1874 Each result list element has the form (S E PLIST), where S and E
1875 are positions in OBJECT and PLIST is a property list containing the
1876 text properties of OBJECT between S and E. Value is nil if OBJECT
1877 doesn't contain text properties between START and END. */
1879 Lisp_Object
1880 text_property_list (object, start, end, prop)
1881 Lisp_Object object, start, end, prop;
1883 struct interval *i;
1884 Lisp_Object result;
1886 result = Qnil;
1888 i = validate_interval_range (object, &start, &end, soft);
1889 if (!NULL_INTERVAL_P (i))
1891 int s = XINT (start);
1892 int e = XINT (end);
1894 while (s < e)
1896 int interval_end, len;
1897 Lisp_Object plist;
1899 interval_end = i->position + LENGTH (i);
1900 if (interval_end > e)
1901 interval_end = e;
1902 len = interval_end - s;
1904 plist = i->plist;
1906 if (!NILP (prop))
1907 for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
1908 if (EQ (Fcar (plist), prop))
1910 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1911 break;
1914 if (!NILP (plist))
1915 result = Fcons (Fcons (make_number (s),
1916 Fcons (make_number (s + len),
1917 Fcons (plist, Qnil))),
1918 result);
1920 i = next_interval (i);
1921 if (NULL_INTERVAL_P (i))
1922 break;
1923 s = i->position;
1927 return result;
1931 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1932 (START END PLIST), where START and END are positions and PLIST is a
1933 property list containing the text properties to add. Adjust START
1934 and END positions by DELTA before adding properties. Value is
1935 non-zero if OBJECT was modified. */
1938 add_text_properties_from_list (object, list, delta)
1939 Lisp_Object object, list, delta;
1941 struct gcpro gcpro1, gcpro2;
1942 int modified_p = 0;
1944 GCPRO2 (list, object);
1946 for (; CONSP (list); list = XCDR (list))
1948 Lisp_Object item, start, end, plist, tem;
1950 item = XCAR (list);
1951 start = make_number (XINT (XCAR (item)) + XINT (delta));
1952 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
1953 plist = XCAR (XCDR (XCDR (item)));
1955 tem = Fadd_text_properties (start, end, plist, object);
1956 if (!NILP (tem))
1957 modified_p = 1;
1960 UNGCPRO;
1961 return modified_p;
1966 /* Modify end-points of ranges in LIST destructively. LIST is a list
1967 as returned from text_property_list. Change end-points equal to
1968 OLD_END to NEW_END. */
1970 void
1971 extend_property_ranges (list, old_end, new_end)
1972 Lisp_Object list, old_end, new_end;
1974 for (; CONSP (list); list = XCDR (list))
1976 Lisp_Object item, end;
1978 item = XCAR (list);
1979 end = XCAR (XCDR (item));
1981 if (EQ (end, old_end))
1982 XSETCAR (XCDR (item), new_end);
1988 /* Call the modification hook functions in LIST, each with START and END. */
1990 static void
1991 call_mod_hooks (list, start, end)
1992 Lisp_Object list, start, end;
1994 struct gcpro gcpro1;
1995 GCPRO1 (list);
1996 while (!NILP (list))
1998 call2 (Fcar (list), start, end);
1999 list = Fcdr (list);
2001 UNGCPRO;
2004 /* Check for read-only intervals between character positions START ... END,
2005 in BUF, and signal an error if we find one.
2007 Then check for any modification hooks in the range.
2008 Create a list of all these hooks in lexicographic order,
2009 eliminating consecutive extra copies of the same hook. Then call
2010 those hooks in order, with START and END - 1 as arguments. */
2012 void
2013 verify_interval_modification (buf, start, end)
2014 struct buffer *buf;
2015 int start, end;
2017 register INTERVAL intervals = BUF_INTERVALS (buf);
2018 register INTERVAL i;
2019 Lisp_Object hooks;
2020 register Lisp_Object prev_mod_hooks;
2021 Lisp_Object mod_hooks;
2022 struct gcpro gcpro1;
2024 hooks = Qnil;
2025 prev_mod_hooks = Qnil;
2026 mod_hooks = Qnil;
2028 interval_insert_behind_hooks = Qnil;
2029 interval_insert_in_front_hooks = Qnil;
2031 if (NULL_INTERVAL_P (intervals))
2032 return;
2034 if (start > end)
2036 int temp = start;
2037 start = end;
2038 end = temp;
2041 /* For an insert operation, check the two chars around the position. */
2042 if (start == end)
2044 INTERVAL prev = NULL;
2045 Lisp_Object before, after;
2047 /* Set I to the interval containing the char after START,
2048 and PREV to the interval containing the char before START.
2049 Either one may be null. They may be equal. */
2050 i = find_interval (intervals, start);
2052 if (start == BUF_BEGV (buf))
2053 prev = 0;
2054 else if (i->position == start)
2055 prev = previous_interval (i);
2056 else if (i->position < start)
2057 prev = i;
2058 if (start == BUF_ZV (buf))
2059 i = 0;
2061 /* If Vinhibit_read_only is set and is not a list, we can
2062 skip the read_only checks. */
2063 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2065 /* If I and PREV differ we need to check for the read-only
2066 property together with its stickiness. If either I or
2067 PREV are 0, this check is all we need.
2068 We have to take special care, since read-only may be
2069 indirectly defined via the category property. */
2070 if (i != prev)
2072 if (! NULL_INTERVAL_P (i))
2074 after = textget (i->plist, Qread_only);
2076 /* If interval I is read-only and read-only is
2077 front-sticky, inhibit insertion.
2078 Check for read-only as well as category. */
2079 if (! NILP (after)
2080 && NILP (Fmemq (after, Vinhibit_read_only)))
2082 Lisp_Object tem;
2084 tem = textget (i->plist, Qfront_sticky);
2085 if (TMEM (Qread_only, tem)
2086 || (NILP (Fplist_get (i->plist, Qread_only))
2087 && TMEM (Qcategory, tem)))
2088 text_read_only (after);
2092 if (! NULL_INTERVAL_P (prev))
2094 before = textget (prev->plist, Qread_only);
2096 /* If interval PREV is read-only and read-only isn't
2097 rear-nonsticky, inhibit insertion.
2098 Check for read-only as well as category. */
2099 if (! NILP (before)
2100 && NILP (Fmemq (before, Vinhibit_read_only)))
2102 Lisp_Object tem;
2104 tem = textget (prev->plist, Qrear_nonsticky);
2105 if (! TMEM (Qread_only, tem)
2106 && (! NILP (Fplist_get (prev->plist,Qread_only))
2107 || ! TMEM (Qcategory, tem)))
2108 text_read_only (before);
2112 else if (! NULL_INTERVAL_P (i))
2114 after = textget (i->plist, Qread_only);
2116 /* If interval I is read-only and read-only is
2117 front-sticky, inhibit insertion.
2118 Check for read-only as well as category. */
2119 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2121 Lisp_Object tem;
2123 tem = textget (i->plist, Qfront_sticky);
2124 if (TMEM (Qread_only, tem)
2125 || (NILP (Fplist_get (i->plist, Qread_only))
2126 && TMEM (Qcategory, tem)))
2127 text_read_only (after);
2129 tem = textget (prev->plist, Qrear_nonsticky);
2130 if (! TMEM (Qread_only, tem)
2131 && (! NILP (Fplist_get (prev->plist, Qread_only))
2132 || ! TMEM (Qcategory, tem)))
2133 text_read_only (after);
2138 /* Run both insert hooks (just once if they're the same). */
2139 if (!NULL_INTERVAL_P (prev))
2140 interval_insert_behind_hooks
2141 = textget (prev->plist, Qinsert_behind_hooks);
2142 if (!NULL_INTERVAL_P (i))
2143 interval_insert_in_front_hooks
2144 = textget (i->plist, Qinsert_in_front_hooks);
2146 else
2148 /* Loop over intervals on or next to START...END,
2149 collecting their hooks. */
2151 i = find_interval (intervals, start);
2154 if (! INTERVAL_WRITABLE_P (i))
2155 text_read_only (textget (i->plist, Qread_only));
2157 if (!inhibit_modification_hooks)
2159 mod_hooks = textget (i->plist, Qmodification_hooks);
2160 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2162 hooks = Fcons (mod_hooks, hooks);
2163 prev_mod_hooks = mod_hooks;
2167 i = next_interval (i);
2169 /* Keep going thru the interval containing the char before END. */
2170 while (! NULL_INTERVAL_P (i) && i->position < end);
2172 if (!inhibit_modification_hooks)
2174 GCPRO1 (hooks);
2175 hooks = Fnreverse (hooks);
2176 while (! EQ (hooks, Qnil))
2178 call_mod_hooks (Fcar (hooks), make_number (start),
2179 make_number (end));
2180 hooks = Fcdr (hooks);
2182 UNGCPRO;
2187 /* Run the interval hooks for an insertion on character range START ... END.
2188 verify_interval_modification chose which hooks to run;
2189 this function is called after the insertion happens
2190 so it can indicate the range of inserted text. */
2192 void
2193 report_interval_modification (start, end)
2194 Lisp_Object start, end;
2196 if (! NILP (interval_insert_behind_hooks))
2197 call_mod_hooks (interval_insert_behind_hooks, start, end);
2198 if (! NILP (interval_insert_in_front_hooks)
2199 && ! EQ (interval_insert_in_front_hooks,
2200 interval_insert_behind_hooks))
2201 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2204 void
2205 syms_of_textprop ()
2207 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
2208 doc: /* Property-list used as default values.
2209 The value of a property in this list is seen as the value for every
2210 character that does not have its own value for that property. */);
2211 Vdefault_text_properties = Qnil;
2213 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist,
2214 doc: /* Alist of alternative properties for properties without a value.
2215 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2216 If a piece of text has no direct value for a particular property, then
2217 this alist is consulted. If that property appears in the alist, then
2218 the first non-nil value from the associated alternative properties is
2219 returned. */);
2220 Vchar_property_alias_alist = Qnil;
2222 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
2223 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2224 This also inhibits the use of the `intangible' text property. */);
2225 Vinhibit_point_motion_hooks = Qnil;
2227 DEFVAR_LISP ("text-property-default-nonsticky",
2228 &Vtext_property_default_nonsticky,
2229 doc: /* Alist of properties vs the corresponding non-stickinesses.
2230 Each element has the form (PROPERTY . NONSTICKINESS).
2232 If a character in a buffer has PROPERTY, new text inserted adjacent to
2233 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2234 inherits it if NONSTICKINESS is nil. The front-sticky and
2235 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
2236 /* Text property `syntax-table' should be nonsticky by default. */
2237 Vtext_property_default_nonsticky
2238 = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil);
2240 staticpro (&interval_insert_behind_hooks);
2241 staticpro (&interval_insert_in_front_hooks);
2242 interval_insert_behind_hooks = Qnil;
2243 interval_insert_in_front_hooks = Qnil;
2246 /* Common attributes one might give text */
2248 staticpro (&Qforeground);
2249 Qforeground = intern ("foreground");
2250 staticpro (&Qbackground);
2251 Qbackground = intern ("background");
2252 staticpro (&Qfont);
2253 Qfont = intern ("font");
2254 staticpro (&Qstipple);
2255 Qstipple = intern ("stipple");
2256 staticpro (&Qunderline);
2257 Qunderline = intern ("underline");
2258 staticpro (&Qread_only);
2259 Qread_only = intern ("read-only");
2260 staticpro (&Qinvisible);
2261 Qinvisible = intern ("invisible");
2262 staticpro (&Qintangible);
2263 Qintangible = intern ("intangible");
2264 staticpro (&Qcategory);
2265 Qcategory = intern ("category");
2266 staticpro (&Qlocal_map);
2267 Qlocal_map = intern ("local-map");
2268 staticpro (&Qfront_sticky);
2269 Qfront_sticky = intern ("front-sticky");
2270 staticpro (&Qrear_nonsticky);
2271 Qrear_nonsticky = intern ("rear-nonsticky");
2272 staticpro (&Qmouse_face);
2273 Qmouse_face = intern ("mouse-face");
2275 /* Properties that text might use to specify certain actions */
2277 staticpro (&Qmouse_left);
2278 Qmouse_left = intern ("mouse-left");
2279 staticpro (&Qmouse_entered);
2280 Qmouse_entered = intern ("mouse-entered");
2281 staticpro (&Qpoint_left);
2282 Qpoint_left = intern ("point-left");
2283 staticpro (&Qpoint_entered);
2284 Qpoint_entered = intern ("point-entered");
2286 defsubr (&Stext_properties_at);
2287 defsubr (&Sget_text_property);
2288 defsubr (&Sget_char_property);
2289 defsubr (&Sget_char_property_and_overlay);
2290 defsubr (&Snext_char_property_change);
2291 defsubr (&Sprevious_char_property_change);
2292 defsubr (&Snext_single_char_property_change);
2293 defsubr (&Sprevious_single_char_property_change);
2294 defsubr (&Snext_property_change);
2295 defsubr (&Snext_single_property_change);
2296 defsubr (&Sprevious_property_change);
2297 defsubr (&Sprevious_single_property_change);
2298 defsubr (&Sadd_text_properties);
2299 defsubr (&Sput_text_property);
2300 defsubr (&Sset_text_properties);
2301 defsubr (&Sremove_text_properties);
2302 defsubr (&Sremove_list_of_text_properties);
2303 defsubr (&Stext_property_any);
2304 defsubr (&Stext_property_not_all);
2305 /* defsubr (&Serase_text_properties); */
2306 /* defsubr (&Scopy_text_properties); */
2309 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
2310 (do not change this comment) */