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