(erc-button-keymap): Bind `follow-link'.
[emacs.git] / src / intervals.c
blobee18dd5b4bef24ddd6c60604bcee209dcd82ec91
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* NOTES:
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
36 to GC them.
41 #include <config.h>
42 #include "lisp.h"
43 #include "intervals.h"
44 #include "buffer.h"
45 #include "puresize.h"
46 #include "keyboard.h"
47 #include "keymap.h"
49 /* Test for membership, allowing for t (actually any non-cons) to mean the
50 universal set. */
52 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
54 Lisp_Object merge_properties_sticky ();
55 static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
56 static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
58 /* Utility functions for intervals. */
61 /* Create the root interval of some object, a buffer or string. */
63 INTERVAL
64 create_root_interval (parent)
65 Lisp_Object parent;
67 INTERVAL new;
69 CHECK_IMPURE (parent);
71 new = make_interval ();
73 if (BUFFERP (parent))
75 new->total_length = (BUF_Z (XBUFFER (parent))
76 - BUF_BEG (XBUFFER (parent)));
77 CHECK_TOTAL_LENGTH (new);
78 BUF_INTERVALS (XBUFFER (parent)) = new;
79 new->position = BEG;
81 else if (STRINGP (parent))
83 new->total_length = SCHARS (parent);
84 CHECK_TOTAL_LENGTH (new);
85 STRING_SET_INTERVALS (parent, new);
86 new->position = 0;
89 SET_INTERVAL_OBJECT (new, parent);
91 return new;
94 /* Make the interval TARGET have exactly the properties of SOURCE */
96 void
97 copy_properties (source, target)
98 register INTERVAL source, target;
100 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
101 return;
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. */
111 static void
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))
118 return;
120 MERGE_INTERVAL_CACHE (source, target);
122 o = source->plist;
123 while (CONSP (o))
125 sym = XCAR (o);
126 o = XCDR (o);
127 CHECK_CONS (o);
129 val = target->plist;
130 while (CONSP (val) && !EQ (XCAR (val), sym))
132 val = XCDR (val);
133 if (!CONSP (val))
134 break;
135 val = XCDR (val);
138 if (NILP (val))
140 val = XCAR (o);
141 target->plist = Fcons (sym, Fcons (val, target->plist));
143 o = XCDR (o);
147 /* Return 1 if the two intervals have the same properties,
148 0 otherwise. */
151 intervals_equal (i0, i1)
152 INTERVAL i0, i1;
154 register Lisp_Object i0_cdr, i0_sym;
155 register Lisp_Object i1_cdr, i1_val;
157 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
158 return 1;
160 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
161 return 0;
163 i0_cdr = i0->plist;
164 i1_cdr = i1->plist;
165 while (CONSP (i0_cdr) && CONSP (i1_cdr))
167 i0_sym = XCAR (i0_cdr);
168 i0_cdr = XCDR (i0_cdr);
169 if (!CONSP (i0_cdr))
170 return 0; /* abort (); */
171 i1_val = i1->plist;
172 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
174 i1_val = XCDR (i1_val);
175 if (!CONSP (i1_val))
176 return 0; /* abort (); */
177 i1_val = XCDR (i1_val);
180 /* i0 has something i1 doesn't. */
181 if (EQ (i1_val, Qnil))
182 return 0;
184 /* i0 and i1 both have sym, but it has different values in each. */
185 if (!CONSP (i1_val)
186 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
187 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
188 return 0;
190 i0_cdr = XCDR (i0_cdr);
192 i1_cdr = XCDR (i1_cdr);
193 if (!CONSP (i1_cdr))
194 return 0; /* abort (); */
195 i1_cdr = XCDR (i1_cdr);
198 /* Lengths of the two plists were equal. */
199 return (NILP (i0_cdr) && NILP (i1_cdr));
203 /* Traverse an interval tree TREE, performing FUNCTION on each node.
204 No guarantee is made about the order of traversal.
205 Pass FUNCTION two args: an interval, and ARG. */
207 void
208 traverse_intervals_noorder (tree, function, arg)
209 INTERVAL tree;
210 void (* function) P_ ((INTERVAL, Lisp_Object));
211 Lisp_Object arg;
213 /* Minimize stack usage. */
214 while (!NULL_INTERVAL_P (tree))
216 (*function) (tree, arg);
217 if (NULL_INTERVAL_P (tree->right))
218 tree = tree->left;
219 else
221 traverse_intervals_noorder (tree->left, function, arg);
222 tree = tree->right;
227 /* Traverse an interval tree TREE, performing FUNCTION on each node.
228 Pass FUNCTION two args: an interval, and ARG. */
230 void
231 traverse_intervals (tree, position, function, arg)
232 INTERVAL tree;
233 int position;
234 void (* function) P_ ((INTERVAL, Lisp_Object));
235 Lisp_Object arg;
237 while (!NULL_INTERVAL_P (tree))
239 traverse_intervals (tree->left, position, function, arg);
240 position += LEFT_TOTAL_LENGTH (tree);
241 tree->position = position;
242 (*function) (tree, arg);
243 position += LENGTH (tree); tree = tree->right;
247 #if 0
249 static int icount;
250 static int idepth;
251 static int zero_length;
253 /* These functions are temporary, for debugging purposes only. */
255 INTERVAL search_interval, found_interval;
257 void
258 check_for_interval (i)
259 register INTERVAL i;
261 if (i == search_interval)
263 found_interval = i;
264 icount++;
268 INTERVAL
269 search_for_interval (i, tree)
270 register INTERVAL i, tree;
272 icount = 0;
273 search_interval = i;
274 found_interval = NULL_INTERVAL;
275 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
276 return found_interval;
279 static void
280 inc_interval_count (i)
281 INTERVAL i;
283 icount++;
284 if (LENGTH (i) == 0)
285 zero_length++;
286 if (depth > idepth)
287 idepth = depth;
291 count_intervals (i)
292 register INTERVAL i;
294 icount = 0;
295 idepth = 0;
296 zero_length = 0;
297 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
299 return icount;
302 static INTERVAL
303 root_interval (interval)
304 INTERVAL interval;
306 register INTERVAL i = interval;
308 while (! ROOT_INTERVAL_P (i))
309 i = INTERVAL_PARENT (i);
311 return i;
313 #endif
315 /* Assuming that a left child exists, perform the following operation:
318 / \ / \
319 B => A
320 / \ / \
324 static INLINE INTERVAL
325 rotate_right (interval)
326 INTERVAL interval;
328 INTERVAL i;
329 INTERVAL B = interval->left;
330 int old_total = interval->total_length;
332 /* Deal with any Parent of A; make it point to B. */
333 if (! ROOT_INTERVAL_P (interval))
335 if (AM_LEFT_CHILD (interval))
336 INTERVAL_PARENT (interval)->left = B;
337 else
338 INTERVAL_PARENT (interval)->right = B;
340 COPY_INTERVAL_PARENT (B, interval);
342 /* Make B the parent of A */
343 i = B->right;
344 B->right = interval;
345 SET_INTERVAL_PARENT (interval, B);
347 /* Make A point to c */
348 interval->left = i;
349 if (! NULL_INTERVAL_P (i))
350 SET_INTERVAL_PARENT (i, interval);
352 /* A's total length is decreased by the length of B and its left child. */
353 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
354 CHECK_TOTAL_LENGTH (interval);
356 /* B must have the same total length of A. */
357 B->total_length = old_total;
358 CHECK_TOTAL_LENGTH (B);
360 return B;
363 /* Assuming that a right child exists, perform the following operation:
366 / \ / \
367 B => A
368 / \ / \
372 static INLINE INTERVAL
373 rotate_left (interval)
374 INTERVAL interval;
376 INTERVAL i;
377 INTERVAL B = interval->right;
378 int old_total = interval->total_length;
380 /* Deal with any parent of A; make it point to B. */
381 if (! ROOT_INTERVAL_P (interval))
383 if (AM_LEFT_CHILD (interval))
384 INTERVAL_PARENT (interval)->left = B;
385 else
386 INTERVAL_PARENT (interval)->right = B;
388 COPY_INTERVAL_PARENT (B, interval);
390 /* Make B the parent of A */
391 i = B->left;
392 B->left = interval;
393 SET_INTERVAL_PARENT (interval, B);
395 /* Make A point to c */
396 interval->right = i;
397 if (! NULL_INTERVAL_P (i))
398 SET_INTERVAL_PARENT (i, interval);
400 /* A's total length is decreased by the length of B and its right child. */
401 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
402 CHECK_TOTAL_LENGTH (interval);
404 /* B must have the same total length of A. */
405 B->total_length = old_total;
406 CHECK_TOTAL_LENGTH (B);
408 return B;
411 /* Balance an interval tree with the assumption that the subtrees
412 themselves are already balanced. */
414 static INTERVAL
415 balance_an_interval (i)
416 INTERVAL i;
418 register int old_diff, new_diff;
420 while (1)
422 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
423 if (old_diff > 0)
425 /* Since the left child is longer, there must be one. */
426 new_diff = i->total_length - i->left->total_length
427 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
428 if (eabs (new_diff) >= old_diff)
429 break;
430 i = rotate_right (i);
431 balance_an_interval (i->right);
433 else if (old_diff < 0)
435 /* Since the right child is longer, there must be one. */
436 new_diff = i->total_length - i->right->total_length
437 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
438 if (eabs (new_diff) >= -old_diff)
439 break;
440 i = rotate_left (i);
441 balance_an_interval (i->left);
443 else
444 break;
446 return i;
449 /* Balance INTERVAL, potentially stuffing it back into its parent
450 Lisp Object. */
452 static INLINE INTERVAL
453 balance_possible_root_interval (interval)
454 register INTERVAL interval;
456 Lisp_Object parent;
457 int have_parent = 0;
459 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
460 return interval;
462 if (INTERVAL_HAS_OBJECT (interval))
464 have_parent = 1;
465 GET_INTERVAL_OBJECT (parent, interval);
467 interval = balance_an_interval (interval);
469 if (have_parent)
471 if (BUFFERP (parent))
472 BUF_INTERVALS (XBUFFER (parent)) = interval;
473 else if (STRINGP (parent))
474 STRING_SET_INTERVALS (parent, interval);
477 return interval;
480 /* Balance the interval tree TREE. Balancing is by weight
481 (the amount of text). */
483 static INTERVAL
484 balance_intervals_internal (tree)
485 register INTERVAL tree;
487 /* Balance within each side. */
488 if (tree->left)
489 balance_intervals_internal (tree->left);
490 if (tree->right)
491 balance_intervals_internal (tree->right);
492 return balance_an_interval (tree);
495 /* Advertised interface to balance intervals. */
497 INTERVAL
498 balance_intervals (tree)
499 INTERVAL tree;
501 if (tree == NULL_INTERVAL)
502 return NULL_INTERVAL;
504 return balance_intervals_internal (tree);
507 /* Split INTERVAL into two pieces, starting the second piece at
508 character position OFFSET (counting from 0), relative to INTERVAL.
509 INTERVAL becomes the left-hand piece, and the right-hand piece
510 (second, lexicographically) is returned.
512 The size and position fields of the two intervals are set based upon
513 those of the original interval. The property list of the new interval
514 is reset, thus it is up to the caller to do the right thing with the
515 result.
517 Note that this does not change the position of INTERVAL; if it is a root,
518 it is still a root after this operation. */
520 INTERVAL
521 split_interval_right (interval, offset)
522 INTERVAL interval;
523 int offset;
525 INTERVAL new = make_interval ();
526 int position = interval->position;
527 int new_length = LENGTH (interval) - offset;
529 new->position = position + offset;
530 SET_INTERVAL_PARENT (new, interval);
532 if (NULL_RIGHT_CHILD (interval))
534 interval->right = new;
535 new->total_length = new_length;
536 CHECK_TOTAL_LENGTH (new);
538 else
540 /* Insert the new node between INTERVAL and its right child. */
541 new->right = interval->right;
542 SET_INTERVAL_PARENT (interval->right, new);
543 interval->right = new;
544 new->total_length = new_length + new->right->total_length;
545 CHECK_TOTAL_LENGTH (new);
546 balance_an_interval (new);
549 balance_possible_root_interval (interval);
551 return new;
554 /* Split INTERVAL into two pieces, starting the second piece at
555 character position OFFSET (counting from 0), relative to INTERVAL.
556 INTERVAL becomes the right-hand piece, and the left-hand piece
557 (first, lexicographically) is returned.
559 The size and position fields of the two intervals are set based upon
560 those of the original interval. The property list of the new interval
561 is reset, thus it is up to the caller to do the right thing with the
562 result.
564 Note that this does not change the position of INTERVAL; if it is a root,
565 it is still a root after this operation. */
567 INTERVAL
568 split_interval_left (interval, offset)
569 INTERVAL interval;
570 int offset;
572 INTERVAL new = make_interval ();
573 int new_length = offset;
575 new->position = interval->position;
576 interval->position = interval->position + offset;
577 SET_INTERVAL_PARENT (new, interval);
579 if (NULL_LEFT_CHILD (interval))
581 interval->left = new;
582 new->total_length = new_length;
583 CHECK_TOTAL_LENGTH (new);
585 else
587 /* Insert the new node between INTERVAL and its left child. */
588 new->left = interval->left;
589 SET_INTERVAL_PARENT (new->left, new);
590 interval->left = new;
591 new->total_length = new_length + new->left->total_length;
592 CHECK_TOTAL_LENGTH (new);
593 balance_an_interval (new);
596 balance_possible_root_interval (interval);
598 return new;
601 /* Return the proper position for the first character
602 described by the interval tree SOURCE.
603 This is 1 if the parent is a buffer,
604 0 if the parent is a string or if there is no parent.
606 Don't use this function on an interval which is the child
607 of another interval! */
610 interval_start_pos (source)
611 INTERVAL source;
613 Lisp_Object parent;
615 if (NULL_INTERVAL_P (source))
616 return 0;
618 if (! INTERVAL_HAS_OBJECT (source))
619 return 0;
620 GET_INTERVAL_OBJECT (parent, source);
621 if (BUFFERP (parent))
622 return BUF_BEG (XBUFFER (parent));
623 return 0;
626 /* Find the interval containing text position POSITION in the text
627 represented by the interval tree TREE. POSITION is a buffer
628 position (starting from 1) or a string index (starting from 0).
629 If POSITION is at the end of the buffer or string,
630 return the interval containing the last character.
632 The `position' field, which is a cache of an interval's position,
633 is updated in the interval found. Other functions (e.g., next_interval)
634 will update this cache based on the result of find_interval. */
636 INTERVAL
637 find_interval (tree, position)
638 register INTERVAL tree;
639 register int position;
641 /* The distance from the left edge of the subtree at TREE
642 to POSITION. */
643 register int relative_position;
645 if (NULL_INTERVAL_P (tree))
646 return NULL_INTERVAL;
648 relative_position = position;
649 if (INTERVAL_HAS_OBJECT (tree))
651 Lisp_Object parent;
652 GET_INTERVAL_OBJECT (parent, tree);
653 if (BUFFERP (parent))
654 relative_position -= BUF_BEG (XBUFFER (parent));
657 if (relative_position > TOTAL_LENGTH (tree))
658 abort (); /* Paranoia */
660 if (!handling_signal)
661 tree = balance_possible_root_interval (tree);
663 while (1)
665 if (relative_position < LEFT_TOTAL_LENGTH (tree))
667 tree = tree->left;
669 else if (! NULL_RIGHT_CHILD (tree)
670 && relative_position >= (TOTAL_LENGTH (tree)
671 - RIGHT_TOTAL_LENGTH (tree)))
673 relative_position -= (TOTAL_LENGTH (tree)
674 - RIGHT_TOTAL_LENGTH (tree));
675 tree = tree->right;
677 else
679 tree->position
680 = (position - relative_position /* left edge of *tree. */
681 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
683 return tree;
688 /* Find the succeeding interval (lexicographically) to INTERVAL.
689 Sets the `position' field based on that of INTERVAL (see
690 find_interval). */
692 INTERVAL
693 next_interval (interval)
694 register INTERVAL interval;
696 register INTERVAL i = interval;
697 register int next_position;
699 if (NULL_INTERVAL_P (i))
700 return NULL_INTERVAL;
701 next_position = interval->position + LENGTH (interval);
703 if (! NULL_RIGHT_CHILD (i))
705 i = i->right;
706 while (! NULL_LEFT_CHILD (i))
707 i = i->left;
709 i->position = next_position;
710 return i;
713 while (! NULL_PARENT (i))
715 if (AM_LEFT_CHILD (i))
717 i = INTERVAL_PARENT (i);
718 i->position = next_position;
719 return i;
722 i = INTERVAL_PARENT (i);
725 return NULL_INTERVAL;
728 /* Find the preceding interval (lexicographically) to INTERVAL.
729 Sets the `position' field based on that of INTERVAL (see
730 find_interval). */
732 INTERVAL
733 previous_interval (interval)
734 register INTERVAL interval;
736 register INTERVAL i;
738 if (NULL_INTERVAL_P (interval))
739 return NULL_INTERVAL;
741 if (! NULL_LEFT_CHILD (interval))
743 i = interval->left;
744 while (! NULL_RIGHT_CHILD (i))
745 i = i->right;
747 i->position = interval->position - LENGTH (i);
748 return i;
751 i = interval;
752 while (! NULL_PARENT (i))
754 if (AM_RIGHT_CHILD (i))
756 i = INTERVAL_PARENT (i);
758 i->position = interval->position - LENGTH (i);
759 return i;
761 i = INTERVAL_PARENT (i);
764 return NULL_INTERVAL;
767 /* Find the interval containing POS given some non-NULL INTERVAL
768 in the same tree. Note that we need to update interval->position
769 if we go down the tree.
770 To speed up the process, we assume that the ->position of
771 I and all its parents is already uptodate. */
772 INTERVAL
773 update_interval (i, pos)
774 register INTERVAL i;
775 int pos;
777 if (NULL_INTERVAL_P (i))
778 return NULL_INTERVAL;
780 while (1)
782 if (pos < i->position)
784 /* Move left. */
785 if (pos >= i->position - TOTAL_LENGTH (i->left))
787 i->left->position = i->position - TOTAL_LENGTH (i->left)
788 + LEFT_TOTAL_LENGTH (i->left);
789 i = i->left; /* Move to the left child */
791 else if (NULL_PARENT (i))
792 error ("Point before start of properties");
793 else
794 i = INTERVAL_PARENT (i);
795 continue;
797 else if (pos >= INTERVAL_LAST_POS (i))
799 /* Move right. */
800 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
802 i->right->position = INTERVAL_LAST_POS (i)
803 + LEFT_TOTAL_LENGTH (i->right);
804 i = i->right; /* Move to the right child */
806 else if (NULL_PARENT (i))
807 error ("Point %d after end of properties", pos);
808 else
809 i = INTERVAL_PARENT (i);
810 continue;
812 else
813 return i;
818 #if 0
819 /* Traverse a path down the interval tree TREE to the interval
820 containing POSITION, adjusting all nodes on the path for
821 an addition of LENGTH characters. Insertion between two intervals
822 (i.e., point == i->position, where i is second interval) means
823 text goes into second interval.
825 Modifications are needed to handle the hungry bits -- after simply
826 finding the interval at position (don't add length going down),
827 if it's the beginning of the interval, get the previous interval
828 and check the hungry bits of both. Then add the length going back up
829 to the root. */
831 static INTERVAL
832 adjust_intervals_for_insertion (tree, position, length)
833 INTERVAL tree;
834 int position, length;
836 register int relative_position;
837 register INTERVAL this;
839 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
840 abort ();
842 /* If inserting at point-max of a buffer, that position
843 will be out of range */
844 if (position > TOTAL_LENGTH (tree))
845 position = TOTAL_LENGTH (tree);
846 relative_position = position;
847 this = tree;
849 while (1)
851 if (relative_position <= LEFT_TOTAL_LENGTH (this))
853 this->total_length += length;
854 CHECK_TOTAL_LENGTH (this);
855 this = this->left;
857 else if (relative_position > (TOTAL_LENGTH (this)
858 - RIGHT_TOTAL_LENGTH (this)))
860 relative_position -= (TOTAL_LENGTH (this)
861 - RIGHT_TOTAL_LENGTH (this));
862 this->total_length += length;
863 CHECK_TOTAL_LENGTH (this);
864 this = this->right;
866 else
868 /* If we are to use zero-length intervals as buffer pointers,
869 then this code will have to change. */
870 this->total_length += length;
871 CHECK_TOTAL_LENGTH (this);
872 this->position = LEFT_TOTAL_LENGTH (this)
873 + position - relative_position + 1;
874 return tree;
878 #endif
880 /* Effect an adjustment corresponding to the addition of LENGTH characters
881 of text. Do this by finding the interval containing POSITION in the
882 interval tree TREE, and then adjusting all of its ancestors by adding
883 LENGTH to them.
885 If POSITION is the first character of an interval, meaning that point
886 is actually between the two intervals, make the new text belong to
887 the interval which is "sticky".
889 If both intervals are "sticky", then make them belong to the left-most
890 interval. Another possibility would be to create a new interval for
891 this text, and make it have the merged properties of both ends. */
893 static INTERVAL
894 adjust_intervals_for_insertion (tree, position, length)
895 INTERVAL tree;
896 int position, length;
898 register INTERVAL i;
899 register INTERVAL temp;
900 int eobp = 0;
901 Lisp_Object parent;
902 int offset;
904 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
905 abort ();
907 GET_INTERVAL_OBJECT (parent, tree);
908 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
910 /* If inserting at point-max of a buffer, that position will be out
911 of range. Remember that buffer positions are 1-based. */
912 if (position >= TOTAL_LENGTH (tree) + offset)
914 position = TOTAL_LENGTH (tree) + offset;
915 eobp = 1;
918 i = find_interval (tree, position);
920 /* If in middle of an interval which is not sticky either way,
921 we must not just give its properties to the insertion.
922 So split this interval at the insertion point.
924 Originally, the if condition here was this:
925 (! (position == i->position || eobp)
926 && END_NONSTICKY_P (i)
927 && FRONT_NONSTICKY_P (i))
928 But, these macros are now unreliable because of introduction of
929 Vtext_property_default_nonsticky. So, we always check properties
930 one by one if POSITION is in middle of an interval. */
931 if (! (position == i->position || eobp))
933 Lisp_Object tail;
934 Lisp_Object front, rear;
936 tail = i->plist;
938 /* Properties font-sticky and rear-nonsticky override
939 Vtext_property_default_nonsticky. So, if they are t, we can
940 skip one by one checking of properties. */
941 rear = textget (i->plist, Qrear_nonsticky);
942 if (! CONSP (rear) && ! NILP (rear))
944 /* All properties are nonsticky. We split the interval. */
945 goto check_done;
947 front = textget (i->plist, Qfront_sticky);
948 if (! CONSP (front) && ! NILP (front))
950 /* All properties are sticky. We don't split the interval. */
951 tail = Qnil;
952 goto check_done;
955 /* Does any actual property pose an actual problem? We break
956 the loop if we find a nonsticky property. */
957 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
959 Lisp_Object prop, tmp;
960 prop = XCAR (tail);
962 /* Is this particular property front-sticky? */
963 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
964 continue;
966 /* Is this particular property rear-nonsticky? */
967 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
968 break;
970 /* Is this particular property recorded as sticky or
971 nonsticky in Vtext_property_default_nonsticky? */
972 tmp = Fassq (prop, Vtext_property_default_nonsticky);
973 if (CONSP (tmp))
975 if (NILP (tmp))
976 continue;
977 break;
980 /* By default, a text property is rear-sticky, thus we
981 continue the loop. */
984 check_done:
985 /* If any property is a real problem, split the interval. */
986 if (! NILP (tail))
988 temp = split_interval_right (i, position - i->position);
989 copy_properties (i, temp);
990 i = temp;
994 /* If we are positioned between intervals, check the stickiness of
995 both of them. We have to do this too, if we are at BEG or Z. */
996 if (position == i->position || eobp)
998 register INTERVAL prev;
1000 if (position == BEG)
1001 prev = 0;
1002 else if (eobp)
1004 prev = i;
1005 i = 0;
1007 else
1008 prev = previous_interval (i);
1010 /* Even if we are positioned between intervals, we default
1011 to the left one if it exists. We extend it now and split
1012 off a part later, if stickiness demands it. */
1013 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1015 temp->total_length += length;
1016 CHECK_TOTAL_LENGTH (temp);
1017 temp = balance_possible_root_interval (temp);
1020 /* If at least one interval has sticky properties,
1021 we check the stickiness property by property.
1023 Originally, the if condition here was this:
1024 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1025 But, these macros are now unreliable because of introduction
1026 of Vtext_property_default_nonsticky. So, we always have to
1027 check stickiness of properties one by one. If cache of
1028 stickiness is implemented in the future, we may be able to
1029 use those macros again. */
1030 if (1)
1032 Lisp_Object pleft, pright;
1033 struct interval newi;
1035 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1036 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1037 newi.plist = merge_properties_sticky (pleft, pright);
1039 if (! prev) /* i.e. position == BEG */
1041 if (! intervals_equal (i, &newi))
1043 i = split_interval_left (i, length);
1044 i->plist = newi.plist;
1047 else if (! intervals_equal (prev, &newi))
1049 prev = split_interval_right (prev,
1050 position - prev->position);
1051 prev->plist = newi.plist;
1052 if (! NULL_INTERVAL_P (i)
1053 && intervals_equal (prev, i))
1054 merge_interval_right (prev);
1057 /* We will need to update the cache here later. */
1059 else if (! prev && ! NILP (i->plist))
1061 /* Just split off a new interval at the left.
1062 Since I wasn't front-sticky, the empty plist is ok. */
1063 i = split_interval_left (i, length);
1067 /* Otherwise just extend the interval. */
1068 else
1070 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1072 temp->total_length += length;
1073 CHECK_TOTAL_LENGTH (temp);
1074 temp = balance_possible_root_interval (temp);
1078 return tree;
1081 /* Any property might be front-sticky on the left, rear-sticky on the left,
1082 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1083 can be arranged in a matrix with rows denoting the left conditions and
1084 columns denoting the right conditions:
1085 _ __ _
1086 _ FR FR FR FR
1087 FR__ 0 1 2 3
1088 _FR 4 5 6 7
1089 FR 8 9 A B
1090 FR C D E F
1092 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1093 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1094 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1095 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1096 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1097 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1098 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1099 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1101 We inherit from whoever has a sticky side facing us. If both sides
1102 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1103 non-nil value for the current property. If both sides do, then we take
1104 from the left.
1106 When we inherit a property, we get its stickiness as well as its value.
1107 So, when we merge the above two lists, we expect to get this:
1109 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1110 rear-nonsticky (p6 pa)
1111 p0 L p1 L p2 L p3 L p6 R p7 R
1112 pa R pb R pc L pd L pe L pf L)
1114 The optimizable special cases are:
1115 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1116 left rear-nonsticky = t, right front-sticky = t (inherit right)
1117 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1120 Lisp_Object
1121 merge_properties_sticky (pleft, pright)
1122 Lisp_Object pleft, pright;
1124 register Lisp_Object props, front, rear;
1125 Lisp_Object lfront, lrear, rfront, rrear;
1126 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1127 int use_left, use_right;
1128 int lpresent;
1130 props = Qnil;
1131 front = Qnil;
1132 rear = Qnil;
1133 lfront = textget (pleft, Qfront_sticky);
1134 lrear = textget (pleft, Qrear_nonsticky);
1135 rfront = textget (pright, Qfront_sticky);
1136 rrear = textget (pright, Qrear_nonsticky);
1138 /* Go through each element of PRIGHT. */
1139 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1141 Lisp_Object tmp;
1143 sym = XCAR (tail1);
1145 /* Sticky properties get special treatment. */
1146 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1147 continue;
1149 rval = Fcar (XCDR (tail1));
1150 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1151 if (EQ (sym, XCAR (tail2)))
1152 break;
1154 /* Indicate whether the property is explicitly defined on the left.
1155 (We know it is defined explicitly on the right
1156 because otherwise we don't get here.) */
1157 lpresent = ! NILP (tail2);
1158 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1160 /* Even if lrear or rfront say nothing about the stickiness of
1161 SYM, Vtext_property_default_nonsticky may give default
1162 stickiness to SYM. */
1163 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1164 use_left = (lpresent
1165 && ! (TMEM (sym, lrear)
1166 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1167 use_right = (TMEM (sym, rfront)
1168 || (CONSP (tmp) && NILP (XCDR (tmp))));
1169 if (use_left && use_right)
1171 if (NILP (lval))
1172 use_left = 0;
1173 else if (NILP (rval))
1174 use_right = 0;
1176 if (use_left)
1178 /* We build props as (value sym ...) rather than (sym value ...)
1179 because we plan to nreverse it when we're done. */
1180 props = Fcons (lval, Fcons (sym, props));
1181 if (TMEM (sym, lfront))
1182 front = Fcons (sym, front);
1183 if (TMEM (sym, lrear))
1184 rear = Fcons (sym, rear);
1186 else if (use_right)
1188 props = Fcons (rval, Fcons (sym, props));
1189 if (TMEM (sym, rfront))
1190 front = Fcons (sym, front);
1191 if (TMEM (sym, rrear))
1192 rear = Fcons (sym, rear);
1196 /* Now go through each element of PLEFT. */
1197 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1199 Lisp_Object tmp;
1201 sym = XCAR (tail2);
1203 /* Sticky properties get special treatment. */
1204 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1205 continue;
1207 /* If sym is in PRIGHT, we've already considered it. */
1208 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1209 if (EQ (sym, XCAR (tail1)))
1210 break;
1211 if (! NILP (tail1))
1212 continue;
1214 lval = Fcar (XCDR (tail2));
1216 /* Even if lrear or rfront say nothing about the stickiness of
1217 SYM, Vtext_property_default_nonsticky may give default
1218 stickiness to SYM. */
1219 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1221 /* Since rval is known to be nil in this loop, the test simplifies. */
1222 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1224 props = Fcons (lval, Fcons (sym, props));
1225 if (TMEM (sym, lfront))
1226 front = Fcons (sym, front);
1228 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1230 /* The value is nil, but we still inherit the stickiness
1231 from the right. */
1232 front = Fcons (sym, front);
1233 if (TMEM (sym, rrear))
1234 rear = Fcons (sym, rear);
1237 props = Fnreverse (props);
1238 if (! NILP (rear))
1239 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1241 cat = textget (props, Qcategory);
1242 if (! NILP (front)
1244 /* If we have inherited a front-stick category property that is t,
1245 we don't need to set up a detailed one. */
1246 ! (! NILP (cat) && SYMBOLP (cat)
1247 && EQ (Fget (cat, Qfront_sticky), Qt)))
1248 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1249 return props;
1253 /* Delete a node I from its interval tree by merging its subtrees
1254 into one subtree which is then returned. Caller is responsible for
1255 storing the resulting subtree into its parent. */
1257 static INTERVAL
1258 delete_node (i)
1259 register INTERVAL i;
1261 register INTERVAL migrate, this;
1262 register int migrate_amt;
1264 if (NULL_INTERVAL_P (i->left))
1265 return i->right;
1266 if (NULL_INTERVAL_P (i->right))
1267 return i->left;
1269 migrate = i->left;
1270 migrate_amt = i->left->total_length;
1271 this = i->right;
1272 this->total_length += migrate_amt;
1273 while (! NULL_INTERVAL_P (this->left))
1275 this = this->left;
1276 this->total_length += migrate_amt;
1278 CHECK_TOTAL_LENGTH (this);
1279 this->left = migrate;
1280 SET_INTERVAL_PARENT (migrate, this);
1282 return i->right;
1285 /* Delete interval I from its tree by calling `delete_node'
1286 and properly connecting the resultant subtree.
1288 I is presumed to be empty; that is, no adjustments are made
1289 for the length of I. */
1291 void
1292 delete_interval (i)
1293 register INTERVAL i;
1295 register INTERVAL parent;
1296 int amt = LENGTH (i);
1298 if (amt > 0) /* Only used on zero-length intervals now. */
1299 abort ();
1301 if (ROOT_INTERVAL_P (i))
1303 Lisp_Object owner;
1304 GET_INTERVAL_OBJECT (owner, i);
1305 parent = delete_node (i);
1306 if (! NULL_INTERVAL_P (parent))
1307 SET_INTERVAL_OBJECT (parent, owner);
1309 if (BUFFERP (owner))
1310 BUF_INTERVALS (XBUFFER (owner)) = parent;
1311 else if (STRINGP (owner))
1312 STRING_SET_INTERVALS (owner, parent);
1313 else
1314 abort ();
1316 return;
1319 parent = INTERVAL_PARENT (i);
1320 if (AM_LEFT_CHILD (i))
1322 parent->left = delete_node (i);
1323 if (! NULL_INTERVAL_P (parent->left))
1324 SET_INTERVAL_PARENT (parent->left, parent);
1326 else
1328 parent->right = delete_node (i);
1329 if (! NULL_INTERVAL_P (parent->right))
1330 SET_INTERVAL_PARENT (parent->right, parent);
1334 /* Find the interval in TREE corresponding to the relative position
1335 FROM and delete as much as possible of AMOUNT from that interval.
1336 Return the amount actually deleted, and if the interval was
1337 zeroed-out, delete that interval node from the tree.
1339 Note that FROM is actually origin zero, aka relative to the
1340 leftmost edge of tree. This is appropriate since we call ourselves
1341 recursively on subtrees.
1343 Do this by recursing down TREE to the interval in question, and
1344 deleting the appropriate amount of text. */
1346 static int
1347 interval_deletion_adjustment (tree, from, amount)
1348 register INTERVAL tree;
1349 register int from, amount;
1351 register int relative_position = from;
1353 if (NULL_INTERVAL_P (tree))
1354 return 0;
1356 /* Left branch */
1357 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1359 int subtract = interval_deletion_adjustment (tree->left,
1360 relative_position,
1361 amount);
1362 tree->total_length -= subtract;
1363 CHECK_TOTAL_LENGTH (tree);
1364 return subtract;
1366 /* Right branch */
1367 else if (relative_position >= (TOTAL_LENGTH (tree)
1368 - RIGHT_TOTAL_LENGTH (tree)))
1370 int subtract;
1372 relative_position -= (tree->total_length
1373 - RIGHT_TOTAL_LENGTH (tree));
1374 subtract = interval_deletion_adjustment (tree->right,
1375 relative_position,
1376 amount);
1377 tree->total_length -= subtract;
1378 CHECK_TOTAL_LENGTH (tree);
1379 return subtract;
1381 /* Here -- this node. */
1382 else
1384 /* How much can we delete from this interval? */
1385 int my_amount = ((tree->total_length
1386 - RIGHT_TOTAL_LENGTH (tree))
1387 - relative_position);
1389 if (amount > my_amount)
1390 amount = my_amount;
1392 tree->total_length -= amount;
1393 CHECK_TOTAL_LENGTH (tree);
1394 if (LENGTH (tree) == 0)
1395 delete_interval (tree);
1397 return amount;
1400 /* Never reach here. */
1403 /* Effect the adjustments necessary to the interval tree of BUFFER to
1404 correspond to the deletion of LENGTH characters from that buffer
1405 text. The deletion is effected at position START (which is a
1406 buffer position, i.e. origin 1). */
1408 static void
1409 adjust_intervals_for_deletion (buffer, start, length)
1410 struct buffer *buffer;
1411 int start, length;
1413 register int left_to_delete = length;
1414 register INTERVAL tree = BUF_INTERVALS (buffer);
1415 Lisp_Object parent;
1416 int offset;
1418 GET_INTERVAL_OBJECT (parent, tree);
1419 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1421 if (NULL_INTERVAL_P (tree))
1422 return;
1424 if (start > offset + TOTAL_LENGTH (tree)
1425 || start + length > offset + TOTAL_LENGTH (tree))
1426 abort ();
1428 if (length == TOTAL_LENGTH (tree))
1430 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1431 return;
1434 if (ONLY_INTERVAL_P (tree))
1436 tree->total_length -= length;
1437 CHECK_TOTAL_LENGTH (tree);
1438 return;
1441 if (start > offset + TOTAL_LENGTH (tree))
1442 start = offset + TOTAL_LENGTH (tree);
1443 while (left_to_delete > 0)
1445 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1446 left_to_delete);
1447 tree = BUF_INTERVALS (buffer);
1448 if (left_to_delete == tree->total_length)
1450 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1451 return;
1456 /* Make the adjustments necessary to the interval tree of BUFFER to
1457 represent an addition or deletion of LENGTH characters starting
1458 at position START. Addition or deletion is indicated by the sign
1459 of LENGTH. */
1461 INLINE void
1462 offset_intervals (buffer, start, length)
1463 struct buffer *buffer;
1464 int start, length;
1466 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1467 return;
1469 if (length > 0)
1470 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1471 else
1472 adjust_intervals_for_deletion (buffer, start, -length);
1475 /* Merge interval I with its lexicographic successor. The resulting
1476 interval is returned, and has the properties of the original
1477 successor. The properties of I are lost. I is removed from the
1478 interval tree.
1480 IMPORTANT:
1481 The caller must verify that this is not the last (rightmost)
1482 interval. */
1484 INTERVAL
1485 merge_interval_right (i)
1486 register INTERVAL i;
1488 register int absorb = LENGTH (i);
1489 register INTERVAL successor;
1491 /* Zero out this interval. */
1492 i->total_length -= absorb;
1493 CHECK_TOTAL_LENGTH (i);
1495 /* Find the succeeding interval. */
1496 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1497 as we descend. */
1499 successor = i->right;
1500 while (! NULL_LEFT_CHILD (successor))
1502 successor->total_length += absorb;
1503 CHECK_TOTAL_LENGTH (successor);
1504 successor = successor->left;
1507 successor->total_length += absorb;
1508 CHECK_TOTAL_LENGTH (successor);
1509 delete_interval (i);
1510 return successor;
1513 successor = i;
1514 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1515 we ascend. */
1517 if (AM_LEFT_CHILD (successor))
1519 successor = INTERVAL_PARENT (successor);
1520 delete_interval (i);
1521 return successor;
1524 successor = INTERVAL_PARENT (successor);
1525 successor->total_length -= absorb;
1526 CHECK_TOTAL_LENGTH (successor);
1529 /* This must be the rightmost or last interval and cannot
1530 be merged right. The caller should have known. */
1531 abort ();
1534 /* Merge interval I with its lexicographic predecessor. The resulting
1535 interval is returned, and has the properties of the original predecessor.
1536 The properties of I are lost. Interval node I is removed from the tree.
1538 IMPORTANT:
1539 The caller must verify that this is not the first (leftmost) interval. */
1541 INTERVAL
1542 merge_interval_left (i)
1543 register INTERVAL i;
1545 register int absorb = LENGTH (i);
1546 register INTERVAL predecessor;
1548 /* Zero out this interval. */
1549 i->total_length -= absorb;
1550 CHECK_TOTAL_LENGTH (i);
1552 /* Find the preceding interval. */
1553 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1554 adding ABSORB as we go. */
1556 predecessor = i->left;
1557 while (! NULL_RIGHT_CHILD (predecessor))
1559 predecessor->total_length += absorb;
1560 CHECK_TOTAL_LENGTH (predecessor);
1561 predecessor = predecessor->right;
1564 predecessor->total_length += absorb;
1565 CHECK_TOTAL_LENGTH (predecessor);
1566 delete_interval (i);
1567 return predecessor;
1570 predecessor = i;
1571 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1572 subtracting ABSORB. */
1574 if (AM_RIGHT_CHILD (predecessor))
1576 predecessor = INTERVAL_PARENT (predecessor);
1577 delete_interval (i);
1578 return predecessor;
1581 predecessor = INTERVAL_PARENT (predecessor);
1582 predecessor->total_length -= absorb;
1583 CHECK_TOTAL_LENGTH (predecessor);
1586 /* This must be the leftmost or first interval and cannot
1587 be merged left. The caller should have known. */
1588 abort ();
1591 /* Make an exact copy of interval tree SOURCE which descends from
1592 PARENT. This is done by recursing through SOURCE, copying
1593 the current interval and its properties, and then adjusting
1594 the pointers of the copy. */
1596 static INTERVAL
1597 reproduce_tree (source, parent)
1598 INTERVAL source, parent;
1600 register INTERVAL t = make_interval ();
1602 bcopy (source, t, INTERVAL_SIZE);
1603 copy_properties (source, t);
1604 SET_INTERVAL_PARENT (t, parent);
1605 if (! NULL_LEFT_CHILD (source))
1606 t->left = reproduce_tree (source->left, t);
1607 if (! NULL_RIGHT_CHILD (source))
1608 t->right = reproduce_tree (source->right, t);
1610 return t;
1613 static INTERVAL
1614 reproduce_tree_obj (source, parent)
1615 INTERVAL source;
1616 Lisp_Object parent;
1618 register INTERVAL t = make_interval ();
1620 bcopy (source, t, INTERVAL_SIZE);
1621 copy_properties (source, t);
1622 SET_INTERVAL_OBJECT (t, parent);
1623 if (! NULL_LEFT_CHILD (source))
1624 t->left = reproduce_tree (source->left, t);
1625 if (! NULL_RIGHT_CHILD (source))
1626 t->right = reproduce_tree (source->right, t);
1628 return t;
1631 #if 0
1632 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1634 /* Make a new interval of length LENGTH starting at START in the
1635 group of intervals INTERVALS, which is actually an interval tree.
1636 Returns the new interval.
1638 Generate an error if the new positions would overlap an existing
1639 interval. */
1641 static INTERVAL
1642 make_new_interval (intervals, start, length)
1643 INTERVAL intervals;
1644 int start, length;
1646 INTERVAL slot;
1648 slot = find_interval (intervals, start);
1649 if (start + length > slot->position + LENGTH (slot))
1650 error ("Interval would overlap");
1652 if (start == slot->position && length == LENGTH (slot))
1653 return slot;
1655 if (slot->position == start)
1657 /* New right node. */
1658 split_interval_right (slot, length);
1659 return slot;
1662 if (slot->position + LENGTH (slot) == start + length)
1664 /* New left node. */
1665 split_interval_left (slot, LENGTH (slot) - length);
1666 return slot;
1669 /* Convert interval SLOT into three intervals. */
1670 split_interval_left (slot, start - slot->position);
1671 split_interval_right (slot, length);
1672 return slot;
1674 #endif
1676 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1677 LENGTH is the length of the text in SOURCE.
1679 The `position' field of the SOURCE intervals is assumed to be
1680 consistent with its parent; therefore, SOURCE must be an
1681 interval tree made with copy_interval or must be the whole
1682 tree of a buffer or a string.
1684 This is used in insdel.c when inserting Lisp_Strings into the
1685 buffer. The text corresponding to SOURCE is already in the buffer
1686 when this is called. The intervals of new tree are a copy of those
1687 belonging to the string being inserted; intervals are never
1688 shared.
1690 If the inserted text had no intervals associated, and we don't
1691 want to inherit the surrounding text's properties, this function
1692 simply returns -- offset_intervals should handle placing the
1693 text in the correct interval, depending on the sticky bits.
1695 If the inserted text had properties (intervals), then there are two
1696 cases -- either insertion happened in the middle of some interval,
1697 or between two intervals.
1699 If the text goes into the middle of an interval, then new
1700 intervals are created in the middle with only the properties of
1701 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1702 which case the new text has the union of its properties and those
1703 of the text into which it was inserted.
1705 If the text goes between two intervals, then if neither interval
1706 had its appropriate sticky property set (front_sticky, rear_sticky),
1707 the new text has only its properties. If one of the sticky properties
1708 is set, then the new text "sticks" to that region and its properties
1709 depend on merging as above. If both the preceding and succeeding
1710 intervals to the new text are "sticky", then the new text retains
1711 only its properties, as if neither sticky property were set. Perhaps
1712 we should consider merging all three sets of properties onto the new
1713 text... */
1715 void
1716 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1717 INTERVAL source;
1718 int position, length;
1719 struct buffer *buffer;
1720 int inherit;
1722 register INTERVAL under, over, this, prev;
1723 register INTERVAL tree;
1724 int over_used;
1726 tree = BUF_INTERVALS (buffer);
1728 /* If the new text has no properties, then with inheritance it
1729 becomes part of whatever interval it was inserted into.
1730 To prevent inheritance, we must clear out the properties
1731 of the newly inserted text. */
1732 if (NULL_INTERVAL_P (source))
1734 Lisp_Object buf;
1735 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1737 XSETBUFFER (buf, buffer);
1738 set_text_properties_1 (make_number (position),
1739 make_number (position + length),
1740 Qnil, buf, 0);
1742 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1743 /* Shouldn't be necessary. -stef */
1744 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1745 return;
1748 if (NULL_INTERVAL_P (tree))
1750 /* The inserted text constitutes the whole buffer, so
1751 simply copy over the interval structure. */
1752 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1754 Lisp_Object buf;
1755 XSETBUFFER (buf, buffer);
1756 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1757 BUF_INTERVALS (buffer)->position = BEG;
1758 BUF_INTERVALS (buffer)->up_obj = 1;
1760 /* Explicitly free the old tree here? */
1762 return;
1765 /* Create an interval tree in which to place a copy
1766 of the intervals of the inserted string. */
1768 Lisp_Object buf;
1769 XSETBUFFER (buf, buffer);
1770 tree = create_root_interval (buf);
1773 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1774 /* If the buffer contains only the new string, but
1775 there was already some interval tree there, then it may be
1776 some zero length intervals. Eventually, do something clever
1777 about inserting properly. For now, just waste the old intervals. */
1779 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1780 BUF_INTERVALS (buffer)->position = BEG;
1781 BUF_INTERVALS (buffer)->up_obj = 1;
1782 /* Explicitly free the old tree here. */
1784 return;
1786 /* Paranoia -- the text has already been added, so this buffer
1787 should be of non-zero length. */
1788 else if (TOTAL_LENGTH (tree) == 0)
1789 abort ();
1791 this = under = find_interval (tree, position);
1792 if (NULL_INTERVAL_P (under)) /* Paranoia */
1793 abort ();
1794 over = find_interval (source, interval_start_pos (source));
1796 /* Here for insertion in the middle of an interval.
1797 Split off an equivalent interval to the right,
1798 then don't bother with it any more. */
1800 if (position > under->position)
1802 INTERVAL end_unchanged
1803 = split_interval_left (this, position - under->position);
1804 copy_properties (under, end_unchanged);
1805 under->position = position;
1807 else
1809 /* This call may have some effect because previous_interval may
1810 update `position' fields of intervals. Thus, don't ignore it
1811 for the moment. Someone please tell me the truth (K.Handa). */
1812 prev = previous_interval (under);
1813 #if 0
1814 /* But, this code surely has no effect. And, anyway,
1815 END_NONSTICKY_P is unreliable now. */
1816 if (prev && !END_NONSTICKY_P (prev))
1817 prev = 0;
1818 #endif /* 0 */
1821 /* Insertion is now at beginning of UNDER. */
1823 /* The inserted text "sticks" to the interval `under',
1824 which means it gets those properties.
1825 The properties of under are the result of
1826 adjust_intervals_for_insertion, so stickiness has
1827 already been taken care of. */
1829 /* OVER is the interval we are copying from next.
1830 OVER_USED says how many characters' worth of OVER
1831 have already been copied into target intervals.
1832 UNDER is the next interval in the target. */
1833 over_used = 0;
1834 while (! NULL_INTERVAL_P (over))
1836 /* If UNDER is longer than OVER, split it. */
1837 if (LENGTH (over) - over_used < LENGTH (under))
1839 this = split_interval_left (under, LENGTH (over) - over_used);
1840 copy_properties (under, this);
1842 else
1843 this = under;
1845 /* THIS is now the interval to copy or merge into.
1846 OVER covers all of it. */
1847 if (inherit)
1848 merge_properties (over, this);
1849 else
1850 copy_properties (over, this);
1852 /* If THIS and OVER end at the same place,
1853 advance OVER to a new source interval. */
1854 if (LENGTH (this) == LENGTH (over) - over_used)
1856 over = next_interval (over);
1857 over_used = 0;
1859 else
1860 /* Otherwise just record that more of OVER has been used. */
1861 over_used += LENGTH (this);
1863 /* Always advance to a new target interval. */
1864 under = next_interval (this);
1867 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1868 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1869 return;
1872 /* Get the value of property PROP from PLIST,
1873 which is the plist of an interval.
1874 We check for direct properties, for categories with property PROP,
1875 and for PROP appearing on the default-text-properties list. */
1877 Lisp_Object
1878 textget (plist, prop)
1879 Lisp_Object plist;
1880 register Lisp_Object prop;
1882 return lookup_char_property (plist, prop, 1);
1885 Lisp_Object
1886 lookup_char_property (plist, prop, textprop)
1887 Lisp_Object plist;
1888 register Lisp_Object prop;
1889 int textprop;
1891 register Lisp_Object tail, fallback = Qnil;
1893 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1895 register Lisp_Object tem;
1896 tem = XCAR (tail);
1897 if (EQ (prop, tem))
1898 return Fcar (XCDR (tail));
1899 if (EQ (tem, Qcategory))
1901 tem = Fcar (XCDR (tail));
1902 if (SYMBOLP (tem))
1903 fallback = Fget (tem, prop);
1907 if (! NILP (fallback))
1908 return fallback;
1909 /* Check for alternative properties */
1910 tail = Fassq (prop, Vchar_property_alias_alist);
1911 if (! NILP (tail))
1913 tail = XCDR (tail);
1914 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1915 fallback = Fplist_get (plist, XCAR (tail));
1918 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1919 fallback = Fplist_get (Vdefault_text_properties, prop);
1920 return fallback;
1924 /* Set point "temporarily", without checking any text properties. */
1926 INLINE void
1927 temp_set_point (struct buffer *buffer, EMACS_INT charpos)
1929 temp_set_point_both (buffer, charpos,
1930 buf_charpos_to_bytepos (buffer, charpos));
1933 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1934 byte position BYTEPOS. */
1936 INLINE void
1937 temp_set_point_both (struct buffer *buffer,
1938 EMACS_INT charpos, EMACS_INT bytepos)
1940 /* In a single-byte buffer, the two positions must be equal. */
1941 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1942 && charpos != bytepos)
1943 abort ();
1945 if (charpos > bytepos)
1946 abort ();
1948 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1949 abort ();
1951 BUF_PT_BYTE (buffer) = bytepos;
1952 BUF_PT (buffer) = charpos;
1955 /* Set point in BUFFER to CHARPOS. If the target position is
1956 before an intangible character, move to an ok place. */
1958 void
1959 set_point (EMACS_INT charpos)
1961 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1964 /* If there's an invisible character at position POS + TEST_OFFS in the
1965 current buffer, and the invisible property has a `stickiness' such that
1966 inserting a character at position POS would inherit the property it,
1967 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1968 then intangibility is required as well as invisibleness.
1970 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1972 Note that `stickiness' is determined by overlay marker insertion types,
1973 if the invisible property comes from an overlay. */
1975 static int
1976 adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1977 int pos, test_offs, adj, test_intang;
1979 Lisp_Object invis_propval, invis_overlay;
1980 Lisp_Object test_pos;
1982 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1983 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1984 return pos;
1986 test_pos = make_number (pos + test_offs);
1988 invis_propval
1989 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1990 &invis_overlay);
1992 if ((!test_intang
1993 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1994 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1995 /* This next test is true if the invisible property has a stickiness
1996 such that an insertion at POS would inherit it. */
1997 && (NILP (invis_overlay)
1998 /* Invisible property is from a text-property. */
1999 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
2000 == (test_offs == 0 ? 1 : -1))
2001 /* Invisible property is from an overlay. */
2002 : (test_offs == 0
2003 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
2004 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
2005 pos += adj;
2007 return pos;
2010 /* Set point in BUFFER to CHARPOS, which corresponds to byte
2011 position BYTEPOS. If the target position is
2012 before an intangible character, move to an ok place. */
2014 void
2015 set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
2017 register INTERVAL to, from, toprev, fromprev;
2018 EMACS_INT buffer_point;
2019 EMACS_INT old_position = PT;
2020 /* This ensures that we move forward past intangible text when the
2021 initial position is the same as the destination, in the rare
2022 instances where this is important, e.g. in line-move-finish
2023 (simple.el). */
2024 int backwards = (charpos < old_position ? 1 : 0);
2025 int have_overlays;
2026 EMACS_INT original_position;
2028 current_buffer->point_before_scroll = Qnil;
2030 if (charpos == PT)
2031 return;
2033 /* In a single-byte buffer, the two positions must be equal. */
2034 eassert (ZV != ZV_BYTE || charpos == bytepos);
2036 /* Check this now, before checking if the buffer has any intervals.
2037 That way, we can catch conditions which break this sanity check
2038 whether or not there are intervals in the buffer. */
2039 eassert (charpos <= ZV && charpos >= BEGV);
2041 have_overlays = (current_buffer->overlays_before
2042 || current_buffer->overlays_after);
2044 /* If we have no text properties and overlays,
2045 then we can do it quickly. */
2046 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
2048 temp_set_point_both (current_buffer, charpos, bytepos);
2049 return;
2052 /* Set TO to the interval containing the char after CHARPOS,
2053 and TOPREV to the interval containing the char before CHARPOS.
2054 Either one may be null. They may be equal. */
2055 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2056 if (charpos == BEGV)
2057 toprev = 0;
2058 else if (to && to->position == charpos)
2059 toprev = previous_interval (to);
2060 else
2061 toprev = to;
2063 buffer_point = (PT == ZV ? ZV - 1 : PT);
2065 /* Set FROM to the interval containing the char after PT,
2066 and FROMPREV to the interval containing the char before PT.
2067 Either one may be null. They may be equal. */
2068 /* We could cache this and save time. */
2069 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2070 if (buffer_point == BEGV)
2071 fromprev = 0;
2072 else if (from && from->position == PT)
2073 fromprev = previous_interval (from);
2074 else if (buffer_point != PT)
2075 fromprev = from, from = 0;
2076 else
2077 fromprev = from;
2079 /* Moving within an interval. */
2080 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2081 && ! have_overlays)
2083 temp_set_point_both (current_buffer, charpos, bytepos);
2084 return;
2087 original_position = charpos;
2089 /* If the new position is between two intangible characters
2090 with the same intangible property value,
2091 move forward or backward until a change in that property. */
2092 if (NILP (Vinhibit_point_motion_hooks)
2093 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2094 || have_overlays)
2095 /* Intangibility never stops us from positioning at the beginning
2096 or end of the buffer, so don't bother checking in that case. */
2097 && charpos != BEGV && charpos != ZV)
2099 Lisp_Object pos;
2100 Lisp_Object intangible_propval;
2102 if (backwards)
2104 /* If the preceding character is both intangible and invisible,
2105 and the invisible property is `rear-sticky', perturb it so
2106 that the search starts one character earlier -- this ensures
2107 that point can never move to the end of an invisible/
2108 intangible/rear-sticky region. */
2109 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2111 XSETINT (pos, charpos);
2113 /* If following char is intangible,
2114 skip back over all chars with matching intangible property. */
2116 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2118 if (! NILP (intangible_propval))
2120 while (XINT (pos) > BEGV
2121 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2122 Qintangible, Qnil),
2123 intangible_propval))
2124 pos = Fprevious_char_property_change (pos, Qnil);
2126 /* Set CHARPOS from POS, and if the final intangible character
2127 that we skipped over is also invisible, and the invisible
2128 property is `front-sticky', perturb it to be one character
2129 earlier -- this ensures that point can never move to the
2130 beginning of an invisible/intangible/front-sticky region. */
2131 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2134 else
2136 /* If the following character is both intangible and invisible,
2137 and the invisible property is `front-sticky', perturb it so
2138 that the search starts one character later -- this ensures
2139 that point can never move to the beginning of an
2140 invisible/intangible/front-sticky region. */
2141 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2143 XSETINT (pos, charpos);
2145 /* If preceding char is intangible,
2146 skip forward over all chars with matching intangible property. */
2148 intangible_propval = Fget_char_property (make_number (charpos - 1),
2149 Qintangible, Qnil);
2151 if (! NILP (intangible_propval))
2153 while (XINT (pos) < ZV
2154 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2155 intangible_propval))
2156 pos = Fnext_char_property_change (pos, Qnil);
2158 /* Set CHARPOS from POS, and if the final intangible character
2159 that we skipped over is also invisible, and the invisible
2160 property is `rear-sticky', perturb it to be one character
2161 later -- this ensures that point can never move to the
2162 end of an invisible/intangible/rear-sticky region. */
2163 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2167 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2170 if (charpos != original_position)
2172 /* Set TO to the interval containing the char after CHARPOS,
2173 and TOPREV to the interval containing the char before CHARPOS.
2174 Either one may be null. They may be equal. */
2175 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2176 if (charpos == BEGV)
2177 toprev = 0;
2178 else if (to && to->position == charpos)
2179 toprev = previous_interval (to);
2180 else
2181 toprev = to;
2184 /* Here TO is the interval after the stopping point
2185 and TOPREV is the interval before the stopping point.
2186 One or the other may be null. */
2188 temp_set_point_both (current_buffer, charpos, bytepos);
2190 /* We run point-left and point-entered hooks here, if the
2191 two intervals are not equivalent. These hooks take
2192 (old_point, new_point) as arguments. */
2193 if (NILP (Vinhibit_point_motion_hooks)
2194 && (! intervals_equal (from, to)
2195 || ! intervals_equal (fromprev, toprev)))
2197 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2199 if (fromprev)
2200 leave_before = textget (fromprev->plist, Qpoint_left);
2201 else
2202 leave_before = Qnil;
2204 if (from)
2205 leave_after = textget (from->plist, Qpoint_left);
2206 else
2207 leave_after = Qnil;
2209 if (toprev)
2210 enter_before = textget (toprev->plist, Qpoint_entered);
2211 else
2212 enter_before = Qnil;
2214 if (to)
2215 enter_after = textget (to->plist, Qpoint_entered);
2216 else
2217 enter_after = Qnil;
2219 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2220 call2 (leave_before, make_number (old_position),
2221 make_number (charpos));
2222 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2223 call2 (leave_after, make_number (old_position),
2224 make_number (charpos));
2226 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2227 call2 (enter_before, make_number (old_position),
2228 make_number (charpos));
2229 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2230 call2 (enter_after, make_number (old_position),
2231 make_number (charpos));
2235 /* Move point to POSITION, unless POSITION is inside an intangible
2236 segment that reaches all the way to point. */
2238 void
2239 move_if_not_intangible (position)
2240 int position;
2242 Lisp_Object pos;
2243 Lisp_Object intangible_propval;
2245 XSETINT (pos, position);
2247 if (! NILP (Vinhibit_point_motion_hooks))
2248 /* If intangible is inhibited, always move point to POSITION. */
2250 else if (PT < position && XINT (pos) < ZV)
2252 /* We want to move forward, so check the text before POSITION. */
2254 intangible_propval = Fget_char_property (pos,
2255 Qintangible, Qnil);
2257 /* If following char is intangible,
2258 skip back over all chars with matching intangible property. */
2259 if (! NILP (intangible_propval))
2260 while (XINT (pos) > BEGV
2261 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2262 Qintangible, Qnil),
2263 intangible_propval))
2264 pos = Fprevious_char_property_change (pos, Qnil);
2266 else if (XINT (pos) > BEGV)
2268 /* We want to move backward, so check the text after POSITION. */
2270 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2271 Qintangible, Qnil);
2273 /* If following char is intangible,
2274 skip forward over all chars with matching intangible property. */
2275 if (! NILP (intangible_propval))
2276 while (XINT (pos) < ZV
2277 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2278 intangible_propval))
2279 pos = Fnext_char_property_change (pos, Qnil);
2282 else if (position < BEGV)
2283 position = BEGV;
2284 else if (position > ZV)
2285 position = ZV;
2287 /* If the whole stretch between PT and POSITION isn't intangible,
2288 try moving to POSITION (which means we actually move farther
2289 if POSITION is inside of intangible text). */
2291 if (XINT (pos) != PT)
2292 SET_PT (position);
2295 /* If text at position POS has property PROP, set *VAL to the property
2296 value, *START and *END to the beginning and end of a region that
2297 has the same property, and return 1. Otherwise return 0.
2299 OBJECT is the string or buffer to look for the property in;
2300 nil means the current buffer. */
2303 get_property_and_range (pos, prop, val, start, end, object)
2304 int pos;
2305 Lisp_Object prop, *val;
2306 EMACS_INT *start, *end;
2307 Lisp_Object object;
2309 INTERVAL i, prev, next;
2311 if (NILP (object))
2312 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2313 else if (BUFFERP (object))
2314 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2315 else if (STRINGP (object))
2316 i = find_interval (STRING_INTERVALS (object), pos);
2317 else
2318 abort ();
2320 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2321 return 0;
2322 *val = textget (i->plist, prop);
2323 if (NILP (*val))
2324 return 0;
2326 next = i; /* remember it in advance */
2327 prev = previous_interval (i);
2328 while (! NULL_INTERVAL_P (prev)
2329 && EQ (*val, textget (prev->plist, prop)))
2330 i = prev, prev = previous_interval (prev);
2331 *start = i->position;
2333 next = next_interval (i);
2334 while (! NULL_INTERVAL_P (next)
2335 && EQ (*val, textget (next->plist, prop)))
2336 i = next, next = next_interval (next);
2337 *end = i->position + LENGTH (i);
2339 return 1;
2342 /* Return the proper local keymap TYPE for position POSITION in
2343 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2344 specified by the PROP property, if any. Otherwise, if TYPE is
2345 `local-map' use BUFFER's local map.
2347 POSITION must be in the accessible part of BUFFER. */
2349 Lisp_Object
2350 get_local_map (position, buffer, type)
2351 register int position;
2352 register struct buffer *buffer;
2353 Lisp_Object type;
2355 Lisp_Object prop, lispy_position, lispy_buffer;
2356 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2358 /* Perhaps we should just change `position' to the limit. */
2359 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2360 abort ();
2362 /* Ignore narrowing, so that a local map continues to be valid even if
2363 the visible region contains no characters and hence no properties. */
2364 old_begv = BUF_BEGV (buffer);
2365 old_zv = BUF_ZV (buffer);
2366 old_begv_byte = BUF_BEGV_BYTE (buffer);
2367 old_zv_byte = BUF_ZV_BYTE (buffer);
2368 BUF_BEGV (buffer) = BUF_BEG (buffer);
2369 BUF_ZV (buffer) = BUF_Z (buffer);
2370 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2371 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2373 XSETFASTINT (lispy_position, position);
2374 XSETBUFFER (lispy_buffer, buffer);
2375 /* First check if the CHAR has any property. This is because when
2376 we click with the mouse, the mouse pointer is really pointing
2377 to the CHAR after POS. */
2378 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2379 /* If not, look at the POS's properties. This is necessary because when
2380 editing a field with a `local-map' property, we want insertion at the end
2381 to obey the `local-map' property. */
2382 if (NILP (prop))
2383 prop = get_pos_property (lispy_position, type, lispy_buffer);
2385 BUF_BEGV (buffer) = old_begv;
2386 BUF_ZV (buffer) = old_zv;
2387 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2388 BUF_ZV_BYTE (buffer) = old_zv_byte;
2390 /* Use the local map only if it is valid. */
2391 prop = get_keymap (prop, 0, 0);
2392 if (CONSP (prop))
2393 return prop;
2395 if (EQ (type, Qkeymap))
2396 return Qnil;
2397 else
2398 return buffer->keymap;
2401 /* Produce an interval tree reflecting the intervals in
2402 TREE from START to START + LENGTH.
2403 The new interval tree has no parent and has a starting-position of 0. */
2405 INTERVAL
2406 copy_intervals (tree, start, length)
2407 INTERVAL tree;
2408 int start, length;
2410 register INTERVAL i, new, t;
2411 register int got, prevlen;
2413 if (NULL_INTERVAL_P (tree) || length <= 0)
2414 return NULL_INTERVAL;
2416 i = find_interval (tree, start);
2417 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2418 abort ();
2420 /* If there is only one interval and it's the default, return nil. */
2421 if ((start - i->position + 1 + length) < LENGTH (i)
2422 && DEFAULT_INTERVAL_P (i))
2423 return NULL_INTERVAL;
2425 new = make_interval ();
2426 new->position = 0;
2427 got = (LENGTH (i) - (start - i->position));
2428 new->total_length = length;
2429 CHECK_TOTAL_LENGTH (new);
2430 copy_properties (i, new);
2432 t = new;
2433 prevlen = got;
2434 while (got < length)
2436 i = next_interval (i);
2437 t = split_interval_right (t, prevlen);
2438 copy_properties (i, t);
2439 prevlen = LENGTH (i);
2440 got += prevlen;
2443 return balance_an_interval (new);
2446 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2448 INLINE void
2449 copy_intervals_to_string (string, buffer, position, length)
2450 Lisp_Object string;
2451 struct buffer *buffer;
2452 int position, length;
2454 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2455 position, length);
2456 if (NULL_INTERVAL_P (interval_copy))
2457 return;
2459 SET_INTERVAL_OBJECT (interval_copy, string);
2460 STRING_SET_INTERVALS (string, interval_copy);
2463 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2464 Assume they have identical characters. */
2467 compare_string_intervals (s1, s2)
2468 Lisp_Object s1, s2;
2470 INTERVAL i1, i2;
2471 int pos = 0;
2472 int end = SCHARS (s1);
2474 i1 = find_interval (STRING_INTERVALS (s1), 0);
2475 i2 = find_interval (STRING_INTERVALS (s2), 0);
2477 while (pos < end)
2479 /* Determine how far we can go before we reach the end of I1 or I2. */
2480 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2481 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2482 int distance = min (len1, len2);
2484 /* If we ever find a mismatch between the strings,
2485 they differ. */
2486 if (! intervals_equal (i1, i2))
2487 return 0;
2489 /* Advance POS till the end of the shorter interval,
2490 and advance one or both interval pointers for the new position. */
2491 pos += distance;
2492 if (len1 == distance)
2493 i1 = next_interval (i1);
2494 if (len2 == distance)
2495 i2 = next_interval (i2);
2497 return 1;
2500 /* Recursively adjust interval I in the current buffer
2501 for setting enable_multibyte_characters to MULTI_FLAG.
2502 The range of interval I is START ... END in characters,
2503 START_BYTE ... END_BYTE in bytes. */
2505 static void
2506 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2507 INTERVAL i;
2508 int multi_flag;
2509 int start, start_byte, end, end_byte;
2511 /* Fix the length of this interval. */
2512 if (multi_flag)
2513 i->total_length = end - start;
2514 else
2515 i->total_length = end_byte - start_byte;
2516 CHECK_TOTAL_LENGTH (i);
2518 if (TOTAL_LENGTH (i) == 0)
2520 delete_interval (i);
2521 return;
2524 /* Recursively fix the length of the subintervals. */
2525 if (i->left)
2527 int left_end, left_end_byte;
2529 if (multi_flag)
2531 int temp;
2532 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2533 left_end = BYTE_TO_CHAR (left_end_byte);
2535 temp = CHAR_TO_BYTE (left_end);
2537 /* If LEFT_END_BYTE is in the middle of a character,
2538 adjust it and LEFT_END to a char boundary. */
2539 if (left_end_byte > temp)
2541 left_end_byte = temp;
2543 if (left_end_byte < temp)
2545 left_end--;
2546 left_end_byte = CHAR_TO_BYTE (left_end);
2549 else
2551 left_end = start + LEFT_TOTAL_LENGTH (i);
2552 left_end_byte = CHAR_TO_BYTE (left_end);
2555 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2556 left_end, left_end_byte);
2558 if (i->right)
2560 int right_start_byte, right_start;
2562 if (multi_flag)
2564 int temp;
2566 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2567 right_start = BYTE_TO_CHAR (right_start_byte);
2569 /* If RIGHT_START_BYTE is in the middle of a character,
2570 adjust it and RIGHT_START to a char boundary. */
2571 temp = CHAR_TO_BYTE (right_start);
2573 if (right_start_byte < temp)
2575 right_start_byte = temp;
2577 if (right_start_byte > temp)
2579 right_start++;
2580 right_start_byte = CHAR_TO_BYTE (right_start);
2583 else
2585 right_start = end - RIGHT_TOTAL_LENGTH (i);
2586 right_start_byte = CHAR_TO_BYTE (right_start);
2589 set_intervals_multibyte_1 (i->right, multi_flag,
2590 right_start, right_start_byte,
2591 end, end_byte);
2594 /* Rounding to char boundaries can theoretically ake this interval
2595 spurious. If so, delete one child, and copy its property list
2596 to this interval. */
2597 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2599 if ((i)->left)
2601 (i)->plist = (i)->left->plist;
2602 (i)->left->total_length = 0;
2603 delete_interval ((i)->left);
2605 else
2607 (i)->plist = (i)->right->plist;
2608 (i)->right->total_length = 0;
2609 delete_interval ((i)->right);
2614 /* Update the intervals of the current buffer
2615 to fit the contents as multibyte (if MULTI_FLAG is 1)
2616 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2618 void
2619 set_intervals_multibyte (multi_flag)
2620 int multi_flag;
2622 if (BUF_INTERVALS (current_buffer))
2623 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2624 BEG, BEG_BYTE, Z, Z_BYTE);
2627 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2628 (do not change this comment) */