Backport fcntl.h AIX fix from the trunk.
[emacs.git] / src / textprop.c
blobbd09304ba3b661c61f6411b8c4c089f1898dcd3d
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2014 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. */
47 /* Types of hooks. */
48 static Lisp_Object Qmouse_left;
49 static Lisp_Object Qmouse_entered;
50 Lisp_Object Qpoint_left;
51 Lisp_Object Qpoint_entered;
52 Lisp_Object Qcategory;
53 Lisp_Object Qlocal_map;
55 /* Visual properties text (including strings) may have. */
56 static Lisp_Object Qforeground, Qbackground, Qunderline;
57 Lisp_Object Qfont;
58 static Lisp_Object Qstipple;
59 Lisp_Object Qinvisible, Qintangible, Qmouse_face;
60 static Lisp_Object Qread_only;
61 Lisp_Object Qminibuffer_prompt;
63 enum property_set_type
65 TEXT_PROPERTY_REPLACE,
66 TEXT_PROPERTY_PREPEND,
67 TEXT_PROPERTY_APPEND
70 /* Sticky properties. */
71 Lisp_Object Qfront_sticky, Qrear_nonsticky;
73 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
74 the o1's cdr. Otherwise, return zero. This is handy for
75 traversing plists. */
76 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
78 /* verify_interval_modification saves insertion hooks here
79 to be run later by report_interval_modification. */
80 static Lisp_Object interval_insert_behind_hooks;
81 static Lisp_Object interval_insert_in_front_hooks;
84 /* Signal a `text-read-only' error. This function makes it easier
85 to capture that error in GDB by putting a breakpoint on it. */
87 static _Noreturn void
88 text_read_only (Lisp_Object propval)
90 if (STRINGP (propval))
91 xsignal1 (Qtext_read_only, propval);
93 xsignal0 (Qtext_read_only);
96 /* Prepare to modify the text properties of BUFFER from START to END. */
98 static void
99 modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
101 ptrdiff_t b = XINT (start), e = XINT (end);
102 struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
104 set_buffer_internal (buf);
106 prepare_to_modify_buffer_1 (b, e, NULL);
108 BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
109 if (MODIFF <= SAVE_MODIFF)
110 record_first_change ();
111 MODIFF++;
113 bset_point_before_scroll (current_buffer, Qnil);
115 set_buffer_internal (old);
118 /* Complain if object is not string or buffer type. */
120 static void
121 CHECK_STRING_OR_BUFFER (Lisp_Object x)
123 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
126 /* Extract the interval at the position pointed to by BEGIN from
127 OBJECT, a string or buffer. Additionally, check that the positions
128 pointed to by BEGIN and END are within the bounds of OBJECT, and
129 reverse them if *BEGIN is greater than *END. The objects pointed
130 to by BEGIN and END may be integers or markers; if the latter, they
131 are coerced to integers.
133 When OBJECT is a string, we increment *BEGIN and *END
134 to make them origin-one.
136 Note that buffer points don't correspond to interval indices.
137 For example, point-max is 1 greater than the index of the last
138 character. This difference is handled in the caller, which uses
139 the validated points to determine a length, and operates on that.
140 Exceptions are Ftext_properties_at, Fnext_property_change, and
141 Fprevious_property_change which call this function with BEGIN == END.
142 Handle this case specially.
144 If FORCE is soft (0), it's OK to return NULL. Otherwise,
145 create an interval tree for OBJECT if one doesn't exist, provided
146 the object actually contains text. In the current design, if there
147 is no text, there can be no text properties. */
149 #define soft 0
150 #define hard 1
152 INTERVAL
153 validate_interval_range (Lisp_Object object, Lisp_Object *begin,
154 Lisp_Object *end, bool force)
156 INTERVAL i;
157 ptrdiff_t searchpos;
159 CHECK_STRING_OR_BUFFER (object);
160 CHECK_NUMBER_COERCE_MARKER (*begin);
161 CHECK_NUMBER_COERCE_MARKER (*end);
163 /* If we are asked for a point, but from a subr which operates
164 on a range, then return nothing. */
165 if (EQ (*begin, *end) && begin != end)
166 return NULL;
168 if (XINT (*begin) > XINT (*end))
170 Lisp_Object n;
171 n = *begin;
172 *begin = *end;
173 *end = n;
176 if (BUFFERP (object))
178 register struct buffer *b = XBUFFER (object);
180 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
181 && XINT (*end) <= BUF_ZV (b)))
182 args_out_of_range (*begin, *end);
183 i = buffer_intervals (b);
185 /* If there's no text, there are no properties. */
186 if (BUF_BEGV (b) == BUF_ZV (b))
187 return NULL;
189 searchpos = XINT (*begin);
191 else
193 ptrdiff_t len = SCHARS (object);
195 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
196 && XINT (*end) <= len))
197 args_out_of_range (*begin, *end);
198 XSETFASTINT (*begin, XFASTINT (*begin));
199 if (begin != end)
200 XSETFASTINT (*end, XFASTINT (*end));
201 i = string_intervals (object);
203 if (len == 0)
204 return NULL;
206 searchpos = XINT (*begin);
209 if (!i)
210 return (force ? create_root_interval (object) : i);
212 return find_interval (i, searchpos);
215 /* Validate LIST as a property list. If LIST is not a list, then
216 make one consisting of (LIST nil). Otherwise, verify that LIST
217 is even numbered and thus suitable as a plist. */
219 static Lisp_Object
220 validate_plist (Lisp_Object list)
222 if (NILP (list))
223 return Qnil;
225 if (CONSP (list))
227 bool odd_length = 0;
228 Lisp_Object tail;
229 for (tail = list; CONSP (tail); tail = XCDR (tail))
231 odd_length ^= 1;
232 QUIT;
234 if (odd_length)
235 error ("Odd length text property list");
236 return list;
239 return list2 (list, Qnil);
242 /* Return true if interval I has all the properties,
243 with the same values, of list PLIST. */
245 static bool
246 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
248 Lisp_Object tail1, tail2;
250 /* Go through each element of PLIST. */
251 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
253 Lisp_Object sym1 = XCAR (tail1);
254 bool found = 0;
256 /* Go through I's plist, looking for sym1 */
257 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
258 if (EQ (sym1, XCAR (tail2)))
260 /* Found the same property on both lists. If the
261 values are unequal, return zero. */
262 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
263 return 0;
265 /* Property has same value on both lists; go to next one. */
266 found = 1;
267 break;
270 if (! found)
271 return 0;
274 return 1;
277 /* Return true if the plist of interval I has any of the
278 properties of PLIST, regardless of their values. */
280 static bool
281 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
283 Lisp_Object tail1, tail2, sym;
285 /* Go through each element of PLIST. */
286 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
288 sym = XCAR (tail1);
290 /* Go through i's plist, looking for tail1 */
291 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
292 if (EQ (sym, XCAR (tail2)))
293 return 1;
296 return 0;
299 /* Return nonzero if the plist of interval I has any of the
300 property names in LIST, regardless of their values. */
302 static bool
303 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
305 Lisp_Object tail1, tail2, sym;
307 /* Go through each element of LIST. */
308 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
310 sym = XCAR (tail1);
312 /* Go through i's plist, looking for tail1 */
313 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
314 if (EQ (sym, XCAR (tail2)))
315 return 1;
318 return 0;
321 /* Changing the plists of individual intervals. */
323 /* Return the value of PROP in property-list PLIST, or Qunbound if it
324 has none. */
325 static Lisp_Object
326 property_value (Lisp_Object plist, Lisp_Object prop)
328 Lisp_Object value;
330 while (PLIST_ELT_P (plist, value))
331 if (EQ (XCAR (plist), prop))
332 return XCAR (value);
333 else
334 plist = XCDR (value);
336 return Qunbound;
339 /* Set the properties of INTERVAL to PROPERTIES,
340 and record undo info for the previous values.
341 OBJECT is the string or buffer that INTERVAL belongs to. */
343 static void
344 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
346 Lisp_Object sym, value;
348 if (BUFFERP (object))
350 /* For each property in the old plist which is missing from PROPERTIES,
351 or has a different value in PROPERTIES, make an undo record. */
352 for (sym = interval->plist;
353 PLIST_ELT_P (sym, value);
354 sym = XCDR (value))
355 if (! EQ (property_value (properties, XCAR (sym)),
356 XCAR (value)))
358 record_property_change (interval->position, LENGTH (interval),
359 XCAR (sym), XCAR (value),
360 object);
363 /* For each new property that has no value at all in the old plist,
364 make an undo record binding it to nil, so it will be removed. */
365 for (sym = properties;
366 PLIST_ELT_P (sym, value);
367 sym = XCDR (value))
368 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
370 record_property_change (interval->position, LENGTH (interval),
371 XCAR (sym), Qnil,
372 object);
376 /* Store new properties. */
377 set_interval_plist (interval, Fcopy_sequence (properties));
380 /* Add the properties of PLIST to the interval I, or set
381 the value of I's property to the value of the property on PLIST
382 if they are different.
384 OBJECT should be the string or buffer the interval is in.
386 Return true if this changes I (i.e., if any members of PLIST
387 are actually added to I's plist) */
389 static bool
390 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
391 enum property_set_type set_type)
393 Lisp_Object tail1, tail2, sym1, val1;
394 bool changed = 0;
395 struct gcpro gcpro1, gcpro2, gcpro3;
397 tail1 = plist;
398 sym1 = Qnil;
399 val1 = Qnil;
400 /* No need to protect OBJECT, because we can GC only in the case
401 where it is a buffer, and live buffers are always protected.
402 I and its plist are also protected, via OBJECT. */
403 GCPRO3 (tail1, sym1, val1);
405 /* Go through each element of PLIST. */
406 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
408 bool found = 0;
409 sym1 = XCAR (tail1);
410 val1 = Fcar (XCDR (tail1));
412 /* Go through I's plist, looking for sym1 */
413 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
414 if (EQ (sym1, XCAR (tail2)))
416 /* No need to gcpro, because tail2 protects this
417 and it must be a cons cell (we get an error otherwise). */
418 register Lisp_Object this_cdr;
420 this_cdr = XCDR (tail2);
421 /* Found the property. Now check its value. */
422 found = 1;
424 /* The properties have the same value on both lists.
425 Continue to the next property. */
426 if (EQ (val1, Fcar (this_cdr)))
427 break;
429 /* Record this change in the buffer, for undo purposes. */
430 if (BUFFERP (object))
432 record_property_change (i->position, LENGTH (i),
433 sym1, Fcar (this_cdr), object);
436 /* I's property has a different value -- change it */
437 if (set_type == TEXT_PROPERTY_REPLACE)
438 Fsetcar (this_cdr, val1);
439 else {
440 if (CONSP (Fcar (this_cdr)) &&
441 /* Special-case anonymous face properties. */
442 (! EQ (sym1, Qface) ||
443 NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
444 /* The previous value is a list, so prepend (or
445 append) the new value to this list. */
446 if (set_type == TEXT_PROPERTY_PREPEND)
447 Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
448 else
449 nconc2 (Fcar (this_cdr), list1 (val1));
450 else {
451 /* The previous value is a single value, so make it
452 into a list. */
453 if (set_type == TEXT_PROPERTY_PREPEND)
454 Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
455 else
456 Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
459 changed = 1;
460 break;
463 if (! found)
465 /* Record this change in the buffer, for undo purposes. */
466 if (BUFFERP (object))
468 record_property_change (i->position, LENGTH (i),
469 sym1, Qnil, object);
471 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
472 changed = 1;
476 UNGCPRO;
478 return changed;
481 /* For any members of PLIST, or LIST,
482 which are properties of I, remove them from I's plist.
483 (If PLIST is non-nil, use that, otherwise use LIST.)
484 OBJECT is the string or buffer containing I. */
486 static bool
487 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
489 Lisp_Object tail1, tail2, sym, current_plist;
490 bool changed = 0;
492 /* True means tail1 is a plist, otherwise it is a list. */
493 bool use_plist;
495 current_plist = i->plist;
497 if (! NILP (plist))
498 tail1 = plist, use_plist = 1;
499 else
500 tail1 = list, use_plist = 0;
502 /* Go through each element of LIST or PLIST. */
503 while (CONSP (tail1))
505 sym = XCAR (tail1);
507 /* First, remove the symbol if it's at the head of the list */
508 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
510 if (BUFFERP (object))
511 record_property_change (i->position, LENGTH (i),
512 sym, XCAR (XCDR (current_plist)),
513 object);
515 current_plist = XCDR (XCDR (current_plist));
516 changed = 1;
519 /* Go through I's plist, looking for SYM. */
520 tail2 = current_plist;
521 while (! NILP (tail2))
523 register Lisp_Object this;
524 this = XCDR (XCDR (tail2));
525 if (CONSP (this) && EQ (sym, XCAR (this)))
527 if (BUFFERP (object))
528 record_property_change (i->position, LENGTH (i),
529 sym, XCAR (XCDR (this)), object);
531 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
532 changed = 1;
534 tail2 = this;
537 /* Advance thru TAIL1 one way or the other. */
538 tail1 = XCDR (tail1);
539 if (use_plist && CONSP (tail1))
540 tail1 = XCDR (tail1);
543 if (changed)
544 set_interval_plist (i, current_plist);
545 return changed;
548 /* Returns the interval of POSITION in OBJECT.
549 POSITION is BEG-based. */
551 INTERVAL
552 interval_of (ptrdiff_t position, Lisp_Object object)
554 register INTERVAL i;
555 ptrdiff_t beg, end;
557 if (NILP (object))
558 XSETBUFFER (object, current_buffer);
559 else if (EQ (object, Qt))
560 return NULL;
562 CHECK_STRING_OR_BUFFER (object);
564 if (BUFFERP (object))
566 register struct buffer *b = XBUFFER (object);
568 beg = BUF_BEGV (b);
569 end = BUF_ZV (b);
570 i = buffer_intervals (b);
572 else
574 beg = 0;
575 end = SCHARS (object);
576 i = string_intervals (object);
579 if (!(beg <= position && position <= end))
580 args_out_of_range (make_number (position), make_number (position));
581 if (beg == end || !i)
582 return NULL;
584 return find_interval (i, position);
587 DEFUN ("text-properties-at", Ftext_properties_at,
588 Stext_properties_at, 1, 2, 0,
589 doc: /* Return the list of properties of the character at POSITION in OBJECT.
590 If the optional second argument OBJECT is a buffer (or nil, which means
591 the current buffer), POSITION is a buffer position (integer or marker).
592 If OBJECT is a string, POSITION is a 0-based index into it.
593 If POSITION is at the end of OBJECT, the value is nil. */)
594 (Lisp_Object position, Lisp_Object object)
596 register INTERVAL i;
598 if (NILP (object))
599 XSETBUFFER (object, current_buffer);
601 i = validate_interval_range (object, &position, &position, soft);
602 if (!i)
603 return Qnil;
604 /* If POSITION is at the end of the interval,
605 it means it's the end of OBJECT.
606 There are no properties at the very end,
607 since no character follows. */
608 if (XINT (position) == LENGTH (i) + i->position)
609 return Qnil;
611 return i->plist;
614 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
615 doc: /* Return the value of POSITION's property PROP, in OBJECT.
616 OBJECT should be a buffer or a string; if omitted or nil, it defaults
617 to the current buffer.
618 If POSITION is at the end of OBJECT, the value is nil. */)
619 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
621 return textget (Ftext_properties_at (position, object), prop);
624 /* Return the value of char's property PROP, in OBJECT at POSITION.
625 OBJECT is optional and defaults to the current buffer.
626 If OVERLAY is non-0, then in the case that the returned property is from
627 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
628 returned in *OVERLAY.
629 If POSITION is at the end of OBJECT, the value is nil.
630 If OBJECT is a buffer, then overlay properties are considered as well as
631 text properties.
632 If OBJECT is a window, then that window's buffer is used, but
633 window-specific overlays are considered only if they are associated
634 with OBJECT. */
635 Lisp_Object
636 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
638 struct window *w = 0;
640 CHECK_NUMBER_COERCE_MARKER (position);
642 if (NILP (object))
643 XSETBUFFER (object, current_buffer);
645 if (WINDOWP (object))
647 CHECK_LIVE_WINDOW (object);
648 w = XWINDOW (object);
649 object = w->contents;
651 if (BUFFERP (object))
653 ptrdiff_t noverlays;
654 Lisp_Object *overlay_vec;
655 struct buffer *obuf = current_buffer;
657 if (XINT (position) < BUF_BEGV (XBUFFER (object))
658 || XINT (position) > BUF_ZV (XBUFFER (object)))
659 xsignal1 (Qargs_out_of_range, position);
661 set_buffer_temp (XBUFFER (object));
663 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
664 noverlays = sort_overlays (overlay_vec, noverlays, w);
666 set_buffer_temp (obuf);
668 /* Now check the overlays in order of decreasing priority. */
669 while (--noverlays >= 0)
671 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
672 if (!NILP (tem))
674 if (overlay)
675 /* Return the overlay we got the property from. */
676 *overlay = overlay_vec[noverlays];
677 return tem;
682 if (overlay)
683 /* Indicate that the return value is not from an overlay. */
684 *overlay = Qnil;
686 /* Not a buffer, or no appropriate overlay, so fall through to the
687 simpler case. */
688 return Fget_text_property (position, prop, object);
691 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
692 doc: /* Return the value of POSITION's property PROP, in OBJECT.
693 Both overlay properties and text properties are checked.
694 OBJECT is optional and defaults to the current buffer.
695 If POSITION is at the end of OBJECT, the value is nil.
696 If OBJECT is a buffer, then overlay properties are considered as well as
697 text properties.
698 If OBJECT is a window, then that window's buffer is used, but window-specific
699 overlays are considered only if they are associated with OBJECT. */)
700 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
702 return get_char_property_and_overlay (position, prop, object, 0);
705 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
706 Sget_char_property_and_overlay, 2, 3, 0,
707 doc: /* Like `get-char-property', but with extra overlay information.
708 The value is a cons cell. Its car is the return value of `get-char-property'
709 with the same arguments--that is, the value of POSITION's property
710 PROP in OBJECT. Its cdr is the overlay in which the property was
711 found, or nil, if it was found as a text property or not found at all.
713 OBJECT is optional and defaults to the current buffer. OBJECT may be
714 a string, a buffer or a window. For strings, the cdr of the return
715 value is always nil, since strings do not have overlays. If OBJECT is
716 a window, then that window's buffer is used, but window-specific
717 overlays are considered only if they are associated with OBJECT. If
718 POSITION is at the end of OBJECT, both car and cdr are nil. */)
719 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
721 Lisp_Object overlay;
722 Lisp_Object val
723 = get_char_property_and_overlay (position, prop, object, &overlay);
724 return Fcons (val, overlay);
728 DEFUN ("next-char-property-change", Fnext_char_property_change,
729 Snext_char_property_change, 1, 2, 0,
730 doc: /* Return the position of next text property or overlay change.
731 This scans characters forward in the current buffer from POSITION till
732 it finds a change in some text property, or the beginning or end of an
733 overlay, and returns the position of that.
734 If none is found up to (point-max), the function returns (point-max).
736 If the optional second argument LIMIT is non-nil, don't search
737 past position LIMIT; return LIMIT if nothing is found before LIMIT.
738 LIMIT is a no-op if it is greater than (point-max). */)
739 (Lisp_Object position, Lisp_Object limit)
741 Lisp_Object temp;
743 temp = Fnext_overlay_change (position);
744 if (! NILP (limit))
746 CHECK_NUMBER_COERCE_MARKER (limit);
747 if (XINT (limit) < XINT (temp))
748 temp = limit;
750 return Fnext_property_change (position, Qnil, temp);
753 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
754 Sprevious_char_property_change, 1, 2, 0,
755 doc: /* Return the position of previous text property or overlay change.
756 Scans characters backward in the current buffer from POSITION till it
757 finds a change in some text property, or the beginning or end of an
758 overlay, and returns the position of that.
759 If none is found since (point-min), the function returns (point-min).
761 If the optional second argument LIMIT is non-nil, don't search
762 past position LIMIT; return LIMIT if nothing is found before LIMIT.
763 LIMIT is a no-op if it is less than (point-min). */)
764 (Lisp_Object position, Lisp_Object limit)
766 Lisp_Object temp;
768 temp = Fprevious_overlay_change (position);
769 if (! NILP (limit))
771 CHECK_NUMBER_COERCE_MARKER (limit);
772 if (XINT (limit) > XINT (temp))
773 temp = limit;
775 return Fprevious_property_change (position, Qnil, temp);
779 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
780 Snext_single_char_property_change, 2, 4, 0,
781 doc: /* Return the position of next text property or overlay change for a specific property.
782 Scans characters forward from POSITION till it finds
783 a change in the PROP property, then returns the position of the change.
784 If the optional third argument OBJECT is a buffer (or nil, which means
785 the current buffer), POSITION is a buffer position (integer or marker).
786 If OBJECT is a string, POSITION is a 0-based index into it.
788 In a string, scan runs to the end of the string.
789 In a buffer, it runs to (point-max), and the value cannot exceed that.
791 The property values are compared with `eq'.
792 If the property is constant all the way to the end of OBJECT, return the
793 last valid position in OBJECT.
794 If the optional fourth argument LIMIT is non-nil, don't search
795 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
796 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
798 if (STRINGP (object))
800 position = Fnext_single_property_change (position, prop, object, limit);
801 if (NILP (position))
803 if (NILP (limit))
804 position = make_number (SCHARS (object));
805 else
807 CHECK_NUMBER (limit);
808 position = limit;
812 else
814 Lisp_Object initial_value, value;
815 ptrdiff_t count = SPECPDL_INDEX ();
817 if (! NILP (object))
818 CHECK_BUFFER (object);
820 if (BUFFERP (object) && current_buffer != XBUFFER (object))
822 record_unwind_current_buffer ();
823 Fset_buffer (object);
826 CHECK_NUMBER_COERCE_MARKER (position);
828 initial_value = Fget_char_property (position, prop, object);
830 if (NILP (limit))
831 XSETFASTINT (limit, ZV);
832 else
833 CHECK_NUMBER_COERCE_MARKER (limit);
835 if (XFASTINT (position) >= XFASTINT (limit))
837 position = limit;
838 if (XFASTINT (position) > ZV)
839 XSETFASTINT (position, ZV);
841 else
842 while (1)
844 position = Fnext_char_property_change (position, limit);
845 if (XFASTINT (position) >= XFASTINT (limit))
847 position = limit;
848 break;
851 value = Fget_char_property (position, prop, object);
852 if (!EQ (value, initial_value))
853 break;
856 unbind_to (count, Qnil);
859 return position;
862 DEFUN ("previous-single-char-property-change",
863 Fprevious_single_char_property_change,
864 Sprevious_single_char_property_change, 2, 4, 0,
865 doc: /* Return the position of previous text property or overlay change for a specific property.
866 Scans characters backward from POSITION till it finds
867 a change in the PROP property, then returns the position of the change.
868 If the optional third argument OBJECT is a buffer (or nil, which means
869 the current buffer), POSITION is a buffer position (integer or marker).
870 If OBJECT is a string, POSITION is a 0-based index into it.
872 In a string, scan runs to the start of the string.
873 In a buffer, it runs to (point-min), and the value cannot be less than that.
875 The property values are compared with `eq'.
876 If the property is constant all the way to the start of OBJECT, return the
877 first valid position in OBJECT.
878 If the optional fourth argument LIMIT is non-nil, don't search back past
879 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
880 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
882 if (STRINGP (object))
884 position = Fprevious_single_property_change (position, prop, object, limit);
885 if (NILP (position))
887 if (NILP (limit))
888 position = make_number (0);
889 else
891 CHECK_NUMBER (limit);
892 position = limit;
896 else
898 ptrdiff_t count = SPECPDL_INDEX ();
900 if (! NILP (object))
901 CHECK_BUFFER (object);
903 if (BUFFERP (object) && current_buffer != XBUFFER (object))
905 record_unwind_current_buffer ();
906 Fset_buffer (object);
909 CHECK_NUMBER_COERCE_MARKER (position);
911 if (NILP (limit))
912 XSETFASTINT (limit, BEGV);
913 else
914 CHECK_NUMBER_COERCE_MARKER (limit);
916 if (XFASTINT (position) <= XFASTINT (limit))
918 position = limit;
919 if (XFASTINT (position) < BEGV)
920 XSETFASTINT (position, BEGV);
922 else
924 Lisp_Object initial_value
925 = Fget_char_property (make_number (XFASTINT (position) - 1),
926 prop, object);
928 while (1)
930 position = Fprevious_char_property_change (position, limit);
932 if (XFASTINT (position) <= XFASTINT (limit))
934 position = limit;
935 break;
937 else
939 Lisp_Object value
940 = Fget_char_property (make_number (XFASTINT (position) - 1),
941 prop, object);
943 if (!EQ (value, initial_value))
944 break;
949 unbind_to (count, Qnil);
952 return position;
955 DEFUN ("next-property-change", Fnext_property_change,
956 Snext_property_change, 1, 3, 0,
957 doc: /* Return the position of next property change.
958 Scans characters forward from POSITION in OBJECT till it finds
959 a change in some text property, then returns the position of the change.
960 If the optional second argument OBJECT is a buffer (or nil, which means
961 the current buffer), POSITION is a buffer position (integer or marker).
962 If OBJECT is a string, POSITION is a 0-based index into it.
963 Return nil if the property is constant all the way to the end of OBJECT.
964 If the value is non-nil, it is a position greater than POSITION, never equal.
966 If the optional third argument LIMIT is non-nil, don't search
967 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
968 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
970 register INTERVAL i, next;
972 if (NILP (object))
973 XSETBUFFER (object, current_buffer);
975 if (!NILP (limit) && !EQ (limit, Qt))
976 CHECK_NUMBER_COERCE_MARKER (limit);
978 i = validate_interval_range (object, &position, &position, soft);
980 /* If LIMIT is t, return start of next interval--don't
981 bother checking further intervals. */
982 if (EQ (limit, Qt))
984 if (!i)
985 next = i;
986 else
987 next = next_interval (i);
989 if (!next)
990 XSETFASTINT (position, (STRINGP (object)
991 ? SCHARS (object)
992 : BUF_ZV (XBUFFER (object))));
993 else
994 XSETFASTINT (position, next->position);
995 return position;
998 if (!i)
999 return limit;
1001 next = next_interval (i);
1003 while (next && intervals_equal (i, next)
1004 && (NILP (limit) || next->position < XFASTINT (limit)))
1005 next = next_interval (next);
1007 if (!next
1008 || (next->position
1009 >= (INTEGERP (limit)
1010 ? XFASTINT (limit)
1011 : (STRINGP (object)
1012 ? SCHARS (object)
1013 : BUF_ZV (XBUFFER (object))))))
1014 return limit;
1015 else
1016 return make_number (next->position);
1019 DEFUN ("next-single-property-change", Fnext_single_property_change,
1020 Snext_single_property_change, 2, 4, 0,
1021 doc: /* Return the position of next property change for a specific property.
1022 Scans characters forward from POSITION till it finds
1023 a change in the PROP property, then returns the position of the change.
1024 If the optional third argument OBJECT is a buffer (or nil, which means
1025 the current buffer), POSITION is a buffer position (integer or marker).
1026 If OBJECT is a string, POSITION is a 0-based index into it.
1027 The property values are compared with `eq'.
1028 Return nil if the property is constant all the way to the end of OBJECT.
1029 If the value is non-nil, it is a position greater than POSITION, never equal.
1031 If the optional fourth argument LIMIT is non-nil, don't search
1032 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1033 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1035 register INTERVAL i, next;
1036 register Lisp_Object here_val;
1038 if (NILP (object))
1039 XSETBUFFER (object, current_buffer);
1041 if (!NILP (limit))
1042 CHECK_NUMBER_COERCE_MARKER (limit);
1044 i = validate_interval_range (object, &position, &position, soft);
1045 if (!i)
1046 return limit;
1048 here_val = textget (i->plist, prop);
1049 next = next_interval (i);
1050 while (next
1051 && EQ (here_val, textget (next->plist, prop))
1052 && (NILP (limit) || next->position < XFASTINT (limit)))
1053 next = next_interval (next);
1055 if (!next
1056 || (next->position
1057 >= (INTEGERP (limit)
1058 ? XFASTINT (limit)
1059 : (STRINGP (object)
1060 ? SCHARS (object)
1061 : BUF_ZV (XBUFFER (object))))))
1062 return limit;
1063 else
1064 return make_number (next->position);
1067 DEFUN ("previous-property-change", Fprevious_property_change,
1068 Sprevious_property_change, 1, 3, 0,
1069 doc: /* Return the position of previous property change.
1070 Scans characters backwards from POSITION in OBJECT till it finds
1071 a change in some text property, then returns the position of the change.
1072 If the optional second argument OBJECT is a buffer (or nil, which means
1073 the current buffer), POSITION is a buffer position (integer or marker).
1074 If OBJECT is a string, POSITION is a 0-based index into it.
1075 Return nil if the property is constant all the way to the start of OBJECT.
1076 If the value is non-nil, it is a position less than POSITION, never equal.
1078 If the optional third argument LIMIT is non-nil, don't search
1079 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1080 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1082 register INTERVAL i, previous;
1084 if (NILP (object))
1085 XSETBUFFER (object, current_buffer);
1087 if (!NILP (limit))
1088 CHECK_NUMBER_COERCE_MARKER (limit);
1090 i = validate_interval_range (object, &position, &position, soft);
1091 if (!i)
1092 return limit;
1094 /* Start with the interval containing the char before point. */
1095 if (i->position == XFASTINT (position))
1096 i = previous_interval (i);
1098 previous = previous_interval (i);
1099 while (previous && intervals_equal (previous, i)
1100 && (NILP (limit)
1101 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1102 previous = previous_interval (previous);
1104 if (!previous
1105 || (previous->position + LENGTH (previous)
1106 <= (INTEGERP (limit)
1107 ? XFASTINT (limit)
1108 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1109 return limit;
1110 else
1111 return make_number (previous->position + LENGTH (previous));
1114 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1115 Sprevious_single_property_change, 2, 4, 0,
1116 doc: /* Return the position of previous property change for a specific property.
1117 Scans characters backward from POSITION till it finds
1118 a change in the PROP property, then returns the position of the change.
1119 If the optional third argument OBJECT is a buffer (or nil, which means
1120 the current buffer), POSITION is a buffer position (integer or marker).
1121 If OBJECT is a string, POSITION is a 0-based index into it.
1122 The property values are compared with `eq'.
1123 Return nil if the property is constant all the way to the start of OBJECT.
1124 If the value is non-nil, it is a position less than POSITION, never equal.
1126 If the optional fourth argument LIMIT is non-nil, don't search
1127 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1128 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1130 register INTERVAL i, previous;
1131 register Lisp_Object here_val;
1133 if (NILP (object))
1134 XSETBUFFER (object, current_buffer);
1136 if (!NILP (limit))
1137 CHECK_NUMBER_COERCE_MARKER (limit);
1139 i = validate_interval_range (object, &position, &position, soft);
1141 /* Start with the interval containing the char before point. */
1142 if (i && i->position == XFASTINT (position))
1143 i = previous_interval (i);
1145 if (!i)
1146 return limit;
1148 here_val = textget (i->plist, prop);
1149 previous = previous_interval (i);
1150 while (previous
1151 && EQ (here_val, textget (previous->plist, prop))
1152 && (NILP (limit)
1153 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1154 previous = previous_interval (previous);
1156 if (!previous
1157 || (previous->position + LENGTH (previous)
1158 <= (INTEGERP (limit)
1159 ? XFASTINT (limit)
1160 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1161 return limit;
1162 else
1163 return make_number (previous->position + LENGTH (previous));
1166 /* Used by add-text-properties and add-face-text-property. */
1168 static Lisp_Object
1169 add_text_properties_1 (Lisp_Object start, Lisp_Object end,
1170 Lisp_Object properties, Lisp_Object object,
1171 enum property_set_type set_type) {
1172 INTERVAL i, unchanged;
1173 ptrdiff_t s, len;
1174 bool modified = 0;
1175 struct gcpro gcpro1;
1176 bool first_time = 1;
1178 properties = validate_plist (properties);
1179 if (NILP (properties))
1180 return Qnil;
1182 if (NILP (object))
1183 XSETBUFFER (object, current_buffer);
1185 retry:
1186 i = validate_interval_range (object, &start, &end, hard);
1187 if (!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 this interval already has the properties, we can skip it. */
1198 if (interval_has_all_properties (properties, i))
1200 ptrdiff_t got = LENGTH (i) - (s - i->position);
1204 if (got >= len)
1205 RETURN_UNGCPRO (Qnil);
1206 len -= got;
1207 i = next_interval (i);
1208 got = LENGTH (i);
1210 while (interval_has_all_properties (properties, i));
1212 else if (i->position != s)
1214 /* If we're not starting on an interval boundary, we have to
1215 split this interval. */
1216 unchanged = i;
1217 i = split_interval_right (unchanged, s - unchanged->position);
1218 copy_properties (unchanged, i);
1221 if (BUFFERP (object) && first_time)
1223 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1224 ptrdiff_t prev_pos = i->position;
1226 modify_text_properties (object, start, end);
1227 /* If someone called us recursively as a side effect of
1228 modify_text_properties, and changed the intervals behind our back
1229 (could happen if lock_file, called by prepare_to_modify_buffer,
1230 triggers redisplay, and that calls add-text-properties again
1231 in the same buffer), we cannot continue with I, because its
1232 data changed. So we restart the interval analysis anew. */
1233 if (TOTAL_LENGTH (i) != prev_total_length
1234 || i->position != prev_pos)
1236 first_time = 0;
1237 goto retry;
1241 /* We are at the beginning of interval I, with LEN chars to scan. */
1242 for (;;)
1244 eassert (i != 0);
1246 if (LENGTH (i) >= len)
1248 /* We can UNGCPRO safely here, because there will be just
1249 one more chance to gc, in the next call to add_properties,
1250 and after that we will not need PROPERTIES or OBJECT again. */
1251 UNGCPRO;
1253 if (interval_has_all_properties (properties, i))
1255 if (BUFFERP (object))
1256 signal_after_change (XINT (start), XINT (end) - XINT (start),
1257 XINT (end) - XINT (start));
1259 eassert (modified);
1260 return Qt;
1263 if (LENGTH (i) == len)
1265 add_properties (properties, i, object, set_type);
1266 if (BUFFERP (object))
1267 signal_after_change (XINT (start), XINT (end) - XINT (start),
1268 XINT (end) - XINT (start));
1269 return Qt;
1272 /* i doesn't have the properties, and goes past the change limit */
1273 unchanged = i;
1274 i = split_interval_left (unchanged, len);
1275 copy_properties (unchanged, i);
1276 add_properties (properties, i, object, set_type);
1277 if (BUFFERP (object))
1278 signal_after_change (XINT (start), XINT (end) - XINT (start),
1279 XINT (end) - XINT (start));
1280 return Qt;
1283 len -= LENGTH (i);
1284 modified |= add_properties (properties, i, object, set_type);
1285 i = next_interval (i);
1289 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1291 DEFUN ("add-text-properties", Fadd_text_properties,
1292 Sadd_text_properties, 3, 4, 0,
1293 doc: /* Add properties to the text from START to END.
1294 The third argument PROPERTIES is a property list
1295 specifying the property values to add. If the optional fourth argument
1296 OBJECT is a buffer (or nil, which means the current buffer),
1297 START and END are buffer positions (integers or markers).
1298 If OBJECT is a string, START and END are 0-based indices into it.
1299 Return t if any property value actually changed, nil otherwise. */)
1300 (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1301 Lisp_Object object)
1303 return add_text_properties_1 (start, end, properties, object,
1304 TEXT_PROPERTY_REPLACE);
1307 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1309 DEFUN ("put-text-property", Fput_text_property,
1310 Sput_text_property, 4, 5, 0,
1311 doc: /* Set one property of the text from START to END.
1312 The third and fourth arguments PROPERTY and VALUE
1313 specify the property to add.
1314 If the optional fifth argument OBJECT is a buffer (or nil, which means
1315 the current buffer), START and END are buffer positions (integers or
1316 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1317 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1319 Fadd_text_properties (start, end, list2 (property, value), object);
1320 return Qnil;
1323 DEFUN ("set-text-properties", Fset_text_properties,
1324 Sset_text_properties, 3, 4, 0,
1325 doc: /* Completely replace properties of text from START to END.
1326 The third argument PROPERTIES is the new property list.
1327 If the optional fourth argument OBJECT is a buffer (or nil, which means
1328 the current buffer), START and END are buffer positions (integers or
1329 markers). If OBJECT is a string, START and END are 0-based indices into it.
1330 If PROPERTIES is nil, the effect is to remove all properties from
1331 the designated part of OBJECT. */)
1332 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1334 return set_text_properties (start, end, properties, object, Qt);
1338 DEFUN ("add-face-text-property", Fadd_face_text_property,
1339 Sadd_face_text_property, 3, 5, 0,
1340 doc: /* Add the face property to the text from START to END.
1341 FACE specifies the face to add. It should be a valid value of the
1342 `face' property (typically a face name or a plist of face attributes
1343 and values).
1345 If any text in the region already has a non-nil `face' property, those
1346 face(s) are retained. This is done by setting the `face' property to
1347 a list of faces, with FACE as the first element (by default) and the
1348 pre-existing faces as the remaining elements.
1350 If optional fourth argument APPEND is non-nil, append FACE to the end
1351 of the face list instead.
1353 If optional fifth argument OBJECT is a buffer (or nil, which means the
1354 current buffer), START and END are buffer positions (integers or
1355 markers). If OBJECT is a string, START and END are 0-based indices
1356 into it. */)
1357 (Lisp_Object start, Lisp_Object end, Lisp_Object face,
1358 Lisp_Object append, Lisp_Object object)
1360 add_text_properties_1 (start, end, list2 (Qface, face), object,
1361 (NILP (append)
1362 ? TEXT_PROPERTY_PREPEND
1363 : TEXT_PROPERTY_APPEND));
1364 return Qnil;
1367 /* Replace properties of text from START to END with new list of
1368 properties PROPERTIES. OBJECT is the buffer or string containing
1369 the text. OBJECT nil means use the current buffer.
1370 COHERENT_CHANGE_P nil means this is being called as an internal
1371 subroutine, rather than as a change primitive with checking of
1372 read-only, invoking change hooks, etc.. Value is nil if the
1373 function _detected_ that it did not replace any properties, non-nil
1374 otherwise. */
1376 Lisp_Object
1377 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1378 Lisp_Object object, Lisp_Object coherent_change_p)
1380 register INTERVAL i;
1381 Lisp_Object ostart, oend;
1383 ostart = start;
1384 oend = end;
1386 properties = validate_plist (properties);
1388 if (NILP (object))
1389 XSETBUFFER (object, current_buffer);
1391 /* If we want no properties for a whole string,
1392 get rid of its intervals. */
1393 if (NILP (properties) && STRINGP (object)
1394 && XFASTINT (start) == 0
1395 && XFASTINT (end) == SCHARS (object))
1397 if (!string_intervals (object))
1398 return Qnil;
1400 set_string_intervals (object, NULL);
1401 return Qt;
1404 i = validate_interval_range (object, &start, &end, soft);
1406 if (!i)
1408 /* If buffer has no properties, and we want none, return now. */
1409 if (NILP (properties))
1410 return Qnil;
1412 /* Restore the original START and END values
1413 because validate_interval_range increments them for strings. */
1414 start = ostart;
1415 end = oend;
1417 i = validate_interval_range (object, &start, &end, hard);
1418 /* This can return if start == end. */
1419 if (!i)
1420 return Qnil;
1423 if (BUFFERP (object) && !NILP (coherent_change_p))
1424 modify_text_properties (object, start, end);
1426 set_text_properties_1 (start, end, properties, object, i);
1428 if (BUFFERP (object) && !NILP (coherent_change_p))
1429 signal_after_change (XINT (start), XINT (end) - XINT (start),
1430 XINT (end) - XINT (start));
1431 return Qt;
1434 /* Replace properties of text from START to END with new list of
1435 properties PROPERTIES. OBJECT is the buffer or string containing
1436 the text. This does not obey any hooks.
1437 You should provide the interval that START is located in as I.
1438 START and END can be in any order. */
1440 void
1441 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
1443 register INTERVAL prev_changed = NULL;
1444 register ptrdiff_t s, len;
1445 INTERVAL unchanged;
1447 if (XINT (start) < XINT (end))
1449 s = XINT (start);
1450 len = XINT (end) - s;
1452 else if (XINT (end) < XINT (start))
1454 s = XINT (end);
1455 len = XINT (start) - s;
1457 else
1458 return;
1460 eassert (i);
1462 if (i->position != s)
1464 unchanged = i;
1465 i = split_interval_right (unchanged, s - unchanged->position);
1467 if (LENGTH (i) > len)
1469 copy_properties (unchanged, i);
1470 i = split_interval_left (i, len);
1471 set_properties (properties, i, object);
1472 return;
1475 set_properties (properties, i, object);
1477 if (LENGTH (i) == len)
1478 return;
1480 prev_changed = i;
1481 len -= LENGTH (i);
1482 i = next_interval (i);
1485 /* We are starting at the beginning of an interval I. LEN is positive. */
1488 eassert (i != 0);
1490 if (LENGTH (i) >= len)
1492 if (LENGTH (i) > len)
1493 i = split_interval_left (i, len);
1495 /* We have to call set_properties even if we are going to
1496 merge the intervals, so as to make the undo records
1497 and cause redisplay to happen. */
1498 set_properties (properties, i, object);
1499 if (prev_changed)
1500 merge_interval_left (i);
1501 return;
1504 len -= LENGTH (i);
1506 /* We have to call set_properties even if we are going to
1507 merge the intervals, so as to make the undo records
1508 and cause redisplay to happen. */
1509 set_properties (properties, i, object);
1510 if (!prev_changed)
1511 prev_changed = i;
1512 else
1513 prev_changed = i = merge_interval_left (i);
1515 i = next_interval (i);
1517 while (len > 0);
1520 DEFUN ("remove-text-properties", Fremove_text_properties,
1521 Sremove_text_properties, 3, 4, 0,
1522 doc: /* Remove some properties from text from START to END.
1523 The third argument PROPERTIES is a property list
1524 whose property names specify the properties to remove.
1525 \(The values stored in PROPERTIES are ignored.)
1526 If the optional fourth argument OBJECT is a buffer (or nil, which means
1527 the current buffer), START and END are buffer positions (integers or
1528 markers). If OBJECT is a string, START and END are 0-based indices into it.
1529 Return t if any property was actually removed, nil otherwise.
1531 Use `set-text-properties' if you want to remove all text properties. */)
1532 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1534 INTERVAL i, unchanged;
1535 ptrdiff_t s, len;
1536 bool modified = 0;
1537 bool first_time = 1;
1539 if (NILP (object))
1540 XSETBUFFER (object, current_buffer);
1542 retry:
1543 i = validate_interval_range (object, &start, &end, soft);
1544 if (!i)
1545 return Qnil;
1547 s = XINT (start);
1548 len = XINT (end) - s;
1550 /* If there are no properties on this entire interval, return. */
1551 if (! interval_has_some_properties (properties, i))
1553 ptrdiff_t got = LENGTH (i) - (s - i->position);
1557 if (got >= len)
1558 return Qnil;
1559 len -= got;
1560 i = next_interval (i);
1561 got = LENGTH (i);
1563 while (! interval_has_some_properties (properties, i));
1565 /* Split away the beginning of this interval; what we don't
1566 want to modify. */
1567 else if (i->position != s)
1569 unchanged = i;
1570 i = split_interval_right (unchanged, s - unchanged->position);
1571 copy_properties (unchanged, i);
1574 if (BUFFERP (object) && first_time)
1576 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1577 ptrdiff_t prev_pos = i->position;
1579 modify_text_properties (object, start, end);
1580 /* If someone called us recursively as a side effect of
1581 modify_text_properties, and changed the intervals behind our back
1582 (could happen if lock_file, called by prepare_to_modify_buffer,
1583 triggers redisplay, and that calls add-text-properties again
1584 in the same buffer), we cannot continue with I, because its
1585 data changed. So we restart the interval analysis anew. */
1586 if (TOTAL_LENGTH (i) != prev_total_length
1587 || i->position != prev_pos)
1589 first_time = 0;
1590 goto retry;
1594 /* We are at the beginning of an interval, with len to scan */
1595 for (;;)
1597 eassert (i != 0);
1599 if (LENGTH (i) >= len)
1601 if (! interval_has_some_properties (properties, i))
1603 eassert (modified);
1604 if (BUFFERP (object))
1605 signal_after_change (XINT (start), XINT (end) - XINT (start),
1606 XINT (end) - XINT (start));
1607 return Qt;
1610 if (LENGTH (i) == len)
1612 remove_properties (properties, Qnil, i, object);
1613 if (BUFFERP (object))
1614 signal_after_change (XINT (start), XINT (end) - XINT (start),
1615 XINT (end) - XINT (start));
1616 return Qt;
1619 /* i has the properties, and goes past the change limit */
1620 unchanged = i;
1621 i = split_interval_left (i, len);
1622 copy_properties (unchanged, i);
1623 remove_properties (properties, Qnil, i, object);
1624 if (BUFFERP (object))
1625 signal_after_change (XINT (start), XINT (end) - XINT (start),
1626 XINT (end) - XINT (start));
1627 return Qt;
1630 len -= LENGTH (i);
1631 modified |= remove_properties (properties, Qnil, i, object);
1632 i = next_interval (i);
1636 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1637 Sremove_list_of_text_properties, 3, 4, 0,
1638 doc: /* Remove some properties from text from START to END.
1639 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1640 If the optional fourth 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 Return t if any property was actually removed, nil otherwise. */)
1644 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1646 INTERVAL i, unchanged;
1647 ptrdiff_t s, len;
1648 bool modified = 0;
1649 Lisp_Object properties;
1650 properties = list_of_properties;
1652 if (NILP (object))
1653 XSETBUFFER (object, current_buffer);
1655 i = validate_interval_range (object, &start, &end, soft);
1656 if (!i)
1657 return Qnil;
1659 s = XINT (start);
1660 len = XINT (end) - s;
1662 /* If there are no properties on the interval, return. */
1663 if (! interval_has_some_properties_list (properties, i))
1665 ptrdiff_t got = LENGTH (i) - (s - i->position);
1669 if (got >= len)
1670 return Qnil;
1671 len -= got;
1672 i = next_interval (i);
1673 got = LENGTH (i);
1675 while (! interval_has_some_properties_list (properties, i));
1677 /* Split away the beginning of this interval; what we don't
1678 want to modify. */
1679 else if (i->position != s)
1681 unchanged = i;
1682 i = split_interval_right (unchanged, s - unchanged->position);
1683 copy_properties (unchanged, i);
1686 /* We are at the beginning of an interval, with len to scan.
1687 The flag `modified' records if changes have been made.
1688 When object is a buffer, we must call modify_text_properties
1689 before changes are made and signal_after_change when we are done.
1690 We call modify_text_properties before calling remove_properties if modified == 0,
1691 and we call signal_after_change before returning if modified != 0. */
1692 for (;;)
1694 eassert (i != 0);
1696 if (LENGTH (i) >= len)
1698 if (! interval_has_some_properties_list (properties, i))
1700 if (modified)
1702 if (BUFFERP (object))
1703 signal_after_change (XINT (start),
1704 XINT (end) - XINT (start),
1705 XINT (end) - XINT (start));
1706 return Qt;
1708 else
1709 return Qnil;
1711 else if (LENGTH (i) == len)
1713 if (!modified && BUFFERP (object))
1714 modify_text_properties (object, start, end);
1715 remove_properties (Qnil, properties, i, object);
1716 if (BUFFERP (object))
1717 signal_after_change (XINT (start), XINT (end) - XINT (start),
1718 XINT (end) - XINT (start));
1719 return Qt;
1721 else
1722 { /* i has the properties, and goes past the change limit. */
1723 unchanged = i;
1724 i = split_interval_left (i, len);
1725 copy_properties (unchanged, i);
1726 if (!modified && BUFFERP (object))
1727 modify_text_properties (object, start, end);
1728 remove_properties (Qnil, properties, i, object);
1729 if (BUFFERP (object))
1730 signal_after_change (XINT (start), XINT (end) - XINT (start),
1731 XINT (end) - XINT (start));
1732 return Qt;
1735 if (interval_has_some_properties_list (properties, i))
1737 if (!modified && BUFFERP (object))
1738 modify_text_properties (object, start, end);
1739 remove_properties (Qnil, properties, i, object);
1740 modified = 1;
1742 len -= LENGTH (i);
1743 i = next_interval (i);
1744 if (!i)
1746 if (modified)
1748 if (BUFFERP (object))
1749 signal_after_change (XINT (start),
1750 XINT (end) - XINT (start),
1751 XINT (end) - XINT (start));
1752 return Qt;
1754 else
1755 return Qnil;
1760 DEFUN ("text-property-any", Ftext_property_any,
1761 Stext_property_any, 4, 5, 0,
1762 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
1763 If so, return the position of the first character whose property PROPERTY
1764 is `eq' to VALUE. Otherwise return nil.
1765 If the optional fifth argument OBJECT is a buffer (or nil, which means
1766 the current buffer), START and END are buffer positions (integers or
1767 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1768 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1770 register INTERVAL i;
1771 register ptrdiff_t e, pos;
1773 if (NILP (object))
1774 XSETBUFFER (object, current_buffer);
1775 i = validate_interval_range (object, &start, &end, soft);
1776 if (!i)
1777 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1778 e = XINT (end);
1780 while (i)
1782 if (i->position >= e)
1783 break;
1784 if (EQ (textget (i->plist, property), value))
1786 pos = i->position;
1787 if (pos < XINT (start))
1788 pos = XINT (start);
1789 return make_number (pos);
1791 i = next_interval (i);
1793 return Qnil;
1796 DEFUN ("text-property-not-all", Ftext_property_not_all,
1797 Stext_property_not_all, 4, 5, 0,
1798 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
1799 If so, return the position of the first character whose property PROPERTY
1800 is not `eq' to VALUE. Otherwise, return nil.
1801 If the optional fifth argument OBJECT is a buffer (or nil, which means
1802 the current buffer), START and END are buffer positions (integers or
1803 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1804 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1806 register INTERVAL i;
1807 register ptrdiff_t s, e;
1809 if (NILP (object))
1810 XSETBUFFER (object, current_buffer);
1811 i = validate_interval_range (object, &start, &end, soft);
1812 if (!i)
1813 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1814 s = XINT (start);
1815 e = XINT (end);
1817 while (i)
1819 if (i->position >= e)
1820 break;
1821 if (! EQ (textget (i->plist, property), value))
1823 if (i->position > s)
1824 s = i->position;
1825 return make_number (s);
1827 i = next_interval (i);
1829 return Qnil;
1833 /* Return the direction from which the text-property PROP would be
1834 inherited by any new text inserted at POS: 1 if it would be
1835 inherited from the char after POS, -1 if it would be inherited from
1836 the char before POS, and 0 if from neither.
1837 BUFFER can be either a buffer or nil (meaning current buffer). */
1840 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1842 bool ignore_previous_character;
1843 Lisp_Object prev_pos = make_number (XINT (pos) - 1);
1844 Lisp_Object front_sticky;
1845 bool is_rear_sticky = true, is_front_sticky = false; /* defaults */
1846 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
1848 if (NILP (buffer))
1849 XSETBUFFER (buffer, current_buffer);
1851 ignore_previous_character = XINT (pos) <= BUF_BEGV (XBUFFER (buffer));
1853 if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt))))
1854 is_rear_sticky = false;
1855 else
1857 Lisp_Object rear_non_sticky
1858 = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1860 if (!NILP (CONSP (rear_non_sticky)
1861 ? Fmemq (prop, rear_non_sticky)
1862 : rear_non_sticky))
1863 /* PROP is rear-non-sticky. */
1864 is_rear_sticky = false;
1867 /* Consider following character. */
1868 /* This signals an arg-out-of-range error if pos is outside the
1869 buffer's accessible range. */
1870 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1872 if (EQ (front_sticky, Qt)
1873 || (CONSP (front_sticky)
1874 && !NILP (Fmemq (prop, front_sticky))))
1875 /* PROP is inherited from after. */
1876 is_front_sticky = true;
1878 /* Simple cases, where the properties are consistent. */
1879 if (is_rear_sticky && !is_front_sticky)
1880 return -1;
1881 else if (!is_rear_sticky && is_front_sticky)
1882 return 1;
1883 else if (!is_rear_sticky && !is_front_sticky)
1884 return 0;
1886 /* The stickiness properties are inconsistent, so we have to
1887 disambiguate. Basically, rear-sticky wins, _except_ if the
1888 property that would be inherited has a value of nil, in which case
1889 front-sticky wins. */
1890 if (ignore_previous_character
1891 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1892 return 1;
1893 else
1894 return -1;
1898 /* Copying properties between objects. */
1900 /* Add properties from START to END of SRC, starting at POS in DEST.
1901 SRC and DEST may each refer to strings or buffers.
1902 Optional sixth argument PROP causes only that property to be copied.
1903 Properties are copied to DEST as if by `add-text-properties'.
1904 Return t if any property value actually changed, nil otherwise. */
1906 /* Note this can GC when DEST is a buffer. */
1908 Lisp_Object
1909 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1911 INTERVAL i;
1912 Lisp_Object res;
1913 Lisp_Object stuff;
1914 Lisp_Object plist;
1915 ptrdiff_t s, e, e2, p, len;
1916 bool modified = 0;
1917 struct gcpro gcpro1, gcpro2;
1919 i = validate_interval_range (src, &start, &end, soft);
1920 if (!i)
1921 return Qnil;
1923 CHECK_NUMBER_COERCE_MARKER (pos);
1925 Lisp_Object dest_start, dest_end;
1927 e = XINT (pos) + (XINT (end) - XINT (start));
1928 if (MOST_POSITIVE_FIXNUM < e)
1929 args_out_of_range (pos, end);
1930 dest_start = pos;
1931 XSETFASTINT (dest_end, e);
1932 /* Apply this to a copy of pos; it will try to increment its arguments,
1933 which we don't want. */
1934 validate_interval_range (dest, &dest_start, &dest_end, soft);
1937 s = XINT (start);
1938 e = XINT (end);
1939 p = XINT (pos);
1941 stuff = Qnil;
1943 while (s < e)
1945 e2 = i->position + LENGTH (i);
1946 if (e2 > e)
1947 e2 = e;
1948 len = e2 - s;
1950 plist = i->plist;
1951 if (! NILP (prop))
1952 while (! NILP (plist))
1954 if (EQ (Fcar (plist), prop))
1956 plist = list2 (prop, Fcar (Fcdr (plist)));
1957 break;
1959 plist = Fcdr (Fcdr (plist));
1961 if (! NILP (plist))
1963 /* Must defer modifications to the interval tree in case src
1964 and dest refer to the same string or buffer. */
1965 stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
1966 stuff);
1969 i = next_interval (i);
1970 if (!i)
1971 break;
1973 p += len;
1974 s = i->position;
1977 GCPRO2 (stuff, dest);
1979 while (! NILP (stuff))
1981 res = Fcar (stuff);
1982 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1983 Fcar (Fcdr (Fcdr (res))), dest);
1984 if (! NILP (res))
1985 modified = 1;
1986 stuff = Fcdr (stuff);
1989 UNGCPRO;
1991 return modified ? Qt : Qnil;
1995 /* Return a list representing the text properties of OBJECT between
1996 START and END. if PROP is non-nil, report only on that property.
1997 Each result list element has the form (S E PLIST), where S and E
1998 are positions in OBJECT and PLIST is a property list containing the
1999 text properties of OBJECT between S and E. Value is nil if OBJECT
2000 doesn't contain text properties between START and END. */
2002 Lisp_Object
2003 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
2005 struct interval *i;
2006 Lisp_Object result;
2008 result = Qnil;
2010 i = validate_interval_range (object, &start, &end, soft);
2011 if (i)
2013 ptrdiff_t s = XINT (start);
2014 ptrdiff_t e = XINT (end);
2016 while (s < e)
2018 ptrdiff_t interval_end, len;
2019 Lisp_Object plist;
2021 interval_end = i->position + LENGTH (i);
2022 if (interval_end > e)
2023 interval_end = e;
2024 len = interval_end - s;
2026 plist = i->plist;
2028 if (!NILP (prop))
2029 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
2030 if (EQ (XCAR (plist), prop))
2032 plist = list2 (prop, Fcar (XCDR (plist)));
2033 break;
2036 if (!NILP (plist))
2037 result = Fcons (list3 (make_number (s), make_number (s + len),
2038 plist),
2039 result);
2041 i = next_interval (i);
2042 if (!i)
2043 break;
2044 s = i->position;
2048 return result;
2052 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2053 (START END PLIST), where START and END are positions and PLIST is a
2054 property list containing the text properties to add. Adjust START
2055 and END positions by DELTA before adding properties. */
2057 void
2058 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
2060 struct gcpro gcpro1, gcpro2;
2062 GCPRO2 (list, object);
2064 for (; CONSP (list); list = XCDR (list))
2066 Lisp_Object item, start, end, plist;
2068 item = XCAR (list);
2069 start = make_number (XINT (XCAR (item)) + XINT (delta));
2070 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
2071 plist = XCAR (XCDR (XCDR (item)));
2073 Fadd_text_properties (start, end, plist, object);
2076 UNGCPRO;
2081 /* Modify end-points of ranges in LIST destructively, and return the
2082 new list. LIST is a list as returned from text_property_list.
2083 Discard properties that begin at or after NEW_END, and limit
2084 end-points to NEW_END. */
2086 Lisp_Object
2087 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
2089 Lisp_Object prev = Qnil, head = list;
2090 ptrdiff_t max = XINT (new_end);
2092 for (; CONSP (list); prev = list, list = XCDR (list))
2094 Lisp_Object item, beg, end;
2096 item = XCAR (list);
2097 beg = XCAR (item);
2098 end = XCAR (XCDR (item));
2100 if (XINT (beg) >= max)
2102 /* The start-point is past the end of the new string.
2103 Discard this property. */
2104 if (EQ (head, list))
2105 head = XCDR (list);
2106 else
2107 XSETCDR (prev, XCDR (list));
2109 else if (XINT (end) > max)
2110 /* The end-point is past the end of the new string. */
2111 XSETCAR (XCDR (item), new_end);
2114 return head;
2119 /* Call the modification hook functions in LIST, each with START and END. */
2121 static void
2122 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
2124 struct gcpro gcpro1;
2125 GCPRO1 (list);
2126 while (!NILP (list))
2128 call2 (Fcar (list), start, end);
2129 list = Fcdr (list);
2131 UNGCPRO;
2134 /* Check for read-only intervals between character positions START ... END,
2135 in BUF, and signal an error if we find one.
2137 Then check for any modification hooks in the range.
2138 Create a list of all these hooks in lexicographic order,
2139 eliminating consecutive extra copies of the same hook. Then call
2140 those hooks in order, with START and END - 1 as arguments. */
2142 void
2143 verify_interval_modification (struct buffer *buf,
2144 ptrdiff_t start, ptrdiff_t end)
2146 INTERVAL intervals = buffer_intervals (buf);
2147 INTERVAL i;
2148 Lisp_Object hooks;
2149 Lisp_Object prev_mod_hooks;
2150 Lisp_Object mod_hooks;
2151 struct gcpro gcpro1;
2153 hooks = Qnil;
2154 prev_mod_hooks = Qnil;
2155 mod_hooks = Qnil;
2157 interval_insert_behind_hooks = Qnil;
2158 interval_insert_in_front_hooks = Qnil;
2160 if (!intervals)
2161 return;
2163 if (start > end)
2165 ptrdiff_t temp = start;
2166 start = end;
2167 end = temp;
2170 /* For an insert operation, check the two chars around the position. */
2171 if (start == end)
2173 INTERVAL prev = NULL;
2174 Lisp_Object before, after;
2176 /* Set I to the interval containing the char after START,
2177 and PREV to the interval containing the char before START.
2178 Either one may be null. They may be equal. */
2179 i = find_interval (intervals, start);
2181 if (start == BUF_BEGV (buf))
2182 prev = 0;
2183 else if (i->position == start)
2184 prev = previous_interval (i);
2185 else if (i->position < start)
2186 prev = i;
2187 if (start == BUF_ZV (buf))
2188 i = 0;
2190 /* If Vinhibit_read_only is set and is not a list, we can
2191 skip the read_only checks. */
2192 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2194 /* If I and PREV differ we need to check for the read-only
2195 property together with its stickiness. If either I or
2196 PREV are 0, this check is all we need.
2197 We have to take special care, since read-only may be
2198 indirectly defined via the category property. */
2199 if (i != prev)
2201 if (i)
2203 after = textget (i->plist, Qread_only);
2205 /* If interval I is read-only and read-only is
2206 front-sticky, inhibit insertion.
2207 Check for read-only as well as category. */
2208 if (! NILP (after)
2209 && NILP (Fmemq (after, Vinhibit_read_only)))
2211 Lisp_Object tem;
2213 tem = textget (i->plist, Qfront_sticky);
2214 if (TMEM (Qread_only, tem)
2215 || (NILP (Fplist_get (i->plist, Qread_only))
2216 && TMEM (Qcategory, tem)))
2217 text_read_only (after);
2221 if (prev)
2223 before = textget (prev->plist, Qread_only);
2225 /* If interval PREV is read-only and read-only isn't
2226 rear-nonsticky, inhibit insertion.
2227 Check for read-only as well as category. */
2228 if (! NILP (before)
2229 && NILP (Fmemq (before, Vinhibit_read_only)))
2231 Lisp_Object tem;
2233 tem = textget (prev->plist, Qrear_nonsticky);
2234 if (! TMEM (Qread_only, tem)
2235 && (! NILP (Fplist_get (prev->plist,Qread_only))
2236 || ! TMEM (Qcategory, tem)))
2237 text_read_only (before);
2241 else if (i)
2243 after = textget (i->plist, Qread_only);
2245 /* If interval I is read-only and read-only is
2246 front-sticky, inhibit insertion.
2247 Check for read-only as well as category. */
2248 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2250 Lisp_Object tem;
2252 tem = textget (i->plist, Qfront_sticky);
2253 if (TMEM (Qread_only, tem)
2254 || (NILP (Fplist_get (i->plist, Qread_only))
2255 && TMEM (Qcategory, tem)))
2256 text_read_only (after);
2258 tem = textget (prev->plist, Qrear_nonsticky);
2259 if (! TMEM (Qread_only, tem)
2260 && (! NILP (Fplist_get (prev->plist, Qread_only))
2261 || ! TMEM (Qcategory, tem)))
2262 text_read_only (after);
2267 /* Run both insert hooks (just once if they're the same). */
2268 if (prev)
2269 interval_insert_behind_hooks
2270 = textget (prev->plist, Qinsert_behind_hooks);
2271 if (i)
2272 interval_insert_in_front_hooks
2273 = textget (i->plist, Qinsert_in_front_hooks);
2275 else
2277 /* Loop over intervals on or next to START...END,
2278 collecting their hooks. */
2280 i = find_interval (intervals, start);
2283 if (! INTERVAL_WRITABLE_P (i))
2284 text_read_only (textget (i->plist, Qread_only));
2286 if (!inhibit_modification_hooks)
2288 mod_hooks = textget (i->plist, Qmodification_hooks);
2289 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2291 hooks = Fcons (mod_hooks, hooks);
2292 prev_mod_hooks = mod_hooks;
2296 i = next_interval (i);
2298 /* Keep going thru the interval containing the char before END. */
2299 while (i && i->position < end);
2301 if (!inhibit_modification_hooks)
2303 GCPRO1 (hooks);
2304 hooks = Fnreverse (hooks);
2305 while (! EQ (hooks, Qnil))
2307 call_mod_hooks (Fcar (hooks), make_number (start),
2308 make_number (end));
2309 hooks = Fcdr (hooks);
2311 UNGCPRO;
2316 /* Run the interval hooks for an insertion on character range START ... END.
2317 verify_interval_modification chose which hooks to run;
2318 this function is called after the insertion happens
2319 so it can indicate the range of inserted text. */
2321 void
2322 report_interval_modification (Lisp_Object start, Lisp_Object end)
2324 if (! NILP (interval_insert_behind_hooks))
2325 call_mod_hooks (interval_insert_behind_hooks, start, end);
2326 if (! NILP (interval_insert_in_front_hooks)
2327 && ! EQ (interval_insert_in_front_hooks,
2328 interval_insert_behind_hooks))
2329 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2332 void
2333 syms_of_textprop (void)
2335 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2336 doc: /* Property-list used as default values.
2337 The value of a property in this list is seen as the value for every
2338 character that does not have its own value for that property. */);
2339 Vdefault_text_properties = Qnil;
2341 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2342 doc: /* Alist of alternative properties for properties without a value.
2343 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2344 If a piece of text has no direct value for a particular property, then
2345 this alist is consulted. If that property appears in the alist, then
2346 the first non-nil value from the associated alternative properties is
2347 returned. */);
2348 Vchar_property_alias_alist = Qnil;
2350 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2351 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2352 This also inhibits the use of the `intangible' text property. */);
2353 Vinhibit_point_motion_hooks = Qnil;
2355 DEFVAR_LISP ("text-property-default-nonsticky",
2356 Vtext_property_default_nonsticky,
2357 doc: /* Alist of properties vs the corresponding non-stickiness.
2358 Each element has the form (PROPERTY . NONSTICKINESS).
2360 If a character in a buffer has PROPERTY, new text inserted adjacent to
2361 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2362 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2363 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2364 /* Text properties `syntax-table'and `display' should be nonsticky
2365 by default. */
2366 Vtext_property_default_nonsticky
2367 = list2 (Fcons (intern_c_string ("syntax-table"), Qt),
2368 Fcons (intern_c_string ("display"), Qt));
2370 staticpro (&interval_insert_behind_hooks);
2371 staticpro (&interval_insert_in_front_hooks);
2372 interval_insert_behind_hooks = Qnil;
2373 interval_insert_in_front_hooks = Qnil;
2376 /* Common attributes one might give text */
2378 DEFSYM (Qforeground, "foreground");
2379 DEFSYM (Qbackground, "background");
2380 DEFSYM (Qfont, "font");
2381 DEFSYM (Qface, "face");
2382 DEFSYM (Qstipple, "stipple");
2383 DEFSYM (Qunderline, "underline");
2384 DEFSYM (Qread_only, "read-only");
2385 DEFSYM (Qinvisible, "invisible");
2386 DEFSYM (Qintangible, "intangible");
2387 DEFSYM (Qcategory, "category");
2388 DEFSYM (Qlocal_map, "local-map");
2389 DEFSYM (Qfront_sticky, "front-sticky");
2390 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2391 DEFSYM (Qmouse_face, "mouse-face");
2392 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
2394 /* Properties that text might use to specify certain actions */
2396 DEFSYM (Qmouse_left, "mouse-left");
2397 DEFSYM (Qmouse_entered, "mouse-entered");
2398 DEFSYM (Qpoint_left, "point-left");
2399 DEFSYM (Qpoint_entered, "point-entered");
2401 defsubr (&Stext_properties_at);
2402 defsubr (&Sget_text_property);
2403 defsubr (&Sget_char_property);
2404 defsubr (&Sget_char_property_and_overlay);
2405 defsubr (&Snext_char_property_change);
2406 defsubr (&Sprevious_char_property_change);
2407 defsubr (&Snext_single_char_property_change);
2408 defsubr (&Sprevious_single_char_property_change);
2409 defsubr (&Snext_property_change);
2410 defsubr (&Snext_single_property_change);
2411 defsubr (&Sprevious_property_change);
2412 defsubr (&Sprevious_single_property_change);
2413 defsubr (&Sadd_text_properties);
2414 defsubr (&Sput_text_property);
2415 defsubr (&Sset_text_properties);
2416 defsubr (&Sadd_face_text_property);
2417 defsubr (&Sremove_text_properties);
2418 defsubr (&Sremove_list_of_text_properties);
2419 defsubr (&Stext_property_any);
2420 defsubr (&Stext_property_not_all);