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 /* The rest of the file is within this conditional. */
50 #ifdef USE_TEXT_PROPERTIES
52 /* Test for membership, allowing for t (actually any non-cons) to mean the
55 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
57 #define min(x, y) ((x) < (y) ? (x) : (y))
59 Lisp_Object
merge_properties_sticky ();
61 /* Utility functions for intervals. */
64 /* Create the root interval of some object, a buffer or string. */
67 create_root_interval (parent
)
72 CHECK_IMPURE (parent
);
74 new = make_interval ();
78 new->total_length
= (BUF_Z (XBUFFER (parent
))
79 - BUF_BEG (XBUFFER (parent
)));
80 BUF_INTERVALS (XBUFFER (parent
)) = new;
83 else if (STRINGP (parent
))
85 new->total_length
= XSTRING (parent
)->size
;
86 XSTRING (parent
)->intervals
= new;
90 new->parent
= (INTERVAL
) XFASTINT (parent
);
95 /* Make the interval TARGET have exactly the properties of SOURCE */
98 copy_properties (source
, target
)
99 register INTERVAL source
, target
;
101 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
104 COPY_INTERVAL_CACHE (source
, target
);
105 target
->plist
= Fcopy_sequence (source
->plist
);
108 /* Merge the properties of interval SOURCE into the properties
109 of interval TARGET. That is to say, each property in SOURCE
110 is added to TARGET if TARGET has no such property as yet. */
113 merge_properties (source
, target
)
114 register INTERVAL source
, target
;
116 register Lisp_Object o
, sym
, val
;
118 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
121 MERGE_INTERVAL_CACHE (source
, target
);
124 while (! EQ (o
, Qnil
))
127 val
= Fmemq (sym
, target
->plist
);
133 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
141 /* Return 1 if the two intervals have the same properties,
145 intervals_equal (i0
, i1
)
148 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
151 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
154 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
157 i1_len
= XFASTINT (Flength (i1
->plist
));
158 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
162 while (!NILP (i0_cdr
))
164 /* Lengths of the two plists were unequal. */
168 i0_sym
= Fcar (i0_cdr
);
169 i1_val
= Fmemq (i0_sym
, i1
->plist
);
171 /* i0 has something i1 doesn't. */
172 if (EQ (i1_val
, Qnil
))
175 /* i0 and i1 both have sym, but it has different values in each. */
176 i0_cdr
= Fcdr (i0_cdr
);
177 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
180 i0_cdr
= Fcdr (i0_cdr
);
184 /* Lengths of the two plists were unequal. */
193 static int zero_length
;
195 /* Traverse an interval tree TREE, performing FUNCTION on each node.
196 Pass FUNCTION two args: an interval, and ARG. */
199 traverse_intervals (tree
, position
, depth
, function
, arg
)
202 void (* function
) P_ ((INTERVAL
, Lisp_Object
));
205 if (NULL_INTERVAL_P (tree
))
208 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
209 position
+= LEFT_TOTAL_LENGTH (tree
);
210 tree
->position
= position
;
211 (*function
) (tree
, arg
);
212 position
+= LENGTH (tree
);
213 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
217 /* These functions are temporary, for debugging purposes only. */
219 INTERVAL search_interval
, found_interval
;
222 check_for_interval (i
)
225 if (i
== search_interval
)
233 search_for_interval (i
, tree
)
234 register INTERVAL i
, tree
;
238 found_interval
= NULL_INTERVAL
;
239 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
240 return found_interval
;
244 inc_interval_count (i
)
261 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
267 root_interval (interval
)
270 register INTERVAL i
= interval
;
272 while (! ROOT_INTERVAL_P (i
))
279 /* Assuming that a left child exists, perform the following operation:
289 rotate_right (interval
)
293 INTERVAL B
= interval
->left
;
294 int old_total
= interval
->total_length
;
296 /* Deal with any Parent of A; make it point to B. */
297 if (! ROOT_INTERVAL_P (interval
))
298 if (AM_LEFT_CHILD (interval
))
299 interval
->parent
->left
= B
;
301 interval
->parent
->right
= B
;
302 B
->parent
= interval
->parent
;
304 /* Make B the parent of A */
307 interval
->parent
= B
;
309 /* Make A point to c */
311 if (! NULL_INTERVAL_P (i
))
312 i
->parent
= interval
;
314 /* A's total length is decreased by the length of B and its left child. */
315 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
317 /* B must have the same total length of A. */
318 B
->total_length
= old_total
;
323 /* Assuming that a right child exists, perform the following operation:
333 rotate_left (interval
)
337 INTERVAL B
= interval
->right
;
338 int old_total
= interval
->total_length
;
340 /* Deal with any parent of A; make it point to B. */
341 if (! ROOT_INTERVAL_P (interval
))
342 if (AM_LEFT_CHILD (interval
))
343 interval
->parent
->left
= B
;
345 interval
->parent
->right
= B
;
346 B
->parent
= interval
->parent
;
348 /* Make B the parent of A */
351 interval
->parent
= B
;
353 /* Make A point to c */
355 if (! NULL_INTERVAL_P (i
))
356 i
->parent
= interval
;
358 /* A's total length is decreased by the length of B and its right child. */
359 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
361 /* B must have the same total length of A. */
362 B
->total_length
= old_total
;
367 /* Balance an interval tree with the assumption that the subtrees
368 themselves are already balanced. */
371 balance_an_interval (i
)
374 register int old_diff
, new_diff
;
378 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
381 new_diff
= i
->total_length
- i
->left
->total_length
382 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
383 if (abs (new_diff
) >= old_diff
)
385 i
= rotate_right (i
);
386 balance_an_interval (i
->right
);
388 else if (old_diff
< 0)
390 new_diff
= i
->total_length
- i
->right
->total_length
391 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
392 if (abs (new_diff
) >= -old_diff
)
395 balance_an_interval (i
->left
);
403 /* Balance INTERVAL, potentially stuffing it back into its parent
406 static INLINE INTERVAL
407 balance_possible_root_interval (interval
)
408 register INTERVAL interval
;
412 if (interval
->parent
== NULL_INTERVAL
)
415 XSETFASTINT (parent
, (EMACS_INT
) interval
->parent
);
416 interval
= balance_an_interval (interval
);
418 if (BUFFERP (parent
))
419 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
420 else if (STRINGP (parent
))
421 XSTRING (parent
)->intervals
= interval
;
426 /* Balance the interval tree TREE. Balancing is by weight
427 (the amount of text). */
430 balance_intervals_internal (tree
)
431 register INTERVAL tree
;
433 /* Balance within each side. */
435 balance_intervals_internal (tree
->left
);
437 balance_intervals_internal (tree
->right
);
438 return balance_an_interval (tree
);
441 /* Advertised interface to balance intervals. */
444 balance_intervals (tree
)
447 if (tree
== NULL_INTERVAL
)
448 return NULL_INTERVAL
;
450 return balance_intervals_internal (tree
);
453 /* Split INTERVAL into two pieces, starting the second piece at
454 character position OFFSET (counting from 0), relative to INTERVAL.
455 INTERVAL becomes the left-hand piece, and the right-hand piece
456 (second, lexicographically) is returned.
458 The size and position fields of the two intervals are set based upon
459 those of the original interval. The property list of the new interval
460 is reset, thus it is up to the caller to do the right thing with the
463 Note that this does not change the position of INTERVAL; if it is a root,
464 it is still a root after this operation. */
467 split_interval_right (interval
, offset
)
471 INTERVAL
new = make_interval ();
472 int position
= interval
->position
;
473 int new_length
= LENGTH (interval
) - offset
;
475 new->position
= position
+ offset
;
476 new->parent
= interval
;
478 if (NULL_RIGHT_CHILD (interval
))
480 interval
->right
= new;
481 new->total_length
= new_length
;
485 /* Insert the new node between INTERVAL and its right child. */
486 new->right
= interval
->right
;
487 interval
->right
->parent
= new;
488 interval
->right
= new;
489 new->total_length
= new_length
+ new->right
->total_length
;
490 balance_an_interval (new);
493 balance_possible_root_interval (interval
);
498 /* Split INTERVAL into two pieces, starting the second piece at
499 character position OFFSET (counting from 0), relative to INTERVAL.
500 INTERVAL becomes the right-hand piece, and the left-hand piece
501 (first, lexicographically) is returned.
503 The size and position fields of the two intervals are set based upon
504 those of the original interval. The property list of the new interval
505 is reset, thus it is up to the caller to do the right thing with the
508 Note that this does not change the position of INTERVAL; if it is a root,
509 it is still a root after this operation. */
512 split_interval_left (interval
, offset
)
516 INTERVAL
new = make_interval ();
517 int position
= interval
->position
;
518 int new_length
= offset
;
520 new->position
= interval
->position
;
521 interval
->position
= interval
->position
+ offset
;
522 new->parent
= interval
;
524 if (NULL_LEFT_CHILD (interval
))
526 interval
->left
= new;
527 new->total_length
= new_length
;
531 /* Insert the new node between INTERVAL and its left child. */
532 new->left
= interval
->left
;
533 new->left
->parent
= new;
534 interval
->left
= new;
535 new->total_length
= new_length
+ new->left
->total_length
;
536 balance_an_interval (new);
539 balance_possible_root_interval (interval
);
544 /* Return the proper position for the first character
545 described by the interval tree SOURCE.
546 This is 1 if the parent is a buffer,
547 0 if the parent is a string or if there is no parent.
549 Don't use this function on an interval which is the child
550 of another interval! */
553 interval_start_pos (source
)
558 if (NULL_INTERVAL_P (source
))
561 XSETFASTINT (parent
, (EMACS_INT
) source
->parent
);
562 if (BUFFERP (parent
))
563 return BUF_BEG (XBUFFER (parent
));
567 /* Find the interval containing text position POSITION in the text
568 represented by the interval tree TREE. POSITION is a buffer
569 position (starting from 1) or a string index (starting from 0).
570 If POSITION is at the end of the buffer or string,
571 return the interval containing the last character.
573 The `position' field, which is a cache of an interval's position,
574 is updated in the interval found. Other functions (e.g., next_interval)
575 will update this cache based on the result of find_interval. */
578 find_interval (tree
, position
)
579 register INTERVAL tree
;
580 register int position
;
582 /* The distance from the left edge of the subtree at TREE
584 register int relative_position
;
587 if (NULL_INTERVAL_P (tree
))
588 return NULL_INTERVAL
;
590 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
591 relative_position
= position
;
592 if (BUFFERP (parent
))
593 relative_position
-= BUF_BEG (XBUFFER (parent
));
595 if (relative_position
> TOTAL_LENGTH (tree
))
596 abort (); /* Paranoia */
598 tree
= balance_possible_root_interval (tree
);
602 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
606 else if (! NULL_RIGHT_CHILD (tree
)
607 && relative_position
>= (TOTAL_LENGTH (tree
)
608 - RIGHT_TOTAL_LENGTH (tree
)))
610 relative_position
-= (TOTAL_LENGTH (tree
)
611 - RIGHT_TOTAL_LENGTH (tree
));
617 = (position
- relative_position
/* the left edge of *tree */
618 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
625 /* Find the succeeding interval (lexicographically) to INTERVAL.
626 Sets the `position' field based on that of INTERVAL (see
630 next_interval (interval
)
631 register INTERVAL interval
;
633 register INTERVAL i
= interval
;
634 register int next_position
;
636 if (NULL_INTERVAL_P (i
))
637 return NULL_INTERVAL
;
638 next_position
= interval
->position
+ LENGTH (interval
);
640 if (! NULL_RIGHT_CHILD (i
))
643 while (! NULL_LEFT_CHILD (i
))
646 i
->position
= next_position
;
650 while (! NULL_PARENT (i
))
652 if (AM_LEFT_CHILD (i
))
655 i
->position
= next_position
;
662 return NULL_INTERVAL
;
665 /* Find the preceding interval (lexicographically) to INTERVAL.
666 Sets the `position' field based on that of INTERVAL (see
670 previous_interval (interval
)
671 register INTERVAL interval
;
674 register int position_of_previous
;
676 if (NULL_INTERVAL_P (interval
))
677 return NULL_INTERVAL
;
679 if (! NULL_LEFT_CHILD (interval
))
682 while (! NULL_RIGHT_CHILD (i
))
685 i
->position
= interval
->position
- LENGTH (i
);
690 while (! NULL_PARENT (i
))
692 if (AM_RIGHT_CHILD (i
))
696 i
->position
= interval
->position
- LENGTH (i
);
702 return NULL_INTERVAL
;
705 /* Find the interval containing POS given some non-NULL INTERVAL
706 in the same tree. Note that we need to update interval->position
707 if we go down the tree. */
709 update_interval (i
, pos
)
713 if (NULL_INTERVAL_P (i
))
714 return NULL_INTERVAL
;
718 if (pos
< i
->position
)
721 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
723 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
724 + LEFT_TOTAL_LENGTH (i
->left
);
725 i
= i
->left
; /* Move to the left child */
727 else if (NULL_PARENT (i
))
728 error ("Point before start of properties");
733 else if (pos
>= INTERVAL_LAST_POS (i
))
736 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
738 i
->right
->position
= INTERVAL_LAST_POS (i
) +
739 LEFT_TOTAL_LENGTH (i
->right
);
740 i
= i
->right
; /* Move to the right child */
742 else if (NULL_PARENT (i
))
743 error ("Point after end of properties");
755 /* Traverse a path down the interval tree TREE to the interval
756 containing POSITION, adjusting all nodes on the path for
757 an addition of LENGTH characters. Insertion between two intervals
758 (i.e., point == i->position, where i is second interval) means
759 text goes into second interval.
761 Modifications are needed to handle the hungry bits -- after simply
762 finding the interval at position (don't add length going down),
763 if it's the beginning of the interval, get the previous interval
764 and check the hungry bits of both. Then add the length going back up
768 adjust_intervals_for_insertion (tree
, position
, length
)
770 int position
, length
;
772 register int relative_position
;
773 register INTERVAL
this;
775 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
778 /* If inserting at point-max of a buffer, that position
779 will be out of range */
780 if (position
> TOTAL_LENGTH (tree
))
781 position
= TOTAL_LENGTH (tree
);
782 relative_position
= position
;
787 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
789 this->total_length
+= length
;
792 else if (relative_position
> (TOTAL_LENGTH (this)
793 - RIGHT_TOTAL_LENGTH (this)))
795 relative_position
-= (TOTAL_LENGTH (this)
796 - RIGHT_TOTAL_LENGTH (this));
797 this->total_length
+= length
;
802 /* If we are to use zero-length intervals as buffer pointers,
803 then this code will have to change. */
804 this->total_length
+= length
;
805 this->position
= LEFT_TOTAL_LENGTH (this)
806 + position
- relative_position
+ 1;
813 /* Effect an adjustment corresponding to the addition of LENGTH characters
814 of text. Do this by finding the interval containing POSITION in the
815 interval tree TREE, and then adjusting all of its ancestors by adding
818 If POSITION is the first character of an interval, meaning that point
819 is actually between the two intervals, make the new text belong to
820 the interval which is "sticky".
822 If both intervals are "sticky", then make them belong to the left-most
823 interval. Another possibility would be to create a new interval for
824 this text, and make it have the merged properties of both ends. */
827 adjust_intervals_for_insertion (tree
, position
, length
)
829 int position
, length
;
832 register INTERVAL temp
;
837 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
840 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
841 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
843 /* If inserting at point-max of a buffer, that position will be out
844 of range. Remember that buffer positions are 1-based. */
845 if (position
>= TOTAL_LENGTH (tree
) + offset
)
847 position
= TOTAL_LENGTH (tree
) + offset
;
851 i
= find_interval (tree
, position
);
853 /* If in middle of an interval which is not sticky either way,
854 we must not just give its properties to the insertion.
855 So split this interval at the insertion point. */
856 if (! (position
== i
->position
|| eobp
)
857 && END_NONSTICKY_P (i
)
858 && FRONT_NONSTICKY_P (i
))
861 Lisp_Object front
, rear
;
863 front
= textget (i
->plist
, Qfront_sticky
);
864 rear
= textget (i
->plist
, Qrear_nonsticky
);
866 /* Does any actual property pose an actual problem? */
867 for (tail
= i
->plist
; ! NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
870 prop
= XCONS (tail
)->car
;
872 /* Is this particular property rear-sticky?
873 Note, if REAR isn't a cons, it must be non-nil,
874 which means that all properties are rear-nonsticky. */
875 if (CONSP (rear
) && NILP (Fmemq (prop
, rear
)))
878 /* Is this particular property front-sticky?
879 Note, if FRONT isn't a cons, it must be nil,
880 which means that all properties are front-nonsticky. */
881 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
884 /* PROP isn't sticky on either side => it is a real problem. */
888 /* If any property is a real problem, split the interval. */
891 temp
= split_interval_right (i
, position
- i
->position
);
892 copy_properties (i
, temp
);
897 /* If we are positioned between intervals, check the stickiness of
898 both of them. We have to do this too, if we are at BEG or Z. */
899 if (position
== i
->position
|| eobp
)
901 register INTERVAL prev
;
911 prev
= previous_interval (i
);
913 /* Even if we are positioned between intervals, we default
914 to the left one if it exists. We extend it now and split
915 off a part later, if stickiness demands it. */
916 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
918 temp
->total_length
+= length
;
919 temp
= balance_possible_root_interval (temp
);
922 /* If at least one interval has sticky properties,
923 we check the stickiness property by property. */
924 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
926 Lisp_Object pleft
, pright
;
927 struct interval newi
;
929 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
930 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
931 newi
.plist
= merge_properties_sticky (pleft
, pright
);
933 if (! prev
) /* i.e. position == BEG */
935 if (! intervals_equal (i
, &newi
))
937 i
= split_interval_left (i
, length
);
938 i
->plist
= newi
.plist
;
941 else if (! intervals_equal (prev
, &newi
))
943 prev
= split_interval_right (prev
,
944 position
- prev
->position
);
945 prev
->plist
= newi
.plist
;
946 if (! NULL_INTERVAL_P (i
)
947 && intervals_equal (prev
, i
))
948 merge_interval_right (prev
);
951 /* We will need to update the cache here later. */
953 else if (! prev
&& ! NILP (i
->plist
))
955 /* Just split off a new interval at the left.
956 Since I wasn't front-sticky, the empty plist is ok. */
957 i
= split_interval_left (i
, length
);
961 /* Otherwise just extend the interval. */
964 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
966 temp
->total_length
+= length
;
967 temp
= balance_possible_root_interval (temp
);
974 /* Any property might be front-sticky on the left, rear-sticky on the left,
975 front-sticky on the right, or rear-sticky on the right; the 16 combinations
976 can be arranged in a matrix with rows denoting the left conditions and
977 columns denoting the right conditions:
985 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
986 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
987 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
988 p8 L p9 L pa L pb L pc L pd L pe L pf L)
989 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
990 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
991 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
992 p8 R p9 R pa R pb R pc R pd R pe R pf R)
994 We inherit from whoever has a sticky side facing us. If both sides
995 do (cases 2, 3, E, and F), then we inherit from whichever side has a
996 non-nil value for the current property. If both sides do, then we take
999 When we inherit a property, we get its stickiness as well as its value.
1000 So, when we merge the above two lists, we expect to get this:
1002 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1003 rear-nonsticky (p6 pa)
1004 p0 L p1 L p2 L p3 L p6 R p7 R
1005 pa R pb R pc L pd L pe L pf L)
1007 The optimizable special cases are:
1008 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1009 left rear-nonsticky = t, right front-sticky = t (inherit right)
1010 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1014 merge_properties_sticky (pleft
, pright
)
1015 Lisp_Object pleft
, pright
;
1017 register Lisp_Object props
, front
, rear
;
1018 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1019 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1020 int use_left
, use_right
;
1026 lfront
= textget (pleft
, Qfront_sticky
);
1027 lrear
= textget (pleft
, Qrear_nonsticky
);
1028 rfront
= textget (pright
, Qfront_sticky
);
1029 rrear
= textget (pright
, Qrear_nonsticky
);
1031 /* Go through each element of PRIGHT. */
1032 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1036 /* Sticky properties get special treatment. */
1037 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1040 rval
= Fcar (Fcdr (tail1
));
1041 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1042 if (EQ (sym
, Fcar (tail2
)))
1045 /* Indicate whether the property is explicitly defined on the left.
1046 (We know it is defined explicitly on the right
1047 because otherwise we don't get here.) */
1048 lpresent
= ! NILP (tail2
);
1049 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1051 use_left
= ! TMEM (sym
, lrear
) && lpresent
;
1052 use_right
= TMEM (sym
, rfront
);
1053 if (use_left
&& use_right
)
1057 else if (NILP (rval
))
1062 /* We build props as (value sym ...) rather than (sym value ...)
1063 because we plan to nreverse it when we're done. */
1064 props
= Fcons (lval
, Fcons (sym
, props
));
1065 if (TMEM (sym
, lfront
))
1066 front
= Fcons (sym
, front
);
1067 if (TMEM (sym
, lrear
))
1068 rear
= Fcons (sym
, rear
);
1072 props
= Fcons (rval
, Fcons (sym
, props
));
1073 if (TMEM (sym
, rfront
))
1074 front
= Fcons (sym
, front
);
1075 if (TMEM (sym
, rrear
))
1076 rear
= Fcons (sym
, rear
);
1080 /* Now go through each element of PLEFT. */
1081 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1085 /* Sticky properties get special treatment. */
1086 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1089 /* If sym is in PRIGHT, we've already considered it. */
1090 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1091 if (EQ (sym
, Fcar (tail1
)))
1096 lval
= Fcar (Fcdr (tail2
));
1098 /* Since rval is known to be nil in this loop, the test simplifies. */
1099 if (! TMEM (sym
, lrear
))
1101 props
= Fcons (lval
, Fcons (sym
, props
));
1102 if (TMEM (sym
, lfront
))
1103 front
= Fcons (sym
, front
);
1105 else if (TMEM (sym
, rfront
))
1107 /* The value is nil, but we still inherit the stickiness
1109 front
= Fcons (sym
, front
);
1110 if (TMEM (sym
, rrear
))
1111 rear
= Fcons (sym
, rear
);
1114 props
= Fnreverse (props
);
1116 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1118 cat
= textget (props
, Qcategory
);
1121 /* If we have inherited a front-stick category property that is t,
1122 we don't need to set up a detailed one. */
1123 ! (! NILP (cat
) && SYMBOLP (cat
)
1124 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1125 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1130 /* Delete an node I from its interval tree by merging its subtrees
1131 into one subtree which is then returned. Caller is responsible for
1132 storing the resulting subtree into its parent. */
1136 register INTERVAL i
;
1138 register INTERVAL migrate
, this;
1139 register int migrate_amt
;
1141 if (NULL_INTERVAL_P (i
->left
))
1143 if (NULL_INTERVAL_P (i
->right
))
1147 migrate_amt
= i
->left
->total_length
;
1149 this->total_length
+= migrate_amt
;
1150 while (! NULL_INTERVAL_P (this->left
))
1153 this->total_length
+= migrate_amt
;
1155 this->left
= migrate
;
1156 migrate
->parent
= this;
1161 /* Delete interval I from its tree by calling `delete_node'
1162 and properly connecting the resultant subtree.
1164 I is presumed to be empty; that is, no adjustments are made
1165 for the length of I. */
1169 register INTERVAL i
;
1171 register INTERVAL parent
;
1172 int amt
= LENGTH (i
);
1174 if (amt
> 0) /* Only used on zero-length intervals now. */
1177 if (ROOT_INTERVAL_P (i
))
1180 XSETFASTINT (owner
, (EMACS_INT
) i
->parent
);
1181 parent
= delete_node (i
);
1182 if (! NULL_INTERVAL_P (parent
))
1183 parent
->parent
= (INTERVAL
) XFASTINT (owner
);
1185 if (BUFFERP (owner
))
1186 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1187 else if (STRINGP (owner
))
1188 XSTRING (owner
)->intervals
= parent
;
1196 if (AM_LEFT_CHILD (i
))
1198 parent
->left
= delete_node (i
);
1199 if (! NULL_INTERVAL_P (parent
->left
))
1200 parent
->left
->parent
= parent
;
1204 parent
->right
= delete_node (i
);
1205 if (! NULL_INTERVAL_P (parent
->right
))
1206 parent
->right
->parent
= parent
;
1210 /* Find the interval in TREE corresponding to the relative position
1211 FROM and delete as much as possible of AMOUNT from that interval.
1212 Return the amount actually deleted, and if the interval was
1213 zeroed-out, delete that interval node from the tree.
1215 Note that FROM is actually origin zero, aka relative to the
1216 leftmost edge of tree. This is appropriate since we call ourselves
1217 recursively on subtrees.
1219 Do this by recursing down TREE to the interval in question, and
1220 deleting the appropriate amount of text. */
1223 interval_deletion_adjustment (tree
, from
, amount
)
1224 register INTERVAL tree
;
1225 register int from
, amount
;
1227 register int relative_position
= from
;
1229 if (NULL_INTERVAL_P (tree
))
1233 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1235 int subtract
= interval_deletion_adjustment (tree
->left
,
1238 tree
->total_length
-= subtract
;
1242 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1243 - RIGHT_TOTAL_LENGTH (tree
)))
1247 relative_position
-= (tree
->total_length
1248 - RIGHT_TOTAL_LENGTH (tree
));
1249 subtract
= interval_deletion_adjustment (tree
->right
,
1252 tree
->total_length
-= subtract
;
1255 /* Here -- this node. */
1258 /* How much can we delete from this interval? */
1259 int my_amount
= ((tree
->total_length
1260 - RIGHT_TOTAL_LENGTH (tree
))
1261 - relative_position
);
1263 if (amount
> my_amount
)
1266 tree
->total_length
-= amount
;
1267 if (LENGTH (tree
) == 0)
1268 delete_interval (tree
);
1273 /* Never reach here. */
1276 /* Effect the adjustments necessary to the interval tree of BUFFER to
1277 correspond to the deletion of LENGTH characters from that buffer
1278 text. The deletion is effected at position START (which is a
1279 buffer position, i.e. origin 1). */
1282 adjust_intervals_for_deletion (buffer
, start
, length
)
1283 struct buffer
*buffer
;
1286 register int left_to_delete
= length
;
1287 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1288 register int deleted
;
1292 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
1293 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1295 if (NULL_INTERVAL_P (tree
))
1298 if (start
> offset
+ TOTAL_LENGTH (tree
)
1299 || start
+ length
> offset
+ TOTAL_LENGTH (tree
))
1302 if (length
== TOTAL_LENGTH (tree
))
1304 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1308 if (ONLY_INTERVAL_P (tree
))
1310 tree
->total_length
-= length
;
1314 if (start
> offset
+ TOTAL_LENGTH (tree
))
1315 start
= offset
+ TOTAL_LENGTH (tree
);
1316 while (left_to_delete
> 0)
1318 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1320 tree
= BUF_INTERVALS (buffer
);
1321 if (left_to_delete
== tree
->total_length
)
1323 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1329 /* Make the adjustments necessary to the interval tree of BUFFER to
1330 represent an addition or deletion of LENGTH characters starting
1331 at position START. Addition or deletion is indicated by the sign
1335 offset_intervals (buffer
, start
, length
)
1336 struct buffer
*buffer
;
1339 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1343 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1345 adjust_intervals_for_deletion (buffer
, start
, -length
);
1348 /* Merge interval I with its lexicographic successor. The resulting
1349 interval is returned, and has the properties of the original
1350 successor. The properties of I are lost. I is removed from the
1354 The caller must verify that this is not the last (rightmost)
1358 merge_interval_right (i
)
1359 register INTERVAL i
;
1361 register int absorb
= LENGTH (i
);
1362 register INTERVAL successor
;
1364 /* Zero out this interval. */
1365 i
->total_length
-= absorb
;
1367 /* Find the succeeding interval. */
1368 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1371 successor
= i
->right
;
1372 while (! NULL_LEFT_CHILD (successor
))
1374 successor
->total_length
+= absorb
;
1375 successor
= successor
->left
;
1378 successor
->total_length
+= absorb
;
1379 delete_interval (i
);
1384 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1387 if (AM_LEFT_CHILD (successor
))
1389 successor
= successor
->parent
;
1390 delete_interval (i
);
1394 successor
= successor
->parent
;
1395 successor
->total_length
-= absorb
;
1398 /* This must be the rightmost or last interval and cannot
1399 be merged right. The caller should have known. */
1403 /* Merge interval I with its lexicographic predecessor. The resulting
1404 interval is returned, and has the properties of the original predecessor.
1405 The properties of I are lost. Interval node I is removed from the tree.
1408 The caller must verify that this is not the first (leftmost) interval. */
1411 merge_interval_left (i
)
1412 register INTERVAL i
;
1414 register int absorb
= LENGTH (i
);
1415 register INTERVAL predecessor
;
1417 /* Zero out this interval. */
1418 i
->total_length
-= absorb
;
1420 /* Find the preceding interval. */
1421 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1422 adding ABSORB as we go. */
1424 predecessor
= i
->left
;
1425 while (! NULL_RIGHT_CHILD (predecessor
))
1427 predecessor
->total_length
+= absorb
;
1428 predecessor
= predecessor
->right
;
1431 predecessor
->total_length
+= absorb
;
1432 delete_interval (i
);
1437 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1438 subtracting ABSORB. */
1440 if (AM_RIGHT_CHILD (predecessor
))
1442 predecessor
= predecessor
->parent
;
1443 delete_interval (i
);
1447 predecessor
= predecessor
->parent
;
1448 predecessor
->total_length
-= absorb
;
1451 /* This must be the leftmost or first interval and cannot
1452 be merged left. The caller should have known. */
1456 /* Make an exact copy of interval tree SOURCE which descends from
1457 PARENT. This is done by recursing through SOURCE, copying
1458 the current interval and its properties, and then adjusting
1459 the pointers of the copy. */
1462 reproduce_tree (source
, parent
)
1463 INTERVAL source
, parent
;
1465 register INTERVAL t
= make_interval ();
1467 bcopy (source
, t
, INTERVAL_SIZE
);
1468 copy_properties (source
, t
);
1470 if (! NULL_LEFT_CHILD (source
))
1471 t
->left
= reproduce_tree (source
->left
, t
);
1472 if (! NULL_RIGHT_CHILD (source
))
1473 t
->right
= reproduce_tree (source
->right
, t
);
1479 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1481 /* Make a new interval of length LENGTH starting at START in the
1482 group of intervals INTERVALS, which is actually an interval tree.
1483 Returns the new interval.
1485 Generate an error if the new positions would overlap an existing
1489 make_new_interval (intervals
, start
, length
)
1495 slot
= find_interval (intervals
, start
);
1496 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1497 error ("Interval would overlap");
1499 if (start
== slot
->position
&& length
== LENGTH (slot
))
1502 if (slot
->position
== start
)
1504 /* New right node. */
1505 split_interval_right (slot
, length
);
1509 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1511 /* New left node. */
1512 split_interval_left (slot
, LENGTH (slot
) - length
);
1516 /* Convert interval SLOT into three intervals. */
1517 split_interval_left (slot
, start
- slot
->position
);
1518 split_interval_right (slot
, length
);
1523 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1524 LENGTH is the length of the text in SOURCE.
1526 The `position' field of the SOURCE intervals is assumed to be
1527 consistent with its parent; therefore, SOURCE must be an
1528 interval tree made with copy_interval or must be the whole
1529 tree of a buffer or a string.
1531 This is used in insdel.c when inserting Lisp_Strings into the
1532 buffer. The text corresponding to SOURCE is already in the buffer
1533 when this is called. The intervals of new tree are a copy of those
1534 belonging to the string being inserted; intervals are never
1537 If the inserted text had no intervals associated, and we don't
1538 want to inherit the surrounding text's properties, this function
1539 simply returns -- offset_intervals should handle placing the
1540 text in the correct interval, depending on the sticky bits.
1542 If the inserted text had properties (intervals), then there are two
1543 cases -- either insertion happened in the middle of some interval,
1544 or between two intervals.
1546 If the text goes into the middle of an interval, then new
1547 intervals are created in the middle with only the properties of
1548 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1549 which case the new text has the union of its properties and those
1550 of the text into which it was inserted.
1552 If the text goes between two intervals, then if neither interval
1553 had its appropriate sticky property set (front_sticky, rear_sticky),
1554 the new text has only its properties. If one of the sticky properties
1555 is set, then the new text "sticks" to that region and its properties
1556 depend on merging as above. If both the preceding and succeeding
1557 intervals to the new text are "sticky", then the new text retains
1558 only its properties, as if neither sticky property were set. Perhaps
1559 we should consider merging all three sets of properties onto the new
1563 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1565 int position
, length
;
1566 struct buffer
*buffer
;
1569 register INTERVAL under
, over
, this, prev
;
1570 register INTERVAL tree
;
1573 tree
= BUF_INTERVALS (buffer
);
1575 /* If the new text has no properties, it becomes part of whatever
1576 interval it was inserted into. */
1577 if (NULL_INTERVAL_P (source
))
1580 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1582 int saved_inhibit_modification_hooks
= inhibit_modification_hooks
;
1583 XSETBUFFER (buf
, buffer
);
1584 inhibit_modification_hooks
= 1;
1585 Fset_text_properties (make_number (position
),
1586 make_number (position
+ length
),
1588 inhibit_modification_hooks
= saved_inhibit_modification_hooks
;
1590 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1591 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1595 if (NULL_INTERVAL_P (tree
))
1597 /* The inserted text constitutes the whole buffer, so
1598 simply copy over the interval structure. */
1599 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1602 XSETBUFFER (buf
, buffer
);
1603 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1604 BUF_INTERVALS (buffer
)->position
= 1;
1606 /* Explicitly free the old tree here? */
1611 /* Create an interval tree in which to place a copy
1612 of the intervals of the inserted string. */
1615 XSETBUFFER (buf
, buffer
);
1616 tree
= create_root_interval (buf
);
1619 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1620 /* If the buffer contains only the new string, but
1621 there was already some interval tree there, then it may be
1622 some zero length intervals. Eventually, do something clever
1623 about inserting properly. For now, just waste the old intervals. */
1625 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1626 BUF_INTERVALS (buffer
)->position
= 1;
1627 /* Explicitly free the old tree here. */
1631 /* Paranoia -- the text has already been added, so this buffer
1632 should be of non-zero length. */
1633 else if (TOTAL_LENGTH (tree
) == 0)
1636 this = under
= find_interval (tree
, position
);
1637 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1639 over
= find_interval (source
, interval_start_pos (source
));
1641 /* Here for insertion in the middle of an interval.
1642 Split off an equivalent interval to the right,
1643 then don't bother with it any more. */
1645 if (position
> under
->position
)
1647 INTERVAL end_unchanged
1648 = split_interval_left (this, position
- under
->position
);
1649 copy_properties (under
, end_unchanged
);
1650 under
->position
= position
;
1656 prev
= previous_interval (under
);
1657 if (prev
&& !END_NONSTICKY_P (prev
))
1661 /* Insertion is now at beginning of UNDER. */
1663 /* The inserted text "sticks" to the interval `under',
1664 which means it gets those properties.
1665 The properties of under are the result of
1666 adjust_intervals_for_insertion, so stickiness has
1667 already been taken care of. */
1669 while (! NULL_INTERVAL_P (over
))
1671 if (LENGTH (over
) < LENGTH (under
))
1673 this = split_interval_left (under
, LENGTH (over
));
1674 copy_properties (under
, this);
1678 copy_properties (over
, this);
1680 merge_properties (over
, this);
1682 copy_properties (over
, this);
1683 over
= next_interval (over
);
1686 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1687 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1691 /* Get the value of property PROP from PLIST,
1692 which is the plist of an interval.
1693 We check for direct properties, for categories with property PROP,
1694 and for PROP appearing on the default-text-properties list. */
1697 textget (plist
, prop
)
1699 register Lisp_Object prop
;
1701 register Lisp_Object tail
, fallback
;
1704 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1706 register Lisp_Object tem
;
1709 return Fcar (Fcdr (tail
));
1710 if (EQ (tem
, Qcategory
))
1712 tem
= Fcar (Fcdr (tail
));
1714 fallback
= Fget (tem
, prop
);
1718 if (! NILP (fallback
))
1720 if (CONSP (Vdefault_text_properties
))
1721 return Fplist_get (Vdefault_text_properties
, prop
);
1726 /* Set point "temporarily", without checking any text properties. */
1729 temp_set_point (buffer
, charpos
)
1730 struct buffer
*buffer
;
1733 temp_set_point_both (buffer
, charpos
,
1734 buf_charpos_to_bytepos (buffer
, charpos
));
1737 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1738 byte position BYTEPOS. */
1741 temp_set_point_both (buffer
, charpos
, bytepos
)
1742 int charpos
, bytepos
;
1743 struct buffer
*buffer
;
1745 /* In a single-byte buffer, the two positions must be equal. */
1746 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1747 && charpos
!= bytepos
)
1750 if (charpos
> bytepos
)
1753 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1756 BUF_PT_BYTE (buffer
) = bytepos
;
1757 BUF_PT (buffer
) = charpos
;
1760 /* Set point in BUFFER to CHARPOS. If the target position is
1761 before an intangible character, move to an ok place. */
1764 set_point (buffer
, charpos
)
1765 register struct buffer
*buffer
;
1766 register int charpos
;
1768 set_point_both (buffer
, charpos
, buf_charpos_to_bytepos (buffer
, charpos
));
1771 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1772 position BYTEPOS. If the target position is
1773 before an intangible character, move to an ok place. */
1776 set_point_both (buffer
, charpos
, bytepos
)
1777 register struct buffer
*buffer
;
1778 register int charpos
, bytepos
;
1780 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1782 register Lisp_Object obj
;
1783 int old_position
= BUF_PT (buffer
);
1784 int backwards
= (charpos
< old_position
? 1 : 0);
1786 int original_position
;
1788 buffer
->point_before_scroll
= Qnil
;
1790 if (charpos
== BUF_PT (buffer
))
1793 /* In a single-byte buffer, the two positions must be equal. */
1794 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1795 && charpos
!= bytepos
)
1798 /* Check this now, before checking if the buffer has any intervals.
1799 That way, we can catch conditions which break this sanity check
1800 whether or not there are intervals in the buffer. */
1801 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1804 have_overlays
= (! NILP (buffer
->overlays_before
)
1805 || ! NILP (buffer
->overlays_after
));
1807 /* If we have no text properties and overlays,
1808 then we can do it quickly. */
1809 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1811 temp_set_point_both (buffer
, charpos
, bytepos
);
1815 /* Set TO to the interval containing the char after CHARPOS,
1816 and TOPREV to the interval containing the char before CHARPOS.
1817 Either one may be null. They may be equal. */
1818 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1819 if (charpos
== BUF_BEGV (buffer
))
1821 else if (to
&& to
->position
== charpos
)
1822 toprev
= previous_interval (to
);
1826 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1827 ? BUF_ZV (buffer
) - 1
1830 /* Set FROM to the interval containing the char after PT,
1831 and FROMPREV to the interval containing the char before PT.
1832 Either one may be null. They may be equal. */
1833 /* We could cache this and save time. */
1834 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1835 if (buffer_point
== BUF_BEGV (buffer
))
1837 else if (from
&& from
->position
== BUF_PT (buffer
))
1838 fromprev
= previous_interval (from
);
1839 else if (buffer_point
!= BUF_PT (buffer
))
1840 fromprev
= from
, from
= 0;
1844 /* Moving within an interval. */
1845 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1848 temp_set_point_both (buffer
, charpos
, bytepos
);
1852 original_position
= charpos
;
1854 /* If the new position is between two intangible characters
1855 with the same intangible property value,
1856 move forward or backward until a change in that property. */
1857 if (NILP (Vinhibit_point_motion_hooks
)
1858 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1860 /* Intangibility never stops us from positioning at the beginning
1861 or end of the buffer, so don't bother checking in that case. */
1862 && charpos
!= BEGV
&& charpos
!= ZV
)
1864 Lisp_Object intangible_propval
;
1867 XSETINT (pos
, charpos
);
1871 intangible_propval
= Fget_char_property (make_number (charpos
),
1874 /* If following char is intangible,
1875 skip back over all chars with matching intangible property. */
1876 if (! NILP (intangible_propval
))
1877 while (XINT (pos
) > BUF_BEGV (buffer
)
1878 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1880 intangible_propval
))
1881 pos
= Fprevious_char_property_change (pos
, Qnil
);
1885 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
1888 /* If following char is intangible,
1889 skip forward over all chars with matching intangible property. */
1890 if (! NILP (intangible_propval
))
1891 while (XINT (pos
) < BUF_ZV (buffer
)
1892 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1893 intangible_propval
))
1894 pos
= Fnext_char_property_change (pos
, Qnil
);
1898 charpos
= XINT (pos
);
1899 bytepos
= buf_charpos_to_bytepos (buffer
, charpos
);
1902 if (charpos
!= original_position
)
1904 /* Set TO to the interval containing the char after CHARPOS,
1905 and TOPREV to the interval containing the char before CHARPOS.
1906 Either one may be null. They may be equal. */
1907 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1908 if (charpos
== BUF_BEGV (buffer
))
1910 else if (to
&& to
->position
== charpos
)
1911 toprev
= previous_interval (to
);
1916 /* Here TO is the interval after the stopping point
1917 and TOPREV is the interval before the stopping point.
1918 One or the other may be null. */
1920 temp_set_point_both (buffer
, charpos
, bytepos
);
1922 /* We run point-left and point-entered hooks here, iff the
1923 two intervals are not equivalent. These hooks take
1924 (old_point, new_point) as arguments. */
1925 if (NILP (Vinhibit_point_motion_hooks
)
1926 && (! intervals_equal (from
, to
)
1927 || ! intervals_equal (fromprev
, toprev
)))
1929 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1932 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1936 leave_before
= textget (from
->plist
, Qpoint_left
);
1938 leave_before
= Qnil
;
1941 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1945 enter_before
= textget (to
->plist
, Qpoint_entered
);
1947 enter_before
= Qnil
;
1949 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1950 call2 (leave_before
, make_number (old_position
),
1951 make_number (charpos
));
1952 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1953 call2 (leave_after
, make_number (old_position
),
1954 make_number (charpos
));
1956 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1957 call2 (enter_before
, make_number (old_position
),
1958 make_number (charpos
));
1959 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1960 call2 (enter_after
, make_number (old_position
),
1961 make_number (charpos
));
1965 /* Move point to POSITION, unless POSITION is inside an intangible
1966 segment that reaches all the way to point. */
1969 move_if_not_intangible (position
)
1973 Lisp_Object intangible_propval
;
1975 XSETINT (pos
, position
);
1977 if (! NILP (Vinhibit_point_motion_hooks
))
1978 /* If intangible is inhibited, always move point to POSITION. */
1980 else if (PT
< position
&& XINT (pos
) < ZV
)
1982 /* We want to move forward, so check the text before POSITION. */
1984 intangible_propval
= Fget_char_property (pos
,
1987 /* If following char is intangible,
1988 skip back over all chars with matching intangible property. */
1989 if (! NILP (intangible_propval
))
1990 while (XINT (pos
) > BEGV
1991 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1993 intangible_propval
))
1994 pos
= Fprevious_char_property_change (pos
, Qnil
);
1996 else if (XINT (pos
) > BEGV
)
1998 /* We want to move backward, so check the text after POSITION. */
2000 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2003 /* If following char is intangible,
2004 skip forward over all chars with matching intangible property. */
2005 if (! NILP (intangible_propval
))
2006 while (XINT (pos
) < ZV
2007 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2008 intangible_propval
))
2009 pos
= Fnext_char_property_change (pos
, Qnil
);
2013 /* If the whole stretch between PT and POSITION isn't intangible,
2014 try moving to POSITION (which means we actually move farther
2015 if POSITION is inside of intangible text). */
2017 if (XINT (pos
) != PT
)
2021 /* Return the proper local map for position POSITION in BUFFER.
2022 Use the map specified by the local-map property, if any.
2023 Otherwise, use BUFFER's local map. */
2026 get_local_map (position
, buffer
)
2027 register int position
;
2028 register struct buffer
*buffer
;
2030 Lisp_Object prop
, tem
, lispy_position
, lispy_buffer
;
2031 int old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2033 /* Perhaps we should just change `position' to the limit. */
2034 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
2037 /* Ignore narrowing, so that a local map continues to be valid even if
2038 the visible region contains no characters and hence no properties. */
2039 old_begv
= BUF_BEGV (buffer
);
2040 old_zv
= BUF_ZV (buffer
);
2041 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2042 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2043 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
2044 BUF_ZV (buffer
) = BUF_Z (buffer
);
2045 BUF_BEGV_BYTE (buffer
) = BUF_BEG_BYTE (buffer
);
2046 BUF_ZV_BYTE (buffer
) = BUF_Z_BYTE (buffer
);
2048 /* There are no properties at the end of the buffer, so in that case
2049 check for a local map on the last character of the buffer instead. */
2050 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
2052 XSETFASTINT (lispy_position
, position
);
2053 XSETBUFFER (lispy_buffer
, buffer
);
2054 prop
= Fget_char_property (lispy_position
, Qlocal_map
, lispy_buffer
);
2056 BUF_BEGV (buffer
) = old_begv
;
2057 BUF_ZV (buffer
) = old_zv
;
2058 BUF_BEGV_BYTE (buffer
) = old_begv_byte
;
2059 BUF_ZV_BYTE (buffer
) = old_zv_byte
;
2061 /* Use the local map only if it is valid. */
2062 /* Do allow symbols that are defined as keymaps. */
2063 if (SYMBOLP (prop
) && !NILP (prop
))
2064 prop
= Findirect_function (prop
);
2066 && (tem
= Fkeymapp (prop
), !NILP (tem
)))
2069 return buffer
->keymap
;
2072 /* Produce an interval tree reflecting the intervals in
2073 TREE from START to START + LENGTH.
2074 The new interval tree has no parent and has a starting-position of 0. */
2077 copy_intervals (tree
, start
, length
)
2081 register INTERVAL i
, new, t
;
2082 register int got
, prevlen
;
2084 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2085 return NULL_INTERVAL
;
2087 i
= find_interval (tree
, start
);
2088 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2091 /* If there is only one interval and it's the default, return nil. */
2092 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2093 && DEFAULT_INTERVAL_P (i
))
2094 return NULL_INTERVAL
;
2096 new = make_interval ();
2098 got
= (LENGTH (i
) - (start
- i
->position
));
2099 new->total_length
= length
;
2100 copy_properties (i
, new);
2104 while (got
< length
)
2106 i
= next_interval (i
);
2107 t
= split_interval_right (t
, prevlen
);
2108 copy_properties (i
, t
);
2109 prevlen
= LENGTH (i
);
2113 return balance_an_interval (new);
2116 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2119 copy_intervals_to_string (string
, buffer
, position
, length
)
2121 struct buffer
*buffer
;
2122 int position
, length
;
2124 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2126 if (NULL_INTERVAL_P (interval_copy
))
2129 interval_copy
->parent
= (INTERVAL
) XFASTINT (string
);
2130 XSTRING (string
)->intervals
= interval_copy
;
2133 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2134 Assume they have identical characters. */
2137 compare_string_intervals (s1
, s2
)
2142 int end
= XSTRING (s1
)->size
;
2144 i1
= find_interval (XSTRING (s1
)->intervals
, 0);
2145 i2
= find_interval (XSTRING (s2
)->intervals
, 0);
2149 /* Determine how far we can go before we reach the end of I1 or I2. */
2150 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2151 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2152 int distance
= min (len1
, len2
);
2154 /* If we ever find a mismatch between the strings,
2156 if (! intervals_equal (i1
, i2
))
2159 /* Advance POS till the end of the shorter interval,
2160 and advance one or both interval pointers for the new position. */
2162 if (len1
== distance
)
2163 i1
= next_interval (i1
);
2164 if (len2
== distance
)
2165 i2
= next_interval (i2
);
2170 /* Recursively adjust interval I in the current buffer
2171 for setting enable_multibyte_characters to MULTI_FLAG.
2172 The range of interval I is START ... END in characters,
2173 START_BYTE ... END_BYTE in bytes. */
2176 set_intervals_multibyte_1 (i
, multi_flag
, start
, start_byte
, end
, end_byte
)
2179 int start
, start_byte
, end
, end_byte
;
2181 INTERVAL left
, right
;
2183 /* Fix the length of this interval. */
2185 i
->total_length
= end
- start
;
2187 i
->total_length
= end_byte
- start_byte
;
2189 /* Recursively fix the length of the subintervals. */
2192 int left_end
, left_end_byte
;
2196 left_end_byte
= start_byte
+ LEFT_TOTAL_LENGTH (i
);
2197 left_end
= BYTE_TO_CHAR (left_end_byte
);
2201 left_end
= start
+ LEFT_TOTAL_LENGTH (i
);
2202 left_end_byte
= CHAR_TO_BYTE (left_end
);
2205 set_intervals_multibyte_1 (i
->left
, multi_flag
, start
, start_byte
,
2206 left_end
, left_end_byte
);
2210 int right_start_byte
, right_start
;
2214 right_start_byte
= end_byte
- RIGHT_TOTAL_LENGTH (i
);
2215 right_start
= BYTE_TO_CHAR (right_start_byte
);
2219 right_start
= end
- RIGHT_TOTAL_LENGTH (i
);
2220 right_start_byte
= CHAR_TO_BYTE (right_start
);
2223 set_intervals_multibyte_1 (i
->right
, multi_flag
,
2224 right_start
, right_start_byte
,
2229 /* Update the intervals of the current buffer
2230 to fit the contents as multibyte (if MULTI_FLAG is 1)
2231 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2234 set_intervals_multibyte (multi_flag
)
2237 if (BUF_INTERVALS (current_buffer
))
2238 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer
), multi_flag
,
2239 BEG
, BEG_BYTE
, Z
, Z_BYTE
);
2242 #endif /* USE_TEXT_PROPERTIES */