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