1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
27 An idea: Have the owner of the tree keep count of splits and/or
28 insertion lengths (in intervals), and balance after every N.
30 Need to call *_left_hook when buffer is killed.
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
35 There are comments around about freeing intervals. It might be
36 faster to explicitly free them (put them on the free list) than
44 #include "intervals.h"
49 /* The rest of the file is within this conditional. */
50 #ifdef USE_TEXT_PROPERTIES
52 /* Test for membership, allowing for t (actually any non-cons) to mean the
55 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
57 #define min(x, y) ((x) < (y) ? (x) : (y))
59 Lisp_Object
merge_properties_sticky ();
61 /* Utility functions for intervals. */
64 /* Create the root interval of some object, a buffer or string. */
67 create_root_interval (parent
)
72 CHECK_IMPURE (parent
);
74 new = make_interval ();
78 new->total_length
= (BUF_Z (XBUFFER (parent
))
79 - BUF_BEG (XBUFFER (parent
)));
80 BUF_INTERVALS (XBUFFER (parent
)) = new;
82 else if (STRINGP (parent
))
84 new->total_length
= XSTRING (parent
)->size
;
85 XSTRING (parent
)->intervals
= new;
88 new->parent
= (INTERVAL
) parent
;
94 /* Make the interval TARGET have exactly the properties of SOURCE */
97 copy_properties (source
, target
)
98 register INTERVAL source
, target
;
100 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
103 COPY_INTERVAL_CACHE (source
, target
);
104 target
->plist
= Fcopy_sequence (source
->plist
);
107 /* Merge the properties of interval SOURCE into the properties
108 of interval TARGET. That is to say, each property in SOURCE
109 is added to TARGET if TARGET has no such property as yet. */
112 merge_properties (source
, target
)
113 register INTERVAL source
, target
;
115 register Lisp_Object o
, sym
, val
;
117 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
120 MERGE_INTERVAL_CACHE (source
, target
);
123 while (! EQ (o
, Qnil
))
126 val
= Fmemq (sym
, target
->plist
);
132 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
140 /* Return 1 if the two intervals have the same properties,
144 intervals_equal (i0
, i1
)
147 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
150 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
153 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
156 i1_len
= XFASTINT (Flength (i1
->plist
));
157 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
161 while (!NILP (i0_cdr
))
163 /* Lengths of the two plists were unequal. */
167 i0_sym
= Fcar (i0_cdr
);
168 i1_val
= Fmemq (i0_sym
, i1
->plist
);
170 /* i0 has something i1 doesn't. */
171 if (EQ (i1_val
, Qnil
))
174 /* i0 and i1 both have sym, but it has different values in each. */
175 i0_cdr
= Fcdr (i0_cdr
);
176 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
179 i0_cdr
= Fcdr (i0_cdr
);
183 /* Lengths of the two plists were unequal. */
192 static int zero_length
;
194 /* Traverse an interval tree TREE, performing FUNCTION on each node.
195 Pass FUNCTION two args: an interval, and ARG. */
198 traverse_intervals (tree
, position
, depth
, function
, arg
)
201 void (* function
) ();
204 if (NULL_INTERVAL_P (tree
))
207 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
208 position
+= LEFT_TOTAL_LENGTH (tree
);
209 tree
->position
= position
;
210 (*function
) (tree
, arg
);
211 position
+= LENGTH (tree
);
212 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
216 /* These functions are temporary, for debugging purposes only. */
218 INTERVAL search_interval
, found_interval
;
221 check_for_interval (i
)
224 if (i
== search_interval
)
232 search_for_interval (i
, tree
)
233 register INTERVAL i
, tree
;
237 found_interval
= NULL_INTERVAL
;
238 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
239 return found_interval
;
243 inc_interval_count (i
)
260 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
266 root_interval (interval
)
269 register INTERVAL i
= interval
;
271 while (! ROOT_INTERVAL_P (i
))
278 /* Assuming that a left child exists, perform the following operation:
288 rotate_right (interval
)
292 INTERVAL B
= interval
->left
;
293 int old_total
= interval
->total_length
;
295 /* Deal with any Parent of A; make it point to B. */
296 if (! ROOT_INTERVAL_P (interval
))
297 if (AM_LEFT_CHILD (interval
))
298 interval
->parent
->left
= B
;
300 interval
->parent
->right
= B
;
301 B
->parent
= interval
->parent
;
303 /* Make B the parent of A */
306 interval
->parent
= B
;
308 /* Make A point to c */
310 if (! NULL_INTERVAL_P (i
))
311 i
->parent
= interval
;
313 /* A's total length is decreased by the length of B and its left child. */
314 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
316 /* B must have the same total length of A. */
317 B
->total_length
= old_total
;
322 /* Assuming that a right child exists, perform the following operation:
332 rotate_left (interval
)
336 INTERVAL B
= interval
->right
;
337 int old_total
= interval
->total_length
;
339 /* Deal with any parent of A; make it point to B. */
340 if (! ROOT_INTERVAL_P (interval
))
341 if (AM_LEFT_CHILD (interval
))
342 interval
->parent
->left
= B
;
344 interval
->parent
->right
= B
;
345 B
->parent
= interval
->parent
;
347 /* Make B the parent of A */
350 interval
->parent
= B
;
352 /* Make A point to c */
354 if (! NULL_INTERVAL_P (i
))
355 i
->parent
= interval
;
357 /* A's total length is decreased by the length of B and its right child. */
358 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
360 /* B must have the same total length of A. */
361 B
->total_length
= old_total
;
366 /* Balance an interval tree with the assumption that the subtrees
367 themselves are already balanced. */
370 balance_an_interval (i
)
373 register int old_diff
, new_diff
;
377 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
380 new_diff
= i
->total_length
- i
->left
->total_length
381 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
382 if (abs (new_diff
) >= old_diff
)
384 i
= rotate_right (i
);
385 balance_an_interval (i
->right
);
387 else if (old_diff
< 0)
389 new_diff
= i
->total_length
- i
->right
->total_length
390 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
391 if (abs (new_diff
) >= -old_diff
)
394 balance_an_interval (i
->left
);
402 /* Balance INTERVAL, potentially stuffing it back into its parent
405 static INLINE INTERVAL
406 balance_possible_root_interval (interval
)
407 register INTERVAL interval
;
411 if (interval
->parent
== NULL_INTERVAL
)
414 parent
= (Lisp_Object
) (interval
->parent
);
415 interval
= balance_an_interval (interval
);
417 if (BUFFERP (parent
))
418 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
419 else if (STRINGP (parent
))
420 XSTRING (parent
)->intervals
= interval
;
425 /* Balance the interval tree TREE. Balancing is by weight
426 (the amount of text). */
429 balance_intervals_internal (tree
)
430 register INTERVAL tree
;
432 /* Balance within each side. */
434 balance_intervals_internal (tree
->left
);
436 balance_intervals_internal (tree
->right
);
437 return balance_an_interval (tree
);
440 /* Advertised interface to balance intervals. */
443 balance_intervals (tree
)
446 if (tree
== NULL_INTERVAL
)
447 return NULL_INTERVAL
;
449 return balance_intervals_internal (tree
);
452 /* Split INTERVAL into two pieces, starting the second piece at
453 character position OFFSET (counting from 0), relative to INTERVAL.
454 INTERVAL becomes the left-hand piece, and the right-hand piece
455 (second, lexicographically) is returned.
457 The size and position fields of the two intervals are set based upon
458 those of the original interval. The property list of the new interval
459 is reset, thus it is up to the caller to do the right thing with the
462 Note that this does not change the position of INTERVAL; if it is a root,
463 it is still a root after this operation. */
466 split_interval_right (interval
, offset
)
470 INTERVAL
new = make_interval ();
471 int position
= interval
->position
;
472 int new_length
= LENGTH (interval
) - offset
;
474 new->position
= position
+ offset
;
475 new->parent
= interval
;
477 if (NULL_RIGHT_CHILD (interval
))
479 interval
->right
= new;
480 new->total_length
= new_length
;
485 /* Insert the new node between INTERVAL and its right child. */
486 new->right
= interval
->right
;
487 interval
->right
->parent
= new;
488 interval
->right
= new;
489 new->total_length
= new_length
+ new->right
->total_length
;
491 balance_an_interval (new);
492 balance_possible_root_interval (interval
);
497 /* Split INTERVAL into two pieces, starting the second piece at
498 character position OFFSET (counting from 0), relative to INTERVAL.
499 INTERVAL becomes the right-hand piece, and the left-hand piece
500 (first, lexicographically) is returned.
502 The size and position fields of the two intervals are set based upon
503 those of the original interval. The property list of the new interval
504 is reset, thus it is up to the caller to do the right thing with the
507 Note that this does not change the position of INTERVAL; if it is a root,
508 it is still a root after this operation. */
511 split_interval_left (interval
, offset
)
515 INTERVAL
new = make_interval ();
516 int position
= interval
->position
;
517 int new_length
= offset
;
519 new->position
= interval
->position
;
520 interval
->position
= interval
->position
+ offset
;
521 new->parent
= interval
;
523 if (NULL_LEFT_CHILD (interval
))
525 interval
->left
= new;
526 new->total_length
= new_length
;
531 /* Insert the new node between INTERVAL and its left child. */
532 new->left
= interval
->left
;
533 new->left
->parent
= new;
534 interval
->left
= new;
535 new->total_length
= new_length
+ new->left
->total_length
;
537 balance_an_interval (new);
538 balance_possible_root_interval (interval
);
543 /* Find the interval containing text position POSITION in the text
544 represented by the interval tree TREE. POSITION is a buffer
545 position; the earliest position is 1. If POSITION is at the end of
546 the buffer, return the interval containing the last character.
548 The `position' field, which is a cache of an interval's position,
549 is updated in the interval found. Other functions (e.g., next_interval)
550 will update this cache based on the result of find_interval. */
553 find_interval (tree
, position
)
554 register INTERVAL tree
;
555 register int position
;
557 /* The distance from the left edge of the subtree at TREE
559 register int relative_position
= position
- BEG
;
561 if (NULL_INTERVAL_P (tree
))
562 return NULL_INTERVAL
;
564 if (relative_position
> TOTAL_LENGTH (tree
))
565 abort (); /* Paranoia */
567 tree
= balance_possible_root_interval (tree
);
571 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
575 else if (! NULL_RIGHT_CHILD (tree
)
576 && relative_position
>= (TOTAL_LENGTH (tree
)
577 - RIGHT_TOTAL_LENGTH (tree
)))
579 relative_position
-= (TOTAL_LENGTH (tree
)
580 - RIGHT_TOTAL_LENGTH (tree
));
586 (position
- relative_position
/* the left edge of *tree */
587 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
594 /* Find the succeeding interval (lexicographically) to INTERVAL.
595 Sets the `position' field based on that of INTERVAL (see
599 next_interval (interval
)
600 register INTERVAL interval
;
602 register INTERVAL i
= interval
;
603 register int next_position
;
605 if (NULL_INTERVAL_P (i
))
606 return NULL_INTERVAL
;
607 next_position
= interval
->position
+ LENGTH (interval
);
609 if (! NULL_RIGHT_CHILD (i
))
612 while (! NULL_LEFT_CHILD (i
))
615 i
->position
= next_position
;
619 while (! NULL_PARENT (i
))
621 if (AM_LEFT_CHILD (i
))
624 i
->position
= next_position
;
631 return NULL_INTERVAL
;
634 /* Find the preceding interval (lexicographically) to INTERVAL.
635 Sets the `position' field based on that of INTERVAL (see
639 previous_interval (interval
)
640 register INTERVAL interval
;
643 register position_of_previous
;
645 if (NULL_INTERVAL_P (interval
))
646 return NULL_INTERVAL
;
648 if (! NULL_LEFT_CHILD (interval
))
651 while (! NULL_RIGHT_CHILD (i
))
654 i
->position
= interval
->position
- LENGTH (i
);
659 while (! NULL_PARENT (i
))
661 if (AM_RIGHT_CHILD (i
))
665 i
->position
= interval
->position
- LENGTH (i
);
671 return NULL_INTERVAL
;
675 /* Traverse a path down the interval tree TREE to the interval
676 containing POSITION, adjusting all nodes on the path for
677 an addition of LENGTH characters. Insertion between two intervals
678 (i.e., point == i->position, where i is second interval) means
679 text goes into second interval.
681 Modifications are needed to handle the hungry bits -- after simply
682 finding the interval at position (don't add length going down),
683 if it's the beginning of the interval, get the previous interval
684 and check the hungry bits of both. Then add the length going back up
688 adjust_intervals_for_insertion (tree
, position
, length
)
690 int position
, length
;
692 register int relative_position
;
693 register INTERVAL
this;
695 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
698 /* If inserting at point-max of a buffer, that position
699 will be out of range */
700 if (position
> TOTAL_LENGTH (tree
))
701 position
= TOTAL_LENGTH (tree
);
702 relative_position
= position
;
707 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
709 this->total_length
+= length
;
712 else if (relative_position
> (TOTAL_LENGTH (this)
713 - RIGHT_TOTAL_LENGTH (this)))
715 relative_position
-= (TOTAL_LENGTH (this)
716 - RIGHT_TOTAL_LENGTH (this));
717 this->total_length
+= length
;
722 /* If we are to use zero-length intervals as buffer pointers,
723 then this code will have to change. */
724 this->total_length
+= length
;
725 this->position
= LEFT_TOTAL_LENGTH (this)
726 + position
- relative_position
+ 1;
733 /* Effect an adjustment corresponding to the addition of LENGTH characters
734 of text. Do this by finding the interval containing POSITION in the
735 interval tree TREE, and then adjusting all of its ancestors by adding
738 If POSITION is the first character of an interval, meaning that point
739 is actually between the two intervals, make the new text belong to
740 the interval which is "sticky".
742 If both intervals are "sticky", then make them belong to the left-most
743 interval. Another possibility would be to create a new interval for
744 this text, and make it have the merged properties of both ends. */
747 adjust_intervals_for_insertion (tree
, position
, length
)
749 int position
, length
;
752 register INTERVAL temp
;
755 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
758 /* If inserting at point-max of a buffer, that position will be out
759 of range. Remember that buffer positions are 1-based. */
760 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
761 position
= BEG
+ TOTAL_LENGTH (tree
);
765 i
= find_interval (tree
, position
);
767 /* If in middle of an interval which is not sticky either way,
768 we must not just give its properties to the insertion.
769 So split this interval at the insertion point. */
770 if (! (position
== i
->position
|| eobp
)
771 && END_NONSTICKY_P (i
)
772 && FRONT_NONSTICKY_P (i
))
775 Lisp_Object front
, rear
;
777 front
= textget (i
->plist
, Qfront_sticky
);
778 rear
= textget (i
->plist
, Qrear_nonsticky
);
780 /* Does any actual property pose an actual problem? */
781 for (tail
= i
->plist
; ! NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
784 prop
= XCONS (tail
)->car
;
786 /* Is this particular property rear-sticky?
787 Note, if REAR isn't a cons, it must be non-nil,
788 which means that all properties are rear-nonsticky. */
789 if (CONSP (rear
) && NILP (Fmemq (prop
, rear
)))
792 /* Is this particular property front-sticky?
793 Note, if FRONT isn't a cons, it must be nil,
794 which means that all properties are front-nonsticky. */
795 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
798 /* PROP isn't sticky on either side => it is a real problem. */
802 /* If any property is a real problem, split the interval. */
805 temp
= split_interval_right (i
, position
- i
->position
);
806 copy_properties (i
, temp
);
811 /* If we are positioned between intervals, check the stickiness of
812 both of them. We have to do this too, if we are at BEG or Z. */
813 if (position
== i
->position
|| eobp
)
815 register INTERVAL prev
;
825 prev
= previous_interval (i
);
827 /* Even if we are positioned between intervals, we default
828 to the left one if it exists. We extend it now and split
829 off a part later, if stickiness demands it. */
830 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
832 temp
->total_length
+= length
;
833 temp
= balance_possible_root_interval (temp
);
836 /* If at least one interval has sticky properties,
837 we check the stickiness property by property. */
838 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
840 Lisp_Object pleft
, pright
;
841 struct interval newi
;
843 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
844 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
845 newi
.plist
= merge_properties_sticky (pleft
, pright
);
847 if(! prev
) /* i.e. position == BEG */
849 if (! intervals_equal (i
, &newi
))
851 i
= split_interval_left (i
, length
);
852 i
->plist
= newi
.plist
;
855 else if (! intervals_equal (prev
, &newi
))
857 prev
= split_interval_right (prev
,
858 position
- prev
->position
);
859 prev
->plist
= newi
.plist
;
860 if (! NULL_INTERVAL_P (i
)
861 && intervals_equal (prev
, i
))
862 merge_interval_right (prev
);
865 /* We will need to update the cache here later. */
867 else if (! prev
&& ! NILP (i
->plist
))
869 /* Just split off a new interval at the left.
870 Since I wasn't front-sticky, the empty plist is ok. */
871 i
= split_interval_left (i
, length
);
875 /* Otherwise just extend the interval. */
878 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
880 temp
->total_length
+= length
;
881 temp
= balance_possible_root_interval (temp
);
888 /* Any property might be front-sticky on the left, rear-sticky on the left,
889 front-sticky on the right, or rear-sticky on the right; the 16 combinations
890 can be arranged in a matrix with rows denoting the left conditions and
891 columns denoting the right conditions:
899 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
900 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
901 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
902 p8 L p9 L pa L pb L pc L pd L pe L pf L)
903 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
904 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
905 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
906 p8 R p9 R pa R pb R pc R pd R pe R pf R)
908 We inherit from whoever has a sticky side facing us. If both sides
909 do (cases 2, 3, E, and F), then we inherit from whichever side has a
910 non-nil value for the current property. If both sides do, then we take
913 When we inherit a property, we get its stickiness as well as its value.
914 So, when we merge the above two lists, we expect to get this:
916 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
917 rear-nonsticky (p6 pa)
918 p0 L p1 L p2 L p3 L p6 R p7 R
919 pa R pb R pc L pd L pe L pf L)
921 The optimizable special cases are:
922 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
923 left rear-nonsticky = t, right front-sticky = t (inherit right)
924 left rear-nonsticky = t, right front-sticky = nil (inherit none)
928 merge_properties_sticky (pleft
, pright
)
929 Lisp_Object pleft
, pright
;
931 register Lisp_Object props
, front
, rear
;
932 Lisp_Object lfront
, lrear
, rfront
, rrear
;
933 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
934 int use_left
, use_right
;
940 lfront
= textget (pleft
, Qfront_sticky
);
941 lrear
= textget (pleft
, Qrear_nonsticky
);
942 rfront
= textget (pright
, Qfront_sticky
);
943 rrear
= textget (pright
, Qrear_nonsticky
);
945 /* Go through each element of PRIGHT. */
946 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
950 /* Sticky properties get special treatment. */
951 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
954 rval
= Fcar (Fcdr (tail1
));
955 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
956 if (EQ (sym
, Fcar (tail2
)))
959 /* Indicate whether the property is explicitly defined on the left.
960 (We know it is defined explicitly on the right
961 because otherwise we don't get here.) */
962 lpresent
= ! NILP (tail2
);
963 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
965 use_left
= ! TMEM (sym
, lrear
) && lpresent
;
966 use_right
= TMEM (sym
, rfront
);
967 if (use_left
&& use_right
)
971 else if (NILP (rval
))
976 /* We build props as (value sym ...) rather than (sym value ...)
977 because we plan to nreverse it when we're done. */
978 props
= Fcons (lval
, Fcons (sym
, props
));
979 if (TMEM (sym
, lfront
))
980 front
= Fcons (sym
, front
);
981 if (TMEM (sym
, lrear
))
982 rear
= Fcons (sym
, rear
);
986 props
= Fcons (rval
, Fcons (sym
, props
));
987 if (TMEM (sym
, rfront
))
988 front
= Fcons (sym
, front
);
989 if (TMEM (sym
, rrear
))
990 rear
= Fcons (sym
, rear
);
994 /* Now go through each element of PLEFT. */
995 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
999 /* Sticky properties get special treatment. */
1000 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1003 /* If sym is in PRIGHT, we've already considered it. */
1004 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1005 if (EQ (sym
, Fcar (tail1
)))
1010 lval
= Fcar (Fcdr (tail2
));
1012 /* Since rval is known to be nil in this loop, the test simplifies. */
1013 if (! TMEM (sym
, lrear
))
1015 props
= Fcons (lval
, Fcons (sym
, props
));
1016 if (TMEM (sym
, lfront
))
1017 front
= Fcons (sym
, front
);
1019 else if (TMEM (sym
, rfront
))
1021 /* The value is nil, but we still inherit the stickiness
1023 front
= Fcons (sym
, front
);
1024 if (TMEM (sym
, rrear
))
1025 rear
= Fcons (sym
, rear
);
1028 props
= Fnreverse (props
);
1030 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1032 cat
= textget (props
, Qcategory
);
1035 /* If we have inherited a front-stick category property that is t,
1036 we don't need to set up a detailed one. */
1037 ! (! NILP (cat
) && SYMBOLP (cat
)
1038 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1039 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1044 /* Delete an node I from its interval tree by merging its subtrees
1045 into one subtree which is then returned. Caller is responsible for
1046 storing the resulting subtree into its parent. */
1050 register INTERVAL i
;
1052 register INTERVAL migrate
, this;
1053 register int migrate_amt
;
1055 if (NULL_INTERVAL_P (i
->left
))
1057 if (NULL_INTERVAL_P (i
->right
))
1061 migrate_amt
= i
->left
->total_length
;
1063 this->total_length
+= migrate_amt
;
1064 while (! NULL_INTERVAL_P (this->left
))
1067 this->total_length
+= migrate_amt
;
1069 this->left
= migrate
;
1070 migrate
->parent
= this;
1075 /* Delete interval I from its tree by calling `delete_node'
1076 and properly connecting the resultant subtree.
1078 I is presumed to be empty; that is, no adjustments are made
1079 for the length of I. */
1083 register INTERVAL i
;
1085 register INTERVAL parent
;
1086 int amt
= LENGTH (i
);
1088 if (amt
> 0) /* Only used on zero-length intervals now. */
1091 if (ROOT_INTERVAL_P (i
))
1094 owner
= (Lisp_Object
) i
->parent
;
1095 parent
= delete_node (i
);
1096 if (! NULL_INTERVAL_P (parent
))
1097 parent
->parent
= (INTERVAL
) owner
;
1099 if (BUFFERP (owner
))
1100 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1101 else if (STRINGP (owner
))
1102 XSTRING (owner
)->intervals
= parent
;
1110 if (AM_LEFT_CHILD (i
))
1112 parent
->left
= delete_node (i
);
1113 if (! NULL_INTERVAL_P (parent
->left
))
1114 parent
->left
->parent
= parent
;
1118 parent
->right
= delete_node (i
);
1119 if (! NULL_INTERVAL_P (parent
->right
))
1120 parent
->right
->parent
= parent
;
1124 /* Find the interval in TREE corresponding to the relative position
1125 FROM and delete as much as possible of AMOUNT from that interval.
1126 Return the amount actually deleted, and if the interval was
1127 zeroed-out, delete that interval node from the tree.
1129 Note that FROM is actually origin zero, aka relative to the
1130 leftmost edge of tree. This is appropriate since we call ourselves
1131 recursively on subtrees.
1133 Do this by recursing down TREE to the interval in question, and
1134 deleting the appropriate amount of text. */
1137 interval_deletion_adjustment (tree
, from
, amount
)
1138 register INTERVAL tree
;
1139 register int from
, amount
;
1141 register int relative_position
= from
;
1143 if (NULL_INTERVAL_P (tree
))
1147 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1149 int subtract
= interval_deletion_adjustment (tree
->left
,
1152 tree
->total_length
-= subtract
;
1156 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1157 - RIGHT_TOTAL_LENGTH (tree
)))
1161 relative_position
-= (tree
->total_length
1162 - RIGHT_TOTAL_LENGTH (tree
));
1163 subtract
= interval_deletion_adjustment (tree
->right
,
1166 tree
->total_length
-= subtract
;
1169 /* Here -- this node. */
1172 /* How much can we delete from this interval? */
1173 int my_amount
= ((tree
->total_length
1174 - RIGHT_TOTAL_LENGTH (tree
))
1175 - relative_position
);
1177 if (amount
> my_amount
)
1180 tree
->total_length
-= amount
;
1181 if (LENGTH (tree
) == 0)
1182 delete_interval (tree
);
1187 /* Never reach here. */
1190 /* Effect the adjustments necessary to the interval tree of BUFFER to
1191 correspond to the deletion of LENGTH characters from that buffer
1192 text. The deletion is effected at position START (which is a
1193 buffer position, i.e. origin 1). */
1196 adjust_intervals_for_deletion (buffer
, start
, length
)
1197 struct buffer
*buffer
;
1200 register int left_to_delete
= length
;
1201 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1202 register int deleted
;
1204 if (NULL_INTERVAL_P (tree
))
1207 if (start
> BEG
+ TOTAL_LENGTH (tree
)
1208 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
1211 if (length
== TOTAL_LENGTH (tree
))
1213 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1217 if (ONLY_INTERVAL_P (tree
))
1219 tree
->total_length
-= length
;
1223 if (start
> BEG
+ TOTAL_LENGTH (tree
))
1224 start
= BEG
+ TOTAL_LENGTH (tree
);
1225 while (left_to_delete
> 0)
1227 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
1229 tree
= BUF_INTERVALS (buffer
);
1230 if (left_to_delete
== tree
->total_length
)
1232 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1238 /* Make the adjustments necessary to the interval tree of BUFFER to
1239 represent an addition or deletion of LENGTH characters starting
1240 at position START. Addition or deletion is indicated by the sign
1244 offset_intervals (buffer
, start
, length
)
1245 struct buffer
*buffer
;
1248 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1252 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1254 adjust_intervals_for_deletion (buffer
, start
, -length
);
1257 /* Merge interval I with its lexicographic successor. The resulting
1258 interval is returned, and has the properties of the original
1259 successor. The properties of I are lost. I is removed from the
1263 The caller must verify that this is not the last (rightmost)
1267 merge_interval_right (i
)
1268 register INTERVAL i
;
1270 register int absorb
= LENGTH (i
);
1271 register INTERVAL successor
;
1273 /* Zero out this interval. */
1274 i
->total_length
-= absorb
;
1276 /* Find the succeeding interval. */
1277 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1280 successor
= i
->right
;
1281 while (! NULL_LEFT_CHILD (successor
))
1283 successor
->total_length
+= absorb
;
1284 successor
= successor
->left
;
1287 successor
->total_length
+= absorb
;
1288 delete_interval (i
);
1293 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1296 if (AM_LEFT_CHILD (successor
))
1298 successor
= successor
->parent
;
1299 delete_interval (i
);
1303 successor
= successor
->parent
;
1304 successor
->total_length
-= absorb
;
1307 /* This must be the rightmost or last interval and cannot
1308 be merged right. The caller should have known. */
1312 /* Merge interval I with its lexicographic predecessor. The resulting
1313 interval is returned, and has the properties of the original predecessor.
1314 The properties of I are lost. Interval node I is removed from the tree.
1317 The caller must verify that this is not the first (leftmost) interval. */
1320 merge_interval_left (i
)
1321 register INTERVAL i
;
1323 register int absorb
= LENGTH (i
);
1324 register INTERVAL predecessor
;
1326 /* Zero out this interval. */
1327 i
->total_length
-= absorb
;
1329 /* Find the preceding interval. */
1330 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1331 adding ABSORB as we go. */
1333 predecessor
= i
->left
;
1334 while (! NULL_RIGHT_CHILD (predecessor
))
1336 predecessor
->total_length
+= absorb
;
1337 predecessor
= predecessor
->right
;
1340 predecessor
->total_length
+= absorb
;
1341 delete_interval (i
);
1346 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1347 subtracting ABSORB. */
1349 if (AM_RIGHT_CHILD (predecessor
))
1351 predecessor
= predecessor
->parent
;
1352 delete_interval (i
);
1356 predecessor
= predecessor
->parent
;
1357 predecessor
->total_length
-= absorb
;
1360 /* This must be the leftmost or first interval and cannot
1361 be merged left. The caller should have known. */
1365 /* Make an exact copy of interval tree SOURCE which descends from
1366 PARENT. This is done by recursing through SOURCE, copying
1367 the current interval and its properties, and then adjusting
1368 the pointers of the copy. */
1371 reproduce_tree (source
, parent
)
1372 INTERVAL source
, parent
;
1374 register INTERVAL t
= make_interval ();
1376 bcopy (source
, t
, INTERVAL_SIZE
);
1377 copy_properties (source
, t
);
1379 if (! NULL_LEFT_CHILD (source
))
1380 t
->left
= reproduce_tree (source
->left
, t
);
1381 if (! NULL_RIGHT_CHILD (source
))
1382 t
->right
= reproduce_tree (source
->right
, t
);
1388 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1390 /* Make a new interval of length LENGTH starting at START in the
1391 group of intervals INTERVALS, which is actually an interval tree.
1392 Returns the new interval.
1394 Generate an error if the new positions would overlap an existing
1398 make_new_interval (intervals
, start
, length
)
1404 slot
= find_interval (intervals
, start
);
1405 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1406 error ("Interval would overlap");
1408 if (start
== slot
->position
&& length
== LENGTH (slot
))
1411 if (slot
->position
== start
)
1413 /* New right node. */
1414 split_interval_right (slot
, length
);
1418 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1420 /* New left node. */
1421 split_interval_left (slot
, LENGTH (slot
) - length
);
1425 /* Convert interval SLOT into three intervals. */
1426 split_interval_left (slot
, start
- slot
->position
);
1427 split_interval_right (slot
, length
);
1432 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1433 LENGTH is the length of the text in SOURCE.
1435 This is used in insdel.c when inserting Lisp_Strings into the
1436 buffer. The text corresponding to SOURCE is already in the buffer
1437 when this is called. The intervals of new tree are a copy of those
1438 belonging to the string being inserted; intervals are never
1441 If the inserted text had no intervals associated, and we don't
1442 want to inherit the surrounding text's properties, this function
1443 simply returns -- offset_intervals should handle placing the
1444 text in the correct interval, depending on the sticky bits.
1446 If the inserted text had properties (intervals), then there are two
1447 cases -- either insertion happened in the middle of some interval,
1448 or between two intervals.
1450 If the text goes into the middle of an interval, then new
1451 intervals are created in the middle with only the properties of
1452 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1453 which case the new text has the union of its properties and those
1454 of the text into which it was inserted.
1456 If the text goes between two intervals, then if neither interval
1457 had its appropriate sticky property set (front_sticky, rear_sticky),
1458 the new text has only its properties. If one of the sticky properties
1459 is set, then the new text "sticks" to that region and its properties
1460 depend on merging as above. If both the preceding and succeeding
1461 intervals to the new text are "sticky", then the new text retains
1462 only its properties, as if neither sticky property were set. Perhaps
1463 we should consider merging all three sets of properties onto the new
1467 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1469 int position
, length
;
1470 struct buffer
*buffer
;
1473 register INTERVAL under
, over
, this, prev
;
1474 register INTERVAL tree
;
1477 tree
= BUF_INTERVALS (buffer
);
1479 /* If the new text has no properties, it becomes part of whatever
1480 interval it was inserted into. */
1481 if (NULL_INTERVAL_P (source
))
1484 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1486 XSETBUFFER (buf
, buffer
);
1487 Fset_text_properties (make_number (position
),
1488 make_number (position
+ length
),
1491 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1492 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1496 if (NULL_INTERVAL_P (tree
))
1498 /* The inserted text constitutes the whole buffer, so
1499 simply copy over the interval structure. */
1500 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1503 XSETBUFFER (buf
, buffer
);
1504 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1505 /* Explicitly free the old tree here. */
1510 /* Create an interval tree in which to place a copy
1511 of the intervals of the inserted string. */
1514 XSETBUFFER (buf
, buffer
);
1515 tree
= create_root_interval (buf
);
1518 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1519 /* If the buffer contains only the new string, but
1520 there was already some interval tree there, then it may be
1521 some zero length intervals. Eventually, do something clever
1522 about inserting properly. For now, just waste the old intervals. */
1524 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1525 /* Explicitly free the old tree here. */
1529 /* Paranoia -- the text has already been added, so this buffer
1530 should be of non-zero length. */
1531 else if (TOTAL_LENGTH (tree
) == 0)
1534 this = under
= find_interval (tree
, position
);
1535 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1537 over
= find_interval (source
, 1);
1539 /* Here for insertion in the middle of an interval.
1540 Split off an equivalent interval to the right,
1541 then don't bother with it any more. */
1543 if (position
> under
->position
)
1545 INTERVAL end_unchanged
1546 = split_interval_left (this, position
- under
->position
);
1547 copy_properties (under
, end_unchanged
);
1548 under
->position
= position
;
1554 prev
= previous_interval (under
);
1555 if (prev
&& !END_NONSTICKY_P (prev
))
1559 /* Insertion is now at beginning of UNDER. */
1561 /* The inserted text "sticks" to the interval `under',
1562 which means it gets those properties.
1563 The properties of under are the result of
1564 adjust_intervals_for_insertion, so stickiness has
1565 already been taken care of. */
1567 while (! NULL_INTERVAL_P (over
))
1569 if (LENGTH (over
) < LENGTH (under
))
1571 this = split_interval_left (under
, LENGTH (over
));
1572 copy_properties (under
, this);
1576 copy_properties (over
, this);
1578 merge_properties (over
, this);
1580 copy_properties (over
, this);
1581 over
= next_interval (over
);
1584 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1585 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1589 /* Get the value of property PROP from PLIST,
1590 which is the plist of an interval.
1591 We check for direct properties, for categories with property PROP,
1592 and for PROP appearing on the default-text-properties list. */
1595 textget (plist
, prop
)
1597 register Lisp_Object prop
;
1599 register Lisp_Object tail
, fallback
;
1602 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1604 register Lisp_Object tem
;
1607 return Fcar (Fcdr (tail
));
1608 if (EQ (tem
, Qcategory
))
1610 tem
= Fcar (Fcdr (tail
));
1612 fallback
= Fget (tem
, prop
);
1616 if (! NILP (fallback
))
1618 if (CONSP (Vdefault_text_properties
))
1619 return Fplist_get (Vdefault_text_properties
, prop
);
1624 /* Set point in BUFFER to POSITION. If the target position is
1625 before an intangible character, move to an ok place. */
1628 set_point (position
, buffer
)
1629 register int position
;
1630 register struct buffer
*buffer
;
1632 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1634 register Lisp_Object obj
;
1635 int old_position
= BUF_PT (buffer
);
1636 int backwards
= (position
< old_position
? 1 : 0);
1638 int original_position
;
1640 buffer
->point_before_scroll
= Qnil
;
1642 if (position
== BUF_PT (buffer
))
1645 /* Check this now, before checking if the buffer has any intervals.
1646 That way, we can catch conditions which break this sanity check
1647 whether or not there are intervals in the buffer. */
1648 if (position
> BUF_ZV (buffer
) || position
< BUF_BEGV (buffer
))
1651 have_overlays
= (! NILP (buffer
->overlays_before
)
1652 || ! NILP (buffer
->overlays_after
));
1654 /* If we have no text properties and overlays,
1655 then we can do it quickly. */
1656 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1658 BUF_PT (buffer
) = position
;
1662 /* Set TO to the interval containing the char after POSITION,
1663 and TOPREV to the interval containing the char before POSITION.
1664 Either one may be null. They may be equal. */
1665 to
= find_interval (BUF_INTERVALS (buffer
), position
);
1666 if (position
== BUF_BEGV (buffer
))
1668 else if (to
&& to
->position
== position
)
1669 toprev
= previous_interval (to
);
1673 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1674 ? BUF_ZV (buffer
) - 1
1677 /* Set FROM to the interval containing the char after PT,
1678 and FROMPREV to the interval containing the char before PT.
1679 Either one may be null. They may be equal. */
1680 /* We could cache this and save time. */
1681 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1682 if (buffer_point
== BUF_BEGV (buffer
))
1684 else if (from
&& from
->position
== BUF_PT (buffer
))
1685 fromprev
= previous_interval (from
);
1686 else if (buffer_point
!= BUF_PT (buffer
))
1687 fromprev
= from
, from
= 0;
1691 /* Moving within an interval. */
1692 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1695 BUF_PT (buffer
) = position
;
1699 original_position
= position
;
1701 /* If the new position is between two intangible characters
1702 with the same intangible property value,
1703 move forward or backward until a change in that property. */
1704 if (NILP (Vinhibit_point_motion_hooks
)
1705 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1707 /* Intangibility never stops us from positioning at the beginning
1708 or end of the buffer, so don't bother checking in that case. */
1709 && position
!= BEGV
&& position
!= ZV
)
1711 Lisp_Object intangible_propval
;
1714 XSETINT (pos
, position
);
1718 intangible_propval
= Fget_char_property (make_number (position
),
1721 /* If following char is intangible,
1722 skip back over all chars with matching intangible property. */
1723 if (! NILP (intangible_propval
))
1724 while (XINT (pos
) > BUF_BEGV (buffer
)
1725 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1727 intangible_propval
))
1728 pos
= Fprevious_char_property_change (pos
, Qnil
);
1732 intangible_propval
= Fget_char_property (make_number (position
- 1),
1735 /* If following char is intangible,
1736 skip back over all chars with matching intangible property. */
1737 if (! NILP (intangible_propval
))
1738 while (XINT (pos
) < BUF_ZV (buffer
)
1739 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1740 intangible_propval
))
1741 pos
= Fnext_char_property_change (pos
, Qnil
);
1745 position
= XINT (pos
);
1748 if (position
!= original_position
)
1750 /* Set TO to the interval containing the char after POSITION,
1751 and TOPREV to the interval containing the char before POSITION.
1752 Either one may be null. They may be equal. */
1753 to
= find_interval (BUF_INTERVALS (buffer
), position
);
1754 if (position
== BUF_BEGV (buffer
))
1756 else if (to
&& to
->position
== position
)
1757 toprev
= previous_interval (to
);
1762 /* Here TO is the interval after the stopping point
1763 and TOPREV is the interval before the stopping point.
1764 One or the other may be null. */
1766 BUF_PT (buffer
) = position
;
1768 /* We run point-left and point-entered hooks here, iff the
1769 two intervals are not equivalent. These hooks take
1770 (old_point, new_point) as arguments. */
1771 if (NILP (Vinhibit_point_motion_hooks
)
1772 && (! intervals_equal (from
, to
)
1773 || ! intervals_equal (fromprev
, toprev
)))
1775 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1778 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1782 leave_before
= textget (from
->plist
, Qpoint_left
);
1784 leave_before
= Qnil
;
1787 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1791 enter_before
= textget (to
->plist
, Qpoint_entered
);
1793 enter_before
= Qnil
;
1795 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1796 call2 (leave_before
, old_position
, position
);
1797 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1798 call2 (leave_after
, old_position
, position
);
1800 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1801 call2 (enter_before
, old_position
, position
);
1802 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1803 call2 (enter_after
, old_position
, position
);
1807 /* Set point temporarily, without checking any text properties. */
1810 temp_set_point (position
, buffer
)
1812 struct buffer
*buffer
;
1814 BUF_PT (buffer
) = position
;
1817 /* Return the proper local map for position POSITION in BUFFER.
1818 Use the map specified by the local-map property, if any.
1819 Otherwise, use BUFFER's local map. */
1822 get_local_map (position
, buffer
)
1823 register int position
;
1824 register struct buffer
*buffer
;
1826 Lisp_Object prop
, tem
, lispy_position
, lispy_buffer
;
1827 int old_begv
, old_zv
;
1829 /* Perhaps we should just change `position' to the limit. */
1830 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1833 /* Ignore narrowing, so that a local map continues to be valid even if
1834 the visible region contains no characters and hence no properties. */
1835 old_begv
= BUF_BEGV (buffer
);
1836 old_zv
= BUF_ZV (buffer
);
1837 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
1838 BUF_ZV (buffer
) = BUF_Z (buffer
);
1840 /* There are no properties at the end of the buffer, so in that case
1841 check for a local map on the last character of the buffer instead. */
1842 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
1844 XSETFASTINT (lispy_position
, position
);
1845 XSETBUFFER (lispy_buffer
, buffer
);
1846 prop
= Fget_char_property (lispy_position
, Qlocal_map
, lispy_buffer
);
1848 BUF_BEGV (buffer
) = old_begv
;
1849 BUF_ZV (buffer
) = old_zv
;
1851 /* Use the local map only if it is valid. */
1852 /* Do allow symbols that are defined as keymaps. */
1853 if (SYMBOLP (prop
) && !NILP (prop
))
1854 prop
= Findirect_function (prop
);
1856 && (tem
= Fkeymapp (prop
), !NILP (tem
)))
1859 return buffer
->keymap
;
1862 /* Produce an interval tree reflecting the intervals in
1863 TREE from START to START + LENGTH. */
1866 copy_intervals (tree
, start
, length
)
1870 register INTERVAL i
, new, t
;
1871 register int got
, prevlen
;
1873 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1874 return NULL_INTERVAL
;
1876 i
= find_interval (tree
, start
);
1877 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1880 /* If there is only one interval and it's the default, return nil. */
1881 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
1882 && DEFAULT_INTERVAL_P (i
))
1883 return NULL_INTERVAL
;
1885 new = make_interval ();
1887 got
= (LENGTH (i
) - (start
- i
->position
));
1888 new->total_length
= length
;
1889 copy_properties (i
, new);
1893 while (got
< length
)
1895 i
= next_interval (i
);
1896 t
= split_interval_right (t
, prevlen
);
1897 copy_properties (i
, t
);
1898 prevlen
= LENGTH (i
);
1902 return balance_an_interval (new);
1905 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1908 copy_intervals_to_string (string
, buffer
, position
, length
)
1910 struct buffer
*buffer
;
1911 int position
, length
;
1913 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
1915 if (NULL_INTERVAL_P (interval_copy
))
1918 interval_copy
->parent
= (INTERVAL
) string
;
1919 XSTRING (string
)->intervals
= interval_copy
;
1922 /* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
1923 Assume they have identical characters. */
1926 compare_string_intervals (s1
, s2
)
1931 int end
= XSTRING (s1
)->size
+ 1;
1933 /* We specify 1 as position because the interval functions
1934 always use positions starting at 1. */
1935 i1
= find_interval (XSTRING (s1
)->intervals
, 1);
1936 i2
= find_interval (XSTRING (s2
)->intervals
, 1);
1940 /* Determine how far we can go before we reach the end of I1 or I2. */
1941 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
1942 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
1943 int distance
= min (len1
, len2
);
1945 /* If we ever find a mismatch between the strings,
1947 if (! intervals_equal (i1
, i2
))
1950 /* Advance POS till the end of the shorter interval,
1951 and advance one or both interval pointers for the new position. */
1953 if (len1
== distance
)
1954 i1
= next_interval (i1
);
1955 if (len2
== distance
)
1956 i2
= next_interval (i2
);
1961 #endif /* USE_TEXT_PROPERTIES */