1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
43 #include "intervals.h"
48 /* The rest of the file is within this conditional. */
49 #ifdef USE_TEXT_PROPERTIES
51 /* Test for membership, allowing for t (actually any non-cons) to mean the
54 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
56 #define min(x, y) ((x) < (y) ? (x) : (y))
58 Lisp_Object
merge_properties_sticky ();
60 /* Utility functions for intervals. */
63 /* Create the root interval of some object, a buffer or string. */
66 create_root_interval (parent
)
71 CHECK_IMPURE (parent
);
73 new = make_interval ();
77 new->total_length
= (BUF_Z (XBUFFER (parent
))
78 - BUF_BEG (XBUFFER (parent
)));
79 BUF_INTERVALS (XBUFFER (parent
)) = new;
81 else if (STRINGP (parent
))
83 new->total_length
= XSTRING (parent
)->size
;
84 XSTRING (parent
)->intervals
= new;
87 new->parent
= (INTERVAL
) parent
;
93 /* Make the interval TARGET have exactly the properties of SOURCE */
96 copy_properties (source
, target
)
97 register INTERVAL source
, target
;
99 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
102 COPY_INTERVAL_CACHE (source
, target
);
103 target
->plist
= Fcopy_sequence (source
->plist
);
106 /* Merge the properties of interval SOURCE into the properties
107 of interval TARGET. That is to say, each property in SOURCE
108 is added to TARGET if TARGET has no such property as yet. */
111 merge_properties (source
, target
)
112 register INTERVAL source
, target
;
114 register Lisp_Object o
, sym
, val
;
116 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
119 MERGE_INTERVAL_CACHE (source
, target
);
122 while (! EQ (o
, Qnil
))
125 val
= Fmemq (sym
, target
->plist
);
131 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
139 /* Return 1 if the two intervals have the same properties,
143 intervals_equal (i0
, i1
)
146 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
149 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
152 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
155 i1_len
= XFASTINT (Flength (i1
->plist
));
156 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
160 while (!NILP (i0_cdr
))
162 /* Lengths of the two plists were unequal. */
166 i0_sym
= Fcar (i0_cdr
);
167 i1_val
= Fmemq (i0_sym
, i1
->plist
);
169 /* i0 has something i1 doesn't. */
170 if (EQ (i1_val
, Qnil
))
173 /* i0 and i1 both have sym, but it has different values in each. */
174 i0_cdr
= Fcdr (i0_cdr
);
175 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
178 i0_cdr
= Fcdr (i0_cdr
);
182 /* Lengths of the two plists were unequal. */
191 static int zero_length
;
193 /* Traverse an interval tree TREE, performing FUNCTION on each node.
194 Pass FUNCTION two args: an interval, and ARG. */
197 traverse_intervals (tree
, position
, depth
, function
, arg
)
200 void (* function
) ();
203 if (NULL_INTERVAL_P (tree
))
206 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
207 position
+= LEFT_TOTAL_LENGTH (tree
);
208 tree
->position
= position
;
209 (*function
) (tree
, arg
);
210 position
+= LENGTH (tree
);
211 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
215 /* These functions are temporary, for debugging purposes only. */
217 INTERVAL search_interval
, found_interval
;
220 check_for_interval (i
)
223 if (i
== search_interval
)
231 search_for_interval (i
, tree
)
232 register INTERVAL i
, tree
;
236 found_interval
= NULL_INTERVAL
;
237 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
238 return found_interval
;
242 inc_interval_count (i
)
259 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
265 root_interval (interval
)
268 register INTERVAL i
= interval
;
270 while (! ROOT_INTERVAL_P (i
))
277 /* Assuming that a left child exists, perform the following operation:
287 rotate_right (interval
)
291 INTERVAL B
= interval
->left
;
292 int old_total
= interval
->total_length
;
294 /* Deal with any Parent of A; make it point to B. */
295 if (! ROOT_INTERVAL_P (interval
))
296 if (AM_LEFT_CHILD (interval
))
297 interval
->parent
->left
= B
;
299 interval
->parent
->right
= B
;
300 B
->parent
= interval
->parent
;
302 /* Make B the parent of A */
305 interval
->parent
= B
;
307 /* Make A point to c */
309 if (! NULL_INTERVAL_P (i
))
310 i
->parent
= interval
;
312 /* A's total length is decreased by the length of B and its left child. */
313 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
315 /* B must have the same total length of A. */
316 B
->total_length
= old_total
;
321 /* Assuming that a right child exists, perform the following operation:
331 rotate_left (interval
)
335 INTERVAL B
= interval
->right
;
336 int old_total
= interval
->total_length
;
338 /* Deal with any parent of A; make it point to B. */
339 if (! ROOT_INTERVAL_P (interval
))
340 if (AM_LEFT_CHILD (interval
))
341 interval
->parent
->left
= B
;
343 interval
->parent
->right
= B
;
344 B
->parent
= interval
->parent
;
346 /* Make B the parent of A */
349 interval
->parent
= B
;
351 /* Make A point to c */
353 if (! NULL_INTERVAL_P (i
))
354 i
->parent
= interval
;
356 /* A's total length is decreased by the length of B and its right child. */
357 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
359 /* B must have the same total length of A. */
360 B
->total_length
= old_total
;
365 /* Balance an interval tree with the assumption that the subtrees
366 themselves are already balanced. */
369 balance_an_interval (i
)
372 register int old_diff
, new_diff
;
376 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
379 new_diff
= i
->total_length
- i
->left
->total_length
380 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
381 if (abs (new_diff
) >= old_diff
)
383 i
= rotate_right (i
);
384 balance_an_interval (i
->right
);
386 else if (old_diff
< 0)
388 new_diff
= i
->total_length
- i
->right
->total_length
389 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
390 if (abs (new_diff
) >= -old_diff
)
393 balance_an_interval (i
->left
);
401 /* Balance INTERVAL, potentially stuffing it back into its parent
404 static INLINE INTERVAL
405 balance_possible_root_interval (interval
)
406 register INTERVAL interval
;
410 if (interval
->parent
== NULL_INTERVAL
)
413 parent
= (Lisp_Object
) (interval
->parent
);
414 interval
= balance_an_interval (interval
);
416 if (BUFFERP (parent
))
417 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
418 else if (STRINGP (parent
))
419 XSTRING (parent
)->intervals
= interval
;
424 /* Balance the interval tree TREE. Balancing is by weight
425 (the amount of text). */
428 balance_intervals_internal (tree
)
429 register INTERVAL tree
;
431 /* Balance within each side. */
433 balance_intervals (tree
->left
);
435 balance_intervals (tree
->right
);
436 return balance_an_interval (tree
);
439 /* Advertised interface to balance intervals. */
442 balance_intervals (tree
)
445 if (tree
== NULL_INTERVAL
)
446 return NULL_INTERVAL
;
448 return balance_intervals_internal (tree
);
451 /* Split INTERVAL into two pieces, starting the second piece at
452 character position OFFSET (counting from 0), relative to INTERVAL.
453 INTERVAL becomes the left-hand piece, and the right-hand piece
454 (second, lexicographically) is returned.
456 The size and position fields of the two intervals are set based upon
457 those of the original interval. The property list of the new interval
458 is reset, thus it is up to the caller to do the right thing with the
461 Note that this does not change the position of INTERVAL; if it is a root,
462 it is still a root after this operation. */
465 split_interval_right (interval
, offset
)
469 INTERVAL
new = make_interval ();
470 int position
= interval
->position
;
471 int new_length
= LENGTH (interval
) - offset
;
473 new->position
= position
+ offset
;
474 new->parent
= interval
;
476 if (NULL_RIGHT_CHILD (interval
))
478 interval
->right
= new;
479 new->total_length
= new_length
;
484 /* Insert the new node between INTERVAL and its right child. */
485 new->right
= interval
->right
;
486 interval
->right
->parent
= new;
487 interval
->right
= new;
488 new->total_length
= new_length
+ new->right
->total_length
;
490 balance_an_interval (new);
491 balance_possible_root_interval (interval
);
496 /* Split INTERVAL into two pieces, starting the second piece at
497 character position OFFSET (counting from 0), relative to INTERVAL.
498 INTERVAL becomes the right-hand piece, and the left-hand piece
499 (first, lexicographically) is returned.
501 The size and position fields of the two intervals are set based upon
502 those of the original interval. The property list of the new interval
503 is reset, thus it is up to the caller to do the right thing with the
506 Note that this does not change the position of INTERVAL; if it is a root,
507 it is still a root after this operation. */
510 split_interval_left (interval
, offset
)
514 INTERVAL
new = make_interval ();
515 int position
= interval
->position
;
516 int new_length
= offset
;
518 new->position
= interval
->position
;
519 interval
->position
= interval
->position
+ offset
;
520 new->parent
= interval
;
522 if (NULL_LEFT_CHILD (interval
))
524 interval
->left
= new;
525 new->total_length
= new_length
;
530 /* Insert the new node between INTERVAL and its left child. */
531 new->left
= interval
->left
;
532 new->left
->parent
= new;
533 interval
->left
= new;
534 new->total_length
= new_length
+ new->left
->total_length
;
536 balance_an_interval (new);
537 balance_possible_root_interval (interval
);
542 /* Find the interval containing text position POSITION in the text
543 represented by the interval tree TREE. POSITION is a buffer
544 position; the earliest position is 1. If POSITION is at the end of
545 the buffer, return the interval containing the last character.
547 The `position' field, which is a cache of an interval's position,
548 is updated in the interval found. Other functions (e.g., next_interval)
549 will update this cache based on the result of find_interval. */
552 find_interval (tree
, position
)
553 register INTERVAL tree
;
554 register int position
;
556 /* The distance from the left edge of the subtree at TREE
558 register int relative_position
= position
- BEG
;
560 if (NULL_INTERVAL_P (tree
))
561 return NULL_INTERVAL
;
563 if (relative_position
> TOTAL_LENGTH (tree
))
564 abort (); /* Paranoia */
566 tree
= balance_possible_root_interval (tree
);
570 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
574 else if (! NULL_RIGHT_CHILD (tree
)
575 && relative_position
>= (TOTAL_LENGTH (tree
)
576 - RIGHT_TOTAL_LENGTH (tree
)))
578 relative_position
-= (TOTAL_LENGTH (tree
)
579 - RIGHT_TOTAL_LENGTH (tree
));
585 (position
- relative_position
/* the left edge of *tree */
586 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
593 /* Find the succeeding interval (lexicographically) to INTERVAL.
594 Sets the `position' field based on that of INTERVAL (see
598 next_interval (interval
)
599 register INTERVAL interval
;
601 register INTERVAL i
= interval
;
602 register int next_position
;
604 if (NULL_INTERVAL_P (i
))
605 return NULL_INTERVAL
;
606 next_position
= interval
->position
+ LENGTH (interval
);
608 if (! NULL_RIGHT_CHILD (i
))
611 while (! NULL_LEFT_CHILD (i
))
614 i
->position
= next_position
;
618 while (! NULL_PARENT (i
))
620 if (AM_LEFT_CHILD (i
))
623 i
->position
= next_position
;
630 return NULL_INTERVAL
;
633 /* Find the preceding interval (lexicographically) to INTERVAL.
634 Sets the `position' field based on that of INTERVAL (see
638 previous_interval (interval
)
639 register INTERVAL interval
;
642 register position_of_previous
;
644 if (NULL_INTERVAL_P (interval
))
645 return NULL_INTERVAL
;
647 if (! NULL_LEFT_CHILD (interval
))
650 while (! NULL_RIGHT_CHILD (i
))
653 i
->position
= interval
->position
- LENGTH (i
);
658 while (! NULL_PARENT (i
))
660 if (AM_RIGHT_CHILD (i
))
664 i
->position
= interval
->position
- LENGTH (i
);
670 return NULL_INTERVAL
;
674 /* Traverse a path down the interval tree TREE to the interval
675 containing POSITION, adjusting all nodes on the path for
676 an addition of LENGTH characters. Insertion between two intervals
677 (i.e., point == i->position, where i is second interval) means
678 text goes into second interval.
680 Modifications are needed to handle the hungry bits -- after simply
681 finding the interval at position (don't add length going down),
682 if it's the beginning of the interval, get the previous interval
683 and check the hugry bits of both. Then add the length going back up
687 adjust_intervals_for_insertion (tree
, position
, length
)
689 int position
, length
;
691 register int relative_position
;
692 register INTERVAL
this;
694 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
697 /* If inserting at point-max of a buffer, that position
698 will be out of range */
699 if (position
> TOTAL_LENGTH (tree
))
700 position
= TOTAL_LENGTH (tree
);
701 relative_position
= position
;
706 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
708 this->total_length
+= length
;
711 else if (relative_position
> (TOTAL_LENGTH (this)
712 - RIGHT_TOTAL_LENGTH (this)))
714 relative_position
-= (TOTAL_LENGTH (this)
715 - RIGHT_TOTAL_LENGTH (this));
716 this->total_length
+= length
;
721 /* If we are to use zero-length intervals as buffer pointers,
722 then this code will have to change. */
723 this->total_length
+= length
;
724 this->position
= LEFT_TOTAL_LENGTH (this)
725 + position
- relative_position
+ 1;
732 /* Effect an adjustment corresponding to the addition of LENGTH characters
733 of text. Do this by finding the interval containing POSITION in the
734 interval tree TREE, and then adjusting all of its ancestors by adding
737 If POSITION is the first character of an interval, meaning that point
738 is actually between the two intervals, make the new text belong to
739 the interval which is "sticky".
741 If both intervals are "sticky", then make them belong to the left-most
742 interval. Another possibility would be to create a new interval for
743 this text, and make it have the merged properties of both ends. */
746 adjust_intervals_for_insertion (tree
, position
, length
)
748 int position
, length
;
751 register INTERVAL temp
;
754 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
757 /* If inserting at point-max of a buffer, that position will be out
758 of range. Remember that buffer positions are 1-based. */
759 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
760 position
= BEG
+ TOTAL_LENGTH (tree
);
764 i
= find_interval (tree
, position
);
766 /* If in middle of an interval which is not sticky either way,
767 we must not just give its properties to the insertion.
768 So split this interval at the insertion point. */
769 if (! (position
== i
->position
|| eobp
)
770 && END_NONSTICKY_P (i
)
771 && ! FRONT_STICKY_P (i
))
773 temp
= split_interval_right (i
, position
- i
->position
);
774 copy_properties (i
, temp
);
778 /* If we are positioned between intervals, check the stickiness of
779 both of them. We have to do this too, if we are at BEG or Z. */
780 if (position
== i
->position
|| eobp
)
782 register INTERVAL prev
;
792 prev
= previous_interval (i
);
794 /* Even if we are positioned between intervals, we default
795 to the left one if it exists. We extend it now and split
796 off a part later, if stickyness demands it. */
797 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
799 temp
->total_length
+= length
;
800 temp
= balance_possible_root_interval (temp
);
803 /* If at least one interval has sticky properties,
804 we check the stickyness property by property. */
805 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
807 Lisp_Object pleft
, pright
;
808 struct interval newi
;
810 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
811 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
812 newi
.plist
= merge_properties_sticky (pleft
, pright
);
814 if(! prev
) /* i.e. position == BEG */
816 if (! intervals_equal (i
, &newi
))
818 i
= split_interval_left (i
, length
);
819 i
->plist
= newi
.plist
;
822 else if (! intervals_equal (prev
, &newi
))
824 prev
= split_interval_right (prev
,
825 position
- prev
->position
);
826 prev
->plist
= newi
.plist
;
827 if (! NULL_INTERVAL_P (i
)
828 && intervals_equal (prev
, i
))
829 merge_interval_right (prev
);
832 /* We will need to update the cache here later. */
834 else if (! prev
&& ! NILP (i
->plist
))
836 /* Just split off a new interval at the left.
837 Since I wasn't front-sticky, the empty plist is ok. */
838 i
= split_interval_left (i
, length
);
842 /* Otherwise just extend the interval. */
845 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
847 temp
->total_length
+= length
;
848 temp
= balance_possible_root_interval (temp
);
855 /* Any property might be front-sticky on the left, rear-sticky on the left,
856 front-sticky on the right, or rear-sticky on the right; the 16 combinations
857 can be arranged in a matrix with rows denoting the left conditions and
858 columns denoting the right conditions:
866 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
867 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
868 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
869 p8 L p9 L pa L pb L pc L pd L pe L pf L)
870 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
871 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
872 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
873 p8 R p9 R pa R pb R pc R pd R pe R pf R)
875 We inherit from whoever has a sticky side facing us. If both sides
876 do (cases 2, 3, E, and F), then we inherit from whichever side has a
877 non-nil value for the current property. If both sides do, then we take
880 When we inherit a property, we get its stickiness as well as its value.
881 So, when we merge the above two lists, we expect to get this:
883 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
884 rear-nonsticky (p6 pa)
885 p0 L p1 L p2 L p3 L p6 R p7 R
886 pa R pb R pc L pd L pe L pf L)
888 The optimizable special cases are:
889 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
890 left rear-nonsticky = t, right front-sticky = t (inherit right)
891 left rear-nonsticky = t, right front-sticky = nil (inherit none)
895 merge_properties_sticky (pleft
, pright
)
896 Lisp_Object pleft
, pright
;
898 register Lisp_Object props
, front
, rear
;
899 Lisp_Object lfront
, lrear
, rfront
, rrear
;
900 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
;
901 int use_left
, use_right
;
906 lfront
= textget (pleft
, Qfront_sticky
);
907 lrear
= textget (pleft
, Qrear_nonsticky
);
908 rfront
= textget (pright
, Qfront_sticky
);
909 rrear
= textget (pright
, Qrear_nonsticky
);
911 /* Go through each element of PRIGHT. */
912 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
916 /* Sticky properties get special treatment. */
917 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
920 rval
= Fcar (Fcdr (tail1
));
921 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
922 if (EQ (sym
, Fcar (tail2
)))
924 lval
= (NILP (tail2
) ? Qnil
: Fcar( Fcdr (tail2
)));
926 use_left
= ! TMEM (sym
, lrear
);
927 use_right
= TMEM (sym
, rfront
);
928 if (use_left
&& use_right
)
930 use_left
= ! NILP (lval
);
931 use_right
= ! NILP (rval
);
935 /* We build props as (value sym ...) rather than (sym value ...)
936 because we plan to nreverse it when we're done. */
938 props
= Fcons (lval
, Fcons (sym
, props
));
939 if (TMEM (sym
, lfront
))
940 front
= Fcons (sym
, front
);
941 if (TMEM (sym
, lrear
))
942 rear
= Fcons (sym
, rear
);
947 props
= Fcons (rval
, Fcons (sym
, props
));
948 if (TMEM (sym
, rfront
))
949 front
= Fcons (sym
, front
);
950 if (TMEM (sym
, rrear
))
951 rear
= Fcons (sym
, rear
);
955 /* Now go through each element of PLEFT. */
956 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
960 /* Sticky properties get special treatment. */
961 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
964 /* If sym is in PRIGHT, we've already considered it. */
965 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
966 if (EQ (sym
, Fcar (tail1
)))
971 lval
= Fcar (Fcdr (tail2
));
973 /* Since rval is known to be nil in this loop, the test simplifies. */
974 if (! TMEM (sym
, lrear
))
977 props
= Fcons (lval
, Fcons (sym
, props
));
978 if (TMEM (sym
, lfront
))
979 front
= Fcons (sym
, front
);
981 else if (TMEM (sym
, rfront
))
983 /* The value is nil, but we still inherit the stickiness
985 front
= Fcons (sym
, front
);
986 if (TMEM (sym
, rrear
))
987 rear
= Fcons (sym
, rear
);
990 props
= Fnreverse (props
);
992 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
994 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
999 /* Delete an node I from its interval tree by merging its subtrees
1000 into one subtree which is then returned. Caller is responsible for
1001 storing the resulting subtree into its parent. */
1005 register INTERVAL i
;
1007 register INTERVAL migrate
, this;
1008 register int migrate_amt
;
1010 if (NULL_INTERVAL_P (i
->left
))
1012 if (NULL_INTERVAL_P (i
->right
))
1016 migrate_amt
= i
->left
->total_length
;
1018 this->total_length
+= migrate_amt
;
1019 while (! NULL_INTERVAL_P (this->left
))
1022 this->total_length
+= migrate_amt
;
1024 this->left
= migrate
;
1025 migrate
->parent
= this;
1030 /* Delete interval I from its tree by calling `delete_node'
1031 and properly connecting the resultant subtree.
1033 I is presumed to be empty; that is, no adjustments are made
1034 for the length of I. */
1038 register INTERVAL i
;
1040 register INTERVAL parent
;
1041 int amt
= LENGTH (i
);
1043 if (amt
> 0) /* Only used on zero-length intervals now. */
1046 if (ROOT_INTERVAL_P (i
))
1049 owner
= (Lisp_Object
) i
->parent
;
1050 parent
= delete_node (i
);
1051 if (! NULL_INTERVAL_P (parent
))
1052 parent
->parent
= (INTERVAL
) owner
;
1054 if (BUFFERP (owner
))
1055 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1056 else if (STRINGP (owner
))
1057 XSTRING (owner
)->intervals
= parent
;
1065 if (AM_LEFT_CHILD (i
))
1067 parent
->left
= delete_node (i
);
1068 if (! NULL_INTERVAL_P (parent
->left
))
1069 parent
->left
->parent
= parent
;
1073 parent
->right
= delete_node (i
);
1074 if (! NULL_INTERVAL_P (parent
->right
))
1075 parent
->right
->parent
= parent
;
1079 /* Find the interval in TREE corresponding to the relative position
1080 FROM and delete as much as possible of AMOUNT from that interval.
1081 Return the amount actually deleted, and if the interval was
1082 zeroed-out, delete that interval node from the tree.
1084 Note that FROM is actually origin zero, aka relative to the
1085 leftmost edge of tree. This is appropriate since we call ourselves
1086 recursively on subtrees.
1088 Do this by recursing down TREE to the interval in question, and
1089 deleting the appropriate amount of text. */
1092 interval_deletion_adjustment (tree
, from
, amount
)
1093 register INTERVAL tree
;
1094 register int from
, amount
;
1096 register int relative_position
= from
;
1098 if (NULL_INTERVAL_P (tree
))
1102 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1104 int subtract
= interval_deletion_adjustment (tree
->left
,
1107 tree
->total_length
-= subtract
;
1111 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1112 - RIGHT_TOTAL_LENGTH (tree
)))
1116 relative_position
-= (tree
->total_length
1117 - RIGHT_TOTAL_LENGTH (tree
));
1118 subtract
= interval_deletion_adjustment (tree
->right
,
1121 tree
->total_length
-= subtract
;
1124 /* Here -- this node. */
1127 /* How much can we delete from this interval? */
1128 int my_amount
= ((tree
->total_length
1129 - RIGHT_TOTAL_LENGTH (tree
))
1130 - relative_position
);
1132 if (amount
> my_amount
)
1135 tree
->total_length
-= amount
;
1136 if (LENGTH (tree
) == 0)
1137 delete_interval (tree
);
1142 /* Never reach here. */
1145 /* Effect the adjustments necessary to the interval tree of BUFFER to
1146 correspond to the deletion of LENGTH characters from that buffer
1147 text. The deletion is effected at position START (which is a
1148 buffer position, i.e. origin 1). */
1151 adjust_intervals_for_deletion (buffer
, start
, length
)
1152 struct buffer
*buffer
;
1155 register int left_to_delete
= length
;
1156 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1157 register int deleted
;
1159 if (NULL_INTERVAL_P (tree
))
1162 if (start
> BEG
+ TOTAL_LENGTH (tree
)
1163 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
1166 if (length
== TOTAL_LENGTH (tree
))
1168 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1172 if (ONLY_INTERVAL_P (tree
))
1174 tree
->total_length
-= length
;
1178 if (start
> BEG
+ TOTAL_LENGTH (tree
))
1179 start
= BEG
+ TOTAL_LENGTH (tree
);
1180 while (left_to_delete
> 0)
1182 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
1184 tree
= BUF_INTERVALS (buffer
);
1185 if (left_to_delete
== tree
->total_length
)
1187 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1193 /* Make the adjustments necessary to the interval tree of BUFFER to
1194 represent an addition or deletion of LENGTH characters starting
1195 at position START. Addition or deletion is indicated by the sign
1199 offset_intervals (buffer
, start
, length
)
1200 struct buffer
*buffer
;
1203 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1207 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1209 adjust_intervals_for_deletion (buffer
, start
, -length
);
1212 /* Merge interval I with its lexicographic successor. The resulting
1213 interval is returned, and has the properties of the original
1214 successor. The properties of I are lost. I is removed from the
1218 The caller must verify that this is not the last (rightmost)
1222 merge_interval_right (i
)
1223 register INTERVAL i
;
1225 register int absorb
= LENGTH (i
);
1226 register INTERVAL successor
;
1228 /* Zero out this interval. */
1229 i
->total_length
-= absorb
;
1231 /* Find the succeeding interval. */
1232 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1235 successor
= i
->right
;
1236 while (! NULL_LEFT_CHILD (successor
))
1238 successor
->total_length
+= absorb
;
1239 successor
= successor
->left
;
1242 successor
->total_length
+= absorb
;
1243 delete_interval (i
);
1248 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1251 if (AM_LEFT_CHILD (successor
))
1253 successor
= successor
->parent
;
1254 delete_interval (i
);
1258 successor
= successor
->parent
;
1259 successor
->total_length
-= absorb
;
1262 /* This must be the rightmost or last interval and cannot
1263 be merged right. The caller should have known. */
1267 /* Merge interval I with its lexicographic predecessor. The resulting
1268 interval is returned, and has the properties of the original predecessor.
1269 The properties of I are lost. Interval node I is removed from the tree.
1272 The caller must verify that this is not the first (leftmost) interval. */
1275 merge_interval_left (i
)
1276 register INTERVAL i
;
1278 register int absorb
= LENGTH (i
);
1279 register INTERVAL predecessor
;
1281 /* Zero out this interval. */
1282 i
->total_length
-= absorb
;
1284 /* Find the preceding interval. */
1285 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1286 adding ABSORB as we go. */
1288 predecessor
= i
->left
;
1289 while (! NULL_RIGHT_CHILD (predecessor
))
1291 predecessor
->total_length
+= absorb
;
1292 predecessor
= predecessor
->right
;
1295 predecessor
->total_length
+= absorb
;
1296 delete_interval (i
);
1301 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1302 subtracting ABSORB. */
1304 if (AM_RIGHT_CHILD (predecessor
))
1306 predecessor
= predecessor
->parent
;
1307 delete_interval (i
);
1311 predecessor
= predecessor
->parent
;
1312 predecessor
->total_length
-= absorb
;
1315 /* This must be the leftmost or first interval and cannot
1316 be merged left. The caller should have known. */
1320 /* Make an exact copy of interval tree SOURCE which descends from
1321 PARENT. This is done by recursing through SOURCE, copying
1322 the current interval and its properties, and then adjusting
1323 the pointers of the copy. */
1326 reproduce_tree (source
, parent
)
1327 INTERVAL source
, parent
;
1329 register INTERVAL t
= make_interval ();
1331 bcopy (source
, t
, INTERVAL_SIZE
);
1332 copy_properties (source
, t
);
1334 if (! NULL_LEFT_CHILD (source
))
1335 t
->left
= reproduce_tree (source
->left
, t
);
1336 if (! NULL_RIGHT_CHILD (source
))
1337 t
->right
= reproduce_tree (source
->right
, t
);
1343 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1345 /* Make a new interval of length LENGTH starting at START in the
1346 group of intervals INTERVALS, which is actually an interval tree.
1347 Returns the new interval.
1349 Generate an error if the new positions would overlap an existing
1353 make_new_interval (intervals
, start
, length
)
1359 slot
= find_interval (intervals
, start
);
1360 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1361 error ("Interval would overlap");
1363 if (start
== slot
->position
&& length
== LENGTH (slot
))
1366 if (slot
->position
== start
)
1368 /* New right node. */
1369 split_interval_right (slot
, length
);
1373 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1375 /* New left node. */
1376 split_interval_left (slot
, LENGTH (slot
) - length
);
1380 /* Convert interval SLOT into three intervals. */
1381 split_interval_left (slot
, start
- slot
->position
);
1382 split_interval_right (slot
, length
);
1387 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1388 LENGTH is the length of the text in SOURCE.
1390 This is used in insdel.c when inserting Lisp_Strings into the
1391 buffer. The text corresponding to SOURCE is already in the buffer
1392 when this is called. The intervals of new tree are a copy of those
1393 belonging to the string being inserted; intervals are never
1396 If the inserted text had no intervals associated, and we don't
1397 want to inherit the surrounding text's properties, this function
1398 simply returns -- offset_intervals should handle placing the
1399 text in the correct interval, depending on the sticky bits.
1401 If the inserted text had properties (intervals), then there are two
1402 cases -- either insertion happened in the middle of some interval,
1403 or between two intervals.
1405 If the text goes into the middle of an interval, then new
1406 intervals are created in the middle with only the properties of
1407 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1408 which case the new text has the union of its properties and those
1409 of the text into which it was inserted.
1411 If the text goes between two intervals, then if neither interval
1412 had its appropriate sticky property set (front_sticky, rear_sticky),
1413 the new text has only its properties. If one of the sticky properties
1414 is set, then the new text "sticks" to that region and its properties
1415 depend on merging as above. If both the preceding and succeeding
1416 intervals to the new text are "sticky", then the new text retains
1417 only its properties, as if neither sticky property were set. Perhaps
1418 we should consider merging all three sets of properties onto the new
1422 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1424 int position
, length
;
1425 struct buffer
*buffer
;
1428 register INTERVAL under
, over
, this, prev
;
1429 register INTERVAL tree
;
1432 tree
= BUF_INTERVALS (buffer
);
1434 /* If the new text has no properties, it becomes part of whatever
1435 interval it was inserted into. */
1436 if (NULL_INTERVAL_P (source
))
1439 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1441 XSETBUFFER (buf
, buffer
);
1442 Fset_text_properties (make_number (position
),
1443 make_number (position
+ length
),
1446 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1447 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1451 if (NULL_INTERVAL_P (tree
))
1453 /* The inserted text constitutes the whole buffer, so
1454 simply copy over the interval structure. */
1455 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1458 XSETBUFFER (buf
, buffer
);
1459 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1460 /* Explicitly free the old tree here. */
1465 /* Create an interval tree in which to place a copy
1466 of the intervals of the inserted string. */
1469 XSETBUFFER (buf
, buffer
);
1470 tree
= create_root_interval (buf
);
1473 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1474 /* If the buffer contains only the new string, but
1475 there was already some interval tree there, then it may be
1476 some zero length intervals. Eventually, do something clever
1477 about inserting properly. For now, just waste the old intervals. */
1479 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1480 /* Explicitly free the old tree here. */
1484 /* Paranoia -- the text has already been added, so this buffer
1485 should be of non-zero length. */
1486 else if (TOTAL_LENGTH (tree
) == 0)
1489 this = under
= find_interval (tree
, position
);
1490 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1492 over
= find_interval (source
, 1);
1494 /* Here for insertion in the middle of an interval.
1495 Split off an equivalent interval to the right,
1496 then don't bother with it any more. */
1498 if (position
> under
->position
)
1500 INTERVAL end_unchanged
1501 = split_interval_left (this, position
- under
->position
);
1502 copy_properties (under
, end_unchanged
);
1503 under
->position
= position
;
1509 prev
= previous_interval (under
);
1510 if (prev
&& !END_NONSTICKY_P (prev
))
1514 /* Insertion is now at beginning of UNDER. */
1516 /* The inserted text "sticks" to the interval `under',
1517 which means it gets those properties.
1518 The properties of under are the result of
1519 adjust_intervals_for_insertion, so stickyness has
1520 already been taken care of. */
1522 while (! NULL_INTERVAL_P (over
))
1524 if (LENGTH (over
) < LENGTH (under
))
1526 this = split_interval_left (under
, LENGTH (over
));
1527 copy_properties (under
, this);
1531 copy_properties (over
, this);
1533 merge_properties (over
, this);
1535 copy_properties (over
, this);
1536 over
= next_interval (over
);
1539 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1540 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1544 /* Get the value of property PROP from PLIST,
1545 which is the plist of an interval.
1546 We check for direct properties, for categories with property PROP,
1547 and for PROP appearing on the default-properties list. */
1550 textget (plist
, prop
)
1552 register Lisp_Object prop
;
1554 register Lisp_Object tail
, fallback
;
1557 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1559 register Lisp_Object tem
;
1562 return Fcar (Fcdr (tail
));
1563 if (EQ (tem
, Qcategory
))
1565 tem
= Fcar (Fcdr (tail
));
1567 fallback
= Fget (tem
, prop
);
1571 if (! NILP (fallback
))
1573 if (CONSP (Vdefault_properties
))
1574 return textget_direct (Vdefault_properties
, prop
);
1578 /* Get the value of property PROP from PLIST,
1579 which is the plist of an interval.
1580 We check for direct properties only! */
1583 textget_direct (plist
, prop
)
1585 register Lisp_Object prop
;
1587 register Lisp_Object tail
;
1589 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1591 if (EQ (prop
, Fcar (tail
)))
1592 return Fcar (Fcdr (tail
));
1598 /* Set point in BUFFER to POSITION. If the target position is
1599 before an intangible character, move to an ok place. */
1602 set_point (position
, buffer
)
1603 register int position
;
1604 register struct buffer
*buffer
;
1606 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1608 register Lisp_Object obj
;
1609 int backwards
= (position
< BUF_PT (buffer
)) ? 1 : 0;
1610 int old_position
= BUF_PT (buffer
);
1612 buffer
->point_before_scroll
= Qnil
;
1614 if (position
== BUF_PT (buffer
))
1617 /* Check this now, before checking if the buffer has any intervals.
1618 That way, we can catch conditions which break this sanity check
1619 whether or not there are intervals in the buffer. */
1620 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1623 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1626 BUF_PT (buffer
) = position
;
1630 /* Set TO to the interval containing the char after POSITION,
1631 and TOPREV to the interval containing the char before POSITION.
1632 Either one may be null. They may be equal. */
1633 to
= find_interval (BUF_INTERVALS (buffer
), position
);
1634 if (position
== BUF_BEGV (buffer
))
1636 else if (to
->position
== position
)
1637 toprev
= previous_interval (to
);
1641 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1642 ? BUF_ZV (buffer
) - 1
1645 /* Set FROM to the interval containing the char after PT,
1646 and FROMPREV to the interval containing the char before PT.
1647 Either one may be null. They may be equal. */
1648 /* We could cache this and save time. */
1649 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1650 if (buffer_point
== BUF_BEGV (buffer
))
1652 else if (from
->position
== BUF_PT (buffer
))
1653 fromprev
= previous_interval (from
);
1654 else if (buffer_point
!= BUF_PT (buffer
))
1655 fromprev
= from
, from
= 0;
1659 /* Moving within an interval. */
1660 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
))
1662 BUF_PT (buffer
) = position
;
1666 /* If the new position is between two intangible characters,
1667 move forward or backward across all such characters. */
1668 if (NILP (Vinhibit_point_motion_hooks
) && ! NULL_INTERVAL_P (to
)
1669 && ! NULL_INTERVAL_P (toprev
))
1673 /* Make sure the following character is intangible
1674 if the previous one is. */
1676 || ! NILP (textget (to
->plist
, Qintangible
)))
1677 /* Ok, that is so. Back up across intangible text. */
1678 while (! NULL_INTERVAL_P (toprev
)
1679 && ! NILP (textget (toprev
->plist
, Qintangible
)))
1682 toprev
= previous_interval (toprev
);
1683 if (NULL_INTERVAL_P (toprev
))
1684 position
= BUF_BEGV (buffer
);
1686 /* This is the only line that's not
1687 dual to the following loop.
1688 That's because we want the position
1689 at the end of TOPREV. */
1690 position
= to
->position
;
1695 /* Make sure the previous character is intangible
1696 if the following one is. */
1698 || ! NILP (textget (toprev
->plist
, Qintangible
)))
1699 /* Ok, that is so. Advance across intangible text. */
1700 while (! NULL_INTERVAL_P (to
)
1701 && ! NILP (textget (to
->plist
, Qintangible
)))
1704 to
= next_interval (to
);
1705 if (NULL_INTERVAL_P (to
))
1706 position
= BUF_ZV (buffer
);
1708 position
= to
->position
;
1711 /* Here TO is the interval after the stopping point
1712 and TOPREV is the interval before the stopping point.
1713 One or the other may be null. */
1716 BUF_PT (buffer
) = position
;
1718 /* We run point-left and point-entered hooks here, iff the
1719 two intervals are not equivalent. These hooks take
1720 (old_point, new_point) as arguments. */
1721 if (NILP (Vinhibit_point_motion_hooks
)
1722 && (! intervals_equal (from
, to
)
1723 || ! intervals_equal (fromprev
, toprev
)))
1725 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1728 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1732 leave_before
= textget (from
->plist
, Qpoint_left
);
1734 leave_before
= Qnil
;
1737 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1741 enter_before
= textget (to
->plist
, Qpoint_entered
);
1743 enter_before
= Qnil
;
1745 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1746 call2 (leave_before
, old_position
, position
);
1747 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1748 call2 (leave_after
, old_position
, position
);
1750 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1751 call2 (enter_before
, old_position
, position
);
1752 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1753 call2 (enter_after
, old_position
, position
);
1757 /* Set point temporarily, without checking any text properties. */
1760 temp_set_point (position
, buffer
)
1762 struct buffer
*buffer
;
1764 BUF_PT (buffer
) = position
;
1767 /* Return the proper local map for position POSITION in BUFFER.
1768 Use the map specified by the local-map property, if any.
1769 Otherwise, use BUFFER's local map. */
1772 get_local_map (position
, buffer
)
1773 register int position
;
1774 register struct buffer
*buffer
;
1776 register INTERVAL interval
;
1777 Lisp_Object prop
, tem
;
1779 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1780 return buffer
->keymap
;
1782 /* Perhaps we should just change `position' to the limit. */
1783 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1786 interval
= find_interval (BUF_INTERVALS (buffer
), position
);
1787 prop
= textget (interval
->plist
, Qlocal_map
);
1789 return buffer
->keymap
;
1791 /* Use the local map only if it is valid. */
1792 tem
= Fkeymapp (prop
);
1796 return buffer
->keymap
;
1799 /* Call the modification hook functions in LIST, each with START and END. */
1802 call_mod_hooks (list
, start
, end
)
1803 Lisp_Object list
, start
, end
;
1805 struct gcpro gcpro1
;
1807 while (!NILP (list
))
1809 call2 (Fcar (list
), start
, end
);
1815 /* Check for read-only intervals and signal an error if we find one.
1816 Then check for any modification hooks in the range START up to
1817 (but not including) END. Create a list of all these hooks in
1818 lexicographic order, eliminating consecutive extra copies of the
1819 same hook. Then call those hooks in order, with START and END - 1
1823 verify_interval_modification (buf
, start
, end
)
1827 register INTERVAL intervals
= BUF_INTERVALS (buf
);
1828 register INTERVAL i
, prev
;
1830 register Lisp_Object prev_mod_hooks
;
1831 Lisp_Object mod_hooks
;
1832 struct gcpro gcpro1
;
1835 prev_mod_hooks
= Qnil
;
1838 if (NULL_INTERVAL_P (intervals
))
1848 /* For an insert operation, check the two chars around the position. */
1852 Lisp_Object before
, after
;
1854 /* Set I to the interval containing the char after START,
1855 and PREV to the interval containing the char before START.
1856 Either one may be null. They may be equal. */
1857 i
= find_interval (intervals
, start
);
1859 if (start
== BUF_BEGV (buf
))
1861 else if (i
->position
== start
)
1862 prev
= previous_interval (i
);
1863 else if (i
->position
< start
)
1865 if (start
== BUF_ZV (buf
))
1868 /* If Vinhibit_read_only is set and is not a list, we can
1869 skip the read_only checks. */
1870 if (NILP (Vinhibit_read_only
) || CONSP (Vinhibit_read_only
))
1872 /* If I and PREV differ we need to check for the read-only
1873 property together with its stickyness. If either I or
1874 PREV are 0, this check is all we need.
1875 We have to take special care, since read-only may be
1876 indirectly defined via the category property. */
1879 if (! NULL_INTERVAL_P (i
))
1881 after
= textget (i
->plist
, Qread_only
);
1883 /* If interval I is read-only and read-only is
1884 front-sticky, inhibit insertion.
1885 Check for read-only as well as category. */
1887 && NILP (Fmemq (after
, Vinhibit_read_only
)))
1891 tem
= textget (i
->plist
, Qfront_sticky
);
1892 if (TMEM (Qread_only
, tem
)
1893 || (NILP (textget_direct (i
->plist
, Qread_only
))
1894 && TMEM (Qcategory
, tem
)))
1895 error ("Attempt to insert within read-only text");
1899 if (! NULL_INTERVAL_P (prev
))
1901 before
= textget (prev
->plist
, Qread_only
);
1903 /* If interval PREV is read-only and read-only isn't
1904 rear-nonsticky, inhibit insertion.
1905 Check for read-only as well as category. */
1907 && NILP (Fmemq (before
, Vinhibit_read_only
)))
1911 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1912 if (! TMEM (Qread_only
, tem
)
1913 && (! NILP (textget_direct (prev
->plist
,Qread_only
))
1914 || ! TMEM (Qcategory
, tem
)))
1915 error ("Attempt to insert within read-only text");
1919 else if (! NULL_INTERVAL_P (i
))
1921 after
= textget (i
->plist
, Qread_only
);
1923 /* If interval I is read-only and read-only is
1924 front-sticky, inhibit insertion.
1925 Check for read-only as well as category. */
1926 if (! NILP (after
) && NILP (Fmemq (after
, Vinhibit_read_only
)))
1930 tem
= textget (i
->plist
, Qfront_sticky
);
1931 if (TMEM (Qread_only
, tem
)
1932 || (NILP (textget_direct (i
->plist
, Qread_only
))
1933 && TMEM (Qcategory
, tem
)))
1934 error ("Attempt to insert within read-only text");
1936 tem
= textget (prev
->plist
, Qrear_nonsticky
);
1937 if (! TMEM (Qread_only
, tem
)
1938 && (! NILP (textget_direct (prev
->plist
, Qread_only
))
1939 || ! TMEM (Qcategory
, tem
)))
1940 error ("Attempt to insert within read-only text");
1945 /* Run both insert hooks (just once if they're the same). */
1946 if (!NULL_INTERVAL_P (prev
))
1947 prev_mod_hooks
= textget (prev
->plist
, Qinsert_behind_hooks
);
1948 if (!NULL_INTERVAL_P (i
))
1949 mod_hooks
= textget (i
->plist
, Qinsert_in_front_hooks
);
1951 if (! NILP (prev_mod_hooks
))
1952 call_mod_hooks (prev_mod_hooks
, make_number (start
),
1955 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1956 call_mod_hooks (mod_hooks
, make_number (start
), make_number (end
));
1960 /* Loop over intervals on or next to START...END,
1961 collecting their hooks. */
1963 i
= find_interval (intervals
, start
);
1966 if (! INTERVAL_WRITABLE_P (i
))
1967 error ("Attempt to modify read-only text");
1969 mod_hooks
= textget (i
->plist
, Qmodification_hooks
);
1970 if (! NILP (mod_hooks
) && ! EQ (mod_hooks
, prev_mod_hooks
))
1972 hooks
= Fcons (mod_hooks
, hooks
);
1973 prev_mod_hooks
= mod_hooks
;
1976 i
= next_interval (i
);
1978 /* Keep going thru the interval containing the char before END. */
1979 while (! NULL_INTERVAL_P (i
) && i
->position
< end
);
1982 hooks
= Fnreverse (hooks
);
1983 while (! EQ (hooks
, Qnil
))
1985 call_mod_hooks (Fcar (hooks
), make_number (start
),
1987 hooks
= Fcdr (hooks
);
1993 /* Produce an interval tree reflecting the intervals in
1994 TREE from START to START + LENGTH. */
1997 copy_intervals (tree
, start
, length
)
2001 register INTERVAL i
, new, t
;
2002 register int got
, prevlen
;
2004 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2005 return NULL_INTERVAL
;
2007 i
= find_interval (tree
, start
);
2008 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2011 /* If there is only one interval and it's the default, return nil. */
2012 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2013 && DEFAULT_INTERVAL_P (i
))
2014 return NULL_INTERVAL
;
2016 new = make_interval ();
2018 got
= (LENGTH (i
) - (start
- i
->position
));
2019 new->total_length
= length
;
2020 copy_properties (i
, new);
2024 while (got
< length
)
2026 i
= next_interval (i
);
2027 t
= split_interval_right (t
, prevlen
);
2028 copy_properties (i
, t
);
2029 prevlen
= LENGTH (i
);
2033 return balance_an_interval (new);
2036 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2039 copy_intervals_to_string (string
, buffer
, position
, length
)
2040 Lisp_Object string
, buffer
;
2041 int position
, length
;
2043 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (XBUFFER (buffer
)),
2045 if (NULL_INTERVAL_P (interval_copy
))
2048 interval_copy
->parent
= (INTERVAL
) string
;
2049 XSTRING (string
)->intervals
= interval_copy
;
2052 /* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
2053 Assume they have identical characters. */
2056 compare_string_intervals (s1
, s2
)
2061 int end
= XSTRING (s1
)->size
+ 1;
2063 /* We specify 1 as position because the interval functions
2064 always use positions starting at 1. */
2065 i1
= find_interval (XSTRING (s1
)->intervals
, 1);
2066 i2
= find_interval (XSTRING (s2
)->intervals
, 1);
2070 /* Determine how far we can go before we reach the end of I1 or I2. */
2071 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2072 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2073 int distance
= min (len1
, len2
);
2075 /* If we ever find a mismatch between the strings,
2077 if (! intervals_equal (i1
, i2
))
2080 /* Advance POS till the end of the shorter interval,
2081 and advance one or both interval pointers for the new position. */
2083 if (len1
== distance
)
2084 i1
= next_interval (i1
);
2085 if (len2
== distance
)
2086 i2
= next_interval (i2
);
2091 #endif /* USE_TEXT_PROPERTIES */