1 /* Code for doing intervals.
2 Copyright (C) 1993-1995, 1997-1998, 2001-2012 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 3 of the License, or
9 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
22 Have to ensure that we can't put symbol nil on a plist, or some
23 functions may work incorrectly.
25 An idea: Have the owner of the tree keep count of splits and/or
26 insertion lengths (in intervals), and balance after every N.
28 Need to call *_left_hook when buffer is killed.
30 Scan for zero-length, or 0-length to see notes about handling
31 zero length interval-markers.
33 There are comments around about freeing intervals. It might be
34 faster to explicitly free them (put them on the free list) than
42 #define INTERVALS_INLINE EXTERN_INLINE
47 #include "intervals.h"
48 #include "character.h"
54 /* Test for membership, allowing for t (actually any non-cons) to mean the
57 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
59 static Lisp_Object
merge_properties_sticky (Lisp_Object
, Lisp_Object
);
60 static INTERVAL
merge_interval_right (INTERVAL
);
61 static INTERVAL
reproduce_tree (INTERVAL
, INTERVAL
);
63 /* Utility functions for intervals. */
65 /* Use these functions to set Lisp_Object
66 or pointer slots of struct interval. */
69 set_interval_object (INTERVAL i
, Lisp_Object obj
)
71 eassert (BUFFERP (obj
) || STRINGP (obj
));
77 set_interval_left (INTERVAL i
, INTERVAL left
)
83 set_interval_right (INTERVAL i
, INTERVAL right
)
88 /* Make the parent of D be whatever the parent of S is, regardless
89 of the type. This is used when balancing an interval tree. */
92 copy_interval_parent (INTERVAL d
, INTERVAL s
)
95 d
->up_obj
= s
->up_obj
;
98 /* Create the root interval of some object, a buffer or string. */
101 create_root_interval (Lisp_Object parent
)
105 CHECK_IMPURE (parent
);
107 new = make_interval ();
109 if (BUFFERP (parent
))
111 new->total_length
= (BUF_Z (XBUFFER (parent
))
112 - BUF_BEG (XBUFFER (parent
)));
113 eassert (0 <= TOTAL_LENGTH (new));
114 set_buffer_intervals (XBUFFER (parent
), new);
117 else if (STRINGP (parent
))
119 new->total_length
= SCHARS (parent
);
120 eassert (0 <= TOTAL_LENGTH (new));
121 set_string_intervals (parent
, new);
125 set_interval_object (new, parent
);
130 /* Make the interval TARGET have exactly the properties of SOURCE */
133 copy_properties (register INTERVAL source
, register INTERVAL target
)
135 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
138 COPY_INTERVAL_CACHE (source
, target
);
139 set_interval_plist (target
, Fcopy_sequence (source
->plist
));
142 /* Merge the properties of interval SOURCE into the properties
143 of interval TARGET. That is to say, each property in SOURCE
144 is added to TARGET if TARGET has no such property as yet. */
147 merge_properties (register INTERVAL source
, register INTERVAL target
)
149 register Lisp_Object o
, sym
, val
;
151 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
154 MERGE_INTERVAL_CACHE (source
, target
);
164 while (CONSP (val
) && !EQ (XCAR (val
), sym
))
175 set_interval_plist (target
, Fcons (sym
, Fcons (val
, target
->plist
)));
181 /* Return true if the two intervals have the same properties. */
184 intervals_equal (INTERVAL i0
, INTERVAL i1
)
186 Lisp_Object i0_cdr
, i0_sym
;
187 Lisp_Object i1_cdr
, i1_val
;
189 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
192 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
197 while (CONSP (i0_cdr
) && CONSP (i1_cdr
))
199 i0_sym
= XCAR (i0_cdr
);
200 i0_cdr
= XCDR (i0_cdr
);
202 return 0; /* abort (); */
204 while (CONSP (i1_val
) && !EQ (XCAR (i1_val
), i0_sym
))
206 i1_val
= XCDR (i1_val
);
208 return 0; /* abort (); */
209 i1_val
= XCDR (i1_val
);
212 /* i0 has something i1 doesn't. */
213 if (EQ (i1_val
, Qnil
))
216 /* i0 and i1 both have sym, but it has different values in each. */
218 || (i1_val
= XCDR (i1_val
), !CONSP (i1_val
))
219 || !EQ (XCAR (i1_val
), XCAR (i0_cdr
)))
222 i0_cdr
= XCDR (i0_cdr
);
224 i1_cdr
= XCDR (i1_cdr
);
226 return 0; /* abort (); */
227 i1_cdr
= XCDR (i1_cdr
);
230 /* Lengths of the two plists were equal. */
231 return (NILP (i0_cdr
) && NILP (i1_cdr
));
235 /* Traverse an interval tree TREE, performing FUNCTION on each node.
236 No guarantee is made about the order of traversal.
237 Pass FUNCTION two args: an interval, and ARG. */
240 traverse_intervals_noorder (INTERVAL tree
, void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
242 /* Minimize stack usage. */
245 (*function
) (tree
, arg
);
250 traverse_intervals_noorder (tree
->left
, function
, arg
);
256 /* Traverse an interval tree TREE, performing FUNCTION on each node.
257 Pass FUNCTION two args: an interval, and ARG. */
260 traverse_intervals (INTERVAL tree
, ptrdiff_t position
,
261 void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
265 traverse_intervals (tree
->left
, position
, function
, arg
);
266 position
+= LEFT_TOTAL_LENGTH (tree
);
267 tree
->position
= position
;
268 (*function
) (tree
, arg
);
269 position
+= LENGTH (tree
); tree
= tree
->right
;
277 static int zero_length
;
279 /* These functions are temporary, for debugging purposes only. */
281 INTERVAL search_interval
, found_interval
;
284 check_for_interval (INTERVAL i
)
286 if (i
== search_interval
)
294 search_for_interval (INTERVAL i
, INTERVAL tree
)
298 found_interval
= NULL
;
299 traverse_intervals_noorder (tree
, &check_for_interval
, Qnil
);
300 return found_interval
;
304 inc_interval_count (INTERVAL i
)
314 count_intervals (INTERVAL i
)
319 traverse_intervals_noorder (i
, &inc_interval_count
, Qnil
);
325 root_interval (INTERVAL interval
)
327 register INTERVAL i
= interval
;
329 while (! ROOT_INTERVAL_P (i
))
330 i
= INTERVAL_PARENT (i
);
336 /* Assuming that a left child exists, perform the following operation:
345 static inline INTERVAL
346 rotate_right (INTERVAL interval
)
349 INTERVAL B
= interval
->left
;
350 ptrdiff_t old_total
= interval
->total_length
;
352 /* Deal with any Parent of A; make it point to B. */
353 if (! ROOT_INTERVAL_P (interval
))
355 if (AM_LEFT_CHILD (interval
))
356 set_interval_left (INTERVAL_PARENT (interval
), B
);
358 set_interval_right (INTERVAL_PARENT (interval
), B
);
360 copy_interval_parent (B
, interval
);
362 /* Make B the parent of A */
364 set_interval_right (B
, interval
);
365 set_interval_parent (interval
, B
);
367 /* Make A point to c */
368 set_interval_left (interval
, i
);
370 set_interval_parent (i
, interval
);
372 /* A's total length is decreased by the length of B and its left child. */
373 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
374 eassert (0 <= TOTAL_LENGTH (interval
));
376 /* B must have the same total length of A. */
377 B
->total_length
= old_total
;
378 eassert (0 <= TOTAL_LENGTH (B
));
383 /* Assuming that a right child exists, perform the following operation:
392 static inline INTERVAL
393 rotate_left (INTERVAL interval
)
396 INTERVAL B
= interval
->right
;
397 ptrdiff_t old_total
= interval
->total_length
;
399 /* Deal with any parent of A; make it point to B. */
400 if (! ROOT_INTERVAL_P (interval
))
402 if (AM_LEFT_CHILD (interval
))
403 set_interval_left (INTERVAL_PARENT (interval
), B
);
405 set_interval_right (INTERVAL_PARENT (interval
), B
);
407 copy_interval_parent (B
, interval
);
409 /* Make B the parent of A */
411 set_interval_left (B
, interval
);
412 set_interval_parent (interval
, B
);
414 /* Make A point to c */
415 set_interval_right (interval
, i
);
417 set_interval_parent (i
, interval
);
419 /* A's total length is decreased by the length of B and its right child. */
420 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
421 eassert (0 <= TOTAL_LENGTH (interval
));
423 /* B must have the same total length of A. */
424 B
->total_length
= old_total
;
425 eassert (0 <= TOTAL_LENGTH (B
));
430 /* Balance an interval tree with the assumption that the subtrees
431 themselves are already balanced. */
434 balance_an_interval (INTERVAL i
)
436 register ptrdiff_t old_diff
, new_diff
;
440 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
443 /* Since the left child is longer, there must be one. */
444 new_diff
= i
->total_length
- i
->left
->total_length
445 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
446 if (eabs (new_diff
) >= old_diff
)
448 i
= rotate_right (i
);
449 balance_an_interval (i
->right
);
451 else if (old_diff
< 0)
453 /* Since the right child is longer, there must be one. */
454 new_diff
= i
->total_length
- i
->right
->total_length
455 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
456 if (eabs (new_diff
) >= -old_diff
)
459 balance_an_interval (i
->left
);
467 /* Balance INTERVAL, potentially stuffing it back into its parent
470 static inline INTERVAL
471 balance_possible_root_interval (INTERVAL interval
)
474 bool have_parent
= 0;
476 if (!INTERVAL_HAS_OBJECT (interval
) && !INTERVAL_HAS_PARENT (interval
))
479 if (INTERVAL_HAS_OBJECT (interval
))
482 GET_INTERVAL_OBJECT (parent
, interval
);
484 interval
= balance_an_interval (interval
);
488 if (BUFFERP (parent
))
489 set_buffer_intervals (XBUFFER (parent
), interval
);
490 else if (STRINGP (parent
))
491 set_string_intervals (parent
, interval
);
497 /* Balance the interval tree TREE. Balancing is by weight
498 (the amount of text). */
501 balance_intervals_internal (register INTERVAL tree
)
503 /* Balance within each side. */
505 balance_intervals_internal (tree
->left
);
507 balance_intervals_internal (tree
->right
);
508 return balance_an_interval (tree
);
511 /* Advertised interface to balance intervals. */
514 balance_intervals (INTERVAL tree
)
516 return tree
? balance_intervals_internal (tree
) : NULL
;
519 /* Rebalance text properties of B. */
522 buffer_balance_intervals (struct buffer
*b
)
527 i
= buffer_intervals (b
);
529 set_buffer_intervals (b
, balance_an_interval (i
));
532 /* Split INTERVAL into two pieces, starting the second piece at
533 character position OFFSET (counting from 0), relative to INTERVAL.
534 INTERVAL becomes the left-hand piece, and the right-hand piece
535 (second, lexicographically) is returned.
537 The size and position fields of the two intervals are set based upon
538 those of the original interval. The property list of the new interval
539 is reset, thus it is up to the caller to do the right thing with the
542 Note that this does not change the position of INTERVAL; if it is a root,
543 it is still a root after this operation. */
546 split_interval_right (INTERVAL interval
, ptrdiff_t offset
)
548 INTERVAL
new = make_interval ();
549 ptrdiff_t position
= interval
->position
;
550 ptrdiff_t new_length
= LENGTH (interval
) - offset
;
552 new->position
= position
+ offset
;
553 set_interval_parent (new, interval
);
555 if (NULL_RIGHT_CHILD (interval
))
557 set_interval_right (interval
, new);
558 new->total_length
= new_length
;
559 eassert (0 <= TOTAL_LENGTH (new));
563 /* Insert the new node between INTERVAL and its right child. */
564 set_interval_right (new, interval
->right
);
565 set_interval_parent (interval
->right
, new);
566 set_interval_right (interval
, new);
567 new->total_length
= new_length
+ new->right
->total_length
;
568 eassert (0 <= TOTAL_LENGTH (new));
569 balance_an_interval (new);
572 balance_possible_root_interval (interval
);
577 /* Split INTERVAL into two pieces, starting the second piece at
578 character position OFFSET (counting from 0), relative to INTERVAL.
579 INTERVAL becomes the right-hand piece, and the left-hand piece
580 (first, lexicographically) is returned.
582 The size and position fields of the two intervals are set based upon
583 those of the original interval. The property list of the new interval
584 is reset, thus it is up to the caller to do the right thing with the
587 Note that this does not change the position of INTERVAL; if it is a root,
588 it is still a root after this operation. */
591 split_interval_left (INTERVAL interval
, ptrdiff_t offset
)
593 INTERVAL
new = make_interval ();
594 ptrdiff_t new_length
= offset
;
596 new->position
= interval
->position
;
597 interval
->position
= interval
->position
+ offset
;
598 set_interval_parent (new, interval
);
600 if (NULL_LEFT_CHILD (interval
))
602 set_interval_left (interval
, new);
603 new->total_length
= new_length
;
604 eassert (0 <= TOTAL_LENGTH (new));
608 /* Insert the new node between INTERVAL and its left child. */
609 set_interval_left (new, interval
->left
);
610 set_interval_parent (new->left
, new);
611 set_interval_left (interval
, new);
612 new->total_length
= new_length
+ new->left
->total_length
;
613 eassert (0 <= TOTAL_LENGTH (new));
614 balance_an_interval (new);
617 balance_possible_root_interval (interval
);
622 /* Return the proper position for the first character
623 described by the interval tree SOURCE.
624 This is 1 if the parent is a buffer,
625 0 if the parent is a string or if there is no parent.
627 Don't use this function on an interval which is the child
628 of another interval! */
631 interval_start_pos (INTERVAL source
)
638 if (! INTERVAL_HAS_OBJECT (source
))
640 GET_INTERVAL_OBJECT (parent
, source
);
641 if (BUFFERP (parent
))
642 return BUF_BEG (XBUFFER (parent
));
646 /* Find the interval containing text position POSITION in the text
647 represented by the interval tree TREE. POSITION is a buffer
648 position (starting from 1) or a string index (starting from 0).
649 If POSITION is at the end of the buffer or string,
650 return the interval containing the last character.
652 The `position' field, which is a cache of an interval's position,
653 is updated in the interval found. Other functions (e.g., next_interval)
654 will update this cache based on the result of find_interval. */
657 find_interval (register INTERVAL tree
, register ptrdiff_t position
)
659 /* The distance from the left edge of the subtree at TREE
661 register ptrdiff_t relative_position
;
666 relative_position
= position
;
667 if (INTERVAL_HAS_OBJECT (tree
))
670 GET_INTERVAL_OBJECT (parent
, tree
);
671 if (BUFFERP (parent
))
672 relative_position
-= BUF_BEG (XBUFFER (parent
));
675 eassert (relative_position
<= TOTAL_LENGTH (tree
));
677 if (!handling_signal
)
678 tree
= balance_possible_root_interval (tree
);
682 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
686 else if (! NULL_RIGHT_CHILD (tree
)
687 && relative_position
>= (TOTAL_LENGTH (tree
)
688 - RIGHT_TOTAL_LENGTH (tree
)))
690 relative_position
-= (TOTAL_LENGTH (tree
)
691 - RIGHT_TOTAL_LENGTH (tree
));
697 = (position
- relative_position
/* left edge of *tree. */
698 + LEFT_TOTAL_LENGTH (tree
)); /* left edge of this interval. */
705 /* Find the succeeding interval (lexicographically) to INTERVAL.
706 Sets the `position' field based on that of INTERVAL (see
710 next_interval (register INTERVAL interval
)
712 register INTERVAL i
= interval
;
713 register ptrdiff_t next_position
;
717 next_position
= interval
->position
+ LENGTH (interval
);
719 if (! NULL_RIGHT_CHILD (i
))
722 while (! NULL_LEFT_CHILD (i
))
725 i
->position
= next_position
;
729 while (! NULL_PARENT (i
))
731 if (AM_LEFT_CHILD (i
))
733 i
= INTERVAL_PARENT (i
);
734 i
->position
= next_position
;
738 i
= INTERVAL_PARENT (i
);
744 /* Find the preceding interval (lexicographically) to INTERVAL.
745 Sets the `position' field based on that of INTERVAL (see
749 previous_interval (register INTERVAL interval
)
756 if (! NULL_LEFT_CHILD (interval
))
759 while (! NULL_RIGHT_CHILD (i
))
762 i
->position
= interval
->position
- LENGTH (i
);
767 while (! NULL_PARENT (i
))
769 if (AM_RIGHT_CHILD (i
))
771 i
= INTERVAL_PARENT (i
);
773 i
->position
= interval
->position
- LENGTH (i
);
776 i
= INTERVAL_PARENT (i
);
782 /* Find the interval containing POS given some non-NULL INTERVAL
783 in the same tree. Note that we need to update interval->position
784 if we go down the tree.
785 To speed up the process, we assume that the ->position of
786 I and all its parents is already uptodate. */
788 update_interval (register INTERVAL i
, ptrdiff_t pos
)
795 if (pos
< i
->position
)
798 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
800 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
801 + LEFT_TOTAL_LENGTH (i
->left
);
802 i
= i
->left
; /* Move to the left child */
804 else if (NULL_PARENT (i
))
805 error ("Point before start of properties");
807 i
= INTERVAL_PARENT (i
);
810 else if (pos
>= INTERVAL_LAST_POS (i
))
813 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
815 i
->right
->position
= INTERVAL_LAST_POS (i
)
816 + LEFT_TOTAL_LENGTH (i
->right
);
817 i
= i
->right
; /* Move to the right child */
819 else if (NULL_PARENT (i
))
820 error ("Point %"pD
"d after end of properties", pos
);
822 i
= INTERVAL_PARENT (i
);
830 /* Effect an adjustment corresponding to the addition of LENGTH characters
831 of text. Do this by finding the interval containing POSITION in the
832 interval tree TREE, and then adjusting all of its ancestors by adding
835 If POSITION is the first character of an interval, meaning that point
836 is actually between the two intervals, make the new text belong to
837 the interval which is "sticky".
839 If both intervals are "sticky", then make them belong to the left-most
840 interval. Another possibility would be to create a new interval for
841 this text, and make it have the merged properties of both ends. */
844 adjust_intervals_for_insertion (INTERVAL tree
,
845 ptrdiff_t position
, ptrdiff_t length
)
853 eassert (TOTAL_LENGTH (tree
) > 0);
855 GET_INTERVAL_OBJECT (parent
, tree
);
856 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
858 /* If inserting at point-max of a buffer, that position will be out
859 of range. Remember that buffer positions are 1-based. */
860 if (position
>= TOTAL_LENGTH (tree
) + offset
)
862 position
= TOTAL_LENGTH (tree
) + offset
;
866 i
= find_interval (tree
, position
);
868 /* If in middle of an interval which is not sticky either way,
869 we must not just give its properties to the insertion.
870 So split this interval at the insertion point.
872 Originally, the if condition here was this:
873 (! (position == i->position || eobp)
874 && END_NONSTICKY_P (i)
875 && FRONT_NONSTICKY_P (i))
876 But, these macros are now unreliable because of introduction of
877 Vtext_property_default_nonsticky. So, we always check properties
878 one by one if POSITION is in middle of an interval. */
879 if (! (position
== i
->position
|| eobp
))
882 Lisp_Object front
, rear
;
886 /* Properties font-sticky and rear-nonsticky override
887 Vtext_property_default_nonsticky. So, if they are t, we can
888 skip one by one checking of properties. */
889 rear
= textget (i
->plist
, Qrear_nonsticky
);
890 if (! CONSP (rear
) && ! NILP (rear
))
892 /* All properties are nonsticky. We split the interval. */
895 front
= textget (i
->plist
, Qfront_sticky
);
896 if (! CONSP (front
) && ! NILP (front
))
898 /* All properties are sticky. We don't split the interval. */
903 /* Does any actual property pose an actual problem? We break
904 the loop if we find a nonsticky property. */
905 for (; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
907 Lisp_Object prop
, tmp
;
910 /* Is this particular property front-sticky? */
911 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
914 /* Is this particular property rear-nonsticky? */
915 if (CONSP (rear
) && ! NILP (Fmemq (prop
, rear
)))
918 /* Is this particular property recorded as sticky or
919 nonsticky in Vtext_property_default_nonsticky? */
920 tmp
= Fassq (prop
, Vtext_property_default_nonsticky
);
928 /* By default, a text property is rear-sticky, thus we
929 continue the loop. */
933 /* If any property is a real problem, split the interval. */
936 temp
= split_interval_right (i
, position
- i
->position
);
937 copy_properties (i
, temp
);
942 /* If we are positioned between intervals, check the stickiness of
943 both of them. We have to do this too, if we are at BEG or Z. */
944 if (position
== i
->position
|| eobp
)
946 register INTERVAL prev
;
956 prev
= previous_interval (i
);
958 /* Even if we are positioned between intervals, we default
959 to the left one if it exists. We extend it now and split
960 off a part later, if stickiness demands it. */
961 for (temp
= prev
? prev
: i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
963 temp
->total_length
+= length
;
964 eassert (0 <= TOTAL_LENGTH (temp
));
965 temp
= balance_possible_root_interval (temp
);
968 /* If at least one interval has sticky properties,
969 we check the stickiness property by property.
971 Originally, the if condition here was this:
972 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
973 But, these macros are now unreliable because of introduction
974 of Vtext_property_default_nonsticky. So, we always have to
975 check stickiness of properties one by one. If cache of
976 stickiness is implemented in the future, we may be able to
977 use those macros again. */
980 Lisp_Object pleft
, pright
;
981 struct interval newi
;
983 RESET_INTERVAL (&newi
);
984 pleft
= prev
? prev
->plist
: Qnil
;
985 pright
= i
? i
->plist
: Qnil
;
986 set_interval_plist (&newi
, merge_properties_sticky (pleft
, pright
));
988 if (! prev
) /* i.e. position == BEG */
990 if (! intervals_equal (i
, &newi
))
992 i
= split_interval_left (i
, length
);
993 set_interval_plist (i
, newi
.plist
);
996 else if (! intervals_equal (prev
, &newi
))
998 prev
= split_interval_right (prev
, position
- prev
->position
);
999 set_interval_plist (prev
, newi
.plist
);
1000 if (i
&& intervals_equal (prev
, i
))
1001 merge_interval_right (prev
);
1004 /* We will need to update the cache here later. */
1006 else if (! prev
&& ! NILP (i
->plist
))
1008 /* Just split off a new interval at the left.
1009 Since I wasn't front-sticky, the empty plist is ok. */
1010 i
= split_interval_left (i
, length
);
1014 /* Otherwise just extend the interval. */
1017 for (temp
= i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
1019 temp
->total_length
+= length
;
1020 eassert (0 <= TOTAL_LENGTH (temp
));
1021 temp
= balance_possible_root_interval (temp
);
1028 /* Any property might be front-sticky on the left, rear-sticky on the left,
1029 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1030 can be arranged in a matrix with rows denoting the left conditions and
1031 columns denoting the right conditions:
1039 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1040 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1041 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1042 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1043 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1044 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1045 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1046 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1048 We inherit from whoever has a sticky side facing us. If both sides
1049 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1050 non-nil value for the current property. If both sides do, then we take
1053 When we inherit a property, we get its stickiness as well as its value.
1054 So, when we merge the above two lists, we expect to get this:
1056 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1057 rear-nonsticky (p6 pa)
1058 p0 L p1 L p2 L p3 L p6 R p7 R
1059 pa R pb R pc L pd L pe L pf L)
1061 The optimizable special cases are:
1062 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1063 left rear-nonsticky = t, right front-sticky = t (inherit right)
1064 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1068 merge_properties_sticky (Lisp_Object pleft
, Lisp_Object pright
)
1070 Lisp_Object props
, front
, rear
;
1071 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1072 Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1073 bool use_left
, use_right
, lpresent
;
1078 lfront
= textget (pleft
, Qfront_sticky
);
1079 lrear
= textget (pleft
, Qrear_nonsticky
);
1080 rfront
= textget (pright
, Qfront_sticky
);
1081 rrear
= textget (pright
, Qrear_nonsticky
);
1083 /* Go through each element of PRIGHT. */
1084 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1090 /* Sticky properties get special treatment. */
1091 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1094 rval
= Fcar (XCDR (tail1
));
1095 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1096 if (EQ (sym
, XCAR (tail2
)))
1099 /* Indicate whether the property is explicitly defined on the left.
1100 (We know it is defined explicitly on the right
1101 because otherwise we don't get here.) */
1102 lpresent
= ! NILP (tail2
);
1103 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1105 /* Even if lrear or rfront say nothing about the stickiness of
1106 SYM, Vtext_property_default_nonsticky may give default
1107 stickiness to SYM. */
1108 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1109 use_left
= (lpresent
1110 && ! (TMEM (sym
, lrear
)
1111 || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))));
1112 use_right
= (TMEM (sym
, rfront
)
1113 || (CONSP (tmp
) && NILP (XCDR (tmp
))));
1114 if (use_left
&& use_right
)
1118 else if (NILP (rval
))
1123 /* We build props as (value sym ...) rather than (sym value ...)
1124 because we plan to nreverse it when we're done. */
1125 props
= Fcons (lval
, Fcons (sym
, props
));
1126 if (TMEM (sym
, lfront
))
1127 front
= Fcons (sym
, front
);
1128 if (TMEM (sym
, lrear
))
1129 rear
= Fcons (sym
, rear
);
1133 props
= Fcons (rval
, Fcons (sym
, props
));
1134 if (TMEM (sym
, rfront
))
1135 front
= Fcons (sym
, front
);
1136 if (TMEM (sym
, rrear
))
1137 rear
= Fcons (sym
, rear
);
1141 /* Now go through each element of PLEFT. */
1142 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1148 /* Sticky properties get special treatment. */
1149 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1152 /* If sym is in PRIGHT, we've already considered it. */
1153 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1154 if (EQ (sym
, XCAR (tail1
)))
1159 lval
= Fcar (XCDR (tail2
));
1161 /* Even if lrear or rfront say nothing about the stickiness of
1162 SYM, Vtext_property_default_nonsticky may give default
1163 stickiness to SYM. */
1164 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1166 /* Since rval is known to be nil in this loop, the test simplifies. */
1167 if (! (TMEM (sym
, lrear
) || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))))
1169 props
= Fcons (lval
, Fcons (sym
, props
));
1170 if (TMEM (sym
, lfront
))
1171 front
= Fcons (sym
, front
);
1173 else if (TMEM (sym
, rfront
) || (CONSP (tmp
) && NILP (XCDR (tmp
))))
1175 /* The value is nil, but we still inherit the stickiness
1177 front
= Fcons (sym
, front
);
1178 if (TMEM (sym
, rrear
))
1179 rear
= Fcons (sym
, rear
);
1182 props
= Fnreverse (props
);
1184 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1186 cat
= textget (props
, Qcategory
);
1189 /* If we have inherited a front-stick category property that is t,
1190 we don't need to set up a detailed one. */
1191 ! (! NILP (cat
) && SYMBOLP (cat
)
1192 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1193 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1198 /* Delete a node I from its interval tree by merging its subtrees
1199 into one subtree which is then returned. Caller is responsible for
1200 storing the resulting subtree into its parent. */
1203 delete_node (register INTERVAL i
)
1205 register INTERVAL migrate
, this;
1206 register ptrdiff_t migrate_amt
;
1214 migrate_amt
= i
->left
->total_length
;
1216 this->total_length
+= migrate_amt
;
1220 this->total_length
+= migrate_amt
;
1222 eassert (0 <= TOTAL_LENGTH (this));
1223 set_interval_left (this, migrate
);
1224 set_interval_parent (migrate
, this);
1229 /* Delete interval I from its tree by calling `delete_node'
1230 and properly connecting the resultant subtree.
1232 I is presumed to be empty; that is, no adjustments are made
1233 for the length of I. */
1236 delete_interval (register INTERVAL i
)
1238 register INTERVAL parent
;
1239 ptrdiff_t amt
= LENGTH (i
);
1241 eassert (amt
== 0); /* Only used on zero-length intervals now. */
1243 if (ROOT_INTERVAL_P (i
))
1246 GET_INTERVAL_OBJECT (owner
, i
);
1247 parent
= delete_node (i
);
1249 set_interval_object (parent
, owner
);
1251 if (BUFFERP (owner
))
1252 set_buffer_intervals (XBUFFER (owner
), parent
);
1253 else if (STRINGP (owner
))
1254 set_string_intervals (owner
, parent
);
1261 parent
= INTERVAL_PARENT (i
);
1262 if (AM_LEFT_CHILD (i
))
1264 set_interval_left (parent
, delete_node (i
));
1266 set_interval_parent (parent
->left
, parent
);
1270 set_interval_right (parent
, delete_node (i
));
1272 set_interval_parent (parent
->right
, parent
);
1276 /* Find the interval in TREE corresponding to the relative position
1277 FROM and delete as much as possible of AMOUNT from that interval.
1278 Return the amount actually deleted, and if the interval was
1279 zeroed-out, delete that interval node from the tree.
1281 Note that FROM is actually origin zero, aka relative to the
1282 leftmost edge of tree. This is appropriate since we call ourselves
1283 recursively on subtrees.
1285 Do this by recursing down TREE to the interval in question, and
1286 deleting the appropriate amount of text. */
1289 interval_deletion_adjustment (register INTERVAL tree
, register ptrdiff_t from
,
1290 register ptrdiff_t amount
)
1292 register ptrdiff_t relative_position
= from
;
1298 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1300 ptrdiff_t subtract
= interval_deletion_adjustment (tree
->left
,
1303 tree
->total_length
-= subtract
;
1304 eassert (0 <= TOTAL_LENGTH (tree
));
1308 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1309 - RIGHT_TOTAL_LENGTH (tree
)))
1313 relative_position
-= (tree
->total_length
1314 - RIGHT_TOTAL_LENGTH (tree
));
1315 subtract
= interval_deletion_adjustment (tree
->right
,
1318 tree
->total_length
-= subtract
;
1319 eassert (0 <= TOTAL_LENGTH (tree
));
1322 /* Here -- this node. */
1325 /* How much can we delete from this interval? */
1326 ptrdiff_t my_amount
= ((tree
->total_length
1327 - RIGHT_TOTAL_LENGTH (tree
))
1328 - relative_position
);
1330 if (amount
> my_amount
)
1333 tree
->total_length
-= amount
;
1334 eassert (0 <= TOTAL_LENGTH (tree
));
1335 if (LENGTH (tree
) == 0)
1336 delete_interval (tree
);
1341 /* Never reach here. */
1344 /* Effect the adjustments necessary to the interval tree of BUFFER to
1345 correspond to the deletion of LENGTH characters from that buffer
1346 text. The deletion is effected at position START (which is a
1347 buffer position, i.e. origin 1). */
1350 adjust_intervals_for_deletion (struct buffer
*buffer
,
1351 ptrdiff_t start
, ptrdiff_t length
)
1353 ptrdiff_t left_to_delete
= length
;
1354 INTERVAL tree
= buffer_intervals (buffer
);
1358 GET_INTERVAL_OBJECT (parent
, tree
);
1359 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1364 eassert (start
<= offset
+ TOTAL_LENGTH (tree
)
1365 && start
+ length
<= offset
+ TOTAL_LENGTH (tree
));
1367 if (length
== TOTAL_LENGTH (tree
))
1369 set_buffer_intervals (buffer
, NULL
);
1373 if (ONLY_INTERVAL_P (tree
))
1375 tree
->total_length
-= length
;
1376 eassert (0 <= TOTAL_LENGTH (tree
));
1380 if (start
> offset
+ TOTAL_LENGTH (tree
))
1381 start
= offset
+ TOTAL_LENGTH (tree
);
1382 while (left_to_delete
> 0)
1384 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1386 tree
= buffer_intervals (buffer
);
1387 if (left_to_delete
== tree
->total_length
)
1389 set_buffer_intervals (buffer
, NULL
);
1395 /* Make the adjustments necessary to the interval tree of BUFFER to
1396 represent an addition or deletion of LENGTH characters starting
1397 at position START. Addition or deletion is indicated by the sign
1401 offset_intervals (struct buffer
*buffer
, ptrdiff_t start
, ptrdiff_t length
)
1403 if (!buffer_intervals (buffer
) || length
== 0)
1407 adjust_intervals_for_insertion (buffer_intervals (buffer
),
1411 IF_LINT (if (length
< - TYPE_MAXIMUM (ptrdiff_t)) abort ();)
1412 adjust_intervals_for_deletion (buffer
, start
, -length
);
1416 /* Merge interval I with its lexicographic successor. The resulting
1417 interval is returned, and has the properties of the original
1418 successor. The properties of I are lost. I is removed from the
1422 The caller must verify that this is not the last (rightmost)
1426 merge_interval_right (register INTERVAL i
)
1428 register ptrdiff_t absorb
= LENGTH (i
);
1429 register INTERVAL successor
;
1431 /* Find the succeeding interval. */
1432 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1435 successor
= i
->right
;
1436 while (! NULL_LEFT_CHILD (successor
))
1438 successor
->total_length
+= absorb
;
1439 eassert (0 <= TOTAL_LENGTH (successor
));
1440 successor
= successor
->left
;
1443 successor
->total_length
+= absorb
;
1444 eassert (0 <= TOTAL_LENGTH (successor
));
1445 delete_interval (i
);
1449 /* Zero out this interval. */
1450 i
->total_length
-= absorb
;
1451 eassert (0 <= TOTAL_LENGTH (i
));
1454 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1457 if (AM_LEFT_CHILD (successor
))
1459 successor
= INTERVAL_PARENT (successor
);
1460 delete_interval (i
);
1464 successor
= INTERVAL_PARENT (successor
);
1465 successor
->total_length
-= absorb
;
1466 eassert (0 <= TOTAL_LENGTH (successor
));
1469 /* This must be the rightmost or last interval and cannot
1470 be merged right. The caller should have known. */
1474 /* Merge interval I with its lexicographic predecessor. The resulting
1475 interval is returned, and has the properties of the original predecessor.
1476 The properties of I are lost. Interval node I is removed from the tree.
1479 The caller must verify that this is not the first (leftmost) interval. */
1482 merge_interval_left (register INTERVAL i
)
1484 register ptrdiff_t absorb
= LENGTH (i
);
1485 register INTERVAL predecessor
;
1487 /* Find the preceding interval. */
1488 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1489 adding ABSORB as we go. */
1491 predecessor
= i
->left
;
1492 while (! NULL_RIGHT_CHILD (predecessor
))
1494 predecessor
->total_length
+= absorb
;
1495 eassert (0 <= TOTAL_LENGTH (predecessor
));
1496 predecessor
= predecessor
->right
;
1499 predecessor
->total_length
+= absorb
;
1500 eassert (0 <= TOTAL_LENGTH (predecessor
));
1501 delete_interval (i
);
1505 /* Zero out this interval. */
1506 i
->total_length
-= absorb
;
1507 eassert (0 <= TOTAL_LENGTH (i
));
1510 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1511 subtracting ABSORB. */
1513 if (AM_RIGHT_CHILD (predecessor
))
1515 predecessor
= INTERVAL_PARENT (predecessor
);
1516 delete_interval (i
);
1520 predecessor
= INTERVAL_PARENT (predecessor
);
1521 predecessor
->total_length
-= absorb
;
1522 eassert (0 <= TOTAL_LENGTH (predecessor
));
1525 /* This must be the leftmost or first interval and cannot
1526 be merged left. The caller should have known. */
1530 /* Create a copy of SOURCE but with the default value of UP. */
1533 reproduce_interval (INTERVAL source
)
1535 register INTERVAL target
= make_interval ();
1537 target
->total_length
= source
->total_length
;
1538 target
->position
= source
->position
;
1540 copy_properties (source
, target
);
1542 if (! NULL_LEFT_CHILD (source
))
1543 set_interval_left (target
, reproduce_tree (source
->left
, target
));
1544 if (! NULL_RIGHT_CHILD (source
))
1545 set_interval_right (target
, reproduce_tree (source
->right
, target
));
1550 /* Make an exact copy of interval tree SOURCE which descends from
1551 PARENT. This is done by recursing through SOURCE, copying
1552 the current interval and its properties, and then adjusting
1553 the pointers of the copy. */
1556 reproduce_tree (INTERVAL source
, INTERVAL parent
)
1558 INTERVAL target
= reproduce_interval (source
);
1559 set_interval_parent (target
, parent
);
1564 reproduce_tree_obj (INTERVAL source
, Lisp_Object parent
)
1566 INTERVAL target
= reproduce_interval (source
);
1567 set_interval_object (target
, parent
);
1571 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1572 LENGTH is the length of the text in SOURCE.
1574 The `position' field of the SOURCE intervals is assumed to be
1575 consistent with its parent; therefore, SOURCE must be an
1576 interval tree made with copy_interval or must be the whole
1577 tree of a buffer or a string.
1579 This is used in insdel.c when inserting Lisp_Strings into the
1580 buffer. The text corresponding to SOURCE is already in the buffer
1581 when this is called. The intervals of new tree are a copy of those
1582 belonging to the string being inserted; intervals are never
1585 If the inserted text had no intervals associated, and we don't
1586 want to inherit the surrounding text's properties, this function
1587 simply returns -- offset_intervals should handle placing the
1588 text in the correct interval, depending on the sticky bits.
1590 If the inserted text had properties (intervals), then there are two
1591 cases -- either insertion happened in the middle of some interval,
1592 or between two intervals.
1594 If the text goes into the middle of an interval, then new intervals
1595 are created in the middle, and new text has the union of its properties
1596 and those of the text into which it was inserted.
1598 If the text goes between two intervals, then if neither interval
1599 had its appropriate sticky property set (front_sticky, rear_sticky),
1600 the new text has only its properties. If one of the sticky properties
1601 is set, then the new text "sticks" to that region and its properties
1602 depend on merging as above. If both the preceding and succeeding
1603 intervals to the new text are "sticky", then the new text retains
1604 only its properties, as if neither sticky property were set. Perhaps
1605 we should consider merging all three sets of properties onto the new
1609 graft_intervals_into_buffer (INTERVAL source
, ptrdiff_t position
,
1610 ptrdiff_t length
, struct buffer
*buffer
,
1613 INTERVAL tree
= buffer_intervals (buffer
);
1614 INTERVAL under
, over
, this;
1615 ptrdiff_t over_used
;
1617 /* If the new text has no properties, then with inheritance it
1618 becomes part of whatever interval it was inserted into.
1619 To prevent inheritance, we must clear out the properties
1620 of the newly inserted text. */
1624 if (!inherit
&& tree
&& length
> 0)
1626 XSETBUFFER (buf
, buffer
);
1627 set_text_properties_1 (make_number (position
),
1628 make_number (position
+ length
),
1631 /* Shouldn't be necessary. --Stef */
1632 buffer_balance_intervals (buffer
);
1636 eassert (length
== TOTAL_LENGTH (source
));
1638 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == length
)
1640 /* The inserted text constitutes the whole buffer, so
1641 simply copy over the interval structure. */
1644 XSETBUFFER (buf
, buffer
);
1645 set_buffer_intervals (buffer
, reproduce_tree_obj (source
, buf
));
1646 buffer_intervals (buffer
)->position
= BUF_BEG (buffer
);
1647 eassert (buffer_intervals (buffer
)->up_obj
== 1);
1652 /* Create an interval tree in which to place a copy
1653 of the intervals of the inserted string. */
1656 XSETBUFFER (buf
, buffer
);
1657 tree
= create_root_interval (buf
);
1659 /* Paranoia -- the text has already been added, so
1660 this buffer should be of non-zero length. */
1661 eassert (TOTAL_LENGTH (tree
) > 0);
1663 this = under
= find_interval (tree
, position
);
1665 over
= find_interval (source
, interval_start_pos (source
));
1667 /* Here for insertion in the middle of an interval.
1668 Split off an equivalent interval to the right,
1669 then don't bother with it any more. */
1671 if (position
> under
->position
)
1673 INTERVAL end_unchanged
1674 = split_interval_left (this, position
- under
->position
);
1675 copy_properties (under
, end_unchanged
);
1676 under
->position
= position
;
1680 /* This call may have some effect because previous_interval may
1681 update `position' fields of intervals. Thus, don't ignore it
1682 for the moment. Someone please tell me the truth (K.Handa). */
1683 INTERVAL prev
= previous_interval (under
);
1686 /* But, this code surely has no effect. And, anyway,
1687 END_NONSTICKY_P is unreliable now. */
1688 if (prev
&& !END_NONSTICKY_P (prev
))
1693 /* Insertion is now at beginning of UNDER. */
1695 /* The inserted text "sticks" to the interval `under',
1696 which means it gets those properties.
1697 The properties of under are the result of
1698 adjust_intervals_for_insertion, so stickiness has
1699 already been taken care of. */
1701 /* OVER is the interval we are copying from next.
1702 OVER_USED says how many characters' worth of OVER
1703 have already been copied into target intervals.
1704 UNDER is the next interval in the target. */
1708 /* If UNDER is longer than OVER, split it. */
1709 if (LENGTH (over
) - over_used
< LENGTH (under
))
1711 this = split_interval_left (under
, LENGTH (over
) - over_used
);
1712 copy_properties (under
, this);
1717 /* THIS is now the interval to copy or merge into.
1718 OVER covers all of it. */
1720 merge_properties (over
, this);
1722 copy_properties (over
, this);
1724 /* If THIS and OVER end at the same place,
1725 advance OVER to a new source interval. */
1726 if (LENGTH (this) == LENGTH (over
) - over_used
)
1728 over
= next_interval (over
);
1732 /* Otherwise just record that more of OVER has been used. */
1733 over_used
+= LENGTH (this);
1735 /* Always advance to a new target interval. */
1736 under
= next_interval (this);
1739 buffer_balance_intervals (buffer
);
1742 /* Get the value of property PROP from PLIST,
1743 which is the plist of an interval.
1744 We check for direct properties, for categories with property PROP,
1745 and for PROP appearing on the default-text-properties list. */
1748 textget (Lisp_Object plist
, register Lisp_Object prop
)
1750 return lookup_char_property (plist
, prop
, 1);
1754 lookup_char_property (Lisp_Object plist
, Lisp_Object prop
, bool textprop
)
1756 Lisp_Object tail
, fallback
= Qnil
;
1758 for (tail
= plist
; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
1760 register Lisp_Object tem
;
1763 return Fcar (XCDR (tail
));
1764 if (EQ (tem
, Qcategory
))
1766 tem
= Fcar (XCDR (tail
));
1768 fallback
= Fget (tem
, prop
);
1772 if (! NILP (fallback
))
1774 /* Check for alternative properties */
1775 tail
= Fassq (prop
, Vchar_property_alias_alist
);
1779 for (; NILP (fallback
) && CONSP (tail
); tail
= XCDR (tail
))
1780 fallback
= Fplist_get (plist
, XCAR (tail
));
1783 if (textprop
&& NILP (fallback
) && CONSP (Vdefault_text_properties
))
1784 fallback
= Fplist_get (Vdefault_text_properties
, prop
);
1789 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1790 byte position BYTEPOS. */
1793 temp_set_point_both (struct buffer
*buffer
,
1794 ptrdiff_t charpos
, ptrdiff_t bytepos
)
1796 /* In a single-byte buffer, the two positions must be equal. */
1797 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
))
1798 eassert (charpos
== bytepos
);
1800 eassert (charpos
<= bytepos
);
1801 eassert (charpos
<= BUF_ZV (buffer
) || BUF_BEGV (buffer
) <= charpos
);
1803 SET_BUF_PT_BOTH (buffer
, charpos
, bytepos
);
1806 /* Set point "temporarily", without checking any text properties. */
1809 temp_set_point (struct buffer
*buffer
, ptrdiff_t charpos
)
1811 temp_set_point_both (buffer
, charpos
,
1812 buf_charpos_to_bytepos (buffer
, charpos
));
1815 /* Set point in BUFFER to CHARPOS. If the target position is
1816 before an intangible character, move to an ok place. */
1819 set_point (ptrdiff_t charpos
)
1821 set_point_both (charpos
, buf_charpos_to_bytepos (current_buffer
, charpos
));
1824 /* If there's an invisible character at position POS + TEST_OFFS in the
1825 current buffer, and the invisible property has a `stickiness' such that
1826 inserting a character at position POS would inherit the property it,
1827 return POS + ADJ, otherwise return POS. If TEST_INTANG, intangibility
1828 is required as well as invisibility.
1830 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1832 Note that `stickiness' is determined by overlay marker insertion types,
1833 if the invisible property comes from an overlay. */
1836 adjust_for_invis_intang (ptrdiff_t pos
, ptrdiff_t test_offs
, ptrdiff_t adj
,
1839 Lisp_Object invis_propval
, invis_overlay
;
1840 Lisp_Object test_pos
;
1842 if ((adj
< 0 && pos
+ adj
< BEGV
) || (adj
> 0 && pos
+ adj
> ZV
))
1843 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1846 test_pos
= make_number (pos
+ test_offs
);
1849 = get_char_property_and_overlay (test_pos
, Qinvisible
, Qnil
,
1853 || ! NILP (Fget_char_property (test_pos
, Qintangible
, Qnil
)))
1854 && TEXT_PROP_MEANS_INVISIBLE (invis_propval
)
1855 /* This next test is true if the invisible property has a stickiness
1856 such that an insertion at POS would inherit it. */
1857 && (NILP (invis_overlay
)
1858 /* Invisible property is from a text-property. */
1859 ? (text_property_stickiness (Qinvisible
, make_number (pos
), Qnil
)
1860 == (test_offs
== 0 ? 1 : -1))
1861 /* Invisible property is from an overlay. */
1863 ? XMARKER (OVERLAY_START (invis_overlay
))->insertion_type
== 0
1864 : XMARKER (OVERLAY_END (invis_overlay
))->insertion_type
== 1)))
1870 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1871 position BYTEPOS. If the target position is
1872 before an intangible character, move to an ok place. */
1875 set_point_both (ptrdiff_t charpos
, ptrdiff_t bytepos
)
1877 register INTERVAL to
, from
, toprev
, fromprev
;
1878 ptrdiff_t buffer_point
;
1879 ptrdiff_t old_position
= PT
;
1880 /* This ensures that we move forward past intangible text when the
1881 initial position is the same as the destination, in the rare
1882 instances where this is important, e.g. in line-move-finish
1884 bool backwards
= charpos
< old_position
;
1886 ptrdiff_t original_position
;
1888 bset_point_before_scroll (current_buffer
, Qnil
);
1893 /* In a single-byte buffer, the two positions must be equal. */
1894 eassert (ZV
!= ZV_BYTE
|| charpos
== bytepos
);
1896 /* Check this now, before checking if the buffer has any intervals.
1897 That way, we can catch conditions which break this sanity check
1898 whether or not there are intervals in the buffer. */
1899 eassert (charpos
<= ZV
&& charpos
>= BEGV
);
1901 have_overlays
= buffer_has_overlays ();
1903 /* If we have no text properties and overlays,
1904 then we can do it quickly. */
1905 if (!buffer_intervals (current_buffer
) && ! have_overlays
)
1907 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1911 /* Set TO to the interval containing the char after CHARPOS,
1912 and TOPREV to the interval containing the char before CHARPOS.
1913 Either one may be null. They may be equal. */
1914 to
= find_interval (buffer_intervals (current_buffer
), charpos
);
1915 if (charpos
== BEGV
)
1917 else if (to
&& to
->position
== charpos
)
1918 toprev
= previous_interval (to
);
1922 buffer_point
= (PT
== ZV
? ZV
- 1 : PT
);
1924 /* Set FROM to the interval containing the char after PT,
1925 and FROMPREV to the interval containing the char before PT.
1926 Either one may be null. They may be equal. */
1927 /* We could cache this and save time. */
1928 from
= find_interval (buffer_intervals (current_buffer
), buffer_point
);
1929 if (buffer_point
== BEGV
)
1931 else if (from
&& from
->position
== PT
)
1932 fromprev
= previous_interval (from
);
1933 else if (buffer_point
!= PT
)
1934 fromprev
= from
, from
= 0;
1938 /* Moving within an interval. */
1939 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1942 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1946 original_position
= charpos
;
1948 /* If the new position is between two intangible characters
1949 with the same intangible property value,
1950 move forward or backward until a change in that property. */
1951 if (NILP (Vinhibit_point_motion_hooks
)
1954 /* Intangibility never stops us from positioning at the beginning
1955 or end of the buffer, so don't bother checking in that case. */
1956 && charpos
!= BEGV
&& charpos
!= ZV
)
1959 Lisp_Object intangible_propval
;
1963 /* If the preceding character is both intangible and invisible,
1964 and the invisible property is `rear-sticky', perturb it so
1965 that the search starts one character earlier -- this ensures
1966 that point can never move to the end of an invisible/
1967 intangible/rear-sticky region. */
1968 charpos
= adjust_for_invis_intang (charpos
, -1, -1, 1);
1970 XSETINT (pos
, charpos
);
1972 /* If following char is intangible,
1973 skip back over all chars with matching intangible property. */
1975 intangible_propval
= Fget_char_property (pos
, Qintangible
, Qnil
);
1977 if (! NILP (intangible_propval
))
1979 while (XINT (pos
) > BEGV
1980 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1982 intangible_propval
))
1983 pos
= Fprevious_char_property_change (pos
, Qnil
);
1985 /* Set CHARPOS from POS, and if the final intangible character
1986 that we skipped over is also invisible, and the invisible
1987 property is `front-sticky', perturb it to be one character
1988 earlier -- this ensures that point can never move to the
1989 beginning of an invisible/intangible/front-sticky region. */
1990 charpos
= adjust_for_invis_intang (XINT (pos
), 0, -1, 0);
1995 /* If the following character is both intangible and invisible,
1996 and the invisible property is `front-sticky', perturb it so
1997 that the search starts one character later -- this ensures
1998 that point can never move to the beginning of an
1999 invisible/intangible/front-sticky region. */
2000 charpos
= adjust_for_invis_intang (charpos
, 0, 1, 1);
2002 XSETINT (pos
, charpos
);
2004 /* If preceding char is intangible,
2005 skip forward over all chars with matching intangible property. */
2007 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
2010 if (! NILP (intangible_propval
))
2012 while (XINT (pos
) < ZV
2013 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2014 intangible_propval
))
2015 pos
= Fnext_char_property_change (pos
, Qnil
);
2017 /* Set CHARPOS from POS, and if the final intangible character
2018 that we skipped over is also invisible, and the invisible
2019 property is `rear-sticky', perturb it to be one character
2020 later -- this ensures that point can never move to the
2021 end of an invisible/intangible/rear-sticky region. */
2022 charpos
= adjust_for_invis_intang (XINT (pos
), -1, 1, 0);
2026 bytepos
= buf_charpos_to_bytepos (current_buffer
, charpos
);
2029 if (charpos
!= original_position
)
2031 /* Set TO to the interval containing the char after CHARPOS,
2032 and TOPREV to the interval containing the char before CHARPOS.
2033 Either one may be null. They may be equal. */
2034 to
= find_interval (buffer_intervals (current_buffer
), charpos
);
2035 if (charpos
== BEGV
)
2037 else if (to
&& to
->position
== charpos
)
2038 toprev
= previous_interval (to
);
2043 /* Here TO is the interval after the stopping point
2044 and TOPREV is the interval before the stopping point.
2045 One or the other may be null. */
2047 temp_set_point_both (current_buffer
, charpos
, bytepos
);
2049 /* We run point-left and point-entered hooks here, if the
2050 two intervals are not equivalent. These hooks take
2051 (old_point, new_point) as arguments. */
2052 if (NILP (Vinhibit_point_motion_hooks
)
2053 && (! intervals_equal (from
, to
)
2054 || ! intervals_equal (fromprev
, toprev
)))
2056 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
2059 leave_before
= textget (fromprev
->plist
, Qpoint_left
);
2061 leave_before
= Qnil
;
2064 leave_after
= textget (from
->plist
, Qpoint_left
);
2069 enter_before
= textget (toprev
->plist
, Qpoint_entered
);
2071 enter_before
= Qnil
;
2074 enter_after
= textget (to
->plist
, Qpoint_entered
);
2078 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
2079 call2 (leave_before
, make_number (old_position
),
2080 make_number (charpos
));
2081 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
2082 call2 (leave_after
, make_number (old_position
),
2083 make_number (charpos
));
2085 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
2086 call2 (enter_before
, make_number (old_position
),
2087 make_number (charpos
));
2088 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
2089 call2 (enter_after
, make_number (old_position
),
2090 make_number (charpos
));
2094 /* Move point to POSITION, unless POSITION is inside an intangible
2095 segment that reaches all the way to point. */
2098 move_if_not_intangible (ptrdiff_t position
)
2101 Lisp_Object intangible_propval
;
2103 XSETINT (pos
, position
);
2105 if (! NILP (Vinhibit_point_motion_hooks
))
2106 /* If intangible is inhibited, always move point to POSITION. */
2108 else if (PT
< position
&& XINT (pos
) < ZV
)
2110 /* We want to move forward, so check the text before POSITION. */
2112 intangible_propval
= Fget_char_property (pos
,
2115 /* If following char is intangible,
2116 skip back over all chars with matching intangible property. */
2117 if (! NILP (intangible_propval
))
2118 while (XINT (pos
) > BEGV
2119 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
2121 intangible_propval
))
2122 pos
= Fprevious_char_property_change (pos
, Qnil
);
2124 else if (XINT (pos
) > BEGV
)
2126 /* We want to move backward, so check the text after POSITION. */
2128 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2131 /* If following char is intangible,
2132 skip forward over all chars with matching intangible property. */
2133 if (! NILP (intangible_propval
))
2134 while (XINT (pos
) < ZV
2135 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2136 intangible_propval
))
2137 pos
= Fnext_char_property_change (pos
, Qnil
);
2140 else if (position
< BEGV
)
2142 else if (position
> ZV
)
2145 /* If the whole stretch between PT and POSITION isn't intangible,
2146 try moving to POSITION (which means we actually move farther
2147 if POSITION is inside of intangible text). */
2149 if (XINT (pos
) != PT
)
2153 /* If text at position POS has property PROP, set *VAL to the property
2154 value, *START and *END to the beginning and end of a region that
2155 has the same property, and return true. Otherwise return false.
2157 OBJECT is the string or buffer to look for the property in;
2158 nil means the current buffer. */
2161 get_property_and_range (ptrdiff_t pos
, Lisp_Object prop
, Lisp_Object
*val
,
2162 ptrdiff_t *start
, ptrdiff_t *end
, Lisp_Object object
)
2164 INTERVAL i
, prev
, next
;
2167 i
= find_interval (buffer_intervals (current_buffer
), pos
);
2168 else if (BUFFERP (object
))
2169 i
= find_interval (buffer_intervals (XBUFFER (object
)), pos
);
2170 else if (STRINGP (object
))
2171 i
= find_interval (string_intervals (object
), pos
);
2175 if (!i
|| (i
->position
+ LENGTH (i
) <= pos
))
2177 *val
= textget (i
->plist
, prop
);
2181 next
= i
; /* remember it in advance */
2182 prev
= previous_interval (i
);
2184 && EQ (*val
, textget (prev
->plist
, prop
)))
2185 i
= prev
, prev
= previous_interval (prev
);
2186 *start
= i
->position
;
2188 next
= next_interval (i
);
2189 while (next
&& EQ (*val
, textget (next
->plist
, prop
)))
2190 i
= next
, next
= next_interval (next
);
2191 *end
= i
->position
+ LENGTH (i
);
2196 /* Return the proper local keymap TYPE for position POSITION in
2197 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2198 specified by the PROP property, if any. Otherwise, if TYPE is
2199 `local-map' use BUFFER's local map.
2201 POSITION must be in the accessible part of BUFFER. */
2204 get_local_map (register ptrdiff_t position
, register struct buffer
*buffer
,
2207 Lisp_Object prop
, lispy_position
, lispy_buffer
;
2208 ptrdiff_t old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2210 /* Perhaps we should just change `position' to the limit. */
2211 if (position
> BUF_ZV (buffer
) || position
< BUF_BEGV (buffer
))
2214 /* Ignore narrowing, so that a local map continues to be valid even if
2215 the visible region contains no characters and hence no properties. */
2216 old_begv
= BUF_BEGV (buffer
);
2217 old_zv
= BUF_ZV (buffer
);
2218 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2219 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2221 SET_BUF_BEGV_BOTH (buffer
, BUF_BEG (buffer
), BUF_BEG_BYTE (buffer
));
2222 SET_BUF_ZV_BOTH (buffer
, BUF_Z (buffer
), BUF_Z_BYTE (buffer
));
2224 XSETFASTINT (lispy_position
, position
);
2225 XSETBUFFER (lispy_buffer
, buffer
);
2226 /* First check if the CHAR has any property. This is because when
2227 we click with the mouse, the mouse pointer is really pointing
2228 to the CHAR after POS. */
2229 prop
= Fget_char_property (lispy_position
, type
, lispy_buffer
);
2230 /* If not, look at the POS's properties. This is necessary because when
2231 editing a field with a `local-map' property, we want insertion at the end
2232 to obey the `local-map' property. */
2234 prop
= get_pos_property (lispy_position
, type
, lispy_buffer
);
2236 SET_BUF_BEGV_BOTH (buffer
, old_begv
, old_begv_byte
);
2237 SET_BUF_ZV_BOTH (buffer
, old_zv
, old_zv_byte
);
2239 /* Use the local map only if it is valid. */
2240 prop
= get_keymap (prop
, 0, 0);
2244 if (EQ (type
, Qkeymap
))
2247 return BVAR (buffer
, keymap
);
2250 /* Produce an interval tree reflecting the intervals in
2251 TREE from START to START + LENGTH.
2252 The new interval tree has no parent and has a starting-position of 0. */
2255 copy_intervals (INTERVAL tree
, ptrdiff_t start
, ptrdiff_t length
)
2257 register INTERVAL i
, new, t
;
2258 register ptrdiff_t got
, prevlen
;
2260 if (!tree
|| length
<= 0)
2263 i
= find_interval (tree
, start
);
2264 eassert (i
&& LENGTH (i
) > 0);
2266 /* If there is only one interval and it's the default, return nil. */
2267 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2268 && DEFAULT_INTERVAL_P (i
))
2271 new = make_interval ();
2273 got
= (LENGTH (i
) - (start
- i
->position
));
2274 new->total_length
= length
;
2275 eassert (0 <= TOTAL_LENGTH (new));
2276 copy_properties (i
, new);
2280 while (got
< length
)
2282 i
= next_interval (i
);
2283 t
= split_interval_right (t
, prevlen
);
2284 copy_properties (i
, t
);
2285 prevlen
= LENGTH (i
);
2289 return balance_an_interval (new);
2292 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2295 copy_intervals_to_string (Lisp_Object string
, struct buffer
*buffer
,
2296 ptrdiff_t position
, ptrdiff_t length
)
2298 INTERVAL interval_copy
= copy_intervals (buffer_intervals (buffer
),
2303 set_interval_object (interval_copy
, string
);
2304 set_string_intervals (string
, interval_copy
);
2307 /* Return true if strings S1 and S2 have identical properties.
2308 Assume they have identical characters. */
2311 compare_string_intervals (Lisp_Object s1
, Lisp_Object s2
)
2315 ptrdiff_t end
= SCHARS (s1
);
2317 i1
= find_interval (string_intervals (s1
), 0);
2318 i2
= find_interval (string_intervals (s2
), 0);
2322 /* Determine how far we can go before we reach the end of I1 or I2. */
2323 ptrdiff_t len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2324 ptrdiff_t len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2325 ptrdiff_t distance
= min (len1
, len2
);
2327 /* If we ever find a mismatch between the strings,
2329 if (! intervals_equal (i1
, i2
))
2332 /* Advance POS till the end of the shorter interval,
2333 and advance one or both interval pointers for the new position. */
2335 if (len1
== distance
)
2336 i1
= next_interval (i1
);
2337 if (len2
== distance
)
2338 i2
= next_interval (i2
);
2343 /* Recursively adjust interval I in the current buffer
2344 for setting enable_multibyte_characters to MULTI_FLAG.
2345 The range of interval I is START ... END in characters,
2346 START_BYTE ... END_BYTE in bytes. */
2349 set_intervals_multibyte_1 (INTERVAL i
, bool multi_flag
,
2350 ptrdiff_t start
, ptrdiff_t start_byte
,
2351 ptrdiff_t end
, ptrdiff_t end_byte
)
2353 /* Fix the length of this interval. */
2355 i
->total_length
= end
- start
;
2357 i
->total_length
= end_byte
- start_byte
;
2358 eassert (0 <= TOTAL_LENGTH (i
));
2360 if (TOTAL_LENGTH (i
) == 0)
2362 delete_interval (i
);
2366 /* Recursively fix the length of the subintervals. */
2369 ptrdiff_t left_end
, left_end_byte
;
2374 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2375 left_end
= BYTE_TO_CHAR (left_end_byte
);
2377 temp
= CHAR_TO_BYTE (left_end
);
2379 /* If LEFT_END_BYTE is in the middle of a character,
2380 adjust it and LEFT_END to a char boundary. */
2381 if (left_end_byte
> temp
)
2383 left_end_byte
= temp
;
2385 if (left_end_byte
< temp
)
2388 left_end_byte
= CHAR_TO_BYTE (left_end
);
2393 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2394 left_end_byte
= CHAR_TO_BYTE (left_end
);
2397 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2398 left_end
, left_end_byte
);
2402 ptrdiff_t right_start_byte
, right_start
;
2408 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2409 right_start
= BYTE_TO_CHAR (right_start_byte
);
2411 /* If RIGHT_START_BYTE is in the middle of a character,
2412 adjust it and RIGHT_START to a char boundary. */
2413 temp
= CHAR_TO_BYTE (right_start
);
2415 if (right_start_byte
< temp
)
2417 right_start_byte
= temp
;
2419 if (right_start_byte
> temp
)
2422 right_start_byte
= CHAR_TO_BYTE (right_start
);
2427 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2428 right_start_byte
= CHAR_TO_BYTE (right_start
);
2431 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2432 right_start
, right_start_byte
,
2436 /* Rounding to char boundaries can theoretically ake this interval
2437 spurious. If so, delete one child, and copy its property list
2438 to this interval. */
2439 if (LEFT_TOTAL_LENGTH (i
) + RIGHT_TOTAL_LENGTH (i
) >= TOTAL_LENGTH (i
))
2443 set_interval_plist (i
, i
->left
->plist
);
2444 (i
)->left
->total_length
= 0;
2445 delete_interval ((i
)->left
);
2449 set_interval_plist (i
, i
->right
->plist
);
2450 (i
)->right
->total_length
= 0;
2451 delete_interval ((i
)->right
);
2456 /* Update the intervals of the current buffer
2457 to fit the contents as multibyte (if MULTI_FLAG)
2458 or to fit them as non-multibyte (if not MULTI_FLAG). */
2461 set_intervals_multibyte (bool multi_flag
)
2463 INTERVAL i
= buffer_intervals (current_buffer
);
2466 set_intervals_multibyte_1 (i
, multi_flag
, BEG
, BEG_BYTE
, Z
, Z_BYTE
);