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
))
66 - BUF_BEG (XBUFFER (parent
)));
67 XBUFFER (parent
)->intervals
= new;
69 else if (XTYPE (parent
) == Lisp_String
)
71 new->total_length
= XSTRING (parent
)->size
;
72 XSTRING (parent
)->intervals
= new;
75 new->parent
= (INTERVAL
) parent
;
81 /* Make the interval TARGET have exactly the properties of SOURCE */
84 copy_properties (source
, target
)
85 register INTERVAL source
, target
;
87 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
90 COPY_INTERVAL_CACHE (source
, target
);
91 target
->plist
= Fcopy_sequence (source
->plist
);
94 /* Merge the properties of interval SOURCE into the properties
95 of interval TARGET. That is to say, each property in SOURCE
96 is added to TARGET if TARGET has no such property as yet. */
99 merge_properties (source
, target
)
100 register INTERVAL source
, target
;
102 register Lisp_Object o
, sym
, val
;
104 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
107 MERGE_INTERVAL_CACHE (source
, target
);
110 while (! EQ (o
, Qnil
))
113 val
= Fmemq (sym
, target
->plist
);
119 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
127 /* Return 1 if the two intervals have the same properties,
131 intervals_equal (i0
, i1
)
134 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
137 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
140 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
143 i1_len
= XFASTINT (Flength (i1
->plist
));
144 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
148 while (!NILP (i0_cdr
))
150 /* Lengths of the two plists were unequal */
154 i0_sym
= Fcar (i0_cdr
);
155 i1_val
= Fmemq (i0_sym
, i1
->plist
);
157 /* i0 has something i1 doesn't */
158 if (EQ (i1_val
, Qnil
))
161 /* i0 and i1 both have sym, but it has different values in each */
162 i0_cdr
= Fcdr (i0_cdr
);
163 if (! EQ (i1_val
, Fcar (i0_cdr
)))
166 i0_cdr
= Fcdr (i0_cdr
);
170 /* Lengths of the two plists were unequal */
179 static int zero_length
;
181 /* Traverse an interval tree TREE, performing FUNCTION on each node.
182 Pass FUNCTION two args: an interval, and ARG. */
185 traverse_intervals (tree
, position
, depth
, function
, arg
)
188 void (* function
) ();
191 if (NULL_INTERVAL_P (tree
))
194 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
195 position
+= LEFT_TOTAL_LENGTH (tree
);
196 tree
->position
= position
;
197 (*function
) (tree
, arg
);
198 position
+= LENGTH (tree
);
199 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
203 /* These functions are temporary, for debugging purposes only. */
205 INTERVAL search_interval
, found_interval
;
208 check_for_interval (i
)
211 if (i
== search_interval
)
219 search_for_interval (i
, tree
)
220 register INTERVAL i
, tree
;
224 found_interval
= NULL_INTERVAL
;
225 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
226 return found_interval
;
230 inc_interval_count (i
)
247 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
253 root_interval (interval
)
256 register INTERVAL i
= interval
;
258 while (! ROOT_INTERVAL_P (i
))
265 /* Assuming that a left child exists, perform the following operation:
275 rotate_right (interval
)
279 INTERVAL B
= interval
->left
;
280 int len
= LENGTH (interval
);
282 /* Deal with any Parent of A; make it point to B. */
283 if (! ROOT_INTERVAL_P (interval
))
284 if (AM_LEFT_CHILD (interval
))
285 interval
->parent
->left
= interval
->left
;
287 interval
->parent
->right
= interval
->left
;
288 interval
->left
->parent
= interval
->parent
;
290 /* B gets the same length as A, since it get A's position in the tree. */
291 interval
->left
->total_length
= interval
->total_length
;
293 /* B becomes the parent of A. */
294 i
= interval
->left
->right
;
295 interval
->left
->right
= interval
;
296 interval
->parent
= interval
->left
;
298 /* A gets c as left child. */
300 if (! NULL_INTERVAL_P (i
))
301 i
->parent
= interval
;
302 interval
->total_length
= (len
+ LEFT_TOTAL_LENGTH (interval
)
303 + RIGHT_TOTAL_LENGTH (interval
));
308 /* Assuming that a right child exists, perform the following operation:
318 rotate_left (interval
)
322 INTERVAL B
= interval
->right
;
323 int len
= LENGTH (interval
);
325 /* Deal with the parent of A. */
326 if (! ROOT_INTERVAL_P (interval
))
327 if (AM_LEFT_CHILD (interval
))
328 interval
->parent
->left
= interval
->right
;
330 interval
->parent
->right
= interval
->right
;
331 interval
->right
->parent
= interval
->parent
;
333 /* B must have the same total length of A. */
334 interval
->right
->total_length
= interval
->total_length
;
336 /* Make B the parent of A */
337 i
= interval
->right
->left
;
338 interval
->right
->left
= interval
;
339 interval
->parent
= interval
->right
;
341 /* Make A point to c */
343 if (! NULL_INTERVAL_P (i
))
344 i
->parent
= interval
;
345 interval
->total_length
= (len
+ LEFT_TOTAL_LENGTH (interval
)
346 + RIGHT_TOTAL_LENGTH (interval
));
351 /* Split INTERVAL into two pieces, starting the second piece at
352 character position OFFSET (counting from 0), relative to INTERVAL.
353 INTERVAL becomes the left-hand piece, and the right-hand piece
354 (second, lexicographically) is returned.
356 The size and position fields of the two intervals are set based upon
357 those of the original interval. The property list of the new interval
358 is reset, thus it is up to the caller to do the right thing with the
361 Note that this does not change the position of INTERVAL; if it is a root,
362 it is still a root after this operation. */
365 split_interval_right (interval
, offset
)
369 INTERVAL
new = make_interval ();
370 int position
= interval
->position
;
371 int new_length
= LENGTH (interval
) - offset
;
373 new->position
= position
+ offset
;
374 new->parent
= interval
;
376 if (LEAF_INTERVAL_P (interval
) || NULL_RIGHT_CHILD (interval
))
378 interval
->right
= new;
379 new->total_length
= new_length
;
384 /* Insert the new node between INTERVAL and its right child. */
385 new->right
= interval
->right
;
386 interval
->right
->parent
= new;
387 interval
->right
= new;
389 new->total_length
= new_length
+ new->right
->total_length
;
394 /* Split INTERVAL into two pieces, starting the second piece at
395 character position OFFSET (counting from 0), relative to INTERVAL.
396 INTERVAL becomes the right-hand piece, and the left-hand piece
397 (first, lexicographically) is returned.
399 The size and position fields of the two intervals are set based upon
400 those of the original interval. The property list of the new interval
401 is reset, thus it is up to the caller to do the right thing with the
404 Note that this does not change the position of INTERVAL; if it is a root,
405 it is still a root after this operation. */
408 split_interval_left (interval
, offset
)
412 INTERVAL
new = make_interval ();
413 int position
= interval
->position
;
414 int new_length
= offset
;
416 new->position
= interval
->position
;
417 interval
->position
= interval
->position
+ offset
;
418 new->parent
= interval
;
420 if (NULL_LEFT_CHILD (interval
))
422 interval
->left
= new;
423 new->total_length
= new_length
;
428 /* Insert the new node between INTERVAL and its left child. */
429 new->left
= interval
->left
;
430 new->left
->parent
= new;
431 interval
->left
= new;
432 new->total_length
= new_length
+ LEFT_TOTAL_LENGTH (new);
437 /* Find the interval containing text position POSITION in the text
438 represented by the interval tree TREE. POSITION is a buffer
439 position; the earliest position is 1. If POSITION is at the end of
440 the buffer, return the interval containing the last character.
442 The `position' field, which is a cache of an interval's position,
443 is updated in the interval found. Other functions (e.g., next_interval)
444 will update this cache based on the result of find_interval. */
447 find_interval (tree
, position
)
448 register INTERVAL tree
;
449 register int position
;
451 /* The distance from the left edge of the subtree at TREE
453 register int relative_position
= position
- BEG
;
455 if (NULL_INTERVAL_P (tree
))
456 return NULL_INTERVAL
;
458 if (relative_position
> TOTAL_LENGTH (tree
))
459 abort (); /* Paranoia */
463 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
467 else if (! NULL_RIGHT_CHILD (tree
)
468 && relative_position
>= (TOTAL_LENGTH (tree
)
469 - RIGHT_TOTAL_LENGTH (tree
)))
471 relative_position
-= (TOTAL_LENGTH (tree
)
472 - RIGHT_TOTAL_LENGTH (tree
));
478 (position
- relative_position
/* the left edge of *tree */
479 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
486 /* Find the succeeding interval (lexicographically) to INTERVAL.
487 Sets the `position' field based on that of INTERVAL (see
491 next_interval (interval
)
492 register INTERVAL interval
;
494 register INTERVAL i
= interval
;
495 register int next_position
;
497 if (NULL_INTERVAL_P (i
))
498 return NULL_INTERVAL
;
499 next_position
= interval
->position
+ LENGTH (interval
);
501 if (! NULL_RIGHT_CHILD (i
))
504 while (! NULL_LEFT_CHILD (i
))
507 i
->position
= next_position
;
511 while (! NULL_PARENT (i
))
513 if (AM_LEFT_CHILD (i
))
516 i
->position
= next_position
;
523 return NULL_INTERVAL
;
526 /* Find the preceding interval (lexicographically) to INTERVAL.
527 Sets the `position' field based on that of INTERVAL (see
531 previous_interval (interval
)
532 register INTERVAL interval
;
535 register position_of_previous
;
537 if (NULL_INTERVAL_P (interval
))
538 return NULL_INTERVAL
;
540 if (! NULL_LEFT_CHILD (interval
))
543 while (! NULL_RIGHT_CHILD (i
))
546 i
->position
= interval
->position
- LENGTH (i
);
551 while (! NULL_PARENT (i
))
553 if (AM_RIGHT_CHILD (i
))
557 i
->position
= interval
->position
- LENGTH (i
);
563 return NULL_INTERVAL
;
567 /* Traverse a path down the interval tree TREE to the interval
568 containing POSITION, adjusting all nodes on the path for
569 an addition of LENGTH characters. Insertion between two intervals
570 (i.e., point == i->position, where i is second interval) means
571 text goes into second interval.
573 Modifications are needed to handle the hungry bits -- after simply
574 finding the interval at position (don't add length going down),
575 if it's the beginning of the interval, get the previous interval
576 and check the hugry bits of both. Then add the length going back up
580 adjust_intervals_for_insertion (tree
, position
, length
)
582 int position
, length
;
584 register int relative_position
;
585 register INTERVAL
this;
587 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
590 /* If inserting at point-max of a buffer, that position
591 will be out of range */
592 if (position
> TOTAL_LENGTH (tree
))
593 position
= TOTAL_LENGTH (tree
);
594 relative_position
= position
;
599 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
601 this->total_length
+= length
;
604 else if (relative_position
> (TOTAL_LENGTH (this)
605 - RIGHT_TOTAL_LENGTH (this)))
607 relative_position
-= (TOTAL_LENGTH (this)
608 - RIGHT_TOTAL_LENGTH (this));
609 this->total_length
+= length
;
614 /* If we are to use zero-length intervals as buffer pointers,
615 then this code will have to change. */
616 this->total_length
+= length
;
617 this->position
= LEFT_TOTAL_LENGTH (this)
618 + position
- relative_position
+ 1;
625 /* Effect an adjustment corresponding to the addition of LENGTH characters
626 of text. Do this by finding the interval containing POSITION in the
627 interval tree TREE, and then adjusting all of it's ancestors by adding
630 If POSITION is the first character of an interval, meaning that point
631 is actually between the two intervals, make the new text belong to
632 the interval which is "sticky".
634 If both intervals are "sticky", then make them belong to the left-most
635 interval. Another possibility would be to create a new interval for
636 this text, and make it have the merged properties of both ends. */
639 adjust_intervals_for_insertion (tree
, position
, length
)
641 int position
, length
;
645 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
648 /* If inserting at point-max of a buffer, that position will be out
649 of range. Remember that buffer positions are 1-based. */
650 if (position
> BEG
+ TOTAL_LENGTH (tree
))
651 position
= BEG
+ TOTAL_LENGTH (tree
);
653 i
= find_interval (tree
, position
);
654 /* If we are positioned between intervals, check the stickiness of
656 if (position
== i
->position
659 register INTERVAL prev
= previous_interval (i
);
661 /* If both intervals are sticky here, then default to the
662 left-most one. But perhaps we should create a new
663 interval here instead... */
664 if (END_STICKY_P (prev
) || ! FRONT_STICKY_P (i
))
668 while (! NULL_INTERVAL_P (i
))
670 i
->total_length
+= length
;
677 /* Delete an node I from its interval tree by merging its subtrees
678 into one subtree which is then returned. Caller is responsible for
679 storing the resulting subtree into its parent. */
685 register INTERVAL migrate
, this;
686 register int migrate_amt
;
688 if (NULL_INTERVAL_P (i
->left
))
690 if (NULL_INTERVAL_P (i
->right
))
694 migrate_amt
= i
->left
->total_length
;
696 this->total_length
+= migrate_amt
;
697 while (! NULL_INTERVAL_P (this->left
))
700 this->total_length
+= migrate_amt
;
702 this->left
= migrate
;
703 migrate
->parent
= this;
708 /* Delete interval I from its tree by calling `delete_node'
709 and properly connecting the resultant subtree.
711 I is presumed to be empty; that is, no adjustments are made
712 for the length of I. */
718 register INTERVAL parent
;
719 int amt
= LENGTH (i
);
721 if (amt
> 0) /* Only used on zero-length intervals now. */
724 if (ROOT_INTERVAL_P (i
))
726 Lisp_Object owner
= (Lisp_Object
) i
->parent
;
727 parent
= delete_node (i
);
728 if (! NULL_INTERVAL_P (parent
))
729 parent
->parent
= (INTERVAL
) owner
;
731 if (XTYPE (owner
) == Lisp_Buffer
)
732 XBUFFER (owner
)->intervals
= parent
;
733 else if (XTYPE (owner
) == Lisp_String
)
734 XSTRING (owner
)->intervals
= parent
;
742 if (AM_LEFT_CHILD (i
))
744 parent
->left
= delete_node (i
);
745 if (! NULL_INTERVAL_P (parent
->left
))
746 parent
->left
->parent
= parent
;
750 parent
->right
= delete_node (i
);
751 if (! NULL_INTERVAL_P (parent
->right
))
752 parent
->right
->parent
= parent
;
756 /* Find the interval in TREE corresponding to the relative position
757 FROM and delete as much as possible of AMOUNT from that interval.
758 Return the amount actually deleted, and if the interval was
759 zeroed-out, delete that interval node from the tree.
761 Note that FROM is actually origin zero, aka relative to the
762 leftmost edge of tree. This is appropriate since we call ourselves
763 recursively on subtrees.
765 Do this by recursing down TREE to the interval in question, and
766 deleting the appropriate amount of text. */
769 interval_deletion_adjustment (tree
, from
, amount
)
770 register INTERVAL tree
;
771 register int from
, amount
;
773 register int relative_position
= from
;
775 if (NULL_INTERVAL_P (tree
))
779 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
781 int subtract
= interval_deletion_adjustment (tree
->left
,
784 tree
->total_length
-= subtract
;
788 else if (relative_position
>= (TOTAL_LENGTH (tree
)
789 - RIGHT_TOTAL_LENGTH (tree
)))
793 relative_position
-= (tree
->total_length
794 - RIGHT_TOTAL_LENGTH (tree
));
795 subtract
= interval_deletion_adjustment (tree
->right
,
798 tree
->total_length
-= subtract
;
801 /* Here -- this node */
804 /* How much can we delete from this interval? */
805 int my_amount
= ((tree
->total_length
806 - RIGHT_TOTAL_LENGTH (tree
))
807 - relative_position
);
809 if (amount
> my_amount
)
812 tree
->total_length
-= amount
;
813 if (LENGTH (tree
) == 0)
814 delete_interval (tree
);
819 /* Never reach here */
822 /* Effect the adjustments necessary to the interval tree of BUFFER to
823 correspond to the deletion of LENGTH characters from that buffer
824 text. The deletion is effected at position START (which is a
825 buffer position, i.e. origin 1). */
828 adjust_intervals_for_deletion (buffer
, start
, length
)
829 struct buffer
*buffer
;
832 register int left_to_delete
= length
;
833 register INTERVAL tree
= buffer
->intervals
;
834 register int deleted
;
836 if (NULL_INTERVAL_P (tree
))
839 if (start
> BEG
+ TOTAL_LENGTH (tree
)
840 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
843 if (length
== TOTAL_LENGTH (tree
))
845 buffer
->intervals
= NULL_INTERVAL
;
849 if (ONLY_INTERVAL_P (tree
))
851 tree
->total_length
-= length
;
855 if (start
> BEG
+ TOTAL_LENGTH (tree
))
856 start
= BEG
+ TOTAL_LENGTH (tree
);
857 while (left_to_delete
> 0)
859 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
861 tree
= buffer
->intervals
;
862 if (left_to_delete
== tree
->total_length
)
864 buffer
->intervals
= NULL_INTERVAL
;
870 /* Make the adjustments necessary to the interval tree of BUFFER to
871 represent an addition or deletion of LENGTH characters starting
872 at position START. Addition or deletion is indicated by the sign
876 offset_intervals (buffer
, start
, length
)
877 struct buffer
*buffer
;
880 if (NULL_INTERVAL_P (buffer
->intervals
) || length
== 0)
884 adjust_intervals_for_insertion (buffer
->intervals
, start
, length
);
886 adjust_intervals_for_deletion (buffer
, start
, -length
);
889 /* Merge interval I with its lexicographic successor. The resulting
890 interval is returned, and has the properties of the original
891 successor. The properties of I are lost. I is removed from the
895 The caller must verify that this is not the last (rightmost)
899 merge_interval_right (i
)
902 register int absorb
= LENGTH (i
);
903 register INTERVAL successor
;
905 /* Zero out this interval. */
906 i
->total_length
-= absorb
;
908 /* Find the succeeding interval. */
909 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
912 successor
= i
->right
;
913 while (! NULL_LEFT_CHILD (successor
))
915 successor
->total_length
+= absorb
;
916 successor
= successor
->left
;
919 successor
->total_length
+= absorb
;
925 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
928 if (AM_LEFT_CHILD (successor
))
930 successor
= successor
->parent
;
935 successor
= successor
->parent
;
936 successor
->total_length
-= absorb
;
939 /* This must be the rightmost or last interval and cannot
940 be merged right. The caller should have known. */
944 /* Merge interval I with its lexicographic predecessor. The resulting
945 interval is returned, and has the properties of the original predecessor.
946 The properties of I are lost. Interval node I is removed from the tree.
949 The caller must verify that this is not the first (leftmost) interval. */
952 merge_interval_left (i
)
955 register int absorb
= LENGTH (i
);
956 register INTERVAL predecessor
;
958 /* Zero out this interval. */
959 i
->total_length
-= absorb
;
961 /* Find the preceding interval. */
962 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
963 adding ABSORB as we go. */
965 predecessor
= i
->left
;
966 while (! NULL_RIGHT_CHILD (predecessor
))
968 predecessor
->total_length
+= absorb
;
969 predecessor
= predecessor
->right
;
972 predecessor
->total_length
+= absorb
;
978 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
979 subtracting ABSORB. */
981 if (AM_RIGHT_CHILD (predecessor
))
983 predecessor
= predecessor
->parent
;
988 predecessor
= predecessor
->parent
;
989 predecessor
->total_length
-= absorb
;
992 /* This must be the leftmost or first interval and cannot
993 be merged left. The caller should have known. */
997 /* Make an exact copy of interval tree SOURCE which descends from
998 PARENT. This is done by recursing through SOURCE, copying
999 the current interval and its properties, and then adjusting
1000 the pointers of the copy. */
1003 reproduce_tree (source
, parent
)
1004 INTERVAL source
, parent
;
1006 register INTERVAL t
= make_interval ();
1008 bcopy (source
, t
, INTERVAL_SIZE
);
1009 copy_properties (source
, t
);
1011 if (! NULL_LEFT_CHILD (source
))
1012 t
->left
= reproduce_tree (source
->left
, t
);
1013 if (! NULL_RIGHT_CHILD (source
))
1014 t
->right
= reproduce_tree (source
->right
, t
);
1020 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1022 /* Make a new interval of length LENGTH starting at START in the
1023 group of intervals INTERVALS, which is actually an interval tree.
1024 Returns the new interval.
1026 Generate an error if the new positions would overlap an existing
1030 make_new_interval (intervals
, start
, length
)
1036 slot
= find_interval (intervals
, start
);
1037 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1038 error ("Interval would overlap");
1040 if (start
== slot
->position
&& length
== LENGTH (slot
))
1043 if (slot
->position
== start
)
1045 /* New right node. */
1046 split_interval_right (slot
, length
);
1050 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1052 /* New left node. */
1053 split_interval_left (slot
, LENGTH (slot
) - length
);
1057 /* Convert interval SLOT into three intervals. */
1058 split_interval_left (slot
, start
- slot
->position
);
1059 split_interval_right (slot
, length
);
1064 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1066 This is used in insdel.c when inserting Lisp_Strings into the
1067 buffer. The text corresponding to SOURCE is already in the buffer
1068 when this is called. The intervals of new tree are a copy of those
1069 belonging to the string being inserted; intervals are never
1072 If the inserted text had no intervals associated, this function
1073 simply returns -- offset_intervals should handle placing the
1074 text in the correct interval, depending on the sticky bits.
1076 If the inserted text had properties (intervals), then there are two
1077 cases -- either insertion happened in the middle of some interval,
1078 or between two intervals.
1080 If the text goes into the middle of an interval, then new
1081 intervals are created in the middle with only the properties of
1082 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1083 which case the new text has the union of its properties and those
1084 of the text into which it was inserted.
1086 If the text goes between two intervals, then if neither interval
1087 had its appropriate sticky property set (front_sticky, rear_sticky),
1088 the new text has only its properties. If one of the sticky properties
1089 is set, then the new text "sticks" to that region and its properties
1090 depend on merging as above. If both the preceding and succeeding
1091 intervals to the new text are "sticky", then the new text retains
1092 only its properties, as if neither sticky property were set. Perhaps
1093 we should consider merging all three sets of properties onto the new
1097 graft_intervals_into_buffer (source
, position
, buffer
)
1100 struct buffer
*buffer
;
1102 register INTERVAL under
, over
, this, prev
;
1103 register INTERVAL tree
= buffer
->intervals
;
1106 /* If the new text has no properties, it becomes part of whatever
1107 interval it was inserted into. */
1108 if (NULL_INTERVAL_P (source
))
1111 if (NULL_INTERVAL_P (tree
))
1113 /* The inserted text constitutes the whole buffer, so
1114 simply copy over the interval structure. */
1115 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1118 XSET (buf
, Lisp_Buffer
, buffer
);
1119 buffer
->intervals
= reproduce_tree (source
, buf
);
1120 /* Explicitly free the old tree here. */
1125 /* Create an interval tree in which to place a copy
1126 of the intervals of the inserted string. */
1129 XSET (buf
, Lisp_Buffer
, buffer
);
1130 tree
= create_root_interval (buf
);
1134 if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1135 /* If the buffer contains only the new string, but
1136 there was already some interval tree there, then it may be
1137 some zero length intervals. Eventually, do something clever
1138 about inserting properly. For now, just waste the old intervals. */
1140 buffer
->intervals
= reproduce_tree (source
, tree
->parent
);
1141 /* Explicitly free the old tree here. */
1146 /* Paranoia -- the text has already been added, so this buffer
1147 should be of non-zero length. */
1148 if (TOTAL_LENGTH (tree
) == 0)
1151 this = under
= find_interval (tree
, position
);
1152 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1154 over
= find_interval (source
, 1);
1156 /* Here for insertion in the middle of an interval.
1157 Split off an equivalent interval to the right,
1158 then don't bother with it any more. */
1160 if (position
> under
->position
)
1162 INTERVAL end_unchanged
1163 = split_interval_left (this, position
- under
->position
);
1164 copy_properties (under
, end_unchanged
);
1165 under
->position
= position
;
1171 prev
= previous_interval (under
);
1172 if (prev
&& !END_STICKY_P (prev
))
1176 /* Insertion is now at beginning of UNDER. */
1178 /* The inserted text "sticks" to the interval `under',
1179 which means it gets those properties. */
1180 while (! NULL_INTERVAL_P (over
))
1182 if (LENGTH (over
) + 1 < LENGTH (under
))
1183 this = split_interval_left (under
, LENGTH (over
));
1186 copy_properties (over
, this);
1187 /* Insertion at the end of an interval, PREV,
1188 inherits from PREV if PREV is sticky at the end. */
1189 if (prev
&& ! FRONT_STICKY_P (under
)
1190 && MERGE_INSERTIONS (prev
))
1191 merge_properties (prev
, this);
1192 /* Maybe it inherits from the following interval
1193 if that is sticky at the front. */
1194 else if ((FRONT_STICKY_P (under
) || middle
)
1195 && MERGE_INSERTIONS (under
))
1196 merge_properties (under
, this);
1197 over
= next_interval (over
);
1200 buffer
->intervals
= balance_intervals (buffer
->intervals
);
1204 /* Get the value of property PROP from PLIST,
1205 which is the plist of an interval.
1206 We check for direct properties and for categories with property PROP. */
1209 textget (plist
, prop
)
1211 register Lisp_Object prop
;
1213 register Lisp_Object tail
, fallback
;
1216 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1218 register Lisp_Object tem
;
1221 return Fcar (Fcdr (tail
));
1222 if (EQ (tem
, Qcategory
))
1223 fallback
= Fget (Fcar (Fcdr (tail
)), prop
);
1229 /* Set point in BUFFER to POSITION. If the target position is
1230 before an invisible character which is not displayed with a special glyph,
1231 move back to an ok place to display. */
1234 set_point (position
, buffer
)
1235 register int position
;
1236 register struct buffer
*buffer
;
1238 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1240 register Lisp_Object obj
;
1241 int backwards
= (position
< BUF_PT (buffer
)) ? 1 : 0;
1242 int old_position
= buffer
->text
.pt
;
1244 if (position
== buffer
->text
.pt
)
1247 /* Check this now, before checking if the buffer has any intervals.
1248 That way, we can catch conditions which break this sanity check
1249 whether or not there are intervals in the buffer. */
1250 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1253 if (NULL_INTERVAL_P (buffer
->intervals
))
1255 buffer
->text
.pt
= position
;
1259 /* Set TO to the interval containing the char after POSITION,
1260 and TOPREV to the interval containing the char before POSITION.
1261 Either one may be null. They may be equal. */
1262 to
= find_interval (buffer
->intervals
, position
);
1263 if (position
== BUF_BEGV (buffer
))
1265 else if (to
->position
== position
)
1266 toprev
= previous_interval (to
);
1270 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1271 ? BUF_ZV (buffer
) - 1
1274 /* Set FROM to the interval containing the char after PT,
1275 and FROMPREV to the interval containing the char before PT.
1276 Either one may be null. They may be equal. */
1277 /* We could cache this and save time. */
1278 from
= find_interval (buffer
->intervals
, buffer_point
);
1279 if (from
->position
== BUF_BEGV (buffer
))
1281 else if (from
->position
== BUF_PT (buffer
))
1282 fromprev
= previous_interval (from
);
1283 else if (buffer_point
!= BUF_PT (buffer
))
1284 fromprev
= from
, from
= 0;
1288 /* Moving within an interval */
1289 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
))
1291 buffer
->text
.pt
= position
;
1295 /* If the new position is before an invisible character,
1296 move forward over all such. */
1297 while (! NULL_INTERVAL_P (to
)
1298 && ! INTERVAL_VISIBLE_P (to
)
1299 && ! DISPLAY_INVISIBLE_GLYPH (to
))
1302 to
= next_interval (to
);
1303 if (NULL_INTERVAL_P (to
))
1304 position
= BUF_ZV (buffer
);
1306 position
= to
->position
;
1309 buffer
->text
.pt
= position
;
1311 /* We run point-left and point-entered hooks here, iff the
1312 two intervals are not equivalent. These hooks take
1313 (old_point, new_point) as arguments. */
1314 if (NILP (Vinhibit_point_motion_hooks
)
1315 && (! intervals_equal (from
, to
)
1316 || ! intervals_equal (fromprev
, toprev
)))
1318 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1321 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1325 leave_before
= textget (from
->plist
, Qpoint_left
);
1327 leave_before
= Qnil
;
1330 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1334 enter_before
= textget (to
->plist
, Qpoint_entered
);
1336 enter_before
= Qnil
;
1338 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1339 call2 (leave_before
, old_position
, position
);
1340 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1341 call2 (leave_after
, old_position
, position
);
1343 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1344 call2 (enter_before
, old_position
, position
);
1345 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1346 call2 (enter_after
, old_position
, position
);
1350 /* Set point temporarily, without checking any text properties. */
1353 temp_set_point (position
, buffer
)
1355 struct buffer
*buffer
;
1357 buffer
->text
.pt
= position
;
1360 /* Return the proper local map for position POSITION in BUFFER.
1361 Use the map specified by the local-map property, if any.
1362 Otherwise, use BUFFER's local map. */
1365 get_local_map (position
, buffer
)
1366 register int position
;
1367 register struct buffer
*buffer
;
1369 register INTERVAL interval
;
1370 Lisp_Object prop
, tem
;
1372 if (NULL_INTERVAL_P (buffer
->intervals
))
1373 return current_buffer
->keymap
;
1375 /* Perhaps we should just change `position' to the limit. */
1376 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1379 interval
= find_interval (buffer
->intervals
, position
);
1380 prop
= textget (interval
->plist
, Qlocal_map
);
1382 return current_buffer
->keymap
;
1384 /* Use the local map only if it is valid. */
1385 tem
= Fkeymapp (prop
);
1389 return current_buffer
->keymap
;
1392 /* Call the modification hook functions in LIST, each with START and END. */
1395 call_mod_hooks (list
, start
, end
)
1396 Lisp_Object list
, start
, end
;
1398 struct gcpro gcpro1
;
1400 while (!NILP (list
))
1402 call2 (Fcar (list
), start
, end
);
1408 /* Check for read-only intervals and signal an error if we find one.
1409 Then check for any modification hooks in the range START up to
1410 (but not including) TO. Create a list of all these hooks in
1411 lexicographic order, eliminating consecutive extra copies of the
1412 same hook. Then call those hooks in order, with START and END - 1
1416 verify_interval_modification (buf
, start
, end
)
1420 register INTERVAL intervals
= buf
->intervals
;
1421 register INTERVAL i
, prev
;
1423 register Lisp_Object prev_mod_hooks
;
1424 Lisp_Object mod_hooks
;
1425 struct gcpro gcpro1
;
1428 prev_mod_hooks
= Qnil
;
1431 if (NULL_INTERVAL_P (intervals
))
1441 /* For an insert operation, check the two chars around the position. */
1445 Lisp_Object before
, after
;
1447 /* Set I to the interval containing the char after START,
1448 and PREV to the interval containing the char before START.
1449 Either one may be null. They may be equal. */
1450 i
= find_interval (intervals
, start
);
1452 if (start
== BUF_BEGV (buf
))
1454 if (i
->position
== start
)
1455 prev
= previous_interval (i
);
1456 else if (i
->position
< start
)
1458 if (start
== BUF_ZV (buf
))
1461 if (NULL_INTERVAL_P (prev
))
1463 if (! INTERVAL_WRITABLE_P (i
))
1464 error ("Attempt to insert within read-only text");
1466 else if (NULL_INTERVAL_P (i
))
1468 if (! INTERVAL_WRITABLE_P (prev
))
1469 error ("Attempt to insert within read-only text");
1473 before
= textget (prev
->plist
, Qread_only
);
1474 after
= textget (i
->plist
, Qread_only
);
1475 if (! NILP (before
) && EQ (before
, after
)
1476 /* This checks Vinhibit_read_only properly
1477 for the common value of the read-only property. */
1478 && ! INTERVAL_WRITABLE_P (i
))
1479 error ("Attempt to insert within read-only text");
1482 /* Run both insert hooks (just once if they're the same). */
1483 if (!NULL_INTERVAL_P (prev
))
1484 prev_mod_hooks
= textget (prev
->plist
, Qinsert_behind_hooks
);
1485 if (!NULL_INTERVAL_P (i
))
1486 mod_hooks
= textget (i
->plist
, Qinsert_in_front_hooks
);
1488 if (! NILP (prev_mod_hooks
))
1489 call_mod_hooks (prev_mod_hooks
, make_number (start
),
1492 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1493 call_mod_hooks (mod_hooks
, make_number (start
), make_number (end
));
1497 /* Loop over intervals on or next to START...END,
1498 collecting their hooks. */
1500 i
= find_interval (intervals
, start
);
1503 if (! INTERVAL_WRITABLE_P (i
))
1504 error ("Attempt to modify read-only text");
1506 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1507 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1509 hooks
= Fcons (mod_hooks
, hooks
);
1510 prev_mod_hooks
= mod_hooks
;
1513 i
= next_interval (i
);
1515 /* Keep going thru the interval containing the char before END. */
1516 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1519 hooks
= Fnreverse (hooks
);
1520 while (! EQ (hooks
, Qnil
))
1522 call_mod_hooks (Fcar (hooks
), make_number (start
),
1524 hooks
= Fcdr (hooks
);
1530 /* Balance an interval node if the amount of text in its left and right
1531 subtrees differs by more than the percentage specified by
1532 `interval-balance-threshold'. */
1535 balance_an_interval (i
)
1538 register int total_children_size
= (LEFT_TOTAL_LENGTH (i
)
1539 + RIGHT_TOTAL_LENGTH (i
));
1540 register int threshold
= (XFASTINT (interval_balance_threshold
)
1541 * (total_children_size
/ 100));
1543 /* Balance within each side. */
1544 balance_intervals (i
->left
);
1545 balance_intervals (i
->right
);
1547 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1548 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1550 i
= rotate_right (i
);
1551 /* If that made it unbalanced the other way, take it back. */
1552 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1553 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1554 return rotate_left (i
);
1558 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1559 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1561 i
= rotate_left (i
);
1562 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1563 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1564 return rotate_right (i
);
1571 /* Balance the interval tree TREE. Balancing is by weight
1572 (the amount of text). */
1575 balance_intervals (tree
)
1576 register INTERVAL tree
;
1578 register INTERVAL new_tree
;
1580 if (NULL_INTERVAL_P (tree
))
1581 return NULL_INTERVAL
;
1587 new_tree
= balance_an_interval (new_tree
);
1589 while (new_tree
!= tree
);
1594 /* Produce an interval tree reflecting the intervals in
1595 TREE from START to START + LENGTH. */
1598 copy_intervals (tree
, start
, length
)
1602 register INTERVAL i
, new, t
;
1603 register int got
, prevlen
;
1605 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1606 return NULL_INTERVAL
;
1608 i
= find_interval (tree
, start
);
1609 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1612 /* If there is only one interval and it's the default, return nil. */
1613 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
1614 && DEFAULT_INTERVAL_P (i
))
1615 return NULL_INTERVAL
;
1617 new = make_interval ();
1619 got
= (LENGTH (i
) - (start
- i
->position
));
1620 new->total_length
= length
;
1621 copy_properties (i
, new);
1625 while (got
< length
)
1627 i
= next_interval (i
);
1628 t
= split_interval_right (t
, prevlen
);
1629 copy_properties (i
, t
);
1630 prevlen
= LENGTH (i
);
1634 return balance_intervals (new);
1637 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1640 copy_intervals_to_string (string
, buffer
, position
, length
)
1641 Lisp_Object string
, buffer
;
1642 int position
, length
;
1644 INTERVAL interval_copy
= copy_intervals (XBUFFER (buffer
)->intervals
,
1646 if (NULL_INTERVAL_P (interval_copy
))
1649 interval_copy
->parent
= (INTERVAL
) string
;
1650 XSTRING (string
)->intervals
= interval_copy
;
1653 #endif /* USE_TEXT_PROPERTIES */