1 /* Code for doing intervals.
2 Copyright (C) 1993 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 1, 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"
46 /* The rest of the file is within this conditional. */
47 #ifdef USE_TEXT_PROPERTIES
49 /* Factor for weight-balancing interval trees. */
50 Lisp_Object interval_balance_threshold
;
52 /* Utility functions for intervals. */
55 /* Create the root interval of some object, a buffer or string. */
58 create_root_interval (parent
)
61 INTERVAL
new = make_interval ();
63 if (XTYPE (parent
) == Lisp_Buffer
)
65 new->total_length
= BUF_Z (XBUFFER (parent
)) - 1;
66 XBUFFER (parent
)->intervals
= new;
68 else if (XTYPE (parent
) == Lisp_String
)
70 new->total_length
= XSTRING (parent
)->size
;
71 XSTRING (parent
)->intervals
= new;
74 new->parent
= (INTERVAL
) parent
;
80 /* Make the interval TARGET have exactly the properties of SOURCE */
83 copy_properties (source
, target
)
84 register INTERVAL source
, target
;
86 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
89 COPY_INTERVAL_CACHE (source
, target
);
90 target
->plist
= Fcopy_sequence (source
->plist
);
93 /* Merge the properties of interval SOURCE into the properties
94 of interval TARGET. That is to say, each property in SOURCE
95 is added to TARGET if TARGET has no such property as yet. */
98 merge_properties (source
, target
)
99 register INTERVAL source
, target
;
101 register Lisp_Object o
, sym
, val
;
103 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
106 MERGE_INTERVAL_CACHE (source
, target
);
109 while (! EQ (o
, Qnil
))
112 val
= Fmemq (sym
, target
->plist
);
118 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
126 /* Return 1 if the two intervals have the same properties,
130 intervals_equal (i0
, i1
)
133 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
136 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
139 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
142 i1_len
= XFASTINT (Flength (i1
->plist
));
143 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
147 while (!NILP (i0_cdr
))
149 /* Lengths of the two plists were unequal */
153 i0_sym
= Fcar (i0_cdr
);
154 i1_val
= Fmemq (i0_sym
, i1
->plist
);
156 /* i0 has something i1 doesn't */
157 if (EQ (i1_val
, Qnil
))
160 /* i0 and i1 both have sym, but it has different values in each */
161 i0_cdr
= Fcdr (i0_cdr
);
162 if (! EQ (i1_val
, Fcar (i0_cdr
)))
165 i0_cdr
= Fcdr (i0_cdr
);
169 /* Lengths of the two plists were unequal */
178 static int zero_length
;
180 /* Traverse an interval tree TREE, performing FUNCTION on each node.
181 Pass FUNCTION two args: an interval, and ARG. */
184 traverse_intervals (tree
, position
, depth
, function
, arg
)
187 void (* function
) ();
190 if (NULL_INTERVAL_P (tree
))
193 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
194 position
+= LEFT_TOTAL_LENGTH (tree
);
195 tree
->position
= position
;
196 (*function
) (tree
, arg
);
197 position
+= LENGTH (tree
);
198 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
202 /* These functions are temporary, for debugging purposes only. */
204 INTERVAL search_interval
, found_interval
;
207 check_for_interval (i
)
210 if (i
== search_interval
)
218 search_for_interval (i
, tree
)
219 register INTERVAL i
, tree
;
223 found_interval
= NULL_INTERVAL
;
224 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
225 return found_interval
;
229 inc_interval_count (i
)
246 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
252 root_interval (interval
)
255 register INTERVAL i
= interval
;
257 while (! ROOT_INTERVAL_P (i
))
264 /* Assuming that a left child exists, perform the following operation:
274 rotate_right (interval
)
278 INTERVAL B
= interval
->left
;
279 int len
= LENGTH (interval
);
281 /* Deal with any Parent of A; make it point to B. */
282 if (! ROOT_INTERVAL_P (interval
))
283 if (AM_LEFT_CHILD (interval
))
284 interval
->parent
->left
= interval
->left
;
286 interval
->parent
->right
= interval
->left
;
287 interval
->left
->parent
= interval
->parent
;
289 /* B gets the same length as A, since it get A's position in the tree. */
290 interval
->left
->total_length
= interval
->total_length
;
292 /* B becomes the parent of A. */
293 i
= interval
->left
->right
;
294 interval
->left
->right
= interval
;
295 interval
->parent
= interval
->left
;
297 /* A gets c as left child. */
299 if (! NULL_INTERVAL_P (i
))
300 i
->parent
= interval
;
301 interval
->total_length
= (len
+ LEFT_TOTAL_LENGTH (interval
)
302 + RIGHT_TOTAL_LENGTH (interval
));
307 /* Assuming that a right child exists, perform the following operation:
317 rotate_left (interval
)
321 INTERVAL B
= interval
->right
;
322 int len
= LENGTH (interval
);
324 /* Deal with the parent of A. */
325 if (! ROOT_INTERVAL_P (interval
))
326 if (AM_LEFT_CHILD (interval
))
327 interval
->parent
->left
= interval
->right
;
329 interval
->parent
->right
= interval
->right
;
330 interval
->right
->parent
= interval
->parent
;
332 /* B must have the same total length of A. */
333 interval
->right
->total_length
= interval
->total_length
;
335 /* Make B the parent of A */
336 i
= interval
->right
->left
;
337 interval
->right
->left
= interval
;
338 interval
->parent
= interval
->right
;
340 /* Make A point to c */
342 if (! NULL_INTERVAL_P (i
))
343 i
->parent
= interval
;
344 interval
->total_length
= (len
+ LEFT_TOTAL_LENGTH (interval
)
345 + RIGHT_TOTAL_LENGTH (interval
));
350 /* Split INTERVAL into two pieces, starting the second piece at character
351 position OFFSET (counting from 1), relative to INTERVAL. The right-hand
352 piece (second, lexicographically) is returned.
354 The size and position fields of the two intervals are set based upon
355 those of the original interval. The property list of the new interval
356 is reset, thus it is up to the caller to do the right thing with the
359 Note that this does not change the position of INTERVAL; if it is a root,
360 it is still a root after this operation. */
363 split_interval_right (interval
, offset
)
367 INTERVAL
new = make_interval ();
368 int position
= interval
->position
;
369 int new_length
= LENGTH (interval
) - offset
+ 1;
371 new->position
= position
+ offset
- 1;
372 new->parent
= interval
;
374 if (LEAF_INTERVAL_P (interval
) || NULL_RIGHT_CHILD (interval
))
376 interval
->right
= new;
377 new->total_length
= new_length
;
382 /* Insert the new node between INTERVAL and its right child. */
383 new->right
= interval
->right
;
384 interval
->right
->parent
= new;
385 interval
->right
= new;
387 new->total_length
= new_length
+ new->right
->total_length
;
392 /* Split INTERVAL into two pieces, starting the second piece at character
393 position OFFSET (counting from 1), relative to INTERVAL. The left-hand
394 piece (first, lexicographically) is returned.
396 The size and position fields of the two intervals are set based upon
397 those of the original interval. The property list of the new interval
398 is reset, thus it is up to the caller to do the right thing with the
401 Note that this does not change the position of INTERVAL; if it is a root,
402 it is still a root after this operation. */
405 split_interval_left (interval
, offset
)
409 INTERVAL
new = make_interval ();
410 int position
= interval
->position
;
411 int new_length
= offset
- 1;
413 new->position
= interval
->position
;
414 interval
->position
= interval
->position
+ offset
- 1;
415 new->parent
= interval
;
417 if (NULL_LEFT_CHILD (interval
))
419 interval
->left
= new;
420 new->total_length
= new_length
;
425 /* Insert the new node between INTERVAL and its left child. */
426 new->left
= interval
->left
;
427 new->left
->parent
= new;
428 interval
->left
= new;
429 new->total_length
= new_length
+ LEFT_TOTAL_LENGTH (new);
434 /* Find the interval containing text position POSITION in the text
435 represented by the interval tree TREE. POSITION is a buffer
436 position; the earliest position is 1. If POSITION is at the end of
437 the buffer, return the interval containing the last character.
439 The `position' field, which is a cache of an interval's position,
440 is updated in the interval found. Other functions (e.g., next_interval)
441 will update this cache based on the result of find_interval. */
444 find_interval (tree
, position
)
445 register INTERVAL tree
;
446 register int position
;
448 /* The distance from the left edge of the subtree at TREE
450 register int relative_position
= position
- BEG
;
452 if (NULL_INTERVAL_P (tree
))
453 return NULL_INTERVAL
;
455 if (relative_position
> TOTAL_LENGTH (tree
))
456 abort (); /* Paranoia */
460 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
464 else if (! NULL_RIGHT_CHILD (tree
)
465 && relative_position
>= (TOTAL_LENGTH (tree
)
466 - RIGHT_TOTAL_LENGTH (tree
)))
468 relative_position
-= (TOTAL_LENGTH (tree
)
469 - RIGHT_TOTAL_LENGTH (tree
));
475 (position
- relative_position
/* the left edge of *tree */
476 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
483 /* Find the succeeding interval (lexicographically) to INTERVAL.
484 Sets the `position' field based on that of INTERVAL (see
488 next_interval (interval
)
489 register INTERVAL interval
;
491 register INTERVAL i
= interval
;
492 register int next_position
;
494 if (NULL_INTERVAL_P (i
))
495 return NULL_INTERVAL
;
496 next_position
= interval
->position
+ LENGTH (interval
);
498 if (! NULL_RIGHT_CHILD (i
))
501 while (! NULL_LEFT_CHILD (i
))
504 i
->position
= next_position
;
508 while (! NULL_PARENT (i
))
510 if (AM_LEFT_CHILD (i
))
513 i
->position
= next_position
;
520 return NULL_INTERVAL
;
523 /* Find the preceding interval (lexicographically) to INTERVAL.
524 Sets the `position' field based on that of INTERVAL (see
528 previous_interval (interval
)
529 register INTERVAL interval
;
532 register position_of_previous
;
534 if (NULL_INTERVAL_P (interval
))
535 return NULL_INTERVAL
;
537 if (! NULL_LEFT_CHILD (interval
))
540 while (! NULL_RIGHT_CHILD (i
))
543 i
->position
= interval
->position
- LENGTH (i
);
548 while (! NULL_PARENT (i
))
550 if (AM_RIGHT_CHILD (i
))
554 i
->position
= interval
->position
- LENGTH (i
);
560 return NULL_INTERVAL
;
564 /* Traverse a path down the interval tree TREE to the interval
565 containing POSITION, adjusting all nodes on the path for
566 an addition of LENGTH characters. Insertion between two intervals
567 (i.e., point == i->position, where i is second interval) means
568 text goes into second interval.
570 Modifications are needed to handle the hungry bits -- after simply
571 finding the interval at position (don't add length going down),
572 if it's the beginning of the interval, get the previous interval
573 and check the hugry bits of both. Then add the length going back up
577 adjust_intervals_for_insertion (tree
, position
, length
)
579 int position
, length
;
581 register int relative_position
;
582 register INTERVAL
this;
584 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
587 /* If inserting at point-max of a buffer, that position
588 will be out of range */
589 if (position
> TOTAL_LENGTH (tree
))
590 position
= TOTAL_LENGTH (tree
);
591 relative_position
= position
;
596 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
598 this->total_length
+= length
;
601 else if (relative_position
> (TOTAL_LENGTH (this)
602 - RIGHT_TOTAL_LENGTH (this)))
604 relative_position
-= (TOTAL_LENGTH (this)
605 - RIGHT_TOTAL_LENGTH (this));
606 this->total_length
+= length
;
611 /* If we are to use zero-length intervals as buffer pointers,
612 then this code will have to change. */
613 this->total_length
+= length
;
614 this->position
= LEFT_TOTAL_LENGTH (this)
615 + position
- relative_position
+ 1;
622 /* Effect an adjustment corresponding to the addition of LENGTH characters
623 of text. Do this by finding the interval containing POSITION in the
624 interval tree TREE, and then adjusting all of it's ancestors by adding
627 If POSITION is the first character of an interval, meaning that point
628 is actually between the two intervals, make the new text belong to
629 the interval which is "sticky".
631 If both intervals are "sticky", then make them belong to the left-most
632 interval. Another possibility would be to create a new interval for
633 this text, and make it have the merged properties of both ends. */
636 adjust_intervals_for_insertion (tree
, position
, length
)
638 int position
, length
;
642 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
645 /* If inserting at point-max of a buffer, that position will be out
646 of range. Remember that buffer positions are 1-based. */
647 if (position
> BEG
+ TOTAL_LENGTH (tree
))
648 position
= BEG
+ TOTAL_LENGTH (tree
);
650 i
= find_interval (tree
, position
);
651 /* If we are positioned between intervals, check the stickiness of
653 if (position
== i
->position
656 register INTERVAL prev
= previous_interval (i
);
658 /* If both intervals are sticky here, then default to the
659 left-most one. But perhaps we should create a new
660 interval here instead... */
661 if (END_STICKY_P (prev
) || ! FRONT_STICKY_P (i
))
665 while (! NULL_INTERVAL_P (i
))
667 i
->total_length
+= length
;
674 /* Delete an node I from its interval tree by merging its subtrees
675 into one subtree which is then returned. Caller is responsible for
676 storing the resulting subtree into its parent. */
682 register INTERVAL migrate
, this;
683 register int migrate_amt
;
685 if (NULL_INTERVAL_P (i
->left
))
687 if (NULL_INTERVAL_P (i
->right
))
691 migrate_amt
= i
->left
->total_length
;
693 this->total_length
+= migrate_amt
;
694 while (! NULL_INTERVAL_P (this->left
))
697 this->total_length
+= migrate_amt
;
699 this->left
= migrate
;
700 migrate
->parent
= this;
705 /* Delete interval I from its tree by calling `delete_node'
706 and properly connecting the resultant subtree.
708 I is presumed to be empty; that is, no adjustments are made
709 for the length of I. */
715 register INTERVAL parent
;
716 int amt
= LENGTH (i
);
718 if (amt
> 0) /* Only used on zero-length intervals now. */
721 if (ROOT_INTERVAL_P (i
))
723 Lisp_Object owner
= (Lisp_Object
) i
->parent
;
724 parent
= delete_node (i
);
725 if (! NULL_INTERVAL_P (parent
))
726 parent
->parent
= (INTERVAL
) owner
;
728 if (XTYPE (owner
) == Lisp_Buffer
)
729 XBUFFER (owner
)->intervals
= parent
;
730 else if (XTYPE (owner
) == Lisp_String
)
731 XSTRING (owner
)->intervals
= parent
;
739 if (AM_LEFT_CHILD (i
))
741 parent
->left
= delete_node (i
);
742 if (! NULL_INTERVAL_P (parent
->left
))
743 parent
->left
->parent
= parent
;
747 parent
->right
= delete_node (i
);
748 if (! NULL_INTERVAL_P (parent
->right
))
749 parent
->right
->parent
= parent
;
753 /* Find the interval in TREE corresponding to the relative position
754 FROM and delete as much as possible of AMOUNT from that interval.
755 Return the amount actually deleted, and if the interval was
756 zeroed-out, delete that interval node from the tree.
758 Note that FROM is actually origin zero, aka relative to the
759 leftmost edge of tree. This is appropriate since we call ourselves
760 recursively on subtrees.
762 Do this by recursing down TREE to the interval in question, and
763 deleting the appropriate amount of text. */
766 interval_deletion_adjustment (tree
, from
, amount
)
767 register INTERVAL tree
;
768 register int from
, amount
;
770 register int relative_position
= from
;
772 if (NULL_INTERVAL_P (tree
))
776 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
778 int subtract
= interval_deletion_adjustment (tree
->left
,
781 tree
->total_length
-= subtract
;
785 else if (relative_position
>= (TOTAL_LENGTH (tree
)
786 - RIGHT_TOTAL_LENGTH (tree
)))
790 relative_position
-= (tree
->total_length
791 - RIGHT_TOTAL_LENGTH (tree
));
792 subtract
= interval_deletion_adjustment (tree
->right
,
795 tree
->total_length
-= subtract
;
798 /* Here -- this node */
801 /* How much can we delete from this interval? */
802 int my_amount
= ((tree
->total_length
803 - RIGHT_TOTAL_LENGTH (tree
))
804 - relative_position
);
806 if (amount
> my_amount
)
809 tree
->total_length
-= amount
;
810 if (LENGTH (tree
) == 0)
811 delete_interval (tree
);
816 /* Never reach here */
819 /* Effect the adjustments necessary to the interval tree of BUFFER to
820 correspond to the deletion of LENGTH characters from that buffer
821 text. The deletion is effected at position START (which is a
822 buffer position, i.e. origin 1). */
825 adjust_intervals_for_deletion (buffer
, start
, length
)
826 struct buffer
*buffer
;
829 register int left_to_delete
= length
;
830 register INTERVAL tree
= buffer
->intervals
;
831 register int deleted
;
833 if (NULL_INTERVAL_P (tree
))
836 if (start
> BEG
+ TOTAL_LENGTH (tree
)
837 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
840 if (length
== TOTAL_LENGTH (tree
))
842 buffer
->intervals
= NULL_INTERVAL
;
846 if (ONLY_INTERVAL_P (tree
))
848 tree
->total_length
-= length
;
852 if (start
> BEG
+ TOTAL_LENGTH (tree
))
853 start
= BEG
+ TOTAL_LENGTH (tree
);
854 while (left_to_delete
> 0)
856 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
858 tree
= buffer
->intervals
;
859 if (left_to_delete
== tree
->total_length
)
861 buffer
->intervals
= NULL_INTERVAL
;
867 /* Make the adjustments necessary to the interval tree of BUFFER to
868 represent an addition or deletion of LENGTH characters starting
869 at position START. Addition or deletion is indicated by the sign
873 offset_intervals (buffer
, start
, length
)
874 struct buffer
*buffer
;
877 if (NULL_INTERVAL_P (buffer
->intervals
) || length
== 0)
881 adjust_intervals_for_insertion (buffer
->intervals
, start
, length
);
883 adjust_intervals_for_deletion (buffer
, start
, -length
);
886 /* Merge interval I with its lexicographic successor. The resulting
887 interval is returned, and has the properties of the original
888 successor. The properties of I are lost. I is removed from the
892 The caller must verify that this is not the last (rightmost)
896 merge_interval_right (i
)
899 register int absorb
= LENGTH (i
);
900 register INTERVAL successor
;
902 /* Zero out this interval. */
903 i
->total_length
-= absorb
;
905 /* Find the succeeding interval. */
906 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
909 successor
= i
->right
;
910 while (! NULL_LEFT_CHILD (successor
))
912 successor
->total_length
+= absorb
;
913 successor
= successor
->left
;
916 successor
->total_length
+= absorb
;
922 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
925 if (AM_LEFT_CHILD (successor
))
927 successor
= successor
->parent
;
932 successor
= successor
->parent
;
933 successor
->total_length
-= absorb
;
936 /* This must be the rightmost or last interval and cannot
937 be merged right. The caller should have known. */
941 /* Merge interval I with its lexicographic predecessor. The resulting
942 interval is returned, and has the properties of the original predecessor.
943 The properties of I are lost. Interval node I is removed from the tree.
946 The caller must verify that this is not the first (leftmost) interval. */
949 merge_interval_left (i
)
952 register int absorb
= LENGTH (i
);
953 register INTERVAL predecessor
;
955 /* Zero out this interval. */
956 i
->total_length
-= absorb
;
958 /* Find the preceding interval. */
959 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
960 adding ABSORB as we go. */
962 predecessor
= i
->left
;
963 while (! NULL_RIGHT_CHILD (predecessor
))
965 predecessor
->total_length
+= absorb
;
966 predecessor
= predecessor
->right
;
969 predecessor
->total_length
+= absorb
;
975 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
976 subtracting ABSORB. */
978 if (AM_RIGHT_CHILD (predecessor
))
980 predecessor
= predecessor
->parent
;
985 predecessor
= predecessor
->parent
;
986 predecessor
->total_length
-= absorb
;
989 /* This must be the leftmost or first interval and cannot
990 be merged left. The caller should have known. */
994 /* Make an exact copy of interval tree SOURCE which descends from
995 PARENT. This is done by recursing through SOURCE, copying
996 the current interval and its properties, and then adjusting
997 the pointers of the copy. */
1000 reproduce_tree (source
, parent
)
1001 INTERVAL source
, parent
;
1003 register INTERVAL t
= make_interval ();
1005 bcopy (source
, t
, INTERVAL_SIZE
);
1006 copy_properties (source
, t
);
1008 if (! NULL_LEFT_CHILD (source
))
1009 t
->left
= reproduce_tree (source
->left
, t
);
1010 if (! NULL_RIGHT_CHILD (source
))
1011 t
->right
= reproduce_tree (source
->right
, t
);
1017 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1019 /* Make a new interval of length LENGTH starting at START in the
1020 group of intervals INTERVALS, which is actually an interval tree.
1021 Returns the new interval.
1023 Generate an error if the new positions would overlap an existing
1027 make_new_interval (intervals
, start
, length
)
1033 slot
= find_interval (intervals
, start
);
1034 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1035 error ("Interval would overlap");
1037 if (start
== slot
->position
&& length
== LENGTH (slot
))
1040 if (slot
->position
== start
)
1042 /* New right node. */
1043 split_interval_right (slot
, length
+ 1);
1047 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1049 /* New left node. */
1050 split_interval_left (slot
, LENGTH (slot
) - length
+ 1);
1054 /* Convert interval SLOT into three intervals. */
1055 split_interval_left (slot
, start
- slot
->position
+ 1);
1056 split_interval_right (slot
, length
+ 1);
1061 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1063 This is used in insdel.c when inserting Lisp_Strings into
1064 the buffer. The text corresponding to SOURCE is already in
1065 the buffer when this is called. The intervals of new tree are
1066 those belonging to the string being inserted; a copy is not made.
1068 If the inserted text had no intervals associated, this function
1069 simply returns -- offset_intervals should handle placing the
1070 text in the correct interval, depending on the sticky bits.
1072 If the inserted text had properties (intervals), then there are two
1073 cases -- either insertion happened in the middle of some interval,
1074 or between two intervals.
1076 If the text goes into the middle of an interval, then new
1077 intervals are created in the middle with only the properties of
1078 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1079 which case the new text has the union of its properties and those
1080 of the text into which it was inserted.
1082 If the text goes between two intervals, then if neither interval
1083 had its appropriate sticky property set (front_sticky, rear_sticky),
1084 the new text has only its properties. If one of the sticky properties
1085 is set, then the new text "sticks" to that region and its properties
1086 depend on merging as above. If both the preceding and succeeding
1087 intervals to the new text are "sticky", then the new text retains
1088 only its properties, as if neither sticky property were set. Perhaps
1089 we should consider merging all three sets of properties onto the new
1093 graft_intervals_into_buffer (source
, position
, buffer
)
1096 struct buffer
*buffer
;
1098 register INTERVAL under
, over
, this, prev
;
1099 register INTERVAL tree
= buffer
->intervals
;
1102 /* If the new text has no properties, it becomes part of whatever
1103 interval it was inserted into. */
1104 if (NULL_INTERVAL_P (source
))
1107 if (NULL_INTERVAL_P (tree
))
1109 /* The inserted text constitutes the whole buffer, so
1110 simply copy over the interval structure. */
1111 if (BUF_Z (buffer
) == TOTAL_LENGTH (source
))
1113 buffer
->intervals
= reproduce_tree (source
, tree
->parent
);
1114 /* Explicitly free the old tree here. */
1119 /* Create an interval tree in which to place a copy
1120 of the intervals of the inserted string. */
1123 XSET (buf
, Lisp_Buffer
, buffer
);
1124 tree
= create_root_interval (buf
);
1128 if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1129 /* If the buffer contains only the new string, but
1130 there was already some interval tree there, then it may be
1131 some zero length intervals. Eventually, do something clever
1132 about inserting properly. For now, just waste the old intervals. */
1134 buffer
->intervals
= reproduce_tree (source
, tree
->parent
);
1135 /* Explicitly free the old tree here. */
1140 /* Paranoia -- the text has already been added, so this buffer
1141 should be of non-zero length. */
1142 if (TOTAL_LENGTH (tree
) == 0)
1145 this = under
= find_interval (tree
, position
);
1146 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1148 over
= find_interval (source
, 1);
1150 /* Here for insertion in the middle of an interval.
1151 Split off an equivalent interval to the right,
1152 then don't bother with it any more. */
1154 if (position
> under
->position
)
1156 INTERVAL end_unchanged
1157 = split_interval_left (this, position
- under
->position
+ 1);
1158 copy_properties (under
, end_unchanged
);
1159 under
->position
= position
;
1165 prev
= previous_interval (under
);
1166 if (prev
&& !END_STICKY_P (prev
))
1170 /* Insertion is now at beginning of UNDER. */
1172 /* The inserted text "sticks" to the interval `under',
1173 which means it gets those properties. */
1174 while (! NULL_INTERVAL_P (over
))
1176 position
= LENGTH (over
) + 1;
1177 if (position
< LENGTH (under
))
1178 this = split_interval_left (under
, position
);
1181 copy_properties (over
, this);
1182 /* Insertion at the end of an interval, PREV,
1183 inherits from PREV if PREV is sticky at the end. */
1184 if (prev
&& ! FRONT_STICKY_P (under
)
1185 && MERGE_INSERTIONS (prev
))
1186 merge_properties (prev
, this);
1187 /* Maybe it inherits from the following interval
1188 if that is sticky at the front. */
1189 else if ((FRONT_STICKY_P (under
) || middle
)
1190 && MERGE_INSERTIONS (under
))
1191 merge_properties (under
, this);
1192 over
= next_interval (over
);
1195 buffer
->intervals
= balance_intervals (buffer
->intervals
);
1199 /* Get the value of property PROP from PLIST,
1200 which is the plist of an interval.
1201 We check for direct properties and for categories with property PROP. */
1204 textget (plist
, prop
)
1206 register Lisp_Object prop
;
1208 register Lisp_Object tail
, fallback
;
1211 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1213 register Lisp_Object tem
;
1216 return Fcar (Fcdr (tail
));
1217 if (EQ (tem
, Qcategory
))
1218 fallback
= Fget (Fcar (Fcdr (tail
)), prop
);
1224 /* Set point in BUFFER to POSITION. If the target position is
1225 before an invisible character which is not displayed with a special glyph,
1226 move back to an ok place to display. */
1229 set_point (position
, buffer
)
1230 register int position
;
1231 register struct buffer
*buffer
;
1233 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1235 register Lisp_Object obj
;
1236 int backwards
= (position
< BUF_PT (buffer
)) ? 1 : 0;
1237 int old_position
= buffer
->text
.pt
;
1239 if (position
== buffer
->text
.pt
)
1242 /* Check this now, before checking if the buffer has any intervals.
1243 That way, we can catch conditions which break this sanity check
1244 whether or not there are intervals in the buffer. */
1245 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1248 if (NULL_INTERVAL_P (buffer
->intervals
))
1250 buffer
->text
.pt
= position
;
1254 /* Set TO to the interval containing the char after POSITION,
1255 and TOPREV to the interval containing the char before POSITION.
1256 Either one may be null. They may be equal. */
1257 to
= find_interval (buffer
->intervals
, position
);
1258 if (position
== BUF_BEGV (buffer
))
1260 else if (to
->position
== position
)
1261 toprev
= previous_interval (to
);
1265 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1266 ? BUF_ZV (buffer
) - 1
1269 /* Set FROM to the interval containing the char after PT,
1270 and FROMPREV to the interval containing the char before PT.
1271 Either one may be null. They may be equal. */
1272 /* We could cache this and save time. */
1273 from
= find_interval (buffer
->intervals
, buffer_point
);
1274 if (from
->position
== BUF_BEGV (buffer
))
1276 else if (from
->position
== BUF_PT (buffer
))
1277 fromprev
= previous_interval (from
);
1278 else if (buffer_point
!= BUF_PT (buffer
))
1279 fromprev
= from
, from
= 0;
1283 /* Moving within an interval */
1284 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
))
1286 buffer
->text
.pt
= position
;
1290 /* If the new position is before an invisible character,
1291 move forward over all such. */
1292 while (! NULL_INTERVAL_P (to
)
1293 && ! INTERVAL_VISIBLE_P (to
)
1294 && ! DISPLAY_INVISIBLE_GLYPH (to
))
1297 to
= next_interval (to
);
1298 if (NULL_INTERVAL_P (to
))
1299 position
= BUF_ZV (buffer
);
1301 position
= to
->position
;
1304 buffer
->text
.pt
= position
;
1306 /* We run point-left and point-entered hooks here, iff the
1307 two intervals are not equivalent. These hooks take
1308 (old_point, new_point) as arguments. */
1309 if (! intervals_equal (from
, to
)
1310 || ! intervals_equal (fromprev
, toprev
))
1312 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1315 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1319 leave_before
= textget (from
->plist
, Qpoint_left
);
1321 leave_before
= Qnil
;
1324 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1328 enter_before
= textget (to
->plist
, Qpoint_entered
);
1330 enter_before
= Qnil
;
1332 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1333 call2 (leave_before
, old_position
, position
);
1334 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1335 call2 (leave_after
, old_position
, position
);
1337 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1338 call2 (enter_before
, old_position
, position
);
1339 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1340 call2 (enter_after
, old_position
, position
);
1344 /* Set point temporarily, without checking any text properties. */
1347 temp_set_point (position
, buffer
)
1349 struct buffer
*buffer
;
1351 buffer
->text
.pt
= position
;
1354 /* Return the proper local map for position POSITION in BUFFER.
1355 Use the map specified by the local-map property, if any.
1356 Otherwise, use BUFFER's local map. */
1359 get_local_map (position
, buffer
)
1360 register int position
;
1361 register struct buffer
*buffer
;
1363 register INTERVAL interval
;
1364 Lisp_Object prop
, tem
;
1366 if (NULL_INTERVAL_P (buffer
->intervals
))
1367 return current_buffer
->keymap
;
1369 /* Perhaps we should just change `position' to the limit. */
1370 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1373 interval
= find_interval (buffer
->intervals
, position
);
1374 prop
= textget (interval
->plist
, Qlocal_map
);
1376 return current_buffer
->keymap
;
1378 /* Use the local map only if it is valid. */
1379 tem
= Fkeymapp (prop
);
1383 return current_buffer
->keymap
;
1386 /* Call the modification hook functions in LIST, each with START and END. */
1389 call_mod_hooks (list
, start
, end
)
1390 Lisp_Object list
, start
, end
;
1392 struct gcpro gcpro1
;
1394 while (!NILP (list
))
1396 call2 (Fcar (list
), start
, end
);
1402 /* Check for read-only intervals and signal an error if we find one.
1403 Then check for any modification hooks in the range START up to
1404 (but not including) TO. Create a list of all these hooks in
1405 lexicographic order, eliminating consecutive extra copies of the
1406 same hook. Then call those hooks in order, with START and END - 1
1410 verify_interval_modification (buf
, start
, end
)
1414 register INTERVAL intervals
= buf
->intervals
;
1415 register INTERVAL i
, prev
;
1417 register Lisp_Object prev_mod_hooks
;
1418 Lisp_Object mod_hooks
;
1419 struct gcpro gcpro1
;
1422 prev_mod_hooks
= Qnil
;
1425 if (NULL_INTERVAL_P (intervals
))
1435 /* For an insert operation, check the two chars around the position. */
1439 Lisp_Object before
, after
;
1441 /* Set I to the interval containing the char after START,
1442 and PREV to the interval containing the char before START.
1443 Either one may be null. They may be equal. */
1444 i
= find_interval (intervals
, start
);
1446 if (start
== BUF_BEGV (buf
))
1448 if (i
->position
== start
)
1449 prev
= previous_interval (i
);
1450 else if (i
->position
< start
)
1452 if (start
== BUF_ZV (buf
))
1455 if (NULL_INTERVAL_P (prev
))
1457 if (! INTERVAL_WRITABLE_P (i
))
1458 error ("Attempt to insert within read-only text");
1460 else if (NULL_INTERVAL_P (i
))
1462 if (! INTERVAL_WRITABLE_P (prev
))
1463 error ("Attempt to insert within read-only text");
1467 before
= textget (prev
->plist
, Qread_only
);
1468 after
= textget (i
->plist
, Qread_only
);
1469 if (! NILP (before
) && EQ (before
, after
)
1470 /* This checks Vinhibit_read_only properly
1471 for the common value of the read-only property. */
1472 && ! INTERVAL_WRITABLE_P (i
))
1473 error ("Attempt to insert within read-only text");
1476 /* Run both insert hooks (just once if they're the same). */
1477 if (!NULL_INTERVAL_P (prev
))
1478 prev_mod_hooks
= textget (prev
->plist
, Qinsert_behind_hooks
);
1479 if (!NULL_INTERVAL_P (i
))
1480 mod_hooks
= textget (i
->plist
, Qinsert_in_front_hooks
);
1482 if (! NILP (prev_mod_hooks
))
1483 call_mod_hooks (prev_mod_hooks
, make_number (start
),
1486 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1487 call_mod_hooks (mod_hooks
, make_number (start
), make_number (end
));
1491 /* Loop over intervals on or next to START...END,
1492 collecting their hooks. */
1494 i
= find_interval (intervals
, start
);
1497 if (! INTERVAL_WRITABLE_P (i
))
1498 error ("Attempt to modify read-only text");
1500 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1501 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1503 hooks
= Fcons (mod_hooks
, hooks
);
1504 prev_mod_hooks
= mod_hooks
;
1507 i
= next_interval (i
);
1509 /* Keep going thru the interval containing the char before END. */
1510 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1513 hooks
= Fnreverse (hooks
);
1514 while (! EQ (hooks
, Qnil
))
1516 call_mod_hooks (Fcar (hooks
), make_number (start
),
1518 hooks
= Fcdr (hooks
);
1524 /* Balance an interval node if the amount of text in its left and right
1525 subtrees differs by more than the percentage specified by
1526 `interval-balance-threshold'. */
1529 balance_an_interval (i
)
1532 register int total_children_size
= (LEFT_TOTAL_LENGTH (i
)
1533 + RIGHT_TOTAL_LENGTH (i
));
1534 register int threshold
= (XFASTINT (interval_balance_threshold
)
1535 * (total_children_size
/ 100));
1537 /* Balance within each side. */
1538 balance_intervals (i
->left
);
1539 balance_intervals (i
->right
);
1541 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1542 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1544 i
= rotate_right (i
);
1545 /* If that made it unbalanced the other way, take it back. */
1546 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1547 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1548 return rotate_left (i
);
1552 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1553 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1555 i
= rotate_left (i
);
1556 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1557 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1558 return rotate_right (i
);
1565 /* Balance the interval tree TREE. Balancing is by weight
1566 (the amount of text). */
1569 balance_intervals (tree
)
1570 register INTERVAL tree
;
1572 register INTERVAL new_tree
;
1574 if (NULL_INTERVAL_P (tree
))
1575 return NULL_INTERVAL
;
1581 new_tree
= balance_an_interval (new_tree
);
1583 while (new_tree
!= tree
);
1588 /* Produce an interval tree reflecting the intervals in
1589 TREE from START to START + LENGTH. */
1592 copy_intervals (tree
, start
, length
)
1596 register INTERVAL i
, new, t
;
1597 register int got
, prevlen
;
1599 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1600 return NULL_INTERVAL
;
1602 i
= find_interval (tree
, start
);
1603 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1606 /* If there is only one interval and it's the default, return nil. */
1607 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
1608 && DEFAULT_INTERVAL_P (i
))
1609 return NULL_INTERVAL
;
1611 new = make_interval ();
1613 got
= (LENGTH (i
) - (start
- i
->position
));
1614 new->total_length
= length
;
1615 copy_properties (i
, new);
1619 while (got
< length
)
1621 i
= next_interval (i
);
1622 t
= split_interval_right (t
, prevlen
+ 1);
1623 copy_properties (i
, t
);
1624 prevlen
= LENGTH (i
);
1628 return balance_intervals (new);
1631 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1634 copy_intervals_to_string (string
, buffer
, position
, length
)
1635 Lisp_Object string
, buffer
;
1636 int position
, length
;
1638 INTERVAL interval_copy
= copy_intervals (XBUFFER (buffer
)->intervals
,
1640 if (NULL_INTERVAL_P (interval_copy
))
1643 interval_copy
->parent
= (INTERVAL
) string
;
1644 XSTRING (string
)->intervals
= interval_copy
;
1647 #endif /* USE_TEXT_PROPERTIES */