]> code.delx.au - gnu-emacs/blob - src/textprop.c
Fix bug #13743 with crashes due to recursive add-text-properties.
[gnu-emacs] / src / textprop.c
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
3 Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 #include "lisp.h"
23 #include "intervals.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "window.h"
27
28 /* Test for membership, allowing for t (actually any non-cons) to mean the
29 universal set. */
30
31 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
32 \f
33
34 /* NOTES: previous- and next- property change will have to skip
35 zero-length intervals if they are implemented. This could be done
36 inside next_interval and previous_interval.
37
38 set_properties needs to deal with the interval property cache.
39
40 It is assumed that for any interval plist, a property appears
41 only once on the list. Although some code i.e., remove_properties,
42 handles the more general case, the uniqueness of properties is
43 necessary for the system to remain consistent. This requirement
44 is enforced by the subrs installing properties onto the intervals. */
45
46 \f
47 /* Types of hooks. */
48 static Lisp_Object Qmouse_left;
49 static Lisp_Object Qmouse_entered;
50 Lisp_Object Qpoint_left;
51 Lisp_Object Qpoint_entered;
52 Lisp_Object Qcategory;
53 Lisp_Object Qlocal_map;
54
55 /* Visual properties text (including strings) may have. */
56 static Lisp_Object Qforeground, Qbackground, Qunderline;
57 Lisp_Object Qfont;
58 static Lisp_Object Qstipple;
59 Lisp_Object Qinvisible, Qintangible, Qmouse_face;
60 static Lisp_Object Qread_only;
61 Lisp_Object Qminibuffer_prompt;
62
63 /* Sticky properties */
64 Lisp_Object Qfront_sticky, Qrear_nonsticky;
65
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
67 the o1's cdr. Otherwise, return zero. This is handy for
68 traversing plists. */
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
70
71 /* verify_interval_modification saves insertion hooks here
72 to be run later by report_interval_modification. */
73 static Lisp_Object interval_insert_behind_hooks;
74 static Lisp_Object interval_insert_in_front_hooks;
75
76
77 /* Signal a `text-read-only' error. This function makes it easier
78 to capture that error in GDB by putting a breakpoint on it. */
79
80 static _Noreturn void
81 text_read_only (Lisp_Object propval)
82 {
83 if (STRINGP (propval))
84 xsignal1 (Qtext_read_only, propval);
85
86 xsignal0 (Qtext_read_only);
87 }
88
89 /* Prepare to modify the region of BUFFER from START to END. */
90
91 static void
92 modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
93 {
94 struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
95
96 set_buffer_internal (buf);
97 modify_region_1 (XINT (start), XINT (end), true);
98 set_buffer_internal (old);
99 }
100
101 /* Extract the interval at the position pointed to by BEGIN from
102 OBJECT, a string or buffer. Additionally, check that the positions
103 pointed to by BEGIN and END are within the bounds of OBJECT, and
104 reverse them if *BEGIN is greater than *END. The objects pointed
105 to by BEGIN and END may be integers or markers; if the latter, they
106 are coerced to integers.
107
108 When OBJECT is a string, we increment *BEGIN and *END
109 to make them origin-one.
110
111 Note that buffer points don't correspond to interval indices.
112 For example, point-max is 1 greater than the index of the last
113 character. This difference is handled in the caller, which uses
114 the validated points to determine a length, and operates on that.
115 Exceptions are Ftext_properties_at, Fnext_property_change, and
116 Fprevious_property_change which call this function with BEGIN == END.
117 Handle this case specially.
118
119 If FORCE is soft (0), it's OK to return NULL. Otherwise,
120 create an interval tree for OBJECT if one doesn't exist, provided
121 the object actually contains text. In the current design, if there
122 is no text, there can be no text properties. */
123
124 #define soft 0
125 #define hard 1
126
127 INTERVAL
128 validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
129 {
130 register INTERVAL i;
131 ptrdiff_t searchpos;
132
133 CHECK_STRING_OR_BUFFER (object);
134 CHECK_NUMBER_COERCE_MARKER (*begin);
135 CHECK_NUMBER_COERCE_MARKER (*end);
136
137 /* If we are asked for a point, but from a subr which operates
138 on a range, then return nothing. */
139 if (EQ (*begin, *end) && begin != end)
140 return NULL;
141
142 if (XINT (*begin) > XINT (*end))
143 {
144 Lisp_Object n;
145 n = *begin;
146 *begin = *end;
147 *end = n;
148 }
149
150 if (BUFFERP (object))
151 {
152 register struct buffer *b = XBUFFER (object);
153
154 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
155 && XINT (*end) <= BUF_ZV (b)))
156 args_out_of_range (*begin, *end);
157 i = buffer_intervals (b);
158
159 /* If there's no text, there are no properties. */
160 if (BUF_BEGV (b) == BUF_ZV (b))
161 return NULL;
162
163 searchpos = XINT (*begin);
164 }
165 else
166 {
167 ptrdiff_t len = SCHARS (object);
168
169 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
170 && XINT (*end) <= len))
171 args_out_of_range (*begin, *end);
172 XSETFASTINT (*begin, XFASTINT (*begin));
173 if (begin != end)
174 XSETFASTINT (*end, XFASTINT (*end));
175 i = string_intervals (object);
176
177 if (len == 0)
178 return NULL;
179
180 searchpos = XINT (*begin);
181 }
182
183 if (!i)
184 return (force ? create_root_interval (object) : i);
185
186 return find_interval (i, searchpos);
187 }
188
189 /* Validate LIST as a property list. If LIST is not a list, then
190 make one consisting of (LIST nil). Otherwise, verify that LIST
191 is even numbered and thus suitable as a plist. */
192
193 static Lisp_Object
194 validate_plist (Lisp_Object list)
195 {
196 if (NILP (list))
197 return Qnil;
198
199 if (CONSP (list))
200 {
201 register int i;
202 register Lisp_Object tail;
203 for (i = 0, tail = list; CONSP (tail); i++)
204 {
205 tail = XCDR (tail);
206 QUIT;
207 }
208 if (i & 1)
209 error ("Odd length text property list");
210 return list;
211 }
212
213 return Fcons (list, Fcons (Qnil, Qnil));
214 }
215
216 /* Return nonzero if interval I has all the properties,
217 with the same values, of list PLIST. */
218
219 static int
220 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
221 {
222 register Lisp_Object tail1, tail2, sym1;
223 register int found;
224
225 /* Go through each element of PLIST. */
226 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
227 {
228 sym1 = XCAR (tail1);
229 found = 0;
230
231 /* Go through I's plist, looking for sym1 */
232 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
233 if (EQ (sym1, XCAR (tail2)))
234 {
235 /* Found the same property on both lists. If the
236 values are unequal, return zero. */
237 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
238 return 0;
239
240 /* Property has same value on both lists; go to next one. */
241 found = 1;
242 break;
243 }
244
245 if (! found)
246 return 0;
247 }
248
249 return 1;
250 }
251
252 /* Return nonzero if the plist of interval I has any of the
253 properties of PLIST, regardless of their values. */
254
255 static int
256 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
257 {
258 register Lisp_Object tail1, tail2, sym;
259
260 /* Go through each element of PLIST. */
261 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
262 {
263 sym = XCAR (tail1);
264
265 /* Go through i's plist, looking for tail1 */
266 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
267 if (EQ (sym, XCAR (tail2)))
268 return 1;
269 }
270
271 return 0;
272 }
273
274 /* Return nonzero if the plist of interval I has any of the
275 property names in LIST, regardless of their values. */
276
277 static int
278 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
279 {
280 register Lisp_Object tail1, tail2, sym;
281
282 /* Go through each element of LIST. */
283 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
284 {
285 sym = XCAR (tail1);
286
287 /* Go through i's plist, looking for tail1 */
288 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
289 if (EQ (sym, XCAR (tail2)))
290 return 1;
291 }
292
293 return 0;
294 }
295 \f
296 /* Changing the plists of individual intervals. */
297
298 /* Return the value of PROP in property-list PLIST, or Qunbound if it
299 has none. */
300 static Lisp_Object
301 property_value (Lisp_Object plist, Lisp_Object prop)
302 {
303 Lisp_Object value;
304
305 while (PLIST_ELT_P (plist, value))
306 if (EQ (XCAR (plist), prop))
307 return XCAR (value);
308 else
309 plist = XCDR (value);
310
311 return Qunbound;
312 }
313
314 /* Set the properties of INTERVAL to PROPERTIES,
315 and record undo info for the previous values.
316 OBJECT is the string or buffer that INTERVAL belongs to. */
317
318 static void
319 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
320 {
321 Lisp_Object sym, value;
322
323 if (BUFFERP (object))
324 {
325 /* For each property in the old plist which is missing from PROPERTIES,
326 or has a different value in PROPERTIES, make an undo record. */
327 for (sym = interval->plist;
328 PLIST_ELT_P (sym, value);
329 sym = XCDR (value))
330 if (! EQ (property_value (properties, XCAR (sym)),
331 XCAR (value)))
332 {
333 record_property_change (interval->position, LENGTH (interval),
334 XCAR (sym), XCAR (value),
335 object);
336 }
337
338 /* For each new property that has no value at all in the old plist,
339 make an undo record binding it to nil, so it will be removed. */
340 for (sym = properties;
341 PLIST_ELT_P (sym, value);
342 sym = XCDR (value))
343 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
344 {
345 record_property_change (interval->position, LENGTH (interval),
346 XCAR (sym), Qnil,
347 object);
348 }
349 }
350
351 /* Store new properties. */
352 set_interval_plist (interval, Fcopy_sequence (properties));
353 }
354
355 /* Add the properties of PLIST to the interval I, or set
356 the value of I's property to the value of the property on PLIST
357 if they are different.
358
359 OBJECT should be the string or buffer the interval is in.
360
361 Return nonzero if this changes I (i.e., if any members of PLIST
362 are actually added to I's plist) */
363
364 static int
365 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
366 {
367 Lisp_Object tail1, tail2, sym1, val1;
368 register int changed = 0;
369 register int found;
370 struct gcpro gcpro1, gcpro2, gcpro3;
371
372 tail1 = plist;
373 sym1 = Qnil;
374 val1 = Qnil;
375 /* No need to protect OBJECT, because we can GC only in the case
376 where it is a buffer, and live buffers are always protected.
377 I and its plist are also protected, via OBJECT. */
378 GCPRO3 (tail1, sym1, val1);
379
380 /* Go through each element of PLIST. */
381 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
382 {
383 sym1 = XCAR (tail1);
384 val1 = Fcar (XCDR (tail1));
385 found = 0;
386
387 /* Go through I's plist, looking for sym1 */
388 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
389 if (EQ (sym1, XCAR (tail2)))
390 {
391 /* No need to gcpro, because tail2 protects this
392 and it must be a cons cell (we get an error otherwise). */
393 register Lisp_Object this_cdr;
394
395 this_cdr = XCDR (tail2);
396 /* Found the property. Now check its value. */
397 found = 1;
398
399 /* The properties have the same value on both lists.
400 Continue to the next property. */
401 if (EQ (val1, Fcar (this_cdr)))
402 break;
403
404 /* Record this change in the buffer, for undo purposes. */
405 if (BUFFERP (object))
406 {
407 record_property_change (i->position, LENGTH (i),
408 sym1, Fcar (this_cdr), object);
409 }
410
411 /* I's property has a different value -- change it */
412 Fsetcar (this_cdr, val1);
413 changed++;
414 break;
415 }
416
417 if (! found)
418 {
419 /* Record this change in the buffer, for undo purposes. */
420 if (BUFFERP (object))
421 {
422 record_property_change (i->position, LENGTH (i),
423 sym1, Qnil, object);
424 }
425 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
426 changed++;
427 }
428 }
429
430 UNGCPRO;
431
432 return changed;
433 }
434
435 /* For any members of PLIST, or LIST,
436 which are properties of I, remove them from I's plist.
437 (If PLIST is non-nil, use that, otherwise use LIST.)
438 OBJECT is the string or buffer containing I. */
439
440 static int
441 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
442 {
443 register Lisp_Object tail1, tail2, sym, current_plist;
444 register int changed = 0;
445
446 /* Nonzero means tail1 is a plist, otherwise it is a list. */
447 int use_plist;
448
449 current_plist = i->plist;
450
451 if (! NILP (plist))
452 tail1 = plist, use_plist = 1;
453 else
454 tail1 = list, use_plist = 0;
455
456 /* Go through each element of LIST or PLIST. */
457 while (CONSP (tail1))
458 {
459 sym = XCAR (tail1);
460
461 /* First, remove the symbol if it's at the head of the list */
462 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
463 {
464 if (BUFFERP (object))
465 record_property_change (i->position, LENGTH (i),
466 sym, XCAR (XCDR (current_plist)),
467 object);
468
469 current_plist = XCDR (XCDR (current_plist));
470 changed++;
471 }
472
473 /* Go through I's plist, looking for SYM. */
474 tail2 = current_plist;
475 while (! NILP (tail2))
476 {
477 register Lisp_Object this;
478 this = XCDR (XCDR (tail2));
479 if (CONSP (this) && EQ (sym, XCAR (this)))
480 {
481 if (BUFFERP (object))
482 record_property_change (i->position, LENGTH (i),
483 sym, XCAR (XCDR (this)), object);
484
485 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
486 changed++;
487 }
488 tail2 = this;
489 }
490
491 /* Advance thru TAIL1 one way or the other. */
492 tail1 = XCDR (tail1);
493 if (use_plist && CONSP (tail1))
494 tail1 = XCDR (tail1);
495 }
496
497 if (changed)
498 set_interval_plist (i, current_plist);
499 return changed;
500 }
501 \f
502 /* Returns the interval of POSITION in OBJECT.
503 POSITION is BEG-based. */
504
505 INTERVAL
506 interval_of (ptrdiff_t position, Lisp_Object object)
507 {
508 register INTERVAL i;
509 ptrdiff_t beg, end;
510
511 if (NILP (object))
512 XSETBUFFER (object, current_buffer);
513 else if (EQ (object, Qt))
514 return NULL;
515
516 CHECK_STRING_OR_BUFFER (object);
517
518 if (BUFFERP (object))
519 {
520 register struct buffer *b = XBUFFER (object);
521
522 beg = BUF_BEGV (b);
523 end = BUF_ZV (b);
524 i = buffer_intervals (b);
525 }
526 else
527 {
528 beg = 0;
529 end = SCHARS (object);
530 i = string_intervals (object);
531 }
532
533 if (!(beg <= position && position <= end))
534 args_out_of_range (make_number (position), make_number (position));
535 if (beg == end || !i)
536 return NULL;
537
538 return find_interval (i, position);
539 }
540 \f
541 DEFUN ("text-properties-at", Ftext_properties_at,
542 Stext_properties_at, 1, 2, 0,
543 doc: /* Return the list of properties of the character at POSITION in OBJECT.
544 If the optional second argument OBJECT is a buffer (or nil, which means
545 the current buffer), POSITION is a buffer position (integer or marker).
546 If OBJECT is a string, POSITION is a 0-based index into it.
547 If POSITION is at the end of OBJECT, the value is nil. */)
548 (Lisp_Object position, Lisp_Object object)
549 {
550 register INTERVAL i;
551
552 if (NILP (object))
553 XSETBUFFER (object, current_buffer);
554
555 i = validate_interval_range (object, &position, &position, soft);
556 if (!i)
557 return Qnil;
558 /* If POSITION is at the end of the interval,
559 it means it's the end of OBJECT.
560 There are no properties at the very end,
561 since no character follows. */
562 if (XINT (position) == LENGTH (i) + i->position)
563 return Qnil;
564
565 return i->plist;
566 }
567
568 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
569 doc: /* Return the value of POSITION's property PROP, in OBJECT.
570 OBJECT should be a buffer or a string; if omitted or nil, it defaults
571 to the current buffer.
572 If POSITION is at the end of OBJECT, the value is nil. */)
573 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
574 {
575 return textget (Ftext_properties_at (position, object), prop);
576 }
577
578 /* Return the value of char's property PROP, in OBJECT at POSITION.
579 OBJECT is optional and defaults to the current buffer.
580 If OVERLAY is non-0, then in the case that the returned property is from
581 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
582 returned in *OVERLAY.
583 If POSITION is at the end of OBJECT, the value is nil.
584 If OBJECT is a buffer, then overlay properties are considered as well as
585 text properties.
586 If OBJECT is a window, then that window's buffer is used, but
587 window-specific overlays are considered only if they are associated
588 with OBJECT. */
589 Lisp_Object
590 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
591 {
592 struct window *w = 0;
593
594 CHECK_NUMBER_COERCE_MARKER (position);
595
596 if (NILP (object))
597 XSETBUFFER (object, current_buffer);
598
599 if (WINDOWP (object))
600 {
601 w = XWINDOW (object);
602 object = w->buffer;
603 }
604 if (BUFFERP (object))
605 {
606 ptrdiff_t noverlays;
607 Lisp_Object *overlay_vec;
608 struct buffer *obuf = current_buffer;
609
610 if (XINT (position) < BUF_BEGV (XBUFFER (object))
611 || XINT (position) > BUF_ZV (XBUFFER (object)))
612 xsignal1 (Qargs_out_of_range, position);
613
614 set_buffer_temp (XBUFFER (object));
615
616 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
617 noverlays = sort_overlays (overlay_vec, noverlays, w);
618
619 set_buffer_temp (obuf);
620
621 /* Now check the overlays in order of decreasing priority. */
622 while (--noverlays >= 0)
623 {
624 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
625 if (!NILP (tem))
626 {
627 if (overlay)
628 /* Return the overlay we got the property from. */
629 *overlay = overlay_vec[noverlays];
630 return tem;
631 }
632 }
633 }
634
635 if (overlay)
636 /* Indicate that the return value is not from an overlay. */
637 *overlay = Qnil;
638
639 /* Not a buffer, or no appropriate overlay, so fall through to the
640 simpler case. */
641 return Fget_text_property (position, prop, object);
642 }
643
644 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
645 doc: /* Return the value of POSITION's property PROP, in OBJECT.
646 Both overlay properties and text properties are checked.
647 OBJECT is optional and defaults to the current buffer.
648 If POSITION is at the end of OBJECT, the value is nil.
649 If OBJECT is a buffer, then overlay properties are considered as well as
650 text properties.
651 If OBJECT is a window, then that window's buffer is used, but window-specific
652 overlays are considered only if they are associated with OBJECT. */)
653 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
654 {
655 return get_char_property_and_overlay (position, prop, object, 0);
656 }
657
658 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
659 Sget_char_property_and_overlay, 2, 3, 0,
660 doc: /* Like `get-char-property', but with extra overlay information.
661 The value is a cons cell. Its car is the return value of `get-char-property'
662 with the same arguments--that is, the value of POSITION's property
663 PROP in OBJECT. Its cdr is the overlay in which the property was
664 found, or nil, if it was found as a text property or not found at all.
665
666 OBJECT is optional and defaults to the current buffer. OBJECT may be
667 a string, a buffer or a window. For strings, the cdr of the return
668 value is always nil, since strings do not have overlays. If OBJECT is
669 a window, then that window's buffer is used, but window-specific
670 overlays are considered only if they are associated with OBJECT. If
671 POSITION is at the end of OBJECT, both car and cdr are nil. */)
672 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
673 {
674 Lisp_Object overlay;
675 Lisp_Object val
676 = get_char_property_and_overlay (position, prop, object, &overlay);
677 return Fcons (val, overlay);
678 }
679
680 \f
681 DEFUN ("next-char-property-change", Fnext_char_property_change,
682 Snext_char_property_change, 1, 2, 0,
683 doc: /* Return the position of next text property or overlay change.
684 This scans characters forward in the current buffer from POSITION till
685 it finds a change in some text property, or the beginning or end of an
686 overlay, and returns the position of that.
687 If none is found up to (point-max), the function returns (point-max).
688
689 If the optional second argument LIMIT is non-nil, don't search
690 past position LIMIT; return LIMIT if nothing is found before LIMIT.
691 LIMIT is a no-op if it is greater than (point-max). */)
692 (Lisp_Object position, Lisp_Object limit)
693 {
694 Lisp_Object temp;
695
696 temp = Fnext_overlay_change (position);
697 if (! NILP (limit))
698 {
699 CHECK_NUMBER_COERCE_MARKER (limit);
700 if (XINT (limit) < XINT (temp))
701 temp = limit;
702 }
703 return Fnext_property_change (position, Qnil, temp);
704 }
705
706 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
707 Sprevious_char_property_change, 1, 2, 0,
708 doc: /* Return the position of previous text property or overlay change.
709 Scans characters backward in the current buffer from POSITION till it
710 finds a change in some text property, or the beginning or end of an
711 overlay, and returns the position of that.
712 If none is found since (point-min), the function returns (point-min).
713
714 If the optional second argument LIMIT is non-nil, don't search
715 past position LIMIT; return LIMIT if nothing is found before LIMIT.
716 LIMIT is a no-op if it is less than (point-min). */)
717 (Lisp_Object position, Lisp_Object limit)
718 {
719 Lisp_Object temp;
720
721 temp = Fprevious_overlay_change (position);
722 if (! NILP (limit))
723 {
724 CHECK_NUMBER_COERCE_MARKER (limit);
725 if (XINT (limit) > XINT (temp))
726 temp = limit;
727 }
728 return Fprevious_property_change (position, Qnil, temp);
729 }
730
731
732 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
733 Snext_single_char_property_change, 2, 4, 0,
734 doc: /* Return the position of next text property or overlay change for a specific property.
735 Scans characters forward from POSITION till it finds
736 a change in the PROP property, then returns the position of the change.
737 If the optional third argument OBJECT is a buffer (or nil, which means
738 the current buffer), POSITION is a buffer position (integer or marker).
739 If OBJECT is a string, POSITION is a 0-based index into it.
740
741 In a string, scan runs to the end of the string.
742 In a buffer, it runs to (point-max), and the value cannot exceed that.
743
744 The property values are compared with `eq'.
745 If the property is constant all the way to the end of OBJECT, return the
746 last valid position in OBJECT.
747 If the optional fourth argument LIMIT is non-nil, don't search
748 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
749 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
750 {
751 if (STRINGP (object))
752 {
753 position = Fnext_single_property_change (position, prop, object, limit);
754 if (NILP (position))
755 {
756 if (NILP (limit))
757 position = make_number (SCHARS (object));
758 else
759 {
760 CHECK_NUMBER (limit);
761 position = limit;
762 }
763 }
764 }
765 else
766 {
767 Lisp_Object initial_value, value;
768 ptrdiff_t count = SPECPDL_INDEX ();
769
770 if (! NILP (object))
771 CHECK_BUFFER (object);
772
773 if (BUFFERP (object) && current_buffer != XBUFFER (object))
774 {
775 record_unwind_current_buffer ();
776 Fset_buffer (object);
777 }
778
779 CHECK_NUMBER_COERCE_MARKER (position);
780
781 initial_value = Fget_char_property (position, prop, object);
782
783 if (NILP (limit))
784 XSETFASTINT (limit, ZV);
785 else
786 CHECK_NUMBER_COERCE_MARKER (limit);
787
788 if (XFASTINT (position) >= XFASTINT (limit))
789 {
790 position = limit;
791 if (XFASTINT (position) > ZV)
792 XSETFASTINT (position, ZV);
793 }
794 else
795 while (1)
796 {
797 position = Fnext_char_property_change (position, limit);
798 if (XFASTINT (position) >= XFASTINT (limit))
799 {
800 position = limit;
801 break;
802 }
803
804 value = Fget_char_property (position, prop, object);
805 if (!EQ (value, initial_value))
806 break;
807 }
808
809 unbind_to (count, Qnil);
810 }
811
812 return position;
813 }
814
815 DEFUN ("previous-single-char-property-change",
816 Fprevious_single_char_property_change,
817 Sprevious_single_char_property_change, 2, 4, 0,
818 doc: /* Return the position of previous text property or overlay change for a specific property.
819 Scans characters backward from POSITION till it finds
820 a change in the PROP property, then returns the position of the change.
821 If the optional third argument OBJECT is a buffer (or nil, which means
822 the current buffer), POSITION is a buffer position (integer or marker).
823 If OBJECT is a string, POSITION is a 0-based index into it.
824
825 In a string, scan runs to the start of the string.
826 In a buffer, it runs to (point-min), and the value cannot be less than that.
827
828 The property values are compared with `eq'.
829 If the property is constant all the way to the start of OBJECT, return the
830 first valid position in OBJECT.
831 If the optional fourth argument LIMIT is non-nil, don't search back past
832 position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
833 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
834 {
835 if (STRINGP (object))
836 {
837 position = Fprevious_single_property_change (position, prop, object, limit);
838 if (NILP (position))
839 {
840 if (NILP (limit))
841 position = make_number (0);
842 else
843 {
844 CHECK_NUMBER (limit);
845 position = limit;
846 }
847 }
848 }
849 else
850 {
851 ptrdiff_t count = SPECPDL_INDEX ();
852
853 if (! NILP (object))
854 CHECK_BUFFER (object);
855
856 if (BUFFERP (object) && current_buffer != XBUFFER (object))
857 {
858 record_unwind_current_buffer ();
859 Fset_buffer (object);
860 }
861
862 CHECK_NUMBER_COERCE_MARKER (position);
863
864 if (NILP (limit))
865 XSETFASTINT (limit, BEGV);
866 else
867 CHECK_NUMBER_COERCE_MARKER (limit);
868
869 if (XFASTINT (position) <= XFASTINT (limit))
870 {
871 position = limit;
872 if (XFASTINT (position) < BEGV)
873 XSETFASTINT (position, BEGV);
874 }
875 else
876 {
877 Lisp_Object initial_value
878 = Fget_char_property (make_number (XFASTINT (position) - 1),
879 prop, object);
880
881 while (1)
882 {
883 position = Fprevious_char_property_change (position, limit);
884
885 if (XFASTINT (position) <= XFASTINT (limit))
886 {
887 position = limit;
888 break;
889 }
890 else
891 {
892 Lisp_Object value
893 = Fget_char_property (make_number (XFASTINT (position) - 1),
894 prop, object);
895
896 if (!EQ (value, initial_value))
897 break;
898 }
899 }
900 }
901
902 unbind_to (count, Qnil);
903 }
904
905 return position;
906 }
907 \f
908 DEFUN ("next-property-change", Fnext_property_change,
909 Snext_property_change, 1, 3, 0,
910 doc: /* Return the position of next property change.
911 Scans characters forward from POSITION in OBJECT till it finds
912 a change in some text property, then returns the position of the change.
913 If the optional second argument OBJECT is a buffer (or nil, which means
914 the current buffer), POSITION is a buffer position (integer or marker).
915 If OBJECT is a string, POSITION is a 0-based index into it.
916 Return nil if the property is constant all the way to the end of OBJECT.
917 If the value is non-nil, it is a position greater than POSITION, never equal.
918
919 If the optional third argument LIMIT is non-nil, don't search
920 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
921 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
922 {
923 register INTERVAL i, next;
924
925 if (NILP (object))
926 XSETBUFFER (object, current_buffer);
927
928 if (!NILP (limit) && !EQ (limit, Qt))
929 CHECK_NUMBER_COERCE_MARKER (limit);
930
931 i = validate_interval_range (object, &position, &position, soft);
932
933 /* If LIMIT is t, return start of next interval--don't
934 bother checking further intervals. */
935 if (EQ (limit, Qt))
936 {
937 if (!i)
938 next = i;
939 else
940 next = next_interval (i);
941
942 if (!next)
943 XSETFASTINT (position, (STRINGP (object)
944 ? SCHARS (object)
945 : BUF_ZV (XBUFFER (object))));
946 else
947 XSETFASTINT (position, next->position);
948 return position;
949 }
950
951 if (!i)
952 return limit;
953
954 next = next_interval (i);
955
956 while (next && intervals_equal (i, next)
957 && (NILP (limit) || next->position < XFASTINT (limit)))
958 next = next_interval (next);
959
960 if (!next
961 || (next->position
962 >= (INTEGERP (limit)
963 ? XFASTINT (limit)
964 : (STRINGP (object)
965 ? SCHARS (object)
966 : BUF_ZV (XBUFFER (object))))))
967 return limit;
968 else
969 return make_number (next->position);
970 }
971
972 DEFUN ("next-single-property-change", Fnext_single_property_change,
973 Snext_single_property_change, 2, 4, 0,
974 doc: /* Return the position of next property change for a specific property.
975 Scans characters forward from POSITION till it finds
976 a change in the PROP property, then returns the position of the change.
977 If the optional third argument OBJECT is a buffer (or nil, which means
978 the current buffer), POSITION is a buffer position (integer or marker).
979 If OBJECT is a string, POSITION is a 0-based index into it.
980 The property values are compared with `eq'.
981 Return nil if the property is constant all the way to the end of OBJECT.
982 If the value is non-nil, it is a position greater than POSITION, never equal.
983
984 If the optional fourth argument LIMIT is non-nil, don't search
985 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
986 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
987 {
988 register INTERVAL i, next;
989 register Lisp_Object here_val;
990
991 if (NILP (object))
992 XSETBUFFER (object, current_buffer);
993
994 if (!NILP (limit))
995 CHECK_NUMBER_COERCE_MARKER (limit);
996
997 i = validate_interval_range (object, &position, &position, soft);
998 if (!i)
999 return limit;
1000
1001 here_val = textget (i->plist, prop);
1002 next = next_interval (i);
1003 while (next
1004 && EQ (here_val, textget (next->plist, prop))
1005 && (NILP (limit) || next->position < XFASTINT (limit)))
1006 next = next_interval (next);
1007
1008 if (!next
1009 || (next->position
1010 >= (INTEGERP (limit)
1011 ? XFASTINT (limit)
1012 : (STRINGP (object)
1013 ? SCHARS (object)
1014 : BUF_ZV (XBUFFER (object))))))
1015 return limit;
1016 else
1017 return make_number (next->position);
1018 }
1019
1020 DEFUN ("previous-property-change", Fprevious_property_change,
1021 Sprevious_property_change, 1, 3, 0,
1022 doc: /* Return the position of previous property change.
1023 Scans characters backwards from POSITION in OBJECT till it finds
1024 a change in some text property, then returns the position of the change.
1025 If the optional second argument OBJECT is a buffer (or nil, which means
1026 the current buffer), POSITION is a buffer position (integer or marker).
1027 If OBJECT is a string, POSITION is a 0-based index into it.
1028 Return nil if the property is constant all the way to the start of OBJECT.
1029 If the value is non-nil, it is a position less than POSITION, never equal.
1030
1031 If the optional third argument LIMIT is non-nil, don't search
1032 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1033 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
1034 {
1035 register INTERVAL i, previous;
1036
1037 if (NILP (object))
1038 XSETBUFFER (object, current_buffer);
1039
1040 if (!NILP (limit))
1041 CHECK_NUMBER_COERCE_MARKER (limit);
1042
1043 i = validate_interval_range (object, &position, &position, soft);
1044 if (!i)
1045 return limit;
1046
1047 /* Start with the interval containing the char before point. */
1048 if (i->position == XFASTINT (position))
1049 i = previous_interval (i);
1050
1051 previous = previous_interval (i);
1052 while (previous && intervals_equal (previous, i)
1053 && (NILP (limit)
1054 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1055 previous = previous_interval (previous);
1056
1057 if (!previous
1058 || (previous->position + LENGTH (previous)
1059 <= (INTEGERP (limit)
1060 ? XFASTINT (limit)
1061 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1062 return limit;
1063 else
1064 return make_number (previous->position + LENGTH (previous));
1065 }
1066
1067 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
1068 Sprevious_single_property_change, 2, 4, 0,
1069 doc: /* Return the position of previous property change for a specific property.
1070 Scans characters backward from POSITION till it finds
1071 a change in the PROP property, then returns the position of the change.
1072 If the optional third argument OBJECT is a buffer (or nil, which means
1073 the current buffer), POSITION is a buffer position (integer or marker).
1074 If OBJECT is a string, POSITION is a 0-based index into it.
1075 The property values are compared with `eq'.
1076 Return nil if the property is constant all the way to the start of OBJECT.
1077 If the value is non-nil, it is a position less than POSITION, never equal.
1078
1079 If the optional fourth argument LIMIT is non-nil, don't search
1080 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
1081 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
1082 {
1083 register INTERVAL i, previous;
1084 register Lisp_Object here_val;
1085
1086 if (NILP (object))
1087 XSETBUFFER (object, current_buffer);
1088
1089 if (!NILP (limit))
1090 CHECK_NUMBER_COERCE_MARKER (limit);
1091
1092 i = validate_interval_range (object, &position, &position, soft);
1093
1094 /* Start with the interval containing the char before point. */
1095 if (i && i->position == XFASTINT (position))
1096 i = previous_interval (i);
1097
1098 if (!i)
1099 return limit;
1100
1101 here_val = textget (i->plist, prop);
1102 previous = previous_interval (i);
1103 while (previous
1104 && EQ (here_val, textget (previous->plist, prop))
1105 && (NILP (limit)
1106 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
1107 previous = previous_interval (previous);
1108
1109 if (!previous
1110 || (previous->position + LENGTH (previous)
1111 <= (INTEGERP (limit)
1112 ? XFASTINT (limit)
1113 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1114 return limit;
1115 else
1116 return make_number (previous->position + LENGTH (previous));
1117 }
1118 \f
1119 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1120
1121 DEFUN ("add-text-properties", Fadd_text_properties,
1122 Sadd_text_properties, 3, 4, 0,
1123 doc: /* Add properties to the text from START to END.
1124 The third argument PROPERTIES is a property list
1125 specifying the property values to add. If the optional fourth argument
1126 OBJECT is a buffer (or nil, which means the current buffer),
1127 START and END are buffer positions (integers or markers).
1128 If OBJECT is a string, START and END are 0-based indices into it.
1129 Return t if any property value actually changed, nil otherwise. */)
1130 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1131 {
1132 register INTERVAL i, unchanged;
1133 register ptrdiff_t s, len;
1134 register int modified = 0;
1135 struct gcpro gcpro1;
1136 ptrdiff_t got;
1137
1138 properties = validate_plist (properties);
1139 if (NILP (properties))
1140 return Qnil;
1141
1142 if (NILP (object))
1143 XSETBUFFER (object, current_buffer);
1144
1145 i = validate_interval_range (object, &start, &end, hard);
1146 if (!i)
1147 return Qnil;
1148
1149 s = XINT (start);
1150 len = XINT (end) - s;
1151
1152 /* No need to protect OBJECT, because we GC only if it's a buffer,
1153 and live buffers are always protected. */
1154 GCPRO1 (properties);
1155
1156 /* If this interval already has the properties, we can skip it. */
1157 if (interval_has_all_properties (properties, i))
1158 {
1159 got = LENGTH (i) - (s - i->position);
1160 do {
1161 if (got >= len)
1162 RETURN_UNGCPRO (Qnil);
1163 len -= got;
1164 i = next_interval (i);
1165 got = LENGTH (i);
1166 } while (interval_has_all_properties (properties, i));
1167 }
1168 else if (i->position != s)
1169 {
1170 /* If we're not starting on an interval boundary, we have to
1171 split this interval. */
1172 unchanged = i;
1173 i = split_interval_right (unchanged, s - unchanged->position);
1174 copy_properties (unchanged, i);
1175 }
1176
1177 if (BUFFERP (object))
1178 modify_region (object, start, end);
1179
1180 /* We are at the beginning of interval I, with LEN chars to scan. */
1181 for (;;)
1182 {
1183 eassert (i != 0);
1184
1185 if (LENGTH (i) >= len)
1186 {
1187 /* We can UNGCPRO safely here, because there will be just
1188 one more chance to gc, in the next call to add_properties,
1189 and after that we will not need PROPERTIES or OBJECT again. */
1190 UNGCPRO;
1191
1192 if (interval_has_all_properties (properties, i))
1193 {
1194 if (BUFFERP (object))
1195 signal_after_change (XINT (start), XINT (end) - XINT (start),
1196 XINT (end) - XINT (start));
1197
1198 eassert (modified);
1199 return Qt;
1200 }
1201
1202 if (LENGTH (i) == len)
1203 {
1204 add_properties (properties, i, object);
1205 if (BUFFERP (object))
1206 signal_after_change (XINT (start), XINT (end) - XINT (start),
1207 XINT (end) - XINT (start));
1208 return Qt;
1209 }
1210
1211 /* i doesn't have the properties, and goes past the change limit */
1212 unchanged = i;
1213 i = split_interval_left (unchanged, len);
1214 copy_properties (unchanged, i);
1215 add_properties (properties, i, object);
1216 if (BUFFERP (object))
1217 signal_after_change (XINT (start), XINT (end) - XINT (start),
1218 XINT (end) - XINT (start));
1219 return Qt;
1220 }
1221
1222 len -= LENGTH (i);
1223 modified += add_properties (properties, i, object);
1224 i = next_interval (i);
1225 }
1226 }
1227
1228 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
1229
1230 DEFUN ("put-text-property", Fput_text_property,
1231 Sput_text_property, 4, 5, 0,
1232 doc: /* Set one property of the text from START to END.
1233 The third and fourth arguments PROPERTY and VALUE
1234 specify the property to add.
1235 If the optional fifth argument OBJECT is a buffer (or nil, which means
1236 the current buffer), START and END are buffer positions (integers or
1237 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1238 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1239 {
1240 Fadd_text_properties (start, end,
1241 Fcons (property, Fcons (value, Qnil)),
1242 object);
1243 return Qnil;
1244 }
1245
1246 DEFUN ("set-text-properties", Fset_text_properties,
1247 Sset_text_properties, 3, 4, 0,
1248 doc: /* Completely replace properties of text from START to END.
1249 The third argument PROPERTIES is the new property list.
1250 If the optional fourth argument OBJECT is a buffer (or nil, which means
1251 the current buffer), START and END are buffer positions (integers or
1252 markers). If OBJECT is a string, START and END are 0-based indices into it.
1253 If PROPERTIES is nil, the effect is to remove all properties from
1254 the designated part of OBJECT. */)
1255 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1256 {
1257 return set_text_properties (start, end, properties, object, Qt);
1258 }
1259
1260
1261 /* Replace properties of text from START to END with new list of
1262 properties PROPERTIES. OBJECT is the buffer or string containing
1263 the text. OBJECT nil means use the current buffer.
1264 COHERENT_CHANGE_P nil means this is being called as an internal
1265 subroutine, rather than as a change primitive with checking of
1266 read-only, invoking change hooks, etc.. Value is nil if the
1267 function _detected_ that it did not replace any properties, non-nil
1268 otherwise. */
1269
1270 Lisp_Object
1271 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p)
1272 {
1273 register INTERVAL i;
1274 Lisp_Object ostart, oend;
1275
1276 ostart = start;
1277 oend = end;
1278
1279 properties = validate_plist (properties);
1280
1281 if (NILP (object))
1282 XSETBUFFER (object, current_buffer);
1283
1284 /* If we want no properties for a whole string,
1285 get rid of its intervals. */
1286 if (NILP (properties) && STRINGP (object)
1287 && XFASTINT (start) == 0
1288 && XFASTINT (end) == SCHARS (object))
1289 {
1290 if (!string_intervals (object))
1291 return Qnil;
1292
1293 set_string_intervals (object, NULL);
1294 return Qt;
1295 }
1296
1297 i = validate_interval_range (object, &start, &end, soft);
1298
1299 if (!i)
1300 {
1301 /* If buffer has no properties, and we want none, return now. */
1302 if (NILP (properties))
1303 return Qnil;
1304
1305 /* Restore the original START and END values
1306 because validate_interval_range increments them for strings. */
1307 start = ostart;
1308 end = oend;
1309
1310 i = validate_interval_range (object, &start, &end, hard);
1311 /* This can return if start == end. */
1312 if (!i)
1313 return Qnil;
1314 }
1315
1316 if (BUFFERP (object) && !NILP (coherent_change_p))
1317 modify_region (object, start, end);
1318
1319 set_text_properties_1 (start, end, properties, object, i);
1320
1321 if (BUFFERP (object) && !NILP (coherent_change_p))
1322 signal_after_change (XINT (start), XINT (end) - XINT (start),
1323 XINT (end) - XINT (start));
1324 return Qt;
1325 }
1326
1327 /* Replace properties of text from START to END with new list of
1328 properties PROPERTIES. OBJECT is the buffer or string containing
1329 the text. This does not obey any hooks.
1330 You should provide the interval that START is located in as I.
1331 START and END can be in any order. */
1332
1333 void
1334 set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
1335 {
1336 register INTERVAL prev_changed = NULL;
1337 register ptrdiff_t s, len;
1338 INTERVAL unchanged;
1339
1340 if (XINT (start) < XINT (end))
1341 {
1342 s = XINT (start);
1343 len = XINT (end) - s;
1344 }
1345 else if (XINT (end) < XINT (start))
1346 {
1347 s = XINT (end);
1348 len = XINT (start) - s;
1349 }
1350 else
1351 return;
1352
1353 eassert (i);
1354
1355 if (i->position != s)
1356 {
1357 unchanged = i;
1358 i = split_interval_right (unchanged, s - unchanged->position);
1359
1360 if (LENGTH (i) > len)
1361 {
1362 copy_properties (unchanged, i);
1363 i = split_interval_left (i, len);
1364 set_properties (properties, i, object);
1365 return;
1366 }
1367
1368 set_properties (properties, i, object);
1369
1370 if (LENGTH (i) == len)
1371 return;
1372
1373 prev_changed = i;
1374 len -= LENGTH (i);
1375 i = next_interval (i);
1376 }
1377
1378 /* We are starting at the beginning of an interval I. LEN is positive. */
1379 do
1380 {
1381 eassert (i != 0);
1382
1383 if (LENGTH (i) >= len)
1384 {
1385 if (LENGTH (i) > len)
1386 i = split_interval_left (i, len);
1387
1388 /* We have to call set_properties even if we are going to
1389 merge the intervals, so as to make the undo records
1390 and cause redisplay to happen. */
1391 set_properties (properties, i, object);
1392 if (prev_changed)
1393 merge_interval_left (i);
1394 return;
1395 }
1396
1397 len -= LENGTH (i);
1398
1399 /* We have to call set_properties even if we are going to
1400 merge the intervals, so as to make the undo records
1401 and cause redisplay to happen. */
1402 set_properties (properties, i, object);
1403 if (!prev_changed)
1404 prev_changed = i;
1405 else
1406 prev_changed = i = merge_interval_left (i);
1407
1408 i = next_interval (i);
1409 }
1410 while (len > 0);
1411 }
1412
1413 DEFUN ("remove-text-properties", Fremove_text_properties,
1414 Sremove_text_properties, 3, 4, 0,
1415 doc: /* Remove some properties from text from START to END.
1416 The third argument PROPERTIES is a property list
1417 whose property names specify the properties to remove.
1418 \(The values stored in PROPERTIES are ignored.)
1419 If the optional fourth argument OBJECT is a buffer (or nil, which means
1420 the current buffer), START and END are buffer positions (integers or
1421 markers). If OBJECT is a string, START and END are 0-based indices into it.
1422 Return t if any property was actually removed, nil otherwise.
1423
1424 Use `set-text-properties' if you want to remove all text properties. */)
1425 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
1426 {
1427 register INTERVAL i, unchanged;
1428 register ptrdiff_t s, len;
1429 register int modified = 0;
1430 ptrdiff_t got;
1431
1432 if (NILP (object))
1433 XSETBUFFER (object, current_buffer);
1434
1435 i = validate_interval_range (object, &start, &end, soft);
1436 if (!i)
1437 return Qnil;
1438
1439 s = XINT (start);
1440 len = XINT (end) - s;
1441
1442 /* If there are no properties on this entire interval, return. */
1443 if (! interval_has_some_properties (properties, i))
1444 {
1445 got = (LENGTH (i) - (s - i->position));
1446 do {
1447 if (got >= len)
1448 return Qnil;
1449 len -= got;
1450 i = next_interval (i);
1451 got = LENGTH (i);
1452 } while (! interval_has_some_properties (properties, i));
1453 }
1454 /* Split away the beginning of this interval; what we don't
1455 want to modify. */
1456 else if (i->position != s)
1457 {
1458 unchanged = i;
1459 i = split_interval_right (unchanged, s - unchanged->position);
1460 copy_properties (unchanged, i);
1461 }
1462
1463 if (BUFFERP (object))
1464 modify_region (object, start, end);
1465
1466 /* We are at the beginning of an interval, with len to scan */
1467 for (;;)
1468 {
1469 eassert (i != 0);
1470
1471 if (LENGTH (i) >= len)
1472 {
1473 if (! interval_has_some_properties (properties, i))
1474 {
1475 eassert (modified);
1476 if (BUFFERP (object))
1477 signal_after_change (XINT (start), XINT (end) - XINT (start),
1478 XINT (end) - XINT (start));
1479 return Qt;
1480 }
1481
1482 if (LENGTH (i) == len)
1483 {
1484 remove_properties (properties, Qnil, i, object);
1485 if (BUFFERP (object))
1486 signal_after_change (XINT (start), XINT (end) - XINT (start),
1487 XINT (end) - XINT (start));
1488 return Qt;
1489 }
1490
1491 /* i has the properties, and goes past the change limit */
1492 unchanged = i;
1493 i = split_interval_left (i, len);
1494 copy_properties (unchanged, i);
1495 remove_properties (properties, Qnil, i, object);
1496 if (BUFFERP (object))
1497 signal_after_change (XINT (start), XINT (end) - XINT (start),
1498 XINT (end) - XINT (start));
1499 return Qt;
1500 }
1501
1502 len -= LENGTH (i);
1503 modified += remove_properties (properties, Qnil, i, object);
1504 i = next_interval (i);
1505 }
1506 }
1507
1508 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
1509 Sremove_list_of_text_properties, 3, 4, 0,
1510 doc: /* Remove some properties from text from START to END.
1511 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
1512 If the optional fourth argument OBJECT is a buffer (or nil, which means
1513 the current buffer), START and END are buffer positions (integers or
1514 markers). If OBJECT is a string, START and END are 0-based indices into it.
1515 Return t if any property was actually removed, nil otherwise. */)
1516 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
1517 {
1518 register INTERVAL i, unchanged;
1519 register ptrdiff_t s, len;
1520 register int modified = 0;
1521 Lisp_Object properties;
1522 ptrdiff_t got;
1523 properties = list_of_properties;
1524
1525 if (NILP (object))
1526 XSETBUFFER (object, current_buffer);
1527
1528 i = validate_interval_range (object, &start, &end, soft);
1529 if (!i)
1530 return Qnil;
1531
1532 s = XINT (start);
1533 len = XINT (end) - s;
1534
1535 /* If there are no properties on the interval, return. */
1536 if (! interval_has_some_properties_list (properties, i))
1537 {
1538 got = (LENGTH (i) - (s - i->position));
1539 do {
1540 if (got >= len)
1541 return Qnil;
1542 len -= got;
1543 i = next_interval (i);
1544 got = LENGTH (i);
1545 } while (! interval_has_some_properties_list (properties, i));
1546 }
1547 /* Split away the beginning of this interval; what we don't
1548 want to modify. */
1549 else if (i->position != s)
1550 {
1551 unchanged = i;
1552 i = split_interval_right (unchanged, s - unchanged->position);
1553 copy_properties (unchanged, i);
1554 }
1555
1556 /* We are at the beginning of an interval, with len to scan.
1557 The flag `modified' records if changes have been made.
1558 When object is a buffer, we must call modify_region before changes are
1559 made and signal_after_change when we are done.
1560 We call modify_region before calling remove_properties if modified == 0,
1561 and we call signal_after_change before returning if modified != 0. */
1562 for (;;)
1563 {
1564 eassert (i != 0);
1565
1566 if (LENGTH (i) >= len)
1567 {
1568 if (! interval_has_some_properties_list (properties, i))
1569 {
1570 if (modified)
1571 {
1572 if (BUFFERP (object))
1573 signal_after_change (XINT (start),
1574 XINT (end) - XINT (start),
1575 XINT (end) - XINT (start));
1576 return Qt;
1577 }
1578 else
1579 return Qnil;
1580 }
1581 else if (LENGTH (i) == len)
1582 {
1583 if (!modified && BUFFERP (object))
1584 modify_region (object, start, end);
1585 remove_properties (Qnil, properties, i, object);
1586 if (BUFFERP (object))
1587 signal_after_change (XINT (start), XINT (end) - XINT (start),
1588 XINT (end) - XINT (start));
1589 return Qt;
1590 }
1591 else
1592 { /* i has the properties, and goes past the change limit. */
1593 unchanged = i;
1594 i = split_interval_left (i, len);
1595 copy_properties (unchanged, i);
1596 if (!modified && BUFFERP (object))
1597 modify_region (object, start, end);
1598 remove_properties (Qnil, properties, i, object);
1599 if (BUFFERP (object))
1600 signal_after_change (XINT (start), XINT (end) - XINT (start),
1601 XINT (end) - XINT (start));
1602 return Qt;
1603 }
1604 }
1605 if (interval_has_some_properties_list (properties, i))
1606 {
1607 if (!modified && BUFFERP (object))
1608 modify_region (object, start, end);
1609 remove_properties (Qnil, properties, i, object);
1610 modified = 1;
1611 }
1612 len -= LENGTH (i);
1613 i = next_interval (i);
1614 }
1615 }
1616 \f
1617 DEFUN ("text-property-any", Ftext_property_any,
1618 Stext_property_any, 4, 5, 0,
1619 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
1620 If so, return the position of the first character whose property PROPERTY
1621 is `eq' to VALUE. Otherwise return nil.
1622 If the optional fifth argument OBJECT is a buffer (or nil, which means
1623 the current buffer), START and END are buffer positions (integers or
1624 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1625 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1626 {
1627 register INTERVAL i;
1628 register ptrdiff_t e, pos;
1629
1630 if (NILP (object))
1631 XSETBUFFER (object, current_buffer);
1632 i = validate_interval_range (object, &start, &end, soft);
1633 if (!i)
1634 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1635 e = XINT (end);
1636
1637 while (i)
1638 {
1639 if (i->position >= e)
1640 break;
1641 if (EQ (textget (i->plist, property), value))
1642 {
1643 pos = i->position;
1644 if (pos < XINT (start))
1645 pos = XINT (start);
1646 return make_number (pos);
1647 }
1648 i = next_interval (i);
1649 }
1650 return Qnil;
1651 }
1652
1653 DEFUN ("text-property-not-all", Ftext_property_not_all,
1654 Stext_property_not_all, 4, 5, 0,
1655 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
1656 If so, return the position of the first character whose property PROPERTY
1657 is not `eq' to VALUE. Otherwise, return nil.
1658 If the optional fifth argument OBJECT is a buffer (or nil, which means
1659 the current buffer), START and END are buffer positions (integers or
1660 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
1661 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
1662 {
1663 register INTERVAL i;
1664 register ptrdiff_t s, e;
1665
1666 if (NILP (object))
1667 XSETBUFFER (object, current_buffer);
1668 i = validate_interval_range (object, &start, &end, soft);
1669 if (!i)
1670 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1671 s = XINT (start);
1672 e = XINT (end);
1673
1674 while (i)
1675 {
1676 if (i->position >= e)
1677 break;
1678 if (! EQ (textget (i->plist, property), value))
1679 {
1680 if (i->position > s)
1681 s = i->position;
1682 return make_number (s);
1683 }
1684 i = next_interval (i);
1685 }
1686 return Qnil;
1687 }
1688
1689 \f
1690 /* Return the direction from which the text-property PROP would be
1691 inherited by any new text inserted at POS: 1 if it would be
1692 inherited from the char after POS, -1 if it would be inherited from
1693 the char before POS, and 0 if from neither.
1694 BUFFER can be either a buffer or nil (meaning current buffer). */
1695
1696 int
1697 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
1698 {
1699 Lisp_Object prev_pos, front_sticky;
1700 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
1701 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
1702
1703 if (NILP (buffer))
1704 XSETBUFFER (buffer, current_buffer);
1705
1706 if (CONSP (defalt) && !NILP (XCDR (defalt)))
1707 is_rear_sticky = 0;
1708
1709 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
1710 /* Consider previous character. */
1711 {
1712 Lisp_Object rear_non_sticky;
1713
1714 prev_pos = make_number (XINT (pos) - 1);
1715 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
1716
1717 if (!NILP (CONSP (rear_non_sticky)
1718 ? Fmemq (prop, rear_non_sticky)
1719 : rear_non_sticky))
1720 /* PROP is rear-non-sticky. */
1721 is_rear_sticky = 0;
1722 }
1723 else
1724 return 0;
1725
1726 /* Consider following character. */
1727 /* This signals an arg-out-of-range error if pos is outside the
1728 buffer's accessible range. */
1729 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
1730
1731 if (EQ (front_sticky, Qt)
1732 || (CONSP (front_sticky)
1733 && !NILP (Fmemq (prop, front_sticky))))
1734 /* PROP is inherited from after. */
1735 is_front_sticky = 1;
1736
1737 /* Simple cases, where the properties are consistent. */
1738 if (is_rear_sticky && !is_front_sticky)
1739 return -1;
1740 else if (!is_rear_sticky && is_front_sticky)
1741 return 1;
1742 else if (!is_rear_sticky && !is_front_sticky)
1743 return 0;
1744
1745 /* The stickiness properties are inconsistent, so we have to
1746 disambiguate. Basically, rear-sticky wins, _except_ if the
1747 property that would be inherited has a value of nil, in which case
1748 front-sticky wins. */
1749 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1750 || NILP (Fget_text_property (prev_pos, prop, buffer)))
1751 return 1;
1752 else
1753 return -1;
1754 }
1755
1756 \f
1757 /* Copying properties between objects. */
1758
1759 /* Add properties from START to END of SRC, starting at POS in DEST.
1760 SRC and DEST may each refer to strings or buffers.
1761 Optional sixth argument PROP causes only that property to be copied.
1762 Properties are copied to DEST as if by `add-text-properties'.
1763 Return t if any property value actually changed, nil otherwise. */
1764
1765 /* Note this can GC when DEST is a buffer. */
1766
1767 Lisp_Object
1768 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
1769 {
1770 INTERVAL i;
1771 Lisp_Object res;
1772 Lisp_Object stuff;
1773 Lisp_Object plist;
1774 ptrdiff_t s, e, e2, p, len;
1775 int modified = 0;
1776 struct gcpro gcpro1, gcpro2;
1777
1778 i = validate_interval_range (src, &start, &end, soft);
1779 if (!i)
1780 return Qnil;
1781
1782 CHECK_NUMBER_COERCE_MARKER (pos);
1783 {
1784 Lisp_Object dest_start, dest_end;
1785
1786 e = XINT (pos) + (XINT (end) - XINT (start));
1787 if (MOST_POSITIVE_FIXNUM < e)
1788 args_out_of_range (pos, end);
1789 dest_start = pos;
1790 XSETFASTINT (dest_end, e);
1791 /* Apply this to a copy of pos; it will try to increment its arguments,
1792 which we don't want. */
1793 validate_interval_range (dest, &dest_start, &dest_end, soft);
1794 }
1795
1796 s = XINT (start);
1797 e = XINT (end);
1798 p = XINT (pos);
1799
1800 stuff = Qnil;
1801
1802 while (s < e)
1803 {
1804 e2 = i->position + LENGTH (i);
1805 if (e2 > e)
1806 e2 = e;
1807 len = e2 - s;
1808
1809 plist = i->plist;
1810 if (! NILP (prop))
1811 while (! NILP (plist))
1812 {
1813 if (EQ (Fcar (plist), prop))
1814 {
1815 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1816 break;
1817 }
1818 plist = Fcdr (Fcdr (plist));
1819 }
1820 if (! NILP (plist))
1821 {
1822 /* Must defer modifications to the interval tree in case src
1823 and dest refer to the same string or buffer. */
1824 stuff = Fcons (Fcons (make_number (p),
1825 Fcons (make_number (p + len),
1826 Fcons (plist, Qnil))),
1827 stuff);
1828 }
1829
1830 i = next_interval (i);
1831 if (!i)
1832 break;
1833
1834 p += len;
1835 s = i->position;
1836 }
1837
1838 GCPRO2 (stuff, dest);
1839
1840 while (! NILP (stuff))
1841 {
1842 res = Fcar (stuff);
1843 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1844 Fcar (Fcdr (Fcdr (res))), dest);
1845 if (! NILP (res))
1846 modified++;
1847 stuff = Fcdr (stuff);
1848 }
1849
1850 UNGCPRO;
1851
1852 return modified ? Qt : Qnil;
1853 }
1854
1855
1856 /* Return a list representing the text properties of OBJECT between
1857 START and END. if PROP is non-nil, report only on that property.
1858 Each result list element has the form (S E PLIST), where S and E
1859 are positions in OBJECT and PLIST is a property list containing the
1860 text properties of OBJECT between S and E. Value is nil if OBJECT
1861 doesn't contain text properties between START and END. */
1862
1863 Lisp_Object
1864 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
1865 {
1866 struct interval *i;
1867 Lisp_Object result;
1868
1869 result = Qnil;
1870
1871 i = validate_interval_range (object, &start, &end, soft);
1872 if (i)
1873 {
1874 ptrdiff_t s = XINT (start);
1875 ptrdiff_t e = XINT (end);
1876
1877 while (s < e)
1878 {
1879 ptrdiff_t interval_end, len;
1880 Lisp_Object plist;
1881
1882 interval_end = i->position + LENGTH (i);
1883 if (interval_end > e)
1884 interval_end = e;
1885 len = interval_end - s;
1886
1887 plist = i->plist;
1888
1889 if (!NILP (prop))
1890 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
1891 if (EQ (XCAR (plist), prop))
1892 {
1893 plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
1894 break;
1895 }
1896
1897 if (!NILP (plist))
1898 result = Fcons (Fcons (make_number (s),
1899 Fcons (make_number (s + len),
1900 Fcons (plist, Qnil))),
1901 result);
1902
1903 i = next_interval (i);
1904 if (!i)
1905 break;
1906 s = i->position;
1907 }
1908 }
1909
1910 return result;
1911 }
1912
1913
1914 /* Add text properties to OBJECT from LIST. LIST is a list of triples
1915 (START END PLIST), where START and END are positions and PLIST is a
1916 property list containing the text properties to add. Adjust START
1917 and END positions by DELTA before adding properties. Value is
1918 non-zero if OBJECT was modified. */
1919
1920 int
1921 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
1922 {
1923 struct gcpro gcpro1, gcpro2;
1924 int modified_p = 0;
1925
1926 GCPRO2 (list, object);
1927
1928 for (; CONSP (list); list = XCDR (list))
1929 {
1930 Lisp_Object item, start, end, plist, tem;
1931
1932 item = XCAR (list);
1933 start = make_number (XINT (XCAR (item)) + XINT (delta));
1934 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
1935 plist = XCAR (XCDR (XCDR (item)));
1936
1937 tem = Fadd_text_properties (start, end, plist, object);
1938 if (!NILP (tem))
1939 modified_p = 1;
1940 }
1941
1942 UNGCPRO;
1943 return modified_p;
1944 }
1945
1946
1947
1948 /* Modify end-points of ranges in LIST destructively, and return the
1949 new list. LIST is a list as returned from text_property_list.
1950 Discard properties that begin at or after NEW_END, and limit
1951 end-points to NEW_END. */
1952
1953 Lisp_Object
1954 extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
1955 {
1956 Lisp_Object prev = Qnil, head = list;
1957 ptrdiff_t max = XINT (new_end);
1958
1959 for (; CONSP (list); prev = list, list = XCDR (list))
1960 {
1961 Lisp_Object item, beg, end;
1962
1963 item = XCAR (list);
1964 beg = XCAR (item);
1965 end = XCAR (XCDR (item));
1966
1967 if (XINT (beg) >= max)
1968 {
1969 /* The start-point is past the end of the new string.
1970 Discard this property. */
1971 if (EQ (head, list))
1972 head = XCDR (list);
1973 else
1974 XSETCDR (prev, XCDR (list));
1975 }
1976 else if (XINT (end) > max)
1977 /* The end-point is past the end of the new string. */
1978 XSETCAR (XCDR (item), new_end);
1979 }
1980
1981 return head;
1982 }
1983
1984
1985 \f
1986 /* Call the modification hook functions in LIST, each with START and END. */
1987
1988 static void
1989 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
1990 {
1991 struct gcpro gcpro1;
1992 GCPRO1 (list);
1993 while (!NILP (list))
1994 {
1995 call2 (Fcar (list), start, end);
1996 list = Fcdr (list);
1997 }
1998 UNGCPRO;
1999 }
2000
2001 /* Check for read-only intervals between character positions START ... END,
2002 in BUF, and signal an error if we find one.
2003
2004 Then check for any modification hooks in the range.
2005 Create a list of all these hooks in lexicographic order,
2006 eliminating consecutive extra copies of the same hook. Then call
2007 those hooks in order, with START and END - 1 as arguments. */
2008
2009 void
2010 verify_interval_modification (struct buffer *buf,
2011 ptrdiff_t start, ptrdiff_t end)
2012 {
2013 INTERVAL intervals = buffer_intervals (buf);
2014 INTERVAL i;
2015 Lisp_Object hooks;
2016 Lisp_Object prev_mod_hooks;
2017 Lisp_Object mod_hooks;
2018 struct gcpro gcpro1;
2019
2020 hooks = Qnil;
2021 prev_mod_hooks = Qnil;
2022 mod_hooks = Qnil;
2023
2024 interval_insert_behind_hooks = Qnil;
2025 interval_insert_in_front_hooks = Qnil;
2026
2027 if (!intervals)
2028 return;
2029
2030 if (start > end)
2031 {
2032 ptrdiff_t temp = start;
2033 start = end;
2034 end = temp;
2035 }
2036
2037 /* For an insert operation, check the two chars around the position. */
2038 if (start == end)
2039 {
2040 INTERVAL prev = NULL;
2041 Lisp_Object before, after;
2042
2043 /* Set I to the interval containing the char after START,
2044 and PREV to the interval containing the char before START.
2045 Either one may be null. They may be equal. */
2046 i = find_interval (intervals, start);
2047
2048 if (start == BUF_BEGV (buf))
2049 prev = 0;
2050 else if (i->position == start)
2051 prev = previous_interval (i);
2052 else if (i->position < start)
2053 prev = i;
2054 if (start == BUF_ZV (buf))
2055 i = 0;
2056
2057 /* If Vinhibit_read_only is set and is not a list, we can
2058 skip the read_only checks. */
2059 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2060 {
2061 /* If I and PREV differ we need to check for the read-only
2062 property together with its stickiness. If either I or
2063 PREV are 0, this check is all we need.
2064 We have to take special care, since read-only may be
2065 indirectly defined via the category property. */
2066 if (i != prev)
2067 {
2068 if (i)
2069 {
2070 after = textget (i->plist, Qread_only);
2071
2072 /* If interval I is read-only and read-only is
2073 front-sticky, inhibit insertion.
2074 Check for read-only as well as category. */
2075 if (! NILP (after)
2076 && NILP (Fmemq (after, Vinhibit_read_only)))
2077 {
2078 Lisp_Object tem;
2079
2080 tem = textget (i->plist, Qfront_sticky);
2081 if (TMEM (Qread_only, tem)
2082 || (NILP (Fplist_get (i->plist, Qread_only))
2083 && TMEM (Qcategory, tem)))
2084 text_read_only (after);
2085 }
2086 }
2087
2088 if (prev)
2089 {
2090 before = textget (prev->plist, Qread_only);
2091
2092 /* If interval PREV is read-only and read-only isn't
2093 rear-nonsticky, inhibit insertion.
2094 Check for read-only as well as category. */
2095 if (! NILP (before)
2096 && NILP (Fmemq (before, Vinhibit_read_only)))
2097 {
2098 Lisp_Object tem;
2099
2100 tem = textget (prev->plist, Qrear_nonsticky);
2101 if (! TMEM (Qread_only, tem)
2102 && (! NILP (Fplist_get (prev->plist,Qread_only))
2103 || ! TMEM (Qcategory, tem)))
2104 text_read_only (before);
2105 }
2106 }
2107 }
2108 else if (i)
2109 {
2110 after = textget (i->plist, Qread_only);
2111
2112 /* If interval I is read-only and read-only is
2113 front-sticky, inhibit insertion.
2114 Check for read-only as well as category. */
2115 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2116 {
2117 Lisp_Object tem;
2118
2119 tem = textget (i->plist, Qfront_sticky);
2120 if (TMEM (Qread_only, tem)
2121 || (NILP (Fplist_get (i->plist, Qread_only))
2122 && TMEM (Qcategory, tem)))
2123 text_read_only (after);
2124
2125 tem = textget (prev->plist, Qrear_nonsticky);
2126 if (! TMEM (Qread_only, tem)
2127 && (! NILP (Fplist_get (prev->plist, Qread_only))
2128 || ! TMEM (Qcategory, tem)))
2129 text_read_only (after);
2130 }
2131 }
2132 }
2133
2134 /* Run both insert hooks (just once if they're the same). */
2135 if (prev)
2136 interval_insert_behind_hooks
2137 = textget (prev->plist, Qinsert_behind_hooks);
2138 if (i)
2139 interval_insert_in_front_hooks
2140 = textget (i->plist, Qinsert_in_front_hooks);
2141 }
2142 else
2143 {
2144 /* Loop over intervals on or next to START...END,
2145 collecting their hooks. */
2146
2147 i = find_interval (intervals, start);
2148 do
2149 {
2150 if (! INTERVAL_WRITABLE_P (i))
2151 text_read_only (textget (i->plist, Qread_only));
2152
2153 if (!inhibit_modification_hooks)
2154 {
2155 mod_hooks = textget (i->plist, Qmodification_hooks);
2156 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2157 {
2158 hooks = Fcons (mod_hooks, hooks);
2159 prev_mod_hooks = mod_hooks;
2160 }
2161 }
2162
2163 i = next_interval (i);
2164 }
2165 /* Keep going thru the interval containing the char before END. */
2166 while (i && i->position < end);
2167
2168 if (!inhibit_modification_hooks)
2169 {
2170 GCPRO1 (hooks);
2171 hooks = Fnreverse (hooks);
2172 while (! EQ (hooks, Qnil))
2173 {
2174 call_mod_hooks (Fcar (hooks), make_number (start),
2175 make_number (end));
2176 hooks = Fcdr (hooks);
2177 }
2178 UNGCPRO;
2179 }
2180 }
2181 }
2182
2183 /* Run the interval hooks for an insertion on character range START ... END.
2184 verify_interval_modification chose which hooks to run;
2185 this function is called after the insertion happens
2186 so it can indicate the range of inserted text. */
2187
2188 void
2189 report_interval_modification (Lisp_Object start, Lisp_Object end)
2190 {
2191 if (! NILP (interval_insert_behind_hooks))
2192 call_mod_hooks (interval_insert_behind_hooks, start, end);
2193 if (! NILP (interval_insert_in_front_hooks)
2194 && ! EQ (interval_insert_in_front_hooks,
2195 interval_insert_behind_hooks))
2196 call_mod_hooks (interval_insert_in_front_hooks, start, end);
2197 }
2198 \f
2199 void
2200 syms_of_textprop (void)
2201 {
2202 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
2203 doc: /* Property-list used as default values.
2204 The value of a property in this list is seen as the value for every
2205 character that does not have its own value for that property. */);
2206 Vdefault_text_properties = Qnil;
2207
2208 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
2209 doc: /* Alist of alternative properties for properties without a value.
2210 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2211 If a piece of text has no direct value for a particular property, then
2212 this alist is consulted. If that property appears in the alist, then
2213 the first non-nil value from the associated alternative properties is
2214 returned. */);
2215 Vchar_property_alias_alist = Qnil;
2216
2217 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
2218 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2219 This also inhibits the use of the `intangible' text property. */);
2220 Vinhibit_point_motion_hooks = Qnil;
2221
2222 DEFVAR_LISP ("text-property-default-nonsticky",
2223 Vtext_property_default_nonsticky,
2224 doc: /* Alist of properties vs the corresponding non-stickiness.
2225 Each element has the form (PROPERTY . NONSTICKINESS).
2226
2227 If a character in a buffer has PROPERTY, new text inserted adjacent to
2228 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
2229 inherits it if NONSTICKINESS is nil. The `front-sticky' and
2230 `rear-nonsticky' properties of the character override NONSTICKINESS. */);
2231 /* Text properties `syntax-table'and `display' should be nonsticky
2232 by default. */
2233 Vtext_property_default_nonsticky
2234 = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
2235 Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
2236
2237 staticpro (&interval_insert_behind_hooks);
2238 staticpro (&interval_insert_in_front_hooks);
2239 interval_insert_behind_hooks = Qnil;
2240 interval_insert_in_front_hooks = Qnil;
2241
2242
2243 /* Common attributes one might give text */
2244
2245 DEFSYM (Qforeground, "foreground");
2246 DEFSYM (Qbackground, "background");
2247 DEFSYM (Qfont, "font");
2248 DEFSYM (Qstipple, "stipple");
2249 DEFSYM (Qunderline, "underline");
2250 DEFSYM (Qread_only, "read-only");
2251 DEFSYM (Qinvisible, "invisible");
2252 DEFSYM (Qintangible, "intangible");
2253 DEFSYM (Qcategory, "category");
2254 DEFSYM (Qlocal_map, "local-map");
2255 DEFSYM (Qfront_sticky, "front-sticky");
2256 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2257 DEFSYM (Qmouse_face, "mouse-face");
2258 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
2259
2260 /* Properties that text might use to specify certain actions */
2261
2262 DEFSYM (Qmouse_left, "mouse-left");
2263 DEFSYM (Qmouse_entered, "mouse-entered");
2264 DEFSYM (Qpoint_left, "point-left");
2265 DEFSYM (Qpoint_entered, "point-entered");
2266
2267 defsubr (&Stext_properties_at);
2268 defsubr (&Sget_text_property);
2269 defsubr (&Sget_char_property);
2270 defsubr (&Sget_char_property_and_overlay);
2271 defsubr (&Snext_char_property_change);
2272 defsubr (&Sprevious_char_property_change);
2273 defsubr (&Snext_single_char_property_change);
2274 defsubr (&Sprevious_single_char_property_change);
2275 defsubr (&Snext_property_change);
2276 defsubr (&Snext_single_property_change);
2277 defsubr (&Sprevious_property_change);
2278 defsubr (&Sprevious_single_property_change);
2279 defsubr (&Sadd_text_properties);
2280 defsubr (&Sput_text_property);
2281 defsubr (&Sset_text_properties);
2282 defsubr (&Sremove_text_properties);
2283 defsubr (&Sremove_list_of_text_properties);
2284 defsubr (&Stext_property_any);
2285 defsubr (&Stext_property_not_all);
2286 }