1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
27 An idea: Have the owner of the tree keep count of splits and/or
28 insertion lengths (in intervals), and balance after every N.
30 Need to call *_left_hook when buffer is killed.
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
35 There are comments around about freeing intervals. It might be
36 faster to explicitly free them (put them on the free list) than
44 #include "intervals.h"
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
55 Lisp_Object
merge_properties_sticky ();
56 static INTERVAL reproduce_tree
P_ ((INTERVAL
, INTERVAL
));
57 static INTERVAL reproduce_tree_obj
P_ ((INTERVAL
, Lisp_Object
));
59 /* Utility functions for intervals. */
62 /* Create the root interval of some object, a buffer or string. */
65 create_root_interval (parent
)
70 CHECK_IMPURE (parent
);
72 new = make_interval ();
76 new->total_length
= (BUF_Z (XBUFFER (parent
))
77 - BUF_BEG (XBUFFER (parent
)));
78 BUF_INTERVALS (XBUFFER (parent
)) = new;
81 else if (STRINGP (parent
))
83 new->total_length
= XSTRING (parent
)->size
;
84 XSTRING (parent
)->intervals
= new;
88 SET_INTERVAL_OBJECT (new, parent
);
93 /* Make the interval TARGET have exactly the properties of SOURCE */
96 copy_properties (source
, target
)
97 register INTERVAL source
, target
;
99 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
102 COPY_INTERVAL_CACHE (source
, target
);
103 target
->plist
= Fcopy_sequence (source
->plist
);
106 /* Merge the properties of interval SOURCE into the properties
107 of interval TARGET. That is to say, each property in SOURCE
108 is added to TARGET if TARGET has no such property as yet. */
111 merge_properties (source
, target
)
112 register INTERVAL source
, target
;
114 register Lisp_Object o
, sym
, val
;
116 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
119 MERGE_INTERVAL_CACHE (source
, target
);
122 while (! EQ (o
, Qnil
))
125 val
= Fmemq (sym
, target
->plist
);
131 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
139 /* Return 1 if the two intervals have the same properties,
143 intervals_equal (i0
, i1
)
146 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
149 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
152 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
155 i1_len
= XFASTINT (Flength (i1
->plist
));
156 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
160 while (!NILP (i0_cdr
))
162 /* Lengths of the two plists were unequal. */
166 i0_sym
= Fcar (i0_cdr
);
167 i1_val
= Fmemq (i0_sym
, i1
->plist
);
169 /* i0 has something i1 doesn't. */
170 if (EQ (i1_val
, Qnil
))
173 /* i0 and i1 both have sym, but it has different values in each. */
174 i0_cdr
= Fcdr (i0_cdr
);
175 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
178 i0_cdr
= Fcdr (i0_cdr
);
182 /* Lengths of the two plists were unequal. */
190 /* Traverse an interval tree TREE, performing FUNCTION on each node.
191 No guarantee is made about the order of traversal.
192 Pass FUNCTION two args: an interval, and ARG. */
195 traverse_intervals_noorder (tree
, function
, arg
)
197 void (* function
) P_ ((INTERVAL
, Lisp_Object
));
200 /* Minimize stack usage. */
201 while (!NULL_INTERVAL_P (tree
))
203 (*function
) (tree
, arg
);
204 if (NULL_INTERVAL_P (tree
->right
))
208 traverse_intervals_noorder (tree
->left
, function
, arg
);
214 /* Traverse an interval tree TREE, performing FUNCTION on each node.
215 Pass FUNCTION two args: an interval, and ARG. */
218 traverse_intervals (tree
, position
, function
, arg
)
221 void (* function
) P_ ((INTERVAL
, Lisp_Object
));
224 while (!NULL_INTERVAL_P (tree
))
226 traverse_intervals (tree
->left
, position
, function
, arg
);
227 position
+= LEFT_TOTAL_LENGTH (tree
);
228 tree
->position
= position
;
229 (*function
) (tree
, arg
);
230 position
+= LENGTH (tree
); tree
= tree
->right
;
238 static int zero_length
;
240 /* These functions are temporary, for debugging purposes only. */
242 INTERVAL search_interval
, found_interval
;
245 check_for_interval (i
)
248 if (i
== search_interval
)
256 search_for_interval (i
, tree
)
257 register INTERVAL i
, tree
;
261 found_interval
= NULL_INTERVAL
;
262 traverse_intervals_noorder (tree
, &check_for_interval
, Qnil
);
263 return found_interval
;
267 inc_interval_count (i
)
284 traverse_intervals_noorder (i
, &inc_interval_count
, Qnil
);
290 root_interval (interval
)
293 register INTERVAL i
= interval
;
295 while (! ROOT_INTERVAL_P (i
))
296 i
= INTERVAL_PARENT (i
);
302 /* Assuming that a left child exists, perform the following operation:
311 static INLINE INTERVAL
312 rotate_right (interval
)
316 INTERVAL B
= interval
->left
;
317 int old_total
= interval
->total_length
;
319 /* Deal with any Parent of A; make it point to B. */
320 if (! ROOT_INTERVAL_P (interval
))
322 if (AM_LEFT_CHILD (interval
))
323 INTERVAL_PARENT (interval
)->left
= B
;
325 INTERVAL_PARENT (interval
)->right
= B
;
327 COPY_INTERVAL_PARENT (B
, interval
);
329 /* Make B the parent of A */
332 SET_INTERVAL_PARENT (interval
, B
);
334 /* Make A point to c */
336 if (! NULL_INTERVAL_P (i
))
337 SET_INTERVAL_PARENT (i
, interval
);
339 /* A's total length is decreased by the length of B and its left child. */
340 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
342 /* B must have the same total length of A. */
343 B
->total_length
= old_total
;
348 /* Assuming that a right child exists, perform the following operation:
357 static INLINE INTERVAL
358 rotate_left (interval
)
362 INTERVAL B
= interval
->right
;
363 int old_total
= interval
->total_length
;
365 /* Deal with any parent of A; make it point to B. */
366 if (! ROOT_INTERVAL_P (interval
))
368 if (AM_LEFT_CHILD (interval
))
369 INTERVAL_PARENT (interval
)->left
= B
;
371 INTERVAL_PARENT (interval
)->right
= B
;
373 COPY_INTERVAL_PARENT (B
, interval
);
375 /* Make B the parent of A */
378 SET_INTERVAL_PARENT (interval
, B
);
380 /* Make A point to c */
382 if (! NULL_INTERVAL_P (i
))
383 SET_INTERVAL_PARENT (i
, interval
);
385 /* A's total length is decreased by the length of B and its right child. */
386 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
388 /* B must have the same total length of A. */
389 B
->total_length
= old_total
;
394 /* Balance an interval tree with the assumption that the subtrees
395 themselves are already balanced. */
398 balance_an_interval (i
)
401 register int old_diff
, new_diff
;
405 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
408 new_diff
= i
->total_length
- i
->left
->total_length
409 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
410 if (abs (new_diff
) >= old_diff
)
412 i
= rotate_right (i
);
413 balance_an_interval (i
->right
);
415 else if (old_diff
< 0)
417 new_diff
= i
->total_length
- i
->right
->total_length
418 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
419 if (abs (new_diff
) >= -old_diff
)
422 balance_an_interval (i
->left
);
430 /* Balance INTERVAL, potentially stuffing it back into its parent
433 static INLINE INTERVAL
434 balance_possible_root_interval (interval
)
435 register INTERVAL interval
;
440 if (!INTERVAL_HAS_OBJECT (interval
) && !INTERVAL_HAS_PARENT (interval
))
443 if (INTERVAL_HAS_OBJECT (interval
))
446 GET_INTERVAL_OBJECT (parent
, interval
);
448 interval
= balance_an_interval (interval
);
452 if (BUFFERP (parent
))
453 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
454 else if (STRINGP (parent
))
455 XSTRING (parent
)->intervals
= interval
;
461 /* Balance the interval tree TREE. Balancing is by weight
462 (the amount of text). */
465 balance_intervals_internal (tree
)
466 register INTERVAL tree
;
468 /* Balance within each side. */
470 balance_intervals_internal (tree
->left
);
472 balance_intervals_internal (tree
->right
);
473 return balance_an_interval (tree
);
476 /* Advertised interface to balance intervals. */
479 balance_intervals (tree
)
482 if (tree
== NULL_INTERVAL
)
483 return NULL_INTERVAL
;
485 return balance_intervals_internal (tree
);
488 /* Split INTERVAL into two pieces, starting the second piece at
489 character position OFFSET (counting from 0), relative to INTERVAL.
490 INTERVAL becomes the left-hand piece, and the right-hand piece
491 (second, lexicographically) is returned.
493 The size and position fields of the two intervals are set based upon
494 those of the original interval. The property list of the new interval
495 is reset, thus it is up to the caller to do the right thing with the
498 Note that this does not change the position of INTERVAL; if it is a root,
499 it is still a root after this operation. */
502 split_interval_right (interval
, offset
)
506 INTERVAL
new = make_interval ();
507 int position
= interval
->position
;
508 int new_length
= LENGTH (interval
) - offset
;
510 new->position
= position
+ offset
;
511 SET_INTERVAL_PARENT (new, interval
);
513 if (NULL_RIGHT_CHILD (interval
))
515 interval
->right
= new;
516 new->total_length
= new_length
;
520 /* Insert the new node between INTERVAL and its right child. */
521 new->right
= interval
->right
;
522 SET_INTERVAL_PARENT (interval
->right
, new);
523 interval
->right
= new;
524 new->total_length
= new_length
+ new->right
->total_length
;
525 balance_an_interval (new);
528 balance_possible_root_interval (interval
);
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 right-hand piece, and the left-hand piece
536 (first, 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_left (interval
, offset
)
551 INTERVAL
new = make_interval ();
552 int new_length
= offset
;
554 new->position
= interval
->position
;
555 interval
->position
= interval
->position
+ offset
;
556 SET_INTERVAL_PARENT (new, interval
);
558 if (NULL_LEFT_CHILD (interval
))
560 interval
->left
= new;
561 new->total_length
= new_length
;
565 /* Insert the new node between INTERVAL and its left child. */
566 new->left
= interval
->left
;
567 SET_INTERVAL_PARENT (new->left
, new);
568 interval
->left
= new;
569 new->total_length
= new_length
+ new->left
->total_length
;
570 balance_an_interval (new);
573 balance_possible_root_interval (interval
);
578 /* Return the proper position for the first character
579 described by the interval tree SOURCE.
580 This is 1 if the parent is a buffer,
581 0 if the parent is a string or if there is no parent.
583 Don't use this function on an interval which is the child
584 of another interval! */
587 interval_start_pos (source
)
592 if (NULL_INTERVAL_P (source
))
595 if (! INTERVAL_HAS_OBJECT (source
))
597 GET_INTERVAL_OBJECT (parent
, source
);
598 if (BUFFERP (parent
))
599 return BUF_BEG (XBUFFER (parent
));
603 /* Find the interval containing text position POSITION in the text
604 represented by the interval tree TREE. POSITION is a buffer
605 position (starting from 1) or a string index (starting from 0).
606 If POSITION is at the end of the buffer or string,
607 return the interval containing the last character.
609 The `position' field, which is a cache of an interval's position,
610 is updated in the interval found. Other functions (e.g., next_interval)
611 will update this cache based on the result of find_interval. */
614 find_interval (tree
, position
)
615 register INTERVAL tree
;
616 register int position
;
618 /* The distance from the left edge of the subtree at TREE
620 register int relative_position
;
622 if (NULL_INTERVAL_P (tree
))
623 return NULL_INTERVAL
;
625 relative_position
= position
;
626 if (INTERVAL_HAS_OBJECT (tree
))
629 GET_INTERVAL_OBJECT (parent
, tree
);
630 if (BUFFERP (parent
))
631 relative_position
-= BUF_BEG (XBUFFER (parent
));
634 if (relative_position
> TOTAL_LENGTH (tree
))
635 abort (); /* Paranoia */
637 if (!handling_signal
)
638 tree
= balance_possible_root_interval (tree
);
642 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
646 else if (! NULL_RIGHT_CHILD (tree
)
647 && relative_position
>= (TOTAL_LENGTH (tree
)
648 - RIGHT_TOTAL_LENGTH (tree
)))
650 relative_position
-= (TOTAL_LENGTH (tree
)
651 - RIGHT_TOTAL_LENGTH (tree
));
657 = (position
- relative_position
/* the left edge of *tree */
658 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
665 /* Find the succeeding interval (lexicographically) to INTERVAL.
666 Sets the `position' field based on that of INTERVAL (see
670 next_interval (interval
)
671 register INTERVAL interval
;
673 register INTERVAL i
= interval
;
674 register int next_position
;
676 if (NULL_INTERVAL_P (i
))
677 return NULL_INTERVAL
;
678 next_position
= interval
->position
+ LENGTH (interval
);
680 if (! NULL_RIGHT_CHILD (i
))
683 while (! NULL_LEFT_CHILD (i
))
686 i
->position
= next_position
;
690 while (! NULL_PARENT (i
))
692 if (AM_LEFT_CHILD (i
))
694 i
= INTERVAL_PARENT (i
);
695 i
->position
= next_position
;
699 i
= INTERVAL_PARENT (i
);
702 return NULL_INTERVAL
;
705 /* Find the preceding interval (lexicographically) to INTERVAL.
706 Sets the `position' field based on that of INTERVAL (see
710 previous_interval (interval
)
711 register INTERVAL interval
;
715 if (NULL_INTERVAL_P (interval
))
716 return NULL_INTERVAL
;
718 if (! NULL_LEFT_CHILD (interval
))
721 while (! NULL_RIGHT_CHILD (i
))
724 i
->position
= interval
->position
- LENGTH (i
);
729 while (! NULL_PARENT (i
))
731 if (AM_RIGHT_CHILD (i
))
733 i
= INTERVAL_PARENT (i
);
735 i
->position
= interval
->position
- LENGTH (i
);
738 i
= INTERVAL_PARENT (i
);
741 return NULL_INTERVAL
;
744 /* Find the interval containing POS given some non-NULL INTERVAL
745 in the same tree. Note that we need to update interval->position
746 if we go down the tree.
747 To speed up the process, we assume that the ->position of
748 I and all its parents is already uptodate. */
750 update_interval (i
, pos
)
754 if (NULL_INTERVAL_P (i
))
755 return NULL_INTERVAL
;
759 if (pos
< i
->position
)
762 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
764 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
765 + LEFT_TOTAL_LENGTH (i
->left
);
766 i
= i
->left
; /* Move to the left child */
768 else if (NULL_PARENT (i
))
769 error ("Point before start of properties");
771 i
= INTERVAL_PARENT (i
);
774 else if (pos
>= INTERVAL_LAST_POS (i
))
777 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
779 i
->right
->position
= INTERVAL_LAST_POS (i
) +
780 LEFT_TOTAL_LENGTH (i
->right
);
781 i
= i
->right
; /* Move to the right child */
783 else if (NULL_PARENT (i
))
784 error ("Point after end of properties");
786 i
= INTERVAL_PARENT (i
);
796 /* Traverse a path down the interval tree TREE to the interval
797 containing POSITION, adjusting all nodes on the path for
798 an addition of LENGTH characters. Insertion between two intervals
799 (i.e., point == i->position, where i is second interval) means
800 text goes into second interval.
802 Modifications are needed to handle the hungry bits -- after simply
803 finding the interval at position (don't add length going down),
804 if it's the beginning of the interval, get the previous interval
805 and check the hungry bits of both. Then add the length going back up
809 adjust_intervals_for_insertion (tree
, position
, length
)
811 int position
, length
;
813 register int relative_position
;
814 register INTERVAL
this;
816 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
819 /* If inserting at point-max of a buffer, that position
820 will be out of range */
821 if (position
> TOTAL_LENGTH (tree
))
822 position
= TOTAL_LENGTH (tree
);
823 relative_position
= position
;
828 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
830 this->total_length
+= length
;
833 else if (relative_position
> (TOTAL_LENGTH (this)
834 - RIGHT_TOTAL_LENGTH (this)))
836 relative_position
-= (TOTAL_LENGTH (this)
837 - RIGHT_TOTAL_LENGTH (this));
838 this->total_length
+= length
;
843 /* If we are to use zero-length intervals as buffer pointers,
844 then this code will have to change. */
845 this->total_length
+= length
;
846 this->position
= LEFT_TOTAL_LENGTH (this)
847 + position
- relative_position
+ 1;
854 /* Effect an adjustment corresponding to the addition of LENGTH characters
855 of text. Do this by finding the interval containing POSITION in the
856 interval tree TREE, and then adjusting all of its ancestors by adding
859 If POSITION is the first character of an interval, meaning that point
860 is actually between the two intervals, make the new text belong to
861 the interval which is "sticky".
863 If both intervals are "sticky", then make them belong to the left-most
864 interval. Another possibility would be to create a new interval for
865 this text, and make it have the merged properties of both ends. */
868 adjust_intervals_for_insertion (tree
, position
, length
)
870 int position
, length
;
873 register INTERVAL temp
;
878 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
881 GET_INTERVAL_OBJECT (parent
, tree
);
882 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
884 /* If inserting at point-max of a buffer, that position will be out
885 of range. Remember that buffer positions are 1-based. */
886 if (position
>= TOTAL_LENGTH (tree
) + offset
)
888 position
= TOTAL_LENGTH (tree
) + offset
;
892 i
= find_interval (tree
, position
);
894 /* If in middle of an interval which is not sticky either way,
895 we must not just give its properties to the insertion.
896 So split this interval at the insertion point.
898 Originally, the if condition here was this:
899 (! (position == i->position || eobp)
900 && END_NONSTICKY_P (i)
901 && FRONT_NONSTICKY_P (i))
902 But, these macros are now unreliable because of introduction of
903 Vtext_property_default_nonsticky. So, we always check properties
904 one by one if POSITION is in middle of an interval. */
905 if (! (position
== i
->position
|| eobp
))
908 Lisp_Object front
, rear
;
912 /* Properties font-sticky and rear-nonsticky override
913 Vtext_property_default_nonsticky. So, if they are t, we can
914 skip one by one checking of properties. */
915 rear
= textget (i
->plist
, Qrear_nonsticky
);
916 if (! CONSP (rear
) && ! NILP (rear
))
918 /* All properties are nonsticky. We split the interval. */
921 front
= textget (i
->plist
, Qfront_sticky
);
922 if (! CONSP (front
) && ! NILP (front
))
924 /* All properties are sticky. We don't split the interval. */
929 /* Does any actual property pose an actual problem? We break
930 the loop if we find a nonsticky property. */
931 for (; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
933 Lisp_Object prop
, tmp
;
936 /* Is this particular property front-sticky? */
937 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
940 /* Is this particular property rear-nonsticky? */
941 if (CONSP (rear
) && ! NILP (Fmemq (prop
, rear
)))
944 /* Is this particular property recorded as sticky or
945 nonsticky in Vtext_property_default_nonsticky? */
946 tmp
= Fassq (prop
, Vtext_property_default_nonsticky
);
954 /* By default, a text property is rear-sticky, thus we
955 continue the loop. */
959 /* If any property is a real problem, split the interval. */
962 temp
= split_interval_right (i
, position
- i
->position
);
963 copy_properties (i
, temp
);
968 /* If we are positioned between intervals, check the stickiness of
969 both of them. We have to do this too, if we are at BEG or Z. */
970 if (position
== i
->position
|| eobp
)
972 register INTERVAL prev
;
982 prev
= previous_interval (i
);
984 /* Even if we are positioned between intervals, we default
985 to the left one if it exists. We extend it now and split
986 off a part later, if stickiness demands it. */
987 for (temp
= prev
? prev
: i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
989 temp
->total_length
+= length
;
990 temp
= balance_possible_root_interval (temp
);
993 /* If at least one interval has sticky properties,
994 we check the stickiness property by property.
996 Originally, the if condition here was this:
997 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
998 But, these macros are now unreliable because of introduction
999 of Vtext_property_default_nonsticky. So, we always have to
1000 check stickiness of properties one by one. If cache of
1001 stickiness is implemented in the future, we may be able to
1002 use those macros again. */
1005 Lisp_Object pleft
, pright
;
1006 struct interval newi
;
1008 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
1009 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
1010 newi
.plist
= merge_properties_sticky (pleft
, pright
);
1012 if (! prev
) /* i.e. position == BEG */
1014 if (! intervals_equal (i
, &newi
))
1016 i
= split_interval_left (i
, length
);
1017 i
->plist
= newi
.plist
;
1020 else if (! intervals_equal (prev
, &newi
))
1022 prev
= split_interval_right (prev
,
1023 position
- prev
->position
);
1024 prev
->plist
= newi
.plist
;
1025 if (! NULL_INTERVAL_P (i
)
1026 && intervals_equal (prev
, i
))
1027 merge_interval_right (prev
);
1030 /* We will need to update the cache here later. */
1032 else if (! prev
&& ! NILP (i
->plist
))
1034 /* Just split off a new interval at the left.
1035 Since I wasn't front-sticky, the empty plist is ok. */
1036 i
= split_interval_left (i
, length
);
1040 /* Otherwise just extend the interval. */
1043 for (temp
= i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
1045 temp
->total_length
+= length
;
1046 temp
= balance_possible_root_interval (temp
);
1053 /* Any property might be front-sticky on the left, rear-sticky on the left,
1054 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1055 can be arranged in a matrix with rows denoting the left conditions and
1056 columns denoting the right conditions:
1064 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1065 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1066 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1067 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1068 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1069 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1070 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1071 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1073 We inherit from whoever has a sticky side facing us. If both sides
1074 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1075 non-nil value for the current property. If both sides do, then we take
1078 When we inherit a property, we get its stickiness as well as its value.
1079 So, when we merge the above two lists, we expect to get this:
1081 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1082 rear-nonsticky (p6 pa)
1083 p0 L p1 L p2 L p3 L p6 R p7 R
1084 pa R pb R pc L pd L pe L pf L)
1086 The optimizable special cases are:
1087 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1088 left rear-nonsticky = t, right front-sticky = t (inherit right)
1089 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1093 merge_properties_sticky (pleft
, pright
)
1094 Lisp_Object pleft
, pright
;
1096 register Lisp_Object props
, front
, rear
;
1097 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1098 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1099 int use_left
, use_right
;
1105 lfront
= textget (pleft
, Qfront_sticky
);
1106 lrear
= textget (pleft
, Qrear_nonsticky
);
1107 rfront
= textget (pright
, Qfront_sticky
);
1108 rrear
= textget (pright
, Qrear_nonsticky
);
1110 /* Go through each element of PRIGHT. */
1111 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1117 /* Sticky properties get special treatment. */
1118 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1121 rval
= Fcar (Fcdr (tail1
));
1122 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1123 if (EQ (sym
, Fcar (tail2
)))
1126 /* Indicate whether the property is explicitly defined on the left.
1127 (We know it is defined explicitly on the right
1128 because otherwise we don't get here.) */
1129 lpresent
= ! NILP (tail2
);
1130 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1132 /* Even if lrear or rfront say nothing about the stickiness of
1133 SYM, Vtext_property_default_nonsticky may give default
1134 stickiness to SYM. */
1135 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1136 use_left
= (lpresent
1137 && ! (TMEM (sym
, lrear
)
1138 || CONSP (tmp
) && ! NILP (XCDR (tmp
))));
1139 use_right
= (TMEM (sym
, rfront
)
1140 || (CONSP (tmp
) && NILP (XCDR (tmp
))));
1141 if (use_left
&& use_right
)
1145 else if (NILP (rval
))
1150 /* We build props as (value sym ...) rather than (sym value ...)
1151 because we plan to nreverse it when we're done. */
1152 props
= Fcons (lval
, Fcons (sym
, props
));
1153 if (TMEM (sym
, lfront
))
1154 front
= Fcons (sym
, front
);
1155 if (TMEM (sym
, lrear
))
1156 rear
= Fcons (sym
, rear
);
1160 props
= Fcons (rval
, Fcons (sym
, props
));
1161 if (TMEM (sym
, rfront
))
1162 front
= Fcons (sym
, front
);
1163 if (TMEM (sym
, rrear
))
1164 rear
= Fcons (sym
, rear
);
1168 /* Now go through each element of PLEFT. */
1169 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1175 /* Sticky properties get special treatment. */
1176 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1179 /* If sym is in PRIGHT, we've already considered it. */
1180 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1181 if (EQ (sym
, Fcar (tail1
)))
1186 lval
= Fcar (Fcdr (tail2
));
1188 /* Even if lrear or rfront say nothing about the stickiness of
1189 SYM, Vtext_property_default_nonsticky may give default
1190 stickiness to SYM. */
1191 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1193 /* Since rval is known to be nil in this loop, the test simplifies. */
1194 if (! (TMEM (sym
, lrear
) || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))))
1196 props
= Fcons (lval
, Fcons (sym
, props
));
1197 if (TMEM (sym
, lfront
))
1198 front
= Fcons (sym
, front
);
1200 else if (TMEM (sym
, rfront
) || (CONSP (tmp
) && NILP (XCDR (tmp
))))
1202 /* The value is nil, but we still inherit the stickiness
1204 front
= Fcons (sym
, front
);
1205 if (TMEM (sym
, rrear
))
1206 rear
= Fcons (sym
, rear
);
1209 props
= Fnreverse (props
);
1211 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1213 cat
= textget (props
, Qcategory
);
1216 /* If we have inherited a front-stick category property that is t,
1217 we don't need to set up a detailed one. */
1218 ! (! NILP (cat
) && SYMBOLP (cat
)
1219 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1220 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1225 /* Delete an node I from its interval tree by merging its subtrees
1226 into one subtree which is then returned. Caller is responsible for
1227 storing the resulting subtree into its parent. */
1231 register INTERVAL i
;
1233 register INTERVAL migrate
, this;
1234 register int migrate_amt
;
1236 if (NULL_INTERVAL_P (i
->left
))
1238 if (NULL_INTERVAL_P (i
->right
))
1242 migrate_amt
= i
->left
->total_length
;
1244 this->total_length
+= migrate_amt
;
1245 while (! NULL_INTERVAL_P (this->left
))
1248 this->total_length
+= migrate_amt
;
1250 this->left
= migrate
;
1251 SET_INTERVAL_PARENT (migrate
, this);
1256 /* Delete interval I from its tree by calling `delete_node'
1257 and properly connecting the resultant subtree.
1259 I is presumed to be empty; that is, no adjustments are made
1260 for the length of I. */
1264 register INTERVAL i
;
1266 register INTERVAL parent
;
1267 int amt
= LENGTH (i
);
1269 if (amt
> 0) /* Only used on zero-length intervals now. */
1272 if (ROOT_INTERVAL_P (i
))
1275 GET_INTERVAL_OBJECT (owner
, i
);
1276 parent
= delete_node (i
);
1277 if (! NULL_INTERVAL_P (parent
))
1278 SET_INTERVAL_OBJECT (parent
, owner
);
1280 if (BUFFERP (owner
))
1281 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1282 else if (STRINGP (owner
))
1283 XSTRING (owner
)->intervals
= parent
;
1290 parent
= INTERVAL_PARENT (i
);
1291 if (AM_LEFT_CHILD (i
))
1293 parent
->left
= delete_node (i
);
1294 if (! NULL_INTERVAL_P (parent
->left
))
1295 SET_INTERVAL_PARENT (parent
->left
, parent
);
1299 parent
->right
= delete_node (i
);
1300 if (! NULL_INTERVAL_P (parent
->right
))
1301 SET_INTERVAL_PARENT (parent
->right
, parent
);
1305 /* Find the interval in TREE corresponding to the relative position
1306 FROM and delete as much as possible of AMOUNT from that interval.
1307 Return the amount actually deleted, and if the interval was
1308 zeroed-out, delete that interval node from the tree.
1310 Note that FROM is actually origin zero, aka relative to the
1311 leftmost edge of tree. This is appropriate since we call ourselves
1312 recursively on subtrees.
1314 Do this by recursing down TREE to the interval in question, and
1315 deleting the appropriate amount of text. */
1318 interval_deletion_adjustment (tree
, from
, amount
)
1319 register INTERVAL tree
;
1320 register int from
, amount
;
1322 register int relative_position
= from
;
1324 if (NULL_INTERVAL_P (tree
))
1328 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1330 int subtract
= interval_deletion_adjustment (tree
->left
,
1333 tree
->total_length
-= subtract
;
1337 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1338 - RIGHT_TOTAL_LENGTH (tree
)))
1342 relative_position
-= (tree
->total_length
1343 - RIGHT_TOTAL_LENGTH (tree
));
1344 subtract
= interval_deletion_adjustment (tree
->right
,
1347 tree
->total_length
-= subtract
;
1350 /* Here -- this node. */
1353 /* How much can we delete from this interval? */
1354 int my_amount
= ((tree
->total_length
1355 - RIGHT_TOTAL_LENGTH (tree
))
1356 - relative_position
);
1358 if (amount
> my_amount
)
1361 tree
->total_length
-= amount
;
1362 if (LENGTH (tree
) == 0)
1363 delete_interval (tree
);
1368 /* Never reach here. */
1371 /* Effect the adjustments necessary to the interval tree of BUFFER to
1372 correspond to the deletion of LENGTH characters from that buffer
1373 text. The deletion is effected at position START (which is a
1374 buffer position, i.e. origin 1). */
1377 adjust_intervals_for_deletion (buffer
, start
, length
)
1378 struct buffer
*buffer
;
1381 register int left_to_delete
= length
;
1382 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1386 GET_INTERVAL_OBJECT (parent
, tree
);
1387 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1389 if (NULL_INTERVAL_P (tree
))
1392 if (start
> offset
+ TOTAL_LENGTH (tree
)
1393 || start
+ length
> offset
+ TOTAL_LENGTH (tree
))
1396 if (length
== TOTAL_LENGTH (tree
))
1398 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1402 if (ONLY_INTERVAL_P (tree
))
1404 tree
->total_length
-= length
;
1408 if (start
> offset
+ TOTAL_LENGTH (tree
))
1409 start
= offset
+ TOTAL_LENGTH (tree
);
1410 while (left_to_delete
> 0)
1412 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1414 tree
= BUF_INTERVALS (buffer
);
1415 if (left_to_delete
== tree
->total_length
)
1417 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1423 /* Make the adjustments necessary to the interval tree of BUFFER to
1424 represent an addition or deletion of LENGTH characters starting
1425 at position START. Addition or deletion is indicated by the sign
1429 offset_intervals (buffer
, start
, length
)
1430 struct buffer
*buffer
;
1433 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1437 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1439 adjust_intervals_for_deletion (buffer
, start
, -length
);
1442 /* Merge interval I with its lexicographic successor. The resulting
1443 interval is returned, and has the properties of the original
1444 successor. The properties of I are lost. I is removed from the
1448 The caller must verify that this is not the last (rightmost)
1452 merge_interval_right (i
)
1453 register INTERVAL i
;
1455 register int absorb
= LENGTH (i
);
1456 register INTERVAL successor
;
1458 /* Zero out this interval. */
1459 i
->total_length
-= absorb
;
1461 /* Find the succeeding interval. */
1462 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1465 successor
= i
->right
;
1466 while (! NULL_LEFT_CHILD (successor
))
1468 successor
->total_length
+= absorb
;
1469 successor
= successor
->left
;
1472 successor
->total_length
+= absorb
;
1473 delete_interval (i
);
1478 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1481 if (AM_LEFT_CHILD (successor
))
1483 successor
= INTERVAL_PARENT (successor
);
1484 delete_interval (i
);
1488 successor
= INTERVAL_PARENT (successor
);
1489 successor
->total_length
-= absorb
;
1492 /* This must be the rightmost or last interval and cannot
1493 be merged right. The caller should have known. */
1497 /* Merge interval I with its lexicographic predecessor. The resulting
1498 interval is returned, and has the properties of the original predecessor.
1499 The properties of I are lost. Interval node I is removed from the tree.
1502 The caller must verify that this is not the first (leftmost) interval. */
1505 merge_interval_left (i
)
1506 register INTERVAL i
;
1508 register int absorb
= LENGTH (i
);
1509 register INTERVAL predecessor
;
1511 /* Zero out this interval. */
1512 i
->total_length
-= absorb
;
1514 /* Find the preceding interval. */
1515 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1516 adding ABSORB as we go. */
1518 predecessor
= i
->left
;
1519 while (! NULL_RIGHT_CHILD (predecessor
))
1521 predecessor
->total_length
+= absorb
;
1522 predecessor
= predecessor
->right
;
1525 predecessor
->total_length
+= absorb
;
1526 delete_interval (i
);
1531 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1532 subtracting ABSORB. */
1534 if (AM_RIGHT_CHILD (predecessor
))
1536 predecessor
= INTERVAL_PARENT (predecessor
);
1537 delete_interval (i
);
1541 predecessor
= INTERVAL_PARENT (predecessor
);
1542 predecessor
->total_length
-= absorb
;
1545 /* This must be the leftmost or first interval and cannot
1546 be merged left. The caller should have known. */
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 (source
, parent
)
1557 INTERVAL source
, parent
;
1559 register INTERVAL t
= make_interval ();
1561 bcopy (source
, t
, INTERVAL_SIZE
);
1562 copy_properties (source
, t
);
1563 SET_INTERVAL_PARENT (t
, parent
);
1564 if (! NULL_LEFT_CHILD (source
))
1565 t
->left
= reproduce_tree (source
->left
, t
);
1566 if (! NULL_RIGHT_CHILD (source
))
1567 t
->right
= reproduce_tree (source
->right
, t
);
1573 reproduce_tree_obj (source
, parent
)
1577 register INTERVAL t
= make_interval ();
1579 bcopy (source
, t
, INTERVAL_SIZE
);
1580 copy_properties (source
, t
);
1581 SET_INTERVAL_OBJECT (t
, parent
);
1582 if (! NULL_LEFT_CHILD (source
))
1583 t
->left
= reproduce_tree (source
->left
, t
);
1584 if (! NULL_RIGHT_CHILD (source
))
1585 t
->right
= reproduce_tree (source
->right
, t
);
1591 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1593 /* Make a new interval of length LENGTH starting at START in the
1594 group of intervals INTERVALS, which is actually an interval tree.
1595 Returns the new interval.
1597 Generate an error if the new positions would overlap an existing
1601 make_new_interval (intervals
, start
, length
)
1607 slot
= find_interval (intervals
, start
);
1608 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1609 error ("Interval would overlap");
1611 if (start
== slot
->position
&& length
== LENGTH (slot
))
1614 if (slot
->position
== start
)
1616 /* New right node. */
1617 split_interval_right (slot
, length
);
1621 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1623 /* New left node. */
1624 split_interval_left (slot
, LENGTH (slot
) - length
);
1628 /* Convert interval SLOT into three intervals. */
1629 split_interval_left (slot
, start
- slot
->position
);
1630 split_interval_right (slot
, length
);
1635 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1636 LENGTH is the length of the text in SOURCE.
1638 The `position' field of the SOURCE intervals is assumed to be
1639 consistent with its parent; therefore, SOURCE must be an
1640 interval tree made with copy_interval or must be the whole
1641 tree of a buffer or a string.
1643 This is used in insdel.c when inserting Lisp_Strings into the
1644 buffer. The text corresponding to SOURCE is already in the buffer
1645 when this is called. The intervals of new tree are a copy of those
1646 belonging to the string being inserted; intervals are never
1649 If the inserted text had no intervals associated, and we don't
1650 want to inherit the surrounding text's properties, this function
1651 simply returns -- offset_intervals should handle placing the
1652 text in the correct interval, depending on the sticky bits.
1654 If the inserted text had properties (intervals), then there are two
1655 cases -- either insertion happened in the middle of some interval,
1656 or between two intervals.
1658 If the text goes into the middle of an interval, then new
1659 intervals are created in the middle with only the properties of
1660 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1661 which case the new text has the union of its properties and those
1662 of the text into which it was inserted.
1664 If the text goes between two intervals, then if neither interval
1665 had its appropriate sticky property set (front_sticky, rear_sticky),
1666 the new text has only its properties. If one of the sticky properties
1667 is set, then the new text "sticks" to that region and its properties
1668 depend on merging as above. If both the preceding and succeeding
1669 intervals to the new text are "sticky", then the new text retains
1670 only its properties, as if neither sticky property were set. Perhaps
1671 we should consider merging all three sets of properties onto the new
1675 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1677 int position
, length
;
1678 struct buffer
*buffer
;
1681 register INTERVAL under
, over
, this, prev
;
1682 register INTERVAL tree
;
1684 tree
= BUF_INTERVALS (buffer
);
1686 /* If the new text has no properties, it becomes part of whatever
1687 interval it was inserted into. */
1688 if (NULL_INTERVAL_P (source
))
1691 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1693 int saved_inhibit_modification_hooks
= inhibit_modification_hooks
;
1694 XSETBUFFER (buf
, buffer
);
1695 inhibit_modification_hooks
= 1;
1696 Fset_text_properties (make_number (position
),
1697 make_number (position
+ length
),
1699 inhibit_modification_hooks
= saved_inhibit_modification_hooks
;
1701 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1702 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1706 if (NULL_INTERVAL_P (tree
))
1708 /* The inserted text constitutes the whole buffer, so
1709 simply copy over the interval structure. */
1710 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1713 XSETBUFFER (buf
, buffer
);
1714 BUF_INTERVALS (buffer
) = reproduce_tree_obj (source
, buf
);
1715 BUF_INTERVALS (buffer
)->position
= 1;
1717 /* Explicitly free the old tree here? */
1722 /* Create an interval tree in which to place a copy
1723 of the intervals of the inserted string. */
1726 XSETBUFFER (buf
, buffer
);
1727 tree
= create_root_interval (buf
);
1730 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1731 /* If the buffer contains only the new string, but
1732 there was already some interval tree there, then it may be
1733 some zero length intervals. Eventually, do something clever
1734 about inserting properly. For now, just waste the old intervals. */
1736 BUF_INTERVALS (buffer
) = reproduce_tree (source
, INTERVAL_PARENT (tree
));
1737 BUF_INTERVALS (buffer
)->position
= 1;
1738 /* Explicitly free the old tree here. */
1742 /* Paranoia -- the text has already been added, so this buffer
1743 should be of non-zero length. */
1744 else if (TOTAL_LENGTH (tree
) == 0)
1747 this = under
= find_interval (tree
, position
);
1748 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1750 over
= find_interval (source
, interval_start_pos (source
));
1752 /* Here for insertion in the middle of an interval.
1753 Split off an equivalent interval to the right,
1754 then don't bother with it any more. */
1756 if (position
> under
->position
)
1758 INTERVAL end_unchanged
1759 = split_interval_left (this, position
- under
->position
);
1760 copy_properties (under
, end_unchanged
);
1761 under
->position
= position
;
1765 /* This call may have some effect because previous_interval may
1766 update `position' fields of intervals. Thus, don't ignore it
1767 for the moment. Someone please tell me the truth (K.Handa). */
1768 prev
= previous_interval (under
);
1770 /* But, this code surely has no effect. And, anyway,
1771 END_NONSTICKY_P is unreliable now. */
1772 if (prev
&& !END_NONSTICKY_P (prev
))
1777 /* Insertion is now at beginning of UNDER. */
1779 /* The inserted text "sticks" to the interval `under',
1780 which means it gets those properties.
1781 The properties of under are the result of
1782 adjust_intervals_for_insertion, so stickiness has
1783 already been taken care of. */
1785 while (! NULL_INTERVAL_P (over
))
1787 if (LENGTH (over
) < LENGTH (under
))
1789 this = split_interval_left (under
, LENGTH (over
));
1790 copy_properties (under
, this);
1794 copy_properties (over
, this);
1796 merge_properties (over
, this);
1798 copy_properties (over
, this);
1799 over
= next_interval (over
);
1802 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1803 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1807 /* Get the value of property PROP from PLIST,
1808 which is the plist of an interval.
1809 We check for direct properties, for categories with property PROP,
1810 and for PROP appearing on the default-text-properties list. */
1813 textget (plist
, prop
)
1815 register Lisp_Object prop
;
1817 register Lisp_Object tail
, fallback
;
1820 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1822 register Lisp_Object tem
;
1825 return Fcar (Fcdr (tail
));
1826 if (EQ (tem
, Qcategory
))
1828 tem
= Fcar (Fcdr (tail
));
1830 fallback
= Fget (tem
, prop
);
1834 if (! NILP (fallback
))
1836 if (CONSP (Vdefault_text_properties
))
1837 return Fplist_get (Vdefault_text_properties
, prop
);
1842 /* Set point "temporarily", without checking any text properties. */
1845 temp_set_point (buffer
, charpos
)
1846 struct buffer
*buffer
;
1849 temp_set_point_both (buffer
, charpos
,
1850 buf_charpos_to_bytepos (buffer
, charpos
));
1853 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1854 byte position BYTEPOS. */
1857 temp_set_point_both (buffer
, charpos
, bytepos
)
1858 int charpos
, bytepos
;
1859 struct buffer
*buffer
;
1861 /* In a single-byte buffer, the two positions must be equal. */
1862 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1863 && charpos
!= bytepos
)
1866 if (charpos
> bytepos
)
1869 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1872 BUF_PT_BYTE (buffer
) = bytepos
;
1873 BUF_PT (buffer
) = charpos
;
1876 /* Set point in BUFFER to CHARPOS. If the target position is
1877 before an intangible character, move to an ok place. */
1880 set_point (buffer
, charpos
)
1881 register struct buffer
*buffer
;
1882 register int charpos
;
1884 set_point_both (buffer
, charpos
, buf_charpos_to_bytepos (buffer
, charpos
));
1887 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1888 position BYTEPOS. If the target position is
1889 before an intangible character, move to an ok place. */
1892 set_point_both (buffer
, charpos
, bytepos
)
1893 register struct buffer
*buffer
;
1894 register int charpos
, bytepos
;
1896 register INTERVAL to
, from
, toprev
, fromprev
;
1898 int old_position
= BUF_PT (buffer
);
1899 int backwards
= (charpos
< old_position
? 1 : 0);
1901 int original_position
;
1903 buffer
->point_before_scroll
= Qnil
;
1905 if (charpos
== BUF_PT (buffer
))
1908 /* In a single-byte buffer, the two positions must be equal. */
1909 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1910 && charpos
!= bytepos
)
1913 /* Check this now, before checking if the buffer has any intervals.
1914 That way, we can catch conditions which break this sanity check
1915 whether or not there are intervals in the buffer. */
1916 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1919 have_overlays
= (! NILP (buffer
->overlays_before
)
1920 || ! NILP (buffer
->overlays_after
));
1922 /* If we have no text properties and overlays,
1923 then we can do it quickly. */
1924 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1926 temp_set_point_both (buffer
, charpos
, bytepos
);
1930 /* Set TO to the interval containing the char after CHARPOS,
1931 and TOPREV to the interval containing the char before CHARPOS.
1932 Either one may be null. They may be equal. */
1933 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1934 if (charpos
== BUF_BEGV (buffer
))
1936 else if (to
&& to
->position
== charpos
)
1937 toprev
= previous_interval (to
);
1941 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1942 ? BUF_ZV (buffer
) - 1
1945 /* Set FROM to the interval containing the char after PT,
1946 and FROMPREV to the interval containing the char before PT.
1947 Either one may be null. They may be equal. */
1948 /* We could cache this and save time. */
1949 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1950 if (buffer_point
== BUF_BEGV (buffer
))
1952 else if (from
&& from
->position
== BUF_PT (buffer
))
1953 fromprev
= previous_interval (from
);
1954 else if (buffer_point
!= BUF_PT (buffer
))
1955 fromprev
= from
, from
= 0;
1959 /* Moving within an interval. */
1960 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1963 temp_set_point_both (buffer
, charpos
, bytepos
);
1967 original_position
= charpos
;
1969 /* If the new position is between two intangible characters
1970 with the same intangible property value,
1971 move forward or backward until a change in that property. */
1972 if (NILP (Vinhibit_point_motion_hooks
)
1973 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1975 /* Intangibility never stops us from positioning at the beginning
1976 or end of the buffer, so don't bother checking in that case. */
1977 && charpos
!= BEGV
&& charpos
!= ZV
)
1979 Lisp_Object intangible_propval
;
1982 XSETINT (pos
, charpos
);
1986 intangible_propval
= Fget_char_property (make_number (charpos
),
1989 /* If following char is intangible,
1990 skip back over all chars with matching intangible property. */
1991 if (! NILP (intangible_propval
))
1992 while (XINT (pos
) > BUF_BEGV (buffer
)
1993 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1995 intangible_propval
))
1996 pos
= Fprevious_char_property_change (pos
, Qnil
);
2000 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
2003 /* If following char is intangible,
2004 skip forward over all chars with matching intangible property. */
2005 if (! NILP (intangible_propval
))
2006 while (XINT (pos
) < BUF_ZV (buffer
)
2007 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2008 intangible_propval
))
2009 pos
= Fnext_char_property_change (pos
, Qnil
);
2013 charpos
= XINT (pos
);
2014 bytepos
= buf_charpos_to_bytepos (buffer
, charpos
);
2017 if (charpos
!= original_position
)
2019 /* Set TO to the interval containing the char after CHARPOS,
2020 and TOPREV to the interval containing the char before CHARPOS.
2021 Either one may be null. They may be equal. */
2022 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
2023 if (charpos
== BUF_BEGV (buffer
))
2025 else if (to
&& to
->position
== charpos
)
2026 toprev
= previous_interval (to
);
2031 /* Here TO is the interval after the stopping point
2032 and TOPREV is the interval before the stopping point.
2033 One or the other may be null. */
2035 temp_set_point_both (buffer
, charpos
, bytepos
);
2037 /* We run point-left and point-entered hooks here, iff the
2038 two intervals are not equivalent. These hooks take
2039 (old_point, new_point) as arguments. */
2040 if (NILP (Vinhibit_point_motion_hooks
)
2041 && (! intervals_equal (from
, to
)
2042 || ! intervals_equal (fromprev
, toprev
)))
2044 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
2047 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
2051 leave_before
= textget (from
->plist
, Qpoint_left
);
2053 leave_before
= Qnil
;
2056 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
2060 enter_before
= textget (to
->plist
, Qpoint_entered
);
2062 enter_before
= Qnil
;
2064 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
2065 call2 (leave_before
, make_number (old_position
),
2066 make_number (charpos
));
2067 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
2068 call2 (leave_after
, make_number (old_position
),
2069 make_number (charpos
));
2071 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
2072 call2 (enter_before
, make_number (old_position
),
2073 make_number (charpos
));
2074 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
2075 call2 (enter_after
, make_number (old_position
),
2076 make_number (charpos
));
2080 /* Move point to POSITION, unless POSITION is inside an intangible
2081 segment that reaches all the way to point. */
2084 move_if_not_intangible (position
)
2088 Lisp_Object intangible_propval
;
2090 XSETINT (pos
, position
);
2092 if (! NILP (Vinhibit_point_motion_hooks
))
2093 /* If intangible is inhibited, always move point to POSITION. */
2095 else if (PT
< position
&& XINT (pos
) < ZV
)
2097 /* We want to move forward, so check the text before POSITION. */
2099 intangible_propval
= Fget_char_property (pos
,
2102 /* If following char is intangible,
2103 skip back over all chars with matching intangible property. */
2104 if (! NILP (intangible_propval
))
2105 while (XINT (pos
) > BEGV
2106 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
2108 intangible_propval
))
2109 pos
= Fprevious_char_property_change (pos
, Qnil
);
2111 else if (XINT (pos
) > BEGV
)
2113 /* We want to move backward, so check the text after POSITION. */
2115 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2118 /* If following char is intangible,
2119 skip forward over all chars with matching intangible property. */
2120 if (! NILP (intangible_propval
))
2121 while (XINT (pos
) < ZV
2122 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2123 intangible_propval
))
2124 pos
= Fnext_char_property_change (pos
, Qnil
);
2128 /* If the whole stretch between PT and POSITION isn't intangible,
2129 try moving to POSITION (which means we actually move farther
2130 if POSITION is inside of intangible text). */
2132 if (XINT (pos
) != PT
)
2136 /* If text at position POS has property PROP, set *VAL to the property
2137 value, *START and *END to the beginning and end of a region that
2138 has the same property, and return 1. Otherwise return 0.
2140 OBJECT is the string or buffer to look for the property in;
2141 nil means the current buffer. */
2144 get_property_and_range (pos
, prop
, val
, start
, end
, object
)
2146 Lisp_Object prop
, *val
;
2150 INTERVAL i
, prev
, next
;
2153 i
= find_interval (BUF_INTERVALS (current_buffer
), pos
);
2154 else if (BUFFERP (object
))
2155 i
= find_interval (BUF_INTERVALS (XBUFFER (object
)), pos
);
2156 else if (STRINGP (object
))
2157 i
= find_interval (XSTRING (object
)->intervals
, pos
);
2161 if (NULL_INTERVAL_P (i
) || (i
->position
+ LENGTH (i
) <= pos
))
2163 *val
= textget (i
->plist
, prop
);
2167 next
= i
; /* remember it in advance */
2168 prev
= previous_interval (i
);
2169 while (! NULL_INTERVAL_P (prev
)
2170 && EQ (*val
, textget (prev
->plist
, prop
)))
2171 i
= prev
, prev
= previous_interval (prev
);
2172 *start
= i
->position
;
2174 next
= next_interval (i
);
2175 while (! NULL_INTERVAL_P (next
)
2176 && EQ (*val
, textget (next
->plist
, prop
)))
2177 i
= next
, next
= next_interval (next
);
2178 *end
= i
->position
+ LENGTH (i
);
2183 /* Return the proper local keymap TYPE for position POSITION in
2184 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2185 specified by the PROP property, if any. Otherwise, if TYPE is
2186 `local-map' use BUFFER's local map. */
2189 get_local_map (position
, buffer
, type
)
2190 register int position
;
2191 register struct buffer
*buffer
;
2194 Lisp_Object prop
, lispy_position
, lispy_buffer
;
2195 int old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2197 /* Perhaps we should just change `position' to the limit. */
2198 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
2201 /* Ignore narrowing, so that a local map continues to be valid even if
2202 the visible region contains no characters and hence no properties. */
2203 old_begv
= BUF_BEGV (buffer
);
2204 old_zv
= BUF_ZV (buffer
);
2205 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2206 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2207 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
2208 BUF_ZV (buffer
) = BUF_Z (buffer
);
2209 BUF_BEGV_BYTE (buffer
) = BUF_BEG_BYTE (buffer
);
2210 BUF_ZV_BYTE (buffer
) = BUF_Z_BYTE (buffer
);
2212 /* There are no properties at the end of the buffer, so in that case
2213 check for a local map on the last character of the buffer instead. */
2214 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
2216 XSETFASTINT (lispy_position
, position
);
2217 XSETBUFFER (lispy_buffer
, buffer
);
2218 prop
= Fget_char_property (lispy_position
, type
, lispy_buffer
);
2220 BUF_BEGV (buffer
) = old_begv
;
2221 BUF_ZV (buffer
) = old_zv
;
2222 BUF_BEGV_BYTE (buffer
) = old_begv_byte
;
2223 BUF_ZV_BYTE (buffer
) = old_zv_byte
;
2225 /* Use the local map only if it is valid. */
2226 prop
= get_keymap (prop
, 0, 0);
2230 if (EQ (type
, Qkeymap
))
2233 return buffer
->keymap
;
2236 /* Produce an interval tree reflecting the intervals in
2237 TREE from START to START + LENGTH.
2238 The new interval tree has no parent and has a starting-position of 0. */
2241 copy_intervals (tree
, start
, length
)
2245 register INTERVAL i
, new, t
;
2246 register int got
, prevlen
;
2248 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2249 return NULL_INTERVAL
;
2251 i
= find_interval (tree
, start
);
2252 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2255 /* If there is only one interval and it's the default, return nil. */
2256 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2257 && DEFAULT_INTERVAL_P (i
))
2258 return NULL_INTERVAL
;
2260 new = make_interval ();
2262 got
= (LENGTH (i
) - (start
- i
->position
));
2263 new->total_length
= length
;
2264 copy_properties (i
, new);
2268 while (got
< length
)
2270 i
= next_interval (i
);
2271 t
= split_interval_right (t
, prevlen
);
2272 copy_properties (i
, t
);
2273 prevlen
= LENGTH (i
);
2277 return balance_an_interval (new);
2280 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2283 copy_intervals_to_string (string
, buffer
, position
, length
)
2285 struct buffer
*buffer
;
2286 int position
, length
;
2288 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2290 if (NULL_INTERVAL_P (interval_copy
))
2293 SET_INTERVAL_OBJECT (interval_copy
, string
);
2294 XSTRING (string
)->intervals
= interval_copy
;
2297 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2298 Assume they have identical characters. */
2301 compare_string_intervals (s1
, s2
)
2306 int end
= XSTRING (s1
)->size
;
2308 i1
= find_interval (XSTRING (s1
)->intervals
, 0);
2309 i2
= find_interval (XSTRING (s2
)->intervals
, 0);
2313 /* Determine how far we can go before we reach the end of I1 or I2. */
2314 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2315 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2316 int distance
= min (len1
, len2
);
2318 /* If we ever find a mismatch between the strings,
2320 if (! intervals_equal (i1
, i2
))
2323 /* Advance POS till the end of the shorter interval,
2324 and advance one or both interval pointers for the new position. */
2326 if (len1
== distance
)
2327 i1
= next_interval (i1
);
2328 if (len2
== distance
)
2329 i2
= next_interval (i2
);
2334 /* Recursively adjust interval I in the current buffer
2335 for setting enable_multibyte_characters to MULTI_FLAG.
2336 The range of interval I is START ... END in characters,
2337 START_BYTE ... END_BYTE in bytes. */
2340 set_intervals_multibyte_1 (i
, multi_flag
, start
, start_byte
, end
, end_byte
)
2343 int start
, start_byte
, end
, end_byte
;
2345 /* Fix the length of this interval. */
2347 i
->total_length
= end
- start
;
2349 i
->total_length
= end_byte
- start_byte
;
2351 /* Recursively fix the length of the subintervals. */
2354 int left_end
, left_end_byte
;
2358 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2359 left_end
= BYTE_TO_CHAR (left_end_byte
);
2363 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2364 left_end_byte
= CHAR_TO_BYTE (left_end
);
2367 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2368 left_end
, left_end_byte
);
2372 int right_start_byte
, right_start
;
2376 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2377 right_start
= BYTE_TO_CHAR (right_start_byte
);
2381 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2382 right_start_byte
= CHAR_TO_BYTE (right_start
);
2385 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2386 right_start
, right_start_byte
,
2391 /* Update the intervals of the current buffer
2392 to fit the contents as multibyte (if MULTI_FLAG is 1)
2393 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2396 set_intervals_multibyte (multi_flag
)
2399 if (BUF_INTERVALS (current_buffer
))
2400 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer
), multi_flag
,
2401 BEG
, BEG_BYTE
, Z
, Z_BYTE
);