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 1 if the two intervals have the same properties,
185 intervals_equal (INTERVAL i0
, INTERVAL i1
)
187 register Lisp_Object i0_cdr
, i0_sym
;
188 register Lisp_Object i1_cdr
, i1_val
;
190 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
193 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
198 while (CONSP (i0_cdr
) && CONSP (i1_cdr
))
200 i0_sym
= XCAR (i0_cdr
);
201 i0_cdr
= XCDR (i0_cdr
);
203 return 0; /* abort (); */
205 while (CONSP (i1_val
) && !EQ (XCAR (i1_val
), i0_sym
))
207 i1_val
= XCDR (i1_val
);
209 return 0; /* abort (); */
210 i1_val
= XCDR (i1_val
);
213 /* i0 has something i1 doesn't. */
214 if (EQ (i1_val
, Qnil
))
217 /* i0 and i1 both have sym, but it has different values in each. */
219 || (i1_val
= XCDR (i1_val
), !CONSP (i1_val
))
220 || !EQ (XCAR (i1_val
), XCAR (i0_cdr
)))
223 i0_cdr
= XCDR (i0_cdr
);
225 i1_cdr
= XCDR (i1_cdr
);
227 return 0; /* abort (); */
228 i1_cdr
= XCDR (i1_cdr
);
231 /* Lengths of the two plists were equal. */
232 return (NILP (i0_cdr
) && NILP (i1_cdr
));
236 /* Traverse an interval tree TREE, performing FUNCTION on each node.
237 No guarantee is made about the order of traversal.
238 Pass FUNCTION two args: an interval, and ARG. */
241 traverse_intervals_noorder (INTERVAL tree
, void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
243 /* Minimize stack usage. */
246 (*function
) (tree
, arg
);
251 traverse_intervals_noorder (tree
->left
, function
, arg
);
257 /* Traverse an interval tree TREE, performing FUNCTION on each node.
258 Pass FUNCTION two args: an interval, and ARG. */
261 traverse_intervals (INTERVAL tree
, ptrdiff_t position
,
262 void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
266 traverse_intervals (tree
->left
, position
, function
, arg
);
267 position
+= LEFT_TOTAL_LENGTH (tree
);
268 tree
->position
= position
;
269 (*function
) (tree
, arg
);
270 position
+= LENGTH (tree
); tree
= tree
->right
;
278 static int zero_length
;
280 /* These functions are temporary, for debugging purposes only. */
282 INTERVAL search_interval
, found_interval
;
285 check_for_interval (INTERVAL i
)
287 if (i
== search_interval
)
295 search_for_interval (INTERVAL i
, INTERVAL tree
)
299 found_interval
= NULL
;
300 traverse_intervals_noorder (tree
, &check_for_interval
, Qnil
);
301 return found_interval
;
305 inc_interval_count (INTERVAL i
)
315 count_intervals (INTERVAL i
)
320 traverse_intervals_noorder (i
, &inc_interval_count
, Qnil
);
326 root_interval (INTERVAL interval
)
328 register INTERVAL i
= interval
;
330 while (! ROOT_INTERVAL_P (i
))
331 i
= INTERVAL_PARENT (i
);
337 /* Assuming that a left child exists, perform the following operation:
346 static inline INTERVAL
347 rotate_right (INTERVAL interval
)
350 INTERVAL B
= interval
->left
;
351 ptrdiff_t old_total
= interval
->total_length
;
353 /* Deal with any Parent of A; make it point to B. */
354 if (! ROOT_INTERVAL_P (interval
))
356 if (AM_LEFT_CHILD (interval
))
357 set_interval_left (INTERVAL_PARENT (interval
), B
);
359 set_interval_right (INTERVAL_PARENT (interval
), B
);
361 copy_interval_parent (B
, interval
);
363 /* Make B the parent of A */
365 set_interval_right (B
, interval
);
366 set_interval_parent (interval
, B
);
368 /* Make A point to c */
369 set_interval_left (interval
, i
);
371 set_interval_parent (i
, interval
);
373 /* A's total length is decreased by the length of B and its left child. */
374 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
375 eassert (0 <= TOTAL_LENGTH (interval
));
377 /* B must have the same total length of A. */
378 B
->total_length
= old_total
;
379 eassert (0 <= TOTAL_LENGTH (B
));
384 /* Assuming that a right child exists, perform the following operation:
393 static inline INTERVAL
394 rotate_left (INTERVAL interval
)
397 INTERVAL B
= interval
->right
;
398 ptrdiff_t old_total
= interval
->total_length
;
400 /* Deal with any parent of A; make it point to B. */
401 if (! ROOT_INTERVAL_P (interval
))
403 if (AM_LEFT_CHILD (interval
))
404 set_interval_left (INTERVAL_PARENT (interval
), B
);
406 set_interval_right (INTERVAL_PARENT (interval
), B
);
408 copy_interval_parent (B
, interval
);
410 /* Make B the parent of A */
412 set_interval_left (B
, interval
);
413 set_interval_parent (interval
, B
);
415 /* Make A point to c */
416 set_interval_right (interval
, i
);
418 set_interval_parent (i
, interval
);
420 /* A's total length is decreased by the length of B and its right child. */
421 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
422 eassert (0 <= TOTAL_LENGTH (interval
));
424 /* B must have the same total length of A. */
425 B
->total_length
= old_total
;
426 eassert (0 <= TOTAL_LENGTH (B
));
431 /* Balance an interval tree with the assumption that the subtrees
432 themselves are already balanced. */
435 balance_an_interval (INTERVAL i
)
437 register ptrdiff_t old_diff
, new_diff
;
441 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
444 /* Since the left child is longer, there must be one. */
445 new_diff
= i
->total_length
- i
->left
->total_length
446 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
447 if (eabs (new_diff
) >= old_diff
)
449 i
= rotate_right (i
);
450 balance_an_interval (i
->right
);
452 else if (old_diff
< 0)
454 /* Since the right child is longer, there must be one. */
455 new_diff
= i
->total_length
- i
->right
->total_length
456 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
457 if (eabs (new_diff
) >= -old_diff
)
460 balance_an_interval (i
->left
);
468 /* Balance INTERVAL, potentially stuffing it back into its parent
471 static inline INTERVAL
472 balance_possible_root_interval (register INTERVAL interval
)
477 if (!INTERVAL_HAS_OBJECT (interval
) && !INTERVAL_HAS_PARENT (interval
))
480 if (INTERVAL_HAS_OBJECT (interval
))
483 GET_INTERVAL_OBJECT (parent
, interval
);
485 interval
= balance_an_interval (interval
);
489 if (BUFFERP (parent
))
490 set_buffer_intervals (XBUFFER (parent
), interval
);
491 else if (STRINGP (parent
))
492 set_string_intervals (parent
, interval
);
498 /* Balance the interval tree TREE. Balancing is by weight
499 (the amount of text). */
502 balance_intervals_internal (register INTERVAL tree
)
504 /* Balance within each side. */
506 balance_intervals_internal (tree
->left
);
508 balance_intervals_internal (tree
->right
);
509 return balance_an_interval (tree
);
512 /* Advertised interface to balance intervals. */
515 balance_intervals (INTERVAL tree
)
517 return tree
? balance_intervals_internal (tree
) : NULL
;
520 /* Rebalance text properties of B. */
523 buffer_balance_intervals (struct buffer
*b
)
528 i
= buffer_intervals (b
);
530 set_buffer_intervals (b
, balance_an_interval (i
));
533 /* Split INTERVAL into two pieces, starting the second piece at
534 character position OFFSET (counting from 0), relative to INTERVAL.
535 INTERVAL becomes the left-hand piece, and the right-hand piece
536 (second, lexicographically) is returned.
538 The size and position fields of the two intervals are set based upon
539 those of the original interval. The property list of the new interval
540 is reset, thus it is up to the caller to do the right thing with the
543 Note that this does not change the position of INTERVAL; if it is a root,
544 it is still a root after this operation. */
547 split_interval_right (INTERVAL interval
, ptrdiff_t offset
)
549 INTERVAL
new = make_interval ();
550 ptrdiff_t position
= interval
->position
;
551 ptrdiff_t new_length
= LENGTH (interval
) - offset
;
553 new->position
= position
+ offset
;
554 set_interval_parent (new, interval
);
556 if (NULL_RIGHT_CHILD (interval
))
558 set_interval_right (interval
, new);
559 new->total_length
= new_length
;
560 eassert (0 <= TOTAL_LENGTH (new));
564 /* Insert the new node between INTERVAL and its right child. */
565 set_interval_right (new, interval
->right
);
566 set_interval_parent (interval
->right
, new);
567 set_interval_right (interval
, new);
568 new->total_length
= new_length
+ new->right
->total_length
;
569 eassert (0 <= TOTAL_LENGTH (new));
570 balance_an_interval (new);
573 balance_possible_root_interval (interval
);
578 /* Split INTERVAL into two pieces, starting the second piece at
579 character position OFFSET (counting from 0), relative to INTERVAL.
580 INTERVAL becomes the right-hand piece, and the left-hand piece
581 (first, lexicographically) is returned.
583 The size and position fields of the two intervals are set based upon
584 those of the original interval. The property list of the new interval
585 is reset, thus it is up to the caller to do the right thing with the
588 Note that this does not change the position of INTERVAL; if it is a root,
589 it is still a root after this operation. */
592 split_interval_left (INTERVAL interval
, ptrdiff_t offset
)
594 INTERVAL
new = make_interval ();
595 ptrdiff_t new_length
= offset
;
597 new->position
= interval
->position
;
598 interval
->position
= interval
->position
+ offset
;
599 set_interval_parent (new, interval
);
601 if (NULL_LEFT_CHILD (interval
))
603 set_interval_left (interval
, new);
604 new->total_length
= new_length
;
605 eassert (0 <= TOTAL_LENGTH (new));
609 /* Insert the new node between INTERVAL and its left child. */
610 set_interval_left (new, interval
->left
);
611 set_interval_parent (new->left
, new);
612 set_interval_left (interval
, new);
613 new->total_length
= new_length
+ new->left
->total_length
;
614 eassert (0 <= TOTAL_LENGTH (new));
615 balance_an_interval (new);
618 balance_possible_root_interval (interval
);
623 /* Return the proper position for the first character
624 described by the interval tree SOURCE.
625 This is 1 if the parent is a buffer,
626 0 if the parent is a string or if there is no parent.
628 Don't use this function on an interval which is the child
629 of another interval! */
632 interval_start_pos (INTERVAL source
)
639 if (! INTERVAL_HAS_OBJECT (source
))
641 GET_INTERVAL_OBJECT (parent
, source
);
642 if (BUFFERP (parent
))
643 return BUF_BEG (XBUFFER (parent
));
647 /* Find the interval containing text position POSITION in the text
648 represented by the interval tree TREE. POSITION is a buffer
649 position (starting from 1) or a string index (starting from 0).
650 If POSITION is at the end of the buffer or string,
651 return the interval containing the last character.
653 The `position' field, which is a cache of an interval's position,
654 is updated in the interval found. Other functions (e.g., next_interval)
655 will update this cache based on the result of find_interval. */
658 find_interval (register INTERVAL tree
, register ptrdiff_t position
)
660 /* The distance from the left edge of the subtree at TREE
662 register ptrdiff_t relative_position
;
667 relative_position
= position
;
668 if (INTERVAL_HAS_OBJECT (tree
))
671 GET_INTERVAL_OBJECT (parent
, tree
);
672 if (BUFFERP (parent
))
673 relative_position
-= BUF_BEG (XBUFFER (parent
));
676 eassert (relative_position
<= TOTAL_LENGTH (tree
));
678 if (!handling_signal
)
679 tree
= balance_possible_root_interval (tree
);
683 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
687 else if (! NULL_RIGHT_CHILD (tree
)
688 && relative_position
>= (TOTAL_LENGTH (tree
)
689 - RIGHT_TOTAL_LENGTH (tree
)))
691 relative_position
-= (TOTAL_LENGTH (tree
)
692 - RIGHT_TOTAL_LENGTH (tree
));
698 = (position
- relative_position
/* left edge of *tree. */
699 + LEFT_TOTAL_LENGTH (tree
)); /* left edge of this interval. */
706 /* Find the succeeding interval (lexicographically) to INTERVAL.
707 Sets the `position' field based on that of INTERVAL (see
711 next_interval (register INTERVAL interval
)
713 register INTERVAL i
= interval
;
714 register ptrdiff_t next_position
;
718 next_position
= interval
->position
+ LENGTH (interval
);
720 if (! NULL_RIGHT_CHILD (i
))
723 while (! NULL_LEFT_CHILD (i
))
726 i
->position
= next_position
;
730 while (! NULL_PARENT (i
))
732 if (AM_LEFT_CHILD (i
))
734 i
= INTERVAL_PARENT (i
);
735 i
->position
= next_position
;
739 i
= INTERVAL_PARENT (i
);
745 /* Find the preceding interval (lexicographically) to INTERVAL.
746 Sets the `position' field based on that of INTERVAL (see
750 previous_interval (register INTERVAL interval
)
757 if (! NULL_LEFT_CHILD (interval
))
760 while (! NULL_RIGHT_CHILD (i
))
763 i
->position
= interval
->position
- LENGTH (i
);
768 while (! NULL_PARENT (i
))
770 if (AM_RIGHT_CHILD (i
))
772 i
= INTERVAL_PARENT (i
);
774 i
->position
= interval
->position
- LENGTH (i
);
777 i
= INTERVAL_PARENT (i
);
783 /* Find the interval containing POS given some non-NULL INTERVAL
784 in the same tree. Note that we need to update interval->position
785 if we go down the tree.
786 To speed up the process, we assume that the ->position of
787 I and all its parents is already uptodate. */
789 update_interval (register INTERVAL i
, ptrdiff_t pos
)
796 if (pos
< i
->position
)
799 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
801 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
802 + LEFT_TOTAL_LENGTH (i
->left
);
803 i
= i
->left
; /* Move to the left child */
805 else if (NULL_PARENT (i
))
806 error ("Point before start of properties");
808 i
= INTERVAL_PARENT (i
);
811 else if (pos
>= INTERVAL_LAST_POS (i
))
814 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
816 i
->right
->position
= INTERVAL_LAST_POS (i
)
817 + LEFT_TOTAL_LENGTH (i
->right
);
818 i
= i
->right
; /* Move to the right child */
820 else if (NULL_PARENT (i
))
821 error ("Point %"pD
"d after end of properties", pos
);
823 i
= INTERVAL_PARENT (i
);
831 /* Effect an adjustment corresponding to the addition of LENGTH characters
832 of text. Do this by finding the interval containing POSITION in the
833 interval tree TREE, and then adjusting all of its ancestors by adding
836 If POSITION is the first character of an interval, meaning that point
837 is actually between the two intervals, make the new text belong to
838 the interval which is "sticky".
840 If both intervals are "sticky", then make them belong to the left-most
841 interval. Another possibility would be to create a new interval for
842 this text, and make it have the merged properties of both ends. */
845 adjust_intervals_for_insertion (INTERVAL tree
,
846 ptrdiff_t position
, ptrdiff_t length
)
849 register INTERVAL temp
;
854 eassert (TOTAL_LENGTH (tree
) > 0);
856 GET_INTERVAL_OBJECT (parent
, tree
);
857 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
859 /* If inserting at point-max of a buffer, that position will be out
860 of range. Remember that buffer positions are 1-based. */
861 if (position
>= TOTAL_LENGTH (tree
) + offset
)
863 position
= TOTAL_LENGTH (tree
) + offset
;
867 i
= find_interval (tree
, position
);
869 /* If in middle of an interval which is not sticky either way,
870 we must not just give its properties to the insertion.
871 So split this interval at the insertion point.
873 Originally, the if condition here was this:
874 (! (position == i->position || eobp)
875 && END_NONSTICKY_P (i)
876 && FRONT_NONSTICKY_P (i))
877 But, these macros are now unreliable because of introduction of
878 Vtext_property_default_nonsticky. So, we always check properties
879 one by one if POSITION is in middle of an interval. */
880 if (! (position
== i
->position
|| eobp
))
883 Lisp_Object front
, rear
;
887 /* Properties font-sticky and rear-nonsticky override
888 Vtext_property_default_nonsticky. So, if they are t, we can
889 skip one by one checking of properties. */
890 rear
= textget (i
->plist
, Qrear_nonsticky
);
891 if (! CONSP (rear
) && ! NILP (rear
))
893 /* All properties are nonsticky. We split the interval. */
896 front
= textget (i
->plist
, Qfront_sticky
);
897 if (! CONSP (front
) && ! NILP (front
))
899 /* All properties are sticky. We don't split the interval. */
904 /* Does any actual property pose an actual problem? We break
905 the loop if we find a nonsticky property. */
906 for (; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
908 Lisp_Object prop
, tmp
;
911 /* Is this particular property front-sticky? */
912 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
915 /* Is this particular property rear-nonsticky? */
916 if (CONSP (rear
) && ! NILP (Fmemq (prop
, rear
)))
919 /* Is this particular property recorded as sticky or
920 nonsticky in Vtext_property_default_nonsticky? */
921 tmp
= Fassq (prop
, Vtext_property_default_nonsticky
);
929 /* By default, a text property is rear-sticky, thus we
930 continue the loop. */
934 /* If any property is a real problem, split the interval. */
937 temp
= split_interval_right (i
, position
- i
->position
);
938 copy_properties (i
, temp
);
943 /* If we are positioned between intervals, check the stickiness of
944 both of them. We have to do this too, if we are at BEG or Z. */
945 if (position
== i
->position
|| eobp
)
947 register INTERVAL prev
;
957 prev
= previous_interval (i
);
959 /* Even if we are positioned between intervals, we default
960 to the left one if it exists. We extend it now and split
961 off a part later, if stickiness demands it. */
962 for (temp
= prev
? prev
: i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
964 temp
->total_length
+= length
;
965 eassert (0 <= TOTAL_LENGTH (temp
));
966 temp
= balance_possible_root_interval (temp
);
969 /* If at least one interval has sticky properties,
970 we check the stickiness property by property.
972 Originally, the if condition here was this:
973 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
974 But, these macros are now unreliable because of introduction
975 of Vtext_property_default_nonsticky. So, we always have to
976 check stickiness of properties one by one. If cache of
977 stickiness is implemented in the future, we may be able to
978 use those macros again. */
981 Lisp_Object pleft
, pright
;
982 struct interval newi
;
984 RESET_INTERVAL (&newi
);
985 pleft
= prev
? prev
->plist
: Qnil
;
986 pright
= i
? i
->plist
: Qnil
;
987 set_interval_plist (&newi
, merge_properties_sticky (pleft
, pright
));
989 if (! prev
) /* i.e. position == BEG */
991 if (! intervals_equal (i
, &newi
))
993 i
= split_interval_left (i
, length
);
994 set_interval_plist (i
, newi
.plist
);
997 else if (! intervals_equal (prev
, &newi
))
999 prev
= split_interval_right (prev
, position
- prev
->position
);
1000 set_interval_plist (prev
, newi
.plist
);
1001 if (i
&& intervals_equal (prev
, i
))
1002 merge_interval_right (prev
);
1005 /* We will need to update the cache here later. */
1007 else if (! prev
&& ! NILP (i
->plist
))
1009 /* Just split off a new interval at the left.
1010 Since I wasn't front-sticky, the empty plist is ok. */
1011 i
= split_interval_left (i
, length
);
1015 /* Otherwise just extend the interval. */
1018 for (temp
= i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
1020 temp
->total_length
+= length
;
1021 eassert (0 <= TOTAL_LENGTH (temp
));
1022 temp
= balance_possible_root_interval (temp
);
1029 /* Any property might be front-sticky on the left, rear-sticky on the left,
1030 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1031 can be arranged in a matrix with rows denoting the left conditions and
1032 columns denoting the right conditions:
1040 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1041 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1042 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1043 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1044 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1045 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1046 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1047 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1049 We inherit from whoever has a sticky side facing us. If both sides
1050 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1051 non-nil value for the current property. If both sides do, then we take
1054 When we inherit a property, we get its stickiness as well as its value.
1055 So, when we merge the above two lists, we expect to get this:
1057 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1058 rear-nonsticky (p6 pa)
1059 p0 L p1 L p2 L p3 L p6 R p7 R
1060 pa R pb R pc L pd L pe L pf L)
1062 The optimizable special cases are:
1063 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1064 left rear-nonsticky = t, right front-sticky = t (inherit right)
1065 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1069 merge_properties_sticky (Lisp_Object pleft
, Lisp_Object pright
)
1071 register Lisp_Object props
, front
, rear
;
1072 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1073 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1074 int use_left
, use_right
;
1080 lfront
= textget (pleft
, Qfront_sticky
);
1081 lrear
= textget (pleft
, Qrear_nonsticky
);
1082 rfront
= textget (pright
, Qfront_sticky
);
1083 rrear
= textget (pright
, Qrear_nonsticky
);
1085 /* Go through each element of PRIGHT. */
1086 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1092 /* Sticky properties get special treatment. */
1093 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1096 rval
= Fcar (XCDR (tail1
));
1097 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1098 if (EQ (sym
, XCAR (tail2
)))
1101 /* Indicate whether the property is explicitly defined on the left.
1102 (We know it is defined explicitly on the right
1103 because otherwise we don't get here.) */
1104 lpresent
= ! NILP (tail2
);
1105 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1107 /* Even if lrear or rfront say nothing about the stickiness of
1108 SYM, Vtext_property_default_nonsticky may give default
1109 stickiness to SYM. */
1110 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1111 use_left
= (lpresent
1112 && ! (TMEM (sym
, lrear
)
1113 || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))));
1114 use_right
= (TMEM (sym
, rfront
)
1115 || (CONSP (tmp
) && NILP (XCDR (tmp
))));
1116 if (use_left
&& use_right
)
1120 else if (NILP (rval
))
1125 /* We build props as (value sym ...) rather than (sym value ...)
1126 because we plan to nreverse it when we're done. */
1127 props
= Fcons (lval
, Fcons (sym
, props
));
1128 if (TMEM (sym
, lfront
))
1129 front
= Fcons (sym
, front
);
1130 if (TMEM (sym
, lrear
))
1131 rear
= Fcons (sym
, rear
);
1135 props
= Fcons (rval
, Fcons (sym
, props
));
1136 if (TMEM (sym
, rfront
))
1137 front
= Fcons (sym
, front
);
1138 if (TMEM (sym
, rrear
))
1139 rear
= Fcons (sym
, rear
);
1143 /* Now go through each element of PLEFT. */
1144 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1150 /* Sticky properties get special treatment. */
1151 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1154 /* If sym is in PRIGHT, we've already considered it. */
1155 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1156 if (EQ (sym
, XCAR (tail1
)))
1161 lval
= Fcar (XCDR (tail2
));
1163 /* Even if lrear or rfront say nothing about the stickiness of
1164 SYM, Vtext_property_default_nonsticky may give default
1165 stickiness to SYM. */
1166 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1168 /* Since rval is known to be nil in this loop, the test simplifies. */
1169 if (! (TMEM (sym
, lrear
) || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))))
1171 props
= Fcons (lval
, Fcons (sym
, props
));
1172 if (TMEM (sym
, lfront
))
1173 front
= Fcons (sym
, front
);
1175 else if (TMEM (sym
, rfront
) || (CONSP (tmp
) && NILP (XCDR (tmp
))))
1177 /* The value is nil, but we still inherit the stickiness
1179 front
= Fcons (sym
, front
);
1180 if (TMEM (sym
, rrear
))
1181 rear
= Fcons (sym
, rear
);
1184 props
= Fnreverse (props
);
1186 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1188 cat
= textget (props
, Qcategory
);
1191 /* If we have inherited a front-stick category property that is t,
1192 we don't need to set up a detailed one. */
1193 ! (! NILP (cat
) && SYMBOLP (cat
)
1194 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1195 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1200 /* Delete a node I from its interval tree by merging its subtrees
1201 into one subtree which is then returned. Caller is responsible for
1202 storing the resulting subtree into its parent. */
1205 delete_node (register INTERVAL i
)
1207 register INTERVAL migrate
, this;
1208 register ptrdiff_t migrate_amt
;
1216 migrate_amt
= i
->left
->total_length
;
1218 this->total_length
+= migrate_amt
;
1222 this->total_length
+= migrate_amt
;
1224 eassert (0 <= TOTAL_LENGTH (this));
1225 set_interval_left (this, migrate
);
1226 set_interval_parent (migrate
, this);
1231 /* Delete interval I from its tree by calling `delete_node'
1232 and properly connecting the resultant subtree.
1234 I is presumed to be empty; that is, no adjustments are made
1235 for the length of I. */
1238 delete_interval (register INTERVAL i
)
1240 register INTERVAL parent
;
1241 ptrdiff_t amt
= LENGTH (i
);
1243 eassert (amt
== 0); /* Only used on zero-length intervals now. */
1245 if (ROOT_INTERVAL_P (i
))
1248 GET_INTERVAL_OBJECT (owner
, i
);
1249 parent
= delete_node (i
);
1251 set_interval_object (parent
, owner
);
1253 if (BUFFERP (owner
))
1254 set_buffer_intervals (XBUFFER (owner
), parent
);
1255 else if (STRINGP (owner
))
1256 set_string_intervals (owner
, parent
);
1263 parent
= INTERVAL_PARENT (i
);
1264 if (AM_LEFT_CHILD (i
))
1266 set_interval_left (parent
, delete_node (i
));
1268 set_interval_parent (parent
->left
, parent
);
1272 set_interval_right (parent
, delete_node (i
));
1274 set_interval_parent (parent
->right
, parent
);
1278 /* Find the interval in TREE corresponding to the relative position
1279 FROM and delete as much as possible of AMOUNT from that interval.
1280 Return the amount actually deleted, and if the interval was
1281 zeroed-out, delete that interval node from the tree.
1283 Note that FROM is actually origin zero, aka relative to the
1284 leftmost edge of tree. This is appropriate since we call ourselves
1285 recursively on subtrees.
1287 Do this by recursing down TREE to the interval in question, and
1288 deleting the appropriate amount of text. */
1291 interval_deletion_adjustment (register INTERVAL tree
, register ptrdiff_t from
,
1292 register ptrdiff_t amount
)
1294 register ptrdiff_t relative_position
= from
;
1300 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1302 ptrdiff_t subtract
= interval_deletion_adjustment (tree
->left
,
1305 tree
->total_length
-= subtract
;
1306 eassert (0 <= TOTAL_LENGTH (tree
));
1310 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1311 - RIGHT_TOTAL_LENGTH (tree
)))
1315 relative_position
-= (tree
->total_length
1316 - RIGHT_TOTAL_LENGTH (tree
));
1317 subtract
= interval_deletion_adjustment (tree
->right
,
1320 tree
->total_length
-= subtract
;
1321 eassert (0 <= TOTAL_LENGTH (tree
));
1324 /* Here -- this node. */
1327 /* How much can we delete from this interval? */
1328 ptrdiff_t my_amount
= ((tree
->total_length
1329 - RIGHT_TOTAL_LENGTH (tree
))
1330 - relative_position
);
1332 if (amount
> my_amount
)
1335 tree
->total_length
-= amount
;
1336 eassert (0 <= TOTAL_LENGTH (tree
));
1337 if (LENGTH (tree
) == 0)
1338 delete_interval (tree
);
1343 /* Never reach here. */
1346 /* Effect the adjustments necessary to the interval tree of BUFFER to
1347 correspond to the deletion of LENGTH characters from that buffer
1348 text. The deletion is effected at position START (which is a
1349 buffer position, i.e. origin 1). */
1352 adjust_intervals_for_deletion (struct buffer
*buffer
,
1353 ptrdiff_t start
, ptrdiff_t length
)
1355 ptrdiff_t left_to_delete
= length
;
1356 INTERVAL tree
= buffer_intervals (buffer
);
1360 GET_INTERVAL_OBJECT (parent
, tree
);
1361 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1366 eassert (start
<= offset
+ TOTAL_LENGTH (tree
)
1367 && start
+ length
<= offset
+ TOTAL_LENGTH (tree
));
1369 if (length
== TOTAL_LENGTH (tree
))
1371 set_buffer_intervals (buffer
, NULL
);
1375 if (ONLY_INTERVAL_P (tree
))
1377 tree
->total_length
-= length
;
1378 eassert (0 <= TOTAL_LENGTH (tree
));
1382 if (start
> offset
+ TOTAL_LENGTH (tree
))
1383 start
= offset
+ TOTAL_LENGTH (tree
);
1384 while (left_to_delete
> 0)
1386 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1388 tree
= buffer_intervals (buffer
);
1389 if (left_to_delete
== tree
->total_length
)
1391 set_buffer_intervals (buffer
, NULL
);
1397 /* Make the adjustments necessary to the interval tree of BUFFER to
1398 represent an addition or deletion of LENGTH characters starting
1399 at position START. Addition or deletion is indicated by the sign
1403 offset_intervals (struct buffer
*buffer
, ptrdiff_t start
, ptrdiff_t length
)
1405 if (!buffer_intervals (buffer
) || length
== 0)
1409 adjust_intervals_for_insertion (buffer_intervals (buffer
),
1413 IF_LINT (if (length
< - TYPE_MAXIMUM (ptrdiff_t)) abort ();)
1414 adjust_intervals_for_deletion (buffer
, start
, -length
);
1418 /* Merge interval I with its lexicographic successor. The resulting
1419 interval is returned, and has the properties of the original
1420 successor. The properties of I are lost. I is removed from the
1424 The caller must verify that this is not the last (rightmost)
1428 merge_interval_right (register INTERVAL i
)
1430 register ptrdiff_t absorb
= LENGTH (i
);
1431 register INTERVAL successor
;
1433 /* Find the succeeding interval. */
1434 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1437 successor
= i
->right
;
1438 while (! NULL_LEFT_CHILD (successor
))
1440 successor
->total_length
+= absorb
;
1441 eassert (0 <= TOTAL_LENGTH (successor
));
1442 successor
= successor
->left
;
1445 successor
->total_length
+= absorb
;
1446 eassert (0 <= TOTAL_LENGTH (successor
));
1447 delete_interval (i
);
1451 /* Zero out this interval. */
1452 i
->total_length
-= absorb
;
1453 eassert (0 <= TOTAL_LENGTH (i
));
1456 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1459 if (AM_LEFT_CHILD (successor
))
1461 successor
= INTERVAL_PARENT (successor
);
1462 delete_interval (i
);
1466 successor
= INTERVAL_PARENT (successor
);
1467 successor
->total_length
-= absorb
;
1468 eassert (0 <= TOTAL_LENGTH (successor
));
1471 /* This must be the rightmost or last interval and cannot
1472 be merged right. The caller should have known. */
1476 /* Merge interval I with its lexicographic predecessor. The resulting
1477 interval is returned, and has the properties of the original predecessor.
1478 The properties of I are lost. Interval node I is removed from the tree.
1481 The caller must verify that this is not the first (leftmost) interval. */
1484 merge_interval_left (register INTERVAL i
)
1486 register ptrdiff_t absorb
= LENGTH (i
);
1487 register INTERVAL predecessor
;
1489 /* Find the preceding interval. */
1490 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1491 adding ABSORB as we go. */
1493 predecessor
= i
->left
;
1494 while (! NULL_RIGHT_CHILD (predecessor
))
1496 predecessor
->total_length
+= absorb
;
1497 eassert (0 <= TOTAL_LENGTH (predecessor
));
1498 predecessor
= predecessor
->right
;
1501 predecessor
->total_length
+= absorb
;
1502 eassert (0 <= TOTAL_LENGTH (predecessor
));
1503 delete_interval (i
);
1507 /* Zero out this interval. */
1508 i
->total_length
-= absorb
;
1509 eassert (0 <= TOTAL_LENGTH (i
));
1512 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1513 subtracting ABSORB. */
1515 if (AM_RIGHT_CHILD (predecessor
))
1517 predecessor
= INTERVAL_PARENT (predecessor
);
1518 delete_interval (i
);
1522 predecessor
= INTERVAL_PARENT (predecessor
);
1523 predecessor
->total_length
-= absorb
;
1524 eassert (0 <= TOTAL_LENGTH (predecessor
));
1527 /* This must be the leftmost or first interval and cannot
1528 be merged left. The caller should have known. */
1532 /* Create a copy of SOURCE but with the default value of UP. */
1535 reproduce_interval (INTERVAL source
)
1537 register INTERVAL target
= make_interval ();
1539 target
->total_length
= source
->total_length
;
1540 target
->position
= source
->position
;
1542 copy_properties (source
, target
);
1544 if (! NULL_LEFT_CHILD (source
))
1545 set_interval_left (target
, reproduce_tree (source
->left
, target
));
1546 if (! NULL_RIGHT_CHILD (source
))
1547 set_interval_right (target
, reproduce_tree (source
->right
, target
));
1552 /* Make an exact copy of interval tree SOURCE which descends from
1553 PARENT. This is done by recursing through SOURCE, copying
1554 the current interval and its properties, and then adjusting
1555 the pointers of the copy. */
1558 reproduce_tree (INTERVAL source
, INTERVAL parent
)
1560 INTERVAL target
= reproduce_interval (source
);
1561 set_interval_parent (target
, parent
);
1566 reproduce_tree_obj (INTERVAL source
, Lisp_Object parent
)
1568 INTERVAL target
= reproduce_interval (source
);
1569 set_interval_object (target
, parent
);
1573 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1574 LENGTH is the length of the text in SOURCE.
1576 The `position' field of the SOURCE intervals is assumed to be
1577 consistent with its parent; therefore, SOURCE must be an
1578 interval tree made with copy_interval or must be the whole
1579 tree of a buffer or a string.
1581 This is used in insdel.c when inserting Lisp_Strings into the
1582 buffer. The text corresponding to SOURCE is already in the buffer
1583 when this is called. The intervals of new tree are a copy of those
1584 belonging to the string being inserted; intervals are never
1587 If the inserted text had no intervals associated, and we don't
1588 want to inherit the surrounding text's properties, this function
1589 simply returns -- offset_intervals should handle placing the
1590 text in the correct interval, depending on the sticky bits.
1592 If the inserted text had properties (intervals), then there are two
1593 cases -- either insertion happened in the middle of some interval,
1594 or between two intervals.
1596 If the text goes into the middle of an interval, then new intervals
1597 are created in the middle, and new text has the union of its properties
1598 and those of the text into which it was inserted.
1600 If the text goes between two intervals, then if neither interval
1601 had its appropriate sticky property set (front_sticky, rear_sticky),
1602 the new text has only its properties. If one of the sticky properties
1603 is set, then the new text "sticks" to that region and its properties
1604 depend on merging as above. If both the preceding and succeeding
1605 intervals to the new text are "sticky", then the new text retains
1606 only its properties, as if neither sticky property were set. Perhaps
1607 we should consider merging all three sets of properties onto the new
1611 graft_intervals_into_buffer (INTERVAL source
, ptrdiff_t position
,
1612 ptrdiff_t length
, struct buffer
*buffer
,
1615 INTERVAL tree
= buffer_intervals (buffer
);
1616 INTERVAL under
, over
, this;
1617 ptrdiff_t over_used
;
1619 /* If the new text has no properties, then with inheritance it
1620 becomes part of whatever interval it was inserted into.
1621 To prevent inheritance, we must clear out the properties
1622 of the newly inserted text. */
1626 if (!inherit
&& tree
&& length
> 0)
1628 XSETBUFFER (buf
, buffer
);
1629 set_text_properties_1 (make_number (position
),
1630 make_number (position
+ length
),
1633 /* Shouldn't be necessary. --Stef */
1634 buffer_balance_intervals (buffer
);
1638 eassert (length
== TOTAL_LENGTH (source
));
1640 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == length
)
1642 /* The inserted text constitutes the whole buffer, so
1643 simply copy over the interval structure. */
1646 XSETBUFFER (buf
, buffer
);
1647 set_buffer_intervals (buffer
, reproduce_tree_obj (source
, buf
));
1648 buffer_intervals (buffer
)->position
= BUF_BEG (buffer
);
1649 eassert (buffer_intervals (buffer
)->up_obj
== 1);
1654 /* Create an interval tree in which to place a copy
1655 of the intervals of the inserted string. */
1658 XSETBUFFER (buf
, buffer
);
1659 tree
= create_root_interval (buf
);
1661 /* Paranoia -- the text has already been added, so
1662 this buffer should be of non-zero length. */
1663 eassert (TOTAL_LENGTH (tree
) > 0);
1665 this = under
= find_interval (tree
, position
);
1667 over
= find_interval (source
, interval_start_pos (source
));
1669 /* Here for insertion in the middle of an interval.
1670 Split off an equivalent interval to the right,
1671 then don't bother with it any more. */
1673 if (position
> under
->position
)
1675 INTERVAL end_unchanged
1676 = split_interval_left (this, position
- under
->position
);
1677 copy_properties (under
, end_unchanged
);
1678 under
->position
= position
;
1682 /* This call may have some effect because previous_interval may
1683 update `position' fields of intervals. Thus, don't ignore it
1684 for the moment. Someone please tell me the truth (K.Handa). */
1685 INTERVAL prev
= previous_interval (under
);
1688 /* But, this code surely has no effect. And, anyway,
1689 END_NONSTICKY_P is unreliable now. */
1690 if (prev
&& !END_NONSTICKY_P (prev
))
1695 /* Insertion is now at beginning of UNDER. */
1697 /* The inserted text "sticks" to the interval `under',
1698 which means it gets those properties.
1699 The properties of under are the result of
1700 adjust_intervals_for_insertion, so stickiness has
1701 already been taken care of. */
1703 /* OVER is the interval we are copying from next.
1704 OVER_USED says how many characters' worth of OVER
1705 have already been copied into target intervals.
1706 UNDER is the next interval in the target. */
1710 /* If UNDER is longer than OVER, split it. */
1711 if (LENGTH (over
) - over_used
< LENGTH (under
))
1713 this = split_interval_left (under
, LENGTH (over
) - over_used
);
1714 copy_properties (under
, this);
1719 /* THIS is now the interval to copy or merge into.
1720 OVER covers all of it. */
1722 merge_properties (over
, this);
1724 copy_properties (over
, this);
1726 /* If THIS and OVER end at the same place,
1727 advance OVER to a new source interval. */
1728 if (LENGTH (this) == LENGTH (over
) - over_used
)
1730 over
= next_interval (over
);
1734 /* Otherwise just record that more of OVER has been used. */
1735 over_used
+= LENGTH (this);
1737 /* Always advance to a new target interval. */
1738 under
= next_interval (this);
1741 buffer_balance_intervals (buffer
);
1744 /* Get the value of property PROP from PLIST,
1745 which is the plist of an interval.
1746 We check for direct properties, for categories with property PROP,
1747 and for PROP appearing on the default-text-properties list. */
1750 textget (Lisp_Object plist
, register Lisp_Object prop
)
1752 return lookup_char_property (plist
, prop
, 1);
1756 lookup_char_property (Lisp_Object plist
, register Lisp_Object prop
, int textprop
)
1758 register Lisp_Object tail
, fallback
= Qnil
;
1760 for (tail
= plist
; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
1762 register Lisp_Object tem
;
1765 return Fcar (XCDR (tail
));
1766 if (EQ (tem
, Qcategory
))
1768 tem
= Fcar (XCDR (tail
));
1770 fallback
= Fget (tem
, prop
);
1774 if (! NILP (fallback
))
1776 /* Check for alternative properties */
1777 tail
= Fassq (prop
, Vchar_property_alias_alist
);
1781 for (; NILP (fallback
) && CONSP (tail
); tail
= XCDR (tail
))
1782 fallback
= Fplist_get (plist
, XCAR (tail
));
1785 if (textprop
&& NILP (fallback
) && CONSP (Vdefault_text_properties
))
1786 fallback
= Fplist_get (Vdefault_text_properties
, prop
);
1791 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1792 byte position BYTEPOS. */
1795 temp_set_point_both (struct buffer
*buffer
,
1796 ptrdiff_t charpos
, ptrdiff_t bytepos
)
1798 /* In a single-byte buffer, the two positions must be equal. */
1799 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
))
1800 eassert (charpos
== bytepos
);
1802 eassert (charpos
<= bytepos
);
1803 eassert (charpos
<= BUF_ZV (buffer
) || BUF_BEGV (buffer
) <= charpos
);
1805 SET_BUF_PT_BOTH (buffer
, charpos
, bytepos
);
1808 /* Set point "temporarily", without checking any text properties. */
1811 temp_set_point (struct buffer
*buffer
, ptrdiff_t charpos
)
1813 temp_set_point_both (buffer
, charpos
,
1814 buf_charpos_to_bytepos (buffer
, charpos
));
1817 /* Set point in BUFFER to CHARPOS. If the target position is
1818 before an intangible character, move to an ok place. */
1821 set_point (ptrdiff_t charpos
)
1823 set_point_both (charpos
, buf_charpos_to_bytepos (current_buffer
, charpos
));
1826 /* If there's an invisible character at position POS + TEST_OFFS in the
1827 current buffer, and the invisible property has a `stickiness' such that
1828 inserting a character at position POS would inherit the property it,
1829 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1830 then intangibility is required as well as invisibility.
1832 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1834 Note that `stickiness' is determined by overlay marker insertion types,
1835 if the invisible property comes from an overlay. */
1838 adjust_for_invis_intang (ptrdiff_t pos
, ptrdiff_t test_offs
, ptrdiff_t adj
,
1841 Lisp_Object invis_propval
, invis_overlay
;
1842 Lisp_Object test_pos
;
1844 if ((adj
< 0 && pos
+ adj
< BEGV
) || (adj
> 0 && pos
+ adj
> ZV
))
1845 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1848 test_pos
= make_number (pos
+ test_offs
);
1851 = get_char_property_and_overlay (test_pos
, Qinvisible
, Qnil
,
1855 || ! NILP (Fget_char_property (test_pos
, Qintangible
, Qnil
)))
1856 && TEXT_PROP_MEANS_INVISIBLE (invis_propval
)
1857 /* This next test is true if the invisible property has a stickiness
1858 such that an insertion at POS would inherit it. */
1859 && (NILP (invis_overlay
)
1860 /* Invisible property is from a text-property. */
1861 ? (text_property_stickiness (Qinvisible
, make_number (pos
), Qnil
)
1862 == (test_offs
== 0 ? 1 : -1))
1863 /* Invisible property is from an overlay. */
1865 ? XMARKER (OVERLAY_START (invis_overlay
))->insertion_type
== 0
1866 : XMARKER (OVERLAY_END (invis_overlay
))->insertion_type
== 1)))
1872 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1873 position BYTEPOS. If the target position is
1874 before an intangible character, move to an ok place. */
1877 set_point_both (ptrdiff_t charpos
, ptrdiff_t bytepos
)
1879 register INTERVAL to
, from
, toprev
, fromprev
;
1880 ptrdiff_t buffer_point
;
1881 ptrdiff_t old_position
= PT
;
1882 /* This ensures that we move forward past intangible text when the
1883 initial position is the same as the destination, in the rare
1884 instances where this is important, e.g. in line-move-finish
1886 int backwards
= (charpos
< old_position
? 1 : 0);
1888 ptrdiff_t original_position
;
1890 bset_point_before_scroll (current_buffer
, Qnil
);
1895 /* In a single-byte buffer, the two positions must be equal. */
1896 eassert (ZV
!= ZV_BYTE
|| charpos
== bytepos
);
1898 /* Check this now, before checking if the buffer has any intervals.
1899 That way, we can catch conditions which break this sanity check
1900 whether or not there are intervals in the buffer. */
1901 eassert (charpos
<= ZV
&& charpos
>= BEGV
);
1903 have_overlays
= buffer_has_overlays ();
1905 /* If we have no text properties and overlays,
1906 then we can do it quickly. */
1907 if (!buffer_intervals (current_buffer
) && ! have_overlays
)
1909 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1913 /* Set TO to the interval containing the char after CHARPOS,
1914 and TOPREV to the interval containing the char before CHARPOS.
1915 Either one may be null. They may be equal. */
1916 to
= find_interval (buffer_intervals (current_buffer
), charpos
);
1917 if (charpos
== BEGV
)
1919 else if (to
&& to
->position
== charpos
)
1920 toprev
= previous_interval (to
);
1924 buffer_point
= (PT
== ZV
? ZV
- 1 : PT
);
1926 /* Set FROM to the interval containing the char after PT,
1927 and FROMPREV to the interval containing the char before PT.
1928 Either one may be null. They may be equal. */
1929 /* We could cache this and save time. */
1930 from
= find_interval (buffer_intervals (current_buffer
), buffer_point
);
1931 if (buffer_point
== BEGV
)
1933 else if (from
&& from
->position
== PT
)
1934 fromprev
= previous_interval (from
);
1935 else if (buffer_point
!= PT
)
1936 fromprev
= from
, from
= 0;
1940 /* Moving within an interval. */
1941 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1944 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1948 original_position
= charpos
;
1950 /* If the new position is between two intangible characters
1951 with the same intangible property value,
1952 move forward or backward until a change in that property. */
1953 if (NILP (Vinhibit_point_motion_hooks
)
1956 /* Intangibility never stops us from positioning at the beginning
1957 or end of the buffer, so don't bother checking in that case. */
1958 && charpos
!= BEGV
&& charpos
!= ZV
)
1961 Lisp_Object intangible_propval
;
1965 /* If the preceding character is both intangible and invisible,
1966 and the invisible property is `rear-sticky', perturb it so
1967 that the search starts one character earlier -- this ensures
1968 that point can never move to the end of an invisible/
1969 intangible/rear-sticky region. */
1970 charpos
= adjust_for_invis_intang (charpos
, -1, -1, 1);
1972 XSETINT (pos
, charpos
);
1974 /* If following char is intangible,
1975 skip back over all chars with matching intangible property. */
1977 intangible_propval
= Fget_char_property (pos
, Qintangible
, Qnil
);
1979 if (! NILP (intangible_propval
))
1981 while (XINT (pos
) > BEGV
1982 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1984 intangible_propval
))
1985 pos
= Fprevious_char_property_change (pos
, Qnil
);
1987 /* Set CHARPOS from POS, and if the final intangible character
1988 that we skipped over is also invisible, and the invisible
1989 property is `front-sticky', perturb it to be one character
1990 earlier -- this ensures that point can never move to the
1991 beginning of an invisible/intangible/front-sticky region. */
1992 charpos
= adjust_for_invis_intang (XINT (pos
), 0, -1, 0);
1997 /* If the following character is both intangible and invisible,
1998 and the invisible property is `front-sticky', perturb it so
1999 that the search starts one character later -- this ensures
2000 that point can never move to the beginning of an
2001 invisible/intangible/front-sticky region. */
2002 charpos
= adjust_for_invis_intang (charpos
, 0, 1, 1);
2004 XSETINT (pos
, charpos
);
2006 /* If preceding char is intangible,
2007 skip forward over all chars with matching intangible property. */
2009 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
2012 if (! NILP (intangible_propval
))
2014 while (XINT (pos
) < ZV
2015 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2016 intangible_propval
))
2017 pos
= Fnext_char_property_change (pos
, Qnil
);
2019 /* Set CHARPOS from POS, and if the final intangible character
2020 that we skipped over is also invisible, and the invisible
2021 property is `rear-sticky', perturb it to be one character
2022 later -- this ensures that point can never move to the
2023 end of an invisible/intangible/rear-sticky region. */
2024 charpos
= adjust_for_invis_intang (XINT (pos
), -1, 1, 0);
2028 bytepos
= buf_charpos_to_bytepos (current_buffer
, charpos
);
2031 if (charpos
!= original_position
)
2033 /* Set TO to the interval containing the char after CHARPOS,
2034 and TOPREV to the interval containing the char before CHARPOS.
2035 Either one may be null. They may be equal. */
2036 to
= find_interval (buffer_intervals (current_buffer
), charpos
);
2037 if (charpos
== BEGV
)
2039 else if (to
&& to
->position
== charpos
)
2040 toprev
= previous_interval (to
);
2045 /* Here TO is the interval after the stopping point
2046 and TOPREV is the interval before the stopping point.
2047 One or the other may be null. */
2049 temp_set_point_both (current_buffer
, charpos
, bytepos
);
2051 /* We run point-left and point-entered hooks here, if the
2052 two intervals are not equivalent. These hooks take
2053 (old_point, new_point) as arguments. */
2054 if (NILP (Vinhibit_point_motion_hooks
)
2055 && (! intervals_equal (from
, to
)
2056 || ! intervals_equal (fromprev
, toprev
)))
2058 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
2061 leave_before
= textget (fromprev
->plist
, Qpoint_left
);
2063 leave_before
= Qnil
;
2066 leave_after
= textget (from
->plist
, Qpoint_left
);
2071 enter_before
= textget (toprev
->plist
, Qpoint_entered
);
2073 enter_before
= Qnil
;
2076 enter_after
= textget (to
->plist
, Qpoint_entered
);
2080 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
2081 call2 (leave_before
, make_number (old_position
),
2082 make_number (charpos
));
2083 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
2084 call2 (leave_after
, make_number (old_position
),
2085 make_number (charpos
));
2087 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
2088 call2 (enter_before
, make_number (old_position
),
2089 make_number (charpos
));
2090 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
2091 call2 (enter_after
, make_number (old_position
),
2092 make_number (charpos
));
2096 /* Move point to POSITION, unless POSITION is inside an intangible
2097 segment that reaches all the way to point. */
2100 move_if_not_intangible (ptrdiff_t position
)
2103 Lisp_Object intangible_propval
;
2105 XSETINT (pos
, position
);
2107 if (! NILP (Vinhibit_point_motion_hooks
))
2108 /* If intangible is inhibited, always move point to POSITION. */
2110 else if (PT
< position
&& XINT (pos
) < ZV
)
2112 /* We want to move forward, so check the text before POSITION. */
2114 intangible_propval
= Fget_char_property (pos
,
2117 /* If following char is intangible,
2118 skip back over all chars with matching intangible property. */
2119 if (! NILP (intangible_propval
))
2120 while (XINT (pos
) > BEGV
2121 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
2123 intangible_propval
))
2124 pos
= Fprevious_char_property_change (pos
, Qnil
);
2126 else if (XINT (pos
) > BEGV
)
2128 /* We want to move backward, so check the text after POSITION. */
2130 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2133 /* If following char is intangible,
2134 skip forward over all chars with matching intangible property. */
2135 if (! NILP (intangible_propval
))
2136 while (XINT (pos
) < ZV
2137 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2138 intangible_propval
))
2139 pos
= Fnext_char_property_change (pos
, Qnil
);
2142 else if (position
< BEGV
)
2144 else if (position
> ZV
)
2147 /* If the whole stretch between PT and POSITION isn't intangible,
2148 try moving to POSITION (which means we actually move farther
2149 if POSITION is inside of intangible text). */
2151 if (XINT (pos
) != PT
)
2155 /* If text at position POS has property PROP, set *VAL to the property
2156 value, *START and *END to the beginning and end of a region that
2157 has the same property, and return 1. Otherwise return 0.
2159 OBJECT is the string or buffer to look for the property in;
2160 nil means the current buffer. */
2163 get_property_and_range (ptrdiff_t pos
, Lisp_Object prop
, Lisp_Object
*val
,
2164 ptrdiff_t *start
, ptrdiff_t *end
, Lisp_Object object
)
2166 INTERVAL i
, prev
, next
;
2169 i
= find_interval (buffer_intervals (current_buffer
), pos
);
2170 else if (BUFFERP (object
))
2171 i
= find_interval (buffer_intervals (XBUFFER (object
)), pos
);
2172 else if (STRINGP (object
))
2173 i
= find_interval (string_intervals (object
), pos
);
2177 if (!i
|| (i
->position
+ LENGTH (i
) <= pos
))
2179 *val
= textget (i
->plist
, prop
);
2183 next
= i
; /* remember it in advance */
2184 prev
= previous_interval (i
);
2186 && EQ (*val
, textget (prev
->plist
, prop
)))
2187 i
= prev
, prev
= previous_interval (prev
);
2188 *start
= i
->position
;
2190 next
= next_interval (i
);
2191 while (next
&& EQ (*val
, textget (next
->plist
, prop
)))
2192 i
= next
, next
= next_interval (next
);
2193 *end
= i
->position
+ LENGTH (i
);
2198 /* Return the proper local keymap TYPE for position POSITION in
2199 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2200 specified by the PROP property, if any. Otherwise, if TYPE is
2201 `local-map' use BUFFER's local map.
2203 POSITION must be in the accessible part of BUFFER. */
2206 get_local_map (register ptrdiff_t position
, register struct buffer
*buffer
,
2209 Lisp_Object prop
, lispy_position
, lispy_buffer
;
2210 ptrdiff_t old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2212 /* Perhaps we should just change `position' to the limit. */
2213 if (position
> BUF_ZV (buffer
) || position
< BUF_BEGV (buffer
))
2216 /* Ignore narrowing, so that a local map continues to be valid even if
2217 the visible region contains no characters and hence no properties. */
2218 old_begv
= BUF_BEGV (buffer
);
2219 old_zv
= BUF_ZV (buffer
);
2220 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2221 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2223 SET_BUF_BEGV_BOTH (buffer
, BUF_BEG (buffer
), BUF_BEG_BYTE (buffer
));
2224 SET_BUF_ZV_BOTH (buffer
, BUF_Z (buffer
), BUF_Z_BYTE (buffer
));
2226 XSETFASTINT (lispy_position
, position
);
2227 XSETBUFFER (lispy_buffer
, buffer
);
2228 /* First check if the CHAR has any property. This is because when
2229 we click with the mouse, the mouse pointer is really pointing
2230 to the CHAR after POS. */
2231 prop
= Fget_char_property (lispy_position
, type
, lispy_buffer
);
2232 /* If not, look at the POS's properties. This is necessary because when
2233 editing a field with a `local-map' property, we want insertion at the end
2234 to obey the `local-map' property. */
2236 prop
= get_pos_property (lispy_position
, type
, lispy_buffer
);
2238 SET_BUF_BEGV_BOTH (buffer
, old_begv
, old_begv_byte
);
2239 SET_BUF_ZV_BOTH (buffer
, old_zv
, old_zv_byte
);
2241 /* Use the local map only if it is valid. */
2242 prop
= get_keymap (prop
, 0, 0);
2246 if (EQ (type
, Qkeymap
))
2249 return BVAR (buffer
, keymap
);
2252 /* Produce an interval tree reflecting the intervals in
2253 TREE from START to START + LENGTH.
2254 The new interval tree has no parent and has a starting-position of 0. */
2257 copy_intervals (INTERVAL tree
, ptrdiff_t start
, ptrdiff_t length
)
2259 register INTERVAL i
, new, t
;
2260 register ptrdiff_t got
, prevlen
;
2262 if (!tree
|| length
<= 0)
2265 i
= find_interval (tree
, start
);
2266 eassert (i
&& LENGTH (i
) > 0);
2268 /* If there is only one interval and it's the default, return nil. */
2269 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2270 && DEFAULT_INTERVAL_P (i
))
2273 new = make_interval ();
2275 got
= (LENGTH (i
) - (start
- i
->position
));
2276 new->total_length
= length
;
2277 eassert (0 <= TOTAL_LENGTH (new));
2278 copy_properties (i
, new);
2282 while (got
< length
)
2284 i
= next_interval (i
);
2285 t
= split_interval_right (t
, prevlen
);
2286 copy_properties (i
, t
);
2287 prevlen
= LENGTH (i
);
2291 return balance_an_interval (new);
2294 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2297 copy_intervals_to_string (Lisp_Object string
, struct buffer
*buffer
,
2298 ptrdiff_t position
, ptrdiff_t length
)
2300 INTERVAL interval_copy
= copy_intervals (buffer_intervals (buffer
),
2305 set_interval_object (interval_copy
, string
);
2306 set_string_intervals (string
, interval_copy
);
2309 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2310 Assume they have identical characters. */
2313 compare_string_intervals (Lisp_Object s1
, Lisp_Object s2
)
2317 ptrdiff_t end
= SCHARS (s1
);
2319 i1
= find_interval (string_intervals (s1
), 0);
2320 i2
= find_interval (string_intervals (s2
), 0);
2324 /* Determine how far we can go before we reach the end of I1 or I2. */
2325 ptrdiff_t len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2326 ptrdiff_t len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2327 ptrdiff_t distance
= min (len1
, len2
);
2329 /* If we ever find a mismatch between the strings,
2331 if (! intervals_equal (i1
, i2
))
2334 /* Advance POS till the end of the shorter interval,
2335 and advance one or both interval pointers for the new position. */
2337 if (len1
== distance
)
2338 i1
= next_interval (i1
);
2339 if (len2
== distance
)
2340 i2
= next_interval (i2
);
2345 /* Recursively adjust interval I in the current buffer
2346 for setting enable_multibyte_characters to MULTI_FLAG.
2347 The range of interval I is START ... END in characters,
2348 START_BYTE ... END_BYTE in bytes. */
2351 set_intervals_multibyte_1 (INTERVAL i
, int multi_flag
,
2352 ptrdiff_t start
, ptrdiff_t start_byte
,
2353 ptrdiff_t end
, ptrdiff_t end_byte
)
2355 /* Fix the length of this interval. */
2357 i
->total_length
= end
- start
;
2359 i
->total_length
= end_byte
- start_byte
;
2360 eassert (0 <= TOTAL_LENGTH (i
));
2362 if (TOTAL_LENGTH (i
) == 0)
2364 delete_interval (i
);
2368 /* Recursively fix the length of the subintervals. */
2371 ptrdiff_t left_end
, left_end_byte
;
2376 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2377 left_end
= BYTE_TO_CHAR (left_end_byte
);
2379 temp
= CHAR_TO_BYTE (left_end
);
2381 /* If LEFT_END_BYTE is in the middle of a character,
2382 adjust it and LEFT_END to a char boundary. */
2383 if (left_end_byte
> temp
)
2385 left_end_byte
= temp
;
2387 if (left_end_byte
< temp
)
2390 left_end_byte
= CHAR_TO_BYTE (left_end
);
2395 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2396 left_end_byte
= CHAR_TO_BYTE (left_end
);
2399 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2400 left_end
, left_end_byte
);
2404 ptrdiff_t right_start_byte
, right_start
;
2410 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2411 right_start
= BYTE_TO_CHAR (right_start_byte
);
2413 /* If RIGHT_START_BYTE is in the middle of a character,
2414 adjust it and RIGHT_START to a char boundary. */
2415 temp
= CHAR_TO_BYTE (right_start
);
2417 if (right_start_byte
< temp
)
2419 right_start_byte
= temp
;
2421 if (right_start_byte
> temp
)
2424 right_start_byte
= CHAR_TO_BYTE (right_start
);
2429 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2430 right_start_byte
= CHAR_TO_BYTE (right_start
);
2433 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2434 right_start
, right_start_byte
,
2438 /* Rounding to char boundaries can theoretically ake this interval
2439 spurious. If so, delete one child, and copy its property list
2440 to this interval. */
2441 if (LEFT_TOTAL_LENGTH (i
) + RIGHT_TOTAL_LENGTH (i
) >= TOTAL_LENGTH (i
))
2445 set_interval_plist (i
, i
->left
->plist
);
2446 (i
)->left
->total_length
= 0;
2447 delete_interval ((i
)->left
);
2451 set_interval_plist (i
, i
->right
->plist
);
2452 (i
)->right
->total_length
= 0;
2453 delete_interval ((i
)->right
);
2458 /* Update the intervals of the current buffer
2459 to fit the contents as multibyte (if MULTI_FLAG is 1)
2460 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2463 set_intervals_multibyte (int multi_flag
)
2465 INTERVAL i
= buffer_intervals (current_buffer
);
2468 set_intervals_multibyte_1 (i
, multi_flag
, BEG
, BEG_BYTE
, Z
, Z_BYTE
);