1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
27 An idea: Have the owner of the tree keep count of splits and/or
28 insertion lengths (in intervals), and balance after every N.
30 Need to call *_left_hook when buffer is killed.
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
35 There are comments around about freeing intervals. It might be
36 faster to explicitly free them (put them on the free list) than
44 #include "intervals.h"
49 /* Test for membership, allowing for t (actually any non-cons) to mean the
52 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
54 #define min(x, y) ((x) < (y) ? (x) : (y))
56 Lisp_Object
merge_properties_sticky ();
57 static INTERVAL reproduce_tree
P_ ((INTERVAL
, INTERVAL
));
58 static INTERVAL reproduce_tree_obj
P_ ((INTERVAL
, Lisp_Object
));
60 /* Utility functions for intervals. */
63 /* Create the root interval of some object, a buffer or string. */
66 create_root_interval (parent
)
71 CHECK_IMPURE (parent
);
73 new = make_interval ();
77 new->total_length
= (BUF_Z (XBUFFER (parent
))
78 - BUF_BEG (XBUFFER (parent
)));
79 BUF_INTERVALS (XBUFFER (parent
)) = new;
82 else if (STRINGP (parent
))
84 new->total_length
= XSTRING (parent
)->size
;
85 XSTRING (parent
)->intervals
= new;
89 SET_INTERVAL_OBJECT (new, parent
);
94 /* Make the interval TARGET have exactly the properties of SOURCE */
97 copy_properties (source
, target
)
98 register INTERVAL source
, target
;
100 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
103 COPY_INTERVAL_CACHE (source
, target
);
104 target
->plist
= Fcopy_sequence (source
->plist
);
107 /* Merge the properties of interval SOURCE into the properties
108 of interval TARGET. That is to say, each property in SOURCE
109 is added to TARGET if TARGET has no such property as yet. */
112 merge_properties (source
, target
)
113 register INTERVAL source
, target
;
115 register Lisp_Object o
, sym
, val
;
117 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
120 MERGE_INTERVAL_CACHE (source
, target
);
123 while (! EQ (o
, Qnil
))
126 val
= Fmemq (sym
, target
->plist
);
132 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
140 /* Return 1 if the two intervals have the same properties,
144 intervals_equal (i0
, i1
)
147 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
150 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
153 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
156 i1_len
= XFASTINT (Flength (i1
->plist
));
157 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
161 while (!NILP (i0_cdr
))
163 /* Lengths of the two plists were unequal. */
167 i0_sym
= Fcar (i0_cdr
);
168 i1_val
= Fmemq (i0_sym
, i1
->plist
);
170 /* i0 has something i1 doesn't. */
171 if (EQ (i1_val
, Qnil
))
174 /* i0 and i1 both have sym, but it has different values in each. */
175 i0_cdr
= Fcdr (i0_cdr
);
176 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
179 i0_cdr
= Fcdr (i0_cdr
);
183 /* Lengths of the two plists were unequal. */
191 /* Traverse an interval tree TREE, performing FUNCTION on each node.
192 Pass FUNCTION two args: an interval, and ARG. */
195 traverse_intervals (tree
, position
, depth
, function
, arg
)
198 void (* function
) P_ ((INTERVAL
, Lisp_Object
));
201 if (NULL_INTERVAL_P (tree
))
204 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
205 position
+= LEFT_TOTAL_LENGTH (tree
);
206 tree
->position
= position
;
207 (*function
) (tree
, arg
);
208 position
+= LENGTH (tree
);
209 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
216 static int zero_length
;
218 /* These functions are temporary, for debugging purposes only. */
220 INTERVAL search_interval
, found_interval
;
223 check_for_interval (i
)
226 if (i
== search_interval
)
234 search_for_interval (i
, tree
)
235 register INTERVAL i
, tree
;
239 found_interval
= NULL_INTERVAL
;
240 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
241 return found_interval
;
245 inc_interval_count (i
)
262 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
268 root_interval (interval
)
271 register INTERVAL i
= interval
;
273 while (! ROOT_INTERVAL_P (i
))
274 i
= INTERVAL_PARENT (i
);
280 /* Assuming that a left child exists, perform the following operation:
290 rotate_right (interval
)
294 INTERVAL B
= interval
->left
;
295 int old_total
= interval
->total_length
;
297 /* Deal with any Parent of A; make it point to B. */
298 if (! ROOT_INTERVAL_P (interval
))
300 if (AM_LEFT_CHILD (interval
))
301 INTERVAL_PARENT (interval
)->left
= B
;
303 INTERVAL_PARENT (interval
)->right
= B
;
305 COPY_INTERVAL_PARENT (B
, interval
);
307 /* Make B the parent of A */
310 SET_INTERVAL_PARENT (interval
, B
);
312 /* Make A point to c */
314 if (! NULL_INTERVAL_P (i
))
315 SET_INTERVAL_PARENT (i
, interval
);
317 /* A's total length is decreased by the length of B and its left child. */
318 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
320 /* B must have the same total length of A. */
321 B
->total_length
= old_total
;
326 /* Assuming that a right child exists, perform the following operation:
336 rotate_left (interval
)
340 INTERVAL B
= interval
->right
;
341 int old_total
= interval
->total_length
;
343 /* Deal with any parent of A; make it point to B. */
344 if (! ROOT_INTERVAL_P (interval
))
346 if (AM_LEFT_CHILD (interval
))
347 INTERVAL_PARENT (interval
)->left
= B
;
349 INTERVAL_PARENT (interval
)->right
= B
;
351 COPY_INTERVAL_PARENT (B
, interval
);
353 /* Make B the parent of A */
356 SET_INTERVAL_PARENT (interval
, B
);
358 /* Make A point to c */
360 if (! NULL_INTERVAL_P (i
))
361 SET_INTERVAL_PARENT (i
, interval
);
363 /* A's total length is decreased by the length of B and its right child. */
364 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
366 /* B must have the same total length of A. */
367 B
->total_length
= old_total
;
372 /* Balance an interval tree with the assumption that the subtrees
373 themselves are already balanced. */
376 balance_an_interval (i
)
379 register int old_diff
, new_diff
;
383 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
386 new_diff
= i
->total_length
- i
->left
->total_length
387 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
388 if (abs (new_diff
) >= old_diff
)
390 i
= rotate_right (i
);
391 balance_an_interval (i
->right
);
393 else if (old_diff
< 0)
395 new_diff
= i
->total_length
- i
->right
->total_length
396 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
397 if (abs (new_diff
) >= -old_diff
)
400 balance_an_interval (i
->left
);
408 /* Balance INTERVAL, potentially stuffing it back into its parent
411 static INLINE INTERVAL
412 balance_possible_root_interval (interval
)
413 register INTERVAL interval
;
418 if (!INTERVAL_HAS_OBJECT (interval
) && !INTERVAL_HAS_PARENT (interval
))
421 if (INTERVAL_HAS_OBJECT (interval
))
424 GET_INTERVAL_OBJECT (parent
, interval
);
426 interval
= balance_an_interval (interval
);
430 if (BUFFERP (parent
))
431 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
432 else if (STRINGP (parent
))
433 XSTRING (parent
)->intervals
= interval
;
439 /* Balance the interval tree TREE. Balancing is by weight
440 (the amount of text). */
443 balance_intervals_internal (tree
)
444 register INTERVAL tree
;
446 /* Balance within each side. */
448 balance_intervals_internal (tree
->left
);
450 balance_intervals_internal (tree
->right
);
451 return balance_an_interval (tree
);
454 /* Advertised interface to balance intervals. */
457 balance_intervals (tree
)
460 if (tree
== NULL_INTERVAL
)
461 return NULL_INTERVAL
;
463 return balance_intervals_internal (tree
);
466 /* Split INTERVAL into two pieces, starting the second piece at
467 character position OFFSET (counting from 0), relative to INTERVAL.
468 INTERVAL becomes the left-hand piece, and the right-hand piece
469 (second, lexicographically) is returned.
471 The size and position fields of the two intervals are set based upon
472 those of the original interval. The property list of the new interval
473 is reset, thus it is up to the caller to do the right thing with the
476 Note that this does not change the position of INTERVAL; if it is a root,
477 it is still a root after this operation. */
480 split_interval_right (interval
, offset
)
484 INTERVAL
new = make_interval ();
485 int position
= interval
->position
;
486 int new_length
= LENGTH (interval
) - offset
;
488 new->position
= position
+ offset
;
489 SET_INTERVAL_PARENT (new, interval
);
491 if (NULL_RIGHT_CHILD (interval
))
493 interval
->right
= new;
494 new->total_length
= new_length
;
498 /* Insert the new node between INTERVAL and its right child. */
499 new->right
= interval
->right
;
500 SET_INTERVAL_PARENT (interval
->right
, new);
501 interval
->right
= new;
502 new->total_length
= new_length
+ new->right
->total_length
;
503 balance_an_interval (new);
506 balance_possible_root_interval (interval
);
511 /* Split INTERVAL into two pieces, starting the second piece at
512 character position OFFSET (counting from 0), relative to INTERVAL.
513 INTERVAL becomes the right-hand piece, and the left-hand piece
514 (first, lexicographically) is returned.
516 The size and position fields of the two intervals are set based upon
517 those of the original interval. The property list of the new interval
518 is reset, thus it is up to the caller to do the right thing with the
521 Note that this does not change the position of INTERVAL; if it is a root,
522 it is still a root after this operation. */
525 split_interval_left (interval
, offset
)
529 INTERVAL
new = make_interval ();
530 int new_length
= offset
;
532 new->position
= interval
->position
;
533 interval
->position
= interval
->position
+ offset
;
534 SET_INTERVAL_PARENT (new, interval
);
536 if (NULL_LEFT_CHILD (interval
))
538 interval
->left
= new;
539 new->total_length
= new_length
;
543 /* Insert the new node between INTERVAL and its left child. */
544 new->left
= interval
->left
;
545 SET_INTERVAL_PARENT (new->left
, new);
546 interval
->left
= new;
547 new->total_length
= new_length
+ new->left
->total_length
;
548 balance_an_interval (new);
551 balance_possible_root_interval (interval
);
556 /* Return the proper position for the first character
557 described by the interval tree SOURCE.
558 This is 1 if the parent is a buffer,
559 0 if the parent is a string or if there is no parent.
561 Don't use this function on an interval which is the child
562 of another interval! */
565 interval_start_pos (source
)
570 if (NULL_INTERVAL_P (source
))
573 if (! INTERVAL_HAS_OBJECT (source
))
575 GET_INTERVAL_OBJECT (parent
, source
);
576 if (BUFFERP (parent
))
577 return BUF_BEG (XBUFFER (parent
));
581 /* Find the interval containing text position POSITION in the text
582 represented by the interval tree TREE. POSITION is a buffer
583 position (starting from 1) or a string index (starting from 0).
584 If POSITION is at the end of the buffer or string,
585 return the interval containing the last character.
587 The `position' field, which is a cache of an interval's position,
588 is updated in the interval found. Other functions (e.g., next_interval)
589 will update this cache based on the result of find_interval. */
592 find_interval (tree
, position
)
593 register INTERVAL tree
;
594 register int position
;
596 /* The distance from the left edge of the subtree at TREE
598 register int relative_position
;
600 if (NULL_INTERVAL_P (tree
))
601 return NULL_INTERVAL
;
603 relative_position
= position
;
604 if (INTERVAL_HAS_OBJECT (tree
))
607 GET_INTERVAL_OBJECT (parent
, tree
);
608 if (BUFFERP (parent
))
609 relative_position
-= BUF_BEG (XBUFFER (parent
));
612 if (relative_position
> TOTAL_LENGTH (tree
))
613 abort (); /* Paranoia */
615 if (!handling_signal
)
616 tree
= balance_possible_root_interval (tree
);
620 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
624 else if (! NULL_RIGHT_CHILD (tree
)
625 && relative_position
>= (TOTAL_LENGTH (tree
)
626 - RIGHT_TOTAL_LENGTH (tree
)))
628 relative_position
-= (TOTAL_LENGTH (tree
)
629 - RIGHT_TOTAL_LENGTH (tree
));
635 = (position
- relative_position
/* the left edge of *tree */
636 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
643 /* Find the succeeding interval (lexicographically) to INTERVAL.
644 Sets the `position' field based on that of INTERVAL (see
648 next_interval (interval
)
649 register INTERVAL interval
;
651 register INTERVAL i
= interval
;
652 register int next_position
;
654 if (NULL_INTERVAL_P (i
))
655 return NULL_INTERVAL
;
656 next_position
= interval
->position
+ LENGTH (interval
);
658 if (! NULL_RIGHT_CHILD (i
))
661 while (! NULL_LEFT_CHILD (i
))
664 i
->position
= next_position
;
668 while (! NULL_PARENT (i
))
670 if (AM_LEFT_CHILD (i
))
672 i
= INTERVAL_PARENT (i
);
673 i
->position
= next_position
;
677 i
= INTERVAL_PARENT (i
);
680 return NULL_INTERVAL
;
683 /* Find the preceding interval (lexicographically) to INTERVAL.
684 Sets the `position' field based on that of INTERVAL (see
688 previous_interval (interval
)
689 register INTERVAL interval
;
693 if (NULL_INTERVAL_P (interval
))
694 return NULL_INTERVAL
;
696 if (! NULL_LEFT_CHILD (interval
))
699 while (! NULL_RIGHT_CHILD (i
))
702 i
->position
= interval
->position
- LENGTH (i
);
707 while (! NULL_PARENT (i
))
709 if (AM_RIGHT_CHILD (i
))
711 i
= INTERVAL_PARENT (i
);
713 i
->position
= interval
->position
- LENGTH (i
);
716 i
= INTERVAL_PARENT (i
);
719 return NULL_INTERVAL
;
722 /* Find the interval containing POS given some non-NULL INTERVAL
723 in the same tree. Note that we need to update interval->position
724 if we go down the tree.
725 To speed up the process, we assume that the ->position of
726 I and all its parents is already uptodate. */
728 update_interval (i
, pos
)
732 if (NULL_INTERVAL_P (i
))
733 return NULL_INTERVAL
;
737 if (pos
< i
->position
)
740 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
742 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
743 + LEFT_TOTAL_LENGTH (i
->left
);
744 i
= i
->left
; /* Move to the left child */
746 else if (NULL_PARENT (i
))
747 error ("Point before start of properties");
749 i
= INTERVAL_PARENT (i
);
752 else if (pos
>= INTERVAL_LAST_POS (i
))
755 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
757 i
->right
->position
= INTERVAL_LAST_POS (i
) +
758 LEFT_TOTAL_LENGTH (i
->right
);
759 i
= i
->right
; /* Move to the right child */
761 else if (NULL_PARENT (i
))
762 error ("Point after end of properties");
764 i
= INTERVAL_PARENT (i
);
774 /* Traverse a path down the interval tree TREE to the interval
775 containing POSITION, adjusting all nodes on the path for
776 an addition of LENGTH characters. Insertion between two intervals
777 (i.e., point == i->position, where i is second interval) means
778 text goes into second interval.
780 Modifications are needed to handle the hungry bits -- after simply
781 finding the interval at position (don't add length going down),
782 if it's the beginning of the interval, get the previous interval
783 and check the hungry bits of both. Then add the length going back up
787 adjust_intervals_for_insertion (tree
, position
, length
)
789 int position
, length
;
791 register int relative_position
;
792 register INTERVAL
this;
794 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
797 /* If inserting at point-max of a buffer, that position
798 will be out of range */
799 if (position
> TOTAL_LENGTH (tree
))
800 position
= TOTAL_LENGTH (tree
);
801 relative_position
= position
;
806 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
808 this->total_length
+= length
;
811 else if (relative_position
> (TOTAL_LENGTH (this)
812 - RIGHT_TOTAL_LENGTH (this)))
814 relative_position
-= (TOTAL_LENGTH (this)
815 - RIGHT_TOTAL_LENGTH (this));
816 this->total_length
+= length
;
821 /* If we are to use zero-length intervals as buffer pointers,
822 then this code will have to change. */
823 this->total_length
+= length
;
824 this->position
= LEFT_TOTAL_LENGTH (this)
825 + position
- relative_position
+ 1;
832 /* Effect an adjustment corresponding to the addition of LENGTH characters
833 of text. Do this by finding the interval containing POSITION in the
834 interval tree TREE, and then adjusting all of its ancestors by adding
837 If POSITION is the first character of an interval, meaning that point
838 is actually between the two intervals, make the new text belong to
839 the interval which is "sticky".
841 If both intervals are "sticky", then make them belong to the left-most
842 interval. Another possibility would be to create a new interval for
843 this text, and make it have the merged properties of both ends. */
846 adjust_intervals_for_insertion (tree
, position
, length
)
848 int position
, length
;
851 register INTERVAL temp
;
856 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
859 GET_INTERVAL_OBJECT (parent
, tree
);
860 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
862 /* If inserting at point-max of a buffer, that position will be out
863 of range. Remember that buffer positions are 1-based. */
864 if (position
>= TOTAL_LENGTH (tree
) + offset
)
866 position
= TOTAL_LENGTH (tree
) + offset
;
870 i
= find_interval (tree
, position
);
872 /* If in middle of an interval which is not sticky either way,
873 we must not just give its properties to the insertion.
874 So split this interval at the insertion point.
876 Originally, the if condition here was this:
877 (! (position == i->position || eobp)
878 && END_NONSTICKY_P (i)
879 && FRONT_NONSTICKY_P (i))
880 But, these macros are now unreliable because of introduction of
881 Vtext_property_default_nonsticky. So, we always check properties
882 one by one if POSITION is in middle of an interval. */
883 if (! (position
== i
->position
|| eobp
))
886 Lisp_Object front
, rear
;
890 /* Properties font-sticky and rear-nonsticky override
891 Vtext_property_default_nonsticky. So, if they are t, we can
892 skip one by one checking of properties. */
893 rear
= textget (i
->plist
, Qrear_nonsticky
);
894 if (! CONSP (rear
) && ! NILP (rear
))
896 /* All properties are nonsticky. We split the interval. */
899 front
= textget (i
->plist
, Qfront_sticky
);
900 if (! CONSP (front
) && ! NILP (front
))
902 /* All properties are sticky. We don't split the interval. */
907 /* Does any actual property pose an actual problem? We break
908 the loop if we find a nonsticky property. */
909 for (; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
911 Lisp_Object prop
, tmp
;
914 /* Is this particular property front-sticky? */
915 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
918 /* Is this particular property rear-nonsticky? */
919 if (CONSP (rear
) && ! NILP (Fmemq (prop
, rear
)))
922 /* Is this particular property recorded as sticky or
923 nonsticky in Vtext_property_default_nonsticky? */
924 tmp
= Fassq (prop
, Vtext_property_default_nonsticky
);
932 /* By default, a text property is rear-sticky, thus we
933 continue the loop. */
937 /* If any property is a real problem, split the interval. */
940 temp
= split_interval_right (i
, position
- i
->position
);
941 copy_properties (i
, temp
);
946 /* If we are positioned between intervals, check the stickiness of
947 both of them. We have to do this too, if we are at BEG or Z. */
948 if (position
== i
->position
|| eobp
)
950 register INTERVAL prev
;
960 prev
= previous_interval (i
);
962 /* Even if we are positioned between intervals, we default
963 to the left one if it exists. We extend it now and split
964 off a part later, if stickiness demands it. */
965 for (temp
= prev
? prev
: i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
967 temp
->total_length
+= length
;
968 temp
= balance_possible_root_interval (temp
);
971 /* If at least one interval has sticky properties,
972 we check the stickiness property by property.
974 Originally, the if condition here was this:
975 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
976 But, these macros are now unreliable because of introduction
977 of Vtext_property_default_nonsticky. So, we always have to
978 check stickiness of properties one by one. If cache of
979 stickiness is implemented in the future, we may be able to
980 use those macros again. */
983 Lisp_Object pleft
, pright
;
984 struct interval newi
;
986 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
987 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
988 newi
.plist
= merge_properties_sticky (pleft
, pright
);
990 if (! prev
) /* i.e. position == BEG */
992 if (! intervals_equal (i
, &newi
))
994 i
= split_interval_left (i
, length
);
995 i
->plist
= newi
.plist
;
998 else if (! intervals_equal (prev
, &newi
))
1000 prev
= split_interval_right (prev
,
1001 position
- prev
->position
);
1002 prev
->plist
= newi
.plist
;
1003 if (! NULL_INTERVAL_P (i
)
1004 && intervals_equal (prev
, i
))
1005 merge_interval_right (prev
);
1008 /* We will need to update the cache here later. */
1010 else if (! prev
&& ! NILP (i
->plist
))
1012 /* Just split off a new interval at the left.
1013 Since I wasn't front-sticky, the empty plist is ok. */
1014 i
= split_interval_left (i
, length
);
1018 /* Otherwise just extend the interval. */
1021 for (temp
= i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
1023 temp
->total_length
+= length
;
1024 temp
= balance_possible_root_interval (temp
);
1031 /* Any property might be front-sticky on the left, rear-sticky on the left,
1032 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1033 can be arranged in a matrix with rows denoting the left conditions and
1034 columns denoting the right conditions:
1042 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1043 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1044 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1045 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1046 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1047 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1048 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1049 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1051 We inherit from whoever has a sticky side facing us. If both sides
1052 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1053 non-nil value for the current property. If both sides do, then we take
1056 When we inherit a property, we get its stickiness as well as its value.
1057 So, when we merge the above two lists, we expect to get this:
1059 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1060 rear-nonsticky (p6 pa)
1061 p0 L p1 L p2 L p3 L p6 R p7 R
1062 pa R pb R pc L pd L pe L pf L)
1064 The optimizable special cases are:
1065 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1066 left rear-nonsticky = t, right front-sticky = t (inherit right)
1067 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1071 merge_properties_sticky (pleft
, pright
)
1072 Lisp_Object pleft
, pright
;
1074 register Lisp_Object props
, front
, rear
;
1075 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1076 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1077 int use_left
, use_right
;
1083 lfront
= textget (pleft
, Qfront_sticky
);
1084 lrear
= textget (pleft
, Qrear_nonsticky
);
1085 rfront
= textget (pright
, Qfront_sticky
);
1086 rrear
= textget (pright
, Qrear_nonsticky
);
1088 /* Go through each element of PRIGHT. */
1089 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1095 /* Sticky properties get special treatment. */
1096 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1099 rval
= Fcar (Fcdr (tail1
));
1100 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1101 if (EQ (sym
, Fcar (tail2
)))
1104 /* Indicate whether the property is explicitly defined on the left.
1105 (We know it is defined explicitly on the right
1106 because otherwise we don't get here.) */
1107 lpresent
= ! NILP (tail2
);
1108 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1110 /* Even if lrear or rfront say nothing about the stickiness of
1111 SYM, Vtext_property_default_nonsticky may give default
1112 stickiness to SYM. */
1113 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1114 use_left
= (lpresent
1115 && ! (TMEM (sym
, lrear
)
1116 || CONSP (tmp
) && ! NILP (XCDR (tmp
))));
1117 use_right
= (TMEM (sym
, rfront
)
1118 || (CONSP (tmp
) && NILP (XCDR (tmp
))));
1119 if (use_left
&& use_right
)
1123 else if (NILP (rval
))
1128 /* We build props as (value sym ...) rather than (sym value ...)
1129 because we plan to nreverse it when we're done. */
1130 props
= Fcons (lval
, Fcons (sym
, props
));
1131 if (TMEM (sym
, lfront
))
1132 front
= Fcons (sym
, front
);
1133 if (TMEM (sym
, lrear
))
1134 rear
= Fcons (sym
, rear
);
1138 props
= Fcons (rval
, Fcons (sym
, props
));
1139 if (TMEM (sym
, rfront
))
1140 front
= Fcons (sym
, front
);
1141 if (TMEM (sym
, rrear
))
1142 rear
= Fcons (sym
, rear
);
1146 /* Now go through each element of PLEFT. */
1147 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1153 /* Sticky properties get special treatment. */
1154 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1157 /* If sym is in PRIGHT, we've already considered it. */
1158 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1159 if (EQ (sym
, Fcar (tail1
)))
1164 lval
= Fcar (Fcdr (tail2
));
1166 /* Even if lrear or rfront say nothing about the stickiness of
1167 SYM, Vtext_property_default_nonsticky may give default
1168 stickiness to SYM. */
1169 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1171 /* Since rval is known to be nil in this loop, the test simplifies. */
1172 if (! (TMEM (sym
, lrear
) || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))))
1174 props
= Fcons (lval
, Fcons (sym
, props
));
1175 if (TMEM (sym
, lfront
))
1176 front
= Fcons (sym
, front
);
1178 else if (TMEM (sym
, rfront
) || (CONSP (tmp
) && NILP (XCDR (tmp
))))
1180 /* The value is nil, but we still inherit the stickiness
1182 front
= Fcons (sym
, front
);
1183 if (TMEM (sym
, rrear
))
1184 rear
= Fcons (sym
, rear
);
1187 props
= Fnreverse (props
);
1189 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1191 cat
= textget (props
, Qcategory
);
1194 /* If we have inherited a front-stick category property that is t,
1195 we don't need to set up a detailed one. */
1196 ! (! NILP (cat
) && SYMBOLP (cat
)
1197 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1198 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1203 /* Delete an node I from its interval tree by merging its subtrees
1204 into one subtree which is then returned. Caller is responsible for
1205 storing the resulting subtree into its parent. */
1209 register INTERVAL i
;
1211 register INTERVAL migrate
, this;
1212 register int migrate_amt
;
1214 if (NULL_INTERVAL_P (i
->left
))
1216 if (NULL_INTERVAL_P (i
->right
))
1220 migrate_amt
= i
->left
->total_length
;
1222 this->total_length
+= migrate_amt
;
1223 while (! NULL_INTERVAL_P (this->left
))
1226 this->total_length
+= migrate_amt
;
1228 this->left
= migrate
;
1229 SET_INTERVAL_PARENT (migrate
, this);
1234 /* Delete interval I from its tree by calling `delete_node'
1235 and properly connecting the resultant subtree.
1237 I is presumed to be empty; that is, no adjustments are made
1238 for the length of I. */
1242 register INTERVAL i
;
1244 register INTERVAL parent
;
1245 int amt
= LENGTH (i
);
1247 if (amt
> 0) /* Only used on zero-length intervals now. */
1250 if (ROOT_INTERVAL_P (i
))
1253 GET_INTERVAL_OBJECT (owner
, i
);
1254 parent
= delete_node (i
);
1255 if (! NULL_INTERVAL_P (parent
))
1256 SET_INTERVAL_OBJECT (parent
, owner
);
1258 if (BUFFERP (owner
))
1259 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1260 else if (STRINGP (owner
))
1261 XSTRING (owner
)->intervals
= parent
;
1268 parent
= INTERVAL_PARENT (i
);
1269 if (AM_LEFT_CHILD (i
))
1271 parent
->left
= delete_node (i
);
1272 if (! NULL_INTERVAL_P (parent
->left
))
1273 SET_INTERVAL_PARENT (parent
->left
, parent
);
1277 parent
->right
= delete_node (i
);
1278 if (! NULL_INTERVAL_P (parent
->right
))
1279 SET_INTERVAL_PARENT (parent
->right
, parent
);
1283 /* Find the interval in TREE corresponding to the relative position
1284 FROM and delete as much as possible of AMOUNT from that interval.
1285 Return the amount actually deleted, and if the interval was
1286 zeroed-out, delete that interval node from the tree.
1288 Note that FROM is actually origin zero, aka relative to the
1289 leftmost edge of tree. This is appropriate since we call ourselves
1290 recursively on subtrees.
1292 Do this by recursing down TREE to the interval in question, and
1293 deleting the appropriate amount of text. */
1296 interval_deletion_adjustment (tree
, from
, amount
)
1297 register INTERVAL tree
;
1298 register int from
, amount
;
1300 register int relative_position
= from
;
1302 if (NULL_INTERVAL_P (tree
))
1306 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1308 int subtract
= interval_deletion_adjustment (tree
->left
,
1311 tree
->total_length
-= subtract
;
1315 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1316 - RIGHT_TOTAL_LENGTH (tree
)))
1320 relative_position
-= (tree
->total_length
1321 - RIGHT_TOTAL_LENGTH (tree
));
1322 subtract
= interval_deletion_adjustment (tree
->right
,
1325 tree
->total_length
-= subtract
;
1328 /* Here -- this node. */
1331 /* How much can we delete from this interval? */
1332 int my_amount
= ((tree
->total_length
1333 - RIGHT_TOTAL_LENGTH (tree
))
1334 - relative_position
);
1336 if (amount
> my_amount
)
1339 tree
->total_length
-= amount
;
1340 if (LENGTH (tree
) == 0)
1341 delete_interval (tree
);
1346 /* Never reach here. */
1349 /* Effect the adjustments necessary to the interval tree of BUFFER to
1350 correspond to the deletion of LENGTH characters from that buffer
1351 text. The deletion is effected at position START (which is a
1352 buffer position, i.e. origin 1). */
1355 adjust_intervals_for_deletion (buffer
, start
, length
)
1356 struct buffer
*buffer
;
1359 register int left_to_delete
= length
;
1360 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1364 GET_INTERVAL_OBJECT (parent
, tree
);
1365 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1367 if (NULL_INTERVAL_P (tree
))
1370 if (start
> offset
+ TOTAL_LENGTH (tree
)
1371 || start
+ length
> offset
+ TOTAL_LENGTH (tree
))
1374 if (length
== TOTAL_LENGTH (tree
))
1376 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1380 if (ONLY_INTERVAL_P (tree
))
1382 tree
->total_length
-= length
;
1386 if (start
> offset
+ TOTAL_LENGTH (tree
))
1387 start
= offset
+ TOTAL_LENGTH (tree
);
1388 while (left_to_delete
> 0)
1390 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1392 tree
= BUF_INTERVALS (buffer
);
1393 if (left_to_delete
== tree
->total_length
)
1395 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1401 /* Make the adjustments necessary to the interval tree of BUFFER to
1402 represent an addition or deletion of LENGTH characters starting
1403 at position START. Addition or deletion is indicated by the sign
1407 offset_intervals (buffer
, start
, length
)
1408 struct buffer
*buffer
;
1411 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1415 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1417 adjust_intervals_for_deletion (buffer
, start
, -length
);
1420 /* Merge interval I with its lexicographic successor. The resulting
1421 interval is returned, and has the properties of the original
1422 successor. The properties of I are lost. I is removed from the
1426 The caller must verify that this is not the last (rightmost)
1430 merge_interval_right (i
)
1431 register INTERVAL i
;
1433 register int absorb
= LENGTH (i
);
1434 register INTERVAL successor
;
1436 /* Zero out this interval. */
1437 i
->total_length
-= absorb
;
1439 /* Find the succeeding interval. */
1440 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1443 successor
= i
->right
;
1444 while (! NULL_LEFT_CHILD (successor
))
1446 successor
->total_length
+= absorb
;
1447 successor
= successor
->left
;
1450 successor
->total_length
+= absorb
;
1451 delete_interval (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
;
1470 /* This must be the rightmost or last interval and cannot
1471 be merged right. The caller should have known. */
1475 /* Merge interval I with its lexicographic predecessor. The resulting
1476 interval is returned, and has the properties of the original predecessor.
1477 The properties of I are lost. Interval node I is removed from the tree.
1480 The caller must verify that this is not the first (leftmost) interval. */
1483 merge_interval_left (i
)
1484 register INTERVAL i
;
1486 register int absorb
= LENGTH (i
);
1487 register INTERVAL predecessor
;
1489 /* Zero out this interval. */
1490 i
->total_length
-= absorb
;
1492 /* Find the preceding interval. */
1493 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1494 adding ABSORB as we go. */
1496 predecessor
= i
->left
;
1497 while (! NULL_RIGHT_CHILD (predecessor
))
1499 predecessor
->total_length
+= absorb
;
1500 predecessor
= predecessor
->right
;
1503 predecessor
->total_length
+= absorb
;
1504 delete_interval (i
);
1509 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1510 subtracting ABSORB. */
1512 if (AM_RIGHT_CHILD (predecessor
))
1514 predecessor
= INTERVAL_PARENT (predecessor
);
1515 delete_interval (i
);
1519 predecessor
= INTERVAL_PARENT (predecessor
);
1520 predecessor
->total_length
-= absorb
;
1523 /* This must be the leftmost or first interval and cannot
1524 be merged left. The caller should have known. */
1528 /* Make an exact copy of interval tree SOURCE which descends from
1529 PARENT. This is done by recursing through SOURCE, copying
1530 the current interval and its properties, and then adjusting
1531 the pointers of the copy. */
1534 reproduce_tree (source
, parent
)
1535 INTERVAL source
, parent
;
1537 register INTERVAL t
= make_interval ();
1539 bcopy (source
, t
, INTERVAL_SIZE
);
1540 copy_properties (source
, t
);
1541 SET_INTERVAL_PARENT (t
, parent
);
1542 if (! NULL_LEFT_CHILD (source
))
1543 t
->left
= reproduce_tree (source
->left
, t
);
1544 if (! NULL_RIGHT_CHILD (source
))
1545 t
->right
= reproduce_tree (source
->right
, t
);
1551 reproduce_tree_obj (source
, parent
)
1555 register INTERVAL t
= make_interval ();
1557 bcopy (source
, t
, INTERVAL_SIZE
);
1558 copy_properties (source
, t
);
1559 SET_INTERVAL_OBJECT (t
, parent
);
1560 if (! NULL_LEFT_CHILD (source
))
1561 t
->left
= reproduce_tree (source
->left
, t
);
1562 if (! NULL_RIGHT_CHILD (source
))
1563 t
->right
= reproduce_tree (source
->right
, t
);
1569 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1571 /* Make a new interval of length LENGTH starting at START in the
1572 group of intervals INTERVALS, which is actually an interval tree.
1573 Returns the new interval.
1575 Generate an error if the new positions would overlap an existing
1579 make_new_interval (intervals
, start
, length
)
1585 slot
= find_interval (intervals
, start
);
1586 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1587 error ("Interval would overlap");
1589 if (start
== slot
->position
&& length
== LENGTH (slot
))
1592 if (slot
->position
== start
)
1594 /* New right node. */
1595 split_interval_right (slot
, length
);
1599 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1601 /* New left node. */
1602 split_interval_left (slot
, LENGTH (slot
) - length
);
1606 /* Convert interval SLOT into three intervals. */
1607 split_interval_left (slot
, start
- slot
->position
);
1608 split_interval_right (slot
, length
);
1613 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1614 LENGTH is the length of the text in SOURCE.
1616 The `position' field of the SOURCE intervals is assumed to be
1617 consistent with its parent; therefore, SOURCE must be an
1618 interval tree made with copy_interval or must be the whole
1619 tree of a buffer or a string.
1621 This is used in insdel.c when inserting Lisp_Strings into the
1622 buffer. The text corresponding to SOURCE is already in the buffer
1623 when this is called. The intervals of new tree are a copy of those
1624 belonging to the string being inserted; intervals are never
1627 If the inserted text had no intervals associated, and we don't
1628 want to inherit the surrounding text's properties, this function
1629 simply returns -- offset_intervals should handle placing the
1630 text in the correct interval, depending on the sticky bits.
1632 If the inserted text had properties (intervals), then there are two
1633 cases -- either insertion happened in the middle of some interval,
1634 or between two intervals.
1636 If the text goes into the middle of an interval, then new
1637 intervals are created in the middle with only the properties of
1638 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1639 which case the new text has the union of its properties and those
1640 of the text into which it was inserted.
1642 If the text goes between two intervals, then if neither interval
1643 had its appropriate sticky property set (front_sticky, rear_sticky),
1644 the new text has only its properties. If one of the sticky properties
1645 is set, then the new text "sticks" to that region and its properties
1646 depend on merging as above. If both the preceding and succeeding
1647 intervals to the new text are "sticky", then the new text retains
1648 only its properties, as if neither sticky property were set. Perhaps
1649 we should consider merging all three sets of properties onto the new
1653 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1655 int position
, length
;
1656 struct buffer
*buffer
;
1659 register INTERVAL under
, over
, this, prev
;
1660 register INTERVAL tree
;
1663 tree
= BUF_INTERVALS (buffer
);
1665 /* If the new text has no properties, it becomes part of whatever
1666 interval it was inserted into. */
1667 if (NULL_INTERVAL_P (source
))
1670 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1672 int saved_inhibit_modification_hooks
= inhibit_modification_hooks
;
1673 XSETBUFFER (buf
, buffer
);
1674 inhibit_modification_hooks
= 1;
1675 Fset_text_properties (make_number (position
),
1676 make_number (position
+ length
),
1678 inhibit_modification_hooks
= saved_inhibit_modification_hooks
;
1680 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1681 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1685 if (NULL_INTERVAL_P (tree
))
1687 /* The inserted text constitutes the whole buffer, so
1688 simply copy over the interval structure. */
1689 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1692 XSETBUFFER (buf
, buffer
);
1693 BUF_INTERVALS (buffer
) = reproduce_tree_obj (source
, buf
);
1694 BUF_INTERVALS (buffer
)->position
= 1;
1696 /* Explicitly free the old tree here? */
1701 /* Create an interval tree in which to place a copy
1702 of the intervals of the inserted string. */
1705 XSETBUFFER (buf
, buffer
);
1706 tree
= create_root_interval (buf
);
1709 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1710 /* If the buffer contains only the new string, but
1711 there was already some interval tree there, then it may be
1712 some zero length intervals. Eventually, do something clever
1713 about inserting properly. For now, just waste the old intervals. */
1715 BUF_INTERVALS (buffer
) = reproduce_tree (source
, INTERVAL_PARENT (tree
));
1716 BUF_INTERVALS (buffer
)->position
= 1;
1717 /* Explicitly free the old tree here. */
1721 /* Paranoia -- the text has already been added, so this buffer
1722 should be of non-zero length. */
1723 else if (TOTAL_LENGTH (tree
) == 0)
1726 this = under
= find_interval (tree
, position
);
1727 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1729 over
= find_interval (source
, interval_start_pos (source
));
1731 /* Here for insertion in the middle of an interval.
1732 Split off an equivalent interval to the right,
1733 then don't bother with it any more. */
1735 if (position
> under
->position
)
1737 INTERVAL end_unchanged
1738 = split_interval_left (this, position
- under
->position
);
1739 copy_properties (under
, end_unchanged
);
1740 under
->position
= position
;
1742 /* This code has no effect. */
1749 /* This call may have some effect because previous_interval may
1750 update `position' fields of intervals. Thus, don't ignore it
1751 for the moment. Someone please tell me the truth (K.Handa). */
1752 prev
= previous_interval (under
);
1754 /* But, this code surely has no effect. And, anyway,
1755 END_NONSTICKY_P is unreliable now. */
1756 if (prev
&& !END_NONSTICKY_P (prev
))
1761 /* Insertion is now at beginning of UNDER. */
1763 /* The inserted text "sticks" to the interval `under',
1764 which means it gets those properties.
1765 The properties of under are the result of
1766 adjust_intervals_for_insertion, so stickiness has
1767 already been taken care of. */
1769 while (! NULL_INTERVAL_P (over
))
1771 if (LENGTH (over
) < LENGTH (under
))
1773 this = split_interval_left (under
, LENGTH (over
));
1774 copy_properties (under
, this);
1778 copy_properties (over
, this);
1780 merge_properties (over
, this);
1782 copy_properties (over
, this);
1783 over
= next_interval (over
);
1786 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1787 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1791 /* Get the value of property PROP from PLIST,
1792 which is the plist of an interval.
1793 We check for direct properties, for categories with property PROP,
1794 and for PROP appearing on the default-text-properties list. */
1797 textget (plist
, prop
)
1799 register Lisp_Object prop
;
1801 register Lisp_Object tail
, fallback
;
1804 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1806 register Lisp_Object tem
;
1809 return Fcar (Fcdr (tail
));
1810 if (EQ (tem
, Qcategory
))
1812 tem
= Fcar (Fcdr (tail
));
1814 fallback
= Fget (tem
, prop
);
1818 if (! NILP (fallback
))
1820 if (CONSP (Vdefault_text_properties
))
1821 return Fplist_get (Vdefault_text_properties
, prop
);
1826 /* Set point "temporarily", without checking any text properties. */
1829 temp_set_point (buffer
, charpos
)
1830 struct buffer
*buffer
;
1833 temp_set_point_both (buffer
, charpos
,
1834 buf_charpos_to_bytepos (buffer
, charpos
));
1837 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1838 byte position BYTEPOS. */
1841 temp_set_point_both (buffer
, charpos
, bytepos
)
1842 int charpos
, bytepos
;
1843 struct buffer
*buffer
;
1845 /* In a single-byte buffer, the two positions must be equal. */
1846 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1847 && charpos
!= bytepos
)
1850 if (charpos
> bytepos
)
1853 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1856 BUF_PT_BYTE (buffer
) = bytepos
;
1857 BUF_PT (buffer
) = charpos
;
1860 /* Set point in BUFFER to CHARPOS. If the target position is
1861 before an intangible character, move to an ok place. */
1864 set_point (buffer
, charpos
)
1865 register struct buffer
*buffer
;
1866 register int charpos
;
1868 set_point_both (buffer
, charpos
, buf_charpos_to_bytepos (buffer
, charpos
));
1871 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1872 position BYTEPOS. If the target position is
1873 before an intangible character, move to an ok place. */
1876 set_point_both (buffer
, charpos
, bytepos
)
1877 register struct buffer
*buffer
;
1878 register int charpos
, bytepos
;
1880 register INTERVAL to
, from
, toprev
, fromprev
;
1882 int old_position
= BUF_PT (buffer
);
1883 int backwards
= (charpos
< old_position
? 1 : 0);
1885 int original_position
;
1887 buffer
->point_before_scroll
= Qnil
;
1889 if (charpos
== BUF_PT (buffer
))
1892 /* In a single-byte buffer, the two positions must be equal. */
1893 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1894 && charpos
!= bytepos
)
1897 /* Check this now, before checking if the buffer has any intervals.
1898 That way, we can catch conditions which break this sanity check
1899 whether or not there are intervals in the buffer. */
1900 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1903 have_overlays
= (! NILP (buffer
->overlays_before
)
1904 || ! NILP (buffer
->overlays_after
));
1906 /* If we have no text properties and overlays,
1907 then we can do it quickly. */
1908 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1910 temp_set_point_both (buffer
, charpos
, bytepos
);
1914 /* Set TO to the interval containing the char after CHARPOS,
1915 and TOPREV to the interval containing the char before CHARPOS.
1916 Either one may be null. They may be equal. */
1917 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1918 if (charpos
== BUF_BEGV (buffer
))
1920 else if (to
&& to
->position
== charpos
)
1921 toprev
= previous_interval (to
);
1925 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1926 ? BUF_ZV (buffer
) - 1
1929 /* Set FROM to the interval containing the char after PT,
1930 and FROMPREV to the interval containing the char before PT.
1931 Either one may be null. They may be equal. */
1932 /* We could cache this and save time. */
1933 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1934 if (buffer_point
== BUF_BEGV (buffer
))
1936 else if (from
&& from
->position
== BUF_PT (buffer
))
1937 fromprev
= previous_interval (from
);
1938 else if (buffer_point
!= BUF_PT (buffer
))
1939 fromprev
= from
, from
= 0;
1943 /* Moving within an interval. */
1944 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1947 temp_set_point_both (buffer
, charpos
, bytepos
);
1951 original_position
= charpos
;
1953 /* If the new position is between two intangible characters
1954 with the same intangible property value,
1955 move forward or backward until a change in that property. */
1956 if (NILP (Vinhibit_point_motion_hooks
)
1957 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1959 /* Intangibility never stops us from positioning at the beginning
1960 or end of the buffer, so don't bother checking in that case. */
1961 && charpos
!= BEGV
&& charpos
!= ZV
)
1963 Lisp_Object intangible_propval
;
1966 XSETINT (pos
, charpos
);
1970 intangible_propval
= Fget_char_property (make_number (charpos
),
1973 /* If following char is intangible,
1974 skip back over all chars with matching intangible property. */
1975 if (! NILP (intangible_propval
))
1976 while (XINT (pos
) > BUF_BEGV (buffer
)
1977 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1979 intangible_propval
))
1980 pos
= Fprevious_char_property_change (pos
, Qnil
);
1984 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
1987 /* If following char is intangible,
1988 skip forward over all chars with matching intangible property. */
1989 if (! NILP (intangible_propval
))
1990 while (XINT (pos
) < BUF_ZV (buffer
)
1991 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1992 intangible_propval
))
1993 pos
= Fnext_char_property_change (pos
, Qnil
);
1997 charpos
= XINT (pos
);
1998 bytepos
= buf_charpos_to_bytepos (buffer
, charpos
);
2001 if (charpos
!= original_position
)
2003 /* Set TO to the interval containing the char after CHARPOS,
2004 and TOPREV to the interval containing the char before CHARPOS.
2005 Either one may be null. They may be equal. */
2006 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
2007 if (charpos
== BUF_BEGV (buffer
))
2009 else if (to
&& to
->position
== charpos
)
2010 toprev
= previous_interval (to
);
2015 /* Here TO is the interval after the stopping point
2016 and TOPREV is the interval before the stopping point.
2017 One or the other may be null. */
2019 temp_set_point_both (buffer
, charpos
, bytepos
);
2021 /* We run point-left and point-entered hooks here, iff the
2022 two intervals are not equivalent. These hooks take
2023 (old_point, new_point) as arguments. */
2024 if (NILP (Vinhibit_point_motion_hooks
)
2025 && (! intervals_equal (from
, to
)
2026 || ! intervals_equal (fromprev
, toprev
)))
2028 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
2031 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
2035 leave_before
= textget (from
->plist
, Qpoint_left
);
2037 leave_before
= Qnil
;
2040 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
2044 enter_before
= textget (to
->plist
, Qpoint_entered
);
2046 enter_before
= Qnil
;
2048 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
2049 call2 (leave_before
, make_number (old_position
),
2050 make_number (charpos
));
2051 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
2052 call2 (leave_after
, make_number (old_position
),
2053 make_number (charpos
));
2055 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
2056 call2 (enter_before
, make_number (old_position
),
2057 make_number (charpos
));
2058 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
2059 call2 (enter_after
, make_number (old_position
),
2060 make_number (charpos
));
2064 /* Move point to POSITION, unless POSITION is inside an intangible
2065 segment that reaches all the way to point. */
2068 move_if_not_intangible (position
)
2072 Lisp_Object intangible_propval
;
2074 XSETINT (pos
, position
);
2076 if (! NILP (Vinhibit_point_motion_hooks
))
2077 /* If intangible is inhibited, always move point to POSITION. */
2079 else if (PT
< position
&& XINT (pos
) < ZV
)
2081 /* We want to move forward, so check the text before POSITION. */
2083 intangible_propval
= Fget_char_property (pos
,
2086 /* If following char is intangible,
2087 skip back over all chars with matching intangible property. */
2088 if (! NILP (intangible_propval
))
2089 while (XINT (pos
) > BEGV
2090 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
2092 intangible_propval
))
2093 pos
= Fprevious_char_property_change (pos
, Qnil
);
2095 else if (XINT (pos
) > BEGV
)
2097 /* We want to move backward, so check the text after POSITION. */
2099 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2102 /* If following char is intangible,
2103 skip forward over all chars with matching intangible property. */
2104 if (! NILP (intangible_propval
))
2105 while (XINT (pos
) < ZV
2106 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2107 intangible_propval
))
2108 pos
= Fnext_char_property_change (pos
, Qnil
);
2112 /* If the whole stretch between PT and POSITION isn't intangible,
2113 try moving to POSITION (which means we actually move farther
2114 if POSITION is inside of intangible text). */
2116 if (XINT (pos
) != PT
)
2120 /* If text at position POS has property PROP, set *VAL to the property
2121 value, *START and *END to the beginning and end of a region that
2122 has the same property, and return 1. Otherwise return 0.
2124 OBJECT is the string or buffer to look for the property in;
2125 nil means the current buffer. */
2128 get_property_and_range (pos
, prop
, val
, start
, end
, object
)
2130 Lisp_Object prop
, *val
;
2134 INTERVAL i
, prev
, next
;
2137 i
= find_interval (BUF_INTERVALS (current_buffer
), pos
);
2138 else if (BUFFERP (object
))
2139 i
= find_interval (BUF_INTERVALS (XBUFFER (object
)), pos
);
2140 else if (STRINGP (object
))
2141 i
= find_interval (XSTRING (object
)->intervals
, pos
);
2145 if (NULL_INTERVAL_P (i
) || (i
->position
+ LENGTH (i
) <= pos
))
2147 *val
= textget (i
->plist
, prop
);
2151 next
= i
; /* remember it in advance */
2152 prev
= previous_interval (i
);
2153 while (! NULL_INTERVAL_P (prev
)
2154 && EQ (*val
, textget (prev
->plist
, prop
)))
2155 i
= prev
, prev
= previous_interval (prev
);
2156 *start
= i
->position
;
2158 next
= next_interval (i
);
2159 while (! NULL_INTERVAL_P (next
)
2160 && EQ (*val
, textget (next
->plist
, prop
)))
2161 i
= next
, next
= next_interval (next
);
2162 *end
= i
->position
+ LENGTH (i
);
2167 /* Return the proper local keymap TYPE for position POSITION in
2168 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2169 specified by the PROP property, if any. Otherwise, if TYPE is
2170 `local-map' use BUFFER's local map. */
2173 get_local_map (position
, buffer
, type
)
2174 register int position
;
2175 register struct buffer
*buffer
;
2178 Lisp_Object prop
, lispy_position
, lispy_buffer
;
2179 int old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2181 /* Perhaps we should just change `position' to the limit. */
2182 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
2185 /* Ignore narrowing, so that a local map continues to be valid even if
2186 the visible region contains no characters and hence no properties. */
2187 old_begv
= BUF_BEGV (buffer
);
2188 old_zv
= BUF_ZV (buffer
);
2189 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2190 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2191 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
2192 BUF_ZV (buffer
) = BUF_Z (buffer
);
2193 BUF_BEGV_BYTE (buffer
) = BUF_BEG_BYTE (buffer
);
2194 BUF_ZV_BYTE (buffer
) = BUF_Z_BYTE (buffer
);
2196 /* There are no properties at the end of the buffer, so in that case
2197 check for a local map on the last character of the buffer instead. */
2198 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
2200 XSETFASTINT (lispy_position
, position
);
2201 XSETBUFFER (lispy_buffer
, buffer
);
2202 prop
= Fget_char_property (lispy_position
, type
, lispy_buffer
);
2204 BUF_BEGV (buffer
) = old_begv
;
2205 BUF_ZV (buffer
) = old_zv
;
2206 BUF_BEGV_BYTE (buffer
) = old_begv_byte
;
2207 BUF_ZV_BYTE (buffer
) = old_zv_byte
;
2209 /* Use the local map only if it is valid. */
2210 prop
= get_keymap (prop
, 0, 0);
2214 if (EQ (type
, Qkeymap
))
2217 return buffer
->keymap
;
2220 /* Produce an interval tree reflecting the intervals in
2221 TREE from START to START + LENGTH.
2222 The new interval tree has no parent and has a starting-position of 0. */
2225 copy_intervals (tree
, start
, length
)
2229 register INTERVAL i
, new, t
;
2230 register int got
, prevlen
;
2232 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2233 return NULL_INTERVAL
;
2235 i
= find_interval (tree
, start
);
2236 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2239 /* If there is only one interval and it's the default, return nil. */
2240 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2241 && DEFAULT_INTERVAL_P (i
))
2242 return NULL_INTERVAL
;
2244 new = make_interval ();
2246 got
= (LENGTH (i
) - (start
- i
->position
));
2247 new->total_length
= length
;
2248 copy_properties (i
, new);
2252 while (got
< length
)
2254 i
= next_interval (i
);
2255 t
= split_interval_right (t
, prevlen
);
2256 copy_properties (i
, t
);
2257 prevlen
= LENGTH (i
);
2261 return balance_an_interval (new);
2264 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2267 copy_intervals_to_string (string
, buffer
, position
, length
)
2269 struct buffer
*buffer
;
2270 int position
, length
;
2272 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2274 if (NULL_INTERVAL_P (interval_copy
))
2277 SET_INTERVAL_OBJECT (interval_copy
, string
);
2278 XSTRING (string
)->intervals
= interval_copy
;
2281 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2282 Assume they have identical characters. */
2285 compare_string_intervals (s1
, s2
)
2290 int end
= XSTRING (s1
)->size
;
2292 i1
= find_interval (XSTRING (s1
)->intervals
, 0);
2293 i2
= find_interval (XSTRING (s2
)->intervals
, 0);
2297 /* Determine how far we can go before we reach the end of I1 or I2. */
2298 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2299 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2300 int distance
= min (len1
, len2
);
2302 /* If we ever find a mismatch between the strings,
2304 if (! intervals_equal (i1
, i2
))
2307 /* Advance POS till the end of the shorter interval,
2308 and advance one or both interval pointers for the new position. */
2310 if (len1
== distance
)
2311 i1
= next_interval (i1
);
2312 if (len2
== distance
)
2313 i2
= next_interval (i2
);
2318 /* Recursively adjust interval I in the current buffer
2319 for setting enable_multibyte_characters to MULTI_FLAG.
2320 The range of interval I is START ... END in characters,
2321 START_BYTE ... END_BYTE in bytes. */
2324 set_intervals_multibyte_1 (i
, multi_flag
, start
, start_byte
, end
, end_byte
)
2327 int start
, start_byte
, end
, end_byte
;
2329 /* Fix the length of this interval. */
2331 i
->total_length
= end
- start
;
2333 i
->total_length
= end_byte
- start_byte
;
2335 /* Recursively fix the length of the subintervals. */
2338 int left_end
, left_end_byte
;
2342 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2343 left_end
= BYTE_TO_CHAR (left_end_byte
);
2347 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2348 left_end_byte
= CHAR_TO_BYTE (left_end
);
2351 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2352 left_end
, left_end_byte
);
2356 int right_start_byte
, right_start
;
2360 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2361 right_start
= BYTE_TO_CHAR (right_start_byte
);
2365 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2366 right_start_byte
= CHAR_TO_BYTE (right_start
);
2369 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2370 right_start
, right_start_byte
,
2375 /* Update the intervals of the current buffer
2376 to fit the contents as multibyte (if MULTI_FLAG is 1)
2377 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2380 set_intervals_multibyte (multi_flag
)
2383 if (BUF_INTERVALS (current_buffer
))
2384 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer
), multi_flag
,
2385 BEG
, BEG_BYTE
, Z
, Z_BYTE
);