Auto-commit of generated files.
[emacs.git] / src / textprop.c
blobe5d4fe06c6046eb71186c698050c333fd41f68dc
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2013 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 region of BUFFER from START to END. */
98 static void
99 modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
101 struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
103 set_buffer_internal (buf);
104 modify_region_1 (XINT (start), XINT (end), true);
105 set_buffer_internal (old);
108 /* Complain if object is not string or buffer type. */
110 static void
111 CHECK_STRING_OR_BUFFER (Lisp_Object x)
113 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
116 /* Extract the interval at the position pointed to by BEGIN from
117 OBJECT, a string or buffer. Additionally, check that the positions
118 pointed to by BEGIN and END are within the bounds of OBJECT, and
119 reverse them if *BEGIN is greater than *END. The objects pointed
120 to by BEGIN and END may be integers or markers; if the latter, they
121 are coerced to integers.
123 When OBJECT is a string, we increment *BEGIN and *END
124 to make them origin-one.
126 Note that buffer points don't correspond to interval indices.
127 For example, point-max is 1 greater than the index of the last
128 character. This difference is handled in the caller, which uses
129 the validated points to determine a length, and operates on that.
130 Exceptions are Ftext_properties_at, Fnext_property_change, and
131 Fprevious_property_change which call this function with BEGIN == END.
132 Handle this case specially.
134 If FORCE is soft (0), it's OK to return NULL. Otherwise,
135 create an interval tree for OBJECT if one doesn't exist, provided
136 the object actually contains text. In the current design, if there
137 is no text, there can be no text properties. */
139 #define soft 0
140 #define hard 1
142 INTERVAL
143 validate_interval_range (Lisp_Object object, Lisp_Object *begin,
144 Lisp_Object *end, bool force)
146 INTERVAL i;
147 ptrdiff_t searchpos;
149 CHECK_STRING_OR_BUFFER (object);
150 CHECK_NUMBER_COERCE_MARKER (*begin);
151 CHECK_NUMBER_COERCE_MARKER (*end);
153 /* If we are asked for a point, but from a subr which operates
154 on a range, then return nothing. */
155 if (EQ (*begin, *end) && begin != end)
156 return NULL;
158 if (XINT (*begin) > XINT (*end))
160 Lisp_Object n;
161 n = *begin;
162 *begin = *end;
163 *end = n;
166 if (BUFFERP (object))
168 register struct buffer *b = XBUFFER (object);
170 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
171 && XINT (*end) <= BUF_ZV (b)))
172 args_out_of_range (*begin, *end);
173 i = buffer_intervals (b);
175 /* If there's no text, there are no properties. */
176 if (BUF_BEGV (b) == BUF_ZV (b))
177 return NULL;
179 searchpos = XINT (*begin);
181 else
183 ptrdiff_t len = SCHARS (object);
185 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
186 && XINT (*end) <= len))
187 args_out_of_range (*begin, *end);
188 XSETFASTINT (*begin, XFASTINT (*begin));
189 if (begin != end)
190 XSETFASTINT (*end, XFASTINT (*end));
191 i = string_intervals (object);
193 if (len == 0)
194 return NULL;
196 searchpos = XINT (*begin);
199 if (!i)
200 return (force ? create_root_interval (object) : i);
202 return find_interval (i, searchpos);
205 /* Validate LIST as a property list. If LIST is not a list, then
206 make one consisting of (LIST nil). Otherwise, verify that LIST
207 is even numbered and thus suitable as a plist. */
209 static Lisp_Object
210 validate_plist (Lisp_Object list)
212 if (NILP (list))
213 return Qnil;
215 if (CONSP (list))
217 bool odd_length = 0;
218 Lisp_Object tail;
219 for (tail = list; CONSP (tail); tail = XCDR (tail))
221 odd_length ^= 1;
222 QUIT;
224 if (odd_length)
225 error ("Odd length text property list");
226 return list;
229 return Fcons (list, Fcons (Qnil, Qnil));
232 /* Return true if interval I has all the properties,
233 with the same values, of list PLIST. */
235 static bool
236 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
238 Lisp_Object tail1, tail2;
240 /* Go through each element of PLIST. */
241 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
243 Lisp_Object sym1 = XCAR (tail1);
244 bool found = 0;
246 /* Go through I's plist, looking for sym1 */
247 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
248 if (EQ (sym1, XCAR (tail2)))
250 /* Found the same property on both lists. If the
251 values are unequal, return zero. */
252 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
253 return 0;
255 /* Property has same value on both lists; go to next one. */
256 found = 1;
257 break;
260 if (! found)
261 return 0;
264 return 1;
267 /* Return true if the plist of interval I has any of the
268 properties of PLIST, regardless of their values. */
270 static bool
271 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
273 Lisp_Object tail1, tail2, sym;
275 /* Go through each element of PLIST. */
276 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
278 sym = XCAR (tail1);
280 /* Go through i's plist, looking for tail1 */
281 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
282 if (EQ (sym, XCAR (tail2)))
283 return 1;
286 return 0;
289 /* Return nonzero if the plist of interval I has any of the
290 property names in LIST, regardless of their values. */
292 static bool
293 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
295 Lisp_Object tail1, tail2, sym;
297 /* Go through each element of LIST. */
298 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
300 sym = XCAR (tail1);
302 /* Go through i's plist, looking for tail1 */
303 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
304 if (EQ (sym, XCAR (tail2)))
305 return 1;
308 return 0;
311 /* Changing the plists of individual intervals. */
313 /* Return the value of PROP in property-list PLIST, or Qunbound if it
314 has none. */
315 static Lisp_Object
316 property_value (Lisp_Object plist, Lisp_Object prop)
318 Lisp_Object value;
320 while (PLIST_ELT_P (plist, value))
321 if (EQ (XCAR (plist), prop))
322 return XCAR (value);
323 else
324 plist = XCDR (value);
326 return Qunbound;
329 /* Set the properties of INTERVAL to PROPERTIES,
330 and record undo info for the previous values.
331 OBJECT is the string or buffer that INTERVAL belongs to. */
333 static void
334 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
336 Lisp_Object sym, value;
338 if (BUFFERP (object))
340 /* For each property in the old plist which is missing from PROPERTIES,
341 or has a different value in PROPERTIES, make an undo record. */
342 for (sym = interval->plist;
343 PLIST_ELT_P (sym, value);
344 sym = XCDR (value))
345 if (! EQ (property_value (properties, XCAR (sym)),
346 XCAR (value)))
348 record_property_change (interval->position, LENGTH (interval),
349 XCAR (sym), XCAR (value),
350 object);
353 /* For each new property that has no value at all in the old plist,
354 make an undo record binding it to nil, so it will be removed. */
355 for (sym = properties;
356 PLIST_ELT_P (sym, value);
357 sym = XCDR (value))
358 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
360 record_property_change (interval->position, LENGTH (interval),
361 XCAR (sym), Qnil,
362 object);
366 /* Store new properties. */
367 set_interval_plist (interval, Fcopy_sequence (properties));
370 /* Add the properties of PLIST to the interval I, or set
371 the value of I's property to the value of the property on PLIST
372 if they are different.
374 OBJECT should be the string or buffer the interval is in.
376 Return true if this changes I (i.e., if any members of PLIST
377 are actually added to I's plist) */
379 static bool
380 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
381 enum property_set_type set_type)
383 Lisp_Object tail1, tail2, sym1, val1;
384 bool changed = 0;
385 struct gcpro gcpro1, gcpro2, gcpro3;
387 tail1 = plist;
388 sym1 = Qnil;
389 val1 = Qnil;
390 /* No need to protect OBJECT, because we can GC only in the case
391 where it is a buffer, and live buffers are always protected.
392 I and its plist are also protected, via OBJECT. */
393 GCPRO3 (tail1, sym1, val1);
395 /* Go through each element of PLIST. */
396 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
398 bool found = 0;
399 sym1 = XCAR (tail1);
400 val1 = Fcar (XCDR (tail1));
402 /* Go through I's plist, looking for sym1 */
403 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
404 if (EQ (sym1, XCAR (tail2)))
406 /* No need to gcpro, because tail2 protects this
407 and it must be a cons cell (we get an error otherwise). */
408 register Lisp_Object this_cdr;
410 this_cdr = XCDR (tail2);
411 /* Found the property. Now check its value. */
412 found = 1;
414 /* The properties have the same value on both lists.
415 Continue to the next property. */
416 if (EQ (val1, Fcar (this_cdr)))
417 break;
419 /* Record this change in the buffer, for undo purposes. */
420 if (BUFFERP (object))
422 record_property_change (i->position, LENGTH (i),
423 sym1, Fcar (this_cdr), object);
426 /* I's property has a different value -- change it */
427 if (set_type == TEXT_PROPERTY_REPLACE)
428 Fsetcar (this_cdr, val1);
429 else {
430 if (CONSP (Fcar (this_cdr)) &&
431 /* Special-case anonymous face properties. */
432 (! EQ (sym1, Qface) ||
433 NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
434 /* The previous value is a list, so prepend (or
435 append) the new value to this list. */
436 if (set_type == TEXT_PROPERTY_PREPEND)
437 Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
438 else
439 nconc2 (Fcar (this_cdr), Fcons (val1, Qnil));
440 else {
441 /* The previous value is a single value, so make it
442 into a list. */
443 if (set_type == TEXT_PROPERTY_PREPEND)
444 Fsetcar (this_cdr,
445 Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
446 else
447 Fsetcar (this_cdr,
448 Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
451 changed = 1;
452 break;
455 if (! found)
457 /* Record this change in the buffer, for undo purposes. */
458 if (BUFFERP (object))
460 record_property_change (i->position, LENGTH (i),
461 sym1, Qnil, object);
463 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
464 changed = 1;
468 UNGCPRO;
470 return changed;
473 /* For any members of PLIST, or LIST,
474 which are properties of I, remove them from I's plist.
475 (If PLIST is non-nil, use that, otherwise use LIST.)
476 OBJECT is the string or buffer containing I. */
478 static bool
479 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
481 Lisp_Object tail1, tail2, sym, current_plist;
482 bool changed = 0;
484 /* True means tail1 is a plist, otherwise it is a list. */
485 bool use_plist;
487 current_plist = i->plist;
489 if (! NILP (plist))
490 tail1 = plist, use_plist = 1;
491 else
492 tail1 = list, use_plist = 0;
494 /* Go through each element of LIST or PLIST. */
495 while (CONSP (tail1))
497 sym = XCAR (tail1);
499 /* First, remove the symbol if it's at the head of the list */
500 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
502 if (BUFFERP (object))
503 record_property_change (i->position, LENGTH (i),
504 sym, XCAR (XCDR (current_plist)),
505 object);
507 current_plist = XCDR (XCDR (current_plist));
508 changed = 1;
511 /* Go through I's plist, looking for SYM. */
512 tail2 = current_plist;
513 while (! NILP (tail2))
515 register Lisp_Object this;
516 this = XCDR (XCDR (tail2));
517 if (CONSP (this) && EQ (sym, XCAR (this)))
519 if (BUFFERP (object))
520 record_property_change (i->position, LENGTH (i),
521 sym, XCAR (XCDR (this)), object);
523 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
524 changed = 1;
526 tail2 = this;
529 /* Advance thru TAIL1 one way or the other. */
530 tail1 = XCDR (tail1);
531 if (use_plist && CONSP (tail1))
532 tail1 = XCDR (tail1);
535 if (changed)
536 set_interval_plist (i, current_plist);
537 return changed;
540 /* Returns the interval of POSITION in OBJECT.
541 POSITION is BEG-based. */
543 INTERVAL
544 interval_of (ptrdiff_t position, Lisp_Object object)
546 register INTERVAL i;
547 ptrdiff_t beg, end;
549 if (NILP (object))
550 XSETBUFFER (object, current_buffer);
551 else if (EQ (object, Qt))
552 return NULL;
554 CHECK_STRING_OR_BUFFER (object);
556 if (BUFFERP (object))
558 register struct buffer *b = XBUFFER (object);
560 beg = BUF_BEGV (b);
561 end = BUF_ZV (b);
562 i = buffer_intervals (b);
564 else
566 beg = 0;
567 end = SCHARS (object);
568 i = string_intervals (object);
571 if (!(beg <= position && position <= end))
572 args_out_of_range (make_number (position), make_number (position));
573 if (beg == end || !i)
574 return NULL;
576 return find_interval (i, position);
579 DEFUN ("text-properties-at", Ftext_properties_at,
580 Stext_properties_at, 1, 2, 0,
581 doc: /* Return the list of properties of the character at POSITION in OBJECT.
582 If the optional second argument OBJECT is a buffer (or nil, which means
583 the current buffer), POSITION is a buffer position (integer or marker).
584 If OBJECT is a string, POSITION is a 0-based index into it.
585 If POSITION is at the end of OBJECT, the value is nil. */)
586 (Lisp_Object position, Lisp_Object object)
588 register INTERVAL i;
590 if (NILP (object))
591 XSETBUFFER (object, current_buffer);
593 i = validate_interval_range (object, &position, &position, soft);
594 if (!i)
595 return Qnil;
596 /* If POSITION is at the end of the interval,
597 it means it's the end of OBJECT.
598 There are no properties at the very end,
599 since no character follows. */
600 if (XINT (position) == LENGTH (i) + i->position)
601 return Qnil;
603 return i->plist;
606 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
607 doc: /* Return the value of POSITION's property PROP, in OBJECT.
608 OBJECT should be a buffer or a string; if omitted or nil, it defaults
609 to the current buffer.
610 If POSITION is at the end of OBJECT, the value is nil. */)
611 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
613 return textget (Ftext_properties_at (position, object), prop);
616 /* Return the value of char's property PROP, in OBJECT at POSITION.
617 OBJECT is optional and defaults to the current buffer.
618 If OVERLAY is non-0, then in the case that the returned property is from
619 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
620 returned in *OVERLAY.
621 If POSITION is at the end of OBJECT, the value is nil.
622 If OBJECT is a buffer, then overlay properties are considered as well as
623 text properties.
624 If OBJECT is a window, then that window's buffer is used, but
625 window-specific overlays are considered only if they are associated
626 with OBJECT. */
627 Lisp_Object
628 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
630 struct window *w = 0;
632 CHECK_NUMBER_COERCE_MARKER (position);
634 if (NILP (object))
635 XSETBUFFER (object, current_buffer);
637 if (WINDOWP (object))
639 CHECK_LIVE_WINDOW (object);
640 w = XWINDOW (object);
641 object = w->contents;
643 if (BUFFERP (object))
645 ptrdiff_t noverlays;
646 Lisp_Object *overlay_vec;
647 struct buffer *obuf = current_buffer;
649 if (XINT (position) < BUF_BEGV (XBUFFER (object))
650 || XINT (position) > BUF_ZV (XBUFFER (object)))
651 xsignal1 (Qargs_out_of_range, position);
653 set_buffer_temp (XBUFFER (object));
655 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
656 noverlays = sort_overlays (overlay_vec, noverlays, w);
658 set_buffer_temp (obuf);
660 /* Now check the overlays in order of decreasing priority. */
661 while (--noverlays >= 0)
663 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
664 if (!NILP (tem))
666 if (overlay)
667 /* Return the overlay we got the property from. */
668 *overlay = overlay_vec[noverlays];
669 return tem;
674 if (overlay)
675 /* Indicate that the return value is not from an overlay. */
676 *overlay = Qnil;
678 /* Not a buffer, or no appropriate overlay, so fall through to the
679 simpler case. */
680 return Fget_text_property (position, prop, object);
683 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
684 doc: /* Return the value of POSITION's property PROP, in OBJECT.
685 Both overlay properties and text properties are checked.
686 OBJECT is optional and defaults to the current buffer.
687 If POSITION is at the end of OBJECT, the value is nil.
688 If OBJECT is a buffer, then overlay properties are considered as well as
689 text properties.
690 If OBJECT is a window, then that window's buffer is used, but window-specific
691 overlays are considered only if they are associated with OBJECT. */)
692 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
694 return get_char_property_and_overlay (position, prop, object, 0);
697 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
698 Sget_char_property_and_overlay, 2, 3, 0,
699 doc: /* Like `get-char-property', but with extra overlay information.
700 The value is a cons cell. Its car is the return value of `get-char-property'
701 with the same arguments--that is, the value of POSITION's property
702 PROP in OBJECT. Its cdr is the overlay in which the property was
703 found, or nil, if it was found as a text property or not found at all.
705 OBJECT is optional and defaults to the current buffer. OBJECT may be
706 a string, a buffer or a window. For strings, the cdr of the return
707 value is always nil, since strings do not have overlays. If OBJECT is
708 a window, then that window's buffer is used, but window-specific
709 overlays are considered only if they are associated with OBJECT. If
710 POSITION is at the end of OBJECT, both car and cdr are nil. */)
711 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
713 Lisp_Object overlay;
714 Lisp_Object val
715 = get_char_property_and_overlay (position, prop, object, &overlay);
716 return Fcons (val, overlay);
720 DEFUN ("next-char-property-change", Fnext_char_property_change,
721 Snext_char_property_change, 1, 2, 0,
722 doc: /* Return the position of next text property or overlay change.
723 This scans characters forward in the current buffer from POSITION till
724 it finds a change in some text property, or the beginning or end of an
725 overlay, and returns the position of that.
726 If none is found up to (point-max), the function returns (point-max).
728 If the optional second argument LIMIT is non-nil, don't search
729 past position LIMIT; return LIMIT if nothing is found before LIMIT.
730 LIMIT is a no-op if it is greater than (point-max). */)
731 (Lisp_Object position, Lisp_Object limit)
733 Lisp_Object temp;
735 temp = Fnext_overlay_change (position);
736 if (! NILP (limit))
738 CHECK_NUMBER_COERCE_MARKER (limit);
739 if (XINT (limit) < XINT (temp))
740 temp = limit;
742 return Fnext_property_change (position, Qnil, temp);
745 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
746 Sprevious_char_property_change, 1, 2, 0,
747 doc: /* Return the position of previous text property or overlay change.
748 Scans characters backward in the current buffer from POSITION till it
749 finds a change in some text property, or the beginning or end of an
750 overlay, and returns the position of that.
751 If none is found since (point-min), the function returns (point-min).
753 If the optional second argument LIMIT is non-nil, don't search
754 past position LIMIT; return LIMIT if nothing is found before LIMIT.
755 LIMIT is a no-op if it is less than (point-min). */)
756 (Lisp_Object position, Lisp_Object limit)
758 Lisp_Object temp;
760 temp = Fprevious_overlay_change (position);
761 if (! NILP (limit))
763 CHECK_NUMBER_COERCE_MARKER (limit);
764 if (XINT (limit) > XINT (temp))
765 temp = limit;
767 return Fprevious_property_change (position, Qnil, temp);
771 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
772 Snext_single_char_property_change, 2, 4, 0,
773 doc: /* Return the position of next text property or overlay change for a specific property.
774 Scans characters forward from POSITION till it finds
775 a change in the PROP property, then returns the position of the change.
776 If the optional third argument OBJECT is a buffer (or nil, which means
777 the current buffer), POSITION is a buffer position (integer or marker).
778 If OBJECT is a string, POSITION is a 0-based index into it.
780 In a string, scan runs to the end of the string.
781 In a buffer, it runs to (point-max), and the value cannot exceed that.
783 The property values are compared with `eq'.
784 If the property is constant all the way to the end of OBJECT, return the
785 last valid position in OBJECT.
786 If the optional fourth argument LIMIT is non-nil, don't search
787 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
788 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
790 if (STRINGP (object))
792 position = Fnext_single_property_change (position, prop, object, limit);
793 if (NILP (position))
795 if (NILP (limit))
796 position = make_number (SCHARS (object));
797 else
799 CHECK_NUMBER (limit);
800 position = limit;
804 else
806 Lisp_Object initial_value, value;
807 ptrdiff_t count = SPECPDL_INDEX ();
809 if (! NILP (object))
810 CHECK_BUFFER (object);
812 if (BUFFERP (object) && current_buffer != XBUFFER (object))
814 record_unwind_current_buffer ();
815 Fset_buffer (object);
818 CHECK_NUMBER_COERCE_MARKER (position);
820 initial_value = Fget_char_property (position, prop, object);
822 if (NILP (limit))
823 XSETFASTINT (limit, ZV);
824 else
825 CHECK_NUMBER_COERCE_MARKER (limit);
827 if (XFASTINT (position) >= XFASTINT (limit))
829 position = limit;
830 if (XFASTINT (position) > ZV)
831 XSETFASTINT (position, ZV);
833 else
834 while (1)
836 position = Fnext_char_property_change (position, limit);
837 if (XFASTINT (position) >= XFASTINT (limit))
839 position = limit;
840 break;
843 value = Fget_char_property (position, prop, object);
844 if (!EQ (value, initial_value))
845 break;
848 unbind_to (count, Qnil);
851 return position;
854 DEFUN ("previous-single-char-property-change",
855 Fprevious_single_char_property_change,
856 Sprevious_single_char_property_change, 2, 4, 0,
857 doc: /* Return the position of previous text property or overlay change for a specific property.
858 Scans characters backward from POSITION till it finds
859 a change in the PROP property, then returns the position of the change.
860 If the optional third argument OBJECT is a buffer (or nil, which means
861 the current buffer), POSITION is a buffer position (integer or marker).
862 If OBJECT is a string, POSITION is a 0-based index into it.
864 In a string, scan runs to the start of the string.
865 In a buffer, it runs to (point-min), and the value cannot be less than that.
867 The property values are compared with `eq'.
868 If the property is constant all the way to the start of OBJECT, return the
869 first valid position in OBJECT.
870 If the optional fourth argument LIMIT is non-nil, don't search back past
871 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
872 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
874 if (STRINGP (object))
876 position = Fprevious_single_property_change (position, prop, object, limit);
877 if (NILP (position))
879 if (NILP (limit))
880 position = make_number (0);
881 else
883 CHECK_NUMBER (limit);
884 position = limit;
888 else
890 ptrdiff_t count = SPECPDL_INDEX ();
892 if (! NILP (object))
893 CHECK_BUFFER (object);
895 if (BUFFERP (object) && current_buffer != XBUFFER (object))
897 record_unwind_current_buffer ();
898 Fset_buffer (object);
901 CHECK_NUMBER_COERCE_MARKER (position);
903 if (NILP (limit))
904 XSETFASTINT (limit, BEGV);
905 else
906 CHECK_NUMBER_COERCE_MARKER (limit);
908 if (XFASTINT (position) <= XFASTINT (limit))
910 position = limit;
911 if (XFASTINT (position) < BEGV)
912 XSETFASTINT (position, BEGV);
914 else
916 Lisp_Object initial_value
917 = Fget_char_property (make_number (XFASTINT (position) - 1),
918 prop, object);
920 while (1)
922 position = Fprevious_char_property_change (position, limit);
924 if (XFASTINT (position) <= XFASTINT (limit))
926 position = limit;
927 break;
929 else
931 Lisp_Object value
932 = Fget_char_property (make_number (XFASTINT (position) - 1),
933 prop, object);
935 if (!EQ (value, initial_value))
936 break;
941 unbind_to (count, Qnil);
944 return position;
947 DEFUN ("next-property-change", Fnext_property_change,
948 Snext_property_change, 1, 3, 0,
949 doc: /* Return the position of next property change.
950 Scans characters forward from POSITION in OBJECT till it finds
951 a change in some text property, then returns the position of the change.
952 If the optional second argument OBJECT is a buffer (or nil, which means
953 the current buffer), POSITION is a buffer position (integer or marker).
954 If OBJECT is a string, POSITION is a 0-based index into it.
955 Return nil if the property is constant all the way to the end of OBJECT.
956 If the value is non-nil, it is a position greater than POSITION, never equal.
958 If the optional third argument LIMIT is non-nil, don't search
959 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
960 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
962 register INTERVAL i, next;
964 if (NILP (object))
965 XSETBUFFER (object, current_buffer);
967 if (!NILP (limit) && !EQ (limit, Qt))
968 CHECK_NUMBER_COERCE_MARKER (limit);
970 i = validate_interval_range (object, &position, &position, soft);
972 /* If LIMIT is t, return start of next interval--don't
973 bother checking further intervals. */
974 if (EQ (limit, Qt))
976 if (!i)
977 next = i;
978 else
979 next = next_interval (i);
981 if (!next)
982 XSETFASTINT (position, (STRINGP (object)
983 ? SCHARS (object)
984 : BUF_ZV (XBUFFER (object))));
985 else
986 XSETFASTINT (position, next->position);
987 return position;
990 if (!i)
991 return limit;
993 next = next_interval (i);
995 while (next && intervals_equal (i, next)
996 && (NILP (limit) || next->position < XFASTINT (limit)))
997 next = next_interval (next);
999 if (!next
1000 || (next->position
1001 >= (INTEGERP (limit)
1002 ? XFASTINT (limit)
1003 : (STRINGP (object)
1004 ? SCHARS (object)
1005 : BUF_ZV (XBUFFER (object))))))
1006 return limit;
1007 else
1008 return make_number (next->position);
1011 DEFUN ("next-single-property-change", Fnext_single_property_change,
1012 Snext_single_property_change, 2, 4, 0,
1013 doc: /* Return the position of next property change for a specific property.
1014 Scans characters forward from POSITION till it finds
1015 a change in the PROP property, then returns the position of the change.
1016 If the optional third argument OBJECT is a buffer (or nil, which means
1017 the current buffer), POSITION is a buffer position (integer or marker).
1018 If OBJECT is a string, POSITION is a 0-based index into it.
1019 The property values are compared with `eq'.
1020 Return nil if the property is constant all the way to the end of OBJECT.
1021 If the value is non-nil, it is a position greater than POSITION, never equal.
1023 If the optional fourth argument LIMIT is non-nil, don't search
1024 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1025 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1027 register INTERVAL i, next;
1028 register Lisp_Object here_val;
1030 if (NILP (object))
1031 XSETBUFFER (object, current_buffer);
1033 if (!NILP (limit))
1034 CHECK_NUMBER_COERCE_MARKER (limit);
1036 i = validate_interval_range (object, &position, &position, soft);
1037 if (!i)
1038 return limit;
1040 here_val = textget (i->plist, prop);
1041 next = next_interval (i);
1042 while (next
1043 && EQ (here_val, textget (next->plist, prop))
1044 && (NILP (limit) || next->position < XFASTINT (limit)))
1045 next = next_interval (next);
1047 if (!next
1048 || (next->position
1049 >= (INTEGERP (limit)
1050 ? XFASTINT (limit)
1051 : (STRINGP (object)
1052 ? SCHARS (object)
1053 : BUF_ZV (XBUFFER (object))))))
1054 return limit;
1055 else
1056 return make_number (next->position);
1059 DEFUN ("previous-property-change", Fprevious_property_change,
1060 Sprevious_property_change, 1, 3, 0,
1061 doc: /* Return the position of previous property change.
1062 Scans characters backwards from POSITION in OBJECT till it finds
1063 a change in some text property, then returns the position of the change.
1064 If the optional second argument OBJECT is a buffer (or nil, which means
1065 the current buffer), POSITION is a buffer position (integer or marker).
1066 If OBJECT is a string, POSITION is a 0-based index into it.
1067 Return nil if the property is constant all the way to the start of OBJECT.
1068 If the value is non-nil, it is a position less than POSITION, never equal.
1070 If the optional third argument LIMIT is non-nil, don't search
1071 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1072 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1074 register INTERVAL i, previous;
1076 if (NILP (object))
1077 XSETBUFFER (object, current_buffer);
1079 if (!NILP (limit))
1080 CHECK_NUMBER_COERCE_MARKER (limit);
1082 i = validate_interval_range (object, &position, &position, soft);
1083 if (!i)
1084 return limit;
1086 /* Start with the interval containing the char before point. */
1087 if (i->position == XFASTINT (position))
1088 i = previous_interval (i);
1090 previous = previous_interval (i);
1091 while (previous && intervals_equal (previous, i)
1092 && (NILP (limit)
1093 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1094 previous = previous_interval (previous);
1096 if (!previous
1097 || (previous->position + LENGTH (previous)
1098 <= (INTEGERP (limit)
1099 ? XFASTINT (limit)
1100 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1101 return limit;
1102 else
1103 return make_number (previous->position + LENGTH (previous));
1106 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1107 Sprevious_single_property_change, 2, 4, 0,
1108 doc: /* Return the position of previous property change for a specific property.
1109 Scans characters backward from POSITION till it finds
1110 a change in the PROP property, then returns the position of the change.
1111 If the optional third argument OBJECT is a buffer (or nil, which means
1112 the current buffer), POSITION is a buffer position (integer or marker).
1113 If OBJECT is a string, POSITION is a 0-based index into it.
1114 The property values are compared with `eq'.
1115 Return nil if the property is constant all the way to the start of OBJECT.
1116 If the value is non-nil, it is a position less than POSITION, never equal.
1118 If the optional fourth argument LIMIT is non-nil, don't search
1119 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1120 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1122 register INTERVAL i, previous;
1123 register Lisp_Object here_val;
1125 if (NILP (object))
1126 XSETBUFFER (object, current_buffer);
1128 if (!NILP (limit))
1129 CHECK_NUMBER_COERCE_MARKER (limit);
1131 i = validate_interval_range (object, &position, &position, soft);
1133 /* Start with the interval containing the char before point. */
1134 if (i && i->position == XFASTINT (position))
1135 i = previous_interval (i);
1137 if (!i)
1138 return limit;
1140 here_val = textget (i->plist, prop);
1141 previous = previous_interval (i);
1142 while (previous
1143 && EQ (here_val, textget (previous->plist, prop))
1144 && (NILP (limit)
1145 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1146 previous = previous_interval (previous);
1148 if (!previous
1149 || (previous->position + LENGTH (previous)
1150 <= (INTEGERP (limit)
1151 ? XFASTINT (limit)
1152 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1153 return limit;
1154 else
1155 return make_number (previous->position + LENGTH (previous));
1158 /* Used by add-text-properties and add-face-text-property. */
1160 static Lisp_Object
1161 add_text_properties_1 (Lisp_Object start, Lisp_Object end,
1162 Lisp_Object properties, Lisp_Object object,
1163 enum property_set_type set_type) {
1164 INTERVAL i, unchanged;
1165 ptrdiff_t s, len;
1166 bool modified = 0;
1167 struct gcpro gcpro1;
1168 bool first_time = 1;
1170 properties = validate_plist (properties);
1171 if (NILP (properties))
1172 return Qnil;
1174 if (NILP (object))
1175 XSETBUFFER (object, current_buffer);
1177 retry:
1178 i = validate_interval_range (object, &start, &end, hard);
1179 if (!i)
1180 return Qnil;
1182 s = XINT (start);
1183 len = XINT (end) - s;
1185 /* No need to protect OBJECT, because we GC only if it's a buffer,
1186 and live buffers are always protected. */
1187 GCPRO1 (properties);
1189 /* If this interval already has the properties, we can skip it. */
1190 if (interval_has_all_properties (properties, i))
1192 ptrdiff_t got = LENGTH (i) - (s - i->position);
1196 if (got >= len)
1197 RETURN_UNGCPRO (Qnil);
1198 len -= got;
1199 i = next_interval (i);
1200 got = LENGTH (i);
1202 while (interval_has_all_properties (properties, i));
1204 else if (i->position != s)
1206 /* If we're not starting on an interval boundary, we have to
1207 split this interval. */
1208 unchanged = i;
1209 i = split_interval_right (unchanged, s - unchanged->position);
1210 copy_properties (unchanged, i);
1213 if (BUFFERP (object) && first_time)
1215 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1216 ptrdiff_t prev_pos = i->position;
1218 modify_region (object, start, end);
1219 /* If someone called us recursively as a side effect of
1220 modify_region, and changed the intervals behind our back
1221 (could happen if lock_file, called by prepare_to_modify_buffer,
1222 triggers redisplay, and that calls add-text-properties again
1223 in the same buffer), we cannot continue with I, because its
1224 data changed. So we restart the interval analysis anew. */
1225 if (TOTAL_LENGTH (i) != prev_total_length
1226 || i->position != prev_pos)
1228 first_time = 0;
1229 goto retry;
1233 /* We are at the beginning of interval I, with LEN chars to scan. */
1234 for (;;)
1236 eassert (i != 0);
1238 if (LENGTH (i) >= len)
1240 /* We can UNGCPRO safely here, because there will be just
1241 one more chance to gc, in the next call to add_properties,
1242 and after that we will not need PROPERTIES or OBJECT again. */
1243 UNGCPRO;
1245 if (interval_has_all_properties (properties, i))
1247 if (BUFFERP (object))
1248 signal_after_change (XINT (start), XINT (end) - XINT (start),
1249 XINT (end) - XINT (start));
1251 eassert (modified);
1252 return Qt;
1255 if (LENGTH (i) == len)
1257 add_properties (properties, i, object, set_type);
1258 if (BUFFERP (object))
1259 signal_after_change (XINT (start), XINT (end) - XINT (start),
1260 XINT (end) - XINT (start));
1261 return Qt;
1264 /* i doesn't have the properties, and goes past the change limit */
1265 unchanged = i;
1266 i = split_interval_left (unchanged, len);
1267 copy_properties (unchanged, i);
1268 add_properties (properties, i, object, set_type);
1269 if (BUFFERP (object))
1270 signal_after_change (XINT (start), XINT (end) - XINT (start),
1271 XINT (end) - XINT (start));
1272 return Qt;
1275 len -= LENGTH (i);
1276 modified |= add_properties (properties, i, object, set_type);
1277 i = next_interval (i);
1281 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1283 DEFUN ("add-text-properties", Fadd_text_properties,
1284 Sadd_text_properties, 3, 4, 0,
1285 doc: /* Add properties to the text from START to END.
1286 The third argument PROPERTIES is a property list
1287 specifying the property values to add. If the optional fourth argument
1288 OBJECT is a buffer (or nil, which means the current buffer),
1289 START and END are buffer positions (integers or markers).
1290 If OBJECT is a string, START and END are 0-based indices into it.
1291 Return t if any property value actually changed, nil otherwise. */)
1292 (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1293 Lisp_Object object)
1295 return add_text_properties_1 (start, end, properties, object,
1296 TEXT_PROPERTY_REPLACE);
1299 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1301 DEFUN ("put-text-property", Fput_text_property,
1302 Sput_text_property, 4, 5, 0,
1303 doc: /* Set one property of the text from START to END.
1304 The third and fourth arguments PROPERTY and VALUE
1305 specify the property to add.
1306 If the optional fifth argument OBJECT is a buffer (or nil, which means
1307 the current buffer), START and END are buffer positions (integers or
1308 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1309 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1311 Fadd_text_properties (start, end,
1312 Fcons (property, Fcons (value, Qnil)),
1313 object);
1314 return Qnil;
1317 DEFUN ("set-text-properties", Fset_text_properties,
1318 Sset_text_properties, 3, 4, 0,
1319 doc: /* Completely replace properties of text from START to END.
1320 The third argument PROPERTIES is the new property list.
1321 If the optional fourth argument OBJECT is a buffer (or nil, which means
1322 the current buffer), START and END are buffer positions (integers or
1323 markers). If OBJECT is a string, START and END are 0-based indices into it.
1324 If PROPERTIES is nil, the effect is to remove all properties from
1325 the designated part of OBJECT. */)
1326 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1328 return set_text_properties (start, end, properties, object, Qt);
1332 DEFUN ("add-face-text-property", Fadd_face_text_property,
1333 Sadd_face_text_property, 3, 5, 0,
1334 doc: /* Add the face property to the text from START to END.
1335 The third argument FACE specifies the face to add.
1336 If any text in the region already has any face properties, this new
1337 face property will be added to the front of the face property list.
1338 If the optional fourth argument APPENDP is non-nil, append to the end
1339 of the face property list instead.
1340 If the optional fifth argument OBJECT is a buffer (or nil, which means
1341 the current buffer), START and END are buffer positions (integers or
1342 markers). If OBJECT is a string, START and END are 0-based indices
1343 into it. */)
1344 (Lisp_Object start, Lisp_Object end, Lisp_Object face,
1345 Lisp_Object appendp, Lisp_Object object)
1347 add_text_properties_1 (start, end,
1348 Fcons (Qface, Fcons (face, Qnil)),
1349 object,
1350 NILP (appendp)? TEXT_PROPERTY_PREPEND:
1351 TEXT_PROPERTY_APPEND);
1352 return Qnil;
1355 /* Replace properties of text from START to END with new list of
1356 properties PROPERTIES. OBJECT is the buffer or string containing
1357 the text. OBJECT nil means use the current buffer.
1358 COHERENT_CHANGE_P nil means this is being called as an internal
1359 subroutine, rather than as a change primitive with checking of
1360 read-only, invoking change hooks, etc.. Value is nil if the
1361 function _detected_ that it did not replace any properties, non-nil
1362 otherwise. */
1364 Lisp_Object
1365 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p)
1367 register INTERVAL i;
1368 Lisp_Object ostart, oend;
1370 ostart = start;
1371 oend = end;
1373 properties = validate_plist (properties);
1375 if (NILP (object))
1376 XSETBUFFER (object, current_buffer);
1378 /* If we want no properties for a whole string,
1379 get rid of its intervals. */
1380 if (NILP (properties) && STRINGP (object)
1381 && XFASTINT (start) == 0
1382 && XFASTINT (end) == SCHARS (object))
1384 if (!string_intervals (object))
1385 return Qnil;
1387 set_string_intervals (object, NULL);
1388 return Qt;
1391 i = validate_interval_range (object, &start, &end, soft);
1393 if (!i)
1395 /* If buffer has no properties, and we want none, return now. */
1396 if (NILP (properties))
1397 return Qnil;
1399 /* Restore the original START and END values
1400 because validate_interval_range increments them for strings. */
1401 start = ostart;
1402 end = oend;
1404 i = validate_interval_range (object, &start, &end, hard);
1405 /* This can return if start == end. */
1406 if (!i)
1407 return Qnil;
1410 if (BUFFERP (object) && !NILP (coherent_change_p))
1411 modify_region (object, start, end);
1413 set_text_properties_1 (start, end, properties, object, i);
1415 if (BUFFERP (object) && !NILP (coherent_change_p))
1416 signal_after_change (XINT (start), XINT (end) - XINT (start),
1417 XINT (end) - XINT (start));
1418 return Qt;
1421 /* Replace properties of text from START to END with new list of
1422 properties PROPERTIES. OBJECT is the buffer or string containing
1423 the text. This does not obey any hooks.
1424 You should provide the interval that START is located in as I.
1425 START and END can be in any order. */
1427 void
1428 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
1430 register INTERVAL prev_changed = NULL;
1431 register ptrdiff_t s, len;
1432 INTERVAL unchanged;
1434 if (XINT (start) < XINT (end))
1436 s = XINT (start);
1437 len = XINT (end) - s;
1439 else if (XINT (end) < XINT (start))
1441 s = XINT (end);
1442 len = XINT (start) - s;
1444 else
1445 return;
1447 eassert (i);
1449 if (i->position != s)
1451 unchanged = i;
1452 i = split_interval_right (unchanged, s - unchanged->position);
1454 if (LENGTH (i) > len)
1456 copy_properties (unchanged, i);
1457 i = split_interval_left (i, len);
1458 set_properties (properties, i, object);
1459 return;
1462 set_properties (properties, i, object);
1464 if (LENGTH (i) == len)
1465 return;
1467 prev_changed = i;
1468 len -= LENGTH (i);
1469 i = next_interval (i);
1472 /* We are starting at the beginning of an interval I. LEN is positive. */
1475 eassert (i != 0);
1477 if (LENGTH (i) >= len)
1479 if (LENGTH (i) > len)
1480 i = split_interval_left (i, len);
1482 /* We have to call set_properties even if we are going to
1483 merge the intervals, so as to make the undo records
1484 and cause redisplay to happen. */
1485 set_properties (properties, i, object);
1486 if (prev_changed)
1487 merge_interval_left (i);
1488 return;
1491 len -= LENGTH (i);
1493 /* We have to call set_properties even if we are going to
1494 merge the intervals, so as to make the undo records
1495 and cause redisplay to happen. */
1496 set_properties (properties, i, object);
1497 if (!prev_changed)
1498 prev_changed = i;
1499 else
1500 prev_changed = i = merge_interval_left (i);
1502 i = next_interval (i);
1504 while (len > 0);
1507 DEFUN ("remove-text-properties", Fremove_text_properties,
1508 Sremove_text_properties, 3, 4, 0,
1509 doc: /* Remove some properties from text from START to END.
1510 The third argument PROPERTIES is a property list
1511 whose property names specify the properties to remove.
1512 \(The values stored in PROPERTIES are ignored.)
1513 If the optional fourth argument OBJECT is a buffer (or nil, which means
1514 the current buffer), START and END are buffer positions (integers or
1515 markers). If OBJECT is a string, START and END are 0-based indices into it.
1516 Return t if any property was actually removed, nil otherwise.
1518 Use `set-text-properties' if you want to remove all text properties. */)
1519 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1521 INTERVAL i, unchanged;
1522 ptrdiff_t s, len;
1523 bool modified = 0;
1524 bool first_time = 1;
1526 if (NILP (object))
1527 XSETBUFFER (object, current_buffer);
1529 retry:
1530 i = validate_interval_range (object, &start, &end, soft);
1531 if (!i)
1532 return Qnil;
1534 s = XINT (start);
1535 len = XINT (end) - s;
1537 /* If there are no properties on this entire interval, return. */
1538 if (! interval_has_some_properties (properties, i))
1540 ptrdiff_t got = LENGTH (i) - (s - i->position);
1544 if (got >= len)
1545 return Qnil;
1546 len -= got;
1547 i = next_interval (i);
1548 got = LENGTH (i);
1550 while (! interval_has_some_properties (properties, i));
1552 /* Split away the beginning of this interval; what we don't
1553 want to modify. */
1554 else if (i->position != s)
1556 unchanged = i;
1557 i = split_interval_right (unchanged, s - unchanged->position);
1558 copy_properties (unchanged, i);
1561 if (BUFFERP (object) && first_time)
1563 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1564 ptrdiff_t prev_pos = i->position;
1566 modify_region (object, start, end);
1567 /* If someone called us recursively as a side effect of
1568 modify_region, and changed the intervals behind our back
1569 (could happen if lock_file, called by prepare_to_modify_buffer,
1570 triggers redisplay, and that calls add-text-properties again
1571 in the same buffer), we cannot continue with I, because its
1572 data changed. So we restart the interval analysis anew. */
1573 if (TOTAL_LENGTH (i) != prev_total_length
1574 || i->position != prev_pos)
1576 first_time = 0;
1577 goto retry;
1581 /* We are at the beginning of an interval, with len to scan */
1582 for (;;)
1584 eassert (i != 0);
1586 if (LENGTH (i) >= len)
1588 if (! interval_has_some_properties (properties, i))
1590 eassert (modified);
1591 if (BUFFERP (object))
1592 signal_after_change (XINT (start), XINT (end) - XINT (start),
1593 XINT (end) - XINT (start));
1594 return Qt;
1597 if (LENGTH (i) == len)
1599 remove_properties (properties, Qnil, i, object);
1600 if (BUFFERP (object))
1601 signal_after_change (XINT (start), XINT (end) - XINT (start),
1602 XINT (end) - XINT (start));
1603 return Qt;
1606 /* i has the properties, and goes past the change limit */
1607 unchanged = i;
1608 i = split_interval_left (i, len);
1609 copy_properties (unchanged, i);
1610 remove_properties (properties, Qnil, i, object);
1611 if (BUFFERP (object))
1612 signal_after_change (XINT (start), XINT (end) - XINT (start),
1613 XINT (end) - XINT (start));
1614 return Qt;
1617 len -= LENGTH (i);
1618 modified |= remove_properties (properties, Qnil, i, object);
1619 i = next_interval (i);
1623 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1624 Sremove_list_of_text_properties, 3, 4, 0,
1625 doc: /* Remove some properties from text from START to END.
1626 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1627 If the optional fourth argument OBJECT is a buffer (or nil, which means
1628 the current buffer), START and END are buffer positions (integers or
1629 markers). If OBJECT is a string, START and END are 0-based indices into it.
1630 Return t if any property was actually removed, nil otherwise. */)
1631 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1633 INTERVAL i, unchanged;
1634 ptrdiff_t s, len;
1635 bool modified = 0;
1636 Lisp_Object properties;
1637 properties = list_of_properties;
1639 if (NILP (object))
1640 XSETBUFFER (object, current_buffer);
1642 i = validate_interval_range (object, &start, &end, soft);
1643 if (!i)
1644 return Qnil;
1646 s = XINT (start);
1647 len = XINT (end) - s;
1649 /* If there are no properties on the interval, return. */
1650 if (! interval_has_some_properties_list (properties, i))
1652 ptrdiff_t got = LENGTH (i) - (s - i->position);
1656 if (got >= len)
1657 return Qnil;
1658 len -= got;
1659 i = next_interval (i);
1660 got = LENGTH (i);
1662 while (! interval_has_some_properties_list (properties, i));
1664 /* Split away the beginning of this interval; what we don't
1665 want to modify. */
1666 else if (i->position != s)
1668 unchanged = i;
1669 i = split_interval_right (unchanged, s - unchanged->position);
1670 copy_properties (unchanged, i);
1673 /* We are at the beginning of an interval, with len to scan.
1674 The flag `modified' records if changes have been made.
1675 When object is a buffer, we must call modify_region before changes are
1676 made and signal_after_change when we are done.
1677 We call modify_region before calling remove_properties if modified == 0,
1678 and we call signal_after_change before returning if modified != 0. */
1679 for (;;)
1681 eassert (i != 0);
1683 if (LENGTH (i) >= len)
1685 if (! interval_has_some_properties_list (properties, i))
1687 if (modified)
1689 if (BUFFERP (object))
1690 signal_after_change (XINT (start),
1691 XINT (end) - XINT (start),
1692 XINT (end) - XINT (start));
1693 return Qt;
1695 else
1696 return Qnil;
1698 else if (LENGTH (i) == len)
1700 if (!modified && BUFFERP (object))
1701 modify_region (object, start, end);
1702 remove_properties (Qnil, properties, i, object);
1703 if (BUFFERP (object))
1704 signal_after_change (XINT (start), XINT (end) - XINT (start),
1705 XINT (end) - XINT (start));
1706 return Qt;
1708 else
1709 { /* i has the properties, and goes past the change limit. */
1710 unchanged = i;
1711 i = split_interval_left (i, len);
1712 copy_properties (unchanged, i);
1713 if (!modified && BUFFERP (object))
1714 modify_region (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;
1722 if (interval_has_some_properties_list (properties, i))
1724 if (!modified && BUFFERP (object))
1725 modify_region (object, start, end);
1726 remove_properties (Qnil, properties, i, object);
1727 modified = 1;
1729 len -= LENGTH (i);
1730 i = next_interval (i);
1734 DEFUN ("text-property-any", Ftext_property_any,
1735 Stext_property_any, 4, 5, 0,
1736 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
1737 If so, return the position of the first character whose property PROPERTY
1738 is `eq' to VALUE. Otherwise return nil.
1739 If the optional fifth argument OBJECT is a buffer (or nil, which means
1740 the current buffer), START and END are buffer positions (integers or
1741 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1742 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1744 register INTERVAL i;
1745 register ptrdiff_t e, pos;
1747 if (NILP (object))
1748 XSETBUFFER (object, current_buffer);
1749 i = validate_interval_range (object, &start, &end, soft);
1750 if (!i)
1751 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1752 e = XINT (end);
1754 while (i)
1756 if (i->position >= e)
1757 break;
1758 if (EQ (textget (i->plist, property), value))
1760 pos = i->position;
1761 if (pos < XINT (start))
1762 pos = XINT (start);
1763 return make_number (pos);
1765 i = next_interval (i);
1767 return Qnil;
1770 DEFUN ("text-property-not-all", Ftext_property_not_all,
1771 Stext_property_not_all, 4, 5, 0,
1772 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
1773 If so, return the position of the first character whose property PROPERTY
1774 is not `eq' to VALUE. Otherwise, return nil.
1775 If the optional fifth argument OBJECT is a buffer (or nil, which means
1776 the current buffer), START and END are buffer positions (integers or
1777 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1778 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1780 register INTERVAL i;
1781 register ptrdiff_t s, e;
1783 if (NILP (object))
1784 XSETBUFFER (object, current_buffer);
1785 i = validate_interval_range (object, &start, &end, soft);
1786 if (!i)
1787 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1788 s = XINT (start);
1789 e = XINT (end);
1791 while (i)
1793 if (i->position >= e)
1794 break;
1795 if (! EQ (textget (i->plist, property), value))
1797 if (i->position > s)
1798 s = i->position;
1799 return make_number (s);
1801 i = next_interval (i);
1803 return Qnil;
1807 /* Return the direction from which the text-property PROP would be
1808 inherited by any new text inserted at POS: 1 if it would be
1809 inherited from the char after POS, -1 if it would be inherited from
1810 the char before POS, and 0 if from neither.
1811 BUFFER can be either a buffer or nil (meaning current buffer). */
1814 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1816 Lisp_Object prev_pos, front_sticky;
1817 bool is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
1818 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
1820 if (NILP (buffer))
1821 XSETBUFFER (buffer, current_buffer);
1823 if (CONSP (defalt) && !NILP (XCDR (defalt)))
1824 is_rear_sticky = 0;
1826 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
1827 /* Consider previous character. */
1829 Lisp_Object rear_non_sticky;
1831 prev_pos = make_number (XINT (pos) - 1);
1832 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1834 if (!NILP (CONSP (rear_non_sticky)
1835 ? Fmemq (prop, rear_non_sticky)
1836 : rear_non_sticky))
1837 /* PROP is rear-non-sticky. */
1838 is_rear_sticky = 0;
1840 else
1841 return 0;
1843 /* Consider following character. */
1844 /* This signals an arg-out-of-range error if pos is outside the
1845 buffer's accessible range. */
1846 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1848 if (EQ (front_sticky, Qt)
1849 || (CONSP (front_sticky)
1850 && !NILP (Fmemq (prop, front_sticky))))
1851 /* PROP is inherited from after. */
1852 is_front_sticky = 1;
1854 /* Simple cases, where the properties are consistent. */
1855 if (is_rear_sticky && !is_front_sticky)
1856 return -1;
1857 else if (!is_rear_sticky && is_front_sticky)
1858 return 1;
1859 else if (!is_rear_sticky && !is_front_sticky)
1860 return 0;
1862 /* The stickiness properties are inconsistent, so we have to
1863 disambiguate. Basically, rear-sticky wins, _except_ if the
1864 property that would be inherited has a value of nil, in which case
1865 front-sticky wins. */
1866 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1867 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1868 return 1;
1869 else
1870 return -1;
1874 /* Copying properties between objects. */
1876 /* Add properties from START to END of SRC, starting at POS in DEST.
1877 SRC and DEST may each refer to strings or buffers.
1878 Optional sixth argument PROP causes only that property to be copied.
1879 Properties are copied to DEST as if by `add-text-properties'.
1880 Return t if any property value actually changed, nil otherwise. */
1882 /* Note this can GC when DEST is a buffer. */
1884 Lisp_Object
1885 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1887 INTERVAL i;
1888 Lisp_Object res;
1889 Lisp_Object stuff;
1890 Lisp_Object plist;
1891 ptrdiff_t s, e, e2, p, len;
1892 bool modified = 0;
1893 struct gcpro gcpro1, gcpro2;
1895 i = validate_interval_range (src, &start, &end, soft);
1896 if (!i)
1897 return Qnil;
1899 CHECK_NUMBER_COERCE_MARKER (pos);
1901 Lisp_Object dest_start, dest_end;
1903 e = XINT (pos) + (XINT (end) - XINT (start));
1904 if (MOST_POSITIVE_FIXNUM < e)
1905 args_out_of_range (pos, end);
1906 dest_start = pos;
1907 XSETFASTINT (dest_end, e);
1908 /* Apply this to a copy of pos; it will try to increment its arguments,
1909 which we don't want. */
1910 validate_interval_range (dest, &dest_start, &dest_end, soft);
1913 s = XINT (start);
1914 e = XINT (end);
1915 p = XINT (pos);
1917 stuff = Qnil;
1919 while (s < e)
1921 e2 = i->position + LENGTH (i);
1922 if (e2 > e)
1923 e2 = e;
1924 len = e2 - s;
1926 plist = i->plist;
1927 if (! NILP (prop))
1928 while (! NILP (plist))
1930 if (EQ (Fcar (plist), prop))
1932 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1933 break;
1935 plist = Fcdr (Fcdr (plist));
1937 if (! NILP (plist))
1939 /* Must defer modifications to the interval tree in case src
1940 and dest refer to the same string or buffer. */
1941 stuff = Fcons (Fcons (make_number (p),
1942 Fcons (make_number (p + len),
1943 Fcons (plist, Qnil))),
1944 stuff);
1947 i = next_interval (i);
1948 if (!i)
1949 break;
1951 p += len;
1952 s = i->position;
1955 GCPRO2 (stuff, dest);
1957 while (! NILP (stuff))
1959 res = Fcar (stuff);
1960 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1961 Fcar (Fcdr (Fcdr (res))), dest);
1962 if (! NILP (res))
1963 modified = 1;
1964 stuff = Fcdr (stuff);
1967 UNGCPRO;
1969 return modified ? Qt : Qnil;
1973 /* Return a list representing the text properties of OBJECT between
1974 START and END. if PROP is non-nil, report only on that property.
1975 Each result list element has the form (S E PLIST), where S and E
1976 are positions in OBJECT and PLIST is a property list containing the
1977 text properties of OBJECT between S and E. Value is nil if OBJECT
1978 doesn't contain text properties between START and END. */
1980 Lisp_Object
1981 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
1983 struct interval *i;
1984 Lisp_Object result;
1986 result = Qnil;
1988 i = validate_interval_range (object, &start, &end, soft);
1989 if (i)
1991 ptrdiff_t s = XINT (start);
1992 ptrdiff_t e = XINT (end);
1994 while (s < e)
1996 ptrdiff_t interval_end, len;
1997 Lisp_Object plist;
1999 interval_end = i->position + LENGTH (i);
2000 if (interval_end > e)
2001 interval_end = e;
2002 len = interval_end - s;
2004 plist = i->plist;
2006 if (!NILP (prop))
2007 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
2008 if (EQ (XCAR (plist), prop))
2010 plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
2011 break;
2014 if (!NILP (plist))
2015 result = Fcons (Fcons (make_number (s),
2016 Fcons (make_number (s + len),
2017 Fcons (plist, Qnil))),
2018 result);
2020 i = next_interval (i);
2021 if (!i)
2022 break;
2023 s = i->position;
2027 return result;
2031 /* Add text properties to OBJECT from LIST. LIST is a list of triples
2032 (START END PLIST), where START and END are positions and PLIST is a
2033 property list containing the text properties to add. Adjust START
2034 and END positions by DELTA before adding properties. */
2036 void
2037 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
2039 struct gcpro gcpro1, gcpro2;
2041 GCPRO2 (list, object);
2043 for (; CONSP (list); list = XCDR (list))
2045 Lisp_Object item, start, end, plist;
2047 item = XCAR (list);
2048 start = make_number (XINT (XCAR (item)) + XINT (delta));
2049 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
2050 plist = XCAR (XCDR (XCDR (item)));
2052 Fadd_text_properties (start, end, plist, object);
2055 UNGCPRO;
2060 /* Modify end-points of ranges in LIST destructively, and return the
2061 new list. LIST is a list as returned from text_property_list.
2062 Discard properties that begin at or after NEW_END, and limit
2063 end-points to NEW_END. */
2065 Lisp_Object
2066 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
2068 Lisp_Object prev = Qnil, head = list;
2069 ptrdiff_t max = XINT (new_end);
2071 for (; CONSP (list); prev = list, list = XCDR (list))
2073 Lisp_Object item, beg, end;
2075 item = XCAR (list);
2076 beg = XCAR (item);
2077 end = XCAR (XCDR (item));
2079 if (XINT (beg) >= max)
2081 /* The start-point is past the end of the new string.
2082 Discard this property. */
2083 if (EQ (head, list))
2084 head = XCDR (list);
2085 else
2086 XSETCDR (prev, XCDR (list));
2088 else if (XINT (end) > max)
2089 /* The end-point is past the end of the new string. */
2090 XSETCAR (XCDR (item), new_end);
2093 return head;
2098 /* Call the modification hook functions in LIST, each with START and END. */
2100 static void
2101 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
2103 struct gcpro gcpro1;
2104 GCPRO1 (list);
2105 while (!NILP (list))
2107 call2 (Fcar (list), start, end);
2108 list = Fcdr (list);
2110 UNGCPRO;
2113 /* Check for read-only intervals between character positions START ... END,
2114 in BUF, and signal an error if we find one.
2116 Then check for any modification hooks in the range.
2117 Create a list of all these hooks in lexicographic order,
2118 eliminating consecutive extra copies of the same hook. Then call
2119 those hooks in order, with START and END - 1 as arguments. */
2121 void
2122 verify_interval_modification (struct buffer *buf,
2123 ptrdiff_t start, ptrdiff_t end)
2125 INTERVAL intervals = buffer_intervals (buf);
2126 INTERVAL i;
2127 Lisp_Object hooks;
2128 Lisp_Object prev_mod_hooks;
2129 Lisp_Object mod_hooks;
2130 struct gcpro gcpro1;
2132 hooks = Qnil;
2133 prev_mod_hooks = Qnil;
2134 mod_hooks = Qnil;
2136 interval_insert_behind_hooks = Qnil;
2137 interval_insert_in_front_hooks = Qnil;
2139 if (!intervals)
2140 return;
2142 if (start > end)
2144 ptrdiff_t temp = start;
2145 start = end;
2146 end = temp;
2149 /* For an insert operation, check the two chars around the position. */
2150 if (start == end)
2152 INTERVAL prev = NULL;
2153 Lisp_Object before, after;
2155 /* Set I to the interval containing the char after START,
2156 and PREV to the interval containing the char before START.
2157 Either one may be null. They may be equal. */
2158 i = find_interval (intervals, start);
2160 if (start == BUF_BEGV (buf))
2161 prev = 0;
2162 else if (i->position == start)
2163 prev = previous_interval (i);
2164 else if (i->position < start)
2165 prev = i;
2166 if (start == BUF_ZV (buf))
2167 i = 0;
2169 /* If Vinhibit_read_only is set and is not a list, we can
2170 skip the read_only checks. */
2171 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2173 /* If I and PREV differ we need to check for the read-only
2174 property together with its stickiness. If either I or
2175 PREV are 0, this check is all we need.
2176 We have to take special care, since read-only may be
2177 indirectly defined via the category property. */
2178 if (i != prev)
2180 if (i)
2182 after = textget (i->plist, Qread_only);
2184 /* If interval I is read-only and read-only is
2185 front-sticky, inhibit insertion.
2186 Check for read-only as well as category. */
2187 if (! NILP (after)
2188 && NILP (Fmemq (after, Vinhibit_read_only)))
2190 Lisp_Object tem;
2192 tem = textget (i->plist, Qfront_sticky);
2193 if (TMEM (Qread_only, tem)
2194 || (NILP (Fplist_get (i->plist, Qread_only))
2195 && TMEM (Qcategory, tem)))
2196 text_read_only (after);
2200 if (prev)
2202 before = textget (prev->plist, Qread_only);
2204 /* If interval PREV is read-only and read-only isn't
2205 rear-nonsticky, inhibit insertion.
2206 Check for read-only as well as category. */
2207 if (! NILP (before)
2208 && NILP (Fmemq (before, Vinhibit_read_only)))
2210 Lisp_Object tem;
2212 tem = textget (prev->plist, Qrear_nonsticky);
2213 if (! TMEM (Qread_only, tem)
2214 && (! NILP (Fplist_get (prev->plist,Qread_only))
2215 || ! TMEM (Qcategory, tem)))
2216 text_read_only (before);
2220 else if (i)
2222 after = textget (i->plist, Qread_only);
2224 /* If interval I is read-only and read-only is
2225 front-sticky, inhibit insertion.
2226 Check for read-only as well as category. */
2227 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2229 Lisp_Object tem;
2231 tem = textget (i->plist, Qfront_sticky);
2232 if (TMEM (Qread_only, tem)
2233 || (NILP (Fplist_get (i->plist, Qread_only))
2234 && TMEM (Qcategory, tem)))
2235 text_read_only (after);
2237 tem = textget (prev->plist, Qrear_nonsticky);
2238 if (! TMEM (Qread_only, tem)
2239 && (! NILP (Fplist_get (prev->plist, Qread_only))
2240 || ! TMEM (Qcategory, tem)))
2241 text_read_only (after);
2246 /* Run both insert hooks (just once if they're the same). */
2247 if (prev)
2248 interval_insert_behind_hooks
2249 = textget (prev->plist, Qinsert_behind_hooks);
2250 if (i)
2251 interval_insert_in_front_hooks
2252 = textget (i->plist, Qinsert_in_front_hooks);
2254 else
2256 /* Loop over intervals on or next to START...END,
2257 collecting their hooks. */
2259 i = find_interval (intervals, start);
2262 if (! INTERVAL_WRITABLE_P (i))
2263 text_read_only (textget (i->plist, Qread_only));
2265 if (!inhibit_modification_hooks)
2267 mod_hooks = textget (i->plist, Qmodification_hooks);
2268 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2270 hooks = Fcons (mod_hooks, hooks);
2271 prev_mod_hooks = mod_hooks;
2275 i = next_interval (i);
2277 /* Keep going thru the interval containing the char before END. */
2278 while (i && i->position < end);
2280 if (!inhibit_modification_hooks)
2282 GCPRO1 (hooks);
2283 hooks = Fnreverse (hooks);
2284 while (! EQ (hooks, Qnil))
2286 call_mod_hooks (Fcar (hooks), make_number (start),
2287 make_number (end));
2288 hooks = Fcdr (hooks);
2290 UNGCPRO;
2295 /* Run the interval hooks for an insertion on character range START ... END.
2296 verify_interval_modification chose which hooks to run;
2297 this function is called after the insertion happens
2298 so it can indicate the range of inserted text. */
2300 void
2301 report_interval_modification (Lisp_Object start, Lisp_Object end)
2303 if (! NILP (interval_insert_behind_hooks))
2304 call_mod_hooks (interval_insert_behind_hooks, start, end);
2305 if (! NILP (interval_insert_in_front_hooks)
2306 && ! EQ (interval_insert_in_front_hooks,
2307 interval_insert_behind_hooks))
2308 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2311 void
2312 syms_of_textprop (void)
2314 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2315 doc: /* Property-list used as default values.
2316 The value of a property in this list is seen as the value for every
2317 character that does not have its own value for that property. */);
2318 Vdefault_text_properties = Qnil;
2320 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2321 doc: /* Alist of alternative properties for properties without a value.
2322 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2323 If a piece of text has no direct value for a particular property, then
2324 this alist is consulted. If that property appears in the alist, then
2325 the first non-nil value from the associated alternative properties is
2326 returned. */);
2327 Vchar_property_alias_alist = Qnil;
2329 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2330 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2331 This also inhibits the use of the `intangible' text property. */);
2332 Vinhibit_point_motion_hooks = Qnil;
2334 DEFVAR_LISP ("text-property-default-nonsticky",
2335 Vtext_property_default_nonsticky,
2336 doc: /* Alist of properties vs the corresponding non-stickiness.
2337 Each element has the form (PROPERTY . NONSTICKINESS).
2339 If a character in a buffer has PROPERTY, new text inserted adjacent to
2340 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2341 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2342 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2343 /* Text properties `syntax-table'and `display' should be nonsticky
2344 by default. */
2345 Vtext_property_default_nonsticky
2346 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
2347 Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
2349 staticpro (&interval_insert_behind_hooks);
2350 staticpro (&interval_insert_in_front_hooks);
2351 interval_insert_behind_hooks = Qnil;
2352 interval_insert_in_front_hooks = Qnil;
2355 /* Common attributes one might give text */
2357 DEFSYM (Qforeground, "foreground");
2358 DEFSYM (Qbackground, "background");
2359 DEFSYM (Qfont, "font");
2360 DEFSYM (Qface, "face");
2361 DEFSYM (Qstipple, "stipple");
2362 DEFSYM (Qunderline, "underline");
2363 DEFSYM (Qread_only, "read-only");
2364 DEFSYM (Qinvisible, "invisible");
2365 DEFSYM (Qintangible, "intangible");
2366 DEFSYM (Qcategory, "category");
2367 DEFSYM (Qlocal_map, "local-map");
2368 DEFSYM (Qfront_sticky, "front-sticky");
2369 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2370 DEFSYM (Qmouse_face, "mouse-face");
2371 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
2373 /* Properties that text might use to specify certain actions */
2375 DEFSYM (Qmouse_left, "mouse-left");
2376 DEFSYM (Qmouse_entered, "mouse-entered");
2377 DEFSYM (Qpoint_left, "point-left");
2378 DEFSYM (Qpoint_entered, "point-entered");
2380 defsubr (&Stext_properties_at);
2381 defsubr (&Sget_text_property);
2382 defsubr (&Sget_char_property);
2383 defsubr (&Sget_char_property_and_overlay);
2384 defsubr (&Snext_char_property_change);
2385 defsubr (&Sprevious_char_property_change);
2386 defsubr (&Snext_single_char_property_change);
2387 defsubr (&Sprevious_single_char_property_change);
2388 defsubr (&Snext_property_change);
2389 defsubr (&Snext_single_property_change);
2390 defsubr (&Sprevious_property_change);
2391 defsubr (&Sprevious_single_property_change);
2392 defsubr (&Sadd_text_properties);
2393 defsubr (&Sput_text_property);
2394 defsubr (&Sset_text_properties);
2395 defsubr (&Sadd_face_text_property);
2396 defsubr (&Sremove_text_properties);
2397 defsubr (&Sremove_list_of_text_properties);
2398 defsubr (&Stext_property_any);
2399 defsubr (&Stext_property_not_all);