1 /* Code for doing intervals.
2 Copyright (C) 1993-1995, 1997-1998, 2001-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 Have to ensure that we can't put symbol nil on a plist, or some
23 functions may work incorrectly.
25 An idea: Have the owner of the tree keep count of splits and/or
26 insertion lengths (in intervals), and balance after every N.
28 Need to call *_left_hook when buffer is killed.
30 Scan for zero-length, or 0-length to see notes about handling
31 zero length interval-markers.
33 There are comments around about freeing intervals. It might be
34 faster to explicitly free them (put them on the free list) than
42 #define INTERVALS_INLINE EXTERN_INLINE
47 #include "intervals.h"
48 #include "character.h"
54 /* Test for membership, allowing for t (actually any non-cons) to mean the
57 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
59 static Lisp_Object
merge_properties_sticky (Lisp_Object
, Lisp_Object
);
60 static INTERVAL
merge_interval_right (INTERVAL
);
61 static INTERVAL
reproduce_tree (INTERVAL
, INTERVAL
);
62 static INTERVAL
reproduce_tree_obj (INTERVAL
, Lisp_Object
);
64 /* Utility functions for intervals. */
67 /* Create the root interval of some object, a buffer or string. */
70 create_root_interval (Lisp_Object parent
)
74 CHECK_IMPURE (parent
);
76 new = make_interval ();
80 new->total_length
= (BUF_Z (XBUFFER (parent
))
81 - BUF_BEG (XBUFFER (parent
)));
82 eassert (0 <= TOTAL_LENGTH (new));
83 buffer_set_intervals (XBUFFER (parent
), new);
86 else if (STRINGP (parent
))
88 new->total_length
= SCHARS (parent
);
89 eassert (0 <= TOTAL_LENGTH (new));
90 string_set_intervals (parent
, new);
94 interval_set_object (new, parent
);
99 /* Make the interval TARGET have exactly the properties of SOURCE */
102 copy_properties (register INTERVAL source
, register INTERVAL target
)
104 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
107 COPY_INTERVAL_CACHE (source
, target
);
108 interval_set_plist (target
, Fcopy_sequence (source
->plist
));
111 /* Merge the properties of interval SOURCE into the properties
112 of interval TARGET. That is to say, each property in SOURCE
113 is added to TARGET if TARGET has no such property as yet. */
116 merge_properties (register INTERVAL source
, register INTERVAL target
)
118 register Lisp_Object o
, sym
, val
;
120 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
123 MERGE_INTERVAL_CACHE (source
, target
);
133 while (CONSP (val
) && !EQ (XCAR (val
), sym
))
144 interval_set_plist (target
, Fcons (sym
, Fcons (val
, target
->plist
)));
150 /* Return 1 if the two intervals have the same properties,
154 intervals_equal (INTERVAL i0
, INTERVAL i1
)
156 register Lisp_Object i0_cdr
, i0_sym
;
157 register Lisp_Object i1_cdr
, i1_val
;
159 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
162 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
167 while (CONSP (i0_cdr
) && CONSP (i1_cdr
))
169 i0_sym
= XCAR (i0_cdr
);
170 i0_cdr
= XCDR (i0_cdr
);
172 return 0; /* abort (); */
174 while (CONSP (i1_val
) && !EQ (XCAR (i1_val
), i0_sym
))
176 i1_val
= XCDR (i1_val
);
178 return 0; /* abort (); */
179 i1_val
= XCDR (i1_val
);
182 /* i0 has something i1 doesn't. */
183 if (EQ (i1_val
, Qnil
))
186 /* i0 and i1 both have sym, but it has different values in each. */
188 || (i1_val
= XCDR (i1_val
), !CONSP (i1_val
))
189 || !EQ (XCAR (i1_val
), XCAR (i0_cdr
)))
192 i0_cdr
= XCDR (i0_cdr
);
194 i1_cdr
= XCDR (i1_cdr
);
196 return 0; /* abort (); */
197 i1_cdr
= XCDR (i1_cdr
);
200 /* Lengths of the two plists were equal. */
201 return (NILP (i0_cdr
) && NILP (i1_cdr
));
205 /* Traverse an interval tree TREE, performing FUNCTION on each node.
206 No guarantee is made about the order of traversal.
207 Pass FUNCTION two args: an interval, and ARG. */
210 traverse_intervals_noorder (INTERVAL tree
, void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
212 /* Minimize stack usage. */
215 (*function
) (tree
, arg
);
220 traverse_intervals_noorder (tree
->left
, function
, arg
);
226 /* Traverse an interval tree TREE, performing FUNCTION on each node.
227 Pass FUNCTION two args: an interval, and ARG. */
230 traverse_intervals (INTERVAL tree
, ptrdiff_t position
,
231 void (*function
) (INTERVAL
, Lisp_Object
), Lisp_Object arg
)
235 traverse_intervals (tree
->left
, position
, function
, arg
);
236 position
+= LEFT_TOTAL_LENGTH (tree
);
237 tree
->position
= position
;
238 (*function
) (tree
, arg
);
239 position
+= LENGTH (tree
); tree
= tree
->right
;
247 static int zero_length
;
249 /* These functions are temporary, for debugging purposes only. */
251 INTERVAL search_interval
, found_interval
;
254 check_for_interval (INTERVAL i
)
256 if (i
== search_interval
)
264 search_for_interval (INTERVAL i
, INTERVAL tree
)
268 found_interval
= NULL
;
269 traverse_intervals_noorder (tree
, &check_for_interval
, Qnil
);
270 return found_interval
;
274 inc_interval_count (INTERVAL i
)
284 count_intervals (INTERVAL i
)
289 traverse_intervals_noorder (i
, &inc_interval_count
, Qnil
);
295 root_interval (INTERVAL interval
)
297 register INTERVAL i
= interval
;
299 while (! ROOT_INTERVAL_P (i
))
300 i
= INTERVAL_PARENT (i
);
306 /* Assuming that a left child exists, perform the following operation:
315 static inline INTERVAL
316 rotate_right (INTERVAL interval
)
319 INTERVAL B
= interval
->left
;
320 ptrdiff_t old_total
= interval
->total_length
;
322 /* Deal with any Parent of A; make it point to B. */
323 if (! ROOT_INTERVAL_P (interval
))
325 if (AM_LEFT_CHILD (interval
))
326 interval_set_left (INTERVAL_PARENT (interval
), B
);
328 interval_set_right (INTERVAL_PARENT (interval
), B
);
330 interval_copy_parent (B
, interval
);
332 /* Make B the parent of A */
334 interval_set_right (B
, interval
);
335 interval_set_parent (interval
, B
);
337 /* Make A point to c */
338 interval_set_left (interval
, i
);
340 interval_set_parent (i
, interval
);
342 /* A's total length is decreased by the length of B and its left child. */
343 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
344 eassert (0 <= TOTAL_LENGTH (interval
));
346 /* B must have the same total length of A. */
347 B
->total_length
= old_total
;
348 eassert (0 <= TOTAL_LENGTH (B
));
353 /* Assuming that a right child exists, perform the following operation:
362 static inline INTERVAL
363 rotate_left (INTERVAL interval
)
366 INTERVAL B
= interval
->right
;
367 ptrdiff_t old_total
= interval
->total_length
;
369 /* Deal with any parent of A; make it point to B. */
370 if (! ROOT_INTERVAL_P (interval
))
372 if (AM_LEFT_CHILD (interval
))
373 interval_set_left (INTERVAL_PARENT (interval
), B
);
375 interval_set_right (INTERVAL_PARENT (interval
), B
);
377 interval_copy_parent (B
, interval
);
379 /* Make B the parent of A */
381 interval_set_left (B
, interval
);
382 interval_set_parent (interval
, B
);
384 /* Make A point to c */
385 interval_set_right (interval
, i
);
387 interval_set_parent (i
, interval
);
389 /* A's total length is decreased by the length of B and its right child. */
390 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
391 eassert (0 <= TOTAL_LENGTH (interval
));
393 /* B must have the same total length of A. */
394 B
->total_length
= old_total
;
395 eassert (0 <= TOTAL_LENGTH (B
));
400 /* Balance an interval tree with the assumption that the subtrees
401 themselves are already balanced. */
404 balance_an_interval (INTERVAL i
)
406 register ptrdiff_t old_diff
, new_diff
;
410 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
413 /* Since the left child is longer, there must be one. */
414 new_diff
= i
->total_length
- i
->left
->total_length
415 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
416 if (eabs (new_diff
) >= old_diff
)
418 i
= rotate_right (i
);
419 balance_an_interval (i
->right
);
421 else if (old_diff
< 0)
423 /* Since the right child is longer, there must be one. */
424 new_diff
= i
->total_length
- i
->right
->total_length
425 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
426 if (eabs (new_diff
) >= -old_diff
)
429 balance_an_interval (i
->left
);
437 /* Balance INTERVAL, potentially stuffing it back into its parent
440 static inline INTERVAL
441 balance_possible_root_interval (register INTERVAL interval
)
446 if (!INTERVAL_HAS_OBJECT (interval
) && !INTERVAL_HAS_PARENT (interval
))
449 if (INTERVAL_HAS_OBJECT (interval
))
452 GET_INTERVAL_OBJECT (parent
, interval
);
454 interval
= balance_an_interval (interval
);
458 if (BUFFERP (parent
))
459 buffer_set_intervals (XBUFFER (parent
), interval
);
460 else if (STRINGP (parent
))
461 string_set_intervals (parent
, interval
);
467 /* Balance the interval tree TREE. Balancing is by weight
468 (the amount of text). */
471 balance_intervals_internal (register INTERVAL tree
)
473 /* Balance within each side. */
475 balance_intervals_internal (tree
->left
);
477 balance_intervals_internal (tree
->right
);
478 return balance_an_interval (tree
);
481 /* Advertised interface to balance intervals. */
484 balance_intervals (INTERVAL tree
)
486 return tree
? balance_intervals_internal (tree
) : NULL
;
489 /* Rebalance text properties of B. */
492 buffer_balance_intervals (struct buffer
*b
)
497 i
= buffer_get_intervals (b
);
499 buffer_set_intervals (b
, balance_an_interval (i
));
502 /* Split INTERVAL into two pieces, starting the second piece at
503 character position OFFSET (counting from 0), relative to INTERVAL.
504 INTERVAL becomes the left-hand piece, and the right-hand piece
505 (second, lexicographically) is returned.
507 The size and position fields of the two intervals are set based upon
508 those of the original interval. The property list of the new interval
509 is reset, thus it is up to the caller to do the right thing with the
512 Note that this does not change the position of INTERVAL; if it is a root,
513 it is still a root after this operation. */
516 split_interval_right (INTERVAL interval
, ptrdiff_t offset
)
518 INTERVAL
new = make_interval ();
519 ptrdiff_t position
= interval
->position
;
520 ptrdiff_t new_length
= LENGTH (interval
) - offset
;
522 new->position
= position
+ offset
;
523 interval_set_parent (new, interval
);
525 if (NULL_RIGHT_CHILD (interval
))
527 interval_set_right (interval
, new);
528 new->total_length
= new_length
;
529 eassert (0 <= TOTAL_LENGTH (new));
533 /* Insert the new node between INTERVAL and its right child. */
534 interval_set_right (new, interval
->right
);
535 interval_set_parent (interval
->right
, new);
536 interval_set_right (interval
, new);
537 new->total_length
= new_length
+ new->right
->total_length
;
538 eassert (0 <= TOTAL_LENGTH (new));
539 balance_an_interval (new);
542 balance_possible_root_interval (interval
);
547 /* Split INTERVAL into two pieces, starting the second piece at
548 character position OFFSET (counting from 0), relative to INTERVAL.
549 INTERVAL becomes the right-hand piece, and the left-hand piece
550 (first, lexicographically) is returned.
552 The size and position fields of the two intervals are set based upon
553 those of the original interval. The property list of the new interval
554 is reset, thus it is up to the caller to do the right thing with the
557 Note that this does not change the position of INTERVAL; if it is a root,
558 it is still a root after this operation. */
561 split_interval_left (INTERVAL interval
, ptrdiff_t offset
)
563 INTERVAL
new = make_interval ();
564 ptrdiff_t new_length
= offset
;
566 new->position
= interval
->position
;
567 interval
->position
= interval
->position
+ offset
;
568 interval_set_parent (new, interval
);
570 if (NULL_LEFT_CHILD (interval
))
572 interval_set_left (interval
, new);
573 new->total_length
= new_length
;
574 eassert (0 <= TOTAL_LENGTH (new));
578 /* Insert the new node between INTERVAL and its left child. */
579 interval_set_left (new, interval
->left
);
580 interval_set_parent (new->left
, new);
581 interval_set_left (interval
, new);
582 new->total_length
= new_length
+ new->left
->total_length
;
583 eassert (0 <= TOTAL_LENGTH (new));
584 balance_an_interval (new);
587 balance_possible_root_interval (interval
);
592 /* Return the proper position for the first character
593 described by the interval tree SOURCE.
594 This is 1 if the parent is a buffer,
595 0 if the parent is a string or if there is no parent.
597 Don't use this function on an interval which is the child
598 of another interval! */
601 interval_start_pos (INTERVAL source
)
608 if (! INTERVAL_HAS_OBJECT (source
))
610 GET_INTERVAL_OBJECT (parent
, source
);
611 if (BUFFERP (parent
))
612 return BUF_BEG (XBUFFER (parent
));
616 /* Find the interval containing text position POSITION in the text
617 represented by the interval tree TREE. POSITION is a buffer
618 position (starting from 1) or a string index (starting from 0).
619 If POSITION is at the end of the buffer or string,
620 return the interval containing the last character.
622 The `position' field, which is a cache of an interval's position,
623 is updated in the interval found. Other functions (e.g., next_interval)
624 will update this cache based on the result of find_interval. */
627 find_interval (register INTERVAL tree
, register ptrdiff_t position
)
629 /* The distance from the left edge of the subtree at TREE
631 register ptrdiff_t relative_position
;
636 relative_position
= position
;
637 if (INTERVAL_HAS_OBJECT (tree
))
640 GET_INTERVAL_OBJECT (parent
, tree
);
641 if (BUFFERP (parent
))
642 relative_position
-= BUF_BEG (XBUFFER (parent
));
645 eassert (relative_position
<= TOTAL_LENGTH (tree
));
647 if (!handling_signal
)
648 tree
= balance_possible_root_interval (tree
);
652 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
656 else if (! NULL_RIGHT_CHILD (tree
)
657 && relative_position
>= (TOTAL_LENGTH (tree
)
658 - RIGHT_TOTAL_LENGTH (tree
)))
660 relative_position
-= (TOTAL_LENGTH (tree
)
661 - RIGHT_TOTAL_LENGTH (tree
));
667 = (position
- relative_position
/* left edge of *tree. */
668 + LEFT_TOTAL_LENGTH (tree
)); /* left edge of this interval. */
675 /* Find the succeeding interval (lexicographically) to INTERVAL.
676 Sets the `position' field based on that of INTERVAL (see
680 next_interval (register INTERVAL interval
)
682 register INTERVAL i
= interval
;
683 register ptrdiff_t next_position
;
687 next_position
= interval
->position
+ LENGTH (interval
);
689 if (! NULL_RIGHT_CHILD (i
))
692 while (! NULL_LEFT_CHILD (i
))
695 i
->position
= next_position
;
699 while (! NULL_PARENT (i
))
701 if (AM_LEFT_CHILD (i
))
703 i
= INTERVAL_PARENT (i
);
704 i
->position
= next_position
;
708 i
= INTERVAL_PARENT (i
);
714 /* Find the preceding interval (lexicographically) to INTERVAL.
715 Sets the `position' field based on that of INTERVAL (see
719 previous_interval (register INTERVAL interval
)
726 if (! NULL_LEFT_CHILD (interval
))
729 while (! NULL_RIGHT_CHILD (i
))
732 i
->position
= interval
->position
- LENGTH (i
);
737 while (! NULL_PARENT (i
))
739 if (AM_RIGHT_CHILD (i
))
741 i
= INTERVAL_PARENT (i
);
743 i
->position
= interval
->position
- LENGTH (i
);
746 i
= INTERVAL_PARENT (i
);
752 /* Find the interval containing POS given some non-NULL INTERVAL
753 in the same tree. Note that we need to update interval->position
754 if we go down the tree.
755 To speed up the process, we assume that the ->position of
756 I and all its parents is already uptodate. */
758 update_interval (register INTERVAL i
, ptrdiff_t pos
)
765 if (pos
< i
->position
)
768 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
770 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
771 + LEFT_TOTAL_LENGTH (i
->left
);
772 i
= i
->left
; /* Move to the left child */
774 else if (NULL_PARENT (i
))
775 error ("Point before start of properties");
777 i
= INTERVAL_PARENT (i
);
780 else if (pos
>= INTERVAL_LAST_POS (i
))
783 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
785 i
->right
->position
= INTERVAL_LAST_POS (i
)
786 + LEFT_TOTAL_LENGTH (i
->right
);
787 i
= i
->right
; /* Move to the right child */
789 else if (NULL_PARENT (i
))
790 error ("Point %"pD
"d after end of properties", pos
);
792 i
= INTERVAL_PARENT (i
);
800 /* Effect an adjustment corresponding to the addition of LENGTH characters
801 of text. Do this by finding the interval containing POSITION in the
802 interval tree TREE, and then adjusting all of its ancestors by adding
805 If POSITION is the first character of an interval, meaning that point
806 is actually between the two intervals, make the new text belong to
807 the interval which is "sticky".
809 If both intervals are "sticky", then make them belong to the left-most
810 interval. Another possibility would be to create a new interval for
811 this text, and make it have the merged properties of both ends. */
814 adjust_intervals_for_insertion (INTERVAL tree
,
815 ptrdiff_t position
, ptrdiff_t length
)
818 register INTERVAL temp
;
823 eassert (TOTAL_LENGTH (tree
) > 0);
825 GET_INTERVAL_OBJECT (parent
, tree
);
826 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
828 /* If inserting at point-max of a buffer, that position will be out
829 of range. Remember that buffer positions are 1-based. */
830 if (position
>= TOTAL_LENGTH (tree
) + offset
)
832 position
= TOTAL_LENGTH (tree
) + offset
;
836 i
= find_interval (tree
, position
);
838 /* If in middle of an interval which is not sticky either way,
839 we must not just give its properties to the insertion.
840 So split this interval at the insertion point.
842 Originally, the if condition here was this:
843 (! (position == i->position || eobp)
844 && END_NONSTICKY_P (i)
845 && FRONT_NONSTICKY_P (i))
846 But, these macros are now unreliable because of introduction of
847 Vtext_property_default_nonsticky. So, we always check properties
848 one by one if POSITION is in middle of an interval. */
849 if (! (position
== i
->position
|| eobp
))
852 Lisp_Object front
, rear
;
856 /* Properties font-sticky and rear-nonsticky override
857 Vtext_property_default_nonsticky. So, if they are t, we can
858 skip one by one checking of properties. */
859 rear
= textget (i
->plist
, Qrear_nonsticky
);
860 if (! CONSP (rear
) && ! NILP (rear
))
862 /* All properties are nonsticky. We split the interval. */
865 front
= textget (i
->plist
, Qfront_sticky
);
866 if (! CONSP (front
) && ! NILP (front
))
868 /* All properties are sticky. We don't split the interval. */
873 /* Does any actual property pose an actual problem? We break
874 the loop if we find a nonsticky property. */
875 for (; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
877 Lisp_Object prop
, tmp
;
880 /* Is this particular property front-sticky? */
881 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
884 /* Is this particular property rear-nonsticky? */
885 if (CONSP (rear
) && ! NILP (Fmemq (prop
, rear
)))
888 /* Is this particular property recorded as sticky or
889 nonsticky in Vtext_property_default_nonsticky? */
890 tmp
= Fassq (prop
, Vtext_property_default_nonsticky
);
898 /* By default, a text property is rear-sticky, thus we
899 continue the loop. */
903 /* If any property is a real problem, split the interval. */
906 temp
= split_interval_right (i
, position
- i
->position
);
907 copy_properties (i
, temp
);
912 /* If we are positioned between intervals, check the stickiness of
913 both of them. We have to do this too, if we are at BEG or Z. */
914 if (position
== i
->position
|| eobp
)
916 register INTERVAL prev
;
926 prev
= previous_interval (i
);
928 /* Even if we are positioned between intervals, we default
929 to the left one if it exists. We extend it now and split
930 off a part later, if stickiness demands it. */
931 for (temp
= prev
? prev
: i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
933 temp
->total_length
+= length
;
934 eassert (0 <= TOTAL_LENGTH (temp
));
935 temp
= balance_possible_root_interval (temp
);
938 /* If at least one interval has sticky properties,
939 we check the stickiness property by property.
941 Originally, the if condition here was this:
942 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
943 But, these macros are now unreliable because of introduction
944 of Vtext_property_default_nonsticky. So, we always have to
945 check stickiness of properties one by one. If cache of
946 stickiness is implemented in the future, we may be able to
947 use those macros again. */
950 Lisp_Object pleft
, pright
;
951 struct interval newi
;
953 RESET_INTERVAL (&newi
);
954 pleft
= prev
? prev
->plist
: Qnil
;
955 pright
= i
? i
->plist
: Qnil
;
956 interval_set_plist (&newi
, merge_properties_sticky (pleft
, pright
));
958 if (! prev
) /* i.e. position == BEG */
960 if (! intervals_equal (i
, &newi
))
962 i
= split_interval_left (i
, length
);
963 interval_set_plist (i
, newi
.plist
);
966 else if (! intervals_equal (prev
, &newi
))
968 prev
= split_interval_right (prev
, position
- prev
->position
);
969 interval_set_plist (prev
, newi
.plist
);
970 if (i
&& intervals_equal (prev
, i
))
971 merge_interval_right (prev
);
974 /* We will need to update the cache here later. */
976 else if (! prev
&& ! NILP (i
->plist
))
978 /* Just split off a new interval at the left.
979 Since I wasn't front-sticky, the empty plist is ok. */
980 i
= split_interval_left (i
, length
);
984 /* Otherwise just extend the interval. */
987 for (temp
= i
; temp
; temp
= INTERVAL_PARENT_OR_NULL (temp
))
989 temp
->total_length
+= length
;
990 eassert (0 <= TOTAL_LENGTH (temp
));
991 temp
= balance_possible_root_interval (temp
);
998 /* Any property might be front-sticky on the left, rear-sticky on the left,
999 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1000 can be arranged in a matrix with rows denoting the left conditions and
1001 columns denoting the right conditions:
1009 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1010 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1011 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1012 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1013 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1014 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1015 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1016 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1018 We inherit from whoever has a sticky side facing us. If both sides
1019 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1020 non-nil value for the current property. If both sides do, then we take
1023 When we inherit a property, we get its stickiness as well as its value.
1024 So, when we merge the above two lists, we expect to get this:
1026 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1027 rear-nonsticky (p6 pa)
1028 p0 L p1 L p2 L p3 L p6 R p7 R
1029 pa R pb R pc L pd L pe L pf L)
1031 The optimizable special cases are:
1032 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1033 left rear-nonsticky = t, right front-sticky = t (inherit right)
1034 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1038 merge_properties_sticky (Lisp_Object pleft
, Lisp_Object pright
)
1040 register Lisp_Object props
, front
, rear
;
1041 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1042 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1043 int use_left
, use_right
;
1049 lfront
= textget (pleft
, Qfront_sticky
);
1050 lrear
= textget (pleft
, Qrear_nonsticky
);
1051 rfront
= textget (pright
, Qfront_sticky
);
1052 rrear
= textget (pright
, Qrear_nonsticky
);
1054 /* Go through each element of PRIGHT. */
1055 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1061 /* Sticky properties get special treatment. */
1062 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1065 rval
= Fcar (XCDR (tail1
));
1066 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1067 if (EQ (sym
, XCAR (tail2
)))
1070 /* Indicate whether the property is explicitly defined on the left.
1071 (We know it is defined explicitly on the right
1072 because otherwise we don't get here.) */
1073 lpresent
= ! NILP (tail2
);
1074 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1076 /* Even if lrear or rfront say nothing about the stickiness of
1077 SYM, Vtext_property_default_nonsticky may give default
1078 stickiness to SYM. */
1079 tmp
= Fassq (sym
, Vtext_property_default_nonsticky
);
1080 use_left
= (lpresent
1081 && ! (TMEM (sym
, lrear
)
1082 || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))));
1083 use_right
= (TMEM (sym
, rfront
)
1084 || (CONSP (tmp
) && NILP (XCDR (tmp
))));
1085 if (use_left
&& use_right
)
1089 else if (NILP (rval
))
1094 /* We build props as (value sym ...) rather than (sym value ...)
1095 because we plan to nreverse it when we're done. */
1096 props
= Fcons (lval
, Fcons (sym
, props
));
1097 if (TMEM (sym
, lfront
))
1098 front
= Fcons (sym
, front
);
1099 if (TMEM (sym
, lrear
))
1100 rear
= Fcons (sym
, rear
);
1104 props
= Fcons (rval
, Fcons (sym
, props
));
1105 if (TMEM (sym
, rfront
))
1106 front
= Fcons (sym
, front
);
1107 if (TMEM (sym
, rrear
))
1108 rear
= Fcons (sym
, rear
);
1112 /* Now go through each element of PLEFT. */
1113 for (tail2
= pleft
; CONSP (tail2
); tail2
= Fcdr (XCDR (tail2
)))
1119 /* Sticky properties get special treatment. */
1120 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1123 /* If sym is in PRIGHT, we've already considered it. */
1124 for (tail1
= pright
; CONSP (tail1
); tail1
= Fcdr (XCDR (tail1
)))
1125 if (EQ (sym
, XCAR (tail1
)))
1130 lval
= Fcar (XCDR (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
);
1137 /* Since rval is known to be nil in this loop, the test simplifies. */
1138 if (! (TMEM (sym
, lrear
) || (CONSP (tmp
) && ! NILP (XCDR (tmp
)))))
1140 props
= Fcons (lval
, Fcons (sym
, props
));
1141 if (TMEM (sym
, lfront
))
1142 front
= Fcons (sym
, front
);
1144 else if (TMEM (sym
, rfront
) || (CONSP (tmp
) && NILP (XCDR (tmp
))))
1146 /* The value is nil, but we still inherit the stickiness
1148 front
= Fcons (sym
, front
);
1149 if (TMEM (sym
, rrear
))
1150 rear
= Fcons (sym
, rear
);
1153 props
= Fnreverse (props
);
1155 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1157 cat
= textget (props
, Qcategory
);
1160 /* If we have inherited a front-stick category property that is t,
1161 we don't need to set up a detailed one. */
1162 ! (! NILP (cat
) && SYMBOLP (cat
)
1163 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1164 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1169 /* Delete a node I from its interval tree by merging its subtrees
1170 into one subtree which is then returned. Caller is responsible for
1171 storing the resulting subtree into its parent. */
1174 delete_node (register INTERVAL i
)
1176 register INTERVAL migrate
, this;
1177 register ptrdiff_t migrate_amt
;
1185 migrate_amt
= i
->left
->total_length
;
1187 this->total_length
+= migrate_amt
;
1191 this->total_length
+= migrate_amt
;
1193 eassert (0 <= TOTAL_LENGTH (this));
1194 interval_set_left (this, migrate
);
1195 interval_set_parent (migrate
, this);
1200 /* Delete interval I from its tree by calling `delete_node'
1201 and properly connecting the resultant subtree.
1203 I is presumed to be empty; that is, no adjustments are made
1204 for the length of I. */
1207 delete_interval (register INTERVAL i
)
1209 register INTERVAL parent
;
1210 ptrdiff_t amt
= LENGTH (i
);
1212 eassert (amt
== 0); /* Only used on zero-length intervals now. */
1214 if (ROOT_INTERVAL_P (i
))
1217 GET_INTERVAL_OBJECT (owner
, i
);
1218 parent
= delete_node (i
);
1220 interval_set_object (parent
, owner
);
1222 if (BUFFERP (owner
))
1223 buffer_set_intervals (XBUFFER (owner
), parent
);
1224 else if (STRINGP (owner
))
1225 string_set_intervals (owner
, parent
);
1232 parent
= INTERVAL_PARENT (i
);
1233 if (AM_LEFT_CHILD (i
))
1235 interval_set_left (parent
, delete_node (i
));
1237 interval_set_parent (parent
->left
, parent
);
1241 interval_set_right (parent
, delete_node (i
));
1243 interval_set_parent (parent
->right
, parent
);
1247 /* Find the interval in TREE corresponding to the relative position
1248 FROM and delete as much as possible of AMOUNT from that interval.
1249 Return the amount actually deleted, and if the interval was
1250 zeroed-out, delete that interval node from the tree.
1252 Note that FROM is actually origin zero, aka relative to the
1253 leftmost edge of tree. This is appropriate since we call ourselves
1254 recursively on subtrees.
1256 Do this by recursing down TREE to the interval in question, and
1257 deleting the appropriate amount of text. */
1260 interval_deletion_adjustment (register INTERVAL tree
, register ptrdiff_t from
,
1261 register ptrdiff_t amount
)
1263 register ptrdiff_t relative_position
= from
;
1269 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1271 ptrdiff_t subtract
= interval_deletion_adjustment (tree
->left
,
1274 tree
->total_length
-= subtract
;
1275 eassert (0 <= TOTAL_LENGTH (tree
));
1279 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1280 - RIGHT_TOTAL_LENGTH (tree
)))
1284 relative_position
-= (tree
->total_length
1285 - RIGHT_TOTAL_LENGTH (tree
));
1286 subtract
= interval_deletion_adjustment (tree
->right
,
1289 tree
->total_length
-= subtract
;
1290 eassert (0 <= TOTAL_LENGTH (tree
));
1293 /* Here -- this node. */
1296 /* How much can we delete from this interval? */
1297 ptrdiff_t my_amount
= ((tree
->total_length
1298 - RIGHT_TOTAL_LENGTH (tree
))
1299 - relative_position
);
1301 if (amount
> my_amount
)
1304 tree
->total_length
-= amount
;
1305 eassert (0 <= TOTAL_LENGTH (tree
));
1306 if (LENGTH (tree
) == 0)
1307 delete_interval (tree
);
1312 /* Never reach here. */
1315 /* Effect the adjustments necessary to the interval tree of BUFFER to
1316 correspond to the deletion of LENGTH characters from that buffer
1317 text. The deletion is effected at position START (which is a
1318 buffer position, i.e. origin 1). */
1321 adjust_intervals_for_deletion (struct buffer
*buffer
,
1322 ptrdiff_t start
, ptrdiff_t length
)
1324 register ptrdiff_t left_to_delete
= length
;
1325 register INTERVAL tree
= buffer_get_intervals (buffer
);
1329 GET_INTERVAL_OBJECT (parent
, tree
);
1330 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1335 eassert (start
<= offset
+ TOTAL_LENGTH (tree
)
1336 && start
+ length
<= offset
+ TOTAL_LENGTH (tree
));
1338 if (length
== TOTAL_LENGTH (tree
))
1340 buffer_set_intervals (buffer
, NULL
);
1344 if (ONLY_INTERVAL_P (tree
))
1346 tree
->total_length
-= length
;
1347 eassert (0 <= TOTAL_LENGTH (tree
));
1351 if (start
> offset
+ TOTAL_LENGTH (tree
))
1352 start
= offset
+ TOTAL_LENGTH (tree
);
1353 while (left_to_delete
> 0)
1355 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1357 tree
= buffer_get_intervals (buffer
);
1358 if (left_to_delete
== tree
->total_length
)
1360 buffer_set_intervals (buffer
, NULL
);
1366 /* Make the adjustments necessary to the interval tree of BUFFER to
1367 represent an addition or deletion of LENGTH characters starting
1368 at position START. Addition or deletion is indicated by the sign
1372 offset_intervals (struct buffer
*buffer
, ptrdiff_t start
, ptrdiff_t length
)
1374 if (!buffer_get_intervals (buffer
) || length
== 0)
1378 adjust_intervals_for_insertion (buffer_get_intervals (buffer
),
1382 IF_LINT (if (length
< - TYPE_MAXIMUM (ptrdiff_t)) abort ();)
1383 adjust_intervals_for_deletion (buffer
, start
, -length
);
1387 /* Merge interval I with its lexicographic successor. The resulting
1388 interval is returned, and has the properties of the original
1389 successor. The properties of I are lost. I is removed from the
1393 The caller must verify that this is not the last (rightmost)
1397 merge_interval_right (register INTERVAL i
)
1399 register ptrdiff_t absorb
= LENGTH (i
);
1400 register INTERVAL successor
;
1402 /* Find the succeeding interval. */
1403 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1406 successor
= i
->right
;
1407 while (! NULL_LEFT_CHILD (successor
))
1409 successor
->total_length
+= absorb
;
1410 eassert (0 <= TOTAL_LENGTH (successor
));
1411 successor
= successor
->left
;
1414 successor
->total_length
+= absorb
;
1415 eassert (0 <= TOTAL_LENGTH (successor
));
1416 delete_interval (i
);
1420 /* Zero out this interval. */
1421 i
->total_length
-= absorb
;
1422 eassert (0 <= TOTAL_LENGTH (i
));
1425 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1428 if (AM_LEFT_CHILD (successor
))
1430 successor
= INTERVAL_PARENT (successor
);
1431 delete_interval (i
);
1435 successor
= INTERVAL_PARENT (successor
);
1436 successor
->total_length
-= absorb
;
1437 eassert (0 <= TOTAL_LENGTH (successor
));
1440 /* This must be the rightmost or last interval and cannot
1441 be merged right. The caller should have known. */
1445 /* Merge interval I with its lexicographic predecessor. The resulting
1446 interval is returned, and has the properties of the original predecessor.
1447 The properties of I are lost. Interval node I is removed from the tree.
1450 The caller must verify that this is not the first (leftmost) interval. */
1453 merge_interval_left (register INTERVAL i
)
1455 register ptrdiff_t absorb
= LENGTH (i
);
1456 register INTERVAL predecessor
;
1458 /* Find the preceding interval. */
1459 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1460 adding ABSORB as we go. */
1462 predecessor
= i
->left
;
1463 while (! NULL_RIGHT_CHILD (predecessor
))
1465 predecessor
->total_length
+= absorb
;
1466 eassert (0 <= TOTAL_LENGTH (predecessor
));
1467 predecessor
= predecessor
->right
;
1470 predecessor
->total_length
+= absorb
;
1471 eassert (0 <= TOTAL_LENGTH (predecessor
));
1472 delete_interval (i
);
1476 /* Zero out this interval. */
1477 i
->total_length
-= absorb
;
1478 eassert (0 <= TOTAL_LENGTH (i
));
1481 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1482 subtracting ABSORB. */
1484 if (AM_RIGHT_CHILD (predecessor
))
1486 predecessor
= INTERVAL_PARENT (predecessor
);
1487 delete_interval (i
);
1491 predecessor
= INTERVAL_PARENT (predecessor
);
1492 predecessor
->total_length
-= absorb
;
1493 eassert (0 <= TOTAL_LENGTH (predecessor
));
1496 /* This must be the leftmost or first interval and cannot
1497 be merged left. The caller should have known. */
1501 /* Make an exact copy of interval tree SOURCE which descends from
1502 PARENT. This is done by recursing through SOURCE, copying
1503 the current interval and its properties, and then adjusting
1504 the pointers of the copy. */
1507 reproduce_tree (INTERVAL source
, INTERVAL parent
)
1509 register INTERVAL t
= make_interval ();
1511 memcpy (t
, source
, sizeof *t
);
1512 copy_properties (source
, t
);
1513 interval_set_parent (t
, parent
);
1514 if (! NULL_LEFT_CHILD (source
))
1515 interval_set_left (t
, reproduce_tree (source
->left
, t
));
1516 if (! NULL_RIGHT_CHILD (source
))
1517 interval_set_right (t
, reproduce_tree (source
->right
, t
));
1523 reproduce_tree_obj (INTERVAL source
, Lisp_Object parent
)
1525 register INTERVAL t
= make_interval ();
1527 memcpy (t
, source
, sizeof *t
);
1528 copy_properties (source
, t
);
1529 interval_set_object (t
, parent
);
1530 if (! NULL_LEFT_CHILD (source
))
1531 interval_set_left (t
, reproduce_tree (source
->left
, t
));
1532 if (! NULL_RIGHT_CHILD (source
))
1533 interval_set_right (t
, reproduce_tree (source
->right
, t
));
1538 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1539 LENGTH is the length of the text in SOURCE.
1541 The `position' field of the SOURCE intervals is assumed to be
1542 consistent with its parent; therefore, SOURCE must be an
1543 interval tree made with copy_interval or must be the whole
1544 tree of a buffer or a string.
1546 This is used in insdel.c when inserting Lisp_Strings into the
1547 buffer. The text corresponding to SOURCE is already in the buffer
1548 when this is called. The intervals of new tree are a copy of those
1549 belonging to the string being inserted; intervals are never
1552 If the inserted text had no intervals associated, and we don't
1553 want to inherit the surrounding text's properties, this function
1554 simply returns -- offset_intervals should handle placing the
1555 text in the correct interval, depending on the sticky bits.
1557 If the inserted text had properties (intervals), then there are two
1558 cases -- either insertion happened in the middle of some interval,
1559 or between two intervals.
1561 If the text goes into the middle of an interval, then new intervals
1562 are created in the middle, and new text has the union of its properties
1563 and those of the text into which it was inserted.
1565 If the text goes between two intervals, then if neither interval
1566 had its appropriate sticky property set (front_sticky, rear_sticky),
1567 the new text has only its properties. If one of the sticky properties
1568 is set, then the new text "sticks" to that region and its properties
1569 depend on merging as above. If both the preceding and succeeding
1570 intervals to the new text are "sticky", then the new text retains
1571 only its properties, as if neither sticky property were set. Perhaps
1572 we should consider merging all three sets of properties onto the new
1576 graft_intervals_into_buffer (INTERVAL source
, ptrdiff_t position
,
1577 ptrdiff_t length
, struct buffer
*buffer
,
1580 register INTERVAL under
, over
, this;
1581 register INTERVAL tree
;
1582 ptrdiff_t over_used
;
1584 tree
= buffer_get_intervals (buffer
);
1586 /* If the new text has no properties, then with inheritance it
1587 becomes part of whatever interval it was inserted into.
1588 To prevent inheritance, we must clear out the properties
1589 of the newly inserted text. */
1593 if (!inherit
&& tree
&& length
> 0)
1595 XSETBUFFER (buf
, buffer
);
1596 set_text_properties_1 (make_number (position
),
1597 make_number (position
+ length
),
1600 /* Shouldn't be necessary. --Stef */
1601 buffer_balance_intervals (buffer
);
1605 eassert (length
== TOTAL_LENGTH (source
));
1607 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == length
)
1609 /* The inserted text constitutes the whole buffer, so
1610 simply copy over the interval structure. */
1613 XSETBUFFER (buf
, buffer
);
1614 buffer_set_intervals (buffer
, reproduce_tree_obj (source
, buf
));
1615 buffer_get_intervals (buffer
)->position
= BUF_BEG (buffer
);
1616 eassert (buffer_get_intervals (buffer
)->up_obj
== 1);
1621 /* Create an interval tree in which to place a copy
1622 of the intervals of the inserted string. */
1625 XSETBUFFER (buf
, buffer
);
1626 tree
= create_root_interval (buf
);
1628 /* Paranoia -- the text has already been added, so
1629 this buffer should be of non-zero length. */
1630 eassert (TOTAL_LENGTH (tree
) > 0);
1632 this = under
= find_interval (tree
, position
);
1634 over
= find_interval (source
, interval_start_pos (source
));
1636 /* Here for insertion in the middle of an interval.
1637 Split off an equivalent interval to the right,
1638 then don't bother with it any more. */
1640 if (position
> under
->position
)
1642 INTERVAL end_unchanged
1643 = split_interval_left (this, position
- under
->position
);
1644 copy_properties (under
, end_unchanged
);
1645 under
->position
= position
;
1649 /* This call may have some effect because previous_interval may
1650 update `position' fields of intervals. Thus, don't ignore it
1651 for the moment. Someone please tell me the truth (K.Handa). */
1652 INTERVAL prev
= previous_interval (under
);
1655 /* But, this code surely has no effect. And, anyway,
1656 END_NONSTICKY_P is unreliable now. */
1657 if (prev
&& !END_NONSTICKY_P (prev
))
1662 /* Insertion is now at beginning of UNDER. */
1664 /* The inserted text "sticks" to the interval `under',
1665 which means it gets those properties.
1666 The properties of under are the result of
1667 adjust_intervals_for_insertion, so stickiness has
1668 already been taken care of. */
1670 /* OVER is the interval we are copying from next.
1671 OVER_USED says how many characters' worth of OVER
1672 have already been copied into target intervals.
1673 UNDER is the next interval in the target. */
1677 /* If UNDER is longer than OVER, split it. */
1678 if (LENGTH (over
) - over_used
< LENGTH (under
))
1680 this = split_interval_left (under
, LENGTH (over
) - over_used
);
1681 copy_properties (under
, this);
1686 /* THIS is now the interval to copy or merge into.
1687 OVER covers all of it. */
1689 merge_properties (over
, this);
1691 copy_properties (over
, this);
1693 /* If THIS and OVER end at the same place,
1694 advance OVER to a new source interval. */
1695 if (LENGTH (this) == LENGTH (over
) - over_used
)
1697 over
= next_interval (over
);
1701 /* Otherwise just record that more of OVER has been used. */
1702 over_used
+= LENGTH (this);
1704 /* Always advance to a new target interval. */
1705 under
= next_interval (this);
1708 buffer_balance_intervals (buffer
);
1711 /* Get the value of property PROP from PLIST,
1712 which is the plist of an interval.
1713 We check for direct properties, for categories with property PROP,
1714 and for PROP appearing on the default-text-properties list. */
1717 textget (Lisp_Object plist
, register Lisp_Object prop
)
1719 return lookup_char_property (plist
, prop
, 1);
1723 lookup_char_property (Lisp_Object plist
, register Lisp_Object prop
, int textprop
)
1725 register Lisp_Object tail
, fallback
= Qnil
;
1727 for (tail
= plist
; CONSP (tail
); tail
= Fcdr (XCDR (tail
)))
1729 register Lisp_Object tem
;
1732 return Fcar (XCDR (tail
));
1733 if (EQ (tem
, Qcategory
))
1735 tem
= Fcar (XCDR (tail
));
1737 fallback
= Fget (tem
, prop
);
1741 if (! NILP (fallback
))
1743 /* Check for alternative properties */
1744 tail
= Fassq (prop
, Vchar_property_alias_alist
);
1748 for (; NILP (fallback
) && CONSP (tail
); tail
= XCDR (tail
))
1749 fallback
= Fplist_get (plist
, XCAR (tail
));
1752 if (textprop
&& NILP (fallback
) && CONSP (Vdefault_text_properties
))
1753 fallback
= Fplist_get (Vdefault_text_properties
, prop
);
1758 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1759 byte position BYTEPOS. */
1762 temp_set_point_both (struct buffer
*buffer
,
1763 ptrdiff_t charpos
, ptrdiff_t bytepos
)
1765 /* In a single-byte buffer, the two positions must be equal. */
1766 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
))
1767 eassert (charpos
== bytepos
);
1769 eassert (charpos
<= bytepos
);
1770 eassert (charpos
<= BUF_ZV (buffer
) || BUF_BEGV (buffer
) <= charpos
);
1772 SET_BUF_PT_BOTH (buffer
, charpos
, bytepos
);
1775 /* Set point "temporarily", without checking any text properties. */
1778 temp_set_point (struct buffer
*buffer
, ptrdiff_t charpos
)
1780 temp_set_point_both (buffer
, charpos
,
1781 buf_charpos_to_bytepos (buffer
, charpos
));
1784 /* Set point in BUFFER to CHARPOS. If the target position is
1785 before an intangible character, move to an ok place. */
1788 set_point (ptrdiff_t charpos
)
1790 set_point_both (charpos
, buf_charpos_to_bytepos (current_buffer
, charpos
));
1793 /* If there's an invisible character at position POS + TEST_OFFS in the
1794 current buffer, and the invisible property has a `stickiness' such that
1795 inserting a character at position POS would inherit the property it,
1796 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1797 then intangibility is required as well as invisibility.
1799 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1801 Note that `stickiness' is determined by overlay marker insertion types,
1802 if the invisible property comes from an overlay. */
1805 adjust_for_invis_intang (ptrdiff_t pos
, ptrdiff_t test_offs
, ptrdiff_t adj
,
1808 Lisp_Object invis_propval
, invis_overlay
;
1809 Lisp_Object test_pos
;
1811 if ((adj
< 0 && pos
+ adj
< BEGV
) || (adj
> 0 && pos
+ adj
> ZV
))
1812 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1815 test_pos
= make_number (pos
+ test_offs
);
1818 = get_char_property_and_overlay (test_pos
, Qinvisible
, Qnil
,
1822 || ! NILP (Fget_char_property (test_pos
, Qintangible
, Qnil
)))
1823 && TEXT_PROP_MEANS_INVISIBLE (invis_propval
)
1824 /* This next test is true if the invisible property has a stickiness
1825 such that an insertion at POS would inherit it. */
1826 && (NILP (invis_overlay
)
1827 /* Invisible property is from a text-property. */
1828 ? (text_property_stickiness (Qinvisible
, make_number (pos
), Qnil
)
1829 == (test_offs
== 0 ? 1 : -1))
1830 /* Invisible property is from an overlay. */
1832 ? XMARKER (OVERLAY_START (invis_overlay
))->insertion_type
== 0
1833 : XMARKER (OVERLAY_END (invis_overlay
))->insertion_type
== 1)))
1839 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1840 position BYTEPOS. If the target position is
1841 before an intangible character, move to an ok place. */
1844 set_point_both (ptrdiff_t charpos
, ptrdiff_t bytepos
)
1846 register INTERVAL to
, from
, toprev
, fromprev
;
1847 ptrdiff_t buffer_point
;
1848 ptrdiff_t old_position
= PT
;
1849 /* This ensures that we move forward past intangible text when the
1850 initial position is the same as the destination, in the rare
1851 instances where this is important, e.g. in line-move-finish
1853 int backwards
= (charpos
< old_position
? 1 : 0);
1855 ptrdiff_t original_position
;
1857 BSET (current_buffer
, point_before_scroll
, Qnil
);
1862 /* In a single-byte buffer, the two positions must be equal. */
1863 eassert (ZV
!= ZV_BYTE
|| charpos
== bytepos
);
1865 /* Check this now, before checking if the buffer has any intervals.
1866 That way, we can catch conditions which break this sanity check
1867 whether or not there are intervals in the buffer. */
1868 eassert (charpos
<= ZV
&& charpos
>= BEGV
);
1870 have_overlays
= buffer_has_overlays ();
1872 /* If we have no text properties and overlays,
1873 then we can do it quickly. */
1874 if (!buffer_get_intervals (current_buffer
) && ! have_overlays
)
1876 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1880 /* Set TO to the interval containing the char after CHARPOS,
1881 and TOPREV to the interval containing the char before CHARPOS.
1882 Either one may be null. They may be equal. */
1883 to
= find_interval (buffer_get_intervals (current_buffer
), charpos
);
1884 if (charpos
== BEGV
)
1886 else if (to
&& to
->position
== charpos
)
1887 toprev
= previous_interval (to
);
1891 buffer_point
= (PT
== ZV
? ZV
- 1 : PT
);
1893 /* Set FROM to the interval containing the char after PT,
1894 and FROMPREV to the interval containing the char before PT.
1895 Either one may be null. They may be equal. */
1896 /* We could cache this and save time. */
1897 from
= find_interval (buffer_get_intervals (current_buffer
), buffer_point
);
1898 if (buffer_point
== BEGV
)
1900 else if (from
&& from
->position
== PT
)
1901 fromprev
= previous_interval (from
);
1902 else if (buffer_point
!= PT
)
1903 fromprev
= from
, from
= 0;
1907 /* Moving within an interval. */
1908 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1911 temp_set_point_both (current_buffer
, charpos
, bytepos
);
1915 original_position
= charpos
;
1917 /* If the new position is between two intangible characters
1918 with the same intangible property value,
1919 move forward or backward until a change in that property. */
1920 if (NILP (Vinhibit_point_motion_hooks
)
1923 /* Intangibility never stops us from positioning at the beginning
1924 or end of the buffer, so don't bother checking in that case. */
1925 && charpos
!= BEGV
&& charpos
!= ZV
)
1928 Lisp_Object intangible_propval
;
1932 /* If the preceding character is both intangible and invisible,
1933 and the invisible property is `rear-sticky', perturb it so
1934 that the search starts one character earlier -- this ensures
1935 that point can never move to the end of an invisible/
1936 intangible/rear-sticky region. */
1937 charpos
= adjust_for_invis_intang (charpos
, -1, -1, 1);
1939 XSETINT (pos
, charpos
);
1941 /* If following char is intangible,
1942 skip back over all chars with matching intangible property. */
1944 intangible_propval
= Fget_char_property (pos
, Qintangible
, Qnil
);
1946 if (! NILP (intangible_propval
))
1948 while (XINT (pos
) > BEGV
1949 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1951 intangible_propval
))
1952 pos
= Fprevious_char_property_change (pos
, Qnil
);
1954 /* Set CHARPOS from POS, and if the final intangible character
1955 that we skipped over is also invisible, and the invisible
1956 property is `front-sticky', perturb it to be one character
1957 earlier -- this ensures that point can never move to the
1958 beginning of an invisible/intangible/front-sticky region. */
1959 charpos
= adjust_for_invis_intang (XINT (pos
), 0, -1, 0);
1964 /* If the following character is both intangible and invisible,
1965 and the invisible property is `front-sticky', perturb it so
1966 that the search starts one character later -- this ensures
1967 that point can never move to the beginning of an
1968 invisible/intangible/front-sticky region. */
1969 charpos
= adjust_for_invis_intang (charpos
, 0, 1, 1);
1971 XSETINT (pos
, charpos
);
1973 /* If preceding char is intangible,
1974 skip forward over all chars with matching intangible property. */
1976 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
1979 if (! NILP (intangible_propval
))
1981 while (XINT (pos
) < ZV
1982 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1983 intangible_propval
))
1984 pos
= Fnext_char_property_change (pos
, Qnil
);
1986 /* Set CHARPOS from POS, and if the final intangible character
1987 that we skipped over is also invisible, and the invisible
1988 property is `rear-sticky', perturb it to be one character
1989 later -- this ensures that point can never move to the
1990 end of an invisible/intangible/rear-sticky region. */
1991 charpos
= adjust_for_invis_intang (XINT (pos
), -1, 1, 0);
1995 bytepos
= buf_charpos_to_bytepos (current_buffer
, charpos
);
1998 if (charpos
!= original_position
)
2000 /* Set TO to the interval containing the char after CHARPOS,
2001 and TOPREV to the interval containing the char before CHARPOS.
2002 Either one may be null. They may be equal. */
2003 to
= find_interval (buffer_get_intervals (current_buffer
), charpos
);
2004 if (charpos
== BEGV
)
2006 else if (to
&& to
->position
== charpos
)
2007 toprev
= previous_interval (to
);
2012 /* Here TO is the interval after the stopping point
2013 and TOPREV is the interval before the stopping point.
2014 One or the other may be null. */
2016 temp_set_point_both (current_buffer
, charpos
, bytepos
);
2018 /* We run point-left and point-entered hooks here, if the
2019 two intervals are not equivalent. These hooks take
2020 (old_point, new_point) as arguments. */
2021 if (NILP (Vinhibit_point_motion_hooks
)
2022 && (! intervals_equal (from
, to
)
2023 || ! intervals_equal (fromprev
, toprev
)))
2025 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
2028 leave_before
= textget (fromprev
->plist
, Qpoint_left
);
2030 leave_before
= Qnil
;
2033 leave_after
= textget (from
->plist
, Qpoint_left
);
2038 enter_before
= textget (toprev
->plist
, Qpoint_entered
);
2040 enter_before
= Qnil
;
2043 enter_after
= textget (to
->plist
, Qpoint_entered
);
2047 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
2048 call2 (leave_before
, make_number (old_position
),
2049 make_number (charpos
));
2050 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
2051 call2 (leave_after
, make_number (old_position
),
2052 make_number (charpos
));
2054 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
2055 call2 (enter_before
, make_number (old_position
),
2056 make_number (charpos
));
2057 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
2058 call2 (enter_after
, make_number (old_position
),
2059 make_number (charpos
));
2063 /* Move point to POSITION, unless POSITION is inside an intangible
2064 segment that reaches all the way to point. */
2067 move_if_not_intangible (ptrdiff_t position
)
2070 Lisp_Object intangible_propval
;
2072 XSETINT (pos
, position
);
2074 if (! NILP (Vinhibit_point_motion_hooks
))
2075 /* If intangible is inhibited, always move point to POSITION. */
2077 else if (PT
< position
&& XINT (pos
) < ZV
)
2079 /* We want to move forward, so check the text before POSITION. */
2081 intangible_propval
= Fget_char_property (pos
,
2084 /* If following char is intangible,
2085 skip back over all chars with matching intangible property. */
2086 if (! NILP (intangible_propval
))
2087 while (XINT (pos
) > BEGV
2088 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
2090 intangible_propval
))
2091 pos
= Fprevious_char_property_change (pos
, Qnil
);
2093 else if (XINT (pos
) > BEGV
)
2095 /* We want to move backward, so check the text after POSITION. */
2097 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2100 /* If following char is intangible,
2101 skip forward over all chars with matching intangible property. */
2102 if (! NILP (intangible_propval
))
2103 while (XINT (pos
) < ZV
2104 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2105 intangible_propval
))
2106 pos
= Fnext_char_property_change (pos
, Qnil
);
2109 else if (position
< BEGV
)
2111 else if (position
> ZV
)
2114 /* If the whole stretch between PT and POSITION isn't intangible,
2115 try moving to POSITION (which means we actually move farther
2116 if POSITION is inside of intangible text). */
2118 if (XINT (pos
) != PT
)
2122 /* If text at position POS has property PROP, set *VAL to the property
2123 value, *START and *END to the beginning and end of a region that
2124 has the same property, and return 1. Otherwise return 0.
2126 OBJECT is the string or buffer to look for the property in;
2127 nil means the current buffer. */
2130 get_property_and_range (ptrdiff_t pos
, Lisp_Object prop
, Lisp_Object
*val
,
2131 ptrdiff_t *start
, ptrdiff_t *end
, Lisp_Object object
)
2133 INTERVAL i
, prev
, next
;
2136 i
= find_interval (buffer_get_intervals (current_buffer
), pos
);
2137 else if (BUFFERP (object
))
2138 i
= find_interval (buffer_get_intervals (XBUFFER (object
)), pos
);
2139 else if (STRINGP (object
))
2140 i
= find_interval (string_get_intervals (object
), pos
);
2144 if (!i
|| (i
->position
+ LENGTH (i
) <= pos
))
2146 *val
= textget (i
->plist
, prop
);
2150 next
= i
; /* remember it in advance */
2151 prev
= previous_interval (i
);
2153 && EQ (*val
, textget (prev
->plist
, prop
)))
2154 i
= prev
, prev
= previous_interval (prev
);
2155 *start
= i
->position
;
2157 next
= next_interval (i
);
2158 while (next
&& EQ (*val
, textget (next
->plist
, prop
)))
2159 i
= next
, next
= next_interval (next
);
2160 *end
= i
->position
+ LENGTH (i
);
2165 /* Return the proper local keymap TYPE for position POSITION in
2166 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2167 specified by the PROP property, if any. Otherwise, if TYPE is
2168 `local-map' use BUFFER's local map.
2170 POSITION must be in the accessible part of BUFFER. */
2173 get_local_map (register ptrdiff_t position
, register struct buffer
*buffer
,
2176 Lisp_Object prop
, lispy_position
, lispy_buffer
;
2177 ptrdiff_t old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2179 /* Perhaps we should just change `position' to the limit. */
2180 if (position
> BUF_ZV (buffer
) || position
< BUF_BEGV (buffer
))
2183 /* Ignore narrowing, so that a local map continues to be valid even if
2184 the visible region contains no characters and hence no properties. */
2185 old_begv
= BUF_BEGV (buffer
);
2186 old_zv
= BUF_ZV (buffer
);
2187 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2188 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2190 SET_BUF_BEGV_BOTH (buffer
, BUF_BEG (buffer
), BUF_BEG_BYTE (buffer
));
2191 SET_BUF_ZV_BOTH (buffer
, BUF_Z (buffer
), BUF_Z_BYTE (buffer
));
2193 XSETFASTINT (lispy_position
, position
);
2194 XSETBUFFER (lispy_buffer
, buffer
);
2195 /* First check if the CHAR has any property. This is because when
2196 we click with the mouse, the mouse pointer is really pointing
2197 to the CHAR after POS. */
2198 prop
= Fget_char_property (lispy_position
, type
, lispy_buffer
);
2199 /* If not, look at the POS's properties. This is necessary because when
2200 editing a field with a `local-map' property, we want insertion at the end
2201 to obey the `local-map' property. */
2203 prop
= get_pos_property (lispy_position
, type
, lispy_buffer
);
2205 SET_BUF_BEGV_BOTH (buffer
, old_begv
, old_begv_byte
);
2206 SET_BUF_ZV_BOTH (buffer
, old_zv
, old_zv_byte
);
2208 /* Use the local map only if it is valid. */
2209 prop
= get_keymap (prop
, 0, 0);
2213 if (EQ (type
, Qkeymap
))
2216 return BVAR (buffer
, keymap
);
2219 /* Produce an interval tree reflecting the intervals in
2220 TREE from START to START + LENGTH.
2221 The new interval tree has no parent and has a starting-position of 0. */
2224 copy_intervals (INTERVAL tree
, ptrdiff_t start
, ptrdiff_t length
)
2226 register INTERVAL i
, new, t
;
2227 register ptrdiff_t got
, prevlen
;
2229 if (!tree
|| length
<= 0)
2232 i
= find_interval (tree
, start
);
2233 eassert (i
&& LENGTH (i
) > 0);
2235 /* If there is only one interval and it's the default, return nil. */
2236 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2237 && DEFAULT_INTERVAL_P (i
))
2240 new = make_interval ();
2242 got
= (LENGTH (i
) - (start
- i
->position
));
2243 new->total_length
= length
;
2244 eassert (0 <= TOTAL_LENGTH (new));
2245 copy_properties (i
, new);
2249 while (got
< length
)
2251 i
= next_interval (i
);
2252 t
= split_interval_right (t
, prevlen
);
2253 copy_properties (i
, t
);
2254 prevlen
= LENGTH (i
);
2258 return balance_an_interval (new);
2261 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2264 copy_intervals_to_string (Lisp_Object string
, struct buffer
*buffer
,
2265 ptrdiff_t position
, ptrdiff_t length
)
2267 INTERVAL interval_copy
= copy_intervals (buffer_get_intervals (buffer
),
2272 interval_set_object (interval_copy
, string
);
2273 string_set_intervals (string
, interval_copy
);
2276 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2277 Assume they have identical characters. */
2280 compare_string_intervals (Lisp_Object s1
, Lisp_Object s2
)
2284 ptrdiff_t end
= SCHARS (s1
);
2286 i1
= find_interval (string_get_intervals (s1
), 0);
2287 i2
= find_interval (string_get_intervals (s2
), 0);
2291 /* Determine how far we can go before we reach the end of I1 or I2. */
2292 ptrdiff_t len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2293 ptrdiff_t len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2294 ptrdiff_t distance
= min (len1
, len2
);
2296 /* If we ever find a mismatch between the strings,
2298 if (! intervals_equal (i1
, i2
))
2301 /* Advance POS till the end of the shorter interval,
2302 and advance one or both interval pointers for the new position. */
2304 if (len1
== distance
)
2305 i1
= next_interval (i1
);
2306 if (len2
== distance
)
2307 i2
= next_interval (i2
);
2312 /* Recursively adjust interval I in the current buffer
2313 for setting enable_multibyte_characters to MULTI_FLAG.
2314 The range of interval I is START ... END in characters,
2315 START_BYTE ... END_BYTE in bytes. */
2318 set_intervals_multibyte_1 (INTERVAL i
, int multi_flag
,
2319 ptrdiff_t start
, ptrdiff_t start_byte
,
2320 ptrdiff_t end
, ptrdiff_t end_byte
)
2322 /* Fix the length of this interval. */
2324 i
->total_length
= end
- start
;
2326 i
->total_length
= end_byte
- start_byte
;
2327 eassert (0 <= TOTAL_LENGTH (i
));
2329 if (TOTAL_LENGTH (i
) == 0)
2331 delete_interval (i
);
2335 /* Recursively fix the length of the subintervals. */
2338 ptrdiff_t left_end
, left_end_byte
;
2343 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2344 left_end
= BYTE_TO_CHAR (left_end_byte
);
2346 temp
= CHAR_TO_BYTE (left_end
);
2348 /* If LEFT_END_BYTE is in the middle of a character,
2349 adjust it and LEFT_END to a char boundary. */
2350 if (left_end_byte
> temp
)
2352 left_end_byte
= temp
;
2354 if (left_end_byte
< temp
)
2357 left_end_byte
= CHAR_TO_BYTE (left_end
);
2362 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2363 left_end_byte
= CHAR_TO_BYTE (left_end
);
2366 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2367 left_end
, left_end_byte
);
2371 ptrdiff_t right_start_byte
, right_start
;
2377 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2378 right_start
= BYTE_TO_CHAR (right_start_byte
);
2380 /* If RIGHT_START_BYTE is in the middle of a character,
2381 adjust it and RIGHT_START to a char boundary. */
2382 temp
= CHAR_TO_BYTE (right_start
);
2384 if (right_start_byte
< temp
)
2386 right_start_byte
= temp
;
2388 if (right_start_byte
> temp
)
2391 right_start_byte
= CHAR_TO_BYTE (right_start
);
2396 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2397 right_start_byte
= CHAR_TO_BYTE (right_start
);
2400 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2401 right_start
, right_start_byte
,
2405 /* Rounding to char boundaries can theoretically ake this interval
2406 spurious. If so, delete one child, and copy its property list
2407 to this interval. */
2408 if (LEFT_TOTAL_LENGTH (i
) + RIGHT_TOTAL_LENGTH (i
) >= TOTAL_LENGTH (i
))
2412 interval_set_plist (i
, i
->left
->plist
);
2413 (i
)->left
->total_length
= 0;
2414 delete_interval ((i
)->left
);
2418 interval_set_plist (i
, i
->right
->plist
);
2419 (i
)->right
->total_length
= 0;
2420 delete_interval ((i
)->right
);
2425 /* Update the intervals of the current buffer
2426 to fit the contents as multibyte (if MULTI_FLAG is 1)
2427 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2430 set_intervals_multibyte (int multi_flag
)
2432 INTERVAL i
= buffer_get_intervals (current_buffer
);
2435 set_intervals_multibyte_1 (i
, multi_flag
, BEG
, BEG_BYTE
, Z
, Z_BYTE
);