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. */
192 /* Traverse an interval tree TREE, performing FUNCTION on each node.
193 Pass FUNCTION two args: an interval, and ARG. */
196 traverse_intervals (tree
, position
, depth
, function
, arg
)
199 void (* function
) P_ ((INTERVAL
, Lisp_Object
));
202 if (NULL_INTERVAL_P (tree
))
205 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
206 position
+= LEFT_TOTAL_LENGTH (tree
);
207 tree
->position
= position
;
208 (*function
) (tree
, arg
);
209 position
+= LENGTH (tree
);
210 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
217 static int zero_length
;
219 /* These functions are temporary, for debugging purposes only. */
221 INTERVAL search_interval
, found_interval
;
224 check_for_interval (i
)
227 if (i
== search_interval
)
235 search_for_interval (i
, tree
)
236 register INTERVAL i
, tree
;
240 found_interval
= NULL_INTERVAL
;
241 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
242 return found_interval
;
246 inc_interval_count (i
)
263 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
269 root_interval (interval
)
272 register INTERVAL i
= interval
;
274 while (! ROOT_INTERVAL_P (i
))
281 /* Assuming that a left child exists, perform the following operation:
291 rotate_right (interval
)
295 INTERVAL B
= interval
->left
;
296 int old_total
= interval
->total_length
;
298 /* Deal with any Parent of A; make it point to B. */
299 if (! ROOT_INTERVAL_P (interval
))
301 if (AM_LEFT_CHILD (interval
))
302 interval
->parent
->left
= B
;
304 interval
->parent
->right
= B
;
306 B
->parent
= interval
->parent
;
308 /* Make B the parent of A */
311 interval
->parent
= B
;
313 /* Make A point to c */
315 if (! NULL_INTERVAL_P (i
))
316 i
->parent
= interval
;
318 /* A's total length is decreased by the length of B and its left child. */
319 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
321 /* B must have the same total length of A. */
322 B
->total_length
= old_total
;
327 /* Assuming that a right child exists, perform the following operation:
337 rotate_left (interval
)
341 INTERVAL B
= interval
->right
;
342 int old_total
= interval
->total_length
;
344 /* Deal with any parent of A; make it point to B. */
345 if (! ROOT_INTERVAL_P (interval
))
347 if (AM_LEFT_CHILD (interval
))
348 interval
->parent
->left
= B
;
350 interval
->parent
->right
= B
;
352 B
->parent
= interval
->parent
;
354 /* Make B the parent of A */
357 interval
->parent
= B
;
359 /* Make A point to c */
361 if (! NULL_INTERVAL_P (i
))
362 i
->parent
= interval
;
364 /* A's total length is decreased by the length of B and its right child. */
365 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
367 /* B must have the same total length of A. */
368 B
->total_length
= old_total
;
373 /* Balance an interval tree with the assumption that the subtrees
374 themselves are already balanced. */
377 balance_an_interval (i
)
380 register int old_diff
, new_diff
;
384 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
387 new_diff
= i
->total_length
- i
->left
->total_length
388 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
389 if (abs (new_diff
) >= old_diff
)
391 i
= rotate_right (i
);
392 balance_an_interval (i
->right
);
394 else if (old_diff
< 0)
396 new_diff
= i
->total_length
- i
->right
->total_length
397 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
398 if (abs (new_diff
) >= -old_diff
)
401 balance_an_interval (i
->left
);
409 /* Balance INTERVAL, potentially stuffing it back into its parent
412 static INLINE INTERVAL
413 balance_possible_root_interval (interval
)
414 register INTERVAL interval
;
418 if (interval
->parent
== NULL_INTERVAL
)
421 XSETFASTINT (parent
, (EMACS_INT
) interval
->parent
);
422 interval
= balance_an_interval (interval
);
424 if (BUFFERP (parent
))
425 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
426 else if (STRINGP (parent
))
427 XSTRING (parent
)->intervals
= interval
;
432 /* Balance the interval tree TREE. Balancing is by weight
433 (the amount of text). */
436 balance_intervals_internal (tree
)
437 register INTERVAL tree
;
439 /* Balance within each side. */
441 balance_intervals_internal (tree
->left
);
443 balance_intervals_internal (tree
->right
);
444 return balance_an_interval (tree
);
447 /* Advertised interface to balance intervals. */
450 balance_intervals (tree
)
453 if (tree
== NULL_INTERVAL
)
454 return NULL_INTERVAL
;
456 return balance_intervals_internal (tree
);
459 /* Split INTERVAL into two pieces, starting the second piece at
460 character position OFFSET (counting from 0), relative to INTERVAL.
461 INTERVAL becomes the left-hand piece, and the right-hand piece
462 (second, lexicographically) is returned.
464 The size and position fields of the two intervals are set based upon
465 those of the original interval. The property list of the new interval
466 is reset, thus it is up to the caller to do the right thing with the
469 Note that this does not change the position of INTERVAL; if it is a root,
470 it is still a root after this operation. */
473 split_interval_right (interval
, offset
)
477 INTERVAL
new = make_interval ();
478 int position
= interval
->position
;
479 int new_length
= LENGTH (interval
) - offset
;
481 new->position
= position
+ offset
;
482 new->parent
= interval
;
484 if (NULL_RIGHT_CHILD (interval
))
486 interval
->right
= new;
487 new->total_length
= new_length
;
491 /* Insert the new node between INTERVAL and its right child. */
492 new->right
= interval
->right
;
493 interval
->right
->parent
= new;
494 interval
->right
= new;
495 new->total_length
= new_length
+ new->right
->total_length
;
496 balance_an_interval (new);
499 balance_possible_root_interval (interval
);
504 /* Split INTERVAL into two pieces, starting the second piece at
505 character position OFFSET (counting from 0), relative to INTERVAL.
506 INTERVAL becomes the right-hand piece, and the left-hand piece
507 (first, lexicographically) is returned.
509 The size and position fields of the two intervals are set based upon
510 those of the original interval. The property list of the new interval
511 is reset, thus it is up to the caller to do the right thing with the
514 Note that this does not change the position of INTERVAL; if it is a root,
515 it is still a root after this operation. */
518 split_interval_left (interval
, offset
)
522 INTERVAL
new = make_interval ();
523 int new_length
= offset
;
525 new->position
= interval
->position
;
526 interval
->position
= interval
->position
+ offset
;
527 new->parent
= interval
;
529 if (NULL_LEFT_CHILD (interval
))
531 interval
->left
= new;
532 new->total_length
= new_length
;
536 /* Insert the new node between INTERVAL and its left child. */
537 new->left
= interval
->left
;
538 new->left
->parent
= new;
539 interval
->left
= new;
540 new->total_length
= new_length
+ new->left
->total_length
;
541 balance_an_interval (new);
544 balance_possible_root_interval (interval
);
549 /* Return the proper position for the first character
550 described by the interval tree SOURCE.
551 This is 1 if the parent is a buffer,
552 0 if the parent is a string or if there is no parent.
554 Don't use this function on an interval which is the child
555 of another interval! */
558 interval_start_pos (source
)
563 if (NULL_INTERVAL_P (source
))
566 XSETFASTINT (parent
, (EMACS_INT
) source
->parent
);
567 if (BUFFERP (parent
))
568 return BUF_BEG (XBUFFER (parent
));
572 /* Find the interval containing text position POSITION in the text
573 represented by the interval tree TREE. POSITION is a buffer
574 position (starting from 1) or a string index (starting from 0).
575 If POSITION is at the end of the buffer or string,
576 return the interval containing the last character.
578 The `position' field, which is a cache of an interval's position,
579 is updated in the interval found. Other functions (e.g., next_interval)
580 will update this cache based on the result of find_interval. */
583 find_interval (tree
, position
)
584 register INTERVAL tree
;
585 register int position
;
587 /* The distance from the left edge of the subtree at TREE
589 register int relative_position
;
592 if (NULL_INTERVAL_P (tree
))
593 return NULL_INTERVAL
;
595 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
596 relative_position
= position
;
597 if (BUFFERP (parent
))
598 relative_position
-= BUF_BEG (XBUFFER (parent
));
600 if (relative_position
> TOTAL_LENGTH (tree
))
601 abort (); /* Paranoia */
603 tree
= balance_possible_root_interval (tree
);
607 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
611 else if (! NULL_RIGHT_CHILD (tree
)
612 && relative_position
>= (TOTAL_LENGTH (tree
)
613 - RIGHT_TOTAL_LENGTH (tree
)))
615 relative_position
-= (TOTAL_LENGTH (tree
)
616 - RIGHT_TOTAL_LENGTH (tree
));
622 = (position
- relative_position
/* the left edge of *tree */
623 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
630 /* Find the succeeding interval (lexicographically) to INTERVAL.
631 Sets the `position' field based on that of INTERVAL (see
635 next_interval (interval
)
636 register INTERVAL interval
;
638 register INTERVAL i
= interval
;
639 register int next_position
;
641 if (NULL_INTERVAL_P (i
))
642 return NULL_INTERVAL
;
643 next_position
= interval
->position
+ LENGTH (interval
);
645 if (! NULL_RIGHT_CHILD (i
))
648 while (! NULL_LEFT_CHILD (i
))
651 i
->position
= next_position
;
655 while (! NULL_PARENT (i
))
657 if (AM_LEFT_CHILD (i
))
660 i
->position
= next_position
;
667 return NULL_INTERVAL
;
670 /* Find the preceding interval (lexicographically) to INTERVAL.
671 Sets the `position' field based on that of INTERVAL (see
675 previous_interval (interval
)
676 register INTERVAL interval
;
680 if (NULL_INTERVAL_P (interval
))
681 return NULL_INTERVAL
;
683 if (! NULL_LEFT_CHILD (interval
))
686 while (! NULL_RIGHT_CHILD (i
))
689 i
->position
= interval
->position
- LENGTH (i
);
694 while (! NULL_PARENT (i
))
696 if (AM_RIGHT_CHILD (i
))
700 i
->position
= interval
->position
- LENGTH (i
);
706 return NULL_INTERVAL
;
709 /* Find the interval containing POS given some non-NULL INTERVAL
710 in the same tree. Note that we need to update interval->position
711 if we go down the tree. */
713 update_interval (i
, pos
)
717 if (NULL_INTERVAL_P (i
))
718 return NULL_INTERVAL
;
722 if (pos
< i
->position
)
725 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
727 i
->left
->position
= i
->position
- TOTAL_LENGTH (i
->left
)
728 + LEFT_TOTAL_LENGTH (i
->left
);
729 i
= i
->left
; /* Move to the left child */
731 else if (NULL_PARENT (i
))
732 error ("Point before start of properties");
737 else if (pos
>= INTERVAL_LAST_POS (i
))
740 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
742 i
->right
->position
= INTERVAL_LAST_POS (i
) +
743 LEFT_TOTAL_LENGTH (i
->right
);
744 i
= i
->right
; /* Move to the right child */
746 else if (NULL_PARENT (i
))
747 error ("Point after end of properties");
759 /* Traverse a path down the interval tree TREE to the interval
760 containing POSITION, adjusting all nodes on the path for
761 an addition of LENGTH characters. Insertion between two intervals
762 (i.e., point == i->position, where i is second interval) means
763 text goes into second interval.
765 Modifications are needed to handle the hungry bits -- after simply
766 finding the interval at position (don't add length going down),
767 if it's the beginning of the interval, get the previous interval
768 and check the hungry bits of both. Then add the length going back up
772 adjust_intervals_for_insertion (tree
, position
, length
)
774 int position
, length
;
776 register int relative_position
;
777 register INTERVAL
this;
779 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
782 /* If inserting at point-max of a buffer, that position
783 will be out of range */
784 if (position
> TOTAL_LENGTH (tree
))
785 position
= TOTAL_LENGTH (tree
);
786 relative_position
= position
;
791 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
793 this->total_length
+= length
;
796 else if (relative_position
> (TOTAL_LENGTH (this)
797 - RIGHT_TOTAL_LENGTH (this)))
799 relative_position
-= (TOTAL_LENGTH (this)
800 - RIGHT_TOTAL_LENGTH (this));
801 this->total_length
+= length
;
806 /* If we are to use zero-length intervals as buffer pointers,
807 then this code will have to change. */
808 this->total_length
+= length
;
809 this->position
= LEFT_TOTAL_LENGTH (this)
810 + position
- relative_position
+ 1;
817 /* Effect an adjustment corresponding to the addition of LENGTH characters
818 of text. Do this by finding the interval containing POSITION in the
819 interval tree TREE, and then adjusting all of its ancestors by adding
822 If POSITION is the first character of an interval, meaning that point
823 is actually between the two intervals, make the new text belong to
824 the interval which is "sticky".
826 If both intervals are "sticky", then make them belong to the left-most
827 interval. Another possibility would be to create a new interval for
828 this text, and make it have the merged properties of both ends. */
831 adjust_intervals_for_insertion (tree
, position
, length
)
833 int position
, length
;
836 register INTERVAL temp
;
841 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
844 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
845 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
847 /* If inserting at point-max of a buffer, that position will be out
848 of range. Remember that buffer positions are 1-based. */
849 if (position
>= TOTAL_LENGTH (tree
) + offset
)
851 position
= TOTAL_LENGTH (tree
) + offset
;
855 i
= find_interval (tree
, position
);
857 /* If in middle of an interval which is not sticky either way,
858 we must not just give its properties to the insertion.
859 So split this interval at the insertion point. */
860 if (! (position
== i
->position
|| eobp
)
861 && END_NONSTICKY_P (i
)
862 && FRONT_NONSTICKY_P (i
))
865 Lisp_Object front
, rear
;
867 front
= textget (i
->plist
, Qfront_sticky
);
868 rear
= textget (i
->plist
, Qrear_nonsticky
);
870 /* Does any actual property pose an actual problem? */
871 for (tail
= i
->plist
; ! NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
876 /* Is this particular property rear-sticky?
877 Note, if REAR isn't a cons, it must be non-nil,
878 which means that all properties are rear-nonsticky. */
879 if (CONSP (rear
) && NILP (Fmemq (prop
, rear
)))
882 /* Is this particular property front-sticky?
883 Note, if FRONT isn't a cons, it must be nil,
884 which means that all properties are front-nonsticky. */
885 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
888 /* PROP isn't sticky on either side => it is a real problem. */
892 /* If any property is a real problem, split the interval. */
895 temp
= split_interval_right (i
, position
- i
->position
);
896 copy_properties (i
, temp
);
901 /* If we are positioned between intervals, check the stickiness of
902 both of them. We have to do this too, if we are at BEG or Z. */
903 if (position
== i
->position
|| eobp
)
905 register INTERVAL prev
;
915 prev
= previous_interval (i
);
917 /* Even if we are positioned between intervals, we default
918 to the left one if it exists. We extend it now and split
919 off a part later, if stickiness demands it. */
920 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
922 temp
->total_length
+= length
;
923 temp
= balance_possible_root_interval (temp
);
926 /* If at least one interval has sticky properties,
927 we check the stickiness property by property. */
928 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
930 Lisp_Object pleft
, pright
;
931 struct interval newi
;
933 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
934 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
935 newi
.plist
= merge_properties_sticky (pleft
, pright
);
937 if (! prev
) /* i.e. position == BEG */
939 if (! intervals_equal (i
, &newi
))
941 i
= split_interval_left (i
, length
);
942 i
->plist
= newi
.plist
;
945 else if (! intervals_equal (prev
, &newi
))
947 prev
= split_interval_right (prev
,
948 position
- prev
->position
);
949 prev
->plist
= newi
.plist
;
950 if (! NULL_INTERVAL_P (i
)
951 && intervals_equal (prev
, i
))
952 merge_interval_right (prev
);
955 /* We will need to update the cache here later. */
957 else if (! prev
&& ! NILP (i
->plist
))
959 /* Just split off a new interval at the left.
960 Since I wasn't front-sticky, the empty plist is ok. */
961 i
= split_interval_left (i
, length
);
965 /* Otherwise just extend the interval. */
968 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
970 temp
->total_length
+= length
;
971 temp
= balance_possible_root_interval (temp
);
978 /* Any property might be front-sticky on the left, rear-sticky on the left,
979 front-sticky on the right, or rear-sticky on the right; the 16 combinations
980 can be arranged in a matrix with rows denoting the left conditions and
981 columns denoting the right conditions:
989 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
990 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
991 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
992 p8 L p9 L pa L pb L pc L pd L pe L pf L)
993 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
994 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
995 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
996 p8 R p9 R pa R pb R pc R pd R pe R pf R)
998 We inherit from whoever has a sticky side facing us. If both sides
999 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1000 non-nil value for the current property. If both sides do, then we take
1003 When we inherit a property, we get its stickiness as well as its value.
1004 So, when we merge the above two lists, we expect to get this:
1006 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1007 rear-nonsticky (p6 pa)
1008 p0 L p1 L p2 L p3 L p6 R p7 R
1009 pa R pb R pc L pd L pe L pf L)
1011 The optimizable special cases are:
1012 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1013 left rear-nonsticky = t, right front-sticky = t (inherit right)
1014 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1018 merge_properties_sticky (pleft
, pright
)
1019 Lisp_Object pleft
, pright
;
1021 register Lisp_Object props
, front
, rear
;
1022 Lisp_Object lfront
, lrear
, rfront
, rrear
;
1023 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
1024 int use_left
, use_right
;
1030 lfront
= textget (pleft
, Qfront_sticky
);
1031 lrear
= textget (pleft
, Qrear_nonsticky
);
1032 rfront
= textget (pright
, Qfront_sticky
);
1033 rrear
= textget (pright
, Qrear_nonsticky
);
1035 /* Go through each element of PRIGHT. */
1036 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1040 /* Sticky properties get special treatment. */
1041 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1044 rval
= Fcar (Fcdr (tail1
));
1045 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1046 if (EQ (sym
, Fcar (tail2
)))
1049 /* Indicate whether the property is explicitly defined on the left.
1050 (We know it is defined explicitly on the right
1051 because otherwise we don't get here.) */
1052 lpresent
= ! NILP (tail2
);
1053 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1055 use_left
= ! TMEM (sym
, lrear
) && lpresent
;
1056 use_right
= TMEM (sym
, rfront
);
1057 if (use_left
&& use_right
)
1061 else if (NILP (rval
))
1066 /* We build props as (value sym ...) rather than (sym value ...)
1067 because we plan to nreverse it when we're done. */
1068 props
= Fcons (lval
, Fcons (sym
, props
));
1069 if (TMEM (sym
, lfront
))
1070 front
= Fcons (sym
, front
);
1071 if (TMEM (sym
, lrear
))
1072 rear
= Fcons (sym
, rear
);
1076 props
= Fcons (rval
, Fcons (sym
, props
));
1077 if (TMEM (sym
, rfront
))
1078 front
= Fcons (sym
, front
);
1079 if (TMEM (sym
, rrear
))
1080 rear
= Fcons (sym
, rear
);
1084 /* Now go through each element of PLEFT. */
1085 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1089 /* Sticky properties get special treatment. */
1090 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1093 /* If sym is in PRIGHT, we've already considered it. */
1094 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1095 if (EQ (sym
, Fcar (tail1
)))
1100 lval
= Fcar (Fcdr (tail2
));
1102 /* Since rval is known to be nil in this loop, the test simplifies. */
1103 if (! TMEM (sym
, lrear
))
1105 props
= Fcons (lval
, Fcons (sym
, props
));
1106 if (TMEM (sym
, lfront
))
1107 front
= Fcons (sym
, front
);
1109 else if (TMEM (sym
, rfront
))
1111 /* The value is nil, but we still inherit the stickiness
1113 front
= Fcons (sym
, front
);
1114 if (TMEM (sym
, rrear
))
1115 rear
= Fcons (sym
, rear
);
1118 props
= Fnreverse (props
);
1120 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1122 cat
= textget (props
, Qcategory
);
1125 /* If we have inherited a front-stick category property that is t,
1126 we don't need to set up a detailed one. */
1127 ! (! NILP (cat
) && SYMBOLP (cat
)
1128 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1129 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1134 /* Delete an node I from its interval tree by merging its subtrees
1135 into one subtree which is then returned. Caller is responsible for
1136 storing the resulting subtree into its parent. */
1140 register INTERVAL i
;
1142 register INTERVAL migrate
, this;
1143 register int migrate_amt
;
1145 if (NULL_INTERVAL_P (i
->left
))
1147 if (NULL_INTERVAL_P (i
->right
))
1151 migrate_amt
= i
->left
->total_length
;
1153 this->total_length
+= migrate_amt
;
1154 while (! NULL_INTERVAL_P (this->left
))
1157 this->total_length
+= migrate_amt
;
1159 this->left
= migrate
;
1160 migrate
->parent
= this;
1165 /* Delete interval I from its tree by calling `delete_node'
1166 and properly connecting the resultant subtree.
1168 I is presumed to be empty; that is, no adjustments are made
1169 for the length of I. */
1173 register INTERVAL i
;
1175 register INTERVAL parent
;
1176 int amt
= LENGTH (i
);
1178 if (amt
> 0) /* Only used on zero-length intervals now. */
1181 if (ROOT_INTERVAL_P (i
))
1184 XSETFASTINT (owner
, (EMACS_INT
) i
->parent
);
1185 parent
= delete_node (i
);
1186 if (! NULL_INTERVAL_P (parent
))
1187 parent
->parent
= (INTERVAL
) XFASTINT (owner
);
1189 if (BUFFERP (owner
))
1190 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1191 else if (STRINGP (owner
))
1192 XSTRING (owner
)->intervals
= parent
;
1200 if (AM_LEFT_CHILD (i
))
1202 parent
->left
= delete_node (i
);
1203 if (! NULL_INTERVAL_P (parent
->left
))
1204 parent
->left
->parent
= parent
;
1208 parent
->right
= delete_node (i
);
1209 if (! NULL_INTERVAL_P (parent
->right
))
1210 parent
->right
->parent
= parent
;
1214 /* Find the interval in TREE corresponding to the relative position
1215 FROM and delete as much as possible of AMOUNT from that interval.
1216 Return the amount actually deleted, and if the interval was
1217 zeroed-out, delete that interval node from the tree.
1219 Note that FROM is actually origin zero, aka relative to the
1220 leftmost edge of tree. This is appropriate since we call ourselves
1221 recursively on subtrees.
1223 Do this by recursing down TREE to the interval in question, and
1224 deleting the appropriate amount of text. */
1227 interval_deletion_adjustment (tree
, from
, amount
)
1228 register INTERVAL tree
;
1229 register int from
, amount
;
1231 register int relative_position
= from
;
1233 if (NULL_INTERVAL_P (tree
))
1237 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1239 int subtract
= interval_deletion_adjustment (tree
->left
,
1242 tree
->total_length
-= subtract
;
1246 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1247 - RIGHT_TOTAL_LENGTH (tree
)))
1251 relative_position
-= (tree
->total_length
1252 - RIGHT_TOTAL_LENGTH (tree
));
1253 subtract
= interval_deletion_adjustment (tree
->right
,
1256 tree
->total_length
-= subtract
;
1259 /* Here -- this node. */
1262 /* How much can we delete from this interval? */
1263 int my_amount
= ((tree
->total_length
1264 - RIGHT_TOTAL_LENGTH (tree
))
1265 - relative_position
);
1267 if (amount
> my_amount
)
1270 tree
->total_length
-= amount
;
1271 if (LENGTH (tree
) == 0)
1272 delete_interval (tree
);
1277 /* Never reach here. */
1280 /* Effect the adjustments necessary to the interval tree of BUFFER to
1281 correspond to the deletion of LENGTH characters from that buffer
1282 text. The deletion is effected at position START (which is a
1283 buffer position, i.e. origin 1). */
1286 adjust_intervals_for_deletion (buffer
, start
, length
)
1287 struct buffer
*buffer
;
1290 register int left_to_delete
= length
;
1291 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1295 XSETFASTINT (parent
, (EMACS_INT
) tree
->parent
);
1296 offset
= (BUFFERP (parent
) ? BUF_BEG (XBUFFER (parent
)) : 0);
1298 if (NULL_INTERVAL_P (tree
))
1301 if (start
> offset
+ TOTAL_LENGTH (tree
)
1302 || start
+ length
> offset
+ TOTAL_LENGTH (tree
))
1305 if (length
== TOTAL_LENGTH (tree
))
1307 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1311 if (ONLY_INTERVAL_P (tree
))
1313 tree
->total_length
-= length
;
1317 if (start
> offset
+ TOTAL_LENGTH (tree
))
1318 start
= offset
+ TOTAL_LENGTH (tree
);
1319 while (left_to_delete
> 0)
1321 left_to_delete
-= interval_deletion_adjustment (tree
, start
- offset
,
1323 tree
= BUF_INTERVALS (buffer
);
1324 if (left_to_delete
== tree
->total_length
)
1326 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1332 /* Make the adjustments necessary to the interval tree of BUFFER to
1333 represent an addition or deletion of LENGTH characters starting
1334 at position START. Addition or deletion is indicated by the sign
1338 offset_intervals (buffer
, start
, length
)
1339 struct buffer
*buffer
;
1342 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1346 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1348 adjust_intervals_for_deletion (buffer
, start
, -length
);
1351 /* Merge interval I with its lexicographic successor. The resulting
1352 interval is returned, and has the properties of the original
1353 successor. The properties of I are lost. I is removed from the
1357 The caller must verify that this is not the last (rightmost)
1361 merge_interval_right (i
)
1362 register INTERVAL i
;
1364 register int absorb
= LENGTH (i
);
1365 register INTERVAL successor
;
1367 /* Zero out this interval. */
1368 i
->total_length
-= absorb
;
1370 /* Find the succeeding interval. */
1371 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1374 successor
= i
->right
;
1375 while (! NULL_LEFT_CHILD (successor
))
1377 successor
->total_length
+= absorb
;
1378 successor
= successor
->left
;
1381 successor
->total_length
+= absorb
;
1382 delete_interval (i
);
1387 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1390 if (AM_LEFT_CHILD (successor
))
1392 successor
= successor
->parent
;
1393 delete_interval (i
);
1397 successor
= successor
->parent
;
1398 successor
->total_length
-= absorb
;
1401 /* This must be the rightmost or last interval and cannot
1402 be merged right. The caller should have known. */
1406 /* Merge interval I with its lexicographic predecessor. The resulting
1407 interval is returned, and has the properties of the original predecessor.
1408 The properties of I are lost. Interval node I is removed from the tree.
1411 The caller must verify that this is not the first (leftmost) interval. */
1414 merge_interval_left (i
)
1415 register INTERVAL i
;
1417 register int absorb
= LENGTH (i
);
1418 register INTERVAL predecessor
;
1420 /* Zero out this interval. */
1421 i
->total_length
-= absorb
;
1423 /* Find the preceding interval. */
1424 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1425 adding ABSORB as we go. */
1427 predecessor
= i
->left
;
1428 while (! NULL_RIGHT_CHILD (predecessor
))
1430 predecessor
->total_length
+= absorb
;
1431 predecessor
= predecessor
->right
;
1434 predecessor
->total_length
+= absorb
;
1435 delete_interval (i
);
1440 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1441 subtracting ABSORB. */
1443 if (AM_RIGHT_CHILD (predecessor
))
1445 predecessor
= predecessor
->parent
;
1446 delete_interval (i
);
1450 predecessor
= predecessor
->parent
;
1451 predecessor
->total_length
-= absorb
;
1454 /* This must be the leftmost or first interval and cannot
1455 be merged left. The caller should have known. */
1459 /* Make an exact copy of interval tree SOURCE which descends from
1460 PARENT. This is done by recursing through SOURCE, copying
1461 the current interval and its properties, and then adjusting
1462 the pointers of the copy. */
1465 reproduce_tree (source
, parent
)
1466 INTERVAL source
, parent
;
1468 register INTERVAL t
= make_interval ();
1470 bcopy (source
, t
, INTERVAL_SIZE
);
1471 copy_properties (source
, t
);
1473 if (! NULL_LEFT_CHILD (source
))
1474 t
->left
= reproduce_tree (source
->left
, t
);
1475 if (! NULL_RIGHT_CHILD (source
))
1476 t
->right
= reproduce_tree (source
->right
, t
);
1482 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1484 /* Make a new interval of length LENGTH starting at START in the
1485 group of intervals INTERVALS, which is actually an interval tree.
1486 Returns the new interval.
1488 Generate an error if the new positions would overlap an existing
1492 make_new_interval (intervals
, start
, length
)
1498 slot
= find_interval (intervals
, start
);
1499 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1500 error ("Interval would overlap");
1502 if (start
== slot
->position
&& length
== LENGTH (slot
))
1505 if (slot
->position
== start
)
1507 /* New right node. */
1508 split_interval_right (slot
, length
);
1512 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1514 /* New left node. */
1515 split_interval_left (slot
, LENGTH (slot
) - length
);
1519 /* Convert interval SLOT into three intervals. */
1520 split_interval_left (slot
, start
- slot
->position
);
1521 split_interval_right (slot
, length
);
1526 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1527 LENGTH is the length of the text in SOURCE.
1529 The `position' field of the SOURCE intervals is assumed to be
1530 consistent with its parent; therefore, SOURCE must be an
1531 interval tree made with copy_interval or must be the whole
1532 tree of a buffer or a string.
1534 This is used in insdel.c when inserting Lisp_Strings into the
1535 buffer. The text corresponding to SOURCE is already in the buffer
1536 when this is called. The intervals of new tree are a copy of those
1537 belonging to the string being inserted; intervals are never
1540 If the inserted text had no intervals associated, and we don't
1541 want to inherit the surrounding text's properties, this function
1542 simply returns -- offset_intervals should handle placing the
1543 text in the correct interval, depending on the sticky bits.
1545 If the inserted text had properties (intervals), then there are two
1546 cases -- either insertion happened in the middle of some interval,
1547 or between two intervals.
1549 If the text goes into the middle of an interval, then new
1550 intervals are created in the middle with only the properties of
1551 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1552 which case the new text has the union of its properties and those
1553 of the text into which it was inserted.
1555 If the text goes between two intervals, then if neither interval
1556 had its appropriate sticky property set (front_sticky, rear_sticky),
1557 the new text has only its properties. If one of the sticky properties
1558 is set, then the new text "sticks" to that region and its properties
1559 depend on merging as above. If both the preceding and succeeding
1560 intervals to the new text are "sticky", then the new text retains
1561 only its properties, as if neither sticky property were set. Perhaps
1562 we should consider merging all three sets of properties onto the new
1566 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1568 int position
, length
;
1569 struct buffer
*buffer
;
1572 register INTERVAL under
, over
, this, prev
;
1573 register INTERVAL tree
;
1576 tree
= BUF_INTERVALS (buffer
);
1578 /* If the new text has no properties, it becomes part of whatever
1579 interval it was inserted into. */
1580 if (NULL_INTERVAL_P (source
))
1583 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1585 int saved_inhibit_modification_hooks
= inhibit_modification_hooks
;
1586 XSETBUFFER (buf
, buffer
);
1587 inhibit_modification_hooks
= 1;
1588 Fset_text_properties (make_number (position
),
1589 make_number (position
+ length
),
1591 inhibit_modification_hooks
= saved_inhibit_modification_hooks
;
1593 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1594 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1598 if (NULL_INTERVAL_P (tree
))
1600 /* The inserted text constitutes the whole buffer, so
1601 simply copy over the interval structure. */
1602 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1605 XSETBUFFER (buf
, buffer
);
1606 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1607 BUF_INTERVALS (buffer
)->position
= 1;
1609 /* Explicitly free the old tree here? */
1614 /* Create an interval tree in which to place a copy
1615 of the intervals of the inserted string. */
1618 XSETBUFFER (buf
, buffer
);
1619 tree
= create_root_interval (buf
);
1622 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1623 /* If the buffer contains only the new string, but
1624 there was already some interval tree there, then it may be
1625 some zero length intervals. Eventually, do something clever
1626 about inserting properly. For now, just waste the old intervals. */
1628 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1629 BUF_INTERVALS (buffer
)->position
= 1;
1630 /* Explicitly free the old tree here. */
1634 /* Paranoia -- the text has already been added, so this buffer
1635 should be of non-zero length. */
1636 else if (TOTAL_LENGTH (tree
) == 0)
1639 this = under
= find_interval (tree
, position
);
1640 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1642 over
= find_interval (source
, interval_start_pos (source
));
1644 /* Here for insertion in the middle of an interval.
1645 Split off an equivalent interval to the right,
1646 then don't bother with it any more. */
1648 if (position
> under
->position
)
1650 INTERVAL end_unchanged
1651 = split_interval_left (this, position
- under
->position
);
1652 copy_properties (under
, end_unchanged
);
1653 under
->position
= position
;
1659 prev
= previous_interval (under
);
1660 if (prev
&& !END_NONSTICKY_P (prev
))
1664 /* Insertion is now at beginning of UNDER. */
1666 /* The inserted text "sticks" to the interval `under',
1667 which means it gets those properties.
1668 The properties of under are the result of
1669 adjust_intervals_for_insertion, so stickiness has
1670 already been taken care of. */
1672 while (! NULL_INTERVAL_P (over
))
1674 if (LENGTH (over
) < LENGTH (under
))
1676 this = split_interval_left (under
, LENGTH (over
));
1677 copy_properties (under
, this);
1681 copy_properties (over
, this);
1683 merge_properties (over
, this);
1685 copy_properties (over
, this);
1686 over
= next_interval (over
);
1689 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1690 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1694 /* Get the value of property PROP from PLIST,
1695 which is the plist of an interval.
1696 We check for direct properties, for categories with property PROP,
1697 and for PROP appearing on the default-text-properties list. */
1700 textget (plist
, prop
)
1702 register Lisp_Object prop
;
1704 register Lisp_Object tail
, fallback
;
1707 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1709 register Lisp_Object tem
;
1712 return Fcar (Fcdr (tail
));
1713 if (EQ (tem
, Qcategory
))
1715 tem
= Fcar (Fcdr (tail
));
1717 fallback
= Fget (tem
, prop
);
1721 if (! NILP (fallback
))
1723 if (CONSP (Vdefault_text_properties
))
1724 return Fplist_get (Vdefault_text_properties
, prop
);
1729 /* Set point "temporarily", without checking any text properties. */
1732 temp_set_point (buffer
, charpos
)
1733 struct buffer
*buffer
;
1736 temp_set_point_both (buffer
, charpos
,
1737 buf_charpos_to_bytepos (buffer
, charpos
));
1740 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1741 byte position BYTEPOS. */
1744 temp_set_point_both (buffer
, charpos
, bytepos
)
1745 int charpos
, bytepos
;
1746 struct buffer
*buffer
;
1748 /* In a single-byte buffer, the two positions must be equal. */
1749 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1750 && charpos
!= bytepos
)
1753 if (charpos
> bytepos
)
1756 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1759 BUF_PT_BYTE (buffer
) = bytepos
;
1760 BUF_PT (buffer
) = charpos
;
1763 /* Set point in BUFFER to CHARPOS. If the target position is
1764 before an intangible character, move to an ok place. */
1767 set_point (buffer
, charpos
)
1768 register struct buffer
*buffer
;
1769 register int charpos
;
1771 set_point_both (buffer
, charpos
, buf_charpos_to_bytepos (buffer
, charpos
));
1774 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1775 position BYTEPOS. If the target position is
1776 before an intangible character, move to an ok place. */
1779 set_point_both (buffer
, charpos
, bytepos
)
1780 register struct buffer
*buffer
;
1781 register int charpos
, bytepos
;
1783 register INTERVAL to
, from
, toprev
, fromprev
;
1785 int old_position
= BUF_PT (buffer
);
1786 int backwards
= (charpos
< old_position
? 1 : 0);
1788 int original_position
;
1790 buffer
->point_before_scroll
= Qnil
;
1792 if (charpos
== BUF_PT (buffer
))
1795 /* In a single-byte buffer, the two positions must be equal. */
1796 if (BUF_ZV (buffer
) == BUF_ZV_BYTE (buffer
)
1797 && charpos
!= bytepos
)
1800 /* Check this now, before checking if the buffer has any intervals.
1801 That way, we can catch conditions which break this sanity check
1802 whether or not there are intervals in the buffer. */
1803 if (charpos
> BUF_ZV (buffer
) || charpos
< BUF_BEGV (buffer
))
1806 have_overlays
= (! NILP (buffer
->overlays_before
)
1807 || ! NILP (buffer
->overlays_after
));
1809 /* If we have no text properties and overlays,
1810 then we can do it quickly. */
1811 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1813 temp_set_point_both (buffer
, charpos
, bytepos
);
1817 /* Set TO to the interval containing the char after CHARPOS,
1818 and TOPREV to the interval containing the char before CHARPOS.
1819 Either one may be null. They may be equal. */
1820 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1821 if (charpos
== BUF_BEGV (buffer
))
1823 else if (to
&& to
->position
== charpos
)
1824 toprev
= previous_interval (to
);
1828 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1829 ? BUF_ZV (buffer
) - 1
1832 /* Set FROM to the interval containing the char after PT,
1833 and FROMPREV to the interval containing the char before PT.
1834 Either one may be null. They may be equal. */
1835 /* We could cache this and save time. */
1836 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1837 if (buffer_point
== BUF_BEGV (buffer
))
1839 else if (from
&& from
->position
== BUF_PT (buffer
))
1840 fromprev
= previous_interval (from
);
1841 else if (buffer_point
!= BUF_PT (buffer
))
1842 fromprev
= from
, from
= 0;
1846 /* Moving within an interval. */
1847 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1850 temp_set_point_both (buffer
, charpos
, bytepos
);
1854 original_position
= charpos
;
1856 /* If the new position is between two intangible characters
1857 with the same intangible property value,
1858 move forward or backward until a change in that property. */
1859 if (NILP (Vinhibit_point_motion_hooks
)
1860 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1862 /* Intangibility never stops us from positioning at the beginning
1863 or end of the buffer, so don't bother checking in that case. */
1864 && charpos
!= BEGV
&& charpos
!= ZV
)
1866 Lisp_Object intangible_propval
;
1869 XSETINT (pos
, charpos
);
1873 intangible_propval
= Fget_char_property (make_number (charpos
),
1876 /* If following char is intangible,
1877 skip back over all chars with matching intangible property. */
1878 if (! NILP (intangible_propval
))
1879 while (XINT (pos
) > BUF_BEGV (buffer
)
1880 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1882 intangible_propval
))
1883 pos
= Fprevious_char_property_change (pos
, Qnil
);
1887 intangible_propval
= Fget_char_property (make_number (charpos
- 1),
1890 /* If following char is intangible,
1891 skip forward over all chars with matching intangible property. */
1892 if (! NILP (intangible_propval
))
1893 while (XINT (pos
) < BUF_ZV (buffer
)
1894 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1895 intangible_propval
))
1896 pos
= Fnext_char_property_change (pos
, Qnil
);
1900 charpos
= XINT (pos
);
1901 bytepos
= buf_charpos_to_bytepos (buffer
, charpos
);
1904 if (charpos
!= original_position
)
1906 /* Set TO to the interval containing the char after CHARPOS,
1907 and TOPREV to the interval containing the char before CHARPOS.
1908 Either one may be null. They may be equal. */
1909 to
= find_interval (BUF_INTERVALS (buffer
), charpos
);
1910 if (charpos
== BUF_BEGV (buffer
))
1912 else if (to
&& to
->position
== charpos
)
1913 toprev
= previous_interval (to
);
1918 /* Here TO is the interval after the stopping point
1919 and TOPREV is the interval before the stopping point.
1920 One or the other may be null. */
1922 temp_set_point_both (buffer
, charpos
, bytepos
);
1924 /* We run point-left and point-entered hooks here, iff the
1925 two intervals are not equivalent. These hooks take
1926 (old_point, new_point) as arguments. */
1927 if (NILP (Vinhibit_point_motion_hooks
)
1928 && (! intervals_equal (from
, to
)
1929 || ! intervals_equal (fromprev
, toprev
)))
1931 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1934 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1938 leave_before
= textget (from
->plist
, Qpoint_left
);
1940 leave_before
= Qnil
;
1943 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1947 enter_before
= textget (to
->plist
, Qpoint_entered
);
1949 enter_before
= Qnil
;
1951 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1952 call2 (leave_before
, make_number (old_position
),
1953 make_number (charpos
));
1954 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1955 call2 (leave_after
, make_number (old_position
),
1956 make_number (charpos
));
1958 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1959 call2 (enter_before
, make_number (old_position
),
1960 make_number (charpos
));
1961 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1962 call2 (enter_after
, make_number (old_position
),
1963 make_number (charpos
));
1967 /* Move point to POSITION, unless POSITION is inside an intangible
1968 segment that reaches all the way to point. */
1971 move_if_not_intangible (position
)
1975 Lisp_Object intangible_propval
;
1977 XSETINT (pos
, position
);
1979 if (! NILP (Vinhibit_point_motion_hooks
))
1980 /* If intangible is inhibited, always move point to POSITION. */
1982 else if (PT
< position
&& XINT (pos
) < ZV
)
1984 /* We want to move forward, so check the text before POSITION. */
1986 intangible_propval
= Fget_char_property (pos
,
1989 /* If following char is intangible,
1990 skip back over all chars with matching intangible property. */
1991 if (! NILP (intangible_propval
))
1992 while (XINT (pos
) > BEGV
1993 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1995 intangible_propval
))
1996 pos
= Fprevious_char_property_change (pos
, Qnil
);
1998 else if (XINT (pos
) > BEGV
)
2000 /* We want to move backward, so check the text after POSITION. */
2002 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
2005 /* If following char is intangible,
2006 skip forward over all chars with matching intangible property. */
2007 if (! NILP (intangible_propval
))
2008 while (XINT (pos
) < ZV
2009 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
2010 intangible_propval
))
2011 pos
= Fnext_char_property_change (pos
, Qnil
);
2015 /* If the whole stretch between PT and POSITION isn't intangible,
2016 try moving to POSITION (which means we actually move farther
2017 if POSITION is inside of intangible text). */
2019 if (XINT (pos
) != PT
)
2023 /* Return the proper local map for position POSITION in BUFFER.
2024 Use the map specified by the local-map property, if any.
2025 Otherwise, use BUFFER's local map. */
2028 get_local_map (position
, buffer
)
2029 register int position
;
2030 register struct buffer
*buffer
;
2032 Lisp_Object prop
, tem
, lispy_position
, lispy_buffer
;
2033 int old_begv
, old_zv
, old_begv_byte
, old_zv_byte
;
2035 /* Perhaps we should just change `position' to the limit. */
2036 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
2039 /* Ignore narrowing, so that a local map continues to be valid even if
2040 the visible region contains no characters and hence no properties. */
2041 old_begv
= BUF_BEGV (buffer
);
2042 old_zv
= BUF_ZV (buffer
);
2043 old_begv_byte
= BUF_BEGV_BYTE (buffer
);
2044 old_zv_byte
= BUF_ZV_BYTE (buffer
);
2045 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
2046 BUF_ZV (buffer
) = BUF_Z (buffer
);
2047 BUF_BEGV_BYTE (buffer
) = BUF_BEG_BYTE (buffer
);
2048 BUF_ZV_BYTE (buffer
) = BUF_Z_BYTE (buffer
);
2050 /* There are no properties at the end of the buffer, so in that case
2051 check for a local map on the last character of the buffer instead. */
2052 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
2054 XSETFASTINT (lispy_position
, position
);
2055 XSETBUFFER (lispy_buffer
, buffer
);
2056 prop
= Fget_char_property (lispy_position
, Qlocal_map
, lispy_buffer
);
2058 BUF_BEGV (buffer
) = old_begv
;
2059 BUF_ZV (buffer
) = old_zv
;
2060 BUF_BEGV_BYTE (buffer
) = old_begv_byte
;
2061 BUF_ZV_BYTE (buffer
) = old_zv_byte
;
2063 /* Use the local map only if it is valid. */
2064 /* Do allow symbols that are defined as keymaps. */
2065 if (SYMBOLP (prop
) && !NILP (prop
))
2066 prop
= indirect_function (prop
);
2068 && (tem
= Fkeymapp (prop
), !NILP (tem
)))
2071 return buffer
->keymap
;
2074 /* Produce an interval tree reflecting the intervals in
2075 TREE from START to START + LENGTH.
2076 The new interval tree has no parent and has a starting-position of 0. */
2079 copy_intervals (tree
, start
, length
)
2083 register INTERVAL i
, new, t
;
2084 register int got
, prevlen
;
2086 if (NULL_INTERVAL_P (tree
) || length
<= 0)
2087 return NULL_INTERVAL
;
2089 i
= find_interval (tree
, start
);
2090 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
2093 /* If there is only one interval and it's the default, return nil. */
2094 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
2095 && DEFAULT_INTERVAL_P (i
))
2096 return NULL_INTERVAL
;
2098 new = make_interval ();
2100 got
= (LENGTH (i
) - (start
- i
->position
));
2101 new->total_length
= length
;
2102 copy_properties (i
, new);
2106 while (got
< length
)
2108 i
= next_interval (i
);
2109 t
= split_interval_right (t
, prevlen
);
2110 copy_properties (i
, t
);
2111 prevlen
= LENGTH (i
);
2115 return balance_an_interval (new);
2118 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2121 copy_intervals_to_string (string
, buffer
, position
, length
)
2123 struct buffer
*buffer
;
2124 int position
, length
;
2126 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2128 if (NULL_INTERVAL_P (interval_copy
))
2131 interval_copy
->parent
= (INTERVAL
) XFASTINT (string
);
2132 XSTRING (string
)->intervals
= interval_copy
;
2135 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2136 Assume they have identical characters. */
2139 compare_string_intervals (s1
, s2
)
2144 int end
= XSTRING (s1
)->size
;
2146 i1
= find_interval (XSTRING (s1
)->intervals
, 0);
2147 i2
= find_interval (XSTRING (s2
)->intervals
, 0);
2151 /* Determine how far we can go before we reach the end of I1 or I2. */
2152 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2153 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2154 int distance
= min (len1
, len2
);
2156 /* If we ever find a mismatch between the strings,
2158 if (! intervals_equal (i1
, i2
))
2161 /* Advance POS till the end of the shorter interval,
2162 and advance one or both interval pointers for the new position. */
2164 if (len1
== distance
)
2165 i1
= next_interval (i1
);
2166 if (len2
== distance
)
2167 i2
= next_interval (i2
);
2172 /* Recursively adjust interval I in the current buffer
2173 for setting enable_multibyte_characters to MULTI_FLAG.
2174 The range of interval I is START ... END in characters,
2175 START_BYTE ... END_BYTE in bytes. */
2178 set_intervals_multibyte_1 (i
, multi_flag
, start
, start_byte
, end
, end_byte
)
2181 int start
, start_byte
, end
, end_byte
;
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 */