1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997 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;
82 else if (STRINGP (parent
))
84 new->total_length
= XSTRING (parent
)->size
;
85 XSTRING (parent
)->intervals
= new;
88 new->parent
= (INTERVAL
) XFASTINT (parent
);
94 /* Make the interval TARGET have exactly the properties of SOURCE */
97 copy_properties (source
, target
)
98 register INTERVAL source
, target
;
100 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
103 COPY_INTERVAL_CACHE (source
, target
);
104 target
->plist
= Fcopy_sequence (source
->plist
);
107 /* Merge the properties of interval SOURCE into the properties
108 of interval TARGET. That is to say, each property in SOURCE
109 is added to TARGET if TARGET has no such property as yet. */
112 merge_properties (source
, target
)
113 register INTERVAL source
, target
;
115 register Lisp_Object o
, sym
, val
;
117 if (DEFAULT_INTERVAL_P (source
) && DEFAULT_INTERVAL_P (target
))
120 MERGE_INTERVAL_CACHE (source
, target
);
123 while (! EQ (o
, Qnil
))
126 val
= Fmemq (sym
, target
->plist
);
132 target
->plist
= Fcons (sym
, Fcons (val
, target
->plist
));
140 /* Return 1 if the two intervals have the same properties,
144 intervals_equal (i0
, i1
)
147 register Lisp_Object i0_cdr
, i0_sym
, i1_val
;
150 if (DEFAULT_INTERVAL_P (i0
) && DEFAULT_INTERVAL_P (i1
))
153 if (DEFAULT_INTERVAL_P (i0
) || DEFAULT_INTERVAL_P (i1
))
156 i1_len
= XFASTINT (Flength (i1
->plist
));
157 if (i1_len
& 0x1) /* Paranoia -- plists are always even */
161 while (!NILP (i0_cdr
))
163 /* Lengths of the two plists were unequal. */
167 i0_sym
= Fcar (i0_cdr
);
168 i1_val
= Fmemq (i0_sym
, i1
->plist
);
170 /* i0 has something i1 doesn't. */
171 if (EQ (i1_val
, Qnil
))
174 /* i0 and i1 both have sym, but it has different values in each. */
175 i0_cdr
= Fcdr (i0_cdr
);
176 if (! EQ (Fcar (Fcdr (i1_val
)), Fcar (i0_cdr
)))
179 i0_cdr
= Fcdr (i0_cdr
);
183 /* Lengths of the two plists were unequal. */
192 static int zero_length
;
194 /* Traverse an interval tree TREE, performing FUNCTION on each node.
195 Pass FUNCTION two args: an interval, and ARG. */
198 traverse_intervals (tree
, position
, depth
, function
, arg
)
201 void (* function
) ();
204 if (NULL_INTERVAL_P (tree
))
207 traverse_intervals (tree
->left
, position
, depth
+ 1, function
, arg
);
208 position
+= LEFT_TOTAL_LENGTH (tree
);
209 tree
->position
= position
;
210 (*function
) (tree
, arg
);
211 position
+= LENGTH (tree
);
212 traverse_intervals (tree
->right
, position
, depth
+ 1, function
, arg
);
216 /* These functions are temporary, for debugging purposes only. */
218 INTERVAL search_interval
, found_interval
;
221 check_for_interval (i
)
224 if (i
== search_interval
)
232 search_for_interval (i
, tree
)
233 register INTERVAL i
, tree
;
237 found_interval
= NULL_INTERVAL
;
238 traverse_intervals (tree
, 1, 0, &check_for_interval
, Qnil
);
239 return found_interval
;
243 inc_interval_count (i
)
260 traverse_intervals (i
, 1, 0, &inc_interval_count
, Qnil
);
266 root_interval (interval
)
269 register INTERVAL i
= interval
;
271 while (! ROOT_INTERVAL_P (i
))
278 /* Assuming that a left child exists, perform the following operation:
288 rotate_right (interval
)
292 INTERVAL B
= interval
->left
;
293 int old_total
= interval
->total_length
;
295 /* Deal with any Parent of A; make it point to B. */
296 if (! ROOT_INTERVAL_P (interval
))
297 if (AM_LEFT_CHILD (interval
))
298 interval
->parent
->left
= B
;
300 interval
->parent
->right
= B
;
301 B
->parent
= interval
->parent
;
303 /* Make B the parent of A */
306 interval
->parent
= B
;
308 /* Make A point to c */
310 if (! NULL_INTERVAL_P (i
))
311 i
->parent
= interval
;
313 /* A's total length is decreased by the length of B and its left child. */
314 interval
->total_length
-= B
->total_length
- LEFT_TOTAL_LENGTH (interval
);
316 /* B must have the same total length of A. */
317 B
->total_length
= old_total
;
322 /* Assuming that a right child exists, perform the following operation:
332 rotate_left (interval
)
336 INTERVAL B
= interval
->right
;
337 int old_total
= interval
->total_length
;
339 /* Deal with any parent of A; make it point to B. */
340 if (! ROOT_INTERVAL_P (interval
))
341 if (AM_LEFT_CHILD (interval
))
342 interval
->parent
->left
= B
;
344 interval
->parent
->right
= B
;
345 B
->parent
= interval
->parent
;
347 /* Make B the parent of A */
350 interval
->parent
= B
;
352 /* Make A point to c */
354 if (! NULL_INTERVAL_P (i
))
355 i
->parent
= interval
;
357 /* A's total length is decreased by the length of B and its right child. */
358 interval
->total_length
-= B
->total_length
- RIGHT_TOTAL_LENGTH (interval
);
360 /* B must have the same total length of A. */
361 B
->total_length
= old_total
;
366 /* Balance an interval tree with the assumption that the subtrees
367 themselves are already balanced. */
370 balance_an_interval (i
)
373 register int old_diff
, new_diff
;
377 old_diff
= LEFT_TOTAL_LENGTH (i
) - RIGHT_TOTAL_LENGTH (i
);
380 new_diff
= i
->total_length
- i
->left
->total_length
381 + RIGHT_TOTAL_LENGTH (i
->left
) - LEFT_TOTAL_LENGTH (i
->left
);
382 if (abs (new_diff
) >= old_diff
)
384 i
= rotate_right (i
);
385 balance_an_interval (i
->right
);
387 else if (old_diff
< 0)
389 new_diff
= i
->total_length
- i
->right
->total_length
390 + LEFT_TOTAL_LENGTH (i
->right
) - RIGHT_TOTAL_LENGTH (i
->right
);
391 if (abs (new_diff
) >= -old_diff
)
394 balance_an_interval (i
->left
);
402 /* Balance INTERVAL, potentially stuffing it back into its parent
405 static INLINE INTERVAL
406 balance_possible_root_interval (interval
)
407 register INTERVAL interval
;
411 if (interval
->parent
== NULL_INTERVAL
)
414 XSETFASTINT (parent
, (EMACS_INT
) interval
->parent
);
415 interval
= balance_an_interval (interval
);
417 if (BUFFERP (parent
))
418 BUF_INTERVALS (XBUFFER (parent
)) = interval
;
419 else if (STRINGP (parent
))
420 XSTRING (parent
)->intervals
= interval
;
425 /* Balance the interval tree TREE. Balancing is by weight
426 (the amount of text). */
429 balance_intervals_internal (tree
)
430 register INTERVAL tree
;
432 /* Balance within each side. */
434 balance_intervals_internal (tree
->left
);
436 balance_intervals_internal (tree
->right
);
437 return balance_an_interval (tree
);
440 /* Advertised interface to balance intervals. */
443 balance_intervals (tree
)
446 if (tree
== NULL_INTERVAL
)
447 return NULL_INTERVAL
;
449 return balance_intervals_internal (tree
);
452 /* Split INTERVAL into two pieces, starting the second piece at
453 character position OFFSET (counting from 0), relative to INTERVAL.
454 INTERVAL becomes the left-hand piece, and the right-hand piece
455 (second, lexicographically) is returned.
457 The size and position fields of the two intervals are set based upon
458 those of the original interval. The property list of the new interval
459 is reset, thus it is up to the caller to do the right thing with the
462 Note that this does not change the position of INTERVAL; if it is a root,
463 it is still a root after this operation. */
466 split_interval_right (interval
, offset
)
470 INTERVAL
new = make_interval ();
471 int position
= interval
->position
;
472 int new_length
= LENGTH (interval
) - offset
;
474 new->position
= position
+ offset
;
475 new->parent
= interval
;
477 if (NULL_RIGHT_CHILD (interval
))
479 interval
->right
= new;
480 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
;
491 balance_an_interval (new);
492 balance_possible_root_interval (interval
);
497 /* Split INTERVAL into two pieces, starting the second piece at
498 character position OFFSET (counting from 0), relative to INTERVAL.
499 INTERVAL becomes the right-hand piece, and the left-hand piece
500 (first, lexicographically) is returned.
502 The size and position fields of the two intervals are set based upon
503 those of the original interval. The property list of the new interval
504 is reset, thus it is up to the caller to do the right thing with the
507 Note that this does not change the position of INTERVAL; if it is a root,
508 it is still a root after this operation. */
511 split_interval_left (interval
, offset
)
515 INTERVAL
new = make_interval ();
516 int position
= interval
->position
;
517 int new_length
= offset
;
519 new->position
= interval
->position
;
520 interval
->position
= interval
->position
+ offset
;
521 new->parent
= interval
;
523 if (NULL_LEFT_CHILD (interval
))
525 interval
->left
= new;
526 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
;
537 balance_an_interval (new);
538 balance_possible_root_interval (interval
);
543 /* Find the interval containing text position POSITION in the text
544 represented by the interval tree TREE. POSITION is a buffer
545 position; the earliest position is 1. If POSITION is at the end of
546 the buffer, return the interval containing the last character.
548 The `position' field, which is a cache of an interval's position,
549 is updated in the interval found. Other functions (e.g., next_interval)
550 will update this cache based on the result of find_interval. */
553 find_interval (tree
, position
)
554 register INTERVAL tree
;
555 register int position
;
557 /* The distance from the left edge of the subtree at TREE
559 register int relative_position
= position
- BEG
;
561 if (NULL_INTERVAL_P (tree
))
562 return NULL_INTERVAL
;
564 if (relative_position
> TOTAL_LENGTH (tree
))
565 abort (); /* Paranoia */
567 tree
= balance_possible_root_interval (tree
);
571 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
575 else if (! NULL_RIGHT_CHILD (tree
)
576 && relative_position
>= (TOTAL_LENGTH (tree
)
577 - RIGHT_TOTAL_LENGTH (tree
)))
579 relative_position
-= (TOTAL_LENGTH (tree
)
580 - RIGHT_TOTAL_LENGTH (tree
));
586 (position
- relative_position
/* the left edge of *tree */
587 + LEFT_TOTAL_LENGTH (tree
)); /* the left edge of this interval */
594 /* Find the succeeding interval (lexicographically) to INTERVAL.
595 Sets the `position' field based on that of INTERVAL (see
599 next_interval (interval
)
600 register INTERVAL interval
;
602 register INTERVAL i
= interval
;
603 register int next_position
;
605 if (NULL_INTERVAL_P (i
))
606 return NULL_INTERVAL
;
607 next_position
= interval
->position
+ LENGTH (interval
);
609 if (! NULL_RIGHT_CHILD (i
))
612 while (! NULL_LEFT_CHILD (i
))
615 i
->position
= next_position
;
619 while (! NULL_PARENT (i
))
621 if (AM_LEFT_CHILD (i
))
624 i
->position
= next_position
;
631 return NULL_INTERVAL
;
634 /* Find the preceding interval (lexicographically) to INTERVAL.
635 Sets the `position' field based on that of INTERVAL (see
639 previous_interval (interval
)
640 register INTERVAL interval
;
643 register position_of_previous
;
645 if (NULL_INTERVAL_P (interval
))
646 return NULL_INTERVAL
;
648 if (! NULL_LEFT_CHILD (interval
))
651 while (! NULL_RIGHT_CHILD (i
))
654 i
->position
= interval
->position
- LENGTH (i
);
659 while (! NULL_PARENT (i
))
661 if (AM_RIGHT_CHILD (i
))
665 i
->position
= interval
->position
- LENGTH (i
);
671 return NULL_INTERVAL
;
674 /* Find the interval containing POS given some non-NULL INTERVAL
677 update_interval (i
, pos
)
681 if (NULL_INTERVAL_P (i
))
682 return NULL_INTERVAL
;
686 if (pos
< i
->position
)
689 if (pos
>= i
->position
- TOTAL_LENGTH (i
->left
))
690 i
= i
->left
; /* Move to the left child */
691 else if (NULL_PARENT (i
))
692 error ("Point before start of properties");
696 else if (pos
>= INTERVAL_LAST_POS (i
))
699 if (pos
< INTERVAL_LAST_POS (i
) + TOTAL_LENGTH (i
->right
))
700 i
= i
->right
; /* Move to the right child */
701 else if (NULL_PARENT (i
))
702 error ("Point after end of properties");
714 /* Traverse a path down the interval tree TREE to the interval
715 containing POSITION, adjusting all nodes on the path for
716 an addition of LENGTH characters. Insertion between two intervals
717 (i.e., point == i->position, where i is second interval) means
718 text goes into second interval.
720 Modifications are needed to handle the hungry bits -- after simply
721 finding the interval at position (don't add length going down),
722 if it's the beginning of the interval, get the previous interval
723 and check the hungry bits of both. Then add the length going back up
727 adjust_intervals_for_insertion (tree
, position
, length
)
729 int position
, length
;
731 register int relative_position
;
732 register INTERVAL
this;
734 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
737 /* If inserting at point-max of a buffer, that position
738 will be out of range */
739 if (position
> TOTAL_LENGTH (tree
))
740 position
= TOTAL_LENGTH (tree
);
741 relative_position
= position
;
746 if (relative_position
<= LEFT_TOTAL_LENGTH (this))
748 this->total_length
+= length
;
751 else if (relative_position
> (TOTAL_LENGTH (this)
752 - RIGHT_TOTAL_LENGTH (this)))
754 relative_position
-= (TOTAL_LENGTH (this)
755 - RIGHT_TOTAL_LENGTH (this));
756 this->total_length
+= length
;
761 /* If we are to use zero-length intervals as buffer pointers,
762 then this code will have to change. */
763 this->total_length
+= length
;
764 this->position
= LEFT_TOTAL_LENGTH (this)
765 + position
- relative_position
+ 1;
772 /* Effect an adjustment corresponding to the addition of LENGTH characters
773 of text. Do this by finding the interval containing POSITION in the
774 interval tree TREE, and then adjusting all of its ancestors by adding
777 If POSITION is the first character of an interval, meaning that point
778 is actually between the two intervals, make the new text belong to
779 the interval which is "sticky".
781 If both intervals are "sticky", then make them belong to the left-most
782 interval. Another possibility would be to create a new interval for
783 this text, and make it have the merged properties of both ends. */
786 adjust_intervals_for_insertion (tree
, position
, length
)
788 int position
, length
;
791 register INTERVAL temp
;
794 if (TOTAL_LENGTH (tree
) == 0) /* Paranoia */
797 /* If inserting at point-max of a buffer, that position will be out
798 of range. Remember that buffer positions are 1-based. */
799 if (position
>= BEG
+ TOTAL_LENGTH (tree
)){
800 position
= BEG
+ TOTAL_LENGTH (tree
);
804 i
= find_interval (tree
, position
);
806 /* If in middle of an interval which is not sticky either way,
807 we must not just give its properties to the insertion.
808 So split this interval at the insertion point. */
809 if (! (position
== i
->position
|| eobp
)
810 && END_NONSTICKY_P (i
)
811 && FRONT_NONSTICKY_P (i
))
814 Lisp_Object front
, rear
;
816 front
= textget (i
->plist
, Qfront_sticky
);
817 rear
= textget (i
->plist
, Qrear_nonsticky
);
819 /* Does any actual property pose an actual problem? */
820 for (tail
= i
->plist
; ! NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
823 prop
= XCONS (tail
)->car
;
825 /* Is this particular property rear-sticky?
826 Note, if REAR isn't a cons, it must be non-nil,
827 which means that all properties are rear-nonsticky. */
828 if (CONSP (rear
) && NILP (Fmemq (prop
, rear
)))
831 /* Is this particular property front-sticky?
832 Note, if FRONT isn't a cons, it must be nil,
833 which means that all properties are front-nonsticky. */
834 if (CONSP (front
) && ! NILP (Fmemq (prop
, front
)))
837 /* PROP isn't sticky on either side => it is a real problem. */
841 /* If any property is a real problem, split the interval. */
844 temp
= split_interval_right (i
, position
- i
->position
);
845 copy_properties (i
, temp
);
850 /* If we are positioned between intervals, check the stickiness of
851 both of them. We have to do this too, if we are at BEG or Z. */
852 if (position
== i
->position
|| eobp
)
854 register INTERVAL prev
;
864 prev
= previous_interval (i
);
866 /* Even if we are positioned between intervals, we default
867 to the left one if it exists. We extend it now and split
868 off a part later, if stickiness demands it. */
869 for (temp
= prev
? prev
: i
;! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
871 temp
->total_length
+= length
;
872 temp
= balance_possible_root_interval (temp
);
875 /* If at least one interval has sticky properties,
876 we check the stickiness property by property. */
877 if (END_NONSTICKY_P (prev
) || FRONT_STICKY_P (i
))
879 Lisp_Object pleft
, pright
;
880 struct interval newi
;
882 pleft
= NULL_INTERVAL_P (prev
) ? Qnil
: prev
->plist
;
883 pright
= NULL_INTERVAL_P (i
) ? Qnil
: i
->plist
;
884 newi
.plist
= merge_properties_sticky (pleft
, pright
);
886 if(! prev
) /* i.e. position == BEG */
888 if (! intervals_equal (i
, &newi
))
890 i
= split_interval_left (i
, length
);
891 i
->plist
= newi
.plist
;
894 else if (! intervals_equal (prev
, &newi
))
896 prev
= split_interval_right (prev
,
897 position
- prev
->position
);
898 prev
->plist
= newi
.plist
;
899 if (! NULL_INTERVAL_P (i
)
900 && intervals_equal (prev
, i
))
901 merge_interval_right (prev
);
904 /* We will need to update the cache here later. */
906 else if (! prev
&& ! NILP (i
->plist
))
908 /* Just split off a new interval at the left.
909 Since I wasn't front-sticky, the empty plist is ok. */
910 i
= split_interval_left (i
, length
);
914 /* Otherwise just extend the interval. */
917 for (temp
= i
; ! NULL_INTERVAL_P (temp
); temp
= temp
->parent
)
919 temp
->total_length
+= length
;
920 temp
= balance_possible_root_interval (temp
);
927 /* Any property might be front-sticky on the left, rear-sticky on the left,
928 front-sticky on the right, or rear-sticky on the right; the 16 combinations
929 can be arranged in a matrix with rows denoting the left conditions and
930 columns denoting the right conditions:
938 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
939 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
940 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
941 p8 L p9 L pa L pb L pc L pd L pe L pf L)
942 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
943 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
944 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
945 p8 R p9 R pa R pb R pc R pd R pe R pf R)
947 We inherit from whoever has a sticky side facing us. If both sides
948 do (cases 2, 3, E, and F), then we inherit from whichever side has a
949 non-nil value for the current property. If both sides do, then we take
952 When we inherit a property, we get its stickiness as well as its value.
953 So, when we merge the above two lists, we expect to get this:
955 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
956 rear-nonsticky (p6 pa)
957 p0 L p1 L p2 L p3 L p6 R p7 R
958 pa R pb R pc L pd L pe L pf L)
960 The optimizable special cases are:
961 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
962 left rear-nonsticky = t, right front-sticky = t (inherit right)
963 left rear-nonsticky = t, right front-sticky = nil (inherit none)
967 merge_properties_sticky (pleft
, pright
)
968 Lisp_Object pleft
, pright
;
970 register Lisp_Object props
, front
, rear
;
971 Lisp_Object lfront
, lrear
, rfront
, rrear
;
972 register Lisp_Object tail1
, tail2
, sym
, lval
, rval
, cat
;
973 int use_left
, use_right
;
979 lfront
= textget (pleft
, Qfront_sticky
);
980 lrear
= textget (pleft
, Qrear_nonsticky
);
981 rfront
= textget (pright
, Qfront_sticky
);
982 rrear
= textget (pright
, Qrear_nonsticky
);
984 /* Go through each element of PRIGHT. */
985 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
989 /* Sticky properties get special treatment. */
990 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
993 rval
= Fcar (Fcdr (tail1
));
994 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
995 if (EQ (sym
, Fcar (tail2
)))
998 /* Indicate whether the property is explicitly defined on the left.
999 (We know it is defined explicitly on the right
1000 because otherwise we don't get here.) */
1001 lpresent
= ! NILP (tail2
);
1002 lval
= (NILP (tail2
) ? Qnil
: Fcar (Fcdr (tail2
)));
1004 use_left
= ! TMEM (sym
, lrear
) && lpresent
;
1005 use_right
= TMEM (sym
, rfront
);
1006 if (use_left
&& use_right
)
1010 else if (NILP (rval
))
1015 /* We build props as (value sym ...) rather than (sym value ...)
1016 because we plan to nreverse it when we're done. */
1017 props
= Fcons (lval
, Fcons (sym
, props
));
1018 if (TMEM (sym
, lfront
))
1019 front
= Fcons (sym
, front
);
1020 if (TMEM (sym
, lrear
))
1021 rear
= Fcons (sym
, rear
);
1025 props
= Fcons (rval
, Fcons (sym
, props
));
1026 if (TMEM (sym
, rfront
))
1027 front
= Fcons (sym
, front
);
1028 if (TMEM (sym
, rrear
))
1029 rear
= Fcons (sym
, rear
);
1033 /* Now go through each element of PLEFT. */
1034 for (tail2
= pleft
; ! NILP (tail2
); tail2
= Fcdr (Fcdr (tail2
)))
1038 /* Sticky properties get special treatment. */
1039 if (EQ (sym
, Qrear_nonsticky
) || EQ (sym
, Qfront_sticky
))
1042 /* If sym is in PRIGHT, we've already considered it. */
1043 for (tail1
= pright
; ! NILP (tail1
); tail1
= Fcdr (Fcdr (tail1
)))
1044 if (EQ (sym
, Fcar (tail1
)))
1049 lval
= Fcar (Fcdr (tail2
));
1051 /* Since rval is known to be nil in this loop, the test simplifies. */
1052 if (! TMEM (sym
, lrear
))
1054 props
= Fcons (lval
, Fcons (sym
, props
));
1055 if (TMEM (sym
, lfront
))
1056 front
= Fcons (sym
, front
);
1058 else if (TMEM (sym
, rfront
))
1060 /* The value is nil, but we still inherit the stickiness
1062 front
= Fcons (sym
, front
);
1063 if (TMEM (sym
, rrear
))
1064 rear
= Fcons (sym
, rear
);
1067 props
= Fnreverse (props
);
1069 props
= Fcons (Qrear_nonsticky
, Fcons (Fnreverse (rear
), props
));
1071 cat
= textget (props
, Qcategory
);
1074 /* If we have inherited a front-stick category property that is t,
1075 we don't need to set up a detailed one. */
1076 ! (! NILP (cat
) && SYMBOLP (cat
)
1077 && EQ (Fget (cat
, Qfront_sticky
), Qt
)))
1078 props
= Fcons (Qfront_sticky
, Fcons (Fnreverse (front
), props
));
1083 /* Delete an node I from its interval tree by merging its subtrees
1084 into one subtree which is then returned. Caller is responsible for
1085 storing the resulting subtree into its parent. */
1089 register INTERVAL i
;
1091 register INTERVAL migrate
, this;
1092 register int migrate_amt
;
1094 if (NULL_INTERVAL_P (i
->left
))
1096 if (NULL_INTERVAL_P (i
->right
))
1100 migrate_amt
= i
->left
->total_length
;
1102 this->total_length
+= migrate_amt
;
1103 while (! NULL_INTERVAL_P (this->left
))
1106 this->total_length
+= migrate_amt
;
1108 this->left
= migrate
;
1109 migrate
->parent
= this;
1114 /* Delete interval I from its tree by calling `delete_node'
1115 and properly connecting the resultant subtree.
1117 I is presumed to be empty; that is, no adjustments are made
1118 for the length of I. */
1122 register INTERVAL i
;
1124 register INTERVAL parent
;
1125 int amt
= LENGTH (i
);
1127 if (amt
> 0) /* Only used on zero-length intervals now. */
1130 if (ROOT_INTERVAL_P (i
))
1133 XSETFASTINT (owner
, (EMACS_INT
) i
->parent
);
1134 parent
= delete_node (i
);
1135 if (! NULL_INTERVAL_P (parent
))
1136 parent
->parent
= (INTERVAL
) XFASTINT (owner
);
1138 if (BUFFERP (owner
))
1139 BUF_INTERVALS (XBUFFER (owner
)) = parent
;
1140 else if (STRINGP (owner
))
1141 XSTRING (owner
)->intervals
= parent
;
1149 if (AM_LEFT_CHILD (i
))
1151 parent
->left
= delete_node (i
);
1152 if (! NULL_INTERVAL_P (parent
->left
))
1153 parent
->left
->parent
= parent
;
1157 parent
->right
= delete_node (i
);
1158 if (! NULL_INTERVAL_P (parent
->right
))
1159 parent
->right
->parent
= parent
;
1163 /* Find the interval in TREE corresponding to the relative position
1164 FROM and delete as much as possible of AMOUNT from that interval.
1165 Return the amount actually deleted, and if the interval was
1166 zeroed-out, delete that interval node from the tree.
1168 Note that FROM is actually origin zero, aka relative to the
1169 leftmost edge of tree. This is appropriate since we call ourselves
1170 recursively on subtrees.
1172 Do this by recursing down TREE to the interval in question, and
1173 deleting the appropriate amount of text. */
1176 interval_deletion_adjustment (tree
, from
, amount
)
1177 register INTERVAL tree
;
1178 register int from
, amount
;
1180 register int relative_position
= from
;
1182 if (NULL_INTERVAL_P (tree
))
1186 if (relative_position
< LEFT_TOTAL_LENGTH (tree
))
1188 int subtract
= interval_deletion_adjustment (tree
->left
,
1191 tree
->total_length
-= subtract
;
1195 else if (relative_position
>= (TOTAL_LENGTH (tree
)
1196 - RIGHT_TOTAL_LENGTH (tree
)))
1200 relative_position
-= (tree
->total_length
1201 - RIGHT_TOTAL_LENGTH (tree
));
1202 subtract
= interval_deletion_adjustment (tree
->right
,
1205 tree
->total_length
-= subtract
;
1208 /* Here -- this node. */
1211 /* How much can we delete from this interval? */
1212 int my_amount
= ((tree
->total_length
1213 - RIGHT_TOTAL_LENGTH (tree
))
1214 - relative_position
);
1216 if (amount
> my_amount
)
1219 tree
->total_length
-= amount
;
1220 if (LENGTH (tree
) == 0)
1221 delete_interval (tree
);
1226 /* Never reach here. */
1229 /* Effect the adjustments necessary to the interval tree of BUFFER to
1230 correspond to the deletion of LENGTH characters from that buffer
1231 text. The deletion is effected at position START (which is a
1232 buffer position, i.e. origin 1). */
1235 adjust_intervals_for_deletion (buffer
, start
, length
)
1236 struct buffer
*buffer
;
1239 register int left_to_delete
= length
;
1240 register INTERVAL tree
= BUF_INTERVALS (buffer
);
1241 register int deleted
;
1243 if (NULL_INTERVAL_P (tree
))
1246 if (start
> BEG
+ TOTAL_LENGTH (tree
)
1247 || start
+ length
> BEG
+ TOTAL_LENGTH (tree
))
1250 if (length
== TOTAL_LENGTH (tree
))
1252 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1256 if (ONLY_INTERVAL_P (tree
))
1258 tree
->total_length
-= length
;
1262 if (start
> BEG
+ TOTAL_LENGTH (tree
))
1263 start
= BEG
+ TOTAL_LENGTH (tree
);
1264 while (left_to_delete
> 0)
1266 left_to_delete
-= interval_deletion_adjustment (tree
, start
- 1,
1268 tree
= BUF_INTERVALS (buffer
);
1269 if (left_to_delete
== tree
->total_length
)
1271 BUF_INTERVALS (buffer
) = NULL_INTERVAL
;
1277 /* Make the adjustments necessary to the interval tree of BUFFER to
1278 represent an addition or deletion of LENGTH characters starting
1279 at position START. Addition or deletion is indicated by the sign
1283 offset_intervals (buffer
, start
, length
)
1284 struct buffer
*buffer
;
1287 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) || length
== 0)
1291 adjust_intervals_for_insertion (BUF_INTERVALS (buffer
), start
, length
);
1293 adjust_intervals_for_deletion (buffer
, start
, -length
);
1296 /* Merge interval I with its lexicographic successor. The resulting
1297 interval is returned, and has the properties of the original
1298 successor. The properties of I are lost. I is removed from the
1302 The caller must verify that this is not the last (rightmost)
1306 merge_interval_right (i
)
1307 register INTERVAL i
;
1309 register int absorb
= LENGTH (i
);
1310 register INTERVAL successor
;
1312 /* Zero out this interval. */
1313 i
->total_length
-= absorb
;
1315 /* Find the succeeding interval. */
1316 if (! NULL_RIGHT_CHILD (i
)) /* It's below us. Add absorb
1319 successor
= i
->right
;
1320 while (! NULL_LEFT_CHILD (successor
))
1322 successor
->total_length
+= absorb
;
1323 successor
= successor
->left
;
1326 successor
->total_length
+= absorb
;
1327 delete_interval (i
);
1332 while (! NULL_PARENT (successor
)) /* It's above us. Subtract as
1335 if (AM_LEFT_CHILD (successor
))
1337 successor
= successor
->parent
;
1338 delete_interval (i
);
1342 successor
= successor
->parent
;
1343 successor
->total_length
-= absorb
;
1346 /* This must be the rightmost or last interval and cannot
1347 be merged right. The caller should have known. */
1351 /* Merge interval I with its lexicographic predecessor. The resulting
1352 interval is returned, and has the properties of the original predecessor.
1353 The properties of I are lost. Interval node I is removed from the tree.
1356 The caller must verify that this is not the first (leftmost) interval. */
1359 merge_interval_left (i
)
1360 register INTERVAL i
;
1362 register int absorb
= LENGTH (i
);
1363 register INTERVAL predecessor
;
1365 /* Zero out this interval. */
1366 i
->total_length
-= absorb
;
1368 /* Find the preceding interval. */
1369 if (! NULL_LEFT_CHILD (i
)) /* It's below us. Go down,
1370 adding ABSORB as we go. */
1372 predecessor
= i
->left
;
1373 while (! NULL_RIGHT_CHILD (predecessor
))
1375 predecessor
->total_length
+= absorb
;
1376 predecessor
= predecessor
->right
;
1379 predecessor
->total_length
+= absorb
;
1380 delete_interval (i
);
1385 while (! NULL_PARENT (predecessor
)) /* It's above us. Go up,
1386 subtracting ABSORB. */
1388 if (AM_RIGHT_CHILD (predecessor
))
1390 predecessor
= predecessor
->parent
;
1391 delete_interval (i
);
1395 predecessor
= predecessor
->parent
;
1396 predecessor
->total_length
-= absorb
;
1399 /* This must be the leftmost or first interval and cannot
1400 be merged left. The caller should have known. */
1404 /* Make an exact copy of interval tree SOURCE which descends from
1405 PARENT. This is done by recursing through SOURCE, copying
1406 the current interval and its properties, and then adjusting
1407 the pointers of the copy. */
1410 reproduce_tree (source
, parent
)
1411 INTERVAL source
, parent
;
1413 register INTERVAL t
= make_interval ();
1415 bcopy (source
, t
, INTERVAL_SIZE
);
1416 copy_properties (source
, t
);
1418 if (! NULL_LEFT_CHILD (source
))
1419 t
->left
= reproduce_tree (source
->left
, t
);
1420 if (! NULL_RIGHT_CHILD (source
))
1421 t
->right
= reproduce_tree (source
->right
, t
);
1427 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1429 /* Make a new interval of length LENGTH starting at START in the
1430 group of intervals INTERVALS, which is actually an interval tree.
1431 Returns the new interval.
1433 Generate an error if the new positions would overlap an existing
1437 make_new_interval (intervals
, start
, length
)
1443 slot
= find_interval (intervals
, start
);
1444 if (start
+ length
> slot
->position
+ LENGTH (slot
))
1445 error ("Interval would overlap");
1447 if (start
== slot
->position
&& length
== LENGTH (slot
))
1450 if (slot
->position
== start
)
1452 /* New right node. */
1453 split_interval_right (slot
, length
);
1457 if (slot
->position
+ LENGTH (slot
) == start
+ length
)
1459 /* New left node. */
1460 split_interval_left (slot
, LENGTH (slot
) - length
);
1464 /* Convert interval SLOT into three intervals. */
1465 split_interval_left (slot
, start
- slot
->position
);
1466 split_interval_right (slot
, length
);
1471 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1472 LENGTH is the length of the text in SOURCE.
1474 This is used in insdel.c when inserting Lisp_Strings into the
1475 buffer. The text corresponding to SOURCE is already in the buffer
1476 when this is called. The intervals of new tree are a copy of those
1477 belonging to the string being inserted; intervals are never
1480 If the inserted text had no intervals associated, and we don't
1481 want to inherit the surrounding text's properties, this function
1482 simply returns -- offset_intervals should handle placing the
1483 text in the correct interval, depending on the sticky bits.
1485 If the inserted text had properties (intervals), then there are two
1486 cases -- either insertion happened in the middle of some interval,
1487 or between two intervals.
1489 If the text goes into the middle of an interval, then new
1490 intervals are created in the middle with only the properties of
1491 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1492 which case the new text has the union of its properties and those
1493 of the text into which it was inserted.
1495 If the text goes between two intervals, then if neither interval
1496 had its appropriate sticky property set (front_sticky, rear_sticky),
1497 the new text has only its properties. If one of the sticky properties
1498 is set, then the new text "sticks" to that region and its properties
1499 depend on merging as above. If both the preceding and succeeding
1500 intervals to the new text are "sticky", then the new text retains
1501 only its properties, as if neither sticky property were set. Perhaps
1502 we should consider merging all three sets of properties onto the new
1506 graft_intervals_into_buffer (source
, position
, length
, buffer
, inherit
)
1508 int position
, length
;
1509 struct buffer
*buffer
;
1512 register INTERVAL under
, over
, this, prev
;
1513 register INTERVAL tree
;
1516 tree
= BUF_INTERVALS (buffer
);
1518 /* If the new text has no properties, it becomes part of whatever
1519 interval it was inserted into. */
1520 if (NULL_INTERVAL_P (source
))
1523 if (!inherit
&& ! NULL_INTERVAL_P (tree
))
1525 XSETBUFFER (buf
, buffer
);
1526 Fset_text_properties (make_number (position
),
1527 make_number (position
+ length
),
1530 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1531 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1535 if (NULL_INTERVAL_P (tree
))
1537 /* The inserted text constitutes the whole buffer, so
1538 simply copy over the interval structure. */
1539 if ((BUF_Z (buffer
) - BUF_BEG (buffer
)) == TOTAL_LENGTH (source
))
1542 XSETBUFFER (buf
, buffer
);
1543 BUF_INTERVALS (buffer
) = reproduce_tree (source
, buf
);
1544 /* Explicitly free the old tree here. */
1549 /* Create an interval tree in which to place a copy
1550 of the intervals of the inserted string. */
1553 XSETBUFFER (buf
, buffer
);
1554 tree
= create_root_interval (buf
);
1557 else if (TOTAL_LENGTH (tree
) == TOTAL_LENGTH (source
))
1558 /* If the buffer contains only the new string, but
1559 there was already some interval tree there, then it may be
1560 some zero length intervals. Eventually, do something clever
1561 about inserting properly. For now, just waste the old intervals. */
1563 BUF_INTERVALS (buffer
) = reproduce_tree (source
, tree
->parent
);
1564 /* Explicitly free the old tree here. */
1568 /* Paranoia -- the text has already been added, so this buffer
1569 should be of non-zero length. */
1570 else if (TOTAL_LENGTH (tree
) == 0)
1573 this = under
= find_interval (tree
, position
);
1574 if (NULL_INTERVAL_P (under
)) /* Paranoia */
1576 over
= find_interval (source
, 1);
1578 /* Here for insertion in the middle of an interval.
1579 Split off an equivalent interval to the right,
1580 then don't bother with it any more. */
1582 if (position
> under
->position
)
1584 INTERVAL end_unchanged
1585 = split_interval_left (this, position
- under
->position
);
1586 copy_properties (under
, end_unchanged
);
1587 under
->position
= position
;
1593 prev
= previous_interval (under
);
1594 if (prev
&& !END_NONSTICKY_P (prev
))
1598 /* Insertion is now at beginning of UNDER. */
1600 /* The inserted text "sticks" to the interval `under',
1601 which means it gets those properties.
1602 The properties of under are the result of
1603 adjust_intervals_for_insertion, so stickiness has
1604 already been taken care of. */
1606 while (! NULL_INTERVAL_P (over
))
1608 if (LENGTH (over
) < LENGTH (under
))
1610 this = split_interval_left (under
, LENGTH (over
));
1611 copy_properties (under
, this);
1615 copy_properties (over
, this);
1617 merge_properties (over
, this);
1619 copy_properties (over
, this);
1620 over
= next_interval (over
);
1623 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer
)))
1624 BUF_INTERVALS (buffer
) = balance_an_interval (BUF_INTERVALS (buffer
));
1628 /* Get the value of property PROP from PLIST,
1629 which is the plist of an interval.
1630 We check for direct properties, for categories with property PROP,
1631 and for PROP appearing on the default-text-properties list. */
1634 textget (plist
, prop
)
1636 register Lisp_Object prop
;
1638 register Lisp_Object tail
, fallback
;
1641 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (Fcdr (tail
)))
1643 register Lisp_Object tem
;
1646 return Fcar (Fcdr (tail
));
1647 if (EQ (tem
, Qcategory
))
1649 tem
= Fcar (Fcdr (tail
));
1651 fallback
= Fget (tem
, prop
);
1655 if (! NILP (fallback
))
1657 if (CONSP (Vdefault_text_properties
))
1658 return Fplist_get (Vdefault_text_properties
, prop
);
1663 /* Set point in BUFFER to POSITION. If the target position is
1664 before an intangible character, move to an ok place. */
1667 set_point (position
, buffer
)
1668 register int position
;
1669 register struct buffer
*buffer
;
1671 register INTERVAL to
, from
, toprev
, fromprev
, target
;
1673 register Lisp_Object obj
;
1674 int old_position
= BUF_PT (buffer
);
1675 int backwards
= (position
< old_position
? 1 : 0);
1677 int original_position
;
1679 buffer
->point_before_scroll
= Qnil
;
1681 if (position
== BUF_PT (buffer
))
1684 /* Check this now, before checking if the buffer has any intervals.
1685 That way, we can catch conditions which break this sanity check
1686 whether or not there are intervals in the buffer. */
1687 if (position
> BUF_ZV (buffer
) || position
< BUF_BEGV (buffer
))
1690 have_overlays
= (! NILP (buffer
->overlays_before
)
1691 || ! NILP (buffer
->overlays_after
));
1693 /* If we have no text properties and overlays,
1694 then we can do it quickly. */
1695 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer
)) && ! have_overlays
)
1697 BUF_PT (buffer
) = position
;
1701 /* Set TO to the interval containing the char after POSITION,
1702 and TOPREV to the interval containing the char before POSITION.
1703 Either one may be null. They may be equal. */
1704 to
= find_interval (BUF_INTERVALS (buffer
), position
);
1705 if (position
== BUF_BEGV (buffer
))
1707 else if (to
&& to
->position
== position
)
1708 toprev
= previous_interval (to
);
1712 buffer_point
= (BUF_PT (buffer
) == BUF_ZV (buffer
)
1713 ? BUF_ZV (buffer
) - 1
1716 /* Set FROM to the interval containing the char after PT,
1717 and FROMPREV to the interval containing the char before PT.
1718 Either one may be null. They may be equal. */
1719 /* We could cache this and save time. */
1720 from
= find_interval (BUF_INTERVALS (buffer
), buffer_point
);
1721 if (buffer_point
== BUF_BEGV (buffer
))
1723 else if (from
&& from
->position
== BUF_PT (buffer
))
1724 fromprev
= previous_interval (from
);
1725 else if (buffer_point
!= BUF_PT (buffer
))
1726 fromprev
= from
, from
= 0;
1730 /* Moving within an interval. */
1731 if (to
== from
&& toprev
== fromprev
&& INTERVAL_VISIBLE_P (to
)
1734 BUF_PT (buffer
) = position
;
1738 original_position
= position
;
1740 /* If the new position is between two intangible characters
1741 with the same intangible property value,
1742 move forward or backward until a change in that property. */
1743 if (NILP (Vinhibit_point_motion_hooks
)
1744 && ((! NULL_INTERVAL_P (to
) && ! NULL_INTERVAL_P (toprev
))
1746 /* Intangibility never stops us from positioning at the beginning
1747 or end of the buffer, so don't bother checking in that case. */
1748 && position
!= BEGV
&& position
!= ZV
)
1750 Lisp_Object intangible_propval
;
1753 XSETINT (pos
, position
);
1757 intangible_propval
= Fget_char_property (make_number (position
),
1760 /* If following char is intangible,
1761 skip back over all chars with matching intangible property. */
1762 if (! NILP (intangible_propval
))
1763 while (XINT (pos
) > BUF_BEGV (buffer
)
1764 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1766 intangible_propval
))
1767 pos
= Fprevious_char_property_change (pos
, Qnil
);
1771 intangible_propval
= Fget_char_property (make_number (position
- 1),
1774 /* If following char is intangible,
1775 skip back over all chars with matching intangible property. */
1776 if (! NILP (intangible_propval
))
1777 while (XINT (pos
) < BUF_ZV (buffer
)
1778 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1779 intangible_propval
))
1780 pos
= Fnext_char_property_change (pos
, Qnil
);
1784 position
= XINT (pos
);
1787 if (position
!= original_position
)
1789 /* Set TO to the interval containing the char after POSITION,
1790 and TOPREV to the interval containing the char before POSITION.
1791 Either one may be null. They may be equal. */
1792 to
= find_interval (BUF_INTERVALS (buffer
), position
);
1793 if (position
== BUF_BEGV (buffer
))
1795 else if (to
&& to
->position
== position
)
1796 toprev
= previous_interval (to
);
1801 /* Here TO is the interval after the stopping point
1802 and TOPREV is the interval before the stopping point.
1803 One or the other may be null. */
1805 BUF_PT (buffer
) = position
;
1807 /* We run point-left and point-entered hooks here, iff the
1808 two intervals are not equivalent. These hooks take
1809 (old_point, new_point) as arguments. */
1810 if (NILP (Vinhibit_point_motion_hooks
)
1811 && (! intervals_equal (from
, to
)
1812 || ! intervals_equal (fromprev
, toprev
)))
1814 Lisp_Object leave_after
, leave_before
, enter_after
, enter_before
;
1817 leave_after
= textget (fromprev
->plist
, Qpoint_left
);
1821 leave_before
= textget (from
->plist
, Qpoint_left
);
1823 leave_before
= Qnil
;
1826 enter_after
= textget (toprev
->plist
, Qpoint_entered
);
1830 enter_before
= textget (to
->plist
, Qpoint_entered
);
1832 enter_before
= Qnil
;
1834 if (! EQ (leave_before
, enter_before
) && !NILP (leave_before
))
1835 call2 (leave_before
, make_number (old_position
),
1836 make_number (position
));
1837 if (! EQ (leave_after
, enter_after
) && !NILP (leave_after
))
1838 call2 (leave_after
, make_number (old_position
),
1839 make_number (position
));
1841 if (! EQ (enter_before
, leave_before
) && !NILP (enter_before
))
1842 call2 (enter_before
, make_number (old_position
),
1843 make_number (position
));
1844 if (! EQ (enter_after
, leave_after
) && !NILP (enter_after
))
1845 call2 (enter_after
, make_number (old_position
),
1846 make_number (position
));
1850 /* Set point temporarily, without checking any text properties. */
1853 temp_set_point (position
, buffer
)
1855 struct buffer
*buffer
;
1857 BUF_PT (buffer
) = position
;
1860 /* Move point to POSITION, unless POSITION is inside an intangible
1861 segment that reaches all the way to point. */
1864 move_if_not_intangible (position
)
1868 Lisp_Object intangible_propval
;
1870 XSETINT (pos
, position
);
1872 if (! NILP (Vinhibit_point_motion_hooks
))
1873 /* If intangible is inhibited, always move point to POSITION. */
1875 else if (PT
< position
&& XINT (pos
) < ZV
)
1877 /* We want to move forward, so check the text before POSITION. */
1879 intangible_propval
= Fget_char_property (pos
,
1882 /* If following char is intangible,
1883 skip back over all chars with matching intangible property. */
1884 if (! NILP (intangible_propval
))
1885 while (XINT (pos
) > BEGV
1886 && EQ (Fget_char_property (make_number (XINT (pos
) - 1),
1888 intangible_propval
))
1889 pos
= Fprevious_char_property_change (pos
, Qnil
);
1891 else if (XINT (pos
) > BEGV
)
1893 /* We want to move backward, so check the text after POSITION. */
1895 intangible_propval
= Fget_char_property (make_number (XINT (pos
) - 1),
1898 /* If following char is intangible,
1899 skip back over all chars with matching intangible property. */
1900 if (! NILP (intangible_propval
))
1901 while (XINT (pos
) < ZV
1902 && EQ (Fget_char_property (pos
, Qintangible
, Qnil
),
1903 intangible_propval
))
1904 pos
= Fnext_char_property_change (pos
, Qnil
);
1908 /* If the whole stretch between PT and POSITION isn't intangible,
1909 try moving to POSITION (which means we actually move farther
1910 if POSITION is inside of intangible text). */
1912 if (XINT (pos
) != PT
)
1916 /* Return the proper local map for position POSITION in BUFFER.
1917 Use the map specified by the local-map property, if any.
1918 Otherwise, use BUFFER's local map. */
1921 get_local_map (position
, buffer
)
1922 register int position
;
1923 register struct buffer
*buffer
;
1925 Lisp_Object prop
, tem
, lispy_position
, lispy_buffer
;
1926 int old_begv
, old_zv
;
1928 /* Perhaps we should just change `position' to the limit. */
1929 if (position
> BUF_Z (buffer
) || position
< BUF_BEG (buffer
))
1932 /* Ignore narrowing, so that a local map continues to be valid even if
1933 the visible region contains no characters and hence no properties. */
1934 old_begv
= BUF_BEGV (buffer
);
1935 old_zv
= BUF_ZV (buffer
);
1936 BUF_BEGV (buffer
) = BUF_BEG (buffer
);
1937 BUF_ZV (buffer
) = BUF_Z (buffer
);
1939 /* There are no properties at the end of the buffer, so in that case
1940 check for a local map on the last character of the buffer instead. */
1941 if (position
== BUF_Z (buffer
) && BUF_Z (buffer
) > BUF_BEG (buffer
))
1943 XSETFASTINT (lispy_position
, position
);
1944 XSETBUFFER (lispy_buffer
, buffer
);
1945 prop
= Fget_char_property (lispy_position
, Qlocal_map
, lispy_buffer
);
1947 BUF_BEGV (buffer
) = old_begv
;
1948 BUF_ZV (buffer
) = old_zv
;
1950 /* Use the local map only if it is valid. */
1951 /* Do allow symbols that are defined as keymaps. */
1952 if (SYMBOLP (prop
) && !NILP (prop
))
1953 prop
= Findirect_function (prop
);
1955 && (tem
= Fkeymapp (prop
), !NILP (tem
)))
1958 return buffer
->keymap
;
1961 /* Produce an interval tree reflecting the intervals in
1962 TREE from START to START + LENGTH. */
1965 copy_intervals (tree
, start
, length
)
1969 register INTERVAL i
, new, t
;
1970 register int got
, prevlen
;
1972 if (NULL_INTERVAL_P (tree
) || length
<= 0)
1973 return NULL_INTERVAL
;
1975 i
= find_interval (tree
, start
);
1976 if (NULL_INTERVAL_P (i
) || LENGTH (i
) == 0)
1979 /* If there is only one interval and it's the default, return nil. */
1980 if ((start
- i
->position
+ 1 + length
) < LENGTH (i
)
1981 && DEFAULT_INTERVAL_P (i
))
1982 return NULL_INTERVAL
;
1984 new = make_interval ();
1986 got
= (LENGTH (i
) - (start
- i
->position
));
1987 new->total_length
= length
;
1988 copy_properties (i
, new);
1992 while (got
< length
)
1994 i
= next_interval (i
);
1995 t
= split_interval_right (t
, prevlen
);
1996 copy_properties (i
, t
);
1997 prevlen
= LENGTH (i
);
2001 return balance_an_interval (new);
2004 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2007 copy_intervals_to_string (string
, buffer
, position
, length
)
2009 struct buffer
*buffer
;
2010 int position
, length
;
2012 INTERVAL interval_copy
= copy_intervals (BUF_INTERVALS (buffer
),
2014 if (NULL_INTERVAL_P (interval_copy
))
2017 interval_copy
->parent
= (INTERVAL
) XFASTINT (string
);
2018 XSTRING (string
)->intervals
= interval_copy
;
2021 /* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
2022 Assume they have identical characters. */
2025 compare_string_intervals (s1
, s2
)
2030 int end
= XSTRING (s1
)->size
+ 1;
2032 /* We specify 1 as position because the interval functions
2033 always use positions starting at 1. */
2034 i1
= find_interval (XSTRING (s1
)->intervals
, 1);
2035 i2
= find_interval (XSTRING (s2
)->intervals
, 1);
2039 /* Determine how far we can go before we reach the end of I1 or I2. */
2040 int len1
= (i1
!= 0 ? INTERVAL_LAST_POS (i1
) : end
) - pos
;
2041 int len2
= (i2
!= 0 ? INTERVAL_LAST_POS (i2
) : end
) - pos
;
2042 int distance
= min (len1
, len2
);
2044 /* If we ever find a mismatch between the strings,
2046 if (! intervals_equal (i1
, i2
))
2049 /* Advance POS till the end of the shorter interval,
2050 and advance one or both interval pointers for the new position. */
2052 if (len1
== distance
)
2053 i1
= next_interval (i1
);
2054 if (len2
== distance
)
2055 i2
= next_interval (i2
);
2060 #endif /* USE_TEXT_PROPERTIES */