; * lisp/startup.el (normal-top-level): Fix previous change.
[emacs.git] / src / textprop.c
blobf6dbab09228b1cc412475ab9f4d561b1dc8279bf
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2015 Free Software Foundation,
3 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 3 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
22 #include "lisp.h"
23 #include "intervals.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "window.h"
28 /* Test for membership, allowing for t (actually any non-cons) to mean the
29 universal set. */
31 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
34 /* NOTES: previous- and next- property change will have to skip
35 zero-length intervals if they are implemented. This could be done
36 inside next_interval and previous_interval.
38 set_properties needs to deal with the interval property cache.
40 It is assumed that for any interval plist, a property appears
41 only once on the list. Although some code i.e., remove_properties,
42 handles the more general case, the uniqueness of properties is
43 necessary for the system to remain consistent. This requirement
44 is enforced by the subrs installing properties onto the intervals. */
48 enum property_set_type
50 TEXT_PROPERTY_REPLACE,
51 TEXT_PROPERTY_PREPEND,
52 TEXT_PROPERTY_APPEND
55 /* If o1 is a cons whose cdr is a cons, return true and set o2 to
56 the o1's cdr. Otherwise, return false. This is handy for
57 traversing plists. */
58 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
60 /* verify_interval_modification saves insertion hooks here
61 to be run later by report_interval_modification. */
62 static Lisp_Object interval_insert_behind_hooks;
63 static Lisp_Object interval_insert_in_front_hooks;
66 /* Signal a `text-read-only' error. This function makes it easier
67 to capture that error in GDB by putting a breakpoint on it. */
69 static _Noreturn void
70 text_read_only (Lisp_Object propval)
72 if (STRINGP (propval))
73 xsignal1 (Qtext_read_only, propval);
75 xsignal0 (Qtext_read_only);
78 /* Prepare to modify the text properties of BUFFER from START to END. */
80 static void
81 modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
83 ptrdiff_t b = XINT (start), e = XINT (end);
84 struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
86 set_buffer_internal (buf);
88 prepare_to_modify_buffer_1 (b, e, NULL);
90 BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
91 if (MODIFF <= SAVE_MODIFF)
92 record_first_change ();
93 MODIFF++;
95 bset_point_before_scroll (current_buffer, Qnil);
97 set_buffer_internal (old);
100 /* Complain if object is not string or buffer type. */
102 static void
103 CHECK_STRING_OR_BUFFER (Lisp_Object x)
105 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
108 /* Extract the interval at the position pointed to by BEGIN from
109 OBJECT, a string or buffer. Additionally, check that the positions
110 pointed to by BEGIN and END are within the bounds of OBJECT, and
111 reverse them if *BEGIN is greater than *END. The objects pointed
112 to by BEGIN and END may be integers or markers; if the latter, they
113 are coerced to integers.
115 When OBJECT is a string, we increment *BEGIN and *END
116 to make them origin-one.
118 Note that buffer points don't correspond to interval indices.
119 For example, point-max is 1 greater than the index of the last
120 character. This difference is handled in the caller, which uses
121 the validated points to determine a length, and operates on that.
122 Exceptions are Ftext_properties_at, Fnext_property_change, and
123 Fprevious_property_change which call this function with BEGIN == END.
124 Handle this case specially.
126 If FORCE is soft (false), it's OK to return NULL. Otherwise,
127 create an interval tree for OBJECT if one doesn't exist, provided
128 the object actually contains text. In the current design, if there
129 is no text, there can be no text properties. */
131 enum { soft = false, hard = true };
133 INTERVAL
134 validate_interval_range (Lisp_Object object, Lisp_Object *begin,
135 Lisp_Object *end, bool force)
137 INTERVAL i;
138 ptrdiff_t searchpos;
140 CHECK_STRING_OR_BUFFER (object);
141 CHECK_NUMBER_COERCE_MARKER (*begin);
142 CHECK_NUMBER_COERCE_MARKER (*end);
144 /* If we are asked for a point, but from a subr which operates
145 on a range, then return nothing. */
146 if (EQ (*begin, *end) && begin != end)
147 return NULL;
149 if (XINT (*begin) > XINT (*end))
151 Lisp_Object n;
152 n = *begin;
153 *begin = *end;
154 *end = n;
157 if (BUFFERP (object))
159 register struct buffer *b = XBUFFER (object);
161 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
162 && XINT (*end) <= BUF_ZV (b)))
163 args_out_of_range (*begin, *end);
164 i = buffer_intervals (b);
166 /* If there's no text, there are no properties. */
167 if (BUF_BEGV (b) == BUF_ZV (b))
168 return NULL;
170 searchpos = XINT (*begin);
172 else
174 ptrdiff_t len = SCHARS (object);
176 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
177 && XINT (*end) <= len))
178 args_out_of_range (*begin, *end);
179 XSETFASTINT (*begin, XFASTINT (*begin));
180 if (begin != end)
181 XSETFASTINT (*end, XFASTINT (*end));
182 i = string_intervals (object);
184 if (len == 0)
185 return NULL;
187 searchpos = XINT (*begin);
190 if (!i)
191 return (force ? create_root_interval (object) : i);
193 return find_interval (i, searchpos);
196 /* Validate LIST as a property list. If LIST is not a list, then
197 make one consisting of (LIST nil). Otherwise, verify that LIST
198 is even numbered and thus suitable as a plist. */
200 static Lisp_Object
201 validate_plist (Lisp_Object list)
203 if (NILP (list))
204 return Qnil;
206 if (CONSP (list))
208 Lisp_Object tail = list;
211 tail = XCDR (tail);
212 if (! CONSP (tail))
213 error ("Odd length text property list");
214 tail = XCDR (tail);
215 QUIT;
217 while (CONSP (tail));
219 return list;
222 return list2 (list, Qnil);
225 /* Return true if interval I has all the properties,
226 with the same values, of list PLIST. */
228 static bool
229 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
231 Lisp_Object tail1, tail2;
233 /* Go through each element of PLIST. */
234 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
236 Lisp_Object sym1 = XCAR (tail1);
237 bool found = false;
239 /* Go through I's plist, looking for sym1 */
240 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
241 if (EQ (sym1, XCAR (tail2)))
243 /* Found the same property on both lists. If the
244 values are unequal, return false. */
245 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
246 return false;
248 /* Property has same value on both lists; go to next one. */
249 found = true;
250 break;
253 if (! found)
254 return false;
257 return true;
260 /* Return true if the plist of interval I has any of the
261 properties of PLIST, regardless of their values. */
263 static bool
264 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
266 Lisp_Object tail1, tail2, sym;
268 /* Go through each element of PLIST. */
269 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
271 sym = XCAR (tail1);
273 /* Go through i's plist, looking for tail1 */
274 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
275 if (EQ (sym, XCAR (tail2)))
276 return true;
279 return false;
282 /* Return true if the plist of interval I has any of the
283 property names in LIST, regardless of their values. */
285 static bool
286 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
288 Lisp_Object tail1, tail2, sym;
290 /* Go through each element of LIST. */
291 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
293 sym = XCAR (tail1);
295 /* Go through i's plist, looking for tail1 */
296 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
297 if (EQ (sym, XCAR (tail2)))
298 return true;
301 return false;
304 /* Changing the plists of individual intervals. */
306 /* Return the value of PROP in property-list PLIST, or Qunbound if it
307 has none. */
308 static Lisp_Object
309 property_value (Lisp_Object plist, Lisp_Object prop)
311 Lisp_Object value;
313 while (PLIST_ELT_P (plist, value))
314 if (EQ (XCAR (plist), prop))
315 return XCAR (value);
316 else
317 plist = XCDR (value);
319 return Qunbound;
322 /* Set the properties of INTERVAL to PROPERTIES,
323 and record undo info for the previous values.
324 OBJECT is the string or buffer that INTERVAL belongs to. */
326 static void
327 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
329 Lisp_Object sym, value;
331 if (BUFFERP (object))
333 /* For each property in the old plist which is missing from PROPERTIES,
334 or has a different value in PROPERTIES, make an undo record. */
335 for (sym = interval->plist;
336 PLIST_ELT_P (sym, value);
337 sym = XCDR (value))
338 if (! EQ (property_value (properties, XCAR (sym)),
339 XCAR (value)))
341 record_property_change (interval->position, LENGTH (interval),
342 XCAR (sym), XCAR (value),
343 object);
346 /* For each new property that has no value at all in the old plist,
347 make an undo record binding it to nil, so it will be removed. */
348 for (sym = properties;
349 PLIST_ELT_P (sym, value);
350 sym = XCDR (value))
351 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
353 record_property_change (interval->position, LENGTH (interval),
354 XCAR (sym), Qnil,
355 object);
359 /* Store new properties. */
360 set_interval_plist (interval, Fcopy_sequence (properties));
363 /* Add the properties of PLIST to the interval I, or set
364 the value of I's property to the value of the property on PLIST
365 if they are different.
367 OBJECT should be the string or buffer the interval is in.
369 Return true if this changes I (i.e., if any members of PLIST
370 are actually added to I's plist) */
372 static bool
373 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
374 enum property_set_type set_type)
376 Lisp_Object tail1, tail2, sym1, val1;
377 bool changed = false;
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; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
391 bool found = false;
392 sym1 = XCAR (tail1);
393 val1 = Fcar (XCDR (tail1));
395 /* Go through I's plist, looking for sym1 */
396 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
397 if (EQ (sym1, XCAR (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 = XCDR (tail2);
404 /* Found the property. Now check its value. */
405 found = true;
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 if (set_type == TEXT_PROPERTY_REPLACE)
421 Fsetcar (this_cdr, val1);
422 else {
423 if (CONSP (Fcar (this_cdr)) &&
424 /* Special-case anonymous face properties. */
425 (! EQ (sym1, Qface) ||
426 NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
427 /* The previous value is a list, so prepend (or
428 append) the new value to this list. */
429 if (set_type == TEXT_PROPERTY_PREPEND)
430 Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
431 else
432 nconc2 (Fcar (this_cdr), list1 (val1));
433 else {
434 /* The previous value is a single value, so make it
435 into a list. */
436 if (set_type == TEXT_PROPERTY_PREPEND)
437 Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
438 else
439 Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
442 changed = true;
443 break;
446 if (! found)
448 /* Record this change in the buffer, for undo purposes. */
449 if (BUFFERP (object))
451 record_property_change (i->position, LENGTH (i),
452 sym1, Qnil, object);
454 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
455 changed = true;
459 UNGCPRO;
461 return changed;
464 /* For any members of PLIST, or LIST,
465 which are properties of I, remove them from I's plist.
466 (If PLIST is non-nil, use that, otherwise use LIST.)
467 OBJECT is the string or buffer containing I. */
469 static bool
470 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
472 bool changed = false;
474 /* True means tail1 is a plist, otherwise it is a list. */
475 bool use_plist = ! NILP (plist);
476 Lisp_Object tail1 = use_plist ? plist : list;
478 Lisp_Object current_plist = i->plist;
480 /* Go through each element of LIST or PLIST. */
481 while (CONSP (tail1))
483 Lisp_Object sym = XCAR (tail1);
485 /* First, remove the symbol if it's at the head of the list */
486 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
488 if (BUFFERP (object))
489 record_property_change (i->position, LENGTH (i),
490 sym, XCAR (XCDR (current_plist)),
491 object);
493 current_plist = XCDR (XCDR (current_plist));
494 changed = true;
497 /* Go through I's plist, looking for SYM. */
498 Lisp_Object tail2 = current_plist;
499 while (! NILP (tail2))
501 Lisp_Object this = XCDR (XCDR (tail2));
502 if (CONSP (this) && EQ (sym, XCAR (this)))
504 if (BUFFERP (object))
505 record_property_change (i->position, LENGTH (i),
506 sym, XCAR (XCDR (this)), object);
508 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
509 changed = true;
511 tail2 = this;
514 /* Advance thru TAIL1 one way or the other. */
515 tail1 = XCDR (tail1);
516 if (use_plist && CONSP (tail1))
517 tail1 = XCDR (tail1);
520 if (changed)
521 set_interval_plist (i, current_plist);
522 return changed;
525 /* Returns the interval of POSITION in OBJECT.
526 POSITION is BEG-based. */
528 INTERVAL
529 interval_of (ptrdiff_t position, Lisp_Object object)
531 register INTERVAL i;
532 ptrdiff_t beg, end;
534 if (NILP (object))
535 XSETBUFFER (object, current_buffer);
536 else if (EQ (object, Qt))
537 return NULL;
539 CHECK_STRING_OR_BUFFER (object);
541 if (BUFFERP (object))
543 register struct buffer *b = XBUFFER (object);
545 beg = BUF_BEGV (b);
546 end = BUF_ZV (b);
547 i = buffer_intervals (b);
549 else
551 beg = 0;
552 end = SCHARS (object);
553 i = string_intervals (object);
556 if (!(beg <= position && position <= end))
557 args_out_of_range (make_number (position), make_number (position));
558 if (beg == end || !i)
559 return NULL;
561 return find_interval (i, position);
564 DEFUN ("text-properties-at", Ftext_properties_at,
565 Stext_properties_at, 1, 2, 0,
566 doc: /* Return the list of properties of the character at POSITION in OBJECT.
567 If the optional second argument OBJECT is a buffer (or nil, which means
568 the current buffer), POSITION is a buffer position (integer or marker).
569 If OBJECT is a string, POSITION is a 0-based index into it.
570 If POSITION is at the end of OBJECT, the value is nil. */)
571 (Lisp_Object position, Lisp_Object object)
573 register INTERVAL i;
575 if (NILP (object))
576 XSETBUFFER (object, current_buffer);
578 i = validate_interval_range (object, &position, &position, soft);
579 if (!i)
580 return Qnil;
581 /* If POSITION is at the end of the interval,
582 it means it's the end of OBJECT.
583 There are no properties at the very end,
584 since no character follows. */
585 if (XINT (position) == LENGTH (i) + i->position)
586 return Qnil;
588 return i->plist;
591 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
592 doc: /* Return the value of POSITION's property PROP, in OBJECT.
593 OBJECT should be a buffer or a string; if omitted or nil, it defaults
594 to the current buffer.
595 If POSITION is at the end of OBJECT, the value is nil. */)
596 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
598 return textget (Ftext_properties_at (position, object), prop);
601 /* Return the value of char's property PROP, in OBJECT at POSITION.
602 OBJECT is optional and defaults to the current buffer.
603 If OVERLAY is non-0, then in the case that the returned property is from
604 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
605 returned in *OVERLAY.
606 If POSITION is at the end of OBJECT, the value is nil.
607 If OBJECT is a buffer, then overlay properties are considered as well as
608 text properties.
609 If OBJECT is a window, then that window's buffer is used, but
610 window-specific overlays are considered only if they are associated
611 with OBJECT. */
612 Lisp_Object
613 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
615 struct window *w = 0;
617 CHECK_NUMBER_COERCE_MARKER (position);
619 if (NILP (object))
620 XSETBUFFER (object, current_buffer);
622 if (WINDOWP (object))
624 CHECK_LIVE_WINDOW (object);
625 w = XWINDOW (object);
626 object = w->contents;
628 if (BUFFERP (object))
630 ptrdiff_t noverlays;
631 Lisp_Object *overlay_vec;
632 struct buffer *obuf = current_buffer;
634 if (XINT (position) < BUF_BEGV (XBUFFER (object))
635 || XINT (position) > BUF_ZV (XBUFFER (object)))
636 xsignal1 (Qargs_out_of_range, position);
638 set_buffer_temp (XBUFFER (object));
640 USE_SAFE_ALLOCA;
641 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, false);
642 noverlays = sort_overlays (overlay_vec, noverlays, w);
644 set_buffer_temp (obuf);
646 /* Now check the overlays in order of decreasing priority. */
647 while (--noverlays >= 0)
649 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
650 if (!NILP (tem))
652 if (overlay)
653 /* Return the overlay we got the property from. */
654 *overlay = overlay_vec[noverlays];
655 SAFE_FREE ();
656 return tem;
659 SAFE_FREE ();
662 if (overlay)
663 /* Indicate that the return value is not from an overlay. */
664 *overlay = Qnil;
666 /* Not a buffer, or no appropriate overlay, so fall through to the
667 simpler case. */
668 return Fget_text_property (position, prop, object);
671 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
672 doc: /* Return the value of POSITION's property PROP, in OBJECT.
673 Both overlay properties and text properties are checked.
674 OBJECT is optional and defaults to the current buffer.
675 If POSITION is at the end of OBJECT, the value is nil.
676 If OBJECT is a buffer, then overlay properties are considered as well as
677 text properties.
678 If OBJECT is a window, then that window's buffer is used, but window-specific
679 overlays are considered only if they are associated with OBJECT. */)
680 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
682 return get_char_property_and_overlay (position, prop, object, 0);
685 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
686 Sget_char_property_and_overlay, 2, 3, 0,
687 doc: /* Like `get-char-property', but with extra overlay information.
688 The value is a cons cell. Its car is the return value of `get-char-property'
689 with the same arguments--that is, the value of POSITION's property
690 PROP in OBJECT. Its cdr is the overlay in which the property was
691 found, or nil, if it was found as a text property or not found at all.
693 OBJECT is optional and defaults to the current buffer. OBJECT may be
694 a string, a buffer or a window. For strings, the cdr of the return
695 value is always nil, since strings do not have overlays. If OBJECT is
696 a window, then that window's buffer is used, but window-specific
697 overlays are considered only if they are associated with OBJECT. If
698 POSITION is at the end of OBJECT, both car and cdr are nil. */)
699 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
701 Lisp_Object overlay;
702 Lisp_Object val
703 = get_char_property_and_overlay (position, prop, object, &overlay);
704 return Fcons (val, overlay);
708 DEFUN ("next-char-property-change", Fnext_char_property_change,
709 Snext_char_property_change, 1, 2, 0,
710 doc: /* Return the position of next text property or overlay change.
711 This scans characters forward in the current buffer from POSITION till
712 it finds a change in some text property, or the beginning or end of an
713 overlay, and returns the position of that.
714 If none is found, and LIMIT is nil or omitted, the function
715 returns (point-max).
717 If the optional second argument LIMIT is non-nil, the function doesn't
718 search past position LIMIT, and returns LIMIT if nothing is found
719 before LIMIT. LIMIT is a no-op if it is greater than (point-max). */)
720 (Lisp_Object position, Lisp_Object limit)
722 Lisp_Object temp;
724 temp = Fnext_overlay_change (position);
725 if (! NILP (limit))
727 CHECK_NUMBER_COERCE_MARKER (limit);
728 if (XINT (limit) < XINT (temp))
729 temp = limit;
731 return Fnext_property_change (position, Qnil, temp);
734 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
735 Sprevious_char_property_change, 1, 2, 0,
736 doc: /* Return the position of previous text property or overlay change.
737 Scans characters backward in the current buffer from POSITION till it
738 finds a change in some text property, or the beginning or end of an
739 overlay, and returns the position of that.
740 If none is found, and LIMIT is nil or omitted, the function
741 returns (point-min).
743 If the optional second argument LIMIT is non-nil, the function doesn't
744 search before position LIMIT, and returns LIMIT if nothing is found
745 before LIMIT. LIMIT is a no-op if it is less than (point-min). */)
746 (Lisp_Object position, Lisp_Object limit)
748 Lisp_Object temp;
750 temp = Fprevious_overlay_change (position);
751 if (! NILP (limit))
753 CHECK_NUMBER_COERCE_MARKER (limit);
754 if (XINT (limit) > XINT (temp))
755 temp = limit;
757 return Fprevious_property_change (position, Qnil, temp);
761 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
762 Snext_single_char_property_change, 2, 4, 0,
763 doc: /* Return the position of next text property or overlay change for a specific property.
764 Scans characters forward from POSITION till it finds
765 a change in the PROP property, then returns the position of the change.
766 If the optional third argument OBJECT is a buffer (or nil, which means
767 the current buffer), POSITION is a buffer position (integer or marker).
768 If OBJECT is a string, POSITION is a 0-based index into it.
770 In a string, scan runs to the end of the string, unless LIMIT is non-nil.
771 In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the
772 value cannot exceed that.
773 If the optional fourth argument LIMIT is non-nil, don't search
774 past position LIMIT; return LIMIT if nothing is found before LIMIT.
776 The property values are compared with `eq'.
777 If the property is constant all the way to the end of OBJECT, return the
778 last valid position in OBJECT. */)
779 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
781 if (STRINGP (object))
783 position = Fnext_single_property_change (position, prop, object, limit);
784 if (NILP (position))
786 if (NILP (limit))
787 position = make_number (SCHARS (object));
788 else
790 CHECK_NUMBER (limit);
791 position = limit;
795 else
797 Lisp_Object initial_value, value;
798 ptrdiff_t count = SPECPDL_INDEX ();
800 if (! NILP (object))
801 CHECK_BUFFER (object);
803 if (BUFFERP (object) && current_buffer != XBUFFER (object))
805 record_unwind_current_buffer ();
806 Fset_buffer (object);
809 CHECK_NUMBER_COERCE_MARKER (position);
811 initial_value = Fget_char_property (position, prop, object);
813 if (NILP (limit))
814 XSETFASTINT (limit, ZV);
815 else
816 CHECK_NUMBER_COERCE_MARKER (limit);
818 if (XFASTINT (position) >= XFASTINT (limit))
820 position = limit;
821 if (XFASTINT (position) > ZV)
822 XSETFASTINT (position, ZV);
824 else
825 while (true)
827 position = Fnext_char_property_change (position, limit);
828 if (XFASTINT (position) >= XFASTINT (limit))
830 position = limit;
831 break;
834 value = Fget_char_property (position, prop, object);
835 if (!EQ (value, initial_value))
836 break;
839 unbind_to (count, Qnil);
842 return position;
845 DEFUN ("previous-single-char-property-change",
846 Fprevious_single_char_property_change,
847 Sprevious_single_char_property_change, 2, 4, 0,
848 doc: /* Return the position of previous text property or overlay change for a specific property.
849 Scans characters backward from POSITION till it finds
850 a change in the PROP property, then returns the position of the change.
851 If the optional third argument OBJECT is a buffer (or nil, which means
852 the current buffer), POSITION is a buffer position (integer or marker).
853 If OBJECT is a string, POSITION is a 0-based index into it.
855 In a string, scan runs to the start of the string, unless LIMIT is non-nil.
856 In a buffer, if LIMIT is nil or omitted, it runs to (point-min), and the
857 value cannot be less than that.
858 If the optional fourth argument LIMIT is non-nil, don't search back past
859 position LIMIT; return LIMIT if nothing is found before reaching LIMIT.
861 The property values are compared with `eq'.
862 If the property is constant all the way to the start of OBJECT, return the
863 first valid position in OBJECT. */)
864 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
866 if (STRINGP (object))
868 position = Fprevious_single_property_change (position, prop, object, limit);
869 if (NILP (position))
871 if (NILP (limit))
872 position = make_number (0);
873 else
875 CHECK_NUMBER (limit);
876 position = limit;
880 else
882 ptrdiff_t count = SPECPDL_INDEX ();
884 if (! NILP (object))
885 CHECK_BUFFER (object);
887 if (BUFFERP (object) && current_buffer != XBUFFER (object))
889 record_unwind_current_buffer ();
890 Fset_buffer (object);
893 CHECK_NUMBER_COERCE_MARKER (position);
895 if (NILP (limit))
896 XSETFASTINT (limit, BEGV);
897 else
898 CHECK_NUMBER_COERCE_MARKER (limit);
900 if (XFASTINT (position) <= XFASTINT (limit))
902 position = limit;
903 if (XFASTINT (position) < BEGV)
904 XSETFASTINT (position, BEGV);
906 else
908 Lisp_Object initial_value
909 = Fget_char_property (make_number (XFASTINT (position) - 1),
910 prop, object);
912 while (true)
914 position = Fprevious_char_property_change (position, limit);
916 if (XFASTINT (position) <= XFASTINT (limit))
918 position = limit;
919 break;
921 else
923 Lisp_Object value
924 = Fget_char_property (make_number (XFASTINT (position) - 1),
925 prop, object);
927 if (!EQ (value, initial_value))
928 break;
933 unbind_to (count, Qnil);
936 return position;
939 DEFUN ("next-property-change", Fnext_property_change,
940 Snext_property_change, 1, 3, 0,
941 doc: /* Return the position of next property change.
942 Scans characters forward from POSITION in OBJECT till it finds
943 a change in some text property, then returns the position of the change.
944 If the optional second argument OBJECT is a buffer (or nil, which means
945 the current buffer), POSITION is a buffer position (integer or marker).
946 If OBJECT is a string, POSITION is a 0-based index into it.
947 Return nil if LIMIT is nil or omitted, and the property is constant all
948 the way to the end of OBJECT; if the value is non-nil, it is a position
949 greater than POSITION, never equal.
951 If the optional third argument LIMIT is non-nil, don't search
952 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
953 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
955 register INTERVAL i, next;
957 if (NILP (object))
958 XSETBUFFER (object, current_buffer);
960 if (!NILP (limit) && !EQ (limit, Qt))
961 CHECK_NUMBER_COERCE_MARKER (limit);
963 i = validate_interval_range (object, &position, &position, soft);
965 /* If LIMIT is t, return start of next interval--don't
966 bother checking further intervals. */
967 if (EQ (limit, Qt))
969 if (!i)
970 next = i;
971 else
972 next = next_interval (i);
974 if (!next)
975 XSETFASTINT (position, (STRINGP (object)
976 ? SCHARS (object)
977 : BUF_ZV (XBUFFER (object))));
978 else
979 XSETFASTINT (position, next->position);
980 return position;
983 if (!i)
984 return limit;
986 next = next_interval (i);
988 while (next && intervals_equal (i, next)
989 && (NILP (limit) || next->position < XFASTINT (limit)))
990 next = next_interval (next);
992 if (!next
993 || (next->position
994 >= (INTEGERP (limit)
995 ? XFASTINT (limit)
996 : (STRINGP (object)
997 ? SCHARS (object)
998 : BUF_ZV (XBUFFER (object))))))
999 return limit;
1000 else
1001 return make_number (next->position);
1004 DEFUN ("next-single-property-change", Fnext_single_property_change,
1005 Snext_single_property_change, 2, 4, 0,
1006 doc: /* Return the position of next property change for a specific property.
1007 Scans characters forward from POSITION till it finds
1008 a change in the PROP property, then returns the position of the change.
1009 If the optional third argument OBJECT is a buffer (or nil, which means
1010 the current buffer), POSITION is a buffer position (integer or marker).
1011 If OBJECT is a string, POSITION is a 0-based index into it.
1012 The property values are compared with `eq'.
1013 Return nil if LIMIT is nil or omitted, and the property is constant all
1014 the way to the end of OBJECT; if the value is non-nil, it is a position
1015 greater than POSITION, never equal.
1017 If the optional fourth argument LIMIT is non-nil, don't search
1018 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1019 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1021 register INTERVAL i, next;
1022 register Lisp_Object here_val;
1024 if (NILP (object))
1025 XSETBUFFER (object, current_buffer);
1027 if (!NILP (limit))
1028 CHECK_NUMBER_COERCE_MARKER (limit);
1030 i = validate_interval_range (object, &position, &position, soft);
1031 if (!i)
1032 return limit;
1034 here_val = textget (i->plist, prop);
1035 next = next_interval (i);
1036 while (next
1037 && EQ (here_val, textget (next->plist, prop))
1038 && (NILP (limit) || next->position < XFASTINT (limit)))
1039 next = next_interval (next);
1041 if (!next
1042 || (next->position
1043 >= (INTEGERP (limit)
1044 ? XFASTINT (limit)
1045 : (STRINGP (object)
1046 ? SCHARS (object)
1047 : BUF_ZV (XBUFFER (object))))))
1048 return limit;
1049 else
1050 return make_number (next->position);
1053 DEFUN ("previous-property-change", Fprevious_property_change,
1054 Sprevious_property_change, 1, 3, 0,
1055 doc: /* Return the position of previous property change.
1056 Scans characters backwards from POSITION in OBJECT till it finds
1057 a change in some text property, then returns the position of the change.
1058 If the optional second argument OBJECT is a buffer (or nil, which means
1059 the current buffer), POSITION is a buffer position (integer or marker).
1060 If OBJECT is a string, POSITION is a 0-based index into it.
1061 Return nil if LIMIT is nil or omitted, and the property is constant all
1062 the way to the start of OBJECT; if the value is non-nil, it is a position
1063 less than POSITION, never equal.
1065 If the optional third argument LIMIT is non-nil, don't search
1066 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1067 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1069 register INTERVAL i, previous;
1071 if (NILP (object))
1072 XSETBUFFER (object, current_buffer);
1074 if (!NILP (limit))
1075 CHECK_NUMBER_COERCE_MARKER (limit);
1077 i = validate_interval_range (object, &position, &position, soft);
1078 if (!i)
1079 return limit;
1081 /* Start with the interval containing the char before point. */
1082 if (i->position == XFASTINT (position))
1083 i = previous_interval (i);
1085 previous = previous_interval (i);
1086 while (previous && intervals_equal (previous, i)
1087 && (NILP (limit)
1088 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1089 previous = previous_interval (previous);
1091 if (!previous
1092 || (previous->position + LENGTH (previous)
1093 <= (INTEGERP (limit)
1094 ? XFASTINT (limit)
1095 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1096 return limit;
1097 else
1098 return make_number (previous->position + LENGTH (previous));
1101 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1102 Sprevious_single_property_change, 2, 4, 0,
1103 doc: /* Return the position of previous property change for a specific property.
1104 Scans characters backward from POSITION till it finds
1105 a change in the PROP property, then returns the position of the change.
1106 If the optional third argument OBJECT is a buffer (or nil, which means
1107 the current buffer), POSITION is a buffer position (integer or marker).
1108 If OBJECT is a string, POSITION is a 0-based index into it.
1109 The property values are compared with `eq'.
1110 Return nil if LIMIT is nil or omitted, and the property is constant all
1111 the way to the start of OBJECT; if the value is non-nil, it is a position
1112 less than POSITION, never equal.
1114 If the optional fourth argument LIMIT is non-nil, don't search
1115 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1116 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1118 register INTERVAL i, previous;
1119 register Lisp_Object here_val;
1121 if (NILP (object))
1122 XSETBUFFER (object, current_buffer);
1124 if (!NILP (limit))
1125 CHECK_NUMBER_COERCE_MARKER (limit);
1127 i = validate_interval_range (object, &position, &position, soft);
1129 /* Start with the interval containing the char before point. */
1130 if (i && i->position == XFASTINT (position))
1131 i = previous_interval (i);
1133 if (!i)
1134 return limit;
1136 here_val = textget (i->plist, prop);
1137 previous = previous_interval (i);
1138 while (previous
1139 && EQ (here_val, textget (previous->plist, prop))
1140 && (NILP (limit)
1141 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1142 previous = previous_interval (previous);
1144 if (!previous
1145 || (previous->position + LENGTH (previous)
1146 <= (INTEGERP (limit)
1147 ? XFASTINT (limit)
1148 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1149 return limit;
1150 else
1151 return make_number (previous->position + LENGTH (previous));
1154 /* Used by add-text-properties and add-face-text-property. */
1156 static Lisp_Object
1157 add_text_properties_1 (Lisp_Object start, Lisp_Object end,
1158 Lisp_Object properties, Lisp_Object object,
1159 enum property_set_type set_type) {
1160 INTERVAL i, unchanged;
1161 ptrdiff_t s, len;
1162 bool modified = false;
1163 struct gcpro gcpro1;
1164 bool first_time = true;
1166 properties = validate_plist (properties);
1167 if (NILP (properties))
1168 return Qnil;
1170 if (NILP (object))
1171 XSETBUFFER (object, current_buffer);
1173 retry:
1174 i = validate_interval_range (object, &start, &end, hard);
1175 if (!i)
1176 return Qnil;
1178 s = XINT (start);
1179 len = XINT (end) - s;
1181 /* No need to protect OBJECT, because we GC only if it's a buffer,
1182 and live buffers are always protected. */
1183 GCPRO1 (properties);
1185 /* If this interval already has the properties, we can skip it. */
1186 if (interval_has_all_properties (properties, i))
1188 ptrdiff_t got = LENGTH (i) - (s - i->position);
1192 if (got >= len)
1193 RETURN_UNGCPRO (Qnil);
1194 len -= got;
1195 i = next_interval (i);
1196 got = LENGTH (i);
1198 while (interval_has_all_properties (properties, i));
1200 else if (i->position != s)
1202 /* If we're not starting on an interval boundary, we have to
1203 split this interval. */
1204 unchanged = i;
1205 i = split_interval_right (unchanged, s - unchanged->position);
1206 copy_properties (unchanged, i);
1209 if (BUFFERP (object) && first_time)
1211 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1212 ptrdiff_t prev_pos = i->position;
1214 modify_text_properties (object, start, end);
1215 /* If someone called us recursively as a side effect of
1216 modify_text_properties, and changed the intervals behind our back
1217 (could happen if lock_file, called by prepare_to_modify_buffer,
1218 triggers redisplay, and that calls add-text-properties again
1219 in the same buffer), we cannot continue with I, because its
1220 data changed. So we restart the interval analysis anew. */
1221 if (TOTAL_LENGTH (i) != prev_total_length
1222 || i->position != prev_pos)
1224 first_time = false;
1225 goto retry;
1229 /* We are at the beginning of interval I, with LEN chars to scan. */
1230 for (;;)
1232 eassert (i != 0);
1234 if (LENGTH (i) >= len)
1236 /* We can UNGCPRO safely here, because there will be just
1237 one more chance to gc, in the next call to add_properties,
1238 and after that we will not need PROPERTIES or OBJECT again. */
1239 UNGCPRO;
1241 if (interval_has_all_properties (properties, i))
1243 if (BUFFERP (object))
1244 signal_after_change (XINT (start), XINT (end) - XINT (start),
1245 XINT (end) - XINT (start));
1247 eassert (modified);
1248 return Qt;
1251 if (LENGTH (i) == len)
1253 add_properties (properties, i, object, set_type);
1254 if (BUFFERP (object))
1255 signal_after_change (XINT (start), XINT (end) - XINT (start),
1256 XINT (end) - XINT (start));
1257 return Qt;
1260 /* i doesn't have the properties, and goes past the change limit */
1261 unchanged = i;
1262 i = split_interval_left (unchanged, len);
1263 copy_properties (unchanged, i);
1264 add_properties (properties, i, object, set_type);
1265 if (BUFFERP (object))
1266 signal_after_change (XINT (start), XINT (end) - XINT (start),
1267 XINT (end) - XINT (start));
1268 return Qt;
1271 len -= LENGTH (i);
1272 modified |= add_properties (properties, i, object, set_type);
1273 i = next_interval (i);
1277 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1279 DEFUN ("add-text-properties", Fadd_text_properties,
1280 Sadd_text_properties, 3, 4, 0,
1281 doc: /* Add properties to the text from START to END.
1282 The third argument PROPERTIES is a property list
1283 specifying the property values to add. If the optional fourth argument
1284 OBJECT is a buffer (or nil, which means the current buffer),
1285 START and END are buffer positions (integers or markers).
1286 If OBJECT is a string, START and END are 0-based indices into it.
1287 Return t if any property value actually changed, nil otherwise. */)
1288 (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1289 Lisp_Object object)
1291 return add_text_properties_1 (start, end, properties, object,
1292 TEXT_PROPERTY_REPLACE);
1295 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1297 DEFUN ("put-text-property", Fput_text_property,
1298 Sput_text_property, 4, 5, 0,
1299 doc: /* Set one property of the text from START to END.
1300 The third and fourth arguments PROPERTY and VALUE
1301 specify the property to add.
1302 If the optional fifth argument OBJECT is a buffer (or nil, which means
1303 the current buffer), START and END are buffer positions (integers or
1304 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1305 (Lisp_Object start, Lisp_Object end, Lisp_Object property,
1306 Lisp_Object value, Lisp_Object object)
1308 AUTO_LIST2 (properties, property, value);
1309 Fadd_text_properties (start, end, properties, object);
1310 return Qnil;
1313 DEFUN ("set-text-properties", Fset_text_properties,
1314 Sset_text_properties, 3, 4, 0,
1315 doc: /* Completely replace properties of text from START to END.
1316 The third argument PROPERTIES is the new property list.
1317 If the optional fourth argument OBJECT is a buffer (or nil, which means
1318 the current buffer), START and END are buffer positions (integers or
1319 markers). If OBJECT is a string, START and END are 0-based indices into it.
1320 If PROPERTIES is nil, the effect is to remove all properties from
1321 the designated part of OBJECT. */)
1322 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1324 return set_text_properties (start, end, properties, object, Qt);
1328 DEFUN ("add-face-text-property", Fadd_face_text_property,
1329 Sadd_face_text_property, 3, 5, 0,
1330 doc: /* Add the face property to the text from START to END.
1331 FACE specifies the face to add. It should be a valid value of the
1332 `face' property (typically a face name or a plist of face attributes
1333 and values).
1335 If any text in the region already has a non-nil `face' property, those
1336 face(s) are retained. This is done by setting the `face' property to
1337 a list of faces, with FACE as the first element (by default) and the
1338 pre-existing faces as the remaining elements.
1340 If optional fourth argument APPEND is non-nil, append FACE to the end
1341 of the face list instead.
1343 If optional fifth argument OBJECT is a buffer (or nil, which means the
1344 current buffer), START and END are buffer positions (integers or
1345 markers). If OBJECT is a string, START and END are 0-based indices
1346 into it. */)
1347 (Lisp_Object start, Lisp_Object end, Lisp_Object face,
1348 Lisp_Object append, Lisp_Object object)
1350 AUTO_LIST2 (properties, Qface, face);
1351 add_text_properties_1 (start, end, properties, object,
1352 (NILP (append)
1353 ? TEXT_PROPERTY_PREPEND
1354 : TEXT_PROPERTY_APPEND));
1355 return Qnil;
1358 /* Replace properties of text from START to END with new list of
1359 properties PROPERTIES. OBJECT is the buffer or string containing
1360 the text. OBJECT nil means use the current buffer.
1361 COHERENT_CHANGE_P nil means this is being called as an internal
1362 subroutine, rather than as a change primitive with checking of
1363 read-only, invoking change hooks, etc.. Value is nil if the
1364 function _detected_ that it did not replace any properties, non-nil
1365 otherwise. */
1367 Lisp_Object
1368 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1369 Lisp_Object object, Lisp_Object coherent_change_p)
1371 register INTERVAL i;
1372 Lisp_Object ostart, oend;
1374 ostart = start;
1375 oend = end;
1377 properties = validate_plist (properties);
1379 if (NILP (object))
1380 XSETBUFFER (object, current_buffer);
1382 /* If we want no properties for a whole string,
1383 get rid of its intervals. */
1384 if (NILP (properties) && STRINGP (object)
1385 && XFASTINT (start) == 0
1386 && XFASTINT (end) == SCHARS (object))
1388 if (!string_intervals (object))
1389 return Qnil;
1391 set_string_intervals (object, NULL);
1392 return Qt;
1395 i = validate_interval_range (object, &start, &end, soft);
1397 if (!i)
1399 /* If buffer has no properties, and we want none, return now. */
1400 if (NILP (properties))
1401 return Qnil;
1403 /* Restore the original START and END values
1404 because validate_interval_range increments them for strings. */
1405 start = ostart;
1406 end = oend;
1408 i = validate_interval_range (object, &start, &end, hard);
1409 /* This can return if start == end. */
1410 if (!i)
1411 return Qnil;
1414 if (BUFFERP (object) && !NILP (coherent_change_p))
1415 modify_text_properties (object, start, end);
1417 set_text_properties_1 (start, end, properties, object, i);
1419 if (BUFFERP (object) && !NILP (coherent_change_p))
1420 signal_after_change (XINT (start), XINT (end) - XINT (start),
1421 XINT (end) - XINT (start));
1422 return Qt;
1425 /* Replace properties of text from START to END with new list of
1426 properties PROPERTIES. OBJECT is the buffer or string containing
1427 the text. This does not obey any hooks.
1428 You should provide the interval that START is located in as I.
1429 START and END can be in any order. */
1431 void
1432 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
1434 register INTERVAL prev_changed = NULL;
1435 register ptrdiff_t s, len;
1436 INTERVAL unchanged;
1438 if (XINT (start) < XINT (end))
1440 s = XINT (start);
1441 len = XINT (end) - s;
1443 else if (XINT (end) < XINT (start))
1445 s = XINT (end);
1446 len = XINT (start) - s;
1448 else
1449 return;
1451 eassert (i);
1453 if (i->position != s)
1455 unchanged = i;
1456 i = split_interval_right (unchanged, s - unchanged->position);
1458 if (LENGTH (i) > len)
1460 copy_properties (unchanged, i);
1461 i = split_interval_left (i, len);
1462 set_properties (properties, i, object);
1463 return;
1466 set_properties (properties, i, object);
1468 if (LENGTH (i) == len)
1469 return;
1471 prev_changed = i;
1472 len -= LENGTH (i);
1473 i = next_interval (i);
1476 /* We are starting at the beginning of an interval I. LEN is positive. */
1479 eassert (i != 0);
1481 if (LENGTH (i) >= len)
1483 if (LENGTH (i) > len)
1484 i = split_interval_left (i, len);
1486 /* We have to call set_properties even if we are going to
1487 merge the intervals, so as to make the undo records
1488 and cause redisplay to happen. */
1489 set_properties (properties, i, object);
1490 if (prev_changed)
1491 merge_interval_left (i);
1492 return;
1495 len -= LENGTH (i);
1497 /* We have to call set_properties even if we are going to
1498 merge the intervals, so as to make the undo records
1499 and cause redisplay to happen. */
1500 set_properties (properties, i, object);
1501 if (!prev_changed)
1502 prev_changed = i;
1503 else
1504 prev_changed = i = merge_interval_left (i);
1506 i = next_interval (i);
1508 while (len > 0);
1511 DEFUN ("remove-text-properties", Fremove_text_properties,
1512 Sremove_text_properties, 3, 4, 0,
1513 doc: /* Remove some properties from text from START to END.
1514 The third argument PROPERTIES is a property list
1515 whose property names specify the properties to remove.
1516 \(The values stored in PROPERTIES are ignored.)
1517 If the optional fourth argument OBJECT is a buffer (or nil, which means
1518 the current buffer), START and END are buffer positions (integers or
1519 markers). If OBJECT is a string, START and END are 0-based indices into it.
1520 Return t if any property was actually removed, nil otherwise.
1522 Use `set-text-properties' if you want to remove all text properties. */)
1523 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1525 INTERVAL i, unchanged;
1526 ptrdiff_t s, len;
1527 bool modified = false;
1528 bool first_time = true;
1530 if (NILP (object))
1531 XSETBUFFER (object, current_buffer);
1533 retry:
1534 i = validate_interval_range (object, &start, &end, soft);
1535 if (!i)
1536 return Qnil;
1538 s = XINT (start);
1539 len = XINT (end) - s;
1541 /* If there are no properties on this entire interval, return. */
1542 if (! interval_has_some_properties (properties, i))
1544 ptrdiff_t got = LENGTH (i) - (s - i->position);
1548 if (got >= len)
1549 return Qnil;
1550 len -= got;
1551 i = next_interval (i);
1552 got = LENGTH (i);
1554 while (! interval_has_some_properties (properties, i));
1556 /* Split away the beginning of this interval; what we don't
1557 want to modify. */
1558 else if (i->position != s)
1560 unchanged = i;
1561 i = split_interval_right (unchanged, s - unchanged->position);
1562 copy_properties (unchanged, i);
1565 if (BUFFERP (object) && first_time)
1567 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1568 ptrdiff_t prev_pos = i->position;
1570 modify_text_properties (object, start, end);
1571 /* If someone called us recursively as a side effect of
1572 modify_text_properties, and changed the intervals behind our back
1573 (could happen if lock_file, called by prepare_to_modify_buffer,
1574 triggers redisplay, and that calls add-text-properties again
1575 in the same buffer), we cannot continue with I, because its
1576 data changed. So we restart the interval analysis anew. */
1577 if (TOTAL_LENGTH (i) != prev_total_length
1578 || i->position != prev_pos)
1580 first_time = false;
1581 goto retry;
1585 /* We are at the beginning of an interval, with len to scan */
1586 for (;;)
1588 eassert (i != 0);
1590 if (LENGTH (i) >= len)
1592 if (! interval_has_some_properties (properties, i))
1594 eassert (modified);
1595 if (BUFFERP (object))
1596 signal_after_change (XINT (start), XINT (end) - XINT (start),
1597 XINT (end) - XINT (start));
1598 return Qt;
1601 if (LENGTH (i) == len)
1603 remove_properties (properties, Qnil, i, object);
1604 if (BUFFERP (object))
1605 signal_after_change (XINT (start), XINT (end) - XINT (start),
1606 XINT (end) - XINT (start));
1607 return Qt;
1610 /* i has the properties, and goes past the change limit */
1611 unchanged = i;
1612 i = split_interval_left (i, len);
1613 copy_properties (unchanged, i);
1614 remove_properties (properties, Qnil, i, object);
1615 if (BUFFERP (object))
1616 signal_after_change (XINT (start), XINT (end) - XINT (start),
1617 XINT (end) - XINT (start));
1618 return Qt;
1621 len -= LENGTH (i);
1622 modified |= remove_properties (properties, Qnil, i, object);
1623 i = next_interval (i);
1627 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1628 Sremove_list_of_text_properties, 3, 4, 0,
1629 doc: /* Remove some properties from text from START to END.
1630 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1631 If the optional fourth argument OBJECT is a buffer (or nil, which means
1632 the current buffer), START and END are buffer positions (integers or
1633 markers). If OBJECT is a string, START and END are 0-based indices into it.
1634 Return t if any property was actually removed, nil otherwise. */)
1635 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1637 INTERVAL i, unchanged;
1638 ptrdiff_t s, len;
1639 bool modified = false;
1640 Lisp_Object properties;
1641 properties = list_of_properties;
1643 if (NILP (object))
1644 XSETBUFFER (object, current_buffer);
1646 i = validate_interval_range (object, &start, &end, soft);
1647 if (!i)
1648 return Qnil;
1650 s = XINT (start);
1651 len = XINT (end) - s;
1653 /* If there are no properties on the interval, return. */
1654 if (! interval_has_some_properties_list (properties, i))
1656 ptrdiff_t got = LENGTH (i) - (s - i->position);
1660 if (got >= len)
1661 return Qnil;
1662 len -= got;
1663 i = next_interval (i);
1664 got = LENGTH (i);
1666 while (! interval_has_some_properties_list (properties, i));
1668 /* Split away the beginning of this interval; what we don't
1669 want to modify. */
1670 else if (i->position != s)
1672 unchanged = i;
1673 i = split_interval_right (unchanged, s - unchanged->position);
1674 copy_properties (unchanged, i);
1677 /* We are at the beginning of an interval, with len to scan.
1678 The flag MODIFIED records if changes have been made.
1679 When object is a buffer, we must call modify_text_properties
1680 before changes are made and signal_after_change when we are done.
1681 Call modify_text_properties before calling remove_properties if !MODIFIED,
1682 and call signal_after_change before returning if MODIFIED. */
1683 for (;;)
1685 eassert (i != 0);
1687 if (LENGTH (i) >= len)
1689 if (! interval_has_some_properties_list (properties, i))
1691 if (modified)
1693 if (BUFFERP (object))
1694 signal_after_change (XINT (start),
1695 XINT (end) - XINT (start),
1696 XINT (end) - XINT (start));
1697 return Qt;
1699 else
1700 return Qnil;
1702 else if (LENGTH (i) == len)
1704 if (!modified && BUFFERP (object))
1705 modify_text_properties (object, start, end);
1706 remove_properties (Qnil, properties, i, object);
1707 if (BUFFERP (object))
1708 signal_after_change (XINT (start), XINT (end) - XINT (start),
1709 XINT (end) - XINT (start));
1710 return Qt;
1712 else
1713 { /* i has the properties, and goes past the change limit. */
1714 unchanged = i;
1715 i = split_interval_left (i, len);
1716 copy_properties (unchanged, i);
1717 if (!modified && BUFFERP (object))
1718 modify_text_properties (object, start, end);
1719 remove_properties (Qnil, properties, i, object);
1720 if (BUFFERP (object))
1721 signal_after_change (XINT (start), XINT (end) - XINT (start),
1722 XINT (end) - XINT (start));
1723 return Qt;
1726 if (interval_has_some_properties_list (properties, i))
1728 if (!modified && BUFFERP (object))
1729 modify_text_properties (object, start, end);
1730 remove_properties (Qnil, properties, i, object);
1731 modified = true;
1733 len -= LENGTH (i);
1734 i = next_interval (i);
1735 if (!i)
1737 if (modified)
1739 if (BUFFERP (object))
1740 signal_after_change (XINT (start),
1741 XINT (end) - XINT (start),
1742 XINT (end) - XINT (start));
1743 return Qt;
1745 else
1746 return Qnil;
1751 DEFUN ("text-property-any", Ftext_property_any,
1752 Stext_property_any, 4, 5, 0,
1753 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
1754 If so, return the position of the first character whose property PROPERTY
1755 is `eq' to VALUE. Otherwise return nil.
1756 If the optional fifth argument OBJECT is a buffer (or nil, which means
1757 the current buffer), START and END are buffer positions (integers or
1758 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1759 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1761 register INTERVAL i;
1762 register ptrdiff_t e, pos;
1764 if (NILP (object))
1765 XSETBUFFER (object, current_buffer);
1766 i = validate_interval_range (object, &start, &end, soft);
1767 if (!i)
1768 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1769 e = XINT (end);
1771 while (i)
1773 if (i->position >= e)
1774 break;
1775 if (EQ (textget (i->plist, property), value))
1777 pos = i->position;
1778 if (pos < XINT (start))
1779 pos = XINT (start);
1780 return make_number (pos);
1782 i = next_interval (i);
1784 return Qnil;
1787 DEFUN ("text-property-not-all", Ftext_property_not_all,
1788 Stext_property_not_all, 4, 5, 0,
1789 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
1790 If so, return the position of the first character whose property PROPERTY
1791 is not `eq' to VALUE. Otherwise, return nil.
1792 If the optional fifth argument OBJECT is a buffer (or nil, which means
1793 the current buffer), START and END are buffer positions (integers or
1794 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1795 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1797 register INTERVAL i;
1798 register ptrdiff_t s, e;
1800 if (NILP (object))
1801 XSETBUFFER (object, current_buffer);
1802 i = validate_interval_range (object, &start, &end, soft);
1803 if (!i)
1804 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1805 s = XINT (start);
1806 e = XINT (end);
1808 while (i)
1810 if (i->position >= e)
1811 break;
1812 if (! EQ (textget (i->plist, property), value))
1814 if (i->position > s)
1815 s = i->position;
1816 return make_number (s);
1818 i = next_interval (i);
1820 return Qnil;
1824 /* Return the direction from which the text-property PROP would be
1825 inherited by any new text inserted at POS: 1 if it would be
1826 inherited from the char after POS, -1 if it would be inherited from
1827 the char before POS, and 0 if from neither.
1828 BUFFER can be either a buffer or nil (meaning current buffer). */
1831 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1833 bool ignore_previous_character;
1834 Lisp_Object prev_pos = make_number (XINT (pos) - 1);
1835 Lisp_Object front_sticky;
1836 bool is_rear_sticky = true, is_front_sticky = false; /* defaults */
1837 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
1839 if (NILP (buffer))
1840 XSETBUFFER (buffer, current_buffer);
1842 ignore_previous_character = XINT (pos) <= BUF_BEGV (XBUFFER (buffer));
1844 if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt))))
1845 is_rear_sticky = false;
1846 else
1848 Lisp_Object rear_non_sticky
1849 = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1851 if (!NILP (CONSP (rear_non_sticky)
1852 ? Fmemq (prop, rear_non_sticky)
1853 : rear_non_sticky))
1854 /* PROP is rear-non-sticky. */
1855 is_rear_sticky = false;
1858 /* Consider following character. */
1859 /* This signals an arg-out-of-range error if pos is outside the
1860 buffer's accessible range. */
1861 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1863 if (EQ (front_sticky, Qt)
1864 || (CONSP (front_sticky)
1865 && !NILP (Fmemq (prop, front_sticky))))
1866 /* PROP is inherited from after. */
1867 is_front_sticky = true;
1869 /* Simple cases, where the properties are consistent. */
1870 if (is_rear_sticky && !is_front_sticky)
1871 return -1;
1872 else if (!is_rear_sticky && is_front_sticky)
1873 return 1;
1874 else if (!is_rear_sticky && !is_front_sticky)
1875 return 0;
1877 /* The stickiness properties are inconsistent, so we have to
1878 disambiguate. Basically, rear-sticky wins, _except_ if the
1879 property that would be inherited has a value of nil, in which case
1880 front-sticky wins. */
1881 if (ignore_previous_character
1882 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1883 return 1;
1884 else
1885 return -1;
1889 /* Copying properties between objects. */
1891 /* Add properties from START to END of SRC, starting at POS in DEST.
1892 SRC and DEST may each refer to strings or buffers.
1893 Optional sixth argument PROP causes only that property to be copied.
1894 Properties are copied to DEST as if by `add-text-properties'.
1895 Return t if any property value actually changed, nil otherwise. */
1897 /* Note this can GC when DEST is a buffer. */
1899 Lisp_Object
1900 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
1901 Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1903 INTERVAL i;
1904 Lisp_Object res;
1905 Lisp_Object stuff;
1906 Lisp_Object plist;
1907 ptrdiff_t s, e, e2, p, len;
1908 bool modified = false;
1909 struct gcpro gcpro1, gcpro2;
1911 i = validate_interval_range (src, &start, &end, soft);
1912 if (!i)
1913 return Qnil;
1915 CHECK_NUMBER_COERCE_MARKER (pos);
1917 Lisp_Object dest_start, dest_end;
1919 e = XINT (pos) + (XINT (end) - XINT (start));
1920 if (MOST_POSITIVE_FIXNUM < e)
1921 args_out_of_range (pos, end);
1922 dest_start = pos;
1923 XSETFASTINT (dest_end, e);
1924 /* Apply this to a copy of pos; it will try to increment its arguments,
1925 which we don't want. */
1926 validate_interval_range (dest, &dest_start, &dest_end, soft);
1929 s = XINT (start);
1930 e = XINT (end);
1931 p = XINT (pos);
1933 stuff = Qnil;
1935 while (s < e)
1937 e2 = i->position + LENGTH (i);
1938 if (e2 > e)
1939 e2 = e;
1940 len = e2 - s;
1942 plist = i->plist;
1943 if (! NILP (prop))
1944 while (! NILP (plist))
1946 if (EQ (Fcar (plist), prop))
1948 plist = list2 (prop, Fcar (Fcdr (plist)));
1949 break;
1951 plist = Fcdr (Fcdr (plist));
1953 if (! NILP (plist))
1954 /* Must defer modifications to the interval tree in case
1955 src and dest refer to the same string or buffer. */
1956 stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
1957 stuff);
1959 i = next_interval (i);
1960 if (!i)
1961 break;
1963 p += len;
1964 s = i->position;
1967 GCPRO2 (stuff, dest);
1969 while (! NILP (stuff))
1971 res = Fcar (stuff);
1972 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1973 Fcar (Fcdr (Fcdr (res))), dest);
1974 if (! NILP (res))
1975 modified = true;
1976 stuff = Fcdr (stuff);
1979 UNGCPRO;
1981 return modified ? Qt : Qnil;
1985 /* Return a list representing the text properties of OBJECT between
1986 START and END. if PROP is non-nil, report only on that property.
1987 Each result list element has the form (S E PLIST), where S and E
1988 are positions in OBJECT and PLIST is a property list containing the
1989 text properties of OBJECT between S and E. Value is nil if OBJECT
1990 doesn't contain text properties between START and END. */
1992 Lisp_Object
1993 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
1995 struct interval *i;
1996 Lisp_Object result;
1998 result = Qnil;
2000 i = validate_interval_range (object, &start, &end, soft);
2001 if (i)
2003 ptrdiff_t s = XINT (start);
2004 ptrdiff_t e = XINT (end);
2006 while (s < e)
2008 ptrdiff_t interval_end, len;
2009 Lisp_Object plist;
2011 interval_end = i->position + LENGTH (i);
2012 if (interval_end > e)
2013 interval_end = e;
2014 len = interval_end - s;
2016 plist = i->plist;
2018 if (!NILP (prop))
2019 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
2020 if (EQ (XCAR (plist), prop))
2022 plist = list2 (prop, Fcar (XCDR (plist)));
2023 break;
2026 if (!NILP (plist))
2027 result = Fcons (list3 (make_number (s), make_number (s + len),
2028 plist),
2029 result);
2031 i = next_interval (i);
2032 if (!i)
2033 break;
2034 s = i->position;
2038 return result;
2042 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2043 (START END PLIST), where START and END are positions and PLIST is a
2044 property list containing the text properties to add. Adjust START
2045 and END positions by DELTA before adding properties. */
2047 void
2048 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
2050 struct gcpro gcpro1, gcpro2;
2052 GCPRO2 (list, object);
2054 for (; CONSP (list); list = XCDR (list))
2056 Lisp_Object item, start, end, plist;
2058 item = XCAR (list);
2059 start = make_number (XINT (XCAR (item)) + XINT (delta));
2060 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
2061 plist = XCAR (XCDR (XCDR (item)));
2063 Fadd_text_properties (start, end, plist, object);
2066 UNGCPRO;
2071 /* Modify end-points of ranges in LIST destructively, and return the
2072 new list. LIST is a list as returned from text_property_list.
2073 Discard properties that begin at or after NEW_END, and limit
2074 end-points to NEW_END. */
2076 Lisp_Object
2077 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
2079 Lisp_Object prev = Qnil, head = list;
2080 ptrdiff_t max = XINT (new_end);
2082 for (; CONSP (list); prev = list, list = XCDR (list))
2084 Lisp_Object item, beg, end;
2086 item = XCAR (list);
2087 beg = XCAR (item);
2088 end = XCAR (XCDR (item));
2090 if (XINT (beg) >= max)
2092 /* The start-point is past the end of the new string.
2093 Discard this property. */
2094 if (EQ (head, list))
2095 head = XCDR (list);
2096 else
2097 XSETCDR (prev, XCDR (list));
2099 else if (XINT (end) > max)
2100 /* The end-point is past the end of the new string. */
2101 XSETCAR (XCDR (item), new_end);
2104 return head;
2109 /* Call the modification hook functions in LIST, each with START and END. */
2111 static void
2112 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
2114 struct gcpro gcpro1;
2115 GCPRO1 (list);
2116 while (!NILP (list))
2118 call2 (Fcar (list), start, end);
2119 list = Fcdr (list);
2121 UNGCPRO;
2124 /* Check for read-only intervals between character positions START ... END,
2125 in BUF, and signal an error if we find one.
2127 Then check for any modification hooks in the range.
2128 Create a list of all these hooks in lexicographic order,
2129 eliminating consecutive extra copies of the same hook. Then call
2130 those hooks in order, with START and END - 1 as arguments. */
2132 void
2133 verify_interval_modification (struct buffer *buf,
2134 ptrdiff_t start, ptrdiff_t end)
2136 INTERVAL intervals = buffer_intervals (buf);
2137 INTERVAL i;
2138 Lisp_Object hooks;
2139 Lisp_Object prev_mod_hooks;
2140 Lisp_Object mod_hooks;
2141 struct gcpro gcpro1;
2143 hooks = Qnil;
2144 prev_mod_hooks = Qnil;
2145 mod_hooks = Qnil;
2147 interval_insert_behind_hooks = Qnil;
2148 interval_insert_in_front_hooks = Qnil;
2150 if (!intervals)
2151 return;
2153 if (start > end)
2155 ptrdiff_t temp = start;
2156 start = end;
2157 end = temp;
2160 /* For an insert operation, check the two chars around the position. */
2161 if (start == end)
2163 INTERVAL prev = NULL;
2164 Lisp_Object before, after;
2166 /* Set I to the interval containing the char after START,
2167 and PREV to the interval containing the char before START.
2168 Either one may be null. They may be equal. */
2169 i = find_interval (intervals, start);
2171 if (start == BUF_BEGV (buf))
2172 prev = 0;
2173 else if (i->position == start)
2174 prev = previous_interval (i);
2175 else if (i->position < start)
2176 prev = i;
2177 if (start == BUF_ZV (buf))
2178 i = 0;
2180 /* If Vinhibit_read_only is set and is not a list, we can
2181 skip the read_only checks. */
2182 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2184 /* If I and PREV differ we need to check for the read-only
2185 property together with its stickiness. If either I or
2186 PREV are 0, this check is all we need.
2187 We have to take special care, since read-only may be
2188 indirectly defined via the category property. */
2189 if (i != prev)
2191 if (i)
2193 after = textget (i->plist, Qread_only);
2195 /* If interval I is read-only and read-only is
2196 front-sticky, inhibit insertion.
2197 Check for read-only as well as category. */
2198 if (! NILP (after)
2199 && NILP (Fmemq (after, Vinhibit_read_only)))
2201 Lisp_Object tem;
2203 tem = textget (i->plist, Qfront_sticky);
2204 if (TMEM (Qread_only, tem)
2205 || (NILP (Fplist_get (i->plist, Qread_only))
2206 && TMEM (Qcategory, tem)))
2207 text_read_only (after);
2211 if (prev)
2213 before = textget (prev->plist, Qread_only);
2215 /* If interval PREV is read-only and read-only isn't
2216 rear-nonsticky, inhibit insertion.
2217 Check for read-only as well as category. */
2218 if (! NILP (before)
2219 && NILP (Fmemq (before, Vinhibit_read_only)))
2221 Lisp_Object tem;
2223 tem = textget (prev->plist, Qrear_nonsticky);
2224 if (! TMEM (Qread_only, tem)
2225 && (! NILP (Fplist_get (prev->plist,Qread_only))
2226 || ! TMEM (Qcategory, tem)))
2227 text_read_only (before);
2231 else if (i)
2233 after = textget (i->plist, Qread_only);
2235 /* If interval I is read-only and read-only is
2236 front-sticky, inhibit insertion.
2237 Check for read-only as well as category. */
2238 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2240 Lisp_Object tem;
2242 tem = textget (i->plist, Qfront_sticky);
2243 if (TMEM (Qread_only, tem)
2244 || (NILP (Fplist_get (i->plist, Qread_only))
2245 && TMEM (Qcategory, tem)))
2246 text_read_only (after);
2248 tem = textget (prev->plist, Qrear_nonsticky);
2249 if (! TMEM (Qread_only, tem)
2250 && (! NILP (Fplist_get (prev->plist, Qread_only))
2251 || ! TMEM (Qcategory, tem)))
2252 text_read_only (after);
2257 /* Run both insert hooks (just once if they're the same). */
2258 if (prev)
2259 interval_insert_behind_hooks
2260 = textget (prev->plist, Qinsert_behind_hooks);
2261 if (i)
2262 interval_insert_in_front_hooks
2263 = textget (i->plist, Qinsert_in_front_hooks);
2265 else
2267 /* Loop over intervals on or next to START...END,
2268 collecting their hooks. */
2270 i = find_interval (intervals, start);
2273 if (! INTERVAL_WRITABLE_P (i))
2274 text_read_only (textget (i->plist, Qread_only));
2276 if (!inhibit_modification_hooks)
2278 mod_hooks = textget (i->plist, Qmodification_hooks);
2279 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2281 hooks = Fcons (mod_hooks, hooks);
2282 prev_mod_hooks = mod_hooks;
2286 if (i->position + LENGTH (i) < end
2287 && (!NILP (BVAR (current_buffer, read_only))
2288 && NILP (Vinhibit_read_only)))
2289 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2291 i = next_interval (i);
2293 /* Keep going thru the interval containing the char before END. */
2294 while (i && i->position < end);
2296 if (!inhibit_modification_hooks)
2298 GCPRO1 (hooks);
2299 hooks = Fnreverse (hooks);
2300 while (! EQ (hooks, Qnil))
2302 call_mod_hooks (Fcar (hooks), make_number (start),
2303 make_number (end));
2304 hooks = Fcdr (hooks);
2306 UNGCPRO;
2311 /* Run the interval hooks for an insertion on character range START ... END.
2312 verify_interval_modification chose which hooks to run;
2313 this function is called after the insertion happens
2314 so it can indicate the range of inserted text. */
2316 void
2317 report_interval_modification (Lisp_Object start, Lisp_Object end)
2319 if (! NILP (interval_insert_behind_hooks))
2320 call_mod_hooks (interval_insert_behind_hooks, start, end);
2321 if (! NILP (interval_insert_in_front_hooks)
2322 && ! EQ (interval_insert_in_front_hooks,
2323 interval_insert_behind_hooks))
2324 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2327 void
2328 syms_of_textprop (void)
2330 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2331 doc: /* Property-list used as default values.
2332 The value of a property in this list is seen as the value for every
2333 character that does not have its own value for that property. */);
2334 Vdefault_text_properties = Qnil;
2336 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2337 doc: /* Alist of alternative properties for properties without a value.
2338 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2339 If a piece of text has no direct value for a particular property, then
2340 this alist is consulted. If that property appears in the alist, then
2341 the first non-nil value from the associated alternative properties is
2342 returned. */);
2343 Vchar_property_alias_alist = Qnil;
2345 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2346 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2347 This also inhibits the use of the `intangible' text property.
2349 This variable is obsolete since Emacs-25.1. Use `cursor-intangible-mode'
2350 or `cursor-sensor-mode' instead. */);
2351 /* FIXME: We should make-obsolete-variable, but that signals too many
2352 warnings in code which does (let ((inhibit-point-motion-hooks t)) ...)
2353 Ideally, make-obsolete-variable should let us specify that only the nil
2354 value is obsolete, but that requires too many changes in bytecomp.el,
2355 so for now we'll keep it "obsolete via the docstring". */
2356 Vinhibit_point_motion_hooks = Qt;
2358 DEFVAR_LISP ("text-property-default-nonsticky",
2359 Vtext_property_default_nonsticky,
2360 doc: /* Alist of properties vs the corresponding non-stickiness.
2361 Each element has the form (PROPERTY . NONSTICKINESS).
2363 If a character in a buffer has PROPERTY, new text inserted adjacent to
2364 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2365 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2366 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2367 /* Text properties `syntax-table'and `display' should be nonsticky
2368 by default. */
2369 Vtext_property_default_nonsticky
2370 = list2 (Fcons (Qsyntax_table, Qt), Fcons (Qdisplay, Qt));
2372 staticpro (&interval_insert_behind_hooks);
2373 staticpro (&interval_insert_in_front_hooks);
2374 interval_insert_behind_hooks = Qnil;
2375 interval_insert_in_front_hooks = Qnil;
2378 /* Common attributes one might give text. */
2380 DEFSYM (Qfont, "font");
2381 DEFSYM (Qface, "face");
2382 DEFSYM (Qread_only, "read-only");
2383 DEFSYM (Qinvisible, "invisible");
2384 DEFSYM (Qintangible, "intangible");
2385 DEFSYM (Qcategory, "category");
2386 DEFSYM (Qlocal_map, "local-map");
2387 DEFSYM (Qfront_sticky, "front-sticky");
2388 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2389 DEFSYM (Qmouse_face, "mouse-face");
2390 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
2392 /* Properties that text might use to specify certain actions. */
2394 DEFSYM (Qpoint_left, "point-left");
2395 DEFSYM (Qpoint_entered, "point-entered");
2397 defsubr (&Stext_properties_at);
2398 defsubr (&Sget_text_property);
2399 defsubr (&Sget_char_property);
2400 defsubr (&Sget_char_property_and_overlay);
2401 defsubr (&Snext_char_property_change);
2402 defsubr (&Sprevious_char_property_change);
2403 defsubr (&Snext_single_char_property_change);
2404 defsubr (&Sprevious_single_char_property_change);
2405 defsubr (&Snext_property_change);
2406 defsubr (&Snext_single_property_change);
2407 defsubr (&Sprevious_property_change);
2408 defsubr (&Sprevious_single_property_change);
2409 defsubr (&Sadd_text_properties);
2410 defsubr (&Sput_text_property);
2411 defsubr (&Sset_text_properties);
2412 defsubr (&Sadd_face_text_property);
2413 defsubr (&Sremove_text_properties);
2414 defsubr (&Sremove_list_of_text_properties);
2415 defsubr (&Stext_property_any);
2416 defsubr (&Stext_property_not_all);