* lisp/textmodes/table.el (table-insert): Don't use `symbol-name' on
[emacs.git] / src / textprop.c
blob379eafb73f7962b2678b42106b617a5fb6210d3b
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 #include <config.h>
21 #include "lisp.h"
22 #include "intervals.h"
23 #include "character.h"
24 #include "buffer.h"
25 #include "window.h"
27 /* Test for membership, allowing for t (actually any non-cons) to mean the
28 universal set. */
30 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
33 /* NOTES: previous- and next- property change will have to skip
34 zero-length intervals if they are implemented. This could be done
35 inside next_interval and previous_interval.
37 set_properties needs to deal with the interval property cache.
39 It is assumed that for any interval plist, a property appears
40 only once on the list. Although some code i.e., remove_properties,
41 handles the more general case, the uniqueness of properties is
42 necessary for the system to remain consistent. This requirement
43 is enforced by the subrs installing properties onto the intervals. */
46 /* Types of hooks. */
47 static Lisp_Object Qmouse_left;
48 static Lisp_Object Qmouse_entered;
49 Lisp_Object Qpoint_left;
50 Lisp_Object Qpoint_entered;
51 Lisp_Object Qcategory;
52 Lisp_Object Qlocal_map;
54 /* Visual properties text (including strings) may have. */
55 static Lisp_Object Qforeground, Qbackground, Qunderline;
56 Lisp_Object Qfont;
57 static Lisp_Object Qstipple;
58 Lisp_Object Qinvisible, Qintangible, Qmouse_face;
59 static Lisp_Object Qread_only;
60 Lisp_Object Qminibuffer_prompt;
62 /* Sticky properties */
63 Lisp_Object Qfront_sticky, Qrear_nonsticky;
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
66 the o1's cdr. Otherwise, return zero. This is handy for
67 traversing plists. */
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70 /* verify_interval_modification saves insertion hooks here
71 to be run later by report_interval_modification. */
72 static Lisp_Object interval_insert_behind_hooks;
73 static Lisp_Object interval_insert_in_front_hooks;
76 /* Signal a `text-read-only' error. This function makes it easier
77 to capture that error in GDB by putting a breakpoint on it. */
79 static _Noreturn void
80 text_read_only (Lisp_Object propval)
82 if (STRINGP (propval))
83 xsignal1 (Qtext_read_only, propval);
85 xsignal0 (Qtext_read_only);
90 /* Extract the interval at the position pointed to by BEGIN from
91 OBJECT, a string or buffer. Additionally, check that the positions
92 pointed to by BEGIN and END are within the bounds of OBJECT, and
93 reverse them if *BEGIN is greater than *END. The objects pointed
94 to by BEGIN and END may be integers or markers; if the latter, they
95 are coerced to integers.
97 When OBJECT is a string, we increment *BEGIN and *END
98 to make them origin-one.
100 Note that buffer points don't correspond to interval indices.
101 For example, point-max is 1 greater than the index of the last
102 character. This difference is handled in the caller, which uses
103 the validated points to determine a length, and operates on that.
104 Exceptions are Ftext_properties_at, Fnext_property_change, and
105 Fprevious_property_change which call this function with BEGIN == END.
106 Handle this case specially.
108 If FORCE is soft (0), it's OK to return NULL. Otherwise,
109 create an interval tree for OBJECT if one doesn't exist, provided
110 the object actually contains text. In the current design, if there
111 is no text, there can be no text properties. */
113 #define soft 0
114 #define hard 1
116 INTERVAL
117 validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
119 register INTERVAL i;
120 ptrdiff_t searchpos;
122 CHECK_STRING_OR_BUFFER (object);
123 CHECK_NUMBER_COERCE_MARKER (*begin);
124 CHECK_NUMBER_COERCE_MARKER (*end);
126 /* If we are asked for a point, but from a subr which operates
127 on a range, then return nothing. */
128 if (EQ (*begin, *end) && begin != end)
129 return NULL;
131 if (XINT (*begin) > XINT (*end))
133 Lisp_Object n;
134 n = *begin;
135 *begin = *end;
136 *end = n;
139 if (BUFFERP (object))
141 register struct buffer *b = XBUFFER (object);
143 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
144 && XINT (*end) <= BUF_ZV (b)))
145 args_out_of_range (*begin, *end);
146 i = buffer_intervals (b);
148 /* If there's no text, there are no properties. */
149 if (BUF_BEGV (b) == BUF_ZV (b))
150 return NULL;
152 searchpos = XINT (*begin);
154 else
156 ptrdiff_t len = SCHARS (object);
158 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
159 && XINT (*end) <= len))
160 args_out_of_range (*begin, *end);
161 XSETFASTINT (*begin, XFASTINT (*begin));
162 if (begin != end)
163 XSETFASTINT (*end, XFASTINT (*end));
164 i = string_intervals (object);
166 if (len == 0)
167 return NULL;
169 searchpos = XINT (*begin);
172 if (!i)
173 return (force ? create_root_interval (object) : i);
175 return find_interval (i, searchpos);
178 /* Validate LIST as a property list. If LIST is not a list, then
179 make one consisting of (LIST nil). Otherwise, verify that LIST
180 is even numbered and thus suitable as a plist. */
182 static Lisp_Object
183 validate_plist (Lisp_Object list)
185 if (NILP (list))
186 return Qnil;
188 if (CONSP (list))
190 register int i;
191 register Lisp_Object tail;
192 for (i = 0, tail = list; CONSP (tail); i++)
194 tail = XCDR (tail);
195 QUIT;
197 if (i & 1)
198 error ("Odd length text property list");
199 return list;
202 return Fcons (list, Fcons (Qnil, Qnil));
205 /* Return nonzero if interval I has all the properties,
206 with the same values, of list PLIST. */
208 static int
209 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
211 register Lisp_Object tail1, tail2, sym1;
212 register int found;
214 /* Go through each element of PLIST. */
215 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
217 sym1 = XCAR (tail1);
218 found = 0;
220 /* Go through I's plist, looking for sym1 */
221 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
222 if (EQ (sym1, XCAR (tail2)))
224 /* Found the same property on both lists. If the
225 values are unequal, return zero. */
226 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
227 return 0;
229 /* Property has same value on both lists; go to next one. */
230 found = 1;
231 break;
234 if (! found)
235 return 0;
238 return 1;
241 /* Return nonzero if the plist of interval I has any of the
242 properties of PLIST, regardless of their values. */
244 static int
245 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
247 register Lisp_Object tail1, tail2, sym;
249 /* Go through each element of PLIST. */
250 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
252 sym = XCAR (tail1);
254 /* Go through i's plist, looking for tail1 */
255 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
256 if (EQ (sym, XCAR (tail2)))
257 return 1;
260 return 0;
263 /* Return nonzero if the plist of interval I has any of the
264 property names in LIST, regardless of their values. */
266 static int
267 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
269 register Lisp_Object tail1, tail2, sym;
271 /* Go through each element of LIST. */
272 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
274 sym = XCAR (tail1);
276 /* Go through i's plist, looking for tail1 */
277 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
278 if (EQ (sym, XCAR (tail2)))
279 return 1;
282 return 0;
285 /* Changing the plists of individual intervals. */
287 /* Return the value of PROP in property-list PLIST, or Qunbound if it
288 has none. */
289 static Lisp_Object
290 property_value (Lisp_Object plist, Lisp_Object prop)
292 Lisp_Object value;
294 while (PLIST_ELT_P (plist, value))
295 if (EQ (XCAR (plist), prop))
296 return XCAR (value);
297 else
298 plist = XCDR (value);
300 return Qunbound;
303 /* Set the properties of INTERVAL to PROPERTIES,
304 and record undo info for the previous values.
305 OBJECT is the string or buffer that INTERVAL belongs to. */
307 static void
308 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
310 Lisp_Object sym, value;
312 if (BUFFERP (object))
314 /* For each property in the old plist which is missing from PROPERTIES,
315 or has a different value in PROPERTIES, make an undo record. */
316 for (sym = interval->plist;
317 PLIST_ELT_P (sym, value);
318 sym = XCDR (value))
319 if (! EQ (property_value (properties, XCAR (sym)),
320 XCAR (value)))
322 record_property_change (interval->position, LENGTH (interval),
323 XCAR (sym), XCAR (value),
324 object);
327 /* For each new property that has no value at all in the old plist,
328 make an undo record binding it to nil, so it will be removed. */
329 for (sym = properties;
330 PLIST_ELT_P (sym, value);
331 sym = XCDR (value))
332 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
334 record_property_change (interval->position, LENGTH (interval),
335 XCAR (sym), Qnil,
336 object);
340 /* Store new properties. */
341 set_interval_plist (interval, Fcopy_sequence (properties));
344 /* Add the properties of PLIST to the interval I, or set
345 the value of I's property to the value of the property on PLIST
346 if they are different.
348 OBJECT should be the string or buffer the interval is in.
350 Return nonzero if this changes I (i.e., if any members of PLIST
351 are actually added to I's plist) */
353 static int
354 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
356 Lisp_Object tail1, tail2, sym1, val1;
357 register int changed = 0;
358 register int found;
359 struct gcpro gcpro1, gcpro2, gcpro3;
361 tail1 = plist;
362 sym1 = Qnil;
363 val1 = Qnil;
364 /* No need to protect OBJECT, because we can GC only in the case
365 where it is a buffer, and live buffers are always protected.
366 I and its plist are also protected, via OBJECT. */
367 GCPRO3 (tail1, sym1, val1);
369 /* Go through each element of PLIST. */
370 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
372 sym1 = XCAR (tail1);
373 val1 = Fcar (XCDR (tail1));
374 found = 0;
376 /* Go through I's plist, looking for sym1 */
377 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
378 if (EQ (sym1, XCAR (tail2)))
380 /* No need to gcpro, because tail2 protects this
381 and it must be a cons cell (we get an error otherwise). */
382 register Lisp_Object this_cdr;
384 this_cdr = XCDR (tail2);
385 /* Found the property. Now check its value. */
386 found = 1;
388 /* The properties have the same value on both lists.
389 Continue to the next property. */
390 if (EQ (val1, Fcar (this_cdr)))
391 break;
393 /* Record this change in the buffer, for undo purposes. */
394 if (BUFFERP (object))
396 record_property_change (i->position, LENGTH (i),
397 sym1, Fcar (this_cdr), object);
400 /* I's property has a different value -- change it */
401 Fsetcar (this_cdr, val1);
402 changed++;
403 break;
406 if (! found)
408 /* Record this change in the buffer, for undo purposes. */
409 if (BUFFERP (object))
411 record_property_change (i->position, LENGTH (i),
412 sym1, Qnil, object);
414 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
415 changed++;
419 UNGCPRO;
421 return changed;
424 /* For any members of PLIST, or LIST,
425 which are properties of I, remove them from I's plist.
426 (If PLIST is non-nil, use that, otherwise use LIST.)
427 OBJECT is the string or buffer containing I. */
429 static int
430 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
432 register Lisp_Object tail1, tail2, sym, current_plist;
433 register int changed = 0;
435 /* Nonzero means tail1 is a plist, otherwise it is a list. */
436 int use_plist;
438 current_plist = i->plist;
440 if (! NILP (plist))
441 tail1 = plist, use_plist = 1;
442 else
443 tail1 = list, use_plist = 0;
445 /* Go through each element of LIST or PLIST. */
446 while (CONSP (tail1))
448 sym = XCAR (tail1);
450 /* First, remove the symbol if it's at the head of the list */
451 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
453 if (BUFFERP (object))
454 record_property_change (i->position, LENGTH (i),
455 sym, XCAR (XCDR (current_plist)),
456 object);
458 current_plist = XCDR (XCDR (current_plist));
459 changed++;
462 /* Go through I's plist, looking for SYM. */
463 tail2 = current_plist;
464 while (! NILP (tail2))
466 register Lisp_Object this;
467 this = XCDR (XCDR (tail2));
468 if (CONSP (this) && EQ (sym, XCAR (this)))
470 if (BUFFERP (object))
471 record_property_change (i->position, LENGTH (i),
472 sym, XCAR (XCDR (this)), object);
474 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
475 changed++;
477 tail2 = this;
480 /* Advance thru TAIL1 one way or the other. */
481 tail1 = XCDR (tail1);
482 if (use_plist && CONSP (tail1))
483 tail1 = XCDR (tail1);
486 if (changed)
487 set_interval_plist (i, current_plist);
488 return changed;
491 /* Returns the interval of POSITION in OBJECT.
492 POSITION is BEG-based. */
494 INTERVAL
495 interval_of (ptrdiff_t position, Lisp_Object object)
497 register INTERVAL i;
498 ptrdiff_t beg, end;
500 if (NILP (object))
501 XSETBUFFER (object, current_buffer);
502 else if (EQ (object, Qt))
503 return NULL;
505 CHECK_STRING_OR_BUFFER (object);
507 if (BUFFERP (object))
509 register struct buffer *b = XBUFFER (object);
511 beg = BUF_BEGV (b);
512 end = BUF_ZV (b);
513 i = buffer_intervals (b);
515 else
517 beg = 0;
518 end = SCHARS (object);
519 i = string_intervals (object);
522 if (!(beg <= position && position <= end))
523 args_out_of_range (make_number (position), make_number (position));
524 if (beg == end || !i)
525 return NULL;
527 return find_interval (i, position);
530 DEFUN ("text-properties-at", Ftext_properties_at,
531 Stext_properties_at, 1, 2, 0,
532 doc: /* Return the list of properties of the character at POSITION in OBJECT.
533 If the optional second argument OBJECT is a buffer (or nil, which means
534 the current buffer), POSITION is a buffer position (integer or marker).
535 If OBJECT is a string, POSITION is a 0-based index into it.
536 If POSITION is at the end of OBJECT, the value is nil. */)
537 (Lisp_Object position, Lisp_Object object)
539 register INTERVAL i;
541 if (NILP (object))
542 XSETBUFFER (object, current_buffer);
544 i = validate_interval_range (object, &position, &position, soft);
545 if (!i)
546 return Qnil;
547 /* If POSITION is at the end of the interval,
548 it means it's the end of OBJECT.
549 There are no properties at the very end,
550 since no character follows. */
551 if (XINT (position) == LENGTH (i) + i->position)
552 return Qnil;
554 return i->plist;
557 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
558 doc: /* Return the value of POSITION's property PROP, in OBJECT.
559 OBJECT should be a buffer or a string; if omitted or nil, it defaults
560 to the current buffer.
561 If POSITION is at the end of OBJECT, the value is nil. */)
562 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
564 return textget (Ftext_properties_at (position, object), prop);
567 /* Return the value of char's property PROP, in OBJECT at POSITION.
568 OBJECT is optional and defaults to the current buffer.
569 If OVERLAY is non-0, then in the case that the returned property is from
570 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
571 returned in *OVERLAY.
572 If POSITION is at the end of OBJECT, the value is nil.
573 If OBJECT is a buffer, then overlay properties are considered as well as
574 text properties.
575 If OBJECT is a window, then that window's buffer is used, but
576 window-specific overlays are considered only if they are associated
577 with OBJECT. */
578 Lisp_Object
579 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
581 struct window *w = 0;
583 CHECK_NUMBER_COERCE_MARKER (position);
585 if (NILP (object))
586 XSETBUFFER (object, current_buffer);
588 if (WINDOWP (object))
590 w = XWINDOW (object);
591 object = w->buffer;
593 if (BUFFERP (object))
595 ptrdiff_t noverlays;
596 Lisp_Object *overlay_vec;
597 struct buffer *obuf = current_buffer;
599 if (XINT (position) < BUF_BEGV (XBUFFER (object))
600 || XINT (position) > BUF_ZV (XBUFFER (object)))
601 xsignal1 (Qargs_out_of_range, position);
603 set_buffer_temp (XBUFFER (object));
605 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
606 noverlays = sort_overlays (overlay_vec, noverlays, w);
608 set_buffer_temp (obuf);
610 /* Now check the overlays in order of decreasing priority. */
611 while (--noverlays >= 0)
613 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
614 if (!NILP (tem))
616 if (overlay)
617 /* Return the overlay we got the property from. */
618 *overlay = overlay_vec[noverlays];
619 return tem;
624 if (overlay)
625 /* Indicate that the return value is not from an overlay. */
626 *overlay = Qnil;
628 /* Not a buffer, or no appropriate overlay, so fall through to the
629 simpler case. */
630 return Fget_text_property (position, prop, object);
633 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
634 doc: /* Return the value of POSITION's property PROP, in OBJECT.
635 Both overlay properties and text properties are checked.
636 OBJECT is optional and defaults to the current buffer.
637 If POSITION is at the end of OBJECT, the value is nil.
638 If OBJECT is a buffer, then overlay properties are considered as well as
639 text properties.
640 If OBJECT is a window, then that window's buffer is used, but window-specific
641 overlays are considered only if they are associated with OBJECT. */)
642 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
644 return get_char_property_and_overlay (position, prop, object, 0);
647 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
648 Sget_char_property_and_overlay, 2, 3, 0,
649 doc: /* Like `get-char-property', but with extra overlay information.
650 The value is a cons cell. Its car is the return value of `get-char-property'
651 with the same arguments--that is, the value of POSITION's property
652 PROP in OBJECT. Its cdr is the overlay in which the property was
653 found, or nil, if it was found as a text property or not found at all.
655 OBJECT is optional and defaults to the current buffer. OBJECT may be
656 a string, a buffer or a window. For strings, the cdr of the return
657 value is always nil, since strings do not have overlays. If OBJECT is
658 a window, then that window's buffer is used, but window-specific
659 overlays are considered only if they are associated with OBJECT. If
660 POSITION is at the end of OBJECT, both car and cdr are nil. */)
661 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
663 Lisp_Object overlay;
664 Lisp_Object val
665 = get_char_property_and_overlay (position, prop, object, &overlay);
666 return Fcons (val, overlay);
670 DEFUN ("next-char-property-change", Fnext_char_property_change,
671 Snext_char_property_change, 1, 2, 0,
672 doc: /* Return the position of next text property or overlay change.
673 This scans characters forward in the current buffer from POSITION till
674 it finds a change in some text property, or the beginning or end of an
675 overlay, and returns the position of that.
676 If none is found up to (point-max), the function returns (point-max).
678 If the optional second argument LIMIT is non-nil, don't search
679 past position LIMIT; return LIMIT if nothing is found before LIMIT.
680 LIMIT is a no-op if it is greater than (point-max). */)
681 (Lisp_Object position, Lisp_Object limit)
683 Lisp_Object temp;
685 temp = Fnext_overlay_change (position);
686 if (! NILP (limit))
688 CHECK_NUMBER_COERCE_MARKER (limit);
689 if (XINT (limit) < XINT (temp))
690 temp = limit;
692 return Fnext_property_change (position, Qnil, temp);
695 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
696 Sprevious_char_property_change, 1, 2, 0,
697 doc: /* Return the position of previous text property or overlay change.
698 Scans characters backward in the current buffer from POSITION till it
699 finds a change in some text property, or the beginning or end of an
700 overlay, and returns the position of that.
701 If none is found since (point-min), the function returns (point-min).
703 If the optional second argument LIMIT is non-nil, don't search
704 past position LIMIT; return LIMIT if nothing is found before LIMIT.
705 LIMIT is a no-op if it is less than (point-min). */)
706 (Lisp_Object position, Lisp_Object limit)
708 Lisp_Object temp;
710 temp = Fprevious_overlay_change (position);
711 if (! NILP (limit))
713 CHECK_NUMBER_COERCE_MARKER (limit);
714 if (XINT (limit) > XINT (temp))
715 temp = limit;
717 return Fprevious_property_change (position, Qnil, temp);
721 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
722 Snext_single_char_property_change, 2, 4, 0,
723 doc: /* Return the position of next text property or overlay change for a specific property.
724 Scans characters forward from POSITION till it finds
725 a change in the PROP property, then returns the position of the change.
726 If the optional third argument OBJECT is a buffer (or nil, which means
727 the current buffer), POSITION is a buffer position (integer or marker).
728 If OBJECT is a string, POSITION is a 0-based index into it.
730 In a string, scan runs to the end of the string.
731 In a buffer, it runs to (point-max), and the value cannot exceed that.
733 The property values are compared with `eq'.
734 If the property is constant all the way to the end of OBJECT, return the
735 last valid position in OBJECT.
736 If the optional fourth argument LIMIT is non-nil, don't search
737 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
738 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
740 if (STRINGP (object))
742 position = Fnext_single_property_change (position, prop, object, limit);
743 if (NILP (position))
745 if (NILP (limit))
746 position = make_number (SCHARS (object));
747 else
749 CHECK_NUMBER (limit);
750 position = limit;
754 else
756 Lisp_Object initial_value, value;
757 ptrdiff_t count = SPECPDL_INDEX ();
759 if (! NILP (object))
760 CHECK_BUFFER (object);
762 if (BUFFERP (object) && current_buffer != XBUFFER (object))
764 record_unwind_current_buffer ();
765 Fset_buffer (object);
768 CHECK_NUMBER_COERCE_MARKER (position);
770 initial_value = Fget_char_property (position, prop, object);
772 if (NILP (limit))
773 XSETFASTINT (limit, ZV);
774 else
775 CHECK_NUMBER_COERCE_MARKER (limit);
777 if (XFASTINT (position) >= XFASTINT (limit))
779 position = limit;
780 if (XFASTINT (position) > ZV)
781 XSETFASTINT (position, ZV);
783 else
784 while (1)
786 position = Fnext_char_property_change (position, limit);
787 if (XFASTINT (position) >= XFASTINT (limit))
789 position = limit;
790 break;
793 value = Fget_char_property (position, prop, object);
794 if (!EQ (value, initial_value))
795 break;
798 unbind_to (count, Qnil);
801 return position;
804 DEFUN ("previous-single-char-property-change",
805 Fprevious_single_char_property_change,
806 Sprevious_single_char_property_change, 2, 4, 0,
807 doc: /* Return the position of previous text property or overlay change for a specific property.
808 Scans characters backward from POSITION till it finds
809 a change in the PROP property, then returns the position of the change.
810 If the optional third argument OBJECT is a buffer (or nil, which means
811 the current buffer), POSITION is a buffer position (integer or marker).
812 If OBJECT is a string, POSITION is a 0-based index into it.
814 In a string, scan runs to the start of the string.
815 In a buffer, it runs to (point-min), and the value cannot be less than that.
817 The property values are compared with `eq'.
818 If the property is constant all the way to the start of OBJECT, return the
819 first valid position in OBJECT.
820 If the optional fourth argument LIMIT is non-nil, don't search back past
821 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
822 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
824 if (STRINGP (object))
826 position = Fprevious_single_property_change (position, prop, object, limit);
827 if (NILP (position))
829 if (NILP (limit))
830 position = make_number (0);
831 else
833 CHECK_NUMBER (limit);
834 position = limit;
838 else
840 ptrdiff_t count = SPECPDL_INDEX ();
842 if (! NILP (object))
843 CHECK_BUFFER (object);
845 if (BUFFERP (object) && current_buffer != XBUFFER (object))
847 record_unwind_current_buffer ();
848 Fset_buffer (object);
851 CHECK_NUMBER_COERCE_MARKER (position);
853 if (NILP (limit))
854 XSETFASTINT (limit, BEGV);
855 else
856 CHECK_NUMBER_COERCE_MARKER (limit);
858 if (XFASTINT (position) <= XFASTINT (limit))
860 position = limit;
861 if (XFASTINT (position) < BEGV)
862 XSETFASTINT (position, BEGV);
864 else
866 Lisp_Object initial_value
867 = Fget_char_property (make_number (XFASTINT (position) - 1),
868 prop, object);
870 while (1)
872 position = Fprevious_char_property_change (position, limit);
874 if (XFASTINT (position) <= XFASTINT (limit))
876 position = limit;
877 break;
879 else
881 Lisp_Object value
882 = Fget_char_property (make_number (XFASTINT (position) - 1),
883 prop, object);
885 if (!EQ (value, initial_value))
886 break;
891 unbind_to (count, Qnil);
894 return position;
897 DEFUN ("next-property-change", Fnext_property_change,
898 Snext_property_change, 1, 3, 0,
899 doc: /* Return the position of next property change.
900 Scans characters forward from POSITION in OBJECT till it finds
901 a change in some text property, then returns the position of the change.
902 If the optional second argument OBJECT is a buffer (or nil, which means
903 the current buffer), POSITION is a buffer position (integer or marker).
904 If OBJECT is a string, POSITION is a 0-based index into it.
905 Return nil if the property is constant all the way to the end of OBJECT.
906 If the value is non-nil, it is a position greater than POSITION, never equal.
908 If the optional third argument LIMIT is non-nil, don't search
909 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
910 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
912 register INTERVAL i, next;
914 if (NILP (object))
915 XSETBUFFER (object, current_buffer);
917 if (!NILP (limit) && !EQ (limit, Qt))
918 CHECK_NUMBER_COERCE_MARKER (limit);
920 i = validate_interval_range (object, &position, &position, soft);
922 /* If LIMIT is t, return start of next interval--don't
923 bother checking further intervals. */
924 if (EQ (limit, Qt))
926 if (!i)
927 next = i;
928 else
929 next = next_interval (i);
931 if (!next)
932 XSETFASTINT (position, (STRINGP (object)
933 ? SCHARS (object)
934 : BUF_ZV (XBUFFER (object))));
935 else
936 XSETFASTINT (position, next->position);
937 return position;
940 if (!i)
941 return limit;
943 next = next_interval (i);
945 while (next && intervals_equal (i, next)
946 && (NILP (limit) || next->position < XFASTINT (limit)))
947 next = next_interval (next);
949 if (!next
950 || (next->position
951 >= (INTEGERP (limit)
952 ? XFASTINT (limit)
953 : (STRINGP (object)
954 ? SCHARS (object)
955 : BUF_ZV (XBUFFER (object))))))
956 return limit;
957 else
958 return make_number (next->position);
961 DEFUN ("next-single-property-change", Fnext_single_property_change,
962 Snext_single_property_change, 2, 4, 0,
963 doc: /* Return the position of next property change for a specific property.
964 Scans characters forward from POSITION till it finds
965 a change in the PROP property, then returns the position of the change.
966 If the optional third argument OBJECT is a buffer (or nil, which means
967 the current buffer), POSITION is a buffer position (integer or marker).
968 If OBJECT is a string, POSITION is a 0-based index into it.
969 The property values are compared with `eq'.
970 Return nil if the property is constant all the way to the end of OBJECT.
971 If the value is non-nil, it is a position greater than POSITION, never equal.
973 If the optional fourth argument LIMIT is non-nil, don't search
974 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
975 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
977 register INTERVAL i, next;
978 register Lisp_Object here_val;
980 if (NILP (object))
981 XSETBUFFER (object, current_buffer);
983 if (!NILP (limit))
984 CHECK_NUMBER_COERCE_MARKER (limit);
986 i = validate_interval_range (object, &position, &position, soft);
987 if (!i)
988 return limit;
990 here_val = textget (i->plist, prop);
991 next = next_interval (i);
992 while (next
993 && EQ (here_val, textget (next->plist, prop))
994 && (NILP (limit) || next->position < XFASTINT (limit)))
995 next = next_interval (next);
997 if (!next
998 || (next->position
999 >= (INTEGERP (limit)
1000 ? XFASTINT (limit)
1001 : (STRINGP (object)
1002 ? SCHARS (object)
1003 : BUF_ZV (XBUFFER (object))))))
1004 return limit;
1005 else
1006 return make_number (next->position);
1009 DEFUN ("previous-property-change", Fprevious_property_change,
1010 Sprevious_property_change, 1, 3, 0,
1011 doc: /* Return the position of previous property change.
1012 Scans characters backwards from POSITION in OBJECT till it finds
1013 a change in some text property, then returns the position of the change.
1014 If the optional second argument OBJECT is a buffer (or nil, which means
1015 the current buffer), POSITION is a buffer position (integer or marker).
1016 If OBJECT is a string, POSITION is a 0-based index into it.
1017 Return nil if the property is constant all the way to the start of OBJECT.
1018 If the value is non-nil, it is a position less than POSITION, never equal.
1020 If the optional third argument LIMIT is non-nil, don't search
1021 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1022 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1024 register INTERVAL i, previous;
1026 if (NILP (object))
1027 XSETBUFFER (object, current_buffer);
1029 if (!NILP (limit))
1030 CHECK_NUMBER_COERCE_MARKER (limit);
1032 i = validate_interval_range (object, &position, &position, soft);
1033 if (!i)
1034 return limit;
1036 /* Start with the interval containing the char before point. */
1037 if (i->position == XFASTINT (position))
1038 i = previous_interval (i);
1040 previous = previous_interval (i);
1041 while (previous && intervals_equal (previous, i)
1042 && (NILP (limit)
1043 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1044 previous = previous_interval (previous);
1046 if (!previous
1047 || (previous->position + LENGTH (previous)
1048 <= (INTEGERP (limit)
1049 ? XFASTINT (limit)
1050 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1051 return limit;
1052 else
1053 return make_number (previous->position + LENGTH (previous));
1056 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1057 Sprevious_single_property_change, 2, 4, 0,
1058 doc: /* Return the position of previous property change for a specific property.
1059 Scans characters backward from POSITION till it finds
1060 a change in the PROP property, then returns the position of the change.
1061 If the optional third argument OBJECT is a buffer (or nil, which means
1062 the current buffer), POSITION is a buffer position (integer or marker).
1063 If OBJECT is a string, POSITION is a 0-based index into it.
1064 The property values are compared with `eq'.
1065 Return nil if the property is constant all the way to the start of OBJECT.
1066 If the value is non-nil, it is a position less than POSITION, never equal.
1068 If the optional fourth argument LIMIT is non-nil, don't search
1069 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1070 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1072 register INTERVAL i, previous;
1073 register Lisp_Object here_val;
1075 if (NILP (object))
1076 XSETBUFFER (object, current_buffer);
1078 if (!NILP (limit))
1079 CHECK_NUMBER_COERCE_MARKER (limit);
1081 i = validate_interval_range (object, &position, &position, soft);
1083 /* Start with the interval containing the char before point. */
1084 if (i && i->position == XFASTINT (position))
1085 i = previous_interval (i);
1087 if (!i)
1088 return limit;
1090 here_val = textget (i->plist, prop);
1091 previous = previous_interval (i);
1092 while (previous
1093 && EQ (here_val, textget (previous->plist, prop))
1094 && (NILP (limit)
1095 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1096 previous = previous_interval (previous);
1098 if (!previous
1099 || (previous->position + LENGTH (previous)
1100 <= (INTEGERP (limit)
1101 ? XFASTINT (limit)
1102 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1103 return limit;
1104 else
1105 return make_number (previous->position + LENGTH (previous));
1108 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1110 DEFUN ("add-text-properties", Fadd_text_properties,
1111 Sadd_text_properties, 3, 4, 0,
1112 doc: /* Add properties to the text from START to END.
1113 The third argument PROPERTIES is a property list
1114 specifying the property values to add. If the optional fourth argument
1115 OBJECT is a buffer (or nil, which means the current buffer),
1116 START and END are buffer positions (integers or markers).
1117 If OBJECT is a string, START and END are 0-based indices into it.
1118 Return t if any property value actually changed, nil otherwise. */)
1119 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1121 register INTERVAL i, unchanged;
1122 register ptrdiff_t s, len;
1123 register int modified = 0;
1124 struct gcpro gcpro1;
1126 properties = validate_plist (properties);
1127 if (NILP (properties))
1128 return Qnil;
1130 if (NILP (object))
1131 XSETBUFFER (object, current_buffer);
1133 i = validate_interval_range (object, &start, &end, hard);
1134 if (!i)
1135 return Qnil;
1137 s = XINT (start);
1138 len = XINT (end) - s;
1140 /* No need to protect OBJECT, because we GC only if it's a buffer,
1141 and live buffers are always protected. */
1142 GCPRO1 (properties);
1144 /* If we're not starting on an interval boundary, we have to
1145 split this interval. */
1146 if (i->position != s)
1148 /* If this interval already has the properties, we can
1149 skip it. */
1150 if (interval_has_all_properties (properties, i))
1152 ptrdiff_t got = (LENGTH (i) - (s - i->position));
1153 if (got >= len)
1154 RETURN_UNGCPRO (Qnil);
1155 len -= got;
1156 i = next_interval (i);
1158 else
1160 unchanged = i;
1161 i = split_interval_right (unchanged, s - unchanged->position);
1162 copy_properties (unchanged, i);
1166 if (BUFFERP (object))
1167 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1169 /* We are at the beginning of interval I, with LEN chars to scan. */
1170 for (;;)
1172 eassert (i != 0);
1174 if (LENGTH (i) >= len)
1176 /* We can UNGCPRO safely here, because there will be just
1177 one more chance to gc, in the next call to add_properties,
1178 and after that we will not need PROPERTIES or OBJECT again. */
1179 UNGCPRO;
1181 if (interval_has_all_properties (properties, i))
1183 if (BUFFERP (object))
1184 signal_after_change (XINT (start), XINT (end) - XINT (start),
1185 XINT (end) - XINT (start));
1187 return modified ? Qt : Qnil;
1190 if (LENGTH (i) == len)
1192 add_properties (properties, i, object);
1193 if (BUFFERP (object))
1194 signal_after_change (XINT (start), XINT (end) - XINT (start),
1195 XINT (end) - XINT (start));
1196 return Qt;
1199 /* i doesn't have the properties, and goes past the change limit */
1200 unchanged = i;
1201 i = split_interval_left (unchanged, len);
1202 copy_properties (unchanged, i);
1203 add_properties (properties, i, object);
1204 if (BUFFERP (object))
1205 signal_after_change (XINT (start), XINT (end) - XINT (start),
1206 XINT (end) - XINT (start));
1207 return Qt;
1210 len -= LENGTH (i);
1211 modified += add_properties (properties, i, object);
1212 i = next_interval (i);
1216 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1218 DEFUN ("put-text-property", Fput_text_property,
1219 Sput_text_property, 4, 5, 0,
1220 doc: /* Set one property of the text from START to END.
1221 The third and fourth arguments PROPERTY and VALUE
1222 specify the property to add.
1223 If the optional fifth argument OBJECT is a buffer (or nil, which means
1224 the current buffer), START and END are buffer positions (integers or
1225 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1226 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1228 Fadd_text_properties (start, end,
1229 Fcons (property, Fcons (value, Qnil)),
1230 object);
1231 return Qnil;
1234 DEFUN ("set-text-properties", Fset_text_properties,
1235 Sset_text_properties, 3, 4, 0,
1236 doc: /* Completely replace properties of text from START to END.
1237 The third argument PROPERTIES is the new property list.
1238 If the optional fourth argument OBJECT is a buffer (or nil, which means
1239 the current buffer), START and END are buffer positions (integers or
1240 markers). If OBJECT is a string, START and END are 0-based indices into it.
1241 If PROPERTIES is nil, the effect is to remove all properties from
1242 the designated part of OBJECT. */)
1243 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1245 return set_text_properties (start, end, properties, object, Qt);
1249 /* Replace properties of text from START to END with new list of
1250 properties PROPERTIES. OBJECT is the buffer or string containing
1251 the text. OBJECT nil means use the current buffer.
1252 COHERENT_CHANGE_P nil means this is being called as an internal
1253 subroutine, rather than as a change primitive with checking of
1254 read-only, invoking change hooks, etc.. Value is nil if the
1255 function _detected_ that it did not replace any properties, non-nil
1256 otherwise. */
1258 Lisp_Object
1259 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p)
1261 register INTERVAL i;
1262 Lisp_Object ostart, oend;
1264 ostart = start;
1265 oend = end;
1267 properties = validate_plist (properties);
1269 if (NILP (object))
1270 XSETBUFFER (object, current_buffer);
1272 /* If we want no properties for a whole string,
1273 get rid of its intervals. */
1274 if (NILP (properties) && STRINGP (object)
1275 && XFASTINT (start) == 0
1276 && XFASTINT (end) == SCHARS (object))
1278 if (!string_intervals (object))
1279 return Qnil;
1281 set_string_intervals (object, NULL);
1282 return Qt;
1285 i = validate_interval_range (object, &start, &end, soft);
1287 if (!i)
1289 /* If buffer has no properties, and we want none, return now. */
1290 if (NILP (properties))
1291 return Qnil;
1293 /* Restore the original START and END values
1294 because validate_interval_range increments them for strings. */
1295 start = ostart;
1296 end = oend;
1298 i = validate_interval_range (object, &start, &end, hard);
1299 /* This can return if start == end. */
1300 if (!i)
1301 return Qnil;
1304 if (BUFFERP (object) && !NILP (coherent_change_p))
1305 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1307 set_text_properties_1 (start, end, properties, object, i);
1309 if (BUFFERP (object) && !NILP (coherent_change_p))
1310 signal_after_change (XINT (start), XINT (end) - XINT (start),
1311 XINT (end) - XINT (start));
1312 return Qt;
1315 /* Replace properties of text from START to END with new list of
1316 properties PROPERTIES. BUFFER is the buffer containing
1317 the text. This does not obey any hooks.
1318 You can provide the interval that START is located in as I,
1319 or pass NULL for I and this function will find it.
1320 START and END can be in any order. */
1322 void
1323 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i)
1325 register INTERVAL prev_changed = NULL;
1326 register ptrdiff_t s, len;
1327 INTERVAL unchanged;
1329 if (XINT (start) < XINT (end))
1331 s = XINT (start);
1332 len = XINT (end) - s;
1334 else if (XINT (end) < XINT (start))
1336 s = XINT (end);
1337 len = XINT (start) - s;
1339 else
1340 return;
1342 if (i == NULL)
1343 i = find_interval (buffer_intervals (XBUFFER (buffer)), s);
1345 if (i->position != s)
1347 unchanged = i;
1348 i = split_interval_right (unchanged, s - unchanged->position);
1350 if (LENGTH (i) > len)
1352 copy_properties (unchanged, i);
1353 i = split_interval_left (i, len);
1354 set_properties (properties, i, buffer);
1355 return;
1358 set_properties (properties, i, buffer);
1360 if (LENGTH (i) == len)
1361 return;
1363 prev_changed = i;
1364 len -= LENGTH (i);
1365 i = next_interval (i);
1368 /* We are starting at the beginning of an interval I. LEN is positive. */
1371 eassert (i != 0);
1373 if (LENGTH (i) >= len)
1375 if (LENGTH (i) > len)
1376 i = split_interval_left (i, len);
1378 /* We have to call set_properties even if we are going to
1379 merge the intervals, so as to make the undo records
1380 and cause redisplay to happen. */
1381 set_properties (properties, i, buffer);
1382 if (prev_changed)
1383 merge_interval_left (i);
1384 return;
1387 len -= LENGTH (i);
1389 /* We have to call set_properties even if we are going to
1390 merge the intervals, so as to make the undo records
1391 and cause redisplay to happen. */
1392 set_properties (properties, i, buffer);
1393 if (!prev_changed)
1394 prev_changed = i;
1395 else
1396 prev_changed = i = merge_interval_left (i);
1398 i = next_interval (i);
1400 while (len > 0);
1403 DEFUN ("remove-text-properties", Fremove_text_properties,
1404 Sremove_text_properties, 3, 4, 0,
1405 doc: /* Remove some properties from text from START to END.
1406 The third argument PROPERTIES is a property list
1407 whose property names specify the properties to remove.
1408 \(The values stored in PROPERTIES are ignored.)
1409 If the optional fourth argument OBJECT is a buffer (or nil, which means
1410 the current buffer), START and END are buffer positions (integers or
1411 markers). If OBJECT is a string, START and END are 0-based indices into it.
1412 Return t if any property was actually removed, nil otherwise.
1414 Use `set-text-properties' if you want to remove all text properties. */)
1415 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1417 register INTERVAL i, unchanged;
1418 register ptrdiff_t s, len;
1419 register int modified = 0;
1421 if (NILP (object))
1422 XSETBUFFER (object, current_buffer);
1424 i = validate_interval_range (object, &start, &end, soft);
1425 if (!i)
1426 return Qnil;
1428 s = XINT (start);
1429 len = XINT (end) - s;
1431 if (i->position != s)
1433 /* No properties on this first interval -- return if
1434 it covers the entire region. */
1435 if (! interval_has_some_properties (properties, i))
1437 ptrdiff_t got = (LENGTH (i) - (s - i->position));
1438 if (got >= len)
1439 return Qnil;
1440 len -= got;
1441 i = next_interval (i);
1443 /* Split away the beginning of this interval; what we don't
1444 want to modify. */
1445 else
1447 unchanged = i;
1448 i = split_interval_right (unchanged, s - unchanged->position);
1449 copy_properties (unchanged, i);
1453 if (BUFFERP (object))
1454 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1456 /* We are at the beginning of an interval, with len to scan */
1457 for (;;)
1459 eassert (i != 0);
1461 if (LENGTH (i) >= len)
1463 if (! interval_has_some_properties (properties, i))
1464 return modified ? Qt : Qnil;
1466 if (LENGTH (i) == len)
1468 remove_properties (properties, Qnil, i, object);
1469 if (BUFFERP (object))
1470 signal_after_change (XINT (start), XINT (end) - XINT (start),
1471 XINT (end) - XINT (start));
1472 return Qt;
1475 /* i has the properties, and goes past the change limit */
1476 unchanged = i;
1477 i = split_interval_left (i, len);
1478 copy_properties (unchanged, i);
1479 remove_properties (properties, Qnil, i, object);
1480 if (BUFFERP (object))
1481 signal_after_change (XINT (start), XINT (end) - XINT (start),
1482 XINT (end) - XINT (start));
1483 return Qt;
1486 len -= LENGTH (i);
1487 modified += remove_properties (properties, Qnil, i, object);
1488 i = next_interval (i);
1492 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1493 Sremove_list_of_text_properties, 3, 4, 0,
1494 doc: /* Remove some properties from text from START to END.
1495 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1496 If the optional fourth argument OBJECT is a buffer (or nil, which means
1497 the current buffer), START and END are buffer positions (integers or
1498 markers). If OBJECT is a string, START and END are 0-based indices into it.
1499 Return t if any property was actually removed, nil otherwise. */)
1500 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1502 register INTERVAL i, unchanged;
1503 register ptrdiff_t s, len;
1504 register int modified = 0;
1505 Lisp_Object properties;
1506 properties = list_of_properties;
1508 if (NILP (object))
1509 XSETBUFFER (object, current_buffer);
1511 i = validate_interval_range (object, &start, &end, soft);
1512 if (!i)
1513 return Qnil;
1515 s = XINT (start);
1516 len = XINT (end) - s;
1518 if (i->position != s)
1520 /* No properties on this first interval -- return if
1521 it covers the entire region. */
1522 if (! interval_has_some_properties_list (properties, i))
1524 ptrdiff_t got = (LENGTH (i) - (s - i->position));
1525 if (got >= len)
1526 return Qnil;
1527 len -= got;
1528 i = next_interval (i);
1530 /* Split away the beginning of this interval; what we don't
1531 want to modify. */
1532 else
1534 unchanged = i;
1535 i = split_interval_right (unchanged, s - unchanged->position);
1536 copy_properties (unchanged, i);
1540 /* We are at the beginning of an interval, with len to scan.
1541 The flag `modified' records if changes have been made.
1542 When object is a buffer, we must call modify_region before changes are
1543 made and signal_after_change when we are done.
1544 We call modify_region before calling remove_properties if modified == 0,
1545 and we call signal_after_change before returning if modified != 0. */
1546 for (;;)
1548 eassert (i != 0);
1550 if (LENGTH (i) >= len)
1552 if (! interval_has_some_properties_list (properties, i))
1554 if (modified)
1556 if (BUFFERP (object))
1557 signal_after_change (XINT (start),
1558 XINT (end) - XINT (start),
1559 XINT (end) - XINT (start));
1560 return Qt;
1562 else
1563 return Qnil;
1565 else if (LENGTH (i) == len)
1567 if (!modified && BUFFERP (object))
1568 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1569 remove_properties (Qnil, properties, i, object);
1570 if (BUFFERP (object))
1571 signal_after_change (XINT (start), XINT (end) - XINT (start),
1572 XINT (end) - XINT (start));
1573 return Qt;
1575 else
1576 { /* i has the properties, and goes past the change limit. */
1577 unchanged = i;
1578 i = split_interval_left (i, len);
1579 copy_properties (unchanged, i);
1580 if (!modified && BUFFERP (object))
1581 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1582 remove_properties (Qnil, properties, i, object);
1583 if (BUFFERP (object))
1584 signal_after_change (XINT (start), XINT (end) - XINT (start),
1585 XINT (end) - XINT (start));
1586 return Qt;
1589 if (interval_has_some_properties_list (properties, i))
1591 if (!modified && BUFFERP (object))
1592 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1593 remove_properties (Qnil, properties, i, object);
1594 modified = 1;
1596 len -= LENGTH (i);
1597 i = next_interval (i);
1601 DEFUN ("text-property-any", Ftext_property_any,
1602 Stext_property_any, 4, 5, 0,
1603 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
1604 If so, return the position of the first character whose property PROPERTY
1605 is `eq' to VALUE. Otherwise return nil.
1606 If the optional fifth argument OBJECT is a buffer (or nil, which means
1607 the current buffer), START and END are buffer positions (integers or
1608 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1609 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1611 register INTERVAL i;
1612 register ptrdiff_t e, pos;
1614 if (NILP (object))
1615 XSETBUFFER (object, current_buffer);
1616 i = validate_interval_range (object, &start, &end, soft);
1617 if (!i)
1618 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1619 e = XINT (end);
1621 while (i)
1623 if (i->position >= e)
1624 break;
1625 if (EQ (textget (i->plist, property), value))
1627 pos = i->position;
1628 if (pos < XINT (start))
1629 pos = XINT (start);
1630 return make_number (pos);
1632 i = next_interval (i);
1634 return Qnil;
1637 DEFUN ("text-property-not-all", Ftext_property_not_all,
1638 Stext_property_not_all, 4, 5, 0,
1639 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
1640 If so, return the position of the first character whose property PROPERTY
1641 is not `eq' to VALUE. Otherwise, return nil.
1642 If the optional fifth argument OBJECT is a buffer (or nil, which means
1643 the current buffer), START and END are buffer positions (integers or
1644 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1645 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1647 register INTERVAL i;
1648 register ptrdiff_t s, e;
1650 if (NILP (object))
1651 XSETBUFFER (object, current_buffer);
1652 i = validate_interval_range (object, &start, &end, soft);
1653 if (!i)
1654 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1655 s = XINT (start);
1656 e = XINT (end);
1658 while (i)
1660 if (i->position >= e)
1661 break;
1662 if (! EQ (textget (i->plist, property), value))
1664 if (i->position > s)
1665 s = i->position;
1666 return make_number (s);
1668 i = next_interval (i);
1670 return Qnil;
1674 /* Return the direction from which the text-property PROP would be
1675 inherited by any new text inserted at POS: 1 if it would be
1676 inherited from the char after POS, -1 if it would be inherited from
1677 the char before POS, and 0 if from neither.
1678 BUFFER can be either a buffer or nil (meaning current buffer). */
1681 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1683 Lisp_Object prev_pos, front_sticky;
1684 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
1685 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
1687 if (NILP (buffer))
1688 XSETBUFFER (buffer, current_buffer);
1690 if (CONSP (defalt) && !NILP (XCDR (defalt)))
1691 is_rear_sticky = 0;
1693 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
1694 /* Consider previous character. */
1696 Lisp_Object rear_non_sticky;
1698 prev_pos = make_number (XINT (pos) - 1);
1699 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1701 if (!NILP (CONSP (rear_non_sticky)
1702 ? Fmemq (prop, rear_non_sticky)
1703 : rear_non_sticky))
1704 /* PROP is rear-non-sticky. */
1705 is_rear_sticky = 0;
1707 else
1708 return 0;
1710 /* Consider following character. */
1711 /* This signals an arg-out-of-range error if pos is outside the
1712 buffer's accessible range. */
1713 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1715 if (EQ (front_sticky, Qt)
1716 || (CONSP (front_sticky)
1717 && !NILP (Fmemq (prop, front_sticky))))
1718 /* PROP is inherited from after. */
1719 is_front_sticky = 1;
1721 /* Simple cases, where the properties are consistent. */
1722 if (is_rear_sticky && !is_front_sticky)
1723 return -1;
1724 else if (!is_rear_sticky && is_front_sticky)
1725 return 1;
1726 else if (!is_rear_sticky && !is_front_sticky)
1727 return 0;
1729 /* The stickiness properties are inconsistent, so we have to
1730 disambiguate. Basically, rear-sticky wins, _except_ if the
1731 property that would be inherited has a value of nil, in which case
1732 front-sticky wins. */
1733 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1734 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1735 return 1;
1736 else
1737 return -1;
1741 /* Copying properties between objects. */
1743 /* Add properties from START to END of SRC, starting at POS in DEST.
1744 SRC and DEST may each refer to strings or buffers.
1745 Optional sixth argument PROP causes only that property to be copied.
1746 Properties are copied to DEST as if by `add-text-properties'.
1747 Return t if any property value actually changed, nil otherwise. */
1749 /* Note this can GC when DEST is a buffer. */
1751 Lisp_Object
1752 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1754 INTERVAL i;
1755 Lisp_Object res;
1756 Lisp_Object stuff;
1757 Lisp_Object plist;
1758 ptrdiff_t s, e, e2, p, len;
1759 int modified = 0;
1760 struct gcpro gcpro1, gcpro2;
1762 i = validate_interval_range (src, &start, &end, soft);
1763 if (!i)
1764 return Qnil;
1766 CHECK_NUMBER_COERCE_MARKER (pos);
1768 Lisp_Object dest_start, dest_end;
1770 e = XINT (pos) + (XINT (end) - XINT (start));
1771 if (MOST_POSITIVE_FIXNUM < e)
1772 args_out_of_range (pos, end);
1773 dest_start = pos;
1774 XSETFASTINT (dest_end, e);
1775 /* Apply this to a copy of pos; it will try to increment its arguments,
1776 which we don't want. */
1777 validate_interval_range (dest, &dest_start, &dest_end, soft);
1780 s = XINT (start);
1781 e = XINT (end);
1782 p = XINT (pos);
1784 stuff = Qnil;
1786 while (s < e)
1788 e2 = i->position + LENGTH (i);
1789 if (e2 > e)
1790 e2 = e;
1791 len = e2 - s;
1793 plist = i->plist;
1794 if (! NILP (prop))
1795 while (! NILP (plist))
1797 if (EQ (Fcar (plist), prop))
1799 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1800 break;
1802 plist = Fcdr (Fcdr (plist));
1804 if (! NILP (plist))
1806 /* Must defer modifications to the interval tree in case src
1807 and dest refer to the same string or buffer. */
1808 stuff = Fcons (Fcons (make_number (p),
1809 Fcons (make_number (p + len),
1810 Fcons (plist, Qnil))),
1811 stuff);
1814 i = next_interval (i);
1815 if (!i)
1816 break;
1818 p += len;
1819 s = i->position;
1822 GCPRO2 (stuff, dest);
1824 while (! NILP (stuff))
1826 res = Fcar (stuff);
1827 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1828 Fcar (Fcdr (Fcdr (res))), dest);
1829 if (! NILP (res))
1830 modified++;
1831 stuff = Fcdr (stuff);
1834 UNGCPRO;
1836 return modified ? Qt : Qnil;
1840 /* Return a list representing the text properties of OBJECT between
1841 START and END. if PROP is non-nil, report only on that property.
1842 Each result list element has the form (S E PLIST), where S and E
1843 are positions in OBJECT and PLIST is a property list containing the
1844 text properties of OBJECT between S and E. Value is nil if OBJECT
1845 doesn't contain text properties between START and END. */
1847 Lisp_Object
1848 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
1850 struct interval *i;
1851 Lisp_Object result;
1853 result = Qnil;
1855 i = validate_interval_range (object, &start, &end, soft);
1856 if (i)
1858 ptrdiff_t s = XINT (start);
1859 ptrdiff_t e = XINT (end);
1861 while (s < e)
1863 ptrdiff_t interval_end, len;
1864 Lisp_Object plist;
1866 interval_end = i->position + LENGTH (i);
1867 if (interval_end > e)
1868 interval_end = e;
1869 len = interval_end - s;
1871 plist = i->plist;
1873 if (!NILP (prop))
1874 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
1875 if (EQ (XCAR (plist), prop))
1877 plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
1878 break;
1881 if (!NILP (plist))
1882 result = Fcons (Fcons (make_number (s),
1883 Fcons (make_number (s + len),
1884 Fcons (plist, Qnil))),
1885 result);
1887 i = next_interval (i);
1888 if (!i)
1889 break;
1890 s = i->position;
1894 return result;
1898 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1899 (START END PLIST), where START and END are positions and PLIST is a
1900 property list containing the text properties to add. Adjust START
1901 and END positions by DELTA before adding properties. Value is
1902 non-zero if OBJECT was modified. */
1905 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
1907 struct gcpro gcpro1, gcpro2;
1908 int modified_p = 0;
1910 GCPRO2 (list, object);
1912 for (; CONSP (list); list = XCDR (list))
1914 Lisp_Object item, start, end, plist, tem;
1916 item = XCAR (list);
1917 start = make_number (XINT (XCAR (item)) + XINT (delta));
1918 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
1919 plist = XCAR (XCDR (XCDR (item)));
1921 tem = Fadd_text_properties (start, end, plist, object);
1922 if (!NILP (tem))
1923 modified_p = 1;
1926 UNGCPRO;
1927 return modified_p;
1932 /* Modify end-points of ranges in LIST destructively, and return the
1933 new list. LIST is a list as returned from text_property_list.
1934 Discard properties that begin at or after NEW_END, and limit
1935 end-points to NEW_END. */
1937 Lisp_Object
1938 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
1940 Lisp_Object prev = Qnil, head = list;
1941 ptrdiff_t max = XINT (new_end);
1943 for (; CONSP (list); prev = list, list = XCDR (list))
1945 Lisp_Object item, beg, end;
1947 item = XCAR (list);
1948 beg = XCAR (item);
1949 end = XCAR (XCDR (item));
1951 if (XINT (beg) >= max)
1953 /* The start-point is past the end of the new string.
1954 Discard this property. */
1955 if (EQ (head, list))
1956 head = XCDR (list);
1957 else
1958 XSETCDR (prev, XCDR (list));
1960 else if (XINT (end) > max)
1961 /* The end-point is past the end of the new string. */
1962 XSETCAR (XCDR (item), new_end);
1965 return head;
1970 /* Call the modification hook functions in LIST, each with START and END. */
1972 static void
1973 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
1975 struct gcpro gcpro1;
1976 GCPRO1 (list);
1977 while (!NILP (list))
1979 call2 (Fcar (list), start, end);
1980 list = Fcdr (list);
1982 UNGCPRO;
1985 /* Check for read-only intervals between character positions START ... END,
1986 in BUF, and signal an error if we find one.
1988 Then check for any modification hooks in the range.
1989 Create a list of all these hooks in lexicographic order,
1990 eliminating consecutive extra copies of the same hook. Then call
1991 those hooks in order, with START and END - 1 as arguments. */
1993 void
1994 verify_interval_modification (struct buffer *buf,
1995 ptrdiff_t start, ptrdiff_t end)
1997 INTERVAL intervals = buffer_intervals (buf);
1998 INTERVAL i;
1999 Lisp_Object hooks;
2000 Lisp_Object prev_mod_hooks;
2001 Lisp_Object mod_hooks;
2002 struct gcpro gcpro1;
2004 hooks = Qnil;
2005 prev_mod_hooks = Qnil;
2006 mod_hooks = Qnil;
2008 interval_insert_behind_hooks = Qnil;
2009 interval_insert_in_front_hooks = Qnil;
2011 if (!intervals)
2012 return;
2014 if (start > end)
2016 ptrdiff_t temp = start;
2017 start = end;
2018 end = temp;
2021 /* For an insert operation, check the two chars around the position. */
2022 if (start == end)
2024 INTERVAL prev = NULL;
2025 Lisp_Object before, after;
2027 /* Set I to the interval containing the char after START,
2028 and PREV to the interval containing the char before START.
2029 Either one may be null. They may be equal. */
2030 i = find_interval (intervals, start);
2032 if (start == BUF_BEGV (buf))
2033 prev = 0;
2034 else if (i->position == start)
2035 prev = previous_interval (i);
2036 else if (i->position < start)
2037 prev = i;
2038 if (start == BUF_ZV (buf))
2039 i = 0;
2041 /* If Vinhibit_read_only is set and is not a list, we can
2042 skip the read_only checks. */
2043 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2045 /* If I and PREV differ we need to check for the read-only
2046 property together with its stickiness. If either I or
2047 PREV are 0, this check is all we need.
2048 We have to take special care, since read-only may be
2049 indirectly defined via the category property. */
2050 if (i != prev)
2052 if (i)
2054 after = textget (i->plist, Qread_only);
2056 /* If interval I is read-only and read-only is
2057 front-sticky, inhibit insertion.
2058 Check for read-only as well as category. */
2059 if (! NILP (after)
2060 && NILP (Fmemq (after, Vinhibit_read_only)))
2062 Lisp_Object tem;
2064 tem = textget (i->plist, Qfront_sticky);
2065 if (TMEM (Qread_only, tem)
2066 || (NILP (Fplist_get (i->plist, Qread_only))
2067 && TMEM (Qcategory, tem)))
2068 text_read_only (after);
2072 if (prev)
2074 before = textget (prev->plist, Qread_only);
2076 /* If interval PREV is read-only and read-only isn't
2077 rear-nonsticky, inhibit insertion.
2078 Check for read-only as well as category. */
2079 if (! NILP (before)
2080 && NILP (Fmemq (before, Vinhibit_read_only)))
2082 Lisp_Object tem;
2084 tem = textget (prev->plist, Qrear_nonsticky);
2085 if (! TMEM (Qread_only, tem)
2086 && (! NILP (Fplist_get (prev->plist,Qread_only))
2087 || ! TMEM (Qcategory, tem)))
2088 text_read_only (before);
2092 else if (i)
2094 after = textget (i->plist, Qread_only);
2096 /* If interval I is read-only and read-only is
2097 front-sticky, inhibit insertion.
2098 Check for read-only as well as category. */
2099 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2101 Lisp_Object tem;
2103 tem = textget (i->plist, Qfront_sticky);
2104 if (TMEM (Qread_only, tem)
2105 || (NILP (Fplist_get (i->plist, Qread_only))
2106 && TMEM (Qcategory, tem)))
2107 text_read_only (after);
2109 tem = textget (prev->plist, Qrear_nonsticky);
2110 if (! TMEM (Qread_only, tem)
2111 && (! NILP (Fplist_get (prev->plist, Qread_only))
2112 || ! TMEM (Qcategory, tem)))
2113 text_read_only (after);
2118 /* Run both insert hooks (just once if they're the same). */
2119 if (prev)
2120 interval_insert_behind_hooks
2121 = textget (prev->plist, Qinsert_behind_hooks);
2122 if (i)
2123 interval_insert_in_front_hooks
2124 = textget (i->plist, Qinsert_in_front_hooks);
2126 else
2128 /* Loop over intervals on or next to START...END,
2129 collecting their hooks. */
2131 i = find_interval (intervals, start);
2134 if (! INTERVAL_WRITABLE_P (i))
2135 text_read_only (textget (i->plist, Qread_only));
2137 if (!inhibit_modification_hooks)
2139 mod_hooks = textget (i->plist, Qmodification_hooks);
2140 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2142 hooks = Fcons (mod_hooks, hooks);
2143 prev_mod_hooks = mod_hooks;
2147 i = next_interval (i);
2149 /* Keep going thru the interval containing the char before END. */
2150 while (i && i->position < end);
2152 if (!inhibit_modification_hooks)
2154 GCPRO1 (hooks);
2155 hooks = Fnreverse (hooks);
2156 while (! EQ (hooks, Qnil))
2158 call_mod_hooks (Fcar (hooks), make_number (start),
2159 make_number (end));
2160 hooks = Fcdr (hooks);
2162 UNGCPRO;
2167 /* Run the interval hooks for an insertion on character range START ... END.
2168 verify_interval_modification chose which hooks to run;
2169 this function is called after the insertion happens
2170 so it can indicate the range of inserted text. */
2172 void
2173 report_interval_modification (Lisp_Object start, Lisp_Object end)
2175 if (! NILP (interval_insert_behind_hooks))
2176 call_mod_hooks (interval_insert_behind_hooks, start, end);
2177 if (! NILP (interval_insert_in_front_hooks)
2178 && ! EQ (interval_insert_in_front_hooks,
2179 interval_insert_behind_hooks))
2180 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2183 void
2184 syms_of_textprop (void)
2186 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2187 doc: /* Property-list used as default values.
2188 The value of a property in this list is seen as the value for every
2189 character that does not have its own value for that property. */);
2190 Vdefault_text_properties = Qnil;
2192 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2193 doc: /* Alist of alternative properties for properties without a value.
2194 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2195 If a piece of text has no direct value for a particular property, then
2196 this alist is consulted. If that property appears in the alist, then
2197 the first non-nil value from the associated alternative properties is
2198 returned. */);
2199 Vchar_property_alias_alist = Qnil;
2201 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2202 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2203 This also inhibits the use of the `intangible' text property. */);
2204 Vinhibit_point_motion_hooks = Qnil;
2206 DEFVAR_LISP ("text-property-default-nonsticky",
2207 Vtext_property_default_nonsticky,
2208 doc: /* Alist of properties vs the corresponding non-stickiness.
2209 Each element has the form (PROPERTY . NONSTICKINESS).
2211 If a character in a buffer has PROPERTY, new text inserted adjacent to
2212 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2213 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2214 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2215 /* Text properties `syntax-table'and `display' should be nonsticky
2216 by default. */
2217 Vtext_property_default_nonsticky
2218 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
2219 Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
2221 staticpro (&interval_insert_behind_hooks);
2222 staticpro (&interval_insert_in_front_hooks);
2223 interval_insert_behind_hooks = Qnil;
2224 interval_insert_in_front_hooks = Qnil;
2227 /* Common attributes one might give text */
2229 DEFSYM (Qforeground, "foreground");
2230 DEFSYM (Qbackground, "background");
2231 DEFSYM (Qfont, "font");
2232 DEFSYM (Qstipple, "stipple");
2233 DEFSYM (Qunderline, "underline");
2234 DEFSYM (Qread_only, "read-only");
2235 DEFSYM (Qinvisible, "invisible");
2236 DEFSYM (Qintangible, "intangible");
2237 DEFSYM (Qcategory, "category");
2238 DEFSYM (Qlocal_map, "local-map");
2239 DEFSYM (Qfront_sticky, "front-sticky");
2240 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2241 DEFSYM (Qmouse_face, "mouse-face");
2242 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
2244 /* Properties that text might use to specify certain actions */
2246 DEFSYM (Qmouse_left, "mouse-left");
2247 DEFSYM (Qmouse_entered, "mouse-entered");
2248 DEFSYM (Qpoint_left, "point-left");
2249 DEFSYM (Qpoint_entered, "point-entered");
2251 defsubr (&Stext_properties_at);
2252 defsubr (&Sget_text_property);
2253 defsubr (&Sget_char_property);
2254 defsubr (&Sget_char_property_and_overlay);
2255 defsubr (&Snext_char_property_change);
2256 defsubr (&Sprevious_char_property_change);
2257 defsubr (&Snext_single_char_property_change);
2258 defsubr (&Sprevious_single_char_property_change);
2259 defsubr (&Snext_property_change);
2260 defsubr (&Snext_single_property_change);
2261 defsubr (&Sprevious_property_change);
2262 defsubr (&Sprevious_single_property_change);
2263 defsubr (&Sadd_text_properties);
2264 defsubr (&Sput_text_property);
2265 defsubr (&Sset_text_properties);
2266 defsubr (&Sremove_text_properties);
2267 defsubr (&Sremove_list_of_text_properties);
2268 defsubr (&Stext_property_any);
2269 defsubr (&Stext_property_not_all);