1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998 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
) XFASTINT (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
) P_ ((INTERVAL
, Lisp_Object
));
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 XSETFASTINT (parent
, (EMACS_INT
) 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
;
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
;
489 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
;
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
;
535 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 int 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
;
674 /* Find the interval containing POS given some non-NULL INTERVAL
675 in the same tree. Note that we need to update interval->position
676 if we go down the tree. */
678 update_interval (i
, pos
)
682 if (NULL_INTERVAL_P (i
))
683 return NULL_INTERVAL
;
687 if (pos
< i
->position
)
690 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
692 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
693 + LEFT_TOTAL_LENGTH (i
->left
);
694 i
= i
->left
; /* Move to the left child */
696 else if (NULL_PARENT (i
))
697 error ("Point before start of properties");
702 else if (pos
>= INTERVAL_LAST_POS (i
))
705 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
707 i
->right
->position
= INTERVAL_LAST_POS (i
) +
708 LEFT_TOTAL_LENGTH (i
->right
);
709 i
= i
->right
; /* Move to the right child */
711 else if (NULL_PARENT (i
))
712 error ("Point after end of properties");
724 /* Traverse a path down the interval tree TREE to the interval
725 containing POSITION, adjusting all nodes on the path for
726 an addition of LENGTH characters. Insertion between two intervals
727 (i.e., point == i->position, where i is second interval) means
728 text goes into second interval.
730 Modifications are needed to handle the hungry bits -- after simply
731 finding the interval at position (don't add length going down),
732 if it's the beginning of the interval, get the previous interval
733 and check the hungry bits of both. Then add the length going back up
737 adjust_intervals_for_insertion (tree
, position
, length
)
739 int position
, length
;
741 register int relative_position
;
742 register INTERVAL
this;
744 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
747 /* If inserting at point-max of a buffer, that position
748 will be out of range */
749 if (position
> TOTAL_LENGTH (tree
))
750 position
= TOTAL_LENGTH (tree
);
751 relative_position
= position
;
756 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
758 this->total_length
+= length
;
761 else if (relative_position
> (TOTAL_LENGTH (this)
762 - RIGHT_TOTAL_LENGTH (this)))
764 relative_position
-= (TOTAL_LENGTH (this)
765 - RIGHT_TOTAL_LENGTH (this));
766 this->total_length
+= length
;
771 /* If we are to use zero-length intervals as buffer pointers,
772 then this code will have to change. */
773 this->total_length
+= length
;
774 this->position
= LEFT_TOTAL_LENGTH (this)
775 + position
- relative_position
+ 1;
782 /* Effect an adjustment corresponding to the addition of LENGTH characters
783 of text. Do this by finding the interval containing POSITION in the
784 interval tree TREE, and then adjusting all of its ancestors by adding
787 If POSITION is the first character of an interval, meaning that point
788 is actually between the two intervals, make the new text belong to
789 the interval which is "sticky".
791 If both intervals are "sticky", then make them belong to the left-most
792 interval. Another possibility would be to create a new interval for
793 this text, and make it have the merged properties of both ends. */
796 adjust_intervals_for_insertion (tree
, position
, length
)
798 int position
, length
;
801 register INTERVAL temp
;
804 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
807 /* If inserting at point-max of a buffer, that position will be out
808 of range. Remember that buffer positions are 1-based. */
809 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
810 position
= BEG
+ TOTAL_LENGTH (tree
);
814 i
= find_interval (tree
, position
);
816 /* If in middle of an interval which is not sticky either way,
817 we must not just give its properties to the insertion.
818 So split this interval at the insertion point. */
819 if (! (position
== i
->position
|| eobp
)
820 && END_NONSTICKY_P (i
)
821 && FRONT_NONSTICKY_P (i
))
824 Lisp_Object front
, rear
;
826 front
= textget (i
->plist
, Qfront_sticky
);
827 rear
= textget (i
->plist
, Qrear_nonsticky
);
829 /* Does any actual property pose an actual problem? */
830 for (tail
= i
->plist
; ! NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
833 prop
= XCONS (tail
)->car
;
835 /* Is this particular property rear-sticky?
836 Note, if REAR isn't a cons, it must be non-nil,
837 which means that all properties are rear-nonsticky. */
838 if (CONSP (rear
) && NILP (Fmemq (prop
, rear
)))
841 /* Is this particular property front-sticky?
842 Note, if FRONT isn't a cons, it must be nil,
843 which means that all properties are front-nonsticky. */
844 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
847 /* PROP isn't sticky on either side => it is a real problem. */
851 /* If any property is a real problem, split the interval. */
854 temp
= split_interval_right (i
, position
- i
->position
);
855 copy_properties (i
, temp
);
860 /* If we are positioned between intervals, check the stickiness of
861 both of them. We have to do this too, if we are at BEG or Z. */
862 if (position
== i
->position
|| eobp
)
864 register INTERVAL prev
;
874 prev
= previous_interval (i
);
876 /* Even if we are positioned between intervals, we default
877 to the left one if it exists. We extend it now and split
878 off a part later, if stickiness demands it. */
879 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
881 temp
->total_length
+= length
;
882 temp
= balance_possible_root_interval (temp
);
885 /* If at least one interval has sticky properties,
886 we check the stickiness property by property. */
887 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
889 Lisp_Object pleft
, pright
;
890 struct interval newi
;
892 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
893 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
894 newi
.plist
= merge_properties_sticky (pleft
, pright
);
896 if (! prev
) /* i.e. position == BEG */
898 if (! intervals_equal (i
, &newi
))
900 i
= split_interval_left (i
, length
);
901 i
->plist
= newi
.plist
;
904 else if (! intervals_equal (prev
, &newi
))
906 prev
= split_interval_right (prev
,
907 position
- prev
->position
);
908 prev
->plist
= newi
.plist
;
909 if (! NULL_INTERVAL_P (i
)
910 && intervals_equal (prev
, i
))
911 merge_interval_right (prev
);
914 /* We will need to update the cache here later. */
916 else if (! prev
&& ! NILP (i
->plist
))
918 /* Just split off a new interval at the left.
919 Since I wasn't front-sticky, the empty plist is ok. */
920 i
= split_interval_left (i
, length
);
924 /* Otherwise just extend the interval. */
927 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
929 temp
->total_length
+= length
;
930 temp
= balance_possible_root_interval (temp
);
937 /* Any property might be front-sticky on the left, rear-sticky on the left,
938 front-sticky on the right, or rear-sticky on the right; the 16 combinations
939 can be arranged in a matrix with rows denoting the left conditions and
940 columns denoting the right conditions:
948 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
949 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
950 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
951 p8 L p9 L pa L pb L pc L pd L pe L pf L)
952 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
953 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
954 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
955 p8 R p9 R pa R pb R pc R pd R pe R pf R)
957 We inherit from whoever has a sticky side facing us. If both sides
958 do (cases 2, 3, E, and F), then we inherit from whichever side has a
959 non-nil value for the current property. If both sides do, then we take
962 When we inherit a property, we get its stickiness as well as its value.
963 So, when we merge the above two lists, we expect to get this:
965 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
966 rear-nonsticky (p6 pa)
967 p0 L p1 L p2 L p3 L p6 R p7 R
968 pa R pb R pc L pd L pe L pf L)
970 The optimizable special cases are:
971 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
972 left rear-nonsticky = t, right front-sticky = t (inherit right)
973 left rear-nonsticky = t, right front-sticky = nil (inherit none)
977 merge_properties_sticky (pleft
, pright
)
978 Lisp_Object pleft
, pright
;
980 register Lisp_Object props
, front
, rear
;
981 Lisp_Object lfront
, lrear
, rfront
, rrear
;
982 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
983 int use_left
, use_right
;
989 lfront
= textget (pleft
, Qfront_sticky
);
990 lrear
= textget (pleft
, Qrear_nonsticky
);
991 rfront
= textget (pright
, Qfront_sticky
);
992 rrear
= textget (pright
, Qrear_nonsticky
);
994 /* Go through each element of PRIGHT. */
995 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
999 /* Sticky properties get special treatment. */
1000 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1003 rval
= Fcar (Fcdr (tail1
));
1004 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1005 if (EQ (sym
, Fcar (tail2
)))
1008 /* Indicate whether the property is explicitly defined on the left.
1009 (We know it is defined explicitly on the right
1010 because otherwise we don't get here.) */
1011 lpresent
= ! NILP (tail2
);
1012 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1014 use_left
= ! TMEM (sym
, lrear
) && lpresent
;
1015 use_right
= TMEM (sym
, rfront
);
1016 if (use_left
&& use_right
)
1020 else if (NILP (rval
))
1025 /* We build props as (value sym ...) rather than (sym value ...)
1026 because we plan to nreverse it when we're done. */
1027 props
= Fcons (lval
, Fcons (sym
, props
));
1028 if (TMEM (sym
, lfront
))
1029 front
= Fcons (sym
, front
);
1030 if (TMEM (sym
, lrear
))
1031 rear
= Fcons (sym
, rear
);
1035 props
= Fcons (rval
, Fcons (sym
, props
));
1036 if (TMEM (sym
, rfront
))
1037 front
= Fcons (sym
, front
);
1038 if (TMEM (sym
, rrear
))
1039 rear
= Fcons (sym
, rear
);
1043 /* Now go through each element of PLEFT. */
1044 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1048 /* Sticky properties get special treatment. */
1049 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1052 /* If sym is in PRIGHT, we've already considered it. */
1053 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1054 if (EQ (sym
, Fcar (tail1
)))
1059 lval
= Fcar (Fcdr (tail2
));
1061 /* Since rval is known to be nil in this loop, the test simplifies. */
1062 if (! TMEM (sym
, lrear
))
1064 props
= Fcons (lval
, Fcons (sym
, props
));
1065 if (TMEM (sym
, lfront
))
1066 front
= Fcons (sym
, front
);
1068 else if (TMEM (sym
, rfront
))
1070 /* The value is nil, but we still inherit the stickiness
1072 front
= Fcons (sym
, front
);
1073 if (TMEM (sym
, rrear
))
1074 rear
= Fcons (sym
, rear
);
1077 props
= Fnreverse (props
);
1079 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1081 cat
= textget (props
, Qcategory
);
1084 /* If we have inherited a front-stick category property that is t,
1085 we don't need to set up a detailed one. */
1086 ! (! NILP (cat
) && SYMBOLP (cat
)
1087 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1088 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1093 /* Delete an node I from its interval tree by merging its subtrees
1094 into one subtree which is then returned. Caller is responsible for
1095 storing the resulting subtree into its parent. */
1099 register INTERVAL i
;
1101 register INTERVAL migrate
, this;
1102 register int migrate_amt
;
1104 if (NULL_INTERVAL_P (i
->left
))
1106 if (NULL_INTERVAL_P (i
->right
))
1110 migrate_amt
= i
->left
->total_length
;
1112 this->total_length
+= migrate_amt
;
1113 while (! NULL_INTERVAL_P (this->left
))
1116 this->total_length
+= migrate_amt
;
1118 this->left
= migrate
;
1119 migrate
->parent
= this;
1124 /* Delete interval I from its tree by calling `delete_node'
1125 and properly connecting the resultant subtree.
1127 I is presumed to be empty; that is, no adjustments are made
1128 for the length of I. */
1132 register INTERVAL i
;
1134 register INTERVAL parent
;
1135 int amt
= LENGTH (i
);
1137 if (amt
> 0) /* Only used on zero-length intervals now. */
1140 if (ROOT_INTERVAL_P (i
))
1143 XSETFASTINT (owner
, (EMACS_INT
) i
->parent
);
1144 parent
= delete_node (i
);
1145 if (! NULL_INTERVAL_P (parent
))
1146 parent
->parent
= (INTERVAL
) XFASTINT (owner
);
1148 if (BUFFERP (owner
))
1149 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1150 else if (STRINGP (owner
))
1151 XSTRING (owner
)->intervals
= parent
;
1159 if (AM_LEFT_CHILD (i
))
1161 parent
->left
= delete_node (i
);
1162 if (! NULL_INTERVAL_P (parent
->left
))
1163 parent
->left
->parent
= parent
;
1167 parent
->right
= delete_node (i
);
1168 if (! NULL_INTERVAL_P (parent
->right
))
1169 parent
->right
->parent
= parent
;
1173 /* Find the interval in TREE corresponding to the relative position
1174 FROM and delete as much as possible of AMOUNT from that interval.
1175 Return the amount actually deleted, and if the interval was
1176 zeroed-out, delete that interval node from the tree.
1178 Note that FROM is actually origin zero, aka relative to the
1179 leftmost edge of tree. This is appropriate since we call ourselves
1180 recursively on subtrees.
1182 Do this by recursing down TREE to the interval in question, and
1183 deleting the appropriate amount of text. */
1186 interval_deletion_adjustment (tree
, from
, amount
)
1187 register INTERVAL tree
;
1188 register int from
, amount
;
1190 register int relative_position
= from
;
1192 if (NULL_INTERVAL_P (tree
))
1196 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1198 int subtract
= interval_deletion_adjustment (tree
->left
,
1201 tree
->total_length
-= subtract
;
1205 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1206 - RIGHT_TOTAL_LENGTH (tree
)))
1210 relative_position
-= (tree
->total_length
1211 - RIGHT_TOTAL_LENGTH (tree
));
1212 subtract
= interval_deletion_adjustment (tree
->right
,
1215 tree
->total_length
-= subtract
;
1218 /* Here -- this node. */
1221 /* How much can we delete from this interval? */
1222 int my_amount
= ((tree
->total_length
1223 - RIGHT_TOTAL_LENGTH (tree
))
1224 - relative_position
);
1226 if (amount
> my_amount
)
1229 tree
->total_length
-= amount
;
1230 if (LENGTH (tree
) == 0)
1231 delete_interval (tree
);
1236 /* Never reach here. */
1239 /* Effect the adjustments necessary to the interval tree of BUFFER to
1240 correspond to the deletion of LENGTH characters from that buffer
1241 text. The deletion is effected at position START (which is a
1242 buffer position, i.e. origin 1). */
1245 adjust_intervals_for_deletion (buffer
, start
, length
)
1246 struct buffer
*buffer
;
1249 register int left_to_delete
= length
;
1250 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1251 register int deleted
;
1253 if (NULL_INTERVAL_P (tree
))
1256 if (start
> BEG
+ TOTAL_LENGTH (tree
)
1257 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
1260 if (length
== TOTAL_LENGTH (tree
))
1262 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1266 if (ONLY_INTERVAL_P (tree
))
1268 tree
->total_length
-= length
;
1272 if (start
> BEG
+ TOTAL_LENGTH (tree
))
1273 start
= BEG
+ TOTAL_LENGTH (tree
);
1274 while (left_to_delete
> 0)
1276 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
1278 tree
= BUF_INTERVALS (buffer
);
1279 if (left_to_delete
== tree
->total_length
)
1281 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1287 /* Make the adjustments necessary to the interval tree of BUFFER to
1288 represent an addition or deletion of LENGTH characters starting
1289 at position START. Addition or deletion is indicated by the sign
1293 offset_intervals (buffer
, start
, length
)
1294 struct buffer
*buffer
;
1297 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1301 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1303 adjust_intervals_for_deletion (buffer
, start
, -length
);
1306 /* Merge interval I with its lexicographic successor. The resulting
1307 interval is returned, and has the properties of the original
1308 successor. The properties of I are lost. I is removed from the
1312 The caller must verify that this is not the last (rightmost)
1316 merge_interval_right (i
)
1317 register INTERVAL i
;
1319 register int absorb
= LENGTH (i
);
1320 register INTERVAL successor
;
1322 /* Zero out this interval. */
1323 i
->total_length
-= absorb
;
1325 /* Find the succeeding interval. */
1326 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1329 successor
= i
->right
;
1330 while (! NULL_LEFT_CHILD (successor
))
1332 successor
->total_length
+= absorb
;
1333 successor
= successor
->left
;
1336 successor
->total_length
+= absorb
;
1337 delete_interval (i
);
1342 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1345 if (AM_LEFT_CHILD (successor
))
1347 successor
= successor
->parent
;
1348 delete_interval (i
);
1352 successor
= successor
->parent
;
1353 successor
->total_length
-= absorb
;
1356 /* This must be the rightmost or last interval and cannot
1357 be merged right. The caller should have known. */
1361 /* Merge interval I with its lexicographic predecessor. The resulting
1362 interval is returned, and has the properties of the original predecessor.
1363 The properties of I are lost. Interval node I is removed from the tree.
1366 The caller must verify that this is not the first (leftmost) interval. */
1369 merge_interval_left (i
)
1370 register INTERVAL i
;
1372 register int absorb
= LENGTH (i
);
1373 register INTERVAL predecessor
;
1375 /* Zero out this interval. */
1376 i
->total_length
-= absorb
;
1378 /* Find the preceding interval. */
1379 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1380 adding ABSORB as we go. */
1382 predecessor
= i
->left
;
1383 while (! NULL_RIGHT_CHILD (predecessor
))
1385 predecessor
->total_length
+= absorb
;
1386 predecessor
= predecessor
->right
;
1389 predecessor
->total_length
+= absorb
;
1390 delete_interval (i
);
1395 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1396 subtracting ABSORB. */
1398 if (AM_RIGHT_CHILD (predecessor
))
1400 predecessor
= predecessor
->parent
;
1401 delete_interval (i
);
1405 predecessor
= predecessor
->parent
;
1406 predecessor
->total_length
-= absorb
;
1409 /* This must be the leftmost or first interval and cannot
1410 be merged left. The caller should have known. */
1414 /* Make an exact copy of interval tree SOURCE which descends from
1415 PARENT. This is done by recursing through SOURCE, copying
1416 the current interval and its properties, and then adjusting
1417 the pointers of the copy. */
1420 reproduce_tree (source
, parent
)
1421 INTERVAL source
, parent
;
1423 register INTERVAL t
= make_interval ();
1425 bcopy (source
, t
, INTERVAL_SIZE
);
1426 copy_properties (source
, t
);
1428 if (! NULL_LEFT_CHILD (source
))
1429 t
->left
= reproduce_tree (source
->left
, t
);
1430 if (! NULL_RIGHT_CHILD (source
))
1431 t
->right
= reproduce_tree (source
->right
, t
);
1437 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1439 /* Make a new interval of length LENGTH starting at START in the
1440 group of intervals INTERVALS, which is actually an interval tree.
1441 Returns the new interval.
1443 Generate an error if the new positions would overlap an existing
1447 make_new_interval (intervals
, start
, length
)
1453 slot
= find_interval (intervals
, start
);
1454 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1455 error ("Interval would overlap");
1457 if (start
== slot
->position
&& length
== LENGTH (slot
))
1460 if (slot
->position
== start
)
1462 /* New right node. */
1463 split_interval_right (slot
, length
);
1467 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1469 /* New left node. */
1470 split_interval_left (slot
, LENGTH (slot
) - length
);
1474 /* Convert interval SLOT into three intervals. */
1475 split_interval_left (slot
, start
- slot
->position
);
1476 split_interval_right (slot
, length
);
1481 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1482 LENGTH is the length of the text in SOURCE.
1484 This is used in insdel.c when inserting Lisp_Strings into the
1485 buffer. The text corresponding to SOURCE is already in the buffer
1486 when this is called. The intervals of new tree are a copy of those
1487 belonging to the string being inserted; intervals are never
1490 If the inserted text had no intervals associated, and we don't
1491 want to inherit the surrounding text's properties, this function
1492 simply returns -- offset_intervals should handle placing the
1493 text in the correct interval, depending on the sticky bits.
1495 If the inserted text had properties (intervals), then there are two
1496 cases -- either insertion happened in the middle of some interval,
1497 or between two intervals.
1499 If the text goes into the middle of an interval, then new
1500 intervals are created in the middle with only the properties of
1501 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1502 which case the new text has the union of its properties and those
1503 of the text into which it was inserted.
1505 If the text goes between two intervals, then if neither interval
1506 had its appropriate sticky property set (front_sticky, rear_sticky),
1507 the new text has only its properties. If one of the sticky properties
1508 is set, then the new text "sticks" to that region and its properties
1509 depend on merging as above. If both the preceding and succeeding
1510 intervals to the new text are "sticky", then the new text retains
1511 only its properties, as if neither sticky property were set. Perhaps
1512 we should consider merging all three sets of properties onto the new
1516 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1518 int position
, length
;
1519 struct buffer
*buffer
;
1522 register INTERVAL under
, over
, this, prev
;
1523 register INTERVAL tree
;
1526 tree
= BUF_INTERVALS (buffer
);
1528 /* If the new text has no properties, it becomes part of whatever
1529 interval it was inserted into. */
1530 if (NULL_INTERVAL_P (source
))
1533 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1535 XSETBUFFER (buf
, buffer
);
1536 Fset_text_properties (make_number (position
),
1537 make_number (position
+ length
),
1540 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1541 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1545 if (NULL_INTERVAL_P (tree
))
1547 /* The inserted text constitutes the whole buffer, so
1548 simply copy over the interval structure. */
1549 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1552 XSETBUFFER (buf
, buffer
);
1553 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1554 /* Explicitly free the old tree here. */
1559 /* Create an interval tree in which to place a copy
1560 of the intervals of the inserted string. */
1563 XSETBUFFER (buf
, buffer
);
1564 tree
= create_root_interval (buf
);
1567 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1568 /* If the buffer contains only the new string, but
1569 there was already some interval tree there, then it may be
1570 some zero length intervals. Eventually, do something clever
1571 about inserting properly. For now, just waste the old intervals. */
1573 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1574 /* Explicitly free the old tree here. */
1578 /* Paranoia -- the text has already been added, so this buffer
1579 should be of non-zero length. */
1580 else if (TOTAL_LENGTH (tree
) == 0)
1583 this = under
= find_interval (tree
, position
);
1584 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1586 over
= find_interval (source
, 1);
1588 /* Here for insertion in the middle of an interval.
1589 Split off an equivalent interval to the right,
1590 then don't bother with it any more. */
1592 if (position
> under
->position
)
1594 INTERVAL end_unchanged
1595 = split_interval_left (this, position
- under
->position
);
1596 copy_properties (under
, end_unchanged
);
1597 under
->position
= position
;
1603 prev
= previous_interval (under
);
1604 if (prev
&& !END_NONSTICKY_P (prev
))
1608 /* Insertion is now at beginning of UNDER. */
1610 /* The inserted text "sticks" to the interval `under',
1611 which means it gets those properties.
1612 The properties of under are the result of
1613 adjust_intervals_for_insertion, so stickiness has
1614 already been taken care of. */
1616 while (! NULL_INTERVAL_P (over
))
1618 if (LENGTH (over
) < LENGTH (under
))
1620 this = split_interval_left (under
, LENGTH (over
));
1621 copy_properties (under
, this);
1625 copy_properties (over
, this);
1627 merge_properties (over
, this);
1629 copy_properties (over
, this);
1630 over
= next_interval (over
);
1633 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1634 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1638 /* Get the value of property PROP from PLIST,
1639 which is the plist of an interval.
1640 We check for direct properties, for categories with property PROP,
1641 and for PROP appearing on the default-text-properties list. */
1644 textget (plist
, prop
)
1646 register Lisp_Object prop
;
1648 register Lisp_Object tail
, fallback
;
1651 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1653 register Lisp_Object tem
;
1656 return Fcar (Fcdr (tail
));
1657 if (EQ (tem
, Qcategory
))
1659 tem
= Fcar (Fcdr (tail
));
1661 fallback
= Fget (tem
, prop
);
1665 if (! NILP (fallback
))
1667 if (CONSP (Vdefault_text_properties
))
1668 return Fplist_get (Vdefault_text_properties
, prop
);
1673 /* Set point "temporarily", without checking any text properties. */
1676 temp_set_point (buffer
, charpos
)
1677 struct buffer
*buffer
;
1680 temp_set_point_both (buffer
, charpos
,
1681 buf_charpos_to_bytepos (buffer
, charpos
));
1684 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1685 byte position BYTEPOS. */
1688 temp_set_point_both (buffer
, charpos
, bytepos
)
1689 int charpos
, bytepos
;
1690 struct buffer
*buffer
;
1692 /* In a single-byte buffer, the two positions must be equal. */
1693 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1694 && charpos
!= bytepos
)
1697 if (charpos
> bytepos
)
1700 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1703 BUF_PT_BYTE (buffer
) = bytepos
;
1704 BUF_PT (buffer
) = charpos
;
1707 /* Set point in BUFFER to CHARPOS. If the target position is
1708 before an intangible character, move to an ok place. */
1711 set_point (buffer
, charpos
)
1712 register struct buffer
*buffer
;
1713 register int charpos
;
1715 set_point_both (buffer
, charpos
, buf_charpos_to_bytepos (buffer
, charpos
));
1718 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1719 position BYTEPOS. If the target position is
1720 before an intangible character, move to an ok place. */
1723 set_point_both (buffer
, charpos
, bytepos
)
1724 register struct buffer
*buffer
;
1725 register int charpos
, bytepos
;
1727 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1729 register Lisp_Object obj
;
1730 int old_position
= BUF_PT (buffer
);
1731 int backwards
= (charpos
< old_position
? 1 : 0);
1733 int original_position
;
1735 buffer
->point_before_scroll
= Qnil
;
1737 if (charpos
== BUF_PT (buffer
))
1740 /* In a single-byte buffer, the two positions must be equal. */
1741 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1742 && charpos
!= bytepos
)
1745 /* Check this now, before checking if the buffer has any intervals.
1746 That way, we can catch conditions which break this sanity check
1747 whether or not there are intervals in the buffer. */
1748 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1751 have_overlays
= (! NILP (buffer
->overlays_before
)
1752 || ! NILP (buffer
->overlays_after
));
1754 /* If we have no text properties and overlays,
1755 then we can do it quickly. */
1756 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1758 temp_set_point_both (buffer
, charpos
, bytepos
);
1762 /* Set TO to the interval containing the char after CHARPOS,
1763 and TOPREV to the interval containing the char before CHARPOS.
1764 Either one may be null. They may be equal. */
1765 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1766 if (charpos
== BUF_BEGV (buffer
))
1768 else if (to
&& to
->position
== charpos
)
1769 toprev
= previous_interval (to
);
1773 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1774 ? BUF_ZV (buffer
) - 1
1777 /* Set FROM to the interval containing the char after PT,
1778 and FROMPREV to the interval containing the char before PT.
1779 Either one may be null. They may be equal. */
1780 /* We could cache this and save time. */
1781 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1782 if (buffer_point
== BUF_BEGV (buffer
))
1784 else if (from
&& from
->position
== BUF_PT (buffer
))
1785 fromprev
= previous_interval (from
);
1786 else if (buffer_point
!= BUF_PT (buffer
))
1787 fromprev
= from
, from
= 0;
1791 /* Moving within an interval. */
1792 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1795 temp_set_point_both (buffer
, charpos
, bytepos
);
1799 original_position
= charpos
;
1801 /* If the new position is between two intangible characters
1802 with the same intangible property value,
1803 move forward or backward until a change in that property. */
1804 if (NILP (Vinhibit_point_motion_hooks
)
1805 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1807 /* Intangibility never stops us from positioning at the beginning
1808 or end of the buffer, so don't bother checking in that case. */
1809 && charpos
!= BEGV
&& charpos
!= ZV
)
1811 Lisp_Object intangible_propval
;
1814 XSETINT (pos
, charpos
);
1818 intangible_propval
= Fget_char_property (make_number (charpos
),
1821 /* If following char is intangible,
1822 skip back over all chars with matching intangible property. */
1823 if (! NILP (intangible_propval
))
1824 while (XINT (pos
) > BUF_BEGV (buffer
)
1825 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1827 intangible_propval
))
1828 pos
= Fprevious_char_property_change (pos
, Qnil
);
1832 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
1835 /* If following char is intangible,
1836 skip back over all chars with matching intangible property. */
1837 if (! NILP (intangible_propval
))
1838 while (XINT (pos
) < BUF_ZV (buffer
)
1839 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1840 intangible_propval
))
1841 pos
= Fnext_char_property_change (pos
, Qnil
);
1845 charpos
= XINT (pos
);
1846 bytepos
= buf_charpos_to_bytepos (buffer
, charpos
);
1849 if (charpos
!= original_position
)
1851 /* Set TO to the interval containing the char after CHARPOS,
1852 and TOPREV to the interval containing the char before CHARPOS.
1853 Either one may be null. They may be equal. */
1854 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1855 if (charpos
== BUF_BEGV (buffer
))
1857 else if (to
&& to
->position
== charpos
)
1858 toprev
= previous_interval (to
);
1863 /* Here TO is the interval after the stopping point
1864 and TOPREV is the interval before the stopping point.
1865 One or the other may be null. */
1867 temp_set_point_both (buffer
, charpos
, bytepos
);
1869 /* We run point-left and point-entered hooks here, iff the
1870 two intervals are not equivalent. These hooks take
1871 (old_point, new_point) as arguments. */
1872 if (NILP (Vinhibit_point_motion_hooks
)
1873 && (! intervals_equal (from
, to
)
1874 || ! intervals_equal (fromprev
, toprev
)))
1876 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1879 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1883 leave_before
= textget (from
->plist
, Qpoint_left
);
1885 leave_before
= Qnil
;
1888 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1892 enter_before
= textget (to
->plist
, Qpoint_entered
);
1894 enter_before
= Qnil
;
1896 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1897 call2 (leave_before
, make_number (old_position
),
1898 make_number (charpos
));
1899 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1900 call2 (leave_after
, make_number (old_position
),
1901 make_number (charpos
));
1903 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1904 call2 (enter_before
, make_number (old_position
),
1905 make_number (charpos
));
1906 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1907 call2 (enter_after
, make_number (old_position
),
1908 make_number (charpos
));
1912 /* Move point to POSITION, unless POSITION is inside an intangible
1913 segment that reaches all the way to point. */
1916 move_if_not_intangible (position
)
1920 Lisp_Object intangible_propval
;
1922 XSETINT (pos
, position
);
1924 if (! NILP (Vinhibit_point_motion_hooks
))
1925 /* If intangible is inhibited, always move point to POSITION. */
1927 else if (PT
< position
&& XINT (pos
) < ZV
)
1929 /* We want to move forward, so check the text before POSITION. */
1931 intangible_propval
= Fget_char_property (pos
,
1934 /* If following char is intangible,
1935 skip back over all chars with matching intangible property. */
1936 if (! NILP (intangible_propval
))
1937 while (XINT (pos
) > BEGV
1938 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1940 intangible_propval
))
1941 pos
= Fprevious_char_property_change (pos
, Qnil
);
1943 else if (XINT (pos
) > BEGV
)
1945 /* We want to move backward, so check the text after POSITION. */
1947 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
1950 /* If following char is intangible,
1951 skip back over all chars with matching intangible property. */
1952 if (! NILP (intangible_propval
))
1953 while (XINT (pos
) < ZV
1954 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1955 intangible_propval
))
1956 pos
= Fnext_char_property_change (pos
, Qnil
);
1960 /* If the whole stretch between PT and POSITION isn't intangible,
1961 try moving to POSITION (which means we actually move farther
1962 if POSITION is inside of intangible text). */
1964 if (XINT (pos
) != PT
)
1968 /* Return the proper local map for position POSITION in BUFFER.
1969 Use the map specified by the local-map property, if any.
1970 Otherwise, use BUFFER's local map. */
1973 get_local_map (position
, buffer
)
1974 register int position
;
1975 register struct buffer
*buffer
;
1977 Lisp_Object prop
, tem
, lispy_position
, lispy_buffer
;
1978 int old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
1980 /* Perhaps we should just change `position' to the limit. */
1981 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1984 /* Ignore narrowing, so that a local map continues to be valid even if
1985 the visible region contains no characters and hence no properties. */
1986 old_begv
= BUF_BEGV (buffer
);
1987 old_zv
= BUF_ZV (buffer
);
1988 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
1989 old_zv_byte
= BUF_ZV_BYTE (buffer
);
1990 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
1991 BUF_ZV (buffer
) = BUF_Z (buffer
);
1992 BUF_BEGV_BYTE (buffer
) = BUF_BEG_BYTE (buffer
);
1993 BUF_ZV_BYTE (buffer
) = BUF_Z_BYTE (buffer
);
1995 /* There are no properties at the end of the buffer, so in that case
1996 check for a local map on the last character of the buffer instead. */
1997 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
1999 XSETFASTINT (lispy_position
, position
);
2000 XSETBUFFER (lispy_buffer
, buffer
);
2001 prop
= Fget_char_property (lispy_position
, Qlocal_map
, lispy_buffer
);
2003 BUF_BEGV (buffer
) = old_begv
;
2004 BUF_ZV (buffer
) = old_zv
;
2005 BUF_BEGV_BYTE (buffer
) = old_begv_byte
;
2006 BUF_ZV_BYTE (buffer
) = old_zv_byte
;
2008 /* Use the local map only if it is valid. */
2009 /* Do allow symbols that are defined as keymaps. */
2010 if (SYMBOLP (prop
) && !NILP (prop
))
2011 prop
= Findirect_function (prop
);
2013 && (tem
= Fkeymapp (prop
), !NILP (tem
)))
2016 return buffer
->keymap
;
2019 /* Produce an interval tree reflecting the intervals in
2020 TREE from START to START + LENGTH. */
2023 copy_intervals (tree
, start
, length
)
2027 register INTERVAL i
, new, t
;
2028 register int got
, prevlen
;
2030 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2031 return NULL_INTERVAL
;
2033 i
= find_interval (tree
, start
);
2034 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2037 /* If there is only one interval and it's the default, return nil. */
2038 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2039 && DEFAULT_INTERVAL_P (i
))
2040 return NULL_INTERVAL
;
2042 new = make_interval ();
2044 got
= (LENGTH (i
) - (start
- i
->position
));
2045 new->total_length
= length
;
2046 copy_properties (i
, new);
2050 while (got
< length
)
2052 i
= next_interval (i
);
2053 t
= split_interval_right (t
, prevlen
);
2054 copy_properties (i
, t
);
2055 prevlen
= LENGTH (i
);
2059 return balance_an_interval (new);
2062 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2065 copy_intervals_to_string (string
, buffer
, position
, length
)
2067 struct buffer
*buffer
;
2068 int position
, length
;
2070 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2072 if (NULL_INTERVAL_P (interval_copy
))
2075 interval_copy
->parent
= (INTERVAL
) XFASTINT (string
);
2076 XSTRING (string
)->intervals
= interval_copy
;
2079 /* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
2080 Assume they have identical characters. */
2083 compare_string_intervals (s1
, s2
)
2088 int end
= XSTRING (s1
)->size
+ 1;
2090 /* We specify 1 as position because the interval functions
2091 always use positions starting at 1. */
2092 i1
= find_interval (XSTRING (s1
)->intervals
, 1);
2093 i2
= find_interval (XSTRING (s2
)->intervals
, 1);
2097 /* Determine how far we can go before we reach the end of I1 or I2. */
2098 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2099 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2100 int distance
= min (len1
, len2
);
2102 /* If we ever find a mismatch between the strings,
2104 if (! intervals_equal (i1
, i2
))
2107 /* Advance POS till the end of the shorter interval,
2108 and advance one or both interval pointers for the new position. */
2110 if (len1
== distance
)
2111 i1
= next_interval (i1
);
2112 if (len2
== distance
)
2113 i2
= next_interval (i2
);
2118 /* Recursively adjust interval I in the current buffer
2119 for setting enable_multibyte_characters to MULTI_FLAG.
2120 The range of interval I is START ... END in characters,
2121 START_BYTE ... END_BYTE in bytes. */
2124 set_intervals_multibyte_1 (i
, multi_flag
, start
, start_byte
, end
, end_byte
)
2127 int start
, start_byte
, end
, end_byte
;
2129 INTERVAL left
, right
;
2131 /* Fix the length of this interval. */
2133 i
->total_length
= end
- start
;
2135 i
->total_length
= end_byte
- start_byte
;
2137 /* Recursively fix the length of the subintervals. */
2140 int left_end
, left_end_byte
;
2144 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2145 left_end
= BYTE_TO_CHAR (left_end_byte
);
2149 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2150 left_end_byte
= CHAR_TO_BYTE (left_end
);
2153 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2154 left_end
, left_end_byte
);
2158 int right_start_byte
, right_start
;
2162 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2163 right_start
= BYTE_TO_CHAR (right_start_byte
);
2167 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2168 right_start_byte
= CHAR_TO_BYTE (right_start
);
2171 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2172 right_start
, right_start_byte
,
2177 /* Update the intervals of the current buffer
2178 to fit the contents as multibyte (if MULTI_FLAG is 1)
2179 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2182 set_intervals_multibyte (multi_flag
)
2185 if (BUF_INTERVALS (current_buffer
))
2186 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer
), multi_flag
,
2187 BEG
, BEG_BYTE
, Z
, Z_BYTE
);
2190 #endif /* USE_TEXT_PROPERTIES */