* lisp/obsolete/spell.el: Fix header comment.
[emacs.git] / src / textprop.c
blob5db6033670b24e538561090320b2a275a14b4506
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2011 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>
20 #include <setjmp.h>
21 #include "lisp.h"
22 #include "intervals.h"
23 #include "buffer.h"
24 #include "window.h"
26 #ifndef NULL
27 #define NULL (void *)0
28 #endif
30 /* Test for membership, allowing for t (actually any non-cons) to mean the
31 universal set. */
33 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
36 /* NOTES: previous- and next- property change will have to skip
37 zero-length intervals if they are implemented. This could be done
38 inside next_interval and previous_interval.
40 set_properties needs to deal with the interval property cache.
42 It is assumed that for any interval plist, a property appears
43 only once on the list. Although some code i.e., remove_properties,
44 handles the more general case, the uniqueness of properties is
45 necessary for the system to remain consistent. This requirement
46 is enforced by the subrs installing properties onto the intervals. */
49 /* Types of hooks. */
50 Lisp_Object Qmouse_left;
51 Lisp_Object Qmouse_entered;
52 Lisp_Object Qpoint_left;
53 Lisp_Object Qpoint_entered;
54 Lisp_Object Qcategory;
55 Lisp_Object Qlocal_map;
57 /* Visual properties text (including strings) may have. */
58 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
59 Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
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 Lisp_Object interval_insert_behind_hooks;
73 Lisp_Object interval_insert_in_front_hooks;
75 static void text_read_only (Lisp_Object) NO_RETURN;
78 /* Signal a `text-read-only' error. This function makes it easier
79 to capture that error in GDB by putting a breakpoint on it. */
81 static void
82 text_read_only (Lisp_Object propval)
84 if (STRINGP (propval))
85 xsignal1 (Qtext_read_only, propval);
87 xsignal0 (Qtext_read_only);
92 /* Extract the interval at the position pointed to by BEGIN from
93 OBJECT, a string or buffer. Additionally, check that the positions
94 pointed to by BEGIN and END are within the bounds of OBJECT, and
95 reverse them if *BEGIN is greater than *END. The objects pointed
96 to by BEGIN and END may be integers or markers; if the latter, they
97 are coerced to integers.
99 When OBJECT is a string, we increment *BEGIN and *END
100 to make them origin-one.
102 Note that buffer points don't correspond to interval indices.
103 For example, point-max is 1 greater than the index of the last
104 character. This difference is handled in the caller, which uses
105 the validated points to determine a length, and operates on that.
106 Exceptions are Ftext_properties_at, Fnext_property_change, and
107 Fprevious_property_change which call this function with BEGIN == END.
108 Handle this case specially.
110 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
111 create an interval tree for OBJECT if one doesn't exist, provided
112 the object actually contains text. In the current design, if there
113 is no text, there can be no text properties. */
115 #define soft 0
116 #define hard 1
118 INTERVAL
119 validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
121 register INTERVAL i;
122 EMACS_INT searchpos;
124 CHECK_STRING_OR_BUFFER (object);
125 CHECK_NUMBER_COERCE_MARKER (*begin);
126 CHECK_NUMBER_COERCE_MARKER (*end);
128 /* If we are asked for a point, but from a subr which operates
129 on a range, then return nothing. */
130 if (EQ (*begin, *end) && begin != end)
131 return NULL_INTERVAL;
133 if (XINT (*begin) > XINT (*end))
135 Lisp_Object n;
136 n = *begin;
137 *begin = *end;
138 *end = n;
141 if (BUFFERP (object))
143 register struct buffer *b = XBUFFER (object);
145 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
146 && XINT (*end) <= BUF_ZV (b)))
147 args_out_of_range (*begin, *end);
148 i = BUF_INTERVALS (b);
150 /* If there's no text, there are no properties. */
151 if (BUF_BEGV (b) == BUF_ZV (b))
152 return NULL_INTERVAL;
154 searchpos = XINT (*begin);
156 else
158 EMACS_INT len = SCHARS (object);
160 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
161 && XINT (*end) <= len))
162 args_out_of_range (*begin, *end);
163 XSETFASTINT (*begin, XFASTINT (*begin));
164 if (begin != end)
165 XSETFASTINT (*end, XFASTINT (*end));
166 i = STRING_INTERVALS (object);
168 if (len == 0)
169 return NULL_INTERVAL;
171 searchpos = XINT (*begin);
174 if (NULL_INTERVAL_P (i))
175 return (force ? create_root_interval (object) : i);
177 return find_interval (i, searchpos);
180 /* Validate LIST as a property list. If LIST is not a list, then
181 make one consisting of (LIST nil). Otherwise, verify that LIST
182 is even numbered and thus suitable as a plist. */
184 static Lisp_Object
185 validate_plist (Lisp_Object list)
187 if (NILP (list))
188 return Qnil;
190 if (CONSP (list))
192 register int i;
193 register Lisp_Object tail;
194 for (i = 0, tail = list; CONSP (tail); i++)
196 tail = XCDR (tail);
197 QUIT;
199 if (i & 1)
200 error ("Odd length text property list");
201 return list;
204 return Fcons (list, Fcons (Qnil, Qnil));
207 /* Return nonzero if interval I has all the properties,
208 with the same values, of list PLIST. */
210 static int
211 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
213 register Lisp_Object tail1, tail2, sym1;
214 register int found;
216 /* Go through each element of PLIST. */
217 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
219 sym1 = XCAR (tail1);
220 found = 0;
222 /* Go through I's plist, looking for sym1 */
223 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
224 if (EQ (sym1, XCAR (tail2)))
226 /* Found the same property on both lists. If the
227 values are unequal, return zero. */
228 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
229 return 0;
231 /* Property has same value on both lists; go to next one. */
232 found = 1;
233 break;
236 if (! found)
237 return 0;
240 return 1;
243 /* Return nonzero if the plist of interval I has any of the
244 properties of PLIST, regardless of their values. */
246 static INLINE int
247 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
249 register Lisp_Object tail1, tail2, sym;
251 /* Go through each element of PLIST. */
252 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
254 sym = XCAR (tail1);
256 /* Go through i's plist, looking for tail1 */
257 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
258 if (EQ (sym, XCAR (tail2)))
259 return 1;
262 return 0;
265 /* Return nonzero if the plist of interval I has any of the
266 property names in LIST, regardless of their values. */
268 static INLINE int
269 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
271 register Lisp_Object tail1, tail2, sym;
273 /* Go through each element of LIST. */
274 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
276 sym = Fcar (tail1);
278 /* Go through i's plist, looking for tail1 */
279 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
280 if (EQ (sym, XCAR (tail2)))
281 return 1;
284 return 0;
287 /* Changing the plists of individual intervals. */
289 /* Return the value of PROP in property-list PLIST, or Qunbound if it
290 has none. */
291 static Lisp_Object
292 property_value (Lisp_Object plist, Lisp_Object prop)
294 Lisp_Object value;
296 while (PLIST_ELT_P (plist, value))
297 if (EQ (XCAR (plist), prop))
298 return XCAR (value);
299 else
300 plist = XCDR (value);
302 return Qunbound;
305 /* Set the properties of INTERVAL to PROPERTIES,
306 and record undo info for the previous values.
307 OBJECT is the string or buffer that INTERVAL belongs to. */
309 static void
310 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
312 Lisp_Object sym, value;
314 if (BUFFERP (object))
316 /* For each property in the old plist which is missing from PROPERTIES,
317 or has a different value in PROPERTIES, make an undo record. */
318 for (sym = interval->plist;
319 PLIST_ELT_P (sym, value);
320 sym = XCDR (value))
321 if (! EQ (property_value (properties, XCAR (sym)),
322 XCAR (value)))
324 record_property_change (interval->position, LENGTH (interval),
325 XCAR (sym), XCAR (value),
326 object);
329 /* For each new property that has no value at all in the old plist,
330 make an undo record binding it to nil, so it will be removed. */
331 for (sym = properties;
332 PLIST_ELT_P (sym, value);
333 sym = XCDR (value))
334 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
336 record_property_change (interval->position, LENGTH (interval),
337 XCAR (sym), Qnil,
338 object);
342 /* Store new properties. */
343 interval->plist = Fcopy_sequence (properties);
346 /* Add the properties of PLIST to the interval I, or set
347 the value of I's property to the value of the property on PLIST
348 if they are different.
350 OBJECT should be the string or buffer the interval is in.
352 Return nonzero if this changes I (i.e., if any members of PLIST
353 are actually added to I's plist) */
355 static int
356 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
358 Lisp_Object tail1, tail2, sym1, val1;
359 register int changed = 0;
360 register int found;
361 struct gcpro gcpro1, gcpro2, gcpro3;
363 tail1 = plist;
364 sym1 = Qnil;
365 val1 = Qnil;
366 /* No need to protect OBJECT, because we can GC only in the case
367 where it is a buffer, and live buffers are always protected.
368 I and its plist are also protected, via OBJECT. */
369 GCPRO3 (tail1, sym1, val1);
371 /* Go through each element of PLIST. */
372 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
374 sym1 = XCAR (tail1);
375 val1 = Fcar (XCDR (tail1));
376 found = 0;
378 /* Go through I's plist, looking for sym1 */
379 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
380 if (EQ (sym1, XCAR (tail2)))
382 /* No need to gcpro, because tail2 protects this
383 and it must be a cons cell (we get an error otherwise). */
384 register Lisp_Object this_cdr;
386 this_cdr = XCDR (tail2);
387 /* Found the property. Now check its value. */
388 found = 1;
390 /* The properties have the same value on both lists.
391 Continue to the next property. */
392 if (EQ (val1, Fcar (this_cdr)))
393 break;
395 /* Record this change in the buffer, for undo purposes. */
396 if (BUFFERP (object))
398 record_property_change (i->position, LENGTH (i),
399 sym1, Fcar (this_cdr), object);
402 /* I's property has a different value -- change it */
403 Fsetcar (this_cdr, val1);
404 changed++;
405 break;
408 if (! found)
410 /* Record this change in the buffer, for undo purposes. */
411 if (BUFFERP (object))
413 record_property_change (i->position, LENGTH (i),
414 sym1, Qnil, object);
416 i->plist = Fcons (sym1, Fcons (val1, i->plist));
417 changed++;
421 UNGCPRO;
423 return changed;
426 /* For any members of PLIST, or LIST,
427 which are properties of I, remove them from I's plist.
428 (If PLIST is non-nil, use that, otherwise use LIST.)
429 OBJECT is the string or buffer containing I. */
431 static int
432 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
434 register Lisp_Object tail1, tail2, sym, current_plist;
435 register int changed = 0;
437 /* Nonzero means tail1 is a plist, otherwise it is a list. */
438 int use_plist;
440 current_plist = i->plist;
442 if (! NILP (plist))
443 tail1 = plist, use_plist = 1;
444 else
445 tail1 = list, use_plist = 0;
447 /* Go through each element of LIST or PLIST. */
448 while (CONSP (tail1))
450 sym = XCAR (tail1);
452 /* First, remove the symbol if it's at the head of the list */
453 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
455 if (BUFFERP (object))
456 record_property_change (i->position, LENGTH (i),
457 sym, XCAR (XCDR (current_plist)),
458 object);
460 current_plist = XCDR (XCDR (current_plist));
461 changed++;
464 /* Go through I's plist, looking for SYM. */
465 tail2 = current_plist;
466 while (! NILP (tail2))
468 register Lisp_Object this;
469 this = XCDR (XCDR (tail2));
470 if (CONSP (this) && EQ (sym, XCAR (this)))
472 if (BUFFERP (object))
473 record_property_change (i->position, LENGTH (i),
474 sym, XCAR (XCDR (this)), object);
476 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
477 changed++;
479 tail2 = this;
482 /* Advance thru TAIL1 one way or the other. */
483 tail1 = XCDR (tail1);
484 if (use_plist && CONSP (tail1))
485 tail1 = XCDR (tail1);
488 if (changed)
489 i->plist = current_plist;
490 return changed;
493 #if 0
494 /* Remove all properties from interval I. Return non-zero
495 if this changes the interval. */
497 static INLINE int
498 erase_properties (INTERVAL i)
500 if (NILP (i->plist))
501 return 0;
503 i->plist = Qnil;
504 return 1;
506 #endif
508 /* Returns the interval of POSITION in OBJECT.
509 POSITION is BEG-based. */
511 INTERVAL
512 interval_of (int position, Lisp_Object object)
514 register INTERVAL i;
515 EMACS_INT beg, end;
517 if (NILP (object))
518 XSETBUFFER (object, current_buffer);
519 else if (EQ (object, Qt))
520 return NULL_INTERVAL;
522 CHECK_STRING_OR_BUFFER (object);
524 if (BUFFERP (object))
526 register struct buffer *b = XBUFFER (object);
528 beg = BUF_BEGV (b);
529 end = BUF_ZV (b);
530 i = BUF_INTERVALS (b);
532 else
534 beg = 0;
535 end = SCHARS (object);
536 i = STRING_INTERVALS (object);
539 if (!(beg <= position && position <= end))
540 args_out_of_range (make_number (position), make_number (position));
541 if (beg == end || NULL_INTERVAL_P (i))
542 return NULL_INTERVAL;
544 return find_interval (i, position);
547 DEFUN ("text-properties-at", Ftext_properties_at,
548 Stext_properties_at, 1, 2, 0,
549 doc: /* Return the list of properties of the character at POSITION in OBJECT.
550 If the optional second argument OBJECT is a buffer (or nil, which means
551 the current buffer), POSITION is a buffer position (integer or marker).
552 If OBJECT is a string, POSITION is a 0-based index into it.
553 If POSITION is at the end of OBJECT, the value is nil. */)
554 (Lisp_Object position, Lisp_Object object)
556 register INTERVAL i;
558 if (NILP (object))
559 XSETBUFFER (object, current_buffer);
561 i = validate_interval_range (object, &position, &position, soft);
562 if (NULL_INTERVAL_P (i))
563 return Qnil;
564 /* If POSITION is at the end of the interval,
565 it means it's the end of OBJECT.
566 There are no properties at the very end,
567 since no character follows. */
568 if (XINT (position) == LENGTH (i) + i->position)
569 return Qnil;
571 return i->plist;
574 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
575 doc: /* Return the value of POSITION's property PROP, in OBJECT.
576 OBJECT is optional and defaults to the current buffer.
577 If POSITION is at the end of OBJECT, the value is nil. */)
578 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
580 return textget (Ftext_properties_at (position, object), prop);
583 /* Return the value of char's property PROP, in OBJECT at POSITION.
584 OBJECT is optional and defaults to the current buffer.
585 If OVERLAY is non-0, then in the case that the returned property is from
586 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
587 returned in *OVERLAY.
588 If POSITION is at the end of OBJECT, the value is nil.
589 If OBJECT is a buffer, then overlay properties are considered as well as
590 text properties.
591 If OBJECT is a window, then that window's buffer is used, but
592 window-specific overlays are considered only if they are associated
593 with OBJECT. */
594 Lisp_Object
595 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
597 struct window *w = 0;
599 CHECK_NUMBER_COERCE_MARKER (position);
601 if (NILP (object))
602 XSETBUFFER (object, current_buffer);
604 if (WINDOWP (object))
606 w = XWINDOW (object);
607 object = w->buffer;
609 if (BUFFERP (object))
611 int noverlays;
612 Lisp_Object *overlay_vec;
613 struct buffer *obuf = current_buffer;
615 if (XINT (position) < BUF_BEGV (XBUFFER (object))
616 || XINT (position) > BUF_ZV (XBUFFER (object)))
617 xsignal1 (Qargs_out_of_range, position);
619 set_buffer_temp (XBUFFER (object));
621 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
622 noverlays = sort_overlays (overlay_vec, noverlays, w);
624 set_buffer_temp (obuf);
626 /* Now check the overlays in order of decreasing priority. */
627 while (--noverlays >= 0)
629 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
630 if (!NILP (tem))
632 if (overlay)
633 /* Return the overlay we got the property from. */
634 *overlay = overlay_vec[noverlays];
635 return tem;
640 if (overlay)
641 /* Indicate that the return value is not from an overlay. */
642 *overlay = Qnil;
644 /* Not a buffer, or no appropriate overlay, so fall through to the
645 simpler case. */
646 return Fget_text_property (position, prop, object);
649 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
650 doc: /* Return the value of POSITION's property PROP, in OBJECT.
651 Both overlay properties and text properties are checked.
652 OBJECT is optional and defaults to the current buffer.
653 If POSITION is at the end of OBJECT, the value is nil.
654 If OBJECT is a buffer, then overlay properties are considered as well as
655 text properties.
656 If OBJECT is a window, then that window's buffer is used, but window-specific
657 overlays are considered only if they are associated with OBJECT. */)
658 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
660 return get_char_property_and_overlay (position, prop, object, 0);
663 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
664 Sget_char_property_and_overlay, 2, 3, 0,
665 doc: /* Like `get-char-property', but with extra overlay information.
666 The value is a cons cell. Its car is the return value of `get-char-property'
667 with the same arguments--that is, the value of POSITION's property
668 PROP in OBJECT. Its cdr is the overlay in which the property was
669 found, or nil, if it was found as a text property or not found at all.
671 OBJECT is optional and defaults to the current buffer. OBJECT may be
672 a string, a buffer or a window. For strings, the cdr of the return
673 value is always nil, since strings do not have overlays. If OBJECT is
674 a window, then that window's buffer is used, but window-specific
675 overlays are considered only if they are associated with OBJECT. If
676 POSITION is at the end of OBJECT, both car and cdr are nil. */)
677 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
679 Lisp_Object overlay;
680 Lisp_Object val
681 = get_char_property_and_overlay (position, prop, object, &overlay);
682 return Fcons (val, overlay);
686 DEFUN ("next-char-property-change", Fnext_char_property_change,
687 Snext_char_property_change, 1, 2, 0,
688 doc: /* Return the position of next text property or overlay change.
689 This scans characters forward in the current buffer from POSITION till
690 it finds a change in some text property, or the beginning or end of an
691 overlay, and returns the position of that.
692 If none is found up to (point-max), the function returns (point-max).
694 If the optional second argument LIMIT is non-nil, don't search
695 past position LIMIT; return LIMIT if nothing is found before LIMIT.
696 LIMIT is a no-op if it is greater than (point-max). */)
697 (Lisp_Object position, Lisp_Object limit)
699 Lisp_Object temp;
701 temp = Fnext_overlay_change (position);
702 if (! NILP (limit))
704 CHECK_NUMBER_COERCE_MARKER (limit);
705 if (XINT (limit) < XINT (temp))
706 temp = limit;
708 return Fnext_property_change (position, Qnil, temp);
711 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
712 Sprevious_char_property_change, 1, 2, 0,
713 doc: /* Return the position of previous text property or overlay change.
714 Scans characters backward in the current buffer from POSITION till it
715 finds a change in some text property, or the beginning or end of an
716 overlay, and returns the position of that.
717 If none is found since (point-min), the function returns (point-min).
719 If the optional second argument LIMIT is non-nil, don't search
720 past position LIMIT; return LIMIT if nothing is found before LIMIT.
721 LIMIT is a no-op if it is less than (point-min). */)
722 (Lisp_Object position, Lisp_Object limit)
724 Lisp_Object temp;
726 temp = Fprevious_overlay_change (position);
727 if (! NILP (limit))
729 CHECK_NUMBER_COERCE_MARKER (limit);
730 if (XINT (limit) > XINT (temp))
731 temp = limit;
733 return Fprevious_property_change (position, Qnil, temp);
737 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
738 Snext_single_char_property_change, 2, 4, 0,
739 doc: /* Return the position of next text property or overlay change for a specific property.
740 Scans characters forward from POSITION till it finds
741 a change in the PROP property, then returns the position of the change.
742 If the optional third argument OBJECT is a buffer (or nil, which means
743 the current buffer), POSITION is a buffer position (integer or marker).
744 If OBJECT is a string, POSITION is a 0-based index into it.
746 In a string, scan runs to the end of the string.
747 In a buffer, it runs to (point-max), and the value cannot exceed that.
749 The property values are compared with `eq'.
750 If the property is constant all the way to the end of OBJECT, return the
751 last valid position in OBJECT.
752 If the optional fourth argument LIMIT is non-nil, don't search
753 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
754 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
756 if (STRINGP (object))
758 position = Fnext_single_property_change (position, prop, object, limit);
759 if (NILP (position))
761 if (NILP (limit))
762 position = make_number (SCHARS (object));
763 else
765 CHECK_NUMBER (limit);
766 position = limit;
770 else
772 Lisp_Object initial_value, value;
773 int count = SPECPDL_INDEX ();
775 if (! NILP (object))
776 CHECK_BUFFER (object);
778 if (BUFFERP (object) && current_buffer != XBUFFER (object))
780 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
781 Fset_buffer (object);
784 CHECK_NUMBER_COERCE_MARKER (position);
786 initial_value = Fget_char_property (position, prop, object);
788 if (NILP (limit))
789 XSETFASTINT (limit, ZV);
790 else
791 CHECK_NUMBER_COERCE_MARKER (limit);
793 if (XFASTINT (position) >= XFASTINT (limit))
795 position = limit;
796 if (XFASTINT (position) > ZV)
797 XSETFASTINT (position, ZV);
799 else
800 while (1)
802 position = Fnext_char_property_change (position, limit);
803 if (XFASTINT (position) >= XFASTINT (limit))
805 position = limit;
806 break;
809 value = Fget_char_property (position, prop, object);
810 if (!EQ (value, initial_value))
811 break;
814 unbind_to (count, Qnil);
817 return position;
820 DEFUN ("previous-single-char-property-change",
821 Fprevious_single_char_property_change,
822 Sprevious_single_char_property_change, 2, 4, 0,
823 doc: /* Return the position of previous text property or overlay change for a specific property.
824 Scans characters backward from POSITION till it finds
825 a change in the PROP property, then returns the position of the change.
826 If the optional third argument OBJECT is a buffer (or nil, which means
827 the current buffer), POSITION is a buffer position (integer or marker).
828 If OBJECT is a string, POSITION is a 0-based index into it.
830 In a string, scan runs to the start of the string.
831 In a buffer, it runs to (point-min), and the value cannot be less than that.
833 The property values are compared with `eq'.
834 If the property is constant all the way to the start of OBJECT, return the
835 first valid position in OBJECT.
836 If the optional fourth argument LIMIT is non-nil, don't search
837 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
838 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
840 if (STRINGP (object))
842 position = Fprevious_single_property_change (position, prop, object, limit);
843 if (NILP (position))
845 if (NILP (limit))
846 position = make_number (0);
847 else
849 CHECK_NUMBER (limit);
850 position = limit;
854 else
856 int count = SPECPDL_INDEX ();
858 if (! NILP (object))
859 CHECK_BUFFER (object);
861 if (BUFFERP (object) && current_buffer != XBUFFER (object))
863 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
864 Fset_buffer (object);
867 CHECK_NUMBER_COERCE_MARKER (position);
869 if (NILP (limit))
870 XSETFASTINT (limit, BEGV);
871 else
872 CHECK_NUMBER_COERCE_MARKER (limit);
874 if (XFASTINT (position) <= XFASTINT (limit))
876 position = limit;
877 if (XFASTINT (position) < BEGV)
878 XSETFASTINT (position, BEGV);
880 else
882 Lisp_Object initial_value
883 = Fget_char_property (make_number (XFASTINT (position) - 1),
884 prop, object);
886 while (1)
888 position = Fprevious_char_property_change (position, limit);
890 if (XFASTINT (position) <= XFASTINT (limit))
892 position = limit;
893 break;
895 else
897 Lisp_Object value
898 = Fget_char_property (make_number (XFASTINT (position) - 1),
899 prop, object);
901 if (!EQ (value, initial_value))
902 break;
907 unbind_to (count, Qnil);
910 return position;
913 DEFUN ("next-property-change", Fnext_property_change,
914 Snext_property_change, 1, 3, 0,
915 doc: /* Return the position of next property change.
916 Scans characters forward from POSITION in OBJECT till it finds
917 a change in some text property, then returns the position of the change.
918 If the optional second argument OBJECT is a buffer (or nil, which means
919 the current buffer), POSITION is a buffer position (integer or marker).
920 If OBJECT is a string, POSITION is a 0-based index into it.
921 Return nil if the property is constant all the way to the end of OBJECT.
922 If the value is non-nil, it is a position greater than POSITION, never equal.
924 If the optional third argument LIMIT is non-nil, don't search
925 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
926 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
928 register INTERVAL i, next;
930 if (NILP (object))
931 XSETBUFFER (object, current_buffer);
933 if (!NILP (limit) && !EQ (limit, Qt))
934 CHECK_NUMBER_COERCE_MARKER (limit);
936 i = validate_interval_range (object, &position, &position, soft);
938 /* If LIMIT is t, return start of next interval--don't
939 bother checking further intervals. */
940 if (EQ (limit, Qt))
942 if (NULL_INTERVAL_P (i))
943 next = i;
944 else
945 next = next_interval (i);
947 if (NULL_INTERVAL_P (next))
948 XSETFASTINT (position, (STRINGP (object)
949 ? SCHARS (object)
950 : BUF_ZV (XBUFFER (object))));
951 else
952 XSETFASTINT (position, next->position);
953 return position;
956 if (NULL_INTERVAL_P (i))
957 return limit;
959 next = next_interval (i);
961 while (!NULL_INTERVAL_P (next) && intervals_equal (i, next)
962 && (NILP (limit) || next->position < XFASTINT (limit)))
963 next = next_interval (next);
965 if (NULL_INTERVAL_P (next)
966 || (next->position
967 >= (INTEGERP (limit)
968 ? XFASTINT (limit)
969 : (STRINGP (object)
970 ? SCHARS (object)
971 : BUF_ZV (XBUFFER (object))))))
972 return limit;
973 else
974 return make_number (next->position);
977 /* Return 1 if there's a change in some property between BEG and END. */
980 property_change_between_p (EMACS_INT beg, EMACS_INT end)
982 register INTERVAL i, next;
983 Lisp_Object object, pos;
985 XSETBUFFER (object, current_buffer);
986 XSETFASTINT (pos, beg);
988 i = validate_interval_range (object, &pos, &pos, soft);
989 if (NULL_INTERVAL_P (i))
990 return 0;
992 next = next_interval (i);
993 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
995 next = next_interval (next);
996 if (NULL_INTERVAL_P (next))
997 return 0;
998 if (next->position >= end)
999 return 0;
1002 if (NULL_INTERVAL_P (next))
1003 return 0;
1005 return 1;
1008 DEFUN ("next-single-property-change", Fnext_single_property_change,
1009 Snext_single_property_change, 2, 4, 0,
1010 doc: /* Return the position of next property change for a specific property.
1011 Scans characters forward from POSITION till it finds
1012 a change in the PROP property, then returns the position of the change.
1013 If the optional third argument OBJECT is a buffer (or nil, which means
1014 the current buffer), POSITION is a buffer position (integer or marker).
1015 If OBJECT is a string, POSITION is a 0-based index into it.
1016 The property values are compared with `eq'.
1017 Return nil if the property is constant all the way to the end of OBJECT.
1018 If the value is non-nil, it is a position greater than POSITION, never equal.
1020 If the optional fourth argument LIMIT is non-nil, don't search
1021 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
1022 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1024 register INTERVAL i, next;
1025 register Lisp_Object here_val;
1027 if (NILP (object))
1028 XSETBUFFER (object, current_buffer);
1030 if (!NILP (limit))
1031 CHECK_NUMBER_COERCE_MARKER (limit);
1033 i = validate_interval_range (object, &position, &position, soft);
1034 if (NULL_INTERVAL_P (i))
1035 return limit;
1037 here_val = textget (i->plist, prop);
1038 next = next_interval (i);
1039 while (! NULL_INTERVAL_P (next)
1040 && EQ (here_val, textget (next->plist, prop))
1041 && (NILP (limit) || next->position < XFASTINT (limit)))
1042 next = next_interval (next);
1044 if (NULL_INTERVAL_P (next)
1045 || (next->position
1046 >= (INTEGERP (limit)
1047 ? XFASTINT (limit)
1048 : (STRINGP (object)
1049 ? SCHARS (object)
1050 : BUF_ZV (XBUFFER (object))))))
1051 return limit;
1052 else
1053 return make_number (next->position);
1056 DEFUN ("previous-property-change", Fprevious_property_change,
1057 Sprevious_property_change, 1, 3, 0,
1058 doc: /* Return the position of previous property change.
1059 Scans characters backwards from POSITION in OBJECT till it finds
1060 a change in some text property, then returns the position of the change.
1061 If the optional second 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 Return nil if the property is constant all the way to the start of OBJECT.
1065 If the value is non-nil, it is a position less than POSITION, never equal.
1067 If the optional third argument LIMIT is non-nil, don't search
1068 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1069 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1071 register INTERVAL i, previous;
1073 if (NILP (object))
1074 XSETBUFFER (object, current_buffer);
1076 if (!NILP (limit))
1077 CHECK_NUMBER_COERCE_MARKER (limit);
1079 i = validate_interval_range (object, &position, &position, soft);
1080 if (NULL_INTERVAL_P (i))
1081 return limit;
1083 /* Start with the interval containing the char before point. */
1084 if (i->position == XFASTINT (position))
1085 i = previous_interval (i);
1087 previous = previous_interval (i);
1088 while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
1089 && (NILP (limit)
1090 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1091 previous = previous_interval (previous);
1093 if (NULL_INTERVAL_P (previous)
1094 || (previous->position + LENGTH (previous)
1095 <= (INTEGERP (limit)
1096 ? XFASTINT (limit)
1097 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1098 return limit;
1099 else
1100 return make_number (previous->position + LENGTH (previous));
1103 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1104 Sprevious_single_property_change, 2, 4, 0,
1105 doc: /* Return the position of previous property change for a specific property.
1106 Scans characters backward from POSITION till it finds
1107 a change in the PROP property, then returns the position of the change.
1108 If the optional third argument OBJECT is a buffer (or nil, which means
1109 the current buffer), POSITION is a buffer position (integer or marker).
1110 If OBJECT is a string, POSITION is a 0-based index into it.
1111 The property values are compared with `eq'.
1112 Return nil if the property is constant all the way to the start of OBJECT.
1113 If the value is non-nil, it is a position less than POSITION, never equal.
1115 If the optional fourth argument LIMIT is non-nil, don't search
1116 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1117 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1119 register INTERVAL i, previous;
1120 register Lisp_Object here_val;
1122 if (NILP (object))
1123 XSETBUFFER (object, current_buffer);
1125 if (!NILP (limit))
1126 CHECK_NUMBER_COERCE_MARKER (limit);
1128 i = validate_interval_range (object, &position, &position, soft);
1130 /* Start with the interval containing the char before point. */
1131 if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position))
1132 i = previous_interval (i);
1134 if (NULL_INTERVAL_P (i))
1135 return limit;
1137 here_val = textget (i->plist, prop);
1138 previous = previous_interval (i);
1139 while (!NULL_INTERVAL_P (previous)
1140 && EQ (here_val, textget (previous->plist, prop))
1141 && (NILP (limit)
1142 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1143 previous = previous_interval (previous);
1145 if (NULL_INTERVAL_P (previous)
1146 || (previous->position + LENGTH (previous)
1147 <= (INTEGERP (limit)
1148 ? XFASTINT (limit)
1149 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1150 return limit;
1151 else
1152 return make_number (previous->position + LENGTH (previous));
1155 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1157 DEFUN ("add-text-properties", Fadd_text_properties,
1158 Sadd_text_properties, 3, 4, 0,
1159 doc: /* Add properties to the text from START to END.
1160 The third argument PROPERTIES is a property list
1161 specifying the property values to add. If the optional fourth argument
1162 OBJECT is a buffer (or nil, which means the current buffer),
1163 START and END are buffer positions (integers or markers).
1164 If OBJECT is a string, START and END are 0-based indices into it.
1165 Return t if any property value actually changed, nil otherwise. */)
1166 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1168 register INTERVAL i, unchanged;
1169 register EMACS_INT s, len;
1170 register int modified = 0;
1171 struct gcpro gcpro1;
1173 properties = validate_plist (properties);
1174 if (NILP (properties))
1175 return Qnil;
1177 if (NILP (object))
1178 XSETBUFFER (object, current_buffer);
1180 i = validate_interval_range (object, &start, &end, hard);
1181 if (NULL_INTERVAL_P (i))
1182 return Qnil;
1184 s = XINT (start);
1185 len = XINT (end) - s;
1187 /* No need to protect OBJECT, because we GC only if it's a buffer,
1188 and live buffers are always protected. */
1189 GCPRO1 (properties);
1191 /* If we're not starting on an interval boundary, we have to
1192 split this interval. */
1193 if (i->position != s)
1195 /* If this interval already has the properties, we can
1196 skip it. */
1197 if (interval_has_all_properties (properties, i))
1199 EMACS_INT got = (LENGTH (i) - (s - i->position));
1200 if (got >= len)
1201 RETURN_UNGCPRO (Qnil);
1202 len -= got;
1203 i = next_interval (i);
1205 else
1207 unchanged = i;
1208 i = split_interval_right (unchanged, s - unchanged->position);
1209 copy_properties (unchanged, i);
1213 if (BUFFERP (object))
1214 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1216 /* We are at the beginning of interval I, with LEN chars to scan. */
1217 for (;;)
1219 if (i == 0)
1220 abort ();
1222 if (LENGTH (i) >= len)
1224 /* We can UNGCPRO safely here, because there will be just
1225 one more chance to gc, in the next call to add_properties,
1226 and after that we will not need PROPERTIES or OBJECT again. */
1227 UNGCPRO;
1229 if (interval_has_all_properties (properties, i))
1231 if (BUFFERP (object))
1232 signal_after_change (XINT (start), XINT (end) - XINT (start),
1233 XINT (end) - XINT (start));
1235 return modified ? Qt : Qnil;
1238 if (LENGTH (i) == len)
1240 add_properties (properties, i, object);
1241 if (BUFFERP (object))
1242 signal_after_change (XINT (start), XINT (end) - XINT (start),
1243 XINT (end) - XINT (start));
1244 return Qt;
1247 /* i doesn't have the properties, and goes past the change limit */
1248 unchanged = i;
1249 i = split_interval_left (unchanged, len);
1250 copy_properties (unchanged, i);
1251 add_properties (properties, i, object);
1252 if (BUFFERP (object))
1253 signal_after_change (XINT (start), XINT (end) - XINT (start),
1254 XINT (end) - XINT (start));
1255 return Qt;
1258 len -= LENGTH (i);
1259 modified += add_properties (properties, i, object);
1260 i = next_interval (i);
1264 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1266 DEFUN ("put-text-property", Fput_text_property,
1267 Sput_text_property, 4, 5, 0,
1268 doc: /* Set one property of the text from START to END.
1269 The third and fourth arguments PROPERTY and VALUE
1270 specify the property to add.
1271 If the optional fifth argument OBJECT is a buffer (or nil, which means
1272 the current buffer), START and END are buffer positions (integers or
1273 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1274 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1276 Fadd_text_properties (start, end,
1277 Fcons (property, Fcons (value, Qnil)),
1278 object);
1279 return Qnil;
1282 DEFUN ("set-text-properties", Fset_text_properties,
1283 Sset_text_properties, 3, 4, 0,
1284 doc: /* Completely replace properties of text from START to END.
1285 The third argument PROPERTIES is the new property list.
1286 If the optional fourth argument OBJECT is a buffer (or nil, which means
1287 the current buffer), START and END are buffer positions (integers or
1288 markers). If OBJECT is a string, START and END are 0-based indices into it.
1289 If PROPERTIES is nil, the effect is to remove all properties from
1290 the designated part of OBJECT. */)
1291 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1293 return set_text_properties (start, end, properties, object, Qt);
1297 /* Replace properties of text from START to END with new list of
1298 properties PROPERTIES. OBJECT is the buffer or string containing
1299 the text. OBJECT nil means use the current buffer.
1300 COHERENT_CHANGE_P nil means this is being called as an internal
1301 subroutine, rather than as a change primitive with checking of
1302 read-only, invoking change hooks, etc.. Value is nil if the
1303 function _detected_ that it did not replace any properties, non-nil
1304 otherwise. */
1306 Lisp_Object
1307 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p)
1309 register INTERVAL i;
1310 Lisp_Object ostart, oend;
1312 ostart = start;
1313 oend = end;
1315 properties = validate_plist (properties);
1317 if (NILP (object))
1318 XSETBUFFER (object, current_buffer);
1320 /* If we want no properties for a whole string,
1321 get rid of its intervals. */
1322 if (NILP (properties) && STRINGP (object)
1323 && XFASTINT (start) == 0
1324 && XFASTINT (end) == SCHARS (object))
1326 if (! STRING_INTERVALS (object))
1327 return Qnil;
1329 STRING_SET_INTERVALS (object, NULL_INTERVAL);
1330 return Qt;
1333 i = validate_interval_range (object, &start, &end, soft);
1335 if (NULL_INTERVAL_P (i))
1337 /* If buffer has no properties, and we want none, return now. */
1338 if (NILP (properties))
1339 return Qnil;
1341 /* Restore the original START and END values
1342 because validate_interval_range increments them for strings. */
1343 start = ostart;
1344 end = oend;
1346 i = validate_interval_range (object, &start, &end, hard);
1347 /* This can return if start == end. */
1348 if (NULL_INTERVAL_P (i))
1349 return Qnil;
1352 if (BUFFERP (object) && !NILP (coherent_change_p))
1353 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1355 set_text_properties_1 (start, end, properties, object, i);
1357 if (BUFFERP (object) && !NILP (coherent_change_p))
1358 signal_after_change (XINT (start), XINT (end) - XINT (start),
1359 XINT (end) - XINT (start));
1360 return Qt;
1363 /* Replace properties of text from START to END with new list of
1364 properties PROPERTIES. BUFFER is the buffer containing
1365 the text. This does not obey any hooks.
1366 You can provide the interval that START is located in as I,
1367 or pass NULL for I and this function will find it.
1368 START and END can be in any order. */
1370 void
1371 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i)
1373 register INTERVAL prev_changed = NULL_INTERVAL;
1374 register EMACS_INT s, len;
1375 INTERVAL unchanged;
1377 s = XINT (start);
1378 len = XINT (end) - s;
1379 if (len == 0)
1380 return;
1381 if (len < 0)
1383 s = s + len;
1384 len = - len;
1387 if (i == 0)
1388 i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
1390 if (i->position != s)
1392 unchanged = i;
1393 i = split_interval_right (unchanged, s - unchanged->position);
1395 if (LENGTH (i) > len)
1397 copy_properties (unchanged, i);
1398 i = split_interval_left (i, len);
1399 set_properties (properties, i, buffer);
1400 return;
1403 set_properties (properties, i, buffer);
1405 if (LENGTH (i) == len)
1406 return;
1408 prev_changed = i;
1409 len -= LENGTH (i);
1410 i = next_interval (i);
1413 /* We are starting at the beginning of an interval, I */
1414 while (len > 0)
1416 if (i == 0)
1417 abort ();
1419 if (LENGTH (i) >= len)
1421 if (LENGTH (i) > len)
1422 i = split_interval_left (i, len);
1424 /* We have to call set_properties even if we are going to
1425 merge the intervals, so as to make the undo records
1426 and cause redisplay to happen. */
1427 set_properties (properties, i, buffer);
1428 if (!NULL_INTERVAL_P (prev_changed))
1429 merge_interval_left (i);
1430 return;
1433 len -= LENGTH (i);
1435 /* We have to call set_properties even if we are going to
1436 merge the intervals, so as to make the undo records
1437 and cause redisplay to happen. */
1438 set_properties (properties, i, buffer);
1439 if (NULL_INTERVAL_P (prev_changed))
1440 prev_changed = i;
1441 else
1442 prev_changed = i = merge_interval_left (i);
1444 i = next_interval (i);
1448 DEFUN ("remove-text-properties", Fremove_text_properties,
1449 Sremove_text_properties, 3, 4, 0,
1450 doc: /* Remove some properties from text from START to END.
1451 The third argument PROPERTIES is a property list
1452 whose property names specify the properties to remove.
1453 \(The values stored in PROPERTIES are ignored.)
1454 If the optional fourth argument OBJECT is a buffer (or nil, which means
1455 the current buffer), START and END are buffer positions (integers or
1456 markers). If OBJECT is a string, START and END are 0-based indices into it.
1457 Return t if any property was actually removed, nil otherwise.
1459 Use `set-text-properties' if you want to remove all text properties. */)
1460 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1462 register INTERVAL i, unchanged;
1463 register EMACS_INT s, len;
1464 register int modified = 0;
1466 if (NILP (object))
1467 XSETBUFFER (object, current_buffer);
1469 i = validate_interval_range (object, &start, &end, soft);
1470 if (NULL_INTERVAL_P (i))
1471 return Qnil;
1473 s = XINT (start);
1474 len = XINT (end) - s;
1476 if (i->position != s)
1478 /* No properties on this first interval -- return if
1479 it covers the entire region. */
1480 if (! interval_has_some_properties (properties, i))
1482 EMACS_INT got = (LENGTH (i) - (s - i->position));
1483 if (got >= len)
1484 return Qnil;
1485 len -= got;
1486 i = next_interval (i);
1488 /* Split away the beginning of this interval; what we don't
1489 want to modify. */
1490 else
1492 unchanged = i;
1493 i = split_interval_right (unchanged, s - unchanged->position);
1494 copy_properties (unchanged, i);
1498 if (BUFFERP (object))
1499 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1501 /* We are at the beginning of an interval, with len to scan */
1502 for (;;)
1504 if (i == 0)
1505 abort ();
1507 if (LENGTH (i) >= len)
1509 if (! interval_has_some_properties (properties, i))
1510 return modified ? Qt : Qnil;
1512 if (LENGTH (i) == len)
1514 remove_properties (properties, Qnil, i, object);
1515 if (BUFFERP (object))
1516 signal_after_change (XINT (start), XINT (end) - XINT (start),
1517 XINT (end) - XINT (start));
1518 return Qt;
1521 /* i has the properties, and goes past the change limit */
1522 unchanged = i;
1523 i = split_interval_left (i, len);
1524 copy_properties (unchanged, i);
1525 remove_properties (properties, Qnil, i, object);
1526 if (BUFFERP (object))
1527 signal_after_change (XINT (start), XINT (end) - XINT (start),
1528 XINT (end) - XINT (start));
1529 return Qt;
1532 len -= LENGTH (i);
1533 modified += remove_properties (properties, Qnil, i, object);
1534 i = next_interval (i);
1538 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1539 Sremove_list_of_text_properties, 3, 4, 0,
1540 doc: /* Remove some properties from text from START to END.
1541 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1542 If the optional fourth argument OBJECT is a buffer (or nil, which means
1543 the current buffer), START and END are buffer positions (integers or
1544 markers). If OBJECT is a string, START and END are 0-based indices into it.
1545 Return t if any property was actually removed, nil otherwise. */)
1546 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1548 register INTERVAL i, unchanged;
1549 register EMACS_INT s, len;
1550 register int modified = 0;
1551 Lisp_Object properties;
1552 properties = list_of_properties;
1554 if (NILP (object))
1555 XSETBUFFER (object, current_buffer);
1557 i = validate_interval_range (object, &start, &end, soft);
1558 if (NULL_INTERVAL_P (i))
1559 return Qnil;
1561 s = XINT (start);
1562 len = XINT (end) - s;
1564 if (i->position != s)
1566 /* No properties on this first interval -- return if
1567 it covers the entire region. */
1568 if (! interval_has_some_properties_list (properties, i))
1570 EMACS_INT got = (LENGTH (i) - (s - i->position));
1571 if (got >= len)
1572 return Qnil;
1573 len -= got;
1574 i = next_interval (i);
1576 /* Split away the beginning of this interval; what we don't
1577 want to modify. */
1578 else
1580 unchanged = i;
1581 i = split_interval_right (unchanged, s - unchanged->position);
1582 copy_properties (unchanged, i);
1586 /* We are at the beginning of an interval, with len to scan.
1587 The flag `modified' records if changes have been made.
1588 When object is a buffer, we must call modify_region before changes are
1589 made and signal_after_change when we are done.
1590 We call modify_region before calling remove_properties if modified == 0,
1591 and we call signal_after_change before returning if modified != 0. */
1592 for (;;)
1594 if (i == 0)
1595 abort ();
1597 if (LENGTH (i) >= len)
1599 if (! interval_has_some_properties_list (properties, i))
1601 if (modified)
1603 if (BUFFERP (object))
1604 signal_after_change (XINT (start),
1605 XINT (end) - XINT (start),
1606 XINT (end) - XINT (start));
1607 return Qt;
1609 else
1610 return Qnil;
1612 else if (LENGTH (i) == len)
1614 if (!modified && BUFFERP (object))
1615 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1616 remove_properties (Qnil, properties, i, object);
1617 if (BUFFERP (object))
1618 signal_after_change (XINT (start), XINT (end) - XINT (start),
1619 XINT (end) - XINT (start));
1620 return Qt;
1622 else
1623 { /* i has the properties, and goes past the change limit. */
1624 unchanged = i;
1625 i = split_interval_left (i, len);
1626 copy_properties (unchanged, i);
1627 if (!modified && BUFFERP (object))
1628 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1629 remove_properties (Qnil, properties, i, object);
1630 if (BUFFERP (object))
1631 signal_after_change (XINT (start), XINT (end) - XINT (start),
1632 XINT (end) - XINT (start));
1633 return Qt;
1636 if (interval_has_some_properties_list (properties, i))
1638 if (!modified && BUFFERP (object))
1639 modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
1640 remove_properties (Qnil, properties, i, object);
1641 modified = 1;
1643 len -= LENGTH (i);
1644 i = next_interval (i);
1648 DEFUN ("text-property-any", Ftext_property_any,
1649 Stext_property_any, 4, 5, 0,
1650 doc: /* Check text from START to END for property PROPERTY equalling VALUE.
1651 If so, return the position of the first character whose property PROPERTY
1652 is `eq' to VALUE. Otherwise return nil.
1653 If the optional fifth argument OBJECT is a buffer (or nil, which means
1654 the current buffer), START and END are buffer positions (integers or
1655 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1656 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1658 register INTERVAL i;
1659 register EMACS_INT e, pos;
1661 if (NILP (object))
1662 XSETBUFFER (object, current_buffer);
1663 i = validate_interval_range (object, &start, &end, soft);
1664 if (NULL_INTERVAL_P (i))
1665 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1666 e = XINT (end);
1668 while (! NULL_INTERVAL_P (i))
1670 if (i->position >= e)
1671 break;
1672 if (EQ (textget (i->plist, property), value))
1674 pos = i->position;
1675 if (pos < XINT (start))
1676 pos = XINT (start);
1677 return make_number (pos);
1679 i = next_interval (i);
1681 return Qnil;
1684 DEFUN ("text-property-not-all", Ftext_property_not_all,
1685 Stext_property_not_all, 4, 5, 0,
1686 doc: /* Check text from START to END for property PROPERTY not equalling VALUE.
1687 If so, return the position of the first character whose property PROPERTY
1688 is not `eq' to VALUE. Otherwise, return nil.
1689 If the optional fifth argument OBJECT is a buffer (or nil, which means
1690 the current buffer), START and END are buffer positions (integers or
1691 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1692 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1694 register INTERVAL i;
1695 register EMACS_INT s, e;
1697 if (NILP (object))
1698 XSETBUFFER (object, current_buffer);
1699 i = validate_interval_range (object, &start, &end, soft);
1700 if (NULL_INTERVAL_P (i))
1701 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1702 s = XINT (start);
1703 e = XINT (end);
1705 while (! NULL_INTERVAL_P (i))
1707 if (i->position >= e)
1708 break;
1709 if (! EQ (textget (i->plist, property), value))
1711 if (i->position > s)
1712 s = i->position;
1713 return make_number (s);
1715 i = next_interval (i);
1717 return Qnil;
1721 /* Return the direction from which the text-property PROP would be
1722 inherited by any new text inserted at POS: 1 if it would be
1723 inherited from the char after POS, -1 if it would be inherited from
1724 the char before POS, and 0 if from neither.
1725 BUFFER can be either a buffer or nil (meaning current buffer). */
1728 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1730 Lisp_Object prev_pos, front_sticky;
1731 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
1733 if (NILP (buffer))
1734 XSETBUFFER (buffer, current_buffer);
1736 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
1737 /* Consider previous character. */
1739 Lisp_Object rear_non_sticky;
1741 prev_pos = make_number (XINT (pos) - 1);
1742 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1744 if (!NILP (CONSP (rear_non_sticky)
1745 ? Fmemq (prop, rear_non_sticky)
1746 : rear_non_sticky))
1747 /* PROP is rear-non-sticky. */
1748 is_rear_sticky = 0;
1750 else
1751 return 0;
1753 /* Consider following character. */
1754 /* This signals an arg-out-of-range error if pos is outside the
1755 buffer's accessible range. */
1756 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1758 if (EQ (front_sticky, Qt)
1759 || (CONSP (front_sticky)
1760 && !NILP (Fmemq (prop, front_sticky))))
1761 /* PROP is inherited from after. */
1762 is_front_sticky = 1;
1764 /* Simple cases, where the properties are consistent. */
1765 if (is_rear_sticky && !is_front_sticky)
1766 return -1;
1767 else if (!is_rear_sticky && is_front_sticky)
1768 return 1;
1769 else if (!is_rear_sticky && !is_front_sticky)
1770 return 0;
1772 /* The stickiness properties are inconsistent, so we have to
1773 disambiguate. Basically, rear-sticky wins, _except_ if the
1774 property that would be inherited has a value of nil, in which case
1775 front-sticky wins. */
1776 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1777 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1778 return 1;
1779 else
1780 return -1;
1784 /* I don't think this is the right interface to export; how often do you
1785 want to do something like this, other than when you're copying objects
1786 around?
1788 I think it would be better to have a pair of functions, one which
1789 returns the text properties of a region as a list of ranges and
1790 plists, and another which applies such a list to another object. */
1792 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1793 SRC and DEST may each refer to strings or buffers.
1794 Optional sixth argument PROP causes only that property to be copied.
1795 Properties are copied to DEST as if by `add-text-properties'.
1796 Return t if any property value actually changed, nil otherwise. */
1798 /* Note this can GC when DEST is a buffer. */
1800 Lisp_Object
1801 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1803 INTERVAL i;
1804 Lisp_Object res;
1805 Lisp_Object stuff;
1806 Lisp_Object plist;
1807 EMACS_INT s, e, e2, p, len;
1808 int modified = 0;
1809 struct gcpro gcpro1, gcpro2;
1811 i = validate_interval_range (src, &start, &end, soft);
1812 if (NULL_INTERVAL_P (i))
1813 return Qnil;
1815 CHECK_NUMBER_COERCE_MARKER (pos);
1817 Lisp_Object dest_start, dest_end;
1819 dest_start = pos;
1820 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
1821 /* Apply this to a copy of pos; it will try to increment its arguments,
1822 which we don't want. */
1823 validate_interval_range (dest, &dest_start, &dest_end, soft);
1826 s = XINT (start);
1827 e = XINT (end);
1828 p = XINT (pos);
1830 stuff = Qnil;
1832 while (s < e)
1834 e2 = i->position + LENGTH (i);
1835 if (e2 > e)
1836 e2 = e;
1837 len = e2 - s;
1839 plist = i->plist;
1840 if (! NILP (prop))
1841 while (! NILP (plist))
1843 if (EQ (Fcar (plist), prop))
1845 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1846 break;
1848 plist = Fcdr (Fcdr (plist));
1850 if (! NILP (plist))
1852 /* Must defer modifications to the interval tree in case src
1853 and dest refer to the same string or buffer. */
1854 stuff = Fcons (Fcons (make_number (p),
1855 Fcons (make_number (p + len),
1856 Fcons (plist, Qnil))),
1857 stuff);
1860 i = next_interval (i);
1861 if (NULL_INTERVAL_P (i))
1862 break;
1864 p += len;
1865 s = i->position;
1868 GCPRO2 (stuff, dest);
1870 while (! NILP (stuff))
1872 res = Fcar (stuff);
1873 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1874 Fcar (Fcdr (Fcdr (res))), dest);
1875 if (! NILP (res))
1876 modified++;
1877 stuff = Fcdr (stuff);
1880 UNGCPRO;
1882 return modified ? Qt : Qnil;
1886 /* Return a list representing the text properties of OBJECT between
1887 START and END. if PROP is non-nil, report only on that property.
1888 Each result list element has the form (S E PLIST), where S and E
1889 are positions in OBJECT and PLIST is a property list containing the
1890 text properties of OBJECT between S and E. Value is nil if OBJECT
1891 doesn't contain text properties between START and END. */
1893 Lisp_Object
1894 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
1896 struct interval *i;
1897 Lisp_Object result;
1899 result = Qnil;
1901 i = validate_interval_range (object, &start, &end, soft);
1902 if (!NULL_INTERVAL_P (i))
1904 EMACS_INT s = XINT (start);
1905 EMACS_INT e = XINT (end);
1907 while (s < e)
1909 EMACS_INT interval_end, len;
1910 Lisp_Object plist;
1912 interval_end = i->position + LENGTH (i);
1913 if (interval_end > e)
1914 interval_end = e;
1915 len = interval_end - s;
1917 plist = i->plist;
1919 if (!NILP (prop))
1920 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
1921 if (EQ (XCAR (plist), prop))
1923 plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
1924 break;
1927 if (!NILP (plist))
1928 result = Fcons (Fcons (make_number (s),
1929 Fcons (make_number (s + len),
1930 Fcons (plist, Qnil))),
1931 result);
1933 i = next_interval (i);
1934 if (NULL_INTERVAL_P (i))
1935 break;
1936 s = i->position;
1940 return result;
1944 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1945 (START END PLIST), where START and END are positions and PLIST is a
1946 property list containing the text properties to add. Adjust START
1947 and END positions by DELTA before adding properties. Value is
1948 non-zero if OBJECT was modified. */
1951 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
1953 struct gcpro gcpro1, gcpro2;
1954 int modified_p = 0;
1956 GCPRO2 (list, object);
1958 for (; CONSP (list); list = XCDR (list))
1960 Lisp_Object item, start, end, plist, tem;
1962 item = XCAR (list);
1963 start = make_number (XINT (XCAR (item)) + XINT (delta));
1964 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
1965 plist = XCAR (XCDR (XCDR (item)));
1967 tem = Fadd_text_properties (start, end, plist, object);
1968 if (!NILP (tem))
1969 modified_p = 1;
1972 UNGCPRO;
1973 return modified_p;
1978 /* Modify end-points of ranges in LIST destructively, and return the
1979 new list. LIST is a list as returned from text_property_list.
1980 Discard properties that begin at or after NEW_END, and limit
1981 end-points to NEW_END. */
1983 Lisp_Object
1984 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
1986 Lisp_Object prev = Qnil, head = list;
1987 EMACS_INT max = XINT (new_end);
1989 for (; CONSP (list); prev = list, list = XCDR (list))
1991 Lisp_Object item, beg, end;
1993 item = XCAR (list);
1994 beg = XCAR (item);
1995 end = XCAR (XCDR (item));
1997 if (XINT (beg) >= max)
1999 /* The start-point is past the end of the new string.
2000 Discard this property. */
2001 if (EQ (head, list))
2002 head = XCDR (list);
2003 else
2004 XSETCDR (prev, XCDR (list));
2006 else if (XINT (end) > max)
2007 /* The end-point is past the end of the new string. */
2008 XSETCAR (XCDR (item), new_end);
2011 return head;
2016 /* Call the modification hook functions in LIST, each with START and END. */
2018 static void
2019 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
2021 struct gcpro gcpro1;
2022 GCPRO1 (list);
2023 while (!NILP (list))
2025 call2 (Fcar (list), start, end);
2026 list = Fcdr (list);
2028 UNGCPRO;
2031 /* Check for read-only intervals between character positions START ... END,
2032 in BUF, and signal an error if we find one.
2034 Then check for any modification hooks in the range.
2035 Create a list of all these hooks in lexicographic order,
2036 eliminating consecutive extra copies of the same hook. Then call
2037 those hooks in order, with START and END - 1 as arguments. */
2039 void
2040 verify_interval_modification (struct buffer *buf, int start, int end)
2042 register INTERVAL intervals = BUF_INTERVALS (buf);
2043 register INTERVAL i;
2044 Lisp_Object hooks;
2045 register Lisp_Object prev_mod_hooks;
2046 Lisp_Object mod_hooks;
2047 struct gcpro gcpro1;
2049 hooks = Qnil;
2050 prev_mod_hooks = Qnil;
2051 mod_hooks = Qnil;
2053 interval_insert_behind_hooks = Qnil;
2054 interval_insert_in_front_hooks = Qnil;
2056 if (NULL_INTERVAL_P (intervals))
2057 return;
2059 if (start > end)
2061 EMACS_INT temp = start;
2062 start = end;
2063 end = temp;
2066 /* For an insert operation, check the two chars around the position. */
2067 if (start == end)
2069 INTERVAL prev = NULL;
2070 Lisp_Object before, after;
2072 /* Set I to the interval containing the char after START,
2073 and PREV to the interval containing the char before START.
2074 Either one may be null. They may be equal. */
2075 i = find_interval (intervals, start);
2077 if (start == BUF_BEGV (buf))
2078 prev = 0;
2079 else if (i->position == start)
2080 prev = previous_interval (i);
2081 else if (i->position < start)
2082 prev = i;
2083 if (start == BUF_ZV (buf))
2084 i = 0;
2086 /* If Vinhibit_read_only is set and is not a list, we can
2087 skip the read_only checks. */
2088 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2090 /* If I and PREV differ we need to check for the read-only
2091 property together with its stickiness. If either I or
2092 PREV are 0, this check is all we need.
2093 We have to take special care, since read-only may be
2094 indirectly defined via the category property. */
2095 if (i != prev)
2097 if (! NULL_INTERVAL_P (i))
2099 after = textget (i->plist, Qread_only);
2101 /* If interval I is read-only and read-only is
2102 front-sticky, inhibit insertion.
2103 Check for read-only as well as category. */
2104 if (! NILP (after)
2105 && NILP (Fmemq (after, Vinhibit_read_only)))
2107 Lisp_Object tem;
2109 tem = textget (i->plist, Qfront_sticky);
2110 if (TMEM (Qread_only, tem)
2111 || (NILP (Fplist_get (i->plist, Qread_only))
2112 && TMEM (Qcategory, tem)))
2113 text_read_only (after);
2117 if (! NULL_INTERVAL_P (prev))
2119 before = textget (prev->plist, Qread_only);
2121 /* If interval PREV is read-only and read-only isn't
2122 rear-nonsticky, inhibit insertion.
2123 Check for read-only as well as category. */
2124 if (! NILP (before)
2125 && NILP (Fmemq (before, Vinhibit_read_only)))
2127 Lisp_Object tem;
2129 tem = textget (prev->plist, Qrear_nonsticky);
2130 if (! TMEM (Qread_only, tem)
2131 && (! NILP (Fplist_get (prev->plist,Qread_only))
2132 || ! TMEM (Qcategory, tem)))
2133 text_read_only (before);
2137 else if (! NULL_INTERVAL_P (i))
2139 after = textget (i->plist, Qread_only);
2141 /* If interval I is read-only and read-only is
2142 front-sticky, inhibit insertion.
2143 Check for read-only as well as category. */
2144 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2146 Lisp_Object tem;
2148 tem = textget (i->plist, Qfront_sticky);
2149 if (TMEM (Qread_only, tem)
2150 || (NILP (Fplist_get (i->plist, Qread_only))
2151 && TMEM (Qcategory, tem)))
2152 text_read_only (after);
2154 tem = textget (prev->plist, Qrear_nonsticky);
2155 if (! TMEM (Qread_only, tem)
2156 && (! NILP (Fplist_get (prev->plist, Qread_only))
2157 || ! TMEM (Qcategory, tem)))
2158 text_read_only (after);
2163 /* Run both insert hooks (just once if they're the same). */
2164 if (!NULL_INTERVAL_P (prev))
2165 interval_insert_behind_hooks
2166 = textget (prev->plist, Qinsert_behind_hooks);
2167 if (!NULL_INTERVAL_P (i))
2168 interval_insert_in_front_hooks
2169 = textget (i->plist, Qinsert_in_front_hooks);
2171 else
2173 /* Loop over intervals on or next to START...END,
2174 collecting their hooks. */
2176 i = find_interval (intervals, start);
2179 if (! INTERVAL_WRITABLE_P (i))
2180 text_read_only (textget (i->plist, Qread_only));
2182 if (!inhibit_modification_hooks)
2184 mod_hooks = textget (i->plist, Qmodification_hooks);
2185 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2187 hooks = Fcons (mod_hooks, hooks);
2188 prev_mod_hooks = mod_hooks;
2192 i = next_interval (i);
2194 /* Keep going thru the interval containing the char before END. */
2195 while (! NULL_INTERVAL_P (i) && i->position < end);
2197 if (!inhibit_modification_hooks)
2199 GCPRO1 (hooks);
2200 hooks = Fnreverse (hooks);
2201 while (! EQ (hooks, Qnil))
2203 call_mod_hooks (Fcar (hooks), make_number (start),
2204 make_number (end));
2205 hooks = Fcdr (hooks);
2207 UNGCPRO;
2212 /* Run the interval hooks for an insertion on character range START ... END.
2213 verify_interval_modification chose which hooks to run;
2214 this function is called after the insertion happens
2215 so it can indicate the range of inserted text. */
2217 void
2218 report_interval_modification (Lisp_Object start, Lisp_Object end)
2220 if (! NILP (interval_insert_behind_hooks))
2221 call_mod_hooks (interval_insert_behind_hooks, start, end);
2222 if (! NILP (interval_insert_in_front_hooks)
2223 && ! EQ (interval_insert_in_front_hooks,
2224 interval_insert_behind_hooks))
2225 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2228 void
2229 syms_of_textprop (void)
2231 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2232 doc: /* Property-list used as default values.
2233 The value of a property in this list is seen as the value for every
2234 character that does not have its own value for that property. */);
2235 Vdefault_text_properties = Qnil;
2237 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2238 doc: /* Alist of alternative properties for properties without a value.
2239 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2240 If a piece of text has no direct value for a particular property, then
2241 this alist is consulted. If that property appears in the alist, then
2242 the first non-nil value from the associated alternative properties is
2243 returned. */);
2244 Vchar_property_alias_alist = Qnil;
2246 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2247 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2248 This also inhibits the use of the `intangible' text property. */);
2249 Vinhibit_point_motion_hooks = Qnil;
2251 DEFVAR_LISP ("text-property-default-nonsticky",
2252 Vtext_property_default_nonsticky,
2253 doc: /* Alist of properties vs the corresponding non-stickinesses.
2254 Each element has the form (PROPERTY . NONSTICKINESS).
2256 If a character in a buffer has PROPERTY, new text inserted adjacent to
2257 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2258 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2259 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2260 /* Text property `syntax-table' should be nonsticky by default. */
2261 Vtext_property_default_nonsticky
2262 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), Qnil);
2264 staticpro (&interval_insert_behind_hooks);
2265 staticpro (&interval_insert_in_front_hooks);
2266 interval_insert_behind_hooks = Qnil;
2267 interval_insert_in_front_hooks = Qnil;
2270 /* Common attributes one might give text */
2272 staticpro (&Qforeground);
2273 Qforeground = intern_c_string ("foreground");
2274 staticpro (&Qbackground);
2275 Qbackground = intern_c_string ("background");
2276 staticpro (&Qfont);
2277 Qfont = intern_c_string ("font");
2278 staticpro (&Qstipple);
2279 Qstipple = intern_c_string ("stipple");
2280 staticpro (&Qunderline);
2281 Qunderline = intern_c_string ("underline");
2282 staticpro (&Qread_only);
2283 Qread_only = intern_c_string ("read-only");
2284 staticpro (&Qinvisible);
2285 Qinvisible = intern_c_string ("invisible");
2286 staticpro (&Qintangible);
2287 Qintangible = intern_c_string ("intangible");
2288 staticpro (&Qcategory);
2289 Qcategory = intern_c_string ("category");
2290 staticpro (&Qlocal_map);
2291 Qlocal_map = intern_c_string ("local-map");
2292 staticpro (&Qfront_sticky);
2293 Qfront_sticky = intern_c_string ("front-sticky");
2294 staticpro (&Qrear_nonsticky);
2295 Qrear_nonsticky = intern_c_string ("rear-nonsticky");
2296 staticpro (&Qmouse_face);
2297 Qmouse_face = intern_c_string ("mouse-face");
2298 staticpro (&Qminibuffer_prompt);
2299 Qminibuffer_prompt = intern_c_string ("minibuffer-prompt");
2301 /* Properties that text might use to specify certain actions */
2303 staticpro (&Qmouse_left);
2304 Qmouse_left = intern_c_string ("mouse-left");
2305 staticpro (&Qmouse_entered);
2306 Qmouse_entered = intern_c_string ("mouse-entered");
2307 staticpro (&Qpoint_left);
2308 Qpoint_left = intern_c_string ("point-left");
2309 staticpro (&Qpoint_entered);
2310 Qpoint_entered = intern_c_string ("point-entered");
2312 defsubr (&Stext_properties_at);
2313 defsubr (&Sget_text_property);
2314 defsubr (&Sget_char_property);
2315 defsubr (&Sget_char_property_and_overlay);
2316 defsubr (&Snext_char_property_change);
2317 defsubr (&Sprevious_char_property_change);
2318 defsubr (&Snext_single_char_property_change);
2319 defsubr (&Sprevious_single_char_property_change);
2320 defsubr (&Snext_property_change);
2321 defsubr (&Snext_single_property_change);
2322 defsubr (&Sprevious_property_change);
2323 defsubr (&Sprevious_single_property_change);
2324 defsubr (&Sadd_text_properties);
2325 defsubr (&Sput_text_property);
2326 defsubr (&Sset_text_properties);
2327 defsubr (&Sremove_text_properties);
2328 defsubr (&Sremove_list_of_text_properties);
2329 defsubr (&Stext_property_any);
2330 defsubr (&Stext_property_not_all);
2331 /* defsubr (&Serase_text_properties); */
2332 /* defsubr (&Scopy_text_properties); */