1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
43 #include "intervals.h"
48 /* The rest of the file is within this conditional. */
49 #ifdef USE_TEXT_PROPERTIES
51 /* Test for membership, allowing for t (actually any non-cons) to mean the
54 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
56 Lisp_Object
merge_properties_sticky ();
58 /* Utility functions for intervals. */
61 /* Create the root interval of some object, a buffer or string. */
64 create_root_interval (parent
)
69 CHECK_IMPURE (parent
);
71 new = make_interval ();
75 new->total_length
= (BUF_Z (XBUFFER (parent
))
76 - BUF_BEG (XBUFFER (parent
)));
77 XBUFFER (parent
)->intervals
= new;
79 else if (STRINGP (parent
))
81 new->total_length
= XSTRING (parent
)->size
;
82 XSTRING (parent
)->intervals
= new;
85 new->parent
= (INTERVAL
) parent
;
91 /* Make the interval TARGET have exactly the properties of SOURCE */
94 copy_properties (source
, target
)
95 register INTERVAL source
, target
;
97 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
100 COPY_INTERVAL_CACHE (source
, target
);
101 target
->plist
= Fcopy_sequence (source
->plist
);
104 /* Merge the properties of interval SOURCE into the properties
105 of interval TARGET. That is to say, each property in SOURCE
106 is added to TARGET if TARGET has no such property as yet. */
109 merge_properties (source
, target
)
110 register INTERVAL source
, target
;
112 register Lisp_Object o
, sym
, val
;
114 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
117 MERGE_INTERVAL_CACHE (source
, target
);
120 while (! EQ (o
, Qnil
))
123 val
= Fmemq (sym
, target
->plist
);
129 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
137 /* Return 1 if the two intervals have the same properties,
141 intervals_equal (i0
, i1
)
144 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
147 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
150 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
153 i1_len
= XFASTINT (Flength (i1
->plist
));
154 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
158 while (!NILP (i0_cdr
))
160 /* Lengths of the two plists were unequal. */
164 i0_sym
= Fcar (i0_cdr
);
165 i1_val
= Fmemq (i0_sym
, i1
->plist
);
167 /* i0 has something i1 doesn't. */
168 if (EQ (i1_val
, Qnil
))
171 /* i0 and i1 both have sym, but it has different values in each. */
172 i0_cdr
= Fcdr (i0_cdr
);
173 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
176 i0_cdr
= Fcdr (i0_cdr
);
180 /* Lengths of the two plists were unequal. */
189 static int zero_length
;
191 /* Traverse an interval tree TREE, performing FUNCTION on each node.
192 Pass FUNCTION two args: an interval, and ARG. */
195 traverse_intervals (tree
, position
, depth
, function
, arg
)
198 void (* function
) ();
201 if (NULL_INTERVAL_P (tree
))
204 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
205 position
+= LEFT_TOTAL_LENGTH (tree
);
206 tree
->position
= position
;
207 (*function
) (tree
, arg
);
208 position
+= LENGTH (tree
);
209 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
213 /* These functions are temporary, for debugging purposes only. */
215 INTERVAL search_interval
, found_interval
;
218 check_for_interval (i
)
221 if (i
== search_interval
)
229 search_for_interval (i
, tree
)
230 register INTERVAL i
, tree
;
234 found_interval
= NULL_INTERVAL
;
235 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
236 return found_interval
;
240 inc_interval_count (i
)
257 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
263 root_interval (interval
)
266 register INTERVAL i
= interval
;
268 while (! ROOT_INTERVAL_P (i
))
275 /* Assuming that a left child exists, perform the following operation:
285 rotate_right (interval
)
289 INTERVAL B
= interval
->left
;
290 int old_total
= interval
->total_length
;
292 /* Deal with any Parent of A; make it point to B. */
293 if (! ROOT_INTERVAL_P (interval
))
294 if (AM_LEFT_CHILD (interval
))
295 interval
->parent
->left
= B
;
297 interval
->parent
->right
= B
;
298 B
->parent
= interval
->parent
;
300 /* Make B the parent of A */
303 interval
->parent
= B
;
305 /* Make A point to c */
307 if (! NULL_INTERVAL_P (i
))
308 i
->parent
= interval
;
310 /* A's total length is decreased by the length of B and its left child. */
311 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
313 /* B must have the same total length of A. */
314 B
->total_length
= old_total
;
319 /* Assuming that a right child exists, perform the following operation:
329 rotate_left (interval
)
333 INTERVAL B
= interval
->right
;
334 int old_total
= interval
->total_length
;
336 /* Deal with any parent of A; make it point to B. */
337 if (! ROOT_INTERVAL_P (interval
))
338 if (AM_LEFT_CHILD (interval
))
339 interval
->parent
->left
= B
;
341 interval
->parent
->right
= B
;
342 B
->parent
= interval
->parent
;
344 /* Make B the parent of A */
347 interval
->parent
= B
;
349 /* Make A point to c */
351 if (! NULL_INTERVAL_P (i
))
352 i
->parent
= interval
;
354 /* A's total length is decreased by the length of B and its right child. */
355 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
357 /* B must have the same total length of A. */
358 B
->total_length
= old_total
;
363 /* Balance an interval tree with the assumption that the subtrees
364 themselves are already balanced. */
367 balance_an_interval (i
)
370 register int old_diff
, new_diff
;
374 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
377 new_diff
= i
->total_length
- i
->left
->total_length
378 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
379 if (abs (new_diff
) >= old_diff
)
381 i
= rotate_right (i
);
382 balance_an_interval (i
->right
);
384 else if (old_diff
< 0)
386 new_diff
= i
->total_length
- i
->right
->total_length
387 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
388 if (abs (new_diff
) >= -old_diff
)
391 balance_an_interval (i
->left
);
399 /* Balance INTERVAL, potentially stuffing it back into its parent
402 static INLINE INTERVAL
403 balance_possible_root_interval (interval
)
404 register INTERVAL interval
;
408 if (interval
->parent
== NULL_INTERVAL
)
411 parent
= (Lisp_Object
) (interval
->parent
);
412 interval
= balance_an_interval (interval
);
414 if (BUFFERP (parent
))
415 XBUFFER (parent
)->intervals
= interval
;
416 else if (STRINGP (parent
))
417 XSTRING (parent
)->intervals
= interval
;
422 /* Balance the interval tree TREE. Balancing is by weight
423 (the amount of text). */
426 balance_intervals_internal (tree
)
427 register INTERVAL tree
;
429 /* Balance within each side. */
431 balance_intervals (tree
->left
);
433 balance_intervals (tree
->right
);
434 return balance_an_interval (tree
);
437 /* Advertised interface to balance intervals. */
440 balance_intervals (tree
)
443 if (tree
== NULL_INTERVAL
)
444 return NULL_INTERVAL
;
446 return balance_intervals_internal (tree
);
449 /* Split INTERVAL into two pieces, starting the second piece at
450 character position OFFSET (counting from 0), relative to INTERVAL.
451 INTERVAL becomes the left-hand piece, and the right-hand piece
452 (second, lexicographically) is returned.
454 The size and position fields of the two intervals are set based upon
455 those of the original interval. The property list of the new interval
456 is reset, thus it is up to the caller to do the right thing with the
459 Note that this does not change the position of INTERVAL; if it is a root,
460 it is still a root after this operation. */
463 split_interval_right (interval
, offset
)
467 INTERVAL
new = make_interval ();
468 int position
= interval
->position
;
469 int new_length
= LENGTH (interval
) - offset
;
471 new->position
= position
+ offset
;
472 new->parent
= interval
;
474 if (NULL_RIGHT_CHILD (interval
))
476 interval
->right
= new;
477 new->total_length
= new_length
;
482 /* Insert the new node between INTERVAL and its right child. */
483 new->right
= interval
->right
;
484 interval
->right
->parent
= new;
485 interval
->right
= new;
486 new->total_length
= new_length
+ new->right
->total_length
;
488 balance_an_interval (new);
489 balance_possible_root_interval (interval
);
494 /* Split INTERVAL into two pieces, starting the second piece at
495 character position OFFSET (counting from 0), relative to INTERVAL.
496 INTERVAL becomes the right-hand piece, and the left-hand piece
497 (first, lexicographically) is returned.
499 The size and position fields of the two intervals are set based upon
500 those of the original interval. The property list of the new interval
501 is reset, thus it is up to the caller to do the right thing with the
504 Note that this does not change the position of INTERVAL; if it is a root,
505 it is still a root after this operation. */
508 split_interval_left (interval
, offset
)
512 INTERVAL
new = make_interval ();
513 int position
= interval
->position
;
514 int new_length
= offset
;
516 new->position
= interval
->position
;
517 interval
->position
= interval
->position
+ offset
;
518 new->parent
= interval
;
520 if (NULL_LEFT_CHILD (interval
))
522 interval
->left
= new;
523 new->total_length
= new_length
;
528 /* Insert the new node between INTERVAL and its left child. */
529 new->left
= interval
->left
;
530 new->left
->parent
= new;
531 interval
->left
= new;
532 new->total_length
= new_length
+ new->left
->total_length
;
534 balance_an_interval (new);
535 balance_possible_root_interval (interval
);
540 /* Find the interval containing text position POSITION in the text
541 represented by the interval tree TREE. POSITION is a buffer
542 position; the earliest position is 1. If POSITION is at the end of
543 the buffer, return the interval containing the last character.
545 The `position' field, which is a cache of an interval's position,
546 is updated in the interval found. Other functions (e.g., next_interval)
547 will update this cache based on the result of find_interval. */
550 find_interval (tree
, position
)
551 register INTERVAL tree
;
552 register int position
;
554 /* The distance from the left edge of the subtree at TREE
556 register int relative_position
= position
- BEG
;
558 if (NULL_INTERVAL_P (tree
))
559 return NULL_INTERVAL
;
561 if (relative_position
> TOTAL_LENGTH (tree
))
562 abort (); /* Paranoia */
564 tree
= balance_possible_root_interval (tree
);
568 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
572 else if (! NULL_RIGHT_CHILD (tree
)
573 && relative_position
>= (TOTAL_LENGTH (tree
)
574 - RIGHT_TOTAL_LENGTH (tree
)))
576 relative_position
-= (TOTAL_LENGTH (tree
)
577 - RIGHT_TOTAL_LENGTH (tree
));
583 (position
- relative_position
/* the left edge of *tree */
584 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
591 /* Find the succeeding interval (lexicographically) to INTERVAL.
592 Sets the `position' field based on that of INTERVAL (see
596 next_interval (interval
)
597 register INTERVAL interval
;
599 register INTERVAL i
= interval
;
600 register int next_position
;
602 if (NULL_INTERVAL_P (i
))
603 return NULL_INTERVAL
;
604 next_position
= interval
->position
+ LENGTH (interval
);
606 if (! NULL_RIGHT_CHILD (i
))
609 while (! NULL_LEFT_CHILD (i
))
612 i
->position
= next_position
;
616 while (! NULL_PARENT (i
))
618 if (AM_LEFT_CHILD (i
))
621 i
->position
= next_position
;
628 return NULL_INTERVAL
;
631 /* Find the preceding interval (lexicographically) to INTERVAL.
632 Sets the `position' field based on that of INTERVAL (see
636 previous_interval (interval
)
637 register INTERVAL interval
;
640 register position_of_previous
;
642 if (NULL_INTERVAL_P (interval
))
643 return NULL_INTERVAL
;
645 if (! NULL_LEFT_CHILD (interval
))
648 while (! NULL_RIGHT_CHILD (i
))
651 i
->position
= interval
->position
- LENGTH (i
);
656 while (! NULL_PARENT (i
))
658 if (AM_RIGHT_CHILD (i
))
662 i
->position
= interval
->position
- LENGTH (i
);
668 return NULL_INTERVAL
;
672 /* Traverse a path down the interval tree TREE to the interval
673 containing POSITION, adjusting all nodes on the path for
674 an addition of LENGTH characters. Insertion between two intervals
675 (i.e., point == i->position, where i is second interval) means
676 text goes into second interval.
678 Modifications are needed to handle the hungry bits -- after simply
679 finding the interval at position (don't add length going down),
680 if it's the beginning of the interval, get the previous interval
681 and check the hugry bits of both. Then add the length going back up
685 adjust_intervals_for_insertion (tree
, position
, length
)
687 int position
, length
;
689 register int relative_position
;
690 register INTERVAL
this;
692 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
695 /* If inserting at point-max of a buffer, that position
696 will be out of range */
697 if (position
> TOTAL_LENGTH (tree
))
698 position
= TOTAL_LENGTH (tree
);
699 relative_position
= position
;
704 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
706 this->total_length
+= length
;
709 else if (relative_position
> (TOTAL_LENGTH (this)
710 - RIGHT_TOTAL_LENGTH (this)))
712 relative_position
-= (TOTAL_LENGTH (this)
713 - RIGHT_TOTAL_LENGTH (this));
714 this->total_length
+= length
;
719 /* If we are to use zero-length intervals as buffer pointers,
720 then this code will have to change. */
721 this->total_length
+= length
;
722 this->position
= LEFT_TOTAL_LENGTH (this)
723 + position
- relative_position
+ 1;
730 /* Effect an adjustment corresponding to the addition of LENGTH characters
731 of text. Do this by finding the interval containing POSITION in the
732 interval tree TREE, and then adjusting all of its ancestors by adding
735 If POSITION is the first character of an interval, meaning that point
736 is actually between the two intervals, make the new text belong to
737 the interval which is "sticky".
739 If both intervals are "sticky", then make them belong to the left-most
740 interval. Another possibility would be to create a new interval for
741 this text, and make it have the merged properties of both ends. */
744 adjust_intervals_for_insertion (tree
, position
, length
)
746 int position
, length
;
749 register INTERVAL temp
;
752 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
755 /* If inserting at point-max of a buffer, that position will be out
756 of range. Remember that buffer positions are 1-based. */
757 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
758 position
= BEG
+ TOTAL_LENGTH (tree
);
762 i
= find_interval (tree
, position
);
764 /* If in middle of an interval which is not sticky either way,
765 we must not just give its properties to the insertion.
766 So split this interval at the insertion point. */
767 if (! (position
== i
->position
|| eobp
)
768 && END_NONSTICKY_P (i
)
769 && ! FRONT_STICKY_P (i
))
771 temp
= split_interval_right (i
, position
- i
->position
);
772 copy_properties (i
, temp
);
776 /* If we are positioned between intervals, check the stickiness of
777 both of them. We have to do this too, if we are at BEG or Z. */
778 if (position
== i
->position
|| eobp
)
780 register INTERVAL prev
;
790 prev
= previous_interval (i
);
792 /* Even if we are positioned between intervals, we default
793 to the left one if it exists. We extend it now and split
794 off a part later, if stickyness demands it. */
795 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
797 temp
->total_length
+= length
;
798 temp
= balance_possible_root_interval (temp
);
801 /* If at least one interval has sticky properties,
802 we check the stickyness property by property. */
803 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
805 Lisp_Object pleft
, pright
;
806 struct interval newi
;
808 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
809 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
810 newi
.plist
= merge_properties_sticky (pleft
, pright
);
812 if(! prev
) /* i.e. position == BEG */
814 if (! intervals_equal (i
, &newi
))
816 i
= split_interval_left (i
, length
);
817 i
->plist
= newi
.plist
;
820 else if (! intervals_equal (prev
, &newi
))
822 prev
= split_interval_right (prev
,
823 position
- prev
->position
);
824 prev
->plist
= newi
.plist
;
825 if (! NULL_INTERVAL_P (i
)
826 && intervals_equal (prev
, i
))
827 merge_interval_right (prev
);
830 /* We will need to update the cache here later. */
832 else if (! prev
&& ! NILP (i
->plist
))
834 /* Just split off a new interval at the left.
835 Since I wasn't front-sticky, the empty plist is ok. */
836 i
= split_interval_left (i
, length
);
840 /* Otherwise just extend the interval. */
843 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
845 temp
->total_length
+= length
;
846 temp
= balance_possible_root_interval (temp
);
853 /* Any property might be front-sticky on the left, rear-sticky on the left,
854 front-sticky on the right, or rear-sticky on the right; the 16 combinations
855 can be arranged in a matrix with rows denoting the left conditions and
856 columns denoting the right conditions:
864 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
865 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
866 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
867 p8 L p9 L pa L pb L pc L pd L pe L pf L)
868 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
869 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
870 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
871 p8 R p9 R pa R pb R pc R pd R pe R pf R)
873 We inherit from whoever has a sticky side facing us. If both sides
874 do (cases 2, 3, E, and F), then we inherit from whichever side has a
875 non-nil value for the current property. If both sides do, then we take
878 When we inherit a property, we get its stickiness as well as its value.
879 So, when we merge the above two lists, we expect to get this:
881 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
882 rear-nonsticky (p6 pa)
883 p0 L p1 L p2 L p3 L p6 R p7 R
884 pa R pb R pc L pd L pe L pf L)
886 The optimizable special cases are:
887 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
888 left rear-nonsticky = t, right front-sticky = t (inherit right)
889 left rear-nonsticky = t, right front-sticky = nil (inherit none)
893 merge_properties_sticky (pleft
, pright
)
894 Lisp_Object pleft
, pright
;
896 register Lisp_Object props
, front
, rear
;
897 Lisp_Object lfront
, lrear
, rfront
, rrear
;
898 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
;
899 int use_left
, use_right
;
904 lfront
= textget (pleft
, Qfront_sticky
);
905 lrear
= textget (pleft
, Qrear_nonsticky
);
906 rfront
= textget (pright
, Qfront_sticky
);
907 rrear
= textget (pright
, Qrear_nonsticky
);
909 /* Go through each element of PRIGHT. */
910 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
914 /* Sticky properties get special treatment. */
915 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
918 rval
= Fcar (Fcdr (tail1
));
919 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
920 if (EQ (sym
, Fcar (tail2
)))
922 lval
= (NILP (tail2
) ? Qnil
: Fcar( Fcdr (tail2
)));
924 use_left
= ! TMEM (sym
, lrear
);
925 use_right
= TMEM (sym
, rfront
);
926 if (use_left
&& use_right
)
928 use_left
= ! NILP (lval
);
929 use_right
= ! NILP (rval
);
933 /* We build props as (value sym ...) rather than (sym value ...)
934 because we plan to nreverse it when we're done. */
936 props
= Fcons (lval
, Fcons (sym
, props
));
937 if (TMEM (sym
, lfront
))
938 front
= Fcons (sym
, front
);
939 if (TMEM (sym
, lrear
))
940 rear
= Fcons (sym
, rear
);
945 props
= Fcons (rval
, Fcons (sym
, props
));
946 if (TMEM (sym
, rfront
))
947 front
= Fcons (sym
, front
);
948 if (TMEM (sym
, rrear
))
949 rear
= Fcons (sym
, rear
);
953 /* Now go through each element of PLEFT. */
954 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
958 /* Sticky properties get special treatment. */
959 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
962 /* If sym is in PRIGHT, we've already considered it. */
963 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
964 if (EQ (sym
, Fcar (tail1
)))
969 lval
= Fcar (Fcdr (tail2
));
971 /* Since rval is known to be nil in this loop, the test simplifies. */
972 if (! TMEM (sym
, lrear
))
975 props
= Fcons (lval
, Fcons (sym
, props
));
976 if (TMEM (sym
, lfront
))
977 front
= Fcons (sym
, front
);
979 else if (TMEM (sym
, rfront
))
981 /* The value is nil, but we still inherit the stickiness
983 front
= Fcons (sym
, front
);
984 if (TMEM (sym
, rrear
))
985 rear
= Fcons (sym
, rear
);
988 props
= Fnreverse (props
);
990 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
992 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
997 /* Delete an node I from its interval tree by merging its subtrees
998 into one subtree which is then returned. Caller is responsible for
999 storing the resulting subtree into its parent. */
1003 register INTERVAL i
;
1005 register INTERVAL migrate
, this;
1006 register int migrate_amt
;
1008 if (NULL_INTERVAL_P (i
->left
))
1010 if (NULL_INTERVAL_P (i
->right
))
1014 migrate_amt
= i
->left
->total_length
;
1016 this->total_length
+= migrate_amt
;
1017 while (! NULL_INTERVAL_P (this->left
))
1020 this->total_length
+= migrate_amt
;
1022 this->left
= migrate
;
1023 migrate
->parent
= this;
1028 /* Delete interval I from its tree by calling `delete_node'
1029 and properly connecting the resultant subtree.
1031 I is presumed to be empty; that is, no adjustments are made
1032 for the length of I. */
1036 register INTERVAL i
;
1038 register INTERVAL parent
;
1039 int amt
= LENGTH (i
);
1041 if (amt
> 0) /* Only used on zero-length intervals now. */
1044 if (ROOT_INTERVAL_P (i
))
1047 owner
= (Lisp_Object
) i
->parent
;
1048 parent
= delete_node (i
);
1049 if (! NULL_INTERVAL_P (parent
))
1050 parent
->parent
= (INTERVAL
) owner
;
1052 if (BUFFERP (owner
))
1053 XBUFFER (owner
)->intervals
= parent
;
1054 else if (STRINGP (owner
))
1055 XSTRING (owner
)->intervals
= parent
;
1063 if (AM_LEFT_CHILD (i
))
1065 parent
->left
= delete_node (i
);
1066 if (! NULL_INTERVAL_P (parent
->left
))
1067 parent
->left
->parent
= parent
;
1071 parent
->right
= delete_node (i
);
1072 if (! NULL_INTERVAL_P (parent
->right
))
1073 parent
->right
->parent
= parent
;
1077 /* Find the interval in TREE corresponding to the relative position
1078 FROM and delete as much as possible of AMOUNT from that interval.
1079 Return the amount actually deleted, and if the interval was
1080 zeroed-out, delete that interval node from the tree.
1082 Note that FROM is actually origin zero, aka relative to the
1083 leftmost edge of tree. This is appropriate since we call ourselves
1084 recursively on subtrees.
1086 Do this by recursing down TREE to the interval in question, and
1087 deleting the appropriate amount of text. */
1090 interval_deletion_adjustment (tree
, from
, amount
)
1091 register INTERVAL tree
;
1092 register int from
, amount
;
1094 register int relative_position
= from
;
1096 if (NULL_INTERVAL_P (tree
))
1100 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1102 int subtract
= interval_deletion_adjustment (tree
->left
,
1105 tree
->total_length
-= subtract
;
1109 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1110 - RIGHT_TOTAL_LENGTH (tree
)))
1114 relative_position
-= (tree
->total_length
1115 - RIGHT_TOTAL_LENGTH (tree
));
1116 subtract
= interval_deletion_adjustment (tree
->right
,
1119 tree
->total_length
-= subtract
;
1122 /* Here -- this node. */
1125 /* How much can we delete from this interval? */
1126 int my_amount
= ((tree
->total_length
1127 - RIGHT_TOTAL_LENGTH (tree
))
1128 - relative_position
);
1130 if (amount
> my_amount
)
1133 tree
->total_length
-= amount
;
1134 if (LENGTH (tree
) == 0)
1135 delete_interval (tree
);
1140 /* Never reach here. */
1143 /* Effect the adjustments necessary to the interval tree of BUFFER to
1144 correspond to the deletion of LENGTH characters from that buffer
1145 text. The deletion is effected at position START (which is a
1146 buffer position, i.e. origin 1). */
1149 adjust_intervals_for_deletion (buffer
, start
, length
)
1150 struct buffer
*buffer
;
1153 register int left_to_delete
= length
;
1154 register INTERVAL tree
= buffer
->intervals
;
1155 register int deleted
;
1157 if (NULL_INTERVAL_P (tree
))
1160 if (start
> BEG
+ TOTAL_LENGTH (tree
)
1161 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
1164 if (length
== TOTAL_LENGTH (tree
))
1166 buffer
->intervals
= NULL_INTERVAL
;
1170 if (ONLY_INTERVAL_P (tree
))
1172 tree
->total_length
-= length
;
1176 if (start
> BEG
+ TOTAL_LENGTH (tree
))
1177 start
= BEG
+ TOTAL_LENGTH (tree
);
1178 while (left_to_delete
> 0)
1180 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
1182 tree
= buffer
->intervals
;
1183 if (left_to_delete
== tree
->total_length
)
1185 buffer
->intervals
= NULL_INTERVAL
;
1191 /* Make the adjustments necessary to the interval tree of BUFFER to
1192 represent an addition or deletion of LENGTH characters starting
1193 at position START. Addition or deletion is indicated by the sign
1197 offset_intervals (buffer
, start
, length
)
1198 struct buffer
*buffer
;
1201 if (NULL_INTERVAL_P (buffer
->intervals
) || length
== 0)
1205 adjust_intervals_for_insertion (buffer
->intervals
, start
, length
);
1207 adjust_intervals_for_deletion (buffer
, start
, -length
);
1210 /* Merge interval I with its lexicographic successor. The resulting
1211 interval is returned, and has the properties of the original
1212 successor. The properties of I are lost. I is removed from the
1216 The caller must verify that this is not the last (rightmost)
1220 merge_interval_right (i
)
1221 register INTERVAL i
;
1223 register int absorb
= LENGTH (i
);
1224 register INTERVAL successor
;
1226 /* Zero out this interval. */
1227 i
->total_length
-= absorb
;
1229 /* Find the succeeding interval. */
1230 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1233 successor
= i
->right
;
1234 while (! NULL_LEFT_CHILD (successor
))
1236 successor
->total_length
+= absorb
;
1237 successor
= successor
->left
;
1240 successor
->total_length
+= absorb
;
1241 delete_interval (i
);
1246 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1249 if (AM_LEFT_CHILD (successor
))
1251 successor
= successor
->parent
;
1252 delete_interval (i
);
1256 successor
= successor
->parent
;
1257 successor
->total_length
-= absorb
;
1260 /* This must be the rightmost or last interval and cannot
1261 be merged right. The caller should have known. */
1265 /* Merge interval I with its lexicographic predecessor. The resulting
1266 interval is returned, and has the properties of the original predecessor.
1267 The properties of I are lost. Interval node I is removed from the tree.
1270 The caller must verify that this is not the first (leftmost) interval. */
1273 merge_interval_left (i
)
1274 register INTERVAL i
;
1276 register int absorb
= LENGTH (i
);
1277 register INTERVAL predecessor
;
1279 /* Zero out this interval. */
1280 i
->total_length
-= absorb
;
1282 /* Find the preceding interval. */
1283 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1284 adding ABSORB as we go. */
1286 predecessor
= i
->left
;
1287 while (! NULL_RIGHT_CHILD (predecessor
))
1289 predecessor
->total_length
+= absorb
;
1290 predecessor
= predecessor
->right
;
1293 predecessor
->total_length
+= absorb
;
1294 delete_interval (i
);
1299 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1300 subtracting ABSORB. */
1302 if (AM_RIGHT_CHILD (predecessor
))
1304 predecessor
= predecessor
->parent
;
1305 delete_interval (i
);
1309 predecessor
= predecessor
->parent
;
1310 predecessor
->total_length
-= absorb
;
1313 /* This must be the leftmost or first interval and cannot
1314 be merged left. The caller should have known. */
1318 /* Make an exact copy of interval tree SOURCE which descends from
1319 PARENT. This is done by recursing through SOURCE, copying
1320 the current interval and its properties, and then adjusting
1321 the pointers of the copy. */
1324 reproduce_tree (source
, parent
)
1325 INTERVAL source
, parent
;
1327 register INTERVAL t
= make_interval ();
1329 bcopy (source
, t
, INTERVAL_SIZE
);
1330 copy_properties (source
, t
);
1332 if (! NULL_LEFT_CHILD (source
))
1333 t
->left
= reproduce_tree (source
->left
, t
);
1334 if (! NULL_RIGHT_CHILD (source
))
1335 t
->right
= reproduce_tree (source
->right
, t
);
1341 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1343 /* Make a new interval of length LENGTH starting at START in the
1344 group of intervals INTERVALS, which is actually an interval tree.
1345 Returns the new interval.
1347 Generate an error if the new positions would overlap an existing
1351 make_new_interval (intervals
, start
, length
)
1357 slot
= find_interval (intervals
, start
);
1358 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1359 error ("Interval would overlap");
1361 if (start
== slot
->position
&& length
== LENGTH (slot
))
1364 if (slot
->position
== start
)
1366 /* New right node. */
1367 split_interval_right (slot
, length
);
1371 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1373 /* New left node. */
1374 split_interval_left (slot
, LENGTH (slot
) - length
);
1378 /* Convert interval SLOT into three intervals. */
1379 split_interval_left (slot
, start
- slot
->position
);
1380 split_interval_right (slot
, length
);
1385 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1386 LENGTH is the length of the text in SOURCE.
1388 This is used in insdel.c when inserting Lisp_Strings into the
1389 buffer. The text corresponding to SOURCE is already in the buffer
1390 when this is called. The intervals of new tree are a copy of those
1391 belonging to the string being inserted; intervals are never
1394 If the inserted text had no intervals associated, and we don't
1395 want to inherit the surrounding text's properties, this function
1396 simply returns -- offset_intervals should handle placing the
1397 text in the correct interval, depending on the sticky bits.
1399 If the inserted text had properties (intervals), then there are two
1400 cases -- either insertion happened in the middle of some interval,
1401 or between two intervals.
1403 If the text goes into the middle of an interval, then new
1404 intervals are created in the middle with only the properties of
1405 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1406 which case the new text has the union of its properties and those
1407 of the text into which it was inserted.
1409 If the text goes between two intervals, then if neither interval
1410 had its appropriate sticky property set (front_sticky, rear_sticky),
1411 the new text has only its properties. If one of the sticky properties
1412 is set, then the new text "sticks" to that region and its properties
1413 depend on merging as above. If both the preceding and succeeding
1414 intervals to the new text are "sticky", then the new text retains
1415 only its properties, as if neither sticky property were set. Perhaps
1416 we should consider merging all three sets of properties onto the new
1420 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1422 int position
, length
;
1423 struct buffer
*buffer
;
1426 register INTERVAL under
, over
, this, prev
;
1427 register INTERVAL tree
= buffer
->intervals
;
1430 /* If the new text has no properties, it becomes part of whatever
1431 interval it was inserted into. */
1432 if (NULL_INTERVAL_P (source
))
1435 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1437 XSETBUFFER (buf
, buffer
);
1438 Fset_text_properties (make_number (position
),
1439 make_number (position
+ length
),
1442 if (! NULL_INTERVAL_P (buffer
->intervals
))
1443 buffer
->intervals
= balance_an_interval (buffer
->intervals
);
1447 if (NULL_INTERVAL_P (tree
))
1449 /* The inserted text constitutes the whole buffer, so
1450 simply copy over the interval structure. */
1451 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1454 XSETBUFFER (buf
, buffer
);
1455 buffer
->intervals
= reproduce_tree (source
, buf
);
1456 /* Explicitly free the old tree here. */
1461 /* Create an interval tree in which to place a copy
1462 of the intervals of the inserted string. */
1465 XSETBUFFER (buf
, buffer
);
1466 tree
= create_root_interval (buf
);
1469 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1470 /* If the buffer contains only the new string, but
1471 there was already some interval tree there, then it may be
1472 some zero length intervals. Eventually, do something clever
1473 about inserting properly. For now, just waste the old intervals. */
1475 buffer
->intervals
= reproduce_tree (source
, tree
->parent
);
1476 /* Explicitly free the old tree here. */
1480 /* Paranoia -- the text has already been added, so this buffer
1481 should be of non-zero length. */
1482 else if (TOTAL_LENGTH (tree
) == 0)
1485 this = under
= find_interval (tree
, position
);
1486 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1488 over
= find_interval (source
, 1);
1490 /* Here for insertion in the middle of an interval.
1491 Split off an equivalent interval to the right,
1492 then don't bother with it any more. */
1494 if (position
> under
->position
)
1496 INTERVAL end_unchanged
1497 = split_interval_left (this, position
- under
->position
);
1498 copy_properties (under
, end_unchanged
);
1499 under
->position
= position
;
1505 prev
= previous_interval (under
);
1506 if (prev
&& !END_NONSTICKY_P (prev
))
1510 /* Insertion is now at beginning of UNDER. */
1512 /* The inserted text "sticks" to the interval `under',
1513 which means it gets those properties.
1514 The properties of under are the result of
1515 adjust_intervals_for_insertion, so stickyness has
1516 already been taken care of. */
1518 while (! NULL_INTERVAL_P (over
))
1520 if (LENGTH (over
) < LENGTH (under
))
1522 this = split_interval_left (under
, LENGTH (over
));
1523 copy_properties (under
, this);
1527 copy_properties (over
, this);
1529 merge_properties (over
, this);
1531 copy_properties (over
, this);
1532 over
= next_interval (over
);
1535 if (! NULL_INTERVAL_P (buffer
->intervals
))
1536 buffer
->intervals
= balance_an_interval (buffer
->intervals
);
1540 /* Get the value of property PROP from PLIST,
1541 which is the plist of an interval.
1542 We check for direct properties and for categories with property PROP. */
1545 textget (plist
, prop
)
1547 register Lisp_Object prop
;
1549 register Lisp_Object tail
, fallback
;
1552 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1554 register Lisp_Object tem
;
1557 return Fcar (Fcdr (tail
));
1558 if (EQ (tem
, Qcategory
))
1560 tem
= Fcar (Fcdr (tail
));
1562 fallback
= Fget (tem
, prop
);
1569 /* Get the value of property PROP from PLIST,
1570 which is the plist of an interval.
1571 We check for direct properties only! */
1574 textget_direct (plist
, prop
)
1576 register Lisp_Object prop
;
1578 register Lisp_Object tail
;
1580 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1582 if (EQ (prop
, Fcar (tail
)))
1583 return Fcar (Fcdr (tail
));
1589 /* Set point in BUFFER to POSITION. If the target position is
1590 before an intangible character, move to an ok place. */
1593 set_point (position
, buffer
)
1594 register int position
;
1595 register struct buffer
*buffer
;
1597 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1599 register Lisp_Object obj
;
1600 int backwards
= (position
< BUF_PT (buffer
)) ? 1 : 0;
1601 int old_position
= buffer
->text
.pt
;
1603 if (position
== buffer
->text
.pt
)
1606 /* Check this now, before checking if the buffer has any intervals.
1607 That way, we can catch conditions which break this sanity check
1608 whether or not there are intervals in the buffer. */
1609 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1612 if (NULL_INTERVAL_P (buffer
->intervals
))
1614 buffer
->text
.pt
= position
;
1618 /* Set TO to the interval containing the char after POSITION,
1619 and TOPREV to the interval containing the char before POSITION.
1620 Either one may be null. They may be equal. */
1621 to
= find_interval (buffer
->intervals
, position
);
1622 if (position
== BUF_BEGV (buffer
))
1624 else if (to
->position
== position
)
1625 toprev
= previous_interval (to
);
1629 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1630 ? BUF_ZV (buffer
) - 1
1633 /* Set FROM to the interval containing the char after PT,
1634 and FROMPREV to the interval containing the char before PT.
1635 Either one may be null. They may be equal. */
1636 /* We could cache this and save time. */
1637 from
= find_interval (buffer
->intervals
, buffer_point
);
1638 if (buffer_point
== BUF_BEGV (buffer
))
1640 else if (from
->position
== BUF_PT (buffer
))
1641 fromprev
= previous_interval (from
);
1642 else if (buffer_point
!= BUF_PT (buffer
))
1643 fromprev
= from
, from
= 0;
1647 /* Moving within an interval. */
1648 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
))
1650 buffer
->text
.pt
= position
;
1654 /* If the new position is between two intangible characters,
1655 move forward or backward across all such characters. */
1656 if (NILP (Vinhibit_point_motion_hooks
) && ! NULL_INTERVAL_P (to
)
1657 && ! NULL_INTERVAL_P (toprev
))
1661 /* Make sure the following character is intangible
1662 if the previous one is. */
1664 || ! NILP (textget (to
->plist
, Qintangible
)))
1665 /* Ok, that is so. Back up across intangible text. */
1666 while (! NULL_INTERVAL_P (toprev
)
1667 && ! NILP (textget (toprev
->plist
, Qintangible
)))
1670 toprev
= previous_interval (toprev
);
1671 if (NULL_INTERVAL_P (toprev
))
1672 position
= BUF_BEGV (buffer
);
1674 /* This is the only line that's not
1675 dual to the following loop.
1676 That's because we want the position
1677 at the end of TOPREV. */
1678 position
= to
->position
;
1683 /* Make sure the previous character is intangible
1684 if the following one is. */
1686 || ! NILP (textget (toprev
->plist
, Qintangible
)))
1687 /* Ok, that is so. Advance across intangible text. */
1688 while (! NULL_INTERVAL_P (to
)
1689 && ! NILP (textget (to
->plist
, Qintangible
)))
1692 to
= next_interval (to
);
1693 if (NULL_INTERVAL_P (to
))
1694 position
= BUF_ZV (buffer
);
1696 position
= to
->position
;
1699 /* Here TO is the interval after the stopping point
1700 and TOPREV is the interval before the stopping point.
1701 One or the other may be null. */
1704 buffer
->text
.pt
= position
;
1706 /* We run point-left and point-entered hooks here, iff the
1707 two intervals are not equivalent. These hooks take
1708 (old_point, new_point) as arguments. */
1709 if (NILP (Vinhibit_point_motion_hooks
)
1710 && (! intervals_equal (from
, to
)
1711 || ! intervals_equal (fromprev
, toprev
)))
1713 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1716 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1720 leave_before
= textget (from
->plist
, Qpoint_left
);
1722 leave_before
= Qnil
;
1725 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1729 enter_before
= textget (to
->plist
, Qpoint_entered
);
1731 enter_before
= Qnil
;
1733 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1734 call2 (leave_before
, old_position
, position
);
1735 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1736 call2 (leave_after
, old_position
, position
);
1738 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1739 call2 (enter_before
, old_position
, position
);
1740 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1741 call2 (enter_after
, old_position
, position
);
1745 /* Set point temporarily, without checking any text properties. */
1748 temp_set_point (position
, buffer
)
1750 struct buffer
*buffer
;
1752 buffer
->text
.pt
= position
;
1755 /* Return the proper local map for position POSITION in BUFFER.
1756 Use the map specified by the local-map property, if any.
1757 Otherwise, use BUFFER's local map. */
1760 get_local_map (position
, buffer
)
1761 register int position
;
1762 register struct buffer
*buffer
;
1764 register INTERVAL interval
;
1765 Lisp_Object prop
, tem
;
1767 if (NULL_INTERVAL_P (buffer
->intervals
))
1768 return current_buffer
->keymap
;
1770 /* Perhaps we should just change `position' to the limit. */
1771 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1774 interval
= find_interval (buffer
->intervals
, position
);
1775 prop
= textget (interval
->plist
, Qlocal_map
);
1777 return current_buffer
->keymap
;
1779 /* Use the local map only if it is valid. */
1780 tem
= Fkeymapp (prop
);
1784 return current_buffer
->keymap
;
1787 /* Call the modification hook functions in LIST, each with START and END. */
1790 call_mod_hooks (list
, start
, end
)
1791 Lisp_Object list
, start
, end
;
1793 struct gcpro gcpro1
;
1795 while (!NILP (list
))
1797 call2 (Fcar (list
), start
, end
);
1803 /* Check for read-only intervals and signal an error if we find one.
1804 Then check for any modification hooks in the range START up to
1805 (but not including) END. Create a list of all these hooks in
1806 lexicographic order, eliminating consecutive extra copies of the
1807 same hook. Then call those hooks in order, with START and END - 1
1811 verify_interval_modification (buf
, start
, end
)
1815 register INTERVAL intervals
= buf
->intervals
;
1816 register INTERVAL i
, prev
;
1818 register Lisp_Object prev_mod_hooks
;
1819 Lisp_Object mod_hooks
;
1820 struct gcpro gcpro1
;
1823 prev_mod_hooks
= Qnil
;
1826 if (NULL_INTERVAL_P (intervals
))
1836 /* For an insert operation, check the two chars around the position. */
1840 Lisp_Object before
, after
;
1842 /* Set I to the interval containing the char after START,
1843 and PREV to the interval containing the char before START.
1844 Either one may be null. They may be equal. */
1845 i
= find_interval (intervals
, start
);
1847 if (start
== BUF_BEGV (buf
))
1849 else if (i
->position
== start
)
1850 prev
= previous_interval (i
);
1851 else if (i
->position
< start
)
1853 if (start
== BUF_ZV (buf
))
1856 /* If Vinhibit_read_only is set and is not a list, we can
1857 skip the read_only checks. */
1858 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1860 /* If I and PREV differ we need to check for the read-only
1861 property together with its stickyness. If either I or
1862 PREV are 0, this check is all we need.
1863 We have to take special care, since read-only may be
1864 indirectly defined via the category property. */
1867 if (! NULL_INTERVAL_P (i
))
1869 after
= textget (i
->plist
, Qread_only
);
1871 /* If interval I is read-only and read-only is
1872 front-sticky, inhibit insertion.
1873 Check for read-only as well as category. */
1875 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1879 tem
= textget (i
->plist
, Qfront_sticky
);
1880 if (TMEM (Qread_only
, tem
)
1881 || (NILP (textget_direct (i
->plist
, Qread_only
))
1882 && TMEM (Qcategory
, tem
)))
1883 error ("Attempt to insert within read-only text");
1887 if (! NULL_INTERVAL_P (prev
))
1889 before
= textget (prev
->plist
, Qread_only
);
1891 /* If interval PREV is read-only and read-only isn't
1892 rear-nonsticky, inhibit insertion.
1893 Check for read-only as well as category. */
1895 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1899 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1900 if (! TMEM (Qread_only
, tem
)
1901 && (! NILP (textget_direct (prev
->plist
,Qread_only
))
1902 || ! TMEM (Qcategory
, tem
)))
1903 error ("Attempt to insert within read-only text");
1907 else if (! NULL_INTERVAL_P (i
))
1909 after
= textget (i
->plist
, Qread_only
);
1911 /* If interval I is read-only and read-only is
1912 front-sticky, inhibit insertion.
1913 Check for read-only as well as category. */
1914 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1918 tem
= textget (i
->plist
, Qfront_sticky
);
1919 if (TMEM (Qread_only
, tem
)
1920 || (NILP (textget_direct (i
->plist
, Qread_only
))
1921 && TMEM (Qcategory
, tem
)))
1922 error ("Attempt to insert within read-only text");
1924 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1925 if (! TMEM (Qread_only
, tem
)
1926 && (! NILP (textget_direct (prev
->plist
, Qread_only
))
1927 || ! TMEM (Qcategory
, tem
)))
1928 error ("Attempt to insert within read-only text");
1933 /* Run both insert hooks (just once if they're the same). */
1934 if (!NULL_INTERVAL_P (prev
))
1935 prev_mod_hooks
= textget (prev
->plist
, Qinsert_behind_hooks
);
1936 if (!NULL_INTERVAL_P (i
))
1937 mod_hooks
= textget (i
->plist
, Qinsert_in_front_hooks
);
1939 if (! NILP (prev_mod_hooks
))
1940 call_mod_hooks (prev_mod_hooks
, make_number (start
),
1943 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1944 call_mod_hooks (mod_hooks
, make_number (start
), make_number (end
));
1948 /* Loop over intervals on or next to START...END,
1949 collecting their hooks. */
1951 i
= find_interval (intervals
, start
);
1954 if (! INTERVAL_WRITABLE_P (i
))
1955 error ("Attempt to modify read-only text");
1957 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1958 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1960 hooks
= Fcons (mod_hooks
, hooks
);
1961 prev_mod_hooks
= mod_hooks
;
1964 i
= next_interval (i
);
1966 /* Keep going thru the interval containing the char before END. */
1967 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1970 hooks
= Fnreverse (hooks
);
1971 while (! EQ (hooks
, Qnil
))
1973 call_mod_hooks (Fcar (hooks
), make_number (start
),
1975 hooks
= Fcdr (hooks
);
1981 /* Produce an interval tree reflecting the intervals in
1982 TREE from START to START + LENGTH. */
1985 copy_intervals (tree
, start
, length
)
1989 register INTERVAL i
, new, t
;
1990 register int got
, prevlen
;
1992 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1993 return NULL_INTERVAL
;
1995 i
= find_interval (tree
, start
);
1996 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1999 /* If there is only one interval and it's the default, return nil. */
2000 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2001 && DEFAULT_INTERVAL_P (i
))
2002 return NULL_INTERVAL
;
2004 new = make_interval ();
2006 got
= (LENGTH (i
) - (start
- i
->position
));
2007 new->total_length
= length
;
2008 copy_properties (i
, new);
2012 while (got
< length
)
2014 i
= next_interval (i
);
2015 t
= split_interval_right (t
, prevlen
);
2016 copy_properties (i
, t
);
2017 prevlen
= LENGTH (i
);
2021 return balance_an_interval (new);
2024 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2027 copy_intervals_to_string (string
, buffer
, position
, length
)
2028 Lisp_Object string
, buffer
;
2029 int position
, length
;
2031 INTERVAL interval_copy
= copy_intervals (XBUFFER (buffer
)->intervals
,
2033 if (NULL_INTERVAL_P (interval_copy
))
2036 interval_copy
->parent
= (INTERVAL
) string
;
2037 XSTRING (string
)->intervals
= interval_copy
;
2040 #endif /* USE_TEXT_PROPERTIES */