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 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"
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 (Fcar (Fcdr (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
;
644 register INTERVAL temp
;
647 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
650 /* If inserting at point-max of a buffer, that position will be out
651 of range. Remember that buffer positions are 1-based. */
652 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
653 position
= BEG
+ TOTAL_LENGTH (tree
);
657 i
= find_interval (tree
, position
);
659 /* If we are positioned between intervals, check the stickiness of
660 both of them. We have to do this too, if we are at BEG or Z. */
661 if (position
== i
->position
|| eobp
)
663 register INTERVAL prev
;
673 prev
= previous_interval (i
);
675 /* Even if we are positioned between intervals, we default
676 to the left one if it exists. We extend it now and split
677 off a part later, if stickyness demands it. */
678 for (temp
= prev
? prev
: i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
679 temp
->total_length
+= length
;
681 /* If at least one interval has sticky properties,
682 we check the stickyness property by property. */
683 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
685 Lisp_Object pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
686 Lisp_Object pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
687 struct interval newi
;
689 newi
.plist
= merge_properties_sticky (pleft
, pright
);
691 if(! prev
) /* i.e. position == BEG */
693 if (! intervals_equal (i
, &newi
))
695 i
= split_interval_left (i
, length
);
696 i
->plist
= newi
.plist
;
699 else if (! intervals_equal (prev
, &newi
))
701 prev
= split_interval_right (prev
,
702 position
- prev
->position
);
703 prev
->plist
= newi
.plist
;
704 if (! NULL_INTERVAL_P (i
)
705 && intervals_equal (prev
, i
))
706 merge_interval_right (prev
);
709 /* We will need to update the cache here later. */
711 else if (! prev
&& ! NILP (i
->plist
))
713 /* Just split off a new interval at the left.
714 Since I wasn't front-sticky, the empty plist is ok. */
715 i
= split_interval_left (i
, length
);
719 /* Otherwise just extend the interval. */
722 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
723 temp
->total_length
+= length
;
730 merge_properties_sticky (pleft
, pright
)
731 Lisp_Object pleft
, pright
;
733 register Lisp_Object props
= Qnil
, front
= Qnil
, rear
= Qnil
;
735 Lisp_Object lfront
= textget (pleft
, Qfront_sticky
);
736 Lisp_Object lrear
= textget (pleft
, Qrear_nonsticky
);
737 Lisp_Object rfront
= textget (pright
, Qfront_sticky
);
738 Lisp_Object rrear
= textget (pright
, Qrear_nonsticky
);
740 register Lisp_Object tail1
, tail2
, sym
;
742 /* Go through each element of PLEFT. */
743 for (tail1
= pleft
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
747 /* Sticky properties get special treatment. */
748 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
751 if (NILP (Fmemq (sym
, lrear
)))
753 /* rear-sticky is dominant, we needn't search in PRIGHT. */
755 props
= Fcons (sym
, Fcons (Fcar (Fcdr (tail1
)), props
));
756 if (! NILP (Fmemq (sym
, lfront
)))
757 front
= Fcons (sym
, front
);
761 /* Go through PRIGHT, looking for sym. */
762 for (tail2
= pright
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
763 if (EQ (sym
, Fcar (tail2
)))
766 if (! NILP (Fmemq (sym
, rfront
)))
768 /* Nonsticky at the left and sticky at the right,
769 so take the right one. */
770 props
= Fcons (sym
, Fcons (Fcar (Fcdr (tail2
)), props
));
771 front
= Fcons (sym
, front
);
772 if (! NILP (Fmemq (sym
, rrear
)))
773 rear
= Fcons (sym
, rear
);
779 /* Now let's see what to keep from PRIGHT. */
780 for (tail2
= pright
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
784 /* Sticky properties get special treatment. */
785 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
788 /* If it ain't sticky, we don't take it. */
789 if (NILP (Fmemq (sym
, rfront
)))
792 /* If sym is in PLEFT we already got it. */
793 for (tail1
= pleft
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
794 if (EQ (sym
, Fcar (tail1
)))
799 props
= Fcons (sym
, Fcons (Fcar (Fcdr (tail2
)), props
));
800 front
= Fcons (sym
, front
);
801 if (! NILP (Fmemq (sym
, rrear
)))
802 rear
= Fcons (sym
, rear
);
806 props
= Fcons (Qfront_sticky
, Fcons (front
, props
));
808 props
= Fcons (Qrear_nonsticky
, Fcons (rear
, props
));
814 /* Delete an node I from its interval tree by merging its subtrees
815 into one subtree which is then returned. Caller is responsible for
816 storing the resulting subtree into its parent. */
822 register INTERVAL migrate
, this;
823 register int migrate_amt
;
825 if (NULL_INTERVAL_P (i
->left
))
827 if (NULL_INTERVAL_P (i
->right
))
831 migrate_amt
= i
->left
->total_length
;
833 this->total_length
+= migrate_amt
;
834 while (! NULL_INTERVAL_P (this->left
))
837 this->total_length
+= migrate_amt
;
839 this->left
= migrate
;
840 migrate
->parent
= this;
845 /* Delete interval I from its tree by calling `delete_node'
846 and properly connecting the resultant subtree.
848 I is presumed to be empty; that is, no adjustments are made
849 for the length of I. */
855 register INTERVAL parent
;
856 int amt
= LENGTH (i
);
858 if (amt
> 0) /* Only used on zero-length intervals now. */
861 if (ROOT_INTERVAL_P (i
))
863 Lisp_Object owner
= (Lisp_Object
) i
->parent
;
864 parent
= delete_node (i
);
865 if (! NULL_INTERVAL_P (parent
))
866 parent
->parent
= (INTERVAL
) owner
;
868 if (XTYPE (owner
) == Lisp_Buffer
)
869 XBUFFER (owner
)->intervals
= parent
;
870 else if (XTYPE (owner
) == Lisp_String
)
871 XSTRING (owner
)->intervals
= parent
;
879 if (AM_LEFT_CHILD (i
))
881 parent
->left
= delete_node (i
);
882 if (! NULL_INTERVAL_P (parent
->left
))
883 parent
->left
->parent
= parent
;
887 parent
->right
= delete_node (i
);
888 if (! NULL_INTERVAL_P (parent
->right
))
889 parent
->right
->parent
= parent
;
893 /* Find the interval in TREE corresponding to the relative position
894 FROM and delete as much as possible of AMOUNT from that interval.
895 Return the amount actually deleted, and if the interval was
896 zeroed-out, delete that interval node from the tree.
898 Note that FROM is actually origin zero, aka relative to the
899 leftmost edge of tree. This is appropriate since we call ourselves
900 recursively on subtrees.
902 Do this by recursing down TREE to the interval in question, and
903 deleting the appropriate amount of text. */
906 interval_deletion_adjustment (tree
, from
, amount
)
907 register INTERVAL tree
;
908 register int from
, amount
;
910 register int relative_position
= from
;
912 if (NULL_INTERVAL_P (tree
))
916 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
918 int subtract
= interval_deletion_adjustment (tree
->left
,
921 tree
->total_length
-= subtract
;
925 else if (relative_position
>= (TOTAL_LENGTH (tree
)
926 - RIGHT_TOTAL_LENGTH (tree
)))
930 relative_position
-= (tree
->total_length
931 - RIGHT_TOTAL_LENGTH (tree
));
932 subtract
= interval_deletion_adjustment (tree
->right
,
935 tree
->total_length
-= subtract
;
938 /* Here -- this node. */
941 /* How much can we delete from this interval? */
942 int my_amount
= ((tree
->total_length
943 - RIGHT_TOTAL_LENGTH (tree
))
944 - relative_position
);
946 if (amount
> my_amount
)
949 tree
->total_length
-= amount
;
950 if (LENGTH (tree
) == 0)
951 delete_interval (tree
);
956 /* Never reach here. */
959 /* Effect the adjustments necessary to the interval tree of BUFFER to
960 correspond to the deletion of LENGTH characters from that buffer
961 text. The deletion is effected at position START (which is a
962 buffer position, i.e. origin 1). */
965 adjust_intervals_for_deletion (buffer
, start
, length
)
966 struct buffer
*buffer
;
969 register int left_to_delete
= length
;
970 register INTERVAL tree
= buffer
->intervals
;
971 register int deleted
;
973 if (NULL_INTERVAL_P (tree
))
976 if (start
> BEG
+ TOTAL_LENGTH (tree
)
977 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
980 if (length
== TOTAL_LENGTH (tree
))
982 buffer
->intervals
= NULL_INTERVAL
;
986 if (ONLY_INTERVAL_P (tree
))
988 tree
->total_length
-= length
;
992 if (start
> BEG
+ TOTAL_LENGTH (tree
))
993 start
= BEG
+ TOTAL_LENGTH (tree
);
994 while (left_to_delete
> 0)
996 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
998 tree
= buffer
->intervals
;
999 if (left_to_delete
== tree
->total_length
)
1001 buffer
->intervals
= NULL_INTERVAL
;
1007 /* Make the adjustments necessary to the interval tree of BUFFER to
1008 represent an addition or deletion of LENGTH characters starting
1009 at position START. Addition or deletion is indicated by the sign
1013 offset_intervals (buffer
, start
, length
)
1014 struct buffer
*buffer
;
1017 if (NULL_INTERVAL_P (buffer
->intervals
) || length
== 0)
1021 adjust_intervals_for_insertion (buffer
->intervals
, start
, length
);
1023 adjust_intervals_for_deletion (buffer
, start
, -length
);
1026 /* Merge interval I with its lexicographic successor. The resulting
1027 interval is returned, and has the properties of the original
1028 successor. The properties of I are lost. I is removed from the
1032 The caller must verify that this is not the last (rightmost)
1036 merge_interval_right (i
)
1037 register INTERVAL i
;
1039 register int absorb
= LENGTH (i
);
1040 register INTERVAL successor
;
1042 /* Zero out this interval. */
1043 i
->total_length
-= absorb
;
1045 /* Find the succeeding interval. */
1046 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1049 successor
= i
->right
;
1050 while (! NULL_LEFT_CHILD (successor
))
1052 successor
->total_length
+= absorb
;
1053 successor
= successor
->left
;
1056 successor
->total_length
+= absorb
;
1057 delete_interval (i
);
1062 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1065 if (AM_LEFT_CHILD (successor
))
1067 successor
= successor
->parent
;
1068 delete_interval (i
);
1072 successor
= successor
->parent
;
1073 successor
->total_length
-= absorb
;
1076 /* This must be the rightmost or last interval and cannot
1077 be merged right. The caller should have known. */
1081 /* Merge interval I with its lexicographic predecessor. The resulting
1082 interval is returned, and has the properties of the original predecessor.
1083 The properties of I are lost. Interval node I is removed from the tree.
1086 The caller must verify that this is not the first (leftmost) interval. */
1089 merge_interval_left (i
)
1090 register INTERVAL i
;
1092 register int absorb
= LENGTH (i
);
1093 register INTERVAL predecessor
;
1095 /* Zero out this interval. */
1096 i
->total_length
-= absorb
;
1098 /* Find the preceding interval. */
1099 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1100 adding ABSORB as we go. */
1102 predecessor
= i
->left
;
1103 while (! NULL_RIGHT_CHILD (predecessor
))
1105 predecessor
->total_length
+= absorb
;
1106 predecessor
= predecessor
->right
;
1109 predecessor
->total_length
+= absorb
;
1110 delete_interval (i
);
1115 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1116 subtracting ABSORB. */
1118 if (AM_RIGHT_CHILD (predecessor
))
1120 predecessor
= predecessor
->parent
;
1121 delete_interval (i
);
1125 predecessor
= predecessor
->parent
;
1126 predecessor
->total_length
-= absorb
;
1129 /* This must be the leftmost or first interval and cannot
1130 be merged left. The caller should have known. */
1134 /* Make an exact copy of interval tree SOURCE which descends from
1135 PARENT. This is done by recursing through SOURCE, copying
1136 the current interval and its properties, and then adjusting
1137 the pointers of the copy. */
1140 reproduce_tree (source
, parent
)
1141 INTERVAL source
, parent
;
1143 register INTERVAL t
= make_interval ();
1145 bcopy (source
, t
, INTERVAL_SIZE
);
1146 copy_properties (source
, t
);
1148 if (! NULL_LEFT_CHILD (source
))
1149 t
->left
= reproduce_tree (source
->left
, t
);
1150 if (! NULL_RIGHT_CHILD (source
))
1151 t
->right
= reproduce_tree (source
->right
, t
);
1157 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1159 /* Make a new interval of length LENGTH starting at START in the
1160 group of intervals INTERVALS, which is actually an interval tree.
1161 Returns the new interval.
1163 Generate an error if the new positions would overlap an existing
1167 make_new_interval (intervals
, start
, length
)
1173 slot
= find_interval (intervals
, start
);
1174 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1175 error ("Interval would overlap");
1177 if (start
== slot
->position
&& length
== LENGTH (slot
))
1180 if (slot
->position
== start
)
1182 /* New right node. */
1183 split_interval_right (slot
, length
);
1187 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1189 /* New left node. */
1190 split_interval_left (slot
, LENGTH (slot
) - length
);
1194 /* Convert interval SLOT into three intervals. */
1195 split_interval_left (slot
, start
- slot
->position
);
1196 split_interval_right (slot
, length
);
1201 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1203 This is used in insdel.c when inserting Lisp_Strings into the
1204 buffer. The text corresponding to SOURCE is already in the buffer
1205 when this is called. The intervals of new tree are a copy of those
1206 belonging to the string being inserted; intervals are never
1209 If the inserted text had no intervals associated, this function
1210 simply returns -- offset_intervals should handle placing the
1211 text in the correct interval, depending on the sticky bits.
1213 If the inserted text had properties (intervals), then there are two
1214 cases -- either insertion happened in the middle of some interval,
1215 or between two intervals.
1217 If the text goes into the middle of an interval, then new
1218 intervals are created in the middle with only the properties of
1219 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1220 which case the new text has the union of its properties and those
1221 of the text into which it was inserted.
1223 If the text goes between two intervals, then if neither interval
1224 had its appropriate sticky property set (front_sticky, rear_sticky),
1225 the new text has only its properties. If one of the sticky properties
1226 is set, then the new text "sticks" to that region and its properties
1227 depend on merging as above. If both the preceding and succeeding
1228 intervals to the new text are "sticky", then the new text retains
1229 only its properties, as if neither sticky property were set. Perhaps
1230 we should consider merging all three sets of properties onto the new
1234 graft_intervals_into_buffer (source
, position
, buffer
)
1237 struct buffer
*buffer
;
1239 register INTERVAL under
, over
, this, prev
;
1240 register INTERVAL tree
= buffer
->intervals
;
1243 /* If the new text has no properties, it becomes part of whatever
1244 interval it was inserted into. */
1245 if (NULL_INTERVAL_P (source
))
1248 if (NULL_INTERVAL_P (tree
))
1250 /* The inserted text constitutes the whole buffer, so
1251 simply copy over the interval structure. */
1252 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1255 XSET (buf
, Lisp_Buffer
, buffer
);
1256 buffer
->intervals
= reproduce_tree (source
, buf
);
1257 /* Explicitly free the old tree here. */
1262 /* Create an interval tree in which to place a copy
1263 of the intervals of the inserted string. */
1266 XSET (buf
, Lisp_Buffer
, buffer
);
1267 tree
= create_root_interval (buf
);
1271 if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1272 /* If the buffer contains only the new string, but
1273 there was already some interval tree there, then it may be
1274 some zero length intervals. Eventually, do something clever
1275 about inserting properly. For now, just waste the old intervals. */
1277 buffer
->intervals
= reproduce_tree (source
, tree
->parent
);
1278 /* Explicitly free the old tree here. */
1283 /* Paranoia -- the text has already been added, so this buffer
1284 should be of non-zero length. */
1285 if (TOTAL_LENGTH (tree
) == 0)
1288 this = under
= find_interval (tree
, position
);
1289 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1291 over
= find_interval (source
, 1);
1293 /* Here for insertion in the middle of an interval.
1294 Split off an equivalent interval to the right,
1295 then don't bother with it any more. */
1297 if (position
> under
->position
)
1299 INTERVAL end_unchanged
1300 = split_interval_left (this, position
- under
->position
);
1301 copy_properties (under
, end_unchanged
);
1302 under
->position
= position
;
1308 prev
= previous_interval (under
);
1309 if (prev
&& !END_NONSTICKY_P (prev
))
1313 /* Insertion is now at beginning of UNDER. */
1315 /* The inserted text "sticks" to the interval `under',
1316 which means it gets those properties.
1317 The properties of under are the result of
1318 adjust_intervals_for_insertion, so stickyness has
1319 already been taken care of. */
1321 while (! NULL_INTERVAL_P (over
))
1323 if (LENGTH (over
) + 1 < LENGTH (under
))
1325 this = split_interval_left (under
, LENGTH (over
));
1326 copy_properties (under
, this);
1330 copy_properties (over
, this);
1331 if (MERGE_INSERTIONS (this))
1332 merge_properties (over
, this);
1334 copy_properties (over
, this);
1335 over
= next_interval (over
);
1338 buffer
->intervals
= balance_intervals (buffer
->intervals
);
1342 /* Get the value of property PROP from PLIST,
1343 which is the plist of an interval.
1344 We check for direct properties and for categories with property PROP. */
1347 textget (plist
, prop
)
1349 register Lisp_Object prop
;
1351 register Lisp_Object tail
, fallback
;
1354 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1356 register Lisp_Object tem
;
1359 return Fcar (Fcdr (tail
));
1360 if (EQ (tem
, Qcategory
))
1361 fallback
= Fget (Fcar (Fcdr (tail
)), prop
);
1367 /* Get the value of property PROP from PLIST,
1368 which is the plist of an interval.
1369 We check for direct properties only! */
1372 textget_direct (plist
, prop
)
1374 register Lisp_Object prop
;
1376 register Lisp_Object tail
;
1378 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1380 if (EQ (prop
, Fcar (tail
)))
1381 return Fcar (Fcdr (tail
));
1387 /* Set point in BUFFER to POSITION. If the target position is
1388 before an invisible character which is not displayed with a special glyph,
1389 move back to an ok place to display. */
1392 set_point (position
, buffer
)
1393 register int position
;
1394 register struct buffer
*buffer
;
1396 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1398 register Lisp_Object obj
;
1399 int backwards
= (position
< BUF_PT (buffer
)) ? 1 : 0;
1400 int old_position
= buffer
->text
.pt
;
1402 if (position
== buffer
->text
.pt
)
1405 /* Check this now, before checking if the buffer has any intervals.
1406 That way, we can catch conditions which break this sanity check
1407 whether or not there are intervals in the buffer. */
1408 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1411 if (NULL_INTERVAL_P (buffer
->intervals
))
1413 buffer
->text
.pt
= position
;
1417 /* Set TO to the interval containing the char after POSITION,
1418 and TOPREV to the interval containing the char before POSITION.
1419 Either one may be null. They may be equal. */
1420 to
= find_interval (buffer
->intervals
, position
);
1421 if (position
== BUF_BEGV (buffer
))
1423 else if (to
->position
== position
)
1424 toprev
= previous_interval (to
);
1428 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1429 ? BUF_ZV (buffer
) - 1
1432 /* Set FROM to the interval containing the char after PT,
1433 and FROMPREV to the interval containing the char before PT.
1434 Either one may be null. They may be equal. */
1435 /* We could cache this and save time. */
1436 from
= find_interval (buffer
->intervals
, buffer_point
);
1437 if (buffer_point
== BUF_BEGV (buffer
))
1439 else if (from
->position
== BUF_PT (buffer
))
1440 fromprev
= previous_interval (from
);
1441 else if (buffer_point
!= BUF_PT (buffer
))
1442 fromprev
= from
, from
= 0;
1446 /* Moving within an interval. */
1447 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
))
1449 buffer
->text
.pt
= position
;
1453 /* If the new position is before an invisible character
1454 that has an `invisible' property of value `hidden',
1455 move forward over all such. */
1456 while (! NULL_INTERVAL_P (to
)
1457 && EQ (textget (to
->plist
, Qinvisible
), Qhidden
)
1458 && ! DISPLAY_INVISIBLE_GLYPH (to
))
1461 to
= next_interval (to
);
1462 if (NULL_INTERVAL_P (to
))
1463 position
= BUF_ZV (buffer
);
1465 position
= to
->position
;
1468 buffer
->text
.pt
= position
;
1470 /* We run point-left and point-entered hooks here, iff the
1471 two intervals are not equivalent. These hooks take
1472 (old_point, new_point) as arguments. */
1473 if (NILP (Vinhibit_point_motion_hooks
)
1474 && (! intervals_equal (from
, to
)
1475 || ! intervals_equal (fromprev
, toprev
)))
1477 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1480 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1484 leave_before
= textget (from
->plist
, Qpoint_left
);
1486 leave_before
= Qnil
;
1489 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1493 enter_before
= textget (to
->plist
, Qpoint_entered
);
1495 enter_before
= Qnil
;
1497 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1498 call2 (leave_before
, old_position
, position
);
1499 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1500 call2 (leave_after
, old_position
, position
);
1502 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1503 call2 (enter_before
, old_position
, position
);
1504 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1505 call2 (enter_after
, old_position
, position
);
1509 /* Set point temporarily, without checking any text properties. */
1512 temp_set_point (position
, buffer
)
1514 struct buffer
*buffer
;
1516 buffer
->text
.pt
= position
;
1519 /* Return the proper local map for position POSITION in BUFFER.
1520 Use the map specified by the local-map property, if any.
1521 Otherwise, use BUFFER's local map. */
1524 get_local_map (position
, buffer
)
1525 register int position
;
1526 register struct buffer
*buffer
;
1528 register INTERVAL interval
;
1529 Lisp_Object prop
, tem
;
1531 if (NULL_INTERVAL_P (buffer
->intervals
))
1532 return current_buffer
->keymap
;
1534 /* Perhaps we should just change `position' to the limit. */
1535 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1538 interval
= find_interval (buffer
->intervals
, position
);
1539 prop
= textget (interval
->plist
, Qlocal_map
);
1541 return current_buffer
->keymap
;
1543 /* Use the local map only if it is valid. */
1544 tem
= Fkeymapp (prop
);
1548 return current_buffer
->keymap
;
1551 /* Call the modification hook functions in LIST, each with START and END. */
1554 call_mod_hooks (list
, start
, end
)
1555 Lisp_Object list
, start
, end
;
1557 struct gcpro gcpro1
;
1559 while (!NILP (list
))
1561 call2 (Fcar (list
), start
, end
);
1567 /* Check for read-only intervals and signal an error if we find one.
1568 Then check for any modification hooks in the range START up to
1569 (but not including) TO. Create a list of all these hooks in
1570 lexicographic order, eliminating consecutive extra copies of the
1571 same hook. Then call those hooks in order, with START and END - 1
1575 verify_interval_modification (buf
, start
, end
)
1579 register INTERVAL intervals
= buf
->intervals
;
1580 register INTERVAL i
, prev
;
1582 register Lisp_Object prev_mod_hooks
;
1583 Lisp_Object mod_hooks
;
1584 struct gcpro gcpro1
;
1587 prev_mod_hooks
= Qnil
;
1590 if (NULL_INTERVAL_P (intervals
))
1600 /* For an insert operation, check the two chars around the position. */
1604 Lisp_Object before
, after
;
1606 /* Set I to the interval containing the char after START,
1607 and PREV to the interval containing the char before START.
1608 Either one may be null. They may be equal. */
1609 i
= find_interval (intervals
, start
);
1611 if (start
== BUF_BEGV (buf
))
1613 else if (i
->position
== start
)
1614 prev
= previous_interval (i
);
1615 else if (i
->position
< start
)
1617 if (start
== BUF_ZV (buf
))
1620 /* If Vinhibit_read_only is set and is not a list, we can
1621 skip the read_only checks. */
1622 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1624 /* If I and PREV differ we need to check for the read-only
1625 property together with its stickyness. If either I or
1626 PREV are 0, this check is all we need.
1627 We have to take special care, since read-only may be
1628 indirectly defined via the category property. */
1631 if (! NULL_INTERVAL_P (i
))
1633 after
= textget (i
->plist
, Qread_only
);
1635 /* If interval I is read-only and read-only is
1636 front-sticky, inhibit insertion.
1637 Check for read-only as well as category. */
1639 && NILP (Fmemq (after
, Vinhibit_read_only
))
1640 && (! NILP (Fmemq (Qread_only
,
1641 textget (i
->plist
, Qfront_sticky
)))
1642 || (NILP (textget_direct (i
->plist
, Qread_only
))
1643 && ! NILP (Fmemq (Qcategory
,
1646 error ("Attempt to insert within read-only text");
1650 if (! NULL_INTERVAL_P (prev
))
1652 before
= textget (prev
->plist
, Qread_only
);
1654 /* If interval PREV is read-only and read-only isn't
1655 rear-nonsticky, inhibit insertion.
1656 Check for read-only as well as category. */
1658 && NILP (Fmemq (before
, Vinhibit_read_only
))
1659 && NILP (Fmemq (Qread_only
,
1660 textget (prev
->plist
, Qrear_nonsticky
)))
1661 && (! NILP (textget_direct (prev
->plist
,Qread_only
))
1662 || NILP (Fmemq (Qcategory
,
1663 textget (prev
->plist
,
1664 Qrear_nonsticky
)))))
1665 error ("Attempt to insert within read-only text");
1670 else if (! NULL_INTERVAL_P (i
))
1671 before
= after
= textget (i
->plist
, Qread_only
);
1672 if (! NULL_INTERVAL_P (i
) && ! NULL_INTERVAL_P (prev
))
1674 /* If I and PREV differ, neither of them has a sticky
1675 read-only property. It only remains to check, whether
1676 they have a common read-only property. */
1677 if (! NILP (before
) && EQ (before
, after
))
1678 error ("Attempt to insert within read-only text");
1682 /* Run both insert hooks (just once if they're the same). */
1683 if (!NULL_INTERVAL_P (prev
))
1684 prev_mod_hooks
= textget (prev
->plist
, Qinsert_behind_hooks
);
1685 if (!NULL_INTERVAL_P (i
))
1686 mod_hooks
= textget (i
->plist
, Qinsert_in_front_hooks
);
1688 if (! NILP (prev_mod_hooks
))
1689 call_mod_hooks (prev_mod_hooks
, make_number (start
),
1692 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1693 call_mod_hooks (mod_hooks
, make_number (start
), make_number (end
));
1697 /* Loop over intervals on or next to START...END,
1698 collecting their hooks. */
1700 i
= find_interval (intervals
, start
);
1703 if (! INTERVAL_WRITABLE_P (i
))
1704 error ("Attempt to modify read-only text");
1706 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1707 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1709 hooks
= Fcons (mod_hooks
, hooks
);
1710 prev_mod_hooks
= mod_hooks
;
1713 i
= next_interval (i
);
1715 /* Keep going thru the interval containing the char before END. */
1716 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1719 hooks
= Fnreverse (hooks
);
1720 while (! EQ (hooks
, Qnil
))
1722 call_mod_hooks (Fcar (hooks
), make_number (start
),
1724 hooks
= Fcdr (hooks
);
1730 /* Balance an interval node if the amount of text in its left and right
1731 subtrees differs by more than the percentage specified by
1732 `interval-balance-threshold'. */
1735 balance_an_interval (i
)
1738 register int total_children_size
= (LEFT_TOTAL_LENGTH (i
)
1739 + RIGHT_TOTAL_LENGTH (i
));
1740 register int threshold
= (XFASTINT (interval_balance_threshold
)
1741 * (total_children_size
/ 100));
1743 /* Balance within each side. */
1744 balance_intervals (i
->left
);
1745 balance_intervals (i
->right
);
1747 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1748 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1750 i
= rotate_right (i
);
1751 /* If that made it unbalanced the other way, take it back. */
1752 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1753 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1754 return rotate_left (i
);
1758 if (RIGHT_TOTAL_LENGTH (i
) > LEFT_TOTAL_LENGTH (i
)
1759 && (RIGHT_TOTAL_LENGTH (i
) - LEFT_TOTAL_LENGTH (i
)) > threshold
)
1761 i
= rotate_left (i
);
1762 if (LEFT_TOTAL_LENGTH (i
) > RIGHT_TOTAL_LENGTH (i
)
1763 && (LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
)) > threshold
)
1764 return rotate_right (i
);
1771 /* Balance the interval tree TREE. Balancing is by weight
1772 (the amount of text). */
1775 balance_intervals (tree
)
1776 register INTERVAL tree
;
1778 register INTERVAL new_tree
;
1780 if (NULL_INTERVAL_P (tree
))
1781 return NULL_INTERVAL
;
1787 new_tree
= balance_an_interval (new_tree
);
1789 while (new_tree
!= tree
);
1794 /* Produce an interval tree reflecting the intervals in
1795 TREE from START to START + LENGTH. */
1798 copy_intervals (tree
, start
, length
)
1802 register INTERVAL i
, new, t
;
1803 register int got
, prevlen
;
1805 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1806 return NULL_INTERVAL
;
1808 i
= find_interval (tree
, start
);
1809 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1812 /* If there is only one interval and it's the default, return nil. */
1813 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
1814 && DEFAULT_INTERVAL_P (i
))
1815 return NULL_INTERVAL
;
1817 new = make_interval ();
1819 got
= (LENGTH (i
) - (start
- i
->position
));
1820 new->total_length
= length
;
1821 copy_properties (i
, new);
1825 while (got
< length
)
1827 i
= next_interval (i
);
1828 t
= split_interval_right (t
, prevlen
);
1829 copy_properties (i
, t
);
1830 prevlen
= LENGTH (i
);
1834 return balance_intervals (new);
1837 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1840 copy_intervals_to_string (string
, buffer
, position
, length
)
1841 Lisp_Object string
, buffer
;
1842 int position
, length
;
1844 INTERVAL interval_copy
= copy_intervals (XBUFFER (buffer
)->intervals
,
1846 if (NULL_INTERVAL_P (interval_copy
))
1849 interval_copy
->parent
= (INTERVAL
) string
;
1850 XSTRING (string
)->intervals
= interval_copy
;
1853 #endif /* USE_TEXT_PROPERTIES */