]> code.delx.au - gnu-emacs/blob - src/textprop.c
(Fnext_single_property_change): Rearrange handling of
[gnu-emacs] / src / textprop.c
1 /* Interface code for dealing with text properties.
2 Copyright (C) 1993, 1994, 1995 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 2, or (at your option)
9 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; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 #include <config.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 /* The rest of the file is within this conditional */
49 #ifdef USE_TEXT_PROPERTIES
50 \f
51 /* Types of hooks. */
52 Lisp_Object Qmouse_left;
53 Lisp_Object Qmouse_entered;
54 Lisp_Object Qpoint_left;
55 Lisp_Object Qpoint_entered;
56 Lisp_Object Qcategory;
57 Lisp_Object Qlocal_map;
58
59 /* Visual properties text (including strings) may have. */
60 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
61 Lisp_Object Qinvisible, Qread_only, Qintangible;
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)=XCONS (o1)->cdr, CONSP (o2)))
70
71 Lisp_Object Vinhibit_point_motion_hooks;
72 Lisp_Object Vdefault_text_properties;
73
74 /* verify_interval_modification saves insertion hooks here
75 to be run later by report_interval_modification. */
76 Lisp_Object interval_insert_behind_hooks;
77 Lisp_Object interval_insert_in_front_hooks;
78 \f
79 /* Extract the interval at the position pointed to by BEGIN from
80 OBJECT, a string or buffer. Additionally, check that the positions
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
82 reverse them if *BEGIN is greater than *END. The objects pointed
83 to by BEGIN and END may be integers or markers; if the latter, they
84 are coerced to integers.
85
86 When OBJECT is a string, we increment *BEGIN and *END
87 to make them origin-one.
88
89 Note that buffer points don't correspond to interval indices.
90 For example, point-max is 1 greater than the index of the last
91 character. This difference is handled in the caller, which uses
92 the validated points to determine a length, and operates on that.
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
94 Fprevious_property_change which call this function with BEGIN == END.
95 Handle this case specially.
96
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
98 create an interval tree for OBJECT if one doesn't exist, provided
99 the object actually contains text. In the current design, if there
100 is no text, there can be no text properties. */
101
102 #define soft 0
103 #define hard 1
104
105 static INTERVAL
106 validate_interval_range (object, begin, end, force)
107 Lisp_Object object, *begin, *end;
108 int force;
109 {
110 register INTERVAL i;
111 int searchpos;
112
113 CHECK_STRING_OR_BUFFER (object, 0);
114 CHECK_NUMBER_COERCE_MARKER (*begin, 0);
115 CHECK_NUMBER_COERCE_MARKER (*end, 0);
116
117 /* If we are asked for a point, but from a subr which operates
118 on a range, then return nothing. */
119 if (EQ (*begin, *end) && begin != end)
120 return NULL_INTERVAL;
121
122 if (XINT (*begin) > XINT (*end))
123 {
124 Lisp_Object n;
125 n = *begin;
126 *begin = *end;
127 *end = n;
128 }
129
130 if (BUFFERP (object))
131 {
132 register struct buffer *b = XBUFFER (object);
133
134 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
135 && XINT (*end) <= BUF_ZV (b)))
136 args_out_of_range (*begin, *end);
137 i = BUF_INTERVALS (b);
138
139 /* If there's no text, there are no properties. */
140 if (BUF_BEGV (b) == BUF_ZV (b))
141 return NULL_INTERVAL;
142
143 searchpos = XINT (*begin);
144 }
145 else
146 {
147 register struct Lisp_String *s = XSTRING (object);
148
149 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
150 && XINT (*end) <= s->size))
151 args_out_of_range (*begin, *end);
152 /* User-level Positions in strings start with 0,
153 but the interval code always wants positions starting with 1. */
154 XSETFASTINT (*begin, XFASTINT (*begin) + 1);
155 if (begin != end)
156 XSETFASTINT (*end, XFASTINT (*end) + 1);
157 i = s->intervals;
158
159 if (s->size == 0)
160 return NULL_INTERVAL;
161
162 searchpos = XINT (*begin);
163 }
164
165 if (NULL_INTERVAL_P (i))
166 return (force ? create_root_interval (object) : i);
167
168 return find_interval (i, searchpos);
169 }
170
171 /* Validate LIST as a property list. If LIST is not a list, then
172 make one consisting of (LIST nil). Otherwise, verify that LIST
173 is even numbered and thus suitable as a plist. */
174
175 static Lisp_Object
176 validate_plist (list)
177 Lisp_Object list;
178 {
179 if (NILP (list))
180 return Qnil;
181
182 if (CONSP (list))
183 {
184 register int i;
185 register Lisp_Object tail;
186 for (i = 0, tail = list; !NILP (tail); i++)
187 {
188 tail = Fcdr (tail);
189 QUIT;
190 }
191 if (i & 1)
192 error ("Odd length text property list");
193 return list;
194 }
195
196 return Fcons (list, Fcons (Qnil, Qnil));
197 }
198
199 /* Return nonzero if interval I has all the properties,
200 with the same values, of list PLIST. */
201
202 static int
203 interval_has_all_properties (plist, i)
204 Lisp_Object plist;
205 INTERVAL i;
206 {
207 register Lisp_Object tail1, tail2, sym1, sym2;
208 register int found;
209
210 /* Go through each element of PLIST. */
211 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
212 {
213 sym1 = Fcar (tail1);
214 found = 0;
215
216 /* Go through I's plist, looking for sym1 */
217 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
218 if (EQ (sym1, Fcar (tail2)))
219 {
220 /* Found the same property on both lists. If the
221 values are unequal, return zero. */
222 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
223 return 0;
224
225 /* Property has same value on both lists; go to next one. */
226 found = 1;
227 break;
228 }
229
230 if (! found)
231 return 0;
232 }
233
234 return 1;
235 }
236
237 /* Return nonzero if the plist of interval I has any of the
238 properties of PLIST, regardless of their values. */
239
240 static INLINE int
241 interval_has_some_properties (plist, i)
242 Lisp_Object plist;
243 INTERVAL i;
244 {
245 register Lisp_Object tail1, tail2, sym;
246
247 /* Go through each element of PLIST. */
248 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
249 {
250 sym = Fcar (tail1);
251
252 /* Go through i's plist, looking for tail1 */
253 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
254 if (EQ (sym, Fcar (tail2)))
255 return 1;
256 }
257
258 return 0;
259 }
260 \f
261 /* Changing the plists of individual intervals. */
262
263 /* Return the value of PROP in property-list PLIST, or Qunbound if it
264 has none. */
265 static Lisp_Object
266 property_value (plist, prop)
267 Lisp_Object plist, prop;
268 {
269 Lisp_Object value;
270
271 while (PLIST_ELT_P (plist, value))
272 if (EQ (XCONS (plist)->car, prop))
273 return XCONS (value)->car;
274 else
275 plist = XCONS (value)->cdr;
276
277 return Qunbound;
278 }
279
280 /* Set the properties of INTERVAL to PROPERTIES,
281 and record undo info for the previous values.
282 OBJECT is the string or buffer that INTERVAL belongs to. */
283
284 static void
285 set_properties (properties, interval, object)
286 Lisp_Object properties, object;
287 INTERVAL interval;
288 {
289 Lisp_Object sym, value;
290
291 if (BUFFERP (object))
292 {
293 /* For each property in the old plist which is missing from PROPERTIES,
294 or has a different value in PROPERTIES, make an undo record. */
295 for (sym = interval->plist;
296 PLIST_ELT_P (sym, value);
297 sym = XCONS (value)->cdr)
298 if (! EQ (property_value (properties, XCONS (sym)->car),
299 XCONS (value)->car))
300 {
301 modify_region (XBUFFER (object),
302 make_number (interval->position),
303 make_number (interval->position + LENGTH (interval)));
304 record_property_change (interval->position, LENGTH (interval),
305 XCONS (sym)->car, XCONS (value)->car,
306 object);
307 }
308
309 /* For each new property that has no value at all in the old plist,
310 make an undo record binding it to nil, so it will be removed. */
311 for (sym = properties;
312 PLIST_ELT_P (sym, value);
313 sym = XCONS (value)->cdr)
314 if (EQ (property_value (interval->plist, XCONS (sym)->car), Qunbound))
315 {
316 modify_region (XBUFFER (object),
317 make_number (interval->position),
318 make_number (interval->position + LENGTH (interval)));
319 record_property_change (interval->position, LENGTH (interval),
320 XCONS (sym)->car, Qnil,
321 object);
322 }
323 }
324
325 /* Store new properties. */
326 interval->plist = Fcopy_sequence (properties);
327 }
328
329 /* Add the properties of PLIST to the interval I, or set
330 the value of I's property to the value of the property on PLIST
331 if they are different.
332
333 OBJECT should be the string or buffer the interval is in.
334
335 Return nonzero if this changes I (i.e., if any members of PLIST
336 are actually added to I's plist) */
337
338 static int
339 add_properties (plist, i, object)
340 Lisp_Object plist;
341 INTERVAL i;
342 Lisp_Object object;
343 {
344 Lisp_Object tail1, tail2, sym1, val1;
345 register int changed = 0;
346 register int found;
347 struct gcpro gcpro1, gcpro2, gcpro3;
348
349 tail1 = plist;
350 sym1 = Qnil;
351 val1 = Qnil;
352 /* No need to protect OBJECT, because we can GC only in the case
353 where it is a buffer, and live buffers are always protected.
354 I and its plist are also protected, via OBJECT. */
355 GCPRO3 (tail1, sym1, val1);
356
357 /* Go through each element of PLIST. */
358 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
359 {
360 sym1 = Fcar (tail1);
361 val1 = Fcar (Fcdr (tail1));
362 found = 0;
363
364 /* Go through I's plist, looking for sym1 */
365 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
366 if (EQ (sym1, Fcar (tail2)))
367 {
368 /* No need to gcpro, because tail2 protects this
369 and it must be a cons cell (we get an error otherwise). */
370 register Lisp_Object this_cdr;
371
372 this_cdr = Fcdr (tail2);
373 /* Found the property. Now check its value. */
374 found = 1;
375
376 /* The properties have the same value on both lists.
377 Continue to the next property. */
378 if (EQ (val1, Fcar (this_cdr)))
379 break;
380
381 /* Record this change in the buffer, for undo purposes. */
382 if (BUFFERP (object))
383 {
384 modify_region (XBUFFER (object),
385 make_number (i->position),
386 make_number (i->position + LENGTH (i)));
387 record_property_change (i->position, LENGTH (i),
388 sym1, Fcar (this_cdr), object);
389 }
390
391 /* I's property has a different value -- change it */
392 Fsetcar (this_cdr, val1);
393 changed++;
394 break;
395 }
396
397 if (! found)
398 {
399 /* Record this change in the buffer, for undo purposes. */
400 if (BUFFERP (object))
401 {
402 modify_region (XBUFFER (object),
403 make_number (i->position),
404 make_number (i->position + LENGTH (i)));
405 record_property_change (i->position, LENGTH (i),
406 sym1, Qnil, object);
407 }
408 i->plist = Fcons (sym1, Fcons (val1, i->plist));
409 changed++;
410 }
411 }
412
413 UNGCPRO;
414
415 return changed;
416 }
417
418 /* For any members of PLIST which are properties of I, remove them
419 from I's plist.
420 OBJECT is the string or buffer containing I. */
421
422 static int
423 remove_properties (plist, i, object)
424 Lisp_Object plist;
425 INTERVAL i;
426 Lisp_Object object;
427 {
428 register Lisp_Object tail1, tail2, sym, current_plist;
429 register int changed = 0;
430
431 current_plist = i->plist;
432 /* Go through each element of plist. */
433 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
434 {
435 sym = Fcar (tail1);
436
437 /* First, remove the symbol if its at the head of the list */
438 while (! NILP (current_plist) && EQ (sym, Fcar (current_plist)))
439 {
440 if (BUFFERP (object))
441 {
442 modify_region (XBUFFER (object),
443 make_number (i->position),
444 make_number (i->position + LENGTH (i)));
445 record_property_change (i->position, LENGTH (i),
446 sym, Fcar (Fcdr (current_plist)),
447 object);
448 }
449
450 current_plist = Fcdr (Fcdr (current_plist));
451 changed++;
452 }
453
454 /* Go through i's plist, looking for sym */
455 tail2 = current_plist;
456 while (! NILP (tail2))
457 {
458 register Lisp_Object this;
459 this = Fcdr (Fcdr (tail2));
460 if (EQ (sym, Fcar (this)))
461 {
462 if (BUFFERP (object))
463 {
464 modify_region (XBUFFER (object),
465 make_number (i->position),
466 make_number (i->position + LENGTH (i)));
467 record_property_change (i->position, LENGTH (i),
468 sym, Fcar (Fcdr (this)), object);
469 }
470
471 Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this)));
472 changed++;
473 }
474 tail2 = this;
475 }
476 }
477
478 if (changed)
479 i->plist = current_plist;
480 return changed;
481 }
482
483 #if 0
484 /* Remove all properties from interval I. Return non-zero
485 if this changes the interval. */
486
487 static INLINE int
488 erase_properties (i)
489 INTERVAL i;
490 {
491 if (NILP (i->plist))
492 return 0;
493
494 i->plist = Qnil;
495 return 1;
496 }
497 #endif
498 \f
499 DEFUN ("text-properties-at", Ftext_properties_at,
500 Stext_properties_at, 1, 2, 0,
501 "Return the list of properties held by the character at POSITION\n\
502 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\
503 defaults to the current buffer.\n\
504 If POSITION is at the end of OBJECT, the value is nil.")
505 (pos, object)
506 Lisp_Object pos, object;
507 {
508 register INTERVAL i;
509
510 if (NILP (object))
511 XSETBUFFER (object, current_buffer);
512
513 i = validate_interval_range (object, &pos, &pos, soft);
514 if (NULL_INTERVAL_P (i))
515 return Qnil;
516 /* If POS is at the end of the interval,
517 it means it's the end of OBJECT.
518 There are no properties at the very end,
519 since no character follows. */
520 if (XINT (pos) == LENGTH (i) + i->position)
521 return Qnil;
522
523 return i->plist;
524 }
525
526 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
527 "Return the value of position POS's property PROP, in OBJECT.\n\
528 OBJECT is optional and defaults to the current buffer.\n\
529 If POSITION is at the end of OBJECT, the value is nil.")
530 (pos, prop, object)
531 Lisp_Object pos, object;
532 Lisp_Object prop;
533 {
534 return textget (Ftext_properties_at (pos, object), prop);
535 }
536
537 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
538 "Return the value of position POS's property PROP, in OBJECT.\n\
539 OBJECT is optional and defaults to the current buffer.\n\
540 If POS is at the end of OBJECT, the value is nil.\n\
541 If OBJECT is a buffer, then overlay properties are considered as well as\n\
542 text properties.\n\
543 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
544 overlays are considered only if they are associated with OBJECT.")
545 (pos, prop, object)
546 Lisp_Object pos, object;
547 register Lisp_Object prop;
548 {
549 struct window *w = 0;
550
551 CHECK_NUMBER_COERCE_MARKER (pos, 0);
552
553 if (NILP (object))
554 XSETBUFFER (object, current_buffer);
555
556 if (WINDOWP (object))
557 {
558 w = XWINDOW (object);
559 object = w->buffer;
560 }
561 if (BUFFERP (object))
562 {
563 int posn = XINT (pos);
564 int noverlays;
565 Lisp_Object *overlay_vec, tem;
566 int next_overlay;
567 int len;
568 struct buffer *obuf = current_buffer;
569
570 set_buffer_temp (XBUFFER (object));
571
572 /* First try with room for 40 overlays. */
573 len = 40;
574 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
575
576 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
577 &next_overlay, NULL);
578
579 /* If there are more than 40,
580 make enough space for all, and try again. */
581 if (noverlays > len)
582 {
583 len = noverlays;
584 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
585 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
586 &next_overlay, NULL);
587 }
588 noverlays = sort_overlays (overlay_vec, noverlays, w);
589
590 set_buffer_temp (obuf);
591
592 /* Now check the overlays in order of decreasing priority. */
593 while (--noverlays >= 0)
594 {
595 tem = Foverlay_get (overlay_vec[noverlays], prop);
596 if (!NILP (tem))
597 return (tem);
598 }
599 }
600 /* Not a buffer, or no appropriate overlay, so fall through to the
601 simpler case. */
602 return (Fget_text_property (pos, prop, object));
603 }
604
605 DEFUN ("next-property-change", Fnext_property_change,
606 Snext_property_change, 1, 3, 0,
607 "Return the position of next property change.\n\
608 Scans characters forward from POS in OBJECT till it finds\n\
609 a change in some text property, then returns the position of the change.\n\
610 The optional second argument OBJECT is the string or buffer to scan.\n\
611 Return nil if the property is constant all the way to the end of OBJECT.\n\
612 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
613 If the optional third argument LIMIT is non-nil, don't search\n\
614 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
615 (pos, object, limit)
616 Lisp_Object pos, object, limit;
617 {
618 register INTERVAL i, next;
619
620 if (NILP (object))
621 XSETBUFFER (object, current_buffer);
622
623 if (! NILP (limit) && ! EQ (limit, Qt))
624 CHECK_NUMBER_COERCE_MARKER (limit, 0);
625
626 i = validate_interval_range (object, &pos, &pos, soft);
627
628 /* If LIMIT is t, return start of next interval--don't
629 bother checking further intervals. */
630 if (EQ (limit, Qt))
631 {
632 if (NULL_INTERVAL_P (i))
633 next = i;
634 else
635 next = next_interval (i);
636
637 if (NULL_INTERVAL_P (next))
638 XSETFASTINT (pos, (STRINGP (object)
639 ? XSTRING (object)->size
640 : BUF_ZV (XBUFFER (object))));
641 else
642 XSETFASTINT (pos, next->position - (STRINGP (object)));
643 return pos;
644 }
645
646 if (NULL_INTERVAL_P (i))
647 return limit;
648
649 next = next_interval (i);
650
651 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
652 && (NILP (limit) || next->position < XFASTINT (limit)))
653 next = next_interval (next);
654
655 if (NULL_INTERVAL_P (next))
656 return limit;
657 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
658 return limit;
659
660 XSETFASTINT (pos, next->position - (STRINGP (object)));
661 return pos;
662 }
663
664 /* Return 1 if there's a change in some property between BEG and END. */
665
666 int
667 property_change_between_p (beg, end)
668 int beg, end;
669 {
670 register INTERVAL i, next;
671 Lisp_Object object, pos;
672
673 XSETBUFFER (object, current_buffer);
674 XSETFASTINT (pos, beg);
675
676 i = validate_interval_range (object, &pos, &pos, soft);
677 if (NULL_INTERVAL_P (i))
678 return 0;
679
680 next = next_interval (i);
681 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
682 {
683 next = next_interval (next);
684 if (NULL_INTERVAL_P (next))
685 return 0;
686 if (next->position >= end)
687 return 0;
688 }
689
690 if (NULL_INTERVAL_P (next))
691 return 0;
692
693 return 1;
694 }
695
696 DEFUN ("next-single-property-change", Fnext_single_property_change,
697 Snext_single_property_change, 2, 4, 0,
698 "Return the position of next property change for a specific property.\n\
699 Scans characters forward from POS till it finds\n\
700 a change in the PROP property, then returns the position of the change.\n\
701 The optional third argument OBJECT is the string or buffer to scan.\n\
702 The property values are compared with `eq'.\n\
703 Return nil if the property is constant all the way to the end of OBJECT.\n\
704 If the value is non-nil, it is a position greater than POS, never equal.\n\n\
705 If the optional fourth argument LIMIT is non-nil, don't search\n\
706 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
707 (pos, prop, object, limit)
708 Lisp_Object pos, prop, object, limit;
709 {
710 register INTERVAL i, next;
711 register Lisp_Object here_val;
712
713 if (NILP (object))
714 XSETBUFFER (object, current_buffer);
715
716 if (!NILP (limit))
717 CHECK_NUMBER_COERCE_MARKER (limit, 0);
718
719 i = validate_interval_range (object, &pos, &pos, soft);
720 if (NULL_INTERVAL_P (i))
721 return limit;
722
723 here_val = textget (i->plist, prop);
724 next = next_interval (i);
725 while (! NULL_INTERVAL_P (next)
726 && EQ (here_val, textget (next->plist, prop))
727 && (NILP (limit) || next->position < XFASTINT (limit)))
728 next = next_interval (next);
729
730 if (NULL_INTERVAL_P (next))
731 return limit;
732 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
733 return limit;
734
735 XSETFASTINT (pos, next->position - (STRINGP (object)));
736 return pos;
737 }
738
739 DEFUN ("previous-property-change", Fprevious_property_change,
740 Sprevious_property_change, 1, 3, 0,
741 "Return the position of previous property change.\n\
742 Scans characters backwards from POS in OBJECT till it finds\n\
743 a change in some text property, then returns the position of the change.\n\
744 The optional second argument OBJECT is the string or buffer to scan.\n\
745 Return nil if the property is constant all the way to the start of OBJECT.\n\
746 If the value is non-nil, it is a position less than POS, never equal.\n\n\
747 If the optional third argument LIMIT is non-nil, don't search\n\
748 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
749 (pos, object, limit)
750 Lisp_Object pos, object, limit;
751 {
752 register INTERVAL i, previous;
753
754 if (NILP (object))
755 XSETBUFFER (object, current_buffer);
756
757 if (!NILP (limit))
758 CHECK_NUMBER_COERCE_MARKER (limit, 0);
759
760 i = validate_interval_range (object, &pos, &pos, soft);
761 if (NULL_INTERVAL_P (i))
762 return limit;
763
764 /* Start with the interval containing the char before point. */
765 if (i->position == XFASTINT (pos))
766 i = previous_interval (i);
767
768 previous = previous_interval (i);
769 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
770 && (NILP (limit)
771 || previous->position + LENGTH (previous) > XFASTINT (limit)))
772 previous = previous_interval (previous);
773 if (NULL_INTERVAL_P (previous))
774 return limit;
775 if (!NILP (limit)
776 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
777 return limit;
778
779 XSETFASTINT (pos, (previous->position + LENGTH (previous)
780 - (STRINGP (object))));
781 return pos;
782 }
783
784 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
785 Sprevious_single_property_change, 2, 4, 0,
786 "Return the position of previous property change for a specific property.\n\
787 Scans characters backward from POS till it finds\n\
788 a change in the PROP property, then returns the position of the change.\n\
789 The optional third argument OBJECT is the string or buffer to scan.\n\
790 The property values are compared with `eq'.\n\
791 Return nil if the property is constant all the way to the start of OBJECT.\n\
792 If the value is non-nil, it is a position less than POS, never equal.\n\n\
793 If the optional fourth argument LIMIT is non-nil, don't search\n\
794 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
795 (pos, prop, object, limit)
796 Lisp_Object pos, prop, object, limit;
797 {
798 register INTERVAL i, previous;
799 register Lisp_Object here_val;
800
801 if (NILP (object))
802 XSETBUFFER (object, current_buffer);
803
804 if (!NILP (limit))
805 CHECK_NUMBER_COERCE_MARKER (limit, 0);
806
807 i = validate_interval_range (object, &pos, &pos, soft);
808
809 /* Start with the interval containing the char before point. */
810 if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (pos))
811 i = previous_interval (i);
812
813 if (NULL_INTERVAL_P (i))
814 return limit;
815
816 here_val = textget (i->plist, prop);
817 previous = previous_interval (i);
818 while (! NULL_INTERVAL_P (previous)
819 && EQ (here_val, textget (previous->plist, prop))
820 && (NILP (limit)
821 || previous->position + LENGTH (previous) > XFASTINT (limit)))
822 previous = previous_interval (previous);
823 if (NULL_INTERVAL_P (previous))
824 return limit;
825 if (!NILP (limit)
826 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
827 return limit;
828
829 XSETFASTINT (pos, (previous->position + LENGTH (previous)
830 - (STRINGP (object))));
831 return pos;
832 }
833
834 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
835
836 DEFUN ("add-text-properties", Fadd_text_properties,
837 Sadd_text_properties, 3, 4, 0,
838 "Add properties to the text from START to END.\n\
839 The third argument PROPS is a property list\n\
840 specifying the property values to add.\n\
841 The optional fourth argument, OBJECT,\n\
842 is the string or buffer containing the text.\n\
843 Return t if any property value actually changed, nil otherwise.")
844 (start, end, properties, object)
845 Lisp_Object start, end, properties, object;
846 {
847 register INTERVAL i, unchanged;
848 register int s, len, modified = 0;
849 struct gcpro gcpro1;
850
851 properties = validate_plist (properties);
852 if (NILP (properties))
853 return Qnil;
854
855 if (NILP (object))
856 XSETBUFFER (object, current_buffer);
857
858 i = validate_interval_range (object, &start, &end, hard);
859 if (NULL_INTERVAL_P (i))
860 return Qnil;
861
862 s = XINT (start);
863 len = XINT (end) - s;
864
865 /* No need to protect OBJECT, because we GC only if it's a buffer,
866 and live buffers are always protected. */
867 GCPRO1 (properties);
868
869 /* If we're not starting on an interval boundary, we have to
870 split this interval. */
871 if (i->position != s)
872 {
873 /* If this interval already has the properties, we can
874 skip it. */
875 if (interval_has_all_properties (properties, i))
876 {
877 int got = (LENGTH (i) - (s - i->position));
878 if (got >= len)
879 return Qnil;
880 len -= got;
881 i = next_interval (i);
882 }
883 else
884 {
885 unchanged = i;
886 i = split_interval_right (unchanged, s - unchanged->position);
887 copy_properties (unchanged, i);
888 }
889 }
890
891 /* We are at the beginning of interval I, with LEN chars to scan. */
892 for (;;)
893 {
894 if (i == 0)
895 abort ();
896
897 if (LENGTH (i) >= len)
898 {
899 /* We can UNGCPRO safely here, because there will be just
900 one more chance to gc, in the next call to add_properties,
901 and after that we will not need PROPERTIES or OBJECT again. */
902 UNGCPRO;
903
904 if (interval_has_all_properties (properties, i))
905 return modified ? Qt : Qnil;
906
907 if (LENGTH (i) == len)
908 {
909 add_properties (properties, i, object);
910 return Qt;
911 }
912
913 /* i doesn't have the properties, and goes past the change limit */
914 unchanged = i;
915 i = split_interval_left (unchanged, len);
916 copy_properties (unchanged, i);
917 add_properties (properties, i, object);
918 return Qt;
919 }
920
921 len -= LENGTH (i);
922 modified += add_properties (properties, i, object);
923 i = next_interval (i);
924 }
925 }
926
927 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
928
929 DEFUN ("put-text-property", Fput_text_property,
930 Sput_text_property, 4, 5, 0,
931 "Set one property of the text from START to END.\n\
932 The third and fourth arguments PROP and VALUE\n\
933 specify the property to add.\n\
934 The optional fifth argument, OBJECT,\n\
935 is the string or buffer containing the text.")
936 (start, end, prop, value, object)
937 Lisp_Object start, end, prop, value, object;
938 {
939 Fadd_text_properties (start, end,
940 Fcons (prop, Fcons (value, Qnil)),
941 object);
942 return Qnil;
943 }
944
945 DEFUN ("set-text-properties", Fset_text_properties,
946 Sset_text_properties, 3, 4, 0,
947 "Completely replace properties of text from START to END.\n\
948 The third argument PROPS is the new property list.\n\
949 The optional fourth argument, OBJECT,\n\
950 is the string or buffer containing the text.")
951 (start, end, props, object)
952 Lisp_Object start, end, props, object;
953 {
954 register INTERVAL i, unchanged;
955 register INTERVAL prev_changed = NULL_INTERVAL;
956 register int s, len;
957 Lisp_Object ostart, oend;
958
959 ostart = start;
960 oend = end;
961
962 props = validate_plist (props);
963
964 if (NILP (object))
965 XSETBUFFER (object, current_buffer);
966
967 /* If we want no properties for a whole string,
968 get rid of its intervals. */
969 if (NILP (props) && STRINGP (object)
970 && XFASTINT (start) == 0
971 && XFASTINT (end) == XSTRING (object)->size)
972 {
973 XSTRING (object)->intervals = 0;
974 return Qt;
975 }
976
977 i = validate_interval_range (object, &start, &end, soft);
978
979 if (NULL_INTERVAL_P (i))
980 {
981 /* If buffer has no props, and we want none, return now. */
982 if (NILP (props))
983 return Qnil;
984
985 /* Restore the original START and END values
986 because validate_interval_range increments them for strings. */
987 start = ostart;
988 end = oend;
989
990 i = validate_interval_range (object, &start, &end, hard);
991 /* This can return if start == end. */
992 if (NULL_INTERVAL_P (i))
993 return Qnil;
994 }
995
996 s = XINT (start);
997 len = XINT (end) - s;
998
999 if (i->position != s)
1000 {
1001 unchanged = i;
1002 i = split_interval_right (unchanged, s - unchanged->position);
1003
1004 if (LENGTH (i) > len)
1005 {
1006 copy_properties (unchanged, i);
1007 i = split_interval_left (i, len);
1008 set_properties (props, i, object);
1009 return Qt;
1010 }
1011
1012 set_properties (props, i, object);
1013
1014 if (LENGTH (i) == len)
1015 return Qt;
1016
1017 prev_changed = i;
1018 len -= LENGTH (i);
1019 i = next_interval (i);
1020 }
1021
1022 /* We are starting at the beginning of an interval, I */
1023 while (len > 0)
1024 {
1025 if (i == 0)
1026 abort ();
1027
1028 if (LENGTH (i) >= len)
1029 {
1030 if (LENGTH (i) > len)
1031 i = split_interval_left (i, len);
1032
1033 if (NULL_INTERVAL_P (prev_changed))
1034 set_properties (props, i, object);
1035 else
1036 merge_interval_left (i);
1037 return Qt;
1038 }
1039
1040 len -= LENGTH (i);
1041 if (NULL_INTERVAL_P (prev_changed))
1042 {
1043 set_properties (props, i, object);
1044 prev_changed = i;
1045 }
1046 else
1047 prev_changed = i = merge_interval_left (i);
1048
1049 i = next_interval (i);
1050 }
1051
1052 return Qt;
1053 }
1054
1055 DEFUN ("remove-text-properties", Fremove_text_properties,
1056 Sremove_text_properties, 3, 4, 0,
1057 "Remove some properties from text from START to END.\n\
1058 The third argument PROPS is a property list\n\
1059 whose property names specify the properties to remove.\n\
1060 \(The values stored in PROPS are ignored.)\n\
1061 The optional fourth argument, OBJECT,\n\
1062 is the string or buffer containing the text.\n\
1063 Return t if any property was actually removed, nil otherwise.")
1064 (start, end, props, object)
1065 Lisp_Object start, end, props, object;
1066 {
1067 register INTERVAL i, unchanged;
1068 register int s, len, modified = 0;
1069
1070 if (NILP (object))
1071 XSETBUFFER (object, current_buffer);
1072
1073 i = validate_interval_range (object, &start, &end, soft);
1074 if (NULL_INTERVAL_P (i))
1075 return Qnil;
1076
1077 s = XINT (start);
1078 len = XINT (end) - s;
1079
1080 if (i->position != s)
1081 {
1082 /* No properties on this first interval -- return if
1083 it covers the entire region. */
1084 if (! interval_has_some_properties (props, i))
1085 {
1086 int got = (LENGTH (i) - (s - i->position));
1087 if (got >= len)
1088 return Qnil;
1089 len -= got;
1090 i = next_interval (i);
1091 }
1092 /* Split away the beginning of this interval; what we don't
1093 want to modify. */
1094 else
1095 {
1096 unchanged = i;
1097 i = split_interval_right (unchanged, s - unchanged->position);
1098 copy_properties (unchanged, i);
1099 }
1100 }
1101
1102 /* We are at the beginning of an interval, with len to scan */
1103 for (;;)
1104 {
1105 if (i == 0)
1106 abort ();
1107
1108 if (LENGTH (i) >= len)
1109 {
1110 if (! interval_has_some_properties (props, i))
1111 return modified ? Qt : Qnil;
1112
1113 if (LENGTH (i) == len)
1114 {
1115 remove_properties (props, i, object);
1116 return Qt;
1117 }
1118
1119 /* i has the properties, and goes past the change limit */
1120 unchanged = i;
1121 i = split_interval_left (i, len);
1122 copy_properties (unchanged, i);
1123 remove_properties (props, i, object);
1124 return Qt;
1125 }
1126
1127 len -= LENGTH (i);
1128 modified += remove_properties (props, i, object);
1129 i = next_interval (i);
1130 }
1131 }
1132
1133 DEFUN ("text-property-any", Ftext_property_any,
1134 Stext_property_any, 4, 5, 0,
1135 "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\
1136 If so, return the position of the first character whose PROP is `eq'\n\
1137 to VALUE. Otherwise return nil.\n\
1138 The optional fifth argument, OBJECT, is the string or buffer\n\
1139 containing the text.")
1140 (start, end, prop, value, object)
1141 Lisp_Object start, end, prop, value, object;
1142 {
1143 register INTERVAL i;
1144 register int e, pos;
1145
1146 if (NILP (object))
1147 XSETBUFFER (object, current_buffer);
1148 i = validate_interval_range (object, &start, &end, soft);
1149 if (NULL_INTERVAL_P (i))
1150 return (!NILP (value) || EQ (start, end) ? Qnil : start);
1151 e = XINT (end);
1152
1153 while (! NULL_INTERVAL_P (i))
1154 {
1155 if (i->position >= e)
1156 break;
1157 if (EQ (textget (i->plist, prop), value))
1158 {
1159 pos = i->position;
1160 if (pos < XINT (start))
1161 pos = XINT (start);
1162 return make_number (pos - (STRINGP (object)));
1163 }
1164 i = next_interval (i);
1165 }
1166 return Qnil;
1167 }
1168
1169 DEFUN ("text-property-not-all", Ftext_property_not_all,
1170 Stext_property_not_all, 4, 5, 0,
1171 "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\
1172 If so, return the position of the first character whose PROP is not\n\
1173 `eq' to VALUE. Otherwise, return nil.\n\
1174 The optional fifth argument, OBJECT, is the string or buffer\n\
1175 containing the text.")
1176 (start, end, prop, value, object)
1177 Lisp_Object start, end, prop, value, object;
1178 {
1179 register INTERVAL i;
1180 register int s, e;
1181
1182 if (NILP (object))
1183 XSETBUFFER (object, current_buffer);
1184 i = validate_interval_range (object, &start, &end, soft);
1185 if (NULL_INTERVAL_P (i))
1186 return (NILP (value) || EQ (start, end)) ? Qnil : start;
1187 s = XINT (start);
1188 e = XINT (end);
1189
1190 while (! NULL_INTERVAL_P (i))
1191 {
1192 if (i->position >= e)
1193 break;
1194 if (! EQ (textget (i->plist, prop), value))
1195 {
1196 if (i->position > s)
1197 s = i->position;
1198 return make_number (s - (STRINGP (object)));
1199 }
1200 i = next_interval (i);
1201 }
1202 return Qnil;
1203 }
1204
1205 #if 0 /* You can use set-text-properties for this. */
1206
1207 DEFUN ("erase-text-properties", Ferase_text_properties,
1208 Serase_text_properties, 2, 3, 0,
1209 "Remove all properties from the text from START to END.\n\
1210 The optional third argument, OBJECT,\n\
1211 is the string or buffer containing the text.")
1212 (start, end, object)
1213 Lisp_Object start, end, object;
1214 {
1215 register INTERVAL i;
1216 register INTERVAL prev_changed = NULL_INTERVAL;
1217 register int s, len, modified;
1218
1219 if (NILP (object))
1220 XSETBUFFER (object, current_buffer);
1221
1222 i = validate_interval_range (object, &start, &end, soft);
1223 if (NULL_INTERVAL_P (i))
1224 return Qnil;
1225
1226 s = XINT (start);
1227 len = XINT (end) - s;
1228
1229 if (i->position != s)
1230 {
1231 register int got;
1232 register INTERVAL unchanged = i;
1233
1234 /* If there are properties here, then this text will be modified. */
1235 if (! NILP (i->plist))
1236 {
1237 i = split_interval_right (unchanged, s - unchanged->position);
1238 i->plist = Qnil;
1239 modified++;
1240
1241 if (LENGTH (i) > len)
1242 {
1243 i = split_interval_right (i, len);
1244 copy_properties (unchanged, i);
1245 return Qt;
1246 }
1247
1248 if (LENGTH (i) == len)
1249 return Qt;
1250
1251 got = LENGTH (i);
1252 }
1253 /* If the text of I is without any properties, and contains
1254 LEN or more characters, then we may return without changing
1255 anything.*/
1256 else if (LENGTH (i) - (s - i->position) <= len)
1257 return Qnil;
1258 /* The amount of text to change extends past I, so just note
1259 how much we've gotten. */
1260 else
1261 got = LENGTH (i) - (s - i->position);
1262
1263 len -= got;
1264 prev_changed = i;
1265 i = next_interval (i);
1266 }
1267
1268 /* We are starting at the beginning of an interval, I. */
1269 while (len > 0)
1270 {
1271 if (LENGTH (i) >= len)
1272 {
1273 /* If I has no properties, simply merge it if possible. */
1274 if (NILP (i->plist))
1275 {
1276 if (! NULL_INTERVAL_P (prev_changed))
1277 merge_interval_left (i);
1278
1279 return modified ? Qt : Qnil;
1280 }
1281
1282 if (LENGTH (i) > len)
1283 i = split_interval_left (i, len);
1284 if (! NULL_INTERVAL_P (prev_changed))
1285 merge_interval_left (i);
1286 else
1287 i->plist = Qnil;
1288
1289 return Qt;
1290 }
1291
1292 /* Here if we still need to erase past the end of I */
1293 len -= LENGTH (i);
1294 if (NULL_INTERVAL_P (prev_changed))
1295 {
1296 modified += erase_properties (i);
1297 prev_changed = i;
1298 }
1299 else
1300 {
1301 modified += ! NILP (i->plist);
1302 /* Merging I will give it the properties of PREV_CHANGED. */
1303 prev_changed = i = merge_interval_left (i);
1304 }
1305
1306 i = next_interval (i);
1307 }
1308
1309 return modified ? Qt : Qnil;
1310 }
1311 #endif /* 0 */
1312
1313 /* I don't think this is the right interface to export; how often do you
1314 want to do something like this, other than when you're copying objects
1315 around?
1316
1317 I think it would be better to have a pair of functions, one which
1318 returns the text properties of a region as a list of ranges and
1319 plists, and another which applies such a list to another object. */
1320
1321 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
1322 SRC and DEST may each refer to strings or buffers.
1323 Optional sixth argument PROP causes only that property to be copied.
1324 Properties are copied to DEST as if by `add-text-properties'.
1325 Return t if any property value actually changed, nil otherwise. */
1326
1327 /* Note this can GC when DEST is a buffer. */
1328
1329 Lisp_Object
1330 copy_text_properties (start, end, src, pos, dest, prop)
1331 Lisp_Object start, end, src, pos, dest, prop;
1332 {
1333 INTERVAL i;
1334 Lisp_Object res;
1335 Lisp_Object stuff;
1336 Lisp_Object plist;
1337 int s, e, e2, p, len, modified = 0;
1338 struct gcpro gcpro1, gcpro2;
1339
1340 i = validate_interval_range (src, &start, &end, soft);
1341 if (NULL_INTERVAL_P (i))
1342 return Qnil;
1343
1344 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1345 {
1346 Lisp_Object dest_start, dest_end;
1347
1348 dest_start = pos;
1349 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
1350 /* Apply this to a copy of pos; it will try to increment its arguments,
1351 which we don't want. */
1352 validate_interval_range (dest, &dest_start, &dest_end, soft);
1353 }
1354
1355 s = XINT (start);
1356 e = XINT (end);
1357 p = XINT (pos);
1358
1359 stuff = Qnil;
1360
1361 while (s < e)
1362 {
1363 e2 = i->position + LENGTH (i);
1364 if (e2 > e)
1365 e2 = e;
1366 len = e2 - s;
1367
1368 plist = i->plist;
1369 if (! NILP (prop))
1370 while (! NILP (plist))
1371 {
1372 if (EQ (Fcar (plist), prop))
1373 {
1374 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
1375 break;
1376 }
1377 plist = Fcdr (Fcdr (plist));
1378 }
1379 if (! NILP (plist))
1380 {
1381 /* Must defer modifications to the interval tree in case src
1382 and dest refer to the same string or buffer. */
1383 stuff = Fcons (Fcons (make_number (p),
1384 Fcons (make_number (p + len),
1385 Fcons (plist, Qnil))),
1386 stuff);
1387 }
1388
1389 i = next_interval (i);
1390 if (NULL_INTERVAL_P (i))
1391 break;
1392
1393 p += len;
1394 s = i->position;
1395 }
1396
1397 GCPRO2 (stuff, dest);
1398
1399 while (! NILP (stuff))
1400 {
1401 res = Fcar (stuff);
1402 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1403 Fcar (Fcdr (Fcdr (res))), dest);
1404 if (! NILP (res))
1405 modified++;
1406 stuff = Fcdr (stuff);
1407 }
1408
1409 UNGCPRO;
1410
1411 return modified ? Qt : Qnil;
1412 }
1413 \f
1414 /* Call the modification hook functions in LIST, each with START and END. */
1415
1416 static void
1417 call_mod_hooks (list, start, end)
1418 Lisp_Object list, start, end;
1419 {
1420 struct gcpro gcpro1;
1421 GCPRO1 (list);
1422 while (!NILP (list))
1423 {
1424 call2 (Fcar (list), start, end);
1425 list = Fcdr (list);
1426 }
1427 UNGCPRO;
1428 }
1429
1430 /* Check for read-only intervals and signal an error if we find one.
1431 Then check for any modification hooks in the range START up to
1432 (but not including) END. Create a list of all these hooks in
1433 lexicographic order, eliminating consecutive extra copies of the
1434 same hook. Then call those hooks in order, with START and END - 1
1435 as arguments. */
1436
1437 void
1438 verify_interval_modification (buf, start, end)
1439 struct buffer *buf;
1440 int start, end;
1441 {
1442 register INTERVAL intervals = BUF_INTERVALS (buf);
1443 register INTERVAL i, prev;
1444 Lisp_Object hooks;
1445 register Lisp_Object prev_mod_hooks;
1446 Lisp_Object mod_hooks;
1447 struct gcpro gcpro1;
1448
1449 hooks = Qnil;
1450 prev_mod_hooks = Qnil;
1451 mod_hooks = Qnil;
1452
1453 interval_insert_behind_hooks = Qnil;
1454 interval_insert_in_front_hooks = Qnil;
1455
1456 if (NULL_INTERVAL_P (intervals))
1457 return;
1458
1459 if (start > end)
1460 {
1461 int temp = start;
1462 start = end;
1463 end = temp;
1464 }
1465
1466 /* For an insert operation, check the two chars around the position. */
1467 if (start == end)
1468 {
1469 INTERVAL prev;
1470 Lisp_Object before, after;
1471
1472 /* Set I to the interval containing the char after START,
1473 and PREV to the interval containing the char before START.
1474 Either one may be null. They may be equal. */
1475 i = find_interval (intervals, start);
1476
1477 if (start == BUF_BEGV (buf))
1478 prev = 0;
1479 else if (i->position == start)
1480 prev = previous_interval (i);
1481 else if (i->position < start)
1482 prev = i;
1483 if (start == BUF_ZV (buf))
1484 i = 0;
1485
1486 /* If Vinhibit_read_only is set and is not a list, we can
1487 skip the read_only checks. */
1488 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
1489 {
1490 /* If I and PREV differ we need to check for the read-only
1491 property together with its stickyness. If either I or
1492 PREV are 0, this check is all we need.
1493 We have to take special care, since read-only may be
1494 indirectly defined via the category property. */
1495 if (i != prev)
1496 {
1497 if (! NULL_INTERVAL_P (i))
1498 {
1499 after = textget (i->plist, Qread_only);
1500
1501 /* If interval I is read-only and read-only is
1502 front-sticky, inhibit insertion.
1503 Check for read-only as well as category. */
1504 if (! NILP (after)
1505 && NILP (Fmemq (after, Vinhibit_read_only)))
1506 {
1507 Lisp_Object tem;
1508
1509 tem = textget (i->plist, Qfront_sticky);
1510 if (TMEM (Qread_only, tem)
1511 || (NILP (Fplist_get (i->plist, Qread_only))
1512 && TMEM (Qcategory, tem)))
1513 error ("Attempt to insert within read-only text");
1514 }
1515 }
1516
1517 if (! NULL_INTERVAL_P (prev))
1518 {
1519 before = textget (prev->plist, Qread_only);
1520
1521 /* If interval PREV is read-only and read-only isn't
1522 rear-nonsticky, inhibit insertion.
1523 Check for read-only as well as category. */
1524 if (! NILP (before)
1525 && NILP (Fmemq (before, Vinhibit_read_only)))
1526 {
1527 Lisp_Object tem;
1528
1529 tem = textget (prev->plist, Qrear_nonsticky);
1530 if (! TMEM (Qread_only, tem)
1531 && (! NILP (Fplist_get (prev->plist,Qread_only))
1532 || ! TMEM (Qcategory, tem)))
1533 error ("Attempt to insert within read-only text");
1534 }
1535 }
1536 }
1537 else if (! NULL_INTERVAL_P (i))
1538 {
1539 after = textget (i->plist, Qread_only);
1540
1541 /* If interval I is read-only and read-only is
1542 front-sticky, inhibit insertion.
1543 Check for read-only as well as category. */
1544 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
1545 {
1546 Lisp_Object tem;
1547
1548 tem = textget (i->plist, Qfront_sticky);
1549 if (TMEM (Qread_only, tem)
1550 || (NILP (Fplist_get (i->plist, Qread_only))
1551 && TMEM (Qcategory, tem)))
1552 error ("Attempt to insert within read-only text");
1553
1554 tem = textget (prev->plist, Qrear_nonsticky);
1555 if (! TMEM (Qread_only, tem)
1556 && (! NILP (Fplist_get (prev->plist, Qread_only))
1557 || ! TMEM (Qcategory, tem)))
1558 error ("Attempt to insert within read-only text");
1559 }
1560 }
1561 }
1562
1563 /* Run both insert hooks (just once if they're the same). */
1564 if (!NULL_INTERVAL_P (prev))
1565 interval_insert_behind_hooks
1566 = textget (prev->plist, Qinsert_behind_hooks);
1567 if (!NULL_INTERVAL_P (i))
1568 interval_insert_in_front_hooks
1569 = textget (i->plist, Qinsert_in_front_hooks);
1570 }
1571 else
1572 {
1573 /* Loop over intervals on or next to START...END,
1574 collecting their hooks. */
1575
1576 i = find_interval (intervals, start);
1577 do
1578 {
1579 if (! INTERVAL_WRITABLE_P (i))
1580 error ("Attempt to modify read-only text");
1581
1582 mod_hooks = textget (i->plist, Qmodification_hooks);
1583 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
1584 {
1585 hooks = Fcons (mod_hooks, hooks);
1586 prev_mod_hooks = mod_hooks;
1587 }
1588
1589 i = next_interval (i);
1590 }
1591 /* Keep going thru the interval containing the char before END. */
1592 while (! NULL_INTERVAL_P (i) && i->position < end);
1593
1594 GCPRO1 (hooks);
1595 hooks = Fnreverse (hooks);
1596 while (! EQ (hooks, Qnil))
1597 {
1598 call_mod_hooks (Fcar (hooks), make_number (start),
1599 make_number (end));
1600 hooks = Fcdr (hooks);
1601 }
1602 UNGCPRO;
1603 }
1604 }
1605
1606 /* Run the interval hooks for an insertion.
1607 verify_interval_modification chose which hooks to run;
1608 this function is called after the insertion happens
1609 so it can indicate the range of inserted text. */
1610
1611 void
1612 report_interval_modification (start, end)
1613 Lisp_Object start, end;
1614 {
1615 if (! NILP (interval_insert_behind_hooks))
1616 call_mod_hooks (interval_insert_behind_hooks,
1617 make_number (start), make_number (end));
1618 if (! NILP (interval_insert_in_front_hooks)
1619 && ! EQ (interval_insert_in_front_hooks,
1620 interval_insert_behind_hooks))
1621 call_mod_hooks (interval_insert_in_front_hooks,
1622 make_number (start), make_number (end));
1623 }
1624 \f
1625 void
1626 syms_of_textprop ()
1627 {
1628 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
1629 "Property-list used as default values.\n\
1630 The value of a property in this list is seen as the value for every\n\
1631 character that does not have its own value for that property.");
1632 Vdefault_text_properties = Qnil;
1633
1634 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
1635 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
1636 This also inhibits the use of the `intangible' text property.");
1637 Vinhibit_point_motion_hooks = Qnil;
1638
1639 staticpro (&interval_insert_behind_hooks);
1640 staticpro (&interval_insert_in_front_hooks);
1641 interval_insert_behind_hooks = Qnil;
1642 interval_insert_in_front_hooks = Qnil;
1643
1644
1645 /* Common attributes one might give text */
1646
1647 staticpro (&Qforeground);
1648 Qforeground = intern ("foreground");
1649 staticpro (&Qbackground);
1650 Qbackground = intern ("background");
1651 staticpro (&Qfont);
1652 Qfont = intern ("font");
1653 staticpro (&Qstipple);
1654 Qstipple = intern ("stipple");
1655 staticpro (&Qunderline);
1656 Qunderline = intern ("underline");
1657 staticpro (&Qread_only);
1658 Qread_only = intern ("read-only");
1659 staticpro (&Qinvisible);
1660 Qinvisible = intern ("invisible");
1661 staticpro (&Qintangible);
1662 Qintangible = intern ("intangible");
1663 staticpro (&Qcategory);
1664 Qcategory = intern ("category");
1665 staticpro (&Qlocal_map);
1666 Qlocal_map = intern ("local-map");
1667 staticpro (&Qfront_sticky);
1668 Qfront_sticky = intern ("front-sticky");
1669 staticpro (&Qrear_nonsticky);
1670 Qrear_nonsticky = intern ("rear-nonsticky");
1671
1672 /* Properties that text might use to specify certain actions */
1673
1674 staticpro (&Qmouse_left);
1675 Qmouse_left = intern ("mouse-left");
1676 staticpro (&Qmouse_entered);
1677 Qmouse_entered = intern ("mouse-entered");
1678 staticpro (&Qpoint_left);
1679 Qpoint_left = intern ("point-left");
1680 staticpro (&Qpoint_entered);
1681 Qpoint_entered = intern ("point-entered");
1682
1683 defsubr (&Stext_properties_at);
1684 defsubr (&Sget_text_property);
1685 defsubr (&Sget_char_property);
1686 defsubr (&Snext_property_change);
1687 defsubr (&Snext_single_property_change);
1688 defsubr (&Sprevious_property_change);
1689 defsubr (&Sprevious_single_property_change);
1690 defsubr (&Sadd_text_properties);
1691 defsubr (&Sput_text_property);
1692 defsubr (&Sset_text_properties);
1693 defsubr (&Sremove_text_properties);
1694 defsubr (&Stext_property_any);
1695 defsubr (&Stext_property_not_all);
1696 /* defsubr (&Serase_text_properties); */
1697 /* defsubr (&Scopy_text_properties); */
1698 }
1699
1700 #else
1701
1702 lose -- this shouldn't be compiled if USE_TEXT_PROPERTIES isn't defined
1703
1704 #endif /* USE_TEXT_PROPERTIES */