merge emacs-23
[emacs.git] / src / intervals.c
blobd47888b237cc2a38815b94c6634f6b1b63df5f15
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009, 2010, 2011 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 <setjmp.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "buffer.h"
46 #include "puresize.h"
47 #include "keyboard.h"
48 #include "keymap.h"
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
51 universal set. */
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
55 Lisp_Object merge_properties_sticky ();
56 static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
57 static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
59 /* Utility functions for intervals. */
62 /* Create the root interval of some object, a buffer or string. */
64 INTERVAL
65 create_root_interval (parent)
66 Lisp_Object parent;
68 INTERVAL new;
70 CHECK_IMPURE (parent);
72 new = make_interval ();
74 if (BUFFERP (parent))
76 new->total_length = (BUF_Z (XBUFFER (parent))
77 - BUF_BEG (XBUFFER (parent)));
78 CHECK_TOTAL_LENGTH (new);
79 BUF_INTERVALS (XBUFFER (parent)) = new;
80 new->position = BEG;
82 else if (STRINGP (parent))
84 new->total_length = SCHARS (parent);
85 CHECK_TOTAL_LENGTH (new);
86 STRING_SET_INTERVALS (parent, new);
87 new->position = 0;
90 SET_INTERVAL_OBJECT (new, parent);
92 return new;
95 /* Make the interval TARGET have exactly the properties of SOURCE */
97 void
98 copy_properties (source, target)
99 register INTERVAL source, target;
101 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
102 return;
104 COPY_INTERVAL_CACHE (source, target);
105 target->plist = Fcopy_sequence (source->plist);
108 /* Merge the properties of interval SOURCE into the properties
109 of interval TARGET. That is to say, each property in SOURCE
110 is added to TARGET if TARGET has no such property as yet. */
112 static void
113 merge_properties (source, target)
114 register INTERVAL source, target;
116 register Lisp_Object o, sym, val;
118 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
119 return;
121 MERGE_INTERVAL_CACHE (source, target);
123 o = source->plist;
124 while (CONSP (o))
126 sym = XCAR (o);
127 o = XCDR (o);
128 CHECK_CONS (o);
130 val = target->plist;
131 while (CONSP (val) && !EQ (XCAR (val), sym))
133 val = XCDR (val);
134 if (!CONSP (val))
135 break;
136 val = XCDR (val);
139 if (NILP (val))
141 val = XCAR (o);
142 target->plist = Fcons (sym, Fcons (val, target->plist));
144 o = XCDR (o);
148 /* Return 1 if the two intervals have the same properties,
149 0 otherwise. */
152 intervals_equal (i0, i1)
153 INTERVAL i0, i1;
155 register Lisp_Object i0_cdr, i0_sym;
156 register Lisp_Object i1_cdr, i1_val;
158 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
159 return 1;
161 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
162 return 0;
164 i0_cdr = i0->plist;
165 i1_cdr = i1->plist;
166 while (CONSP (i0_cdr) && CONSP (i1_cdr))
168 i0_sym = XCAR (i0_cdr);
169 i0_cdr = XCDR (i0_cdr);
170 if (!CONSP (i0_cdr))
171 return 0; /* abort (); */
172 i1_val = i1->plist;
173 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
175 i1_val = XCDR (i1_val);
176 if (!CONSP (i1_val))
177 return 0; /* abort (); */
178 i1_val = XCDR (i1_val);
181 /* i0 has something i1 doesn't. */
182 if (EQ (i1_val, Qnil))
183 return 0;
185 /* i0 and i1 both have sym, but it has different values in each. */
186 if (!CONSP (i1_val)
187 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
188 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
189 return 0;
191 i0_cdr = XCDR (i0_cdr);
193 i1_cdr = XCDR (i1_cdr);
194 if (!CONSP (i1_cdr))
195 return 0; /* abort (); */
196 i1_cdr = XCDR (i1_cdr);
199 /* Lengths of the two plists were equal. */
200 return (NILP (i0_cdr) && NILP (i1_cdr));
204 /* Traverse an interval tree TREE, performing FUNCTION on each node.
205 No guarantee is made about the order of traversal.
206 Pass FUNCTION two args: an interval, and ARG. */
208 void
209 traverse_intervals_noorder (tree, function, arg)
210 INTERVAL tree;
211 void (* function) P_ ((INTERVAL, Lisp_Object));
212 Lisp_Object arg;
214 /* Minimize stack usage. */
215 while (!NULL_INTERVAL_P (tree))
217 (*function) (tree, arg);
218 if (NULL_INTERVAL_P (tree->right))
219 tree = tree->left;
220 else
222 traverse_intervals_noorder (tree->left, function, arg);
223 tree = tree->right;
228 /* Traverse an interval tree TREE, performing FUNCTION on each node.
229 Pass FUNCTION two args: an interval, and ARG. */
231 void
232 traverse_intervals (tree, position, function, arg)
233 INTERVAL tree;
234 int position;
235 void (* function) P_ ((INTERVAL, Lisp_Object));
236 Lisp_Object arg;
238 while (!NULL_INTERVAL_P (tree))
240 traverse_intervals (tree->left, position, function, arg);
241 position += LEFT_TOTAL_LENGTH (tree);
242 tree->position = position;
243 (*function) (tree, arg);
244 position += LENGTH (tree); tree = tree->right;
248 #if 0
250 static int icount;
251 static int idepth;
252 static int zero_length;
254 /* These functions are temporary, for debugging purposes only. */
256 INTERVAL search_interval, found_interval;
258 void
259 check_for_interval (i)
260 register INTERVAL i;
262 if (i == search_interval)
264 found_interval = i;
265 icount++;
269 INTERVAL
270 search_for_interval (i, tree)
271 register INTERVAL i, tree;
273 icount = 0;
274 search_interval = i;
275 found_interval = NULL_INTERVAL;
276 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
277 return found_interval;
280 static void
281 inc_interval_count (i)
282 INTERVAL i;
284 icount++;
285 if (LENGTH (i) == 0)
286 zero_length++;
287 if (depth > idepth)
288 idepth = depth;
292 count_intervals (i)
293 register INTERVAL i;
295 icount = 0;
296 idepth = 0;
297 zero_length = 0;
298 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
300 return icount;
303 static INTERVAL
304 root_interval (interval)
305 INTERVAL interval;
307 register INTERVAL i = interval;
309 while (! ROOT_INTERVAL_P (i))
310 i = INTERVAL_PARENT (i);
312 return i;
314 #endif
316 /* Assuming that a left child exists, perform the following operation:
319 / \ / \
320 B => A
321 / \ / \
325 static INLINE INTERVAL
326 rotate_right (interval)
327 INTERVAL interval;
329 INTERVAL i;
330 INTERVAL B = interval->left;
331 int old_total = interval->total_length;
333 /* Deal with any Parent of A; make it point to B. */
334 if (! ROOT_INTERVAL_P (interval))
336 if (AM_LEFT_CHILD (interval))
337 INTERVAL_PARENT (interval)->left = B;
338 else
339 INTERVAL_PARENT (interval)->right = B;
341 COPY_INTERVAL_PARENT (B, interval);
343 /* Make B the parent of A */
344 i = B->right;
345 B->right = interval;
346 SET_INTERVAL_PARENT (interval, B);
348 /* Make A point to c */
349 interval->left = i;
350 if (! NULL_INTERVAL_P (i))
351 SET_INTERVAL_PARENT (i, interval);
353 /* A's total length is decreased by the length of B and its left child. */
354 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
355 CHECK_TOTAL_LENGTH (interval);
357 /* B must have the same total length of A. */
358 B->total_length = old_total;
359 CHECK_TOTAL_LENGTH (B);
361 return B;
364 /* Assuming that a right child exists, perform the following operation:
367 / \ / \
368 B => A
369 / \ / \
373 static INLINE INTERVAL
374 rotate_left (interval)
375 INTERVAL interval;
377 INTERVAL i;
378 INTERVAL B = interval->right;
379 int old_total = interval->total_length;
381 /* Deal with any parent of A; make it point to B. */
382 if (! ROOT_INTERVAL_P (interval))
384 if (AM_LEFT_CHILD (interval))
385 INTERVAL_PARENT (interval)->left = B;
386 else
387 INTERVAL_PARENT (interval)->right = B;
389 COPY_INTERVAL_PARENT (B, interval);
391 /* Make B the parent of A */
392 i = B->left;
393 B->left = interval;
394 SET_INTERVAL_PARENT (interval, B);
396 /* Make A point to c */
397 interval->right = i;
398 if (! NULL_INTERVAL_P (i))
399 SET_INTERVAL_PARENT (i, interval);
401 /* A's total length is decreased by the length of B and its right child. */
402 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
403 CHECK_TOTAL_LENGTH (interval);
405 /* B must have the same total length of A. */
406 B->total_length = old_total;
407 CHECK_TOTAL_LENGTH (B);
409 return B;
412 /* Balance an interval tree with the assumption that the subtrees
413 themselves are already balanced. */
415 static INTERVAL
416 balance_an_interval (i)
417 INTERVAL i;
419 register int old_diff, new_diff;
421 while (1)
423 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
424 if (old_diff > 0)
426 /* Since the left child is longer, there must be one. */
427 new_diff = i->total_length - i->left->total_length
428 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
429 if (eabs (new_diff) >= old_diff)
430 break;
431 i = rotate_right (i);
432 balance_an_interval (i->right);
434 else if (old_diff < 0)
436 /* Since the right child is longer, there must be one. */
437 new_diff = i->total_length - i->right->total_length
438 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
439 if (eabs (new_diff) >= -old_diff)
440 break;
441 i = rotate_left (i);
442 balance_an_interval (i->left);
444 else
445 break;
447 return i;
450 /* Balance INTERVAL, potentially stuffing it back into its parent
451 Lisp Object. */
453 static INLINE INTERVAL
454 balance_possible_root_interval (interval)
455 register INTERVAL interval;
457 Lisp_Object parent;
458 int have_parent = 0;
460 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
461 return interval;
463 if (INTERVAL_HAS_OBJECT (interval))
465 have_parent = 1;
466 GET_INTERVAL_OBJECT (parent, interval);
468 interval = balance_an_interval (interval);
470 if (have_parent)
472 if (BUFFERP (parent))
473 BUF_INTERVALS (XBUFFER (parent)) = interval;
474 else if (STRINGP (parent))
475 STRING_SET_INTERVALS (parent, interval);
478 return interval;
481 /* Balance the interval tree TREE. Balancing is by weight
482 (the amount of text). */
484 static INTERVAL
485 balance_intervals_internal (tree)
486 register INTERVAL tree;
488 /* Balance within each side. */
489 if (tree->left)
490 balance_intervals_internal (tree->left);
491 if (tree->right)
492 balance_intervals_internal (tree->right);
493 return balance_an_interval (tree);
496 /* Advertised interface to balance intervals. */
498 INTERVAL
499 balance_intervals (tree)
500 INTERVAL tree;
502 if (tree == NULL_INTERVAL)
503 return NULL_INTERVAL;
505 return balance_intervals_internal (tree);
508 /* Split INTERVAL into two pieces, starting the second piece at
509 character position OFFSET (counting from 0), relative to INTERVAL.
510 INTERVAL becomes the left-hand piece, and the right-hand piece
511 (second, lexicographically) is returned.
513 The size and position fields of the two intervals are set based upon
514 those of the original interval. The property list of the new interval
515 is reset, thus it is up to the caller to do the right thing with the
516 result.
518 Note that this does not change the position of INTERVAL; if it is a root,
519 it is still a root after this operation. */
521 INTERVAL
522 split_interval_right (interval, offset)
523 INTERVAL interval;
524 int offset;
526 INTERVAL new = make_interval ();
527 int position = interval->position;
528 int new_length = LENGTH (interval) - offset;
530 new->position = position + offset;
531 SET_INTERVAL_PARENT (new, interval);
533 if (NULL_RIGHT_CHILD (interval))
535 interval->right = new;
536 new->total_length = new_length;
537 CHECK_TOTAL_LENGTH (new);
539 else
541 /* Insert the new node between INTERVAL and its right child. */
542 new->right = interval->right;
543 SET_INTERVAL_PARENT (interval->right, new);
544 interval->right = new;
545 new->total_length = new_length + new->right->total_length;
546 CHECK_TOTAL_LENGTH (new);
547 balance_an_interval (new);
550 balance_possible_root_interval (interval);
552 return new;
555 /* Split INTERVAL into two pieces, starting the second piece at
556 character position OFFSET (counting from 0), relative to INTERVAL.
557 INTERVAL becomes the right-hand piece, and the left-hand piece
558 (first, lexicographically) is returned.
560 The size and position fields of the two intervals are set based upon
561 those of the original interval. The property list of the new interval
562 is reset, thus it is up to the caller to do the right thing with the
563 result.
565 Note that this does not change the position of INTERVAL; if it is a root,
566 it is still a root after this operation. */
568 INTERVAL
569 split_interval_left (interval, offset)
570 INTERVAL interval;
571 int offset;
573 INTERVAL new = make_interval ();
574 int new_length = offset;
576 new->position = interval->position;
577 interval->position = interval->position + offset;
578 SET_INTERVAL_PARENT (new, interval);
580 if (NULL_LEFT_CHILD (interval))
582 interval->left = new;
583 new->total_length = new_length;
584 CHECK_TOTAL_LENGTH (new);
586 else
588 /* Insert the new node between INTERVAL and its left child. */
589 new->left = interval->left;
590 SET_INTERVAL_PARENT (new->left, new);
591 interval->left = new;
592 new->total_length = new_length + new->left->total_length;
593 CHECK_TOTAL_LENGTH (new);
594 balance_an_interval (new);
597 balance_possible_root_interval (interval);
599 return new;
602 /* Return the proper position for the first character
603 described by the interval tree SOURCE.
604 This is 1 if the parent is a buffer,
605 0 if the parent is a string or if there is no parent.
607 Don't use this function on an interval which is the child
608 of another interval! */
611 interval_start_pos (source)
612 INTERVAL source;
614 Lisp_Object parent;
616 if (NULL_INTERVAL_P (source))
617 return 0;
619 if (! INTERVAL_HAS_OBJECT (source))
620 return 0;
621 GET_INTERVAL_OBJECT (parent, source);
622 if (BUFFERP (parent))
623 return BUF_BEG (XBUFFER (parent));
624 return 0;
627 /* Find the interval containing text position POSITION in the text
628 represented by the interval tree TREE. POSITION is a buffer
629 position (starting from 1) or a string index (starting from 0).
630 If POSITION is at the end of the buffer or string,
631 return the interval containing the last character.
633 The `position' field, which is a cache of an interval's position,
634 is updated in the interval found. Other functions (e.g., next_interval)
635 will update this cache based on the result of find_interval. */
637 INTERVAL
638 find_interval (tree, position)
639 register INTERVAL tree;
640 register int position;
642 /* The distance from the left edge of the subtree at TREE
643 to POSITION. */
644 register int relative_position;
646 if (NULL_INTERVAL_P (tree))
647 return NULL_INTERVAL;
649 relative_position = position;
650 if (INTERVAL_HAS_OBJECT (tree))
652 Lisp_Object parent;
653 GET_INTERVAL_OBJECT (parent, tree);
654 if (BUFFERP (parent))
655 relative_position -= BUF_BEG (XBUFFER (parent));
658 if (relative_position > TOTAL_LENGTH (tree))
659 abort (); /* Paranoia */
661 if (!handling_signal)
662 tree = balance_possible_root_interval (tree);
664 while (1)
666 if (relative_position < LEFT_TOTAL_LENGTH (tree))
668 tree = tree->left;
670 else if (! NULL_RIGHT_CHILD (tree)
671 && relative_position >= (TOTAL_LENGTH (tree)
672 - RIGHT_TOTAL_LENGTH (tree)))
674 relative_position -= (TOTAL_LENGTH (tree)
675 - RIGHT_TOTAL_LENGTH (tree));
676 tree = tree->right;
678 else
680 tree->position
681 = (position - relative_position /* left edge of *tree. */
682 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
684 return tree;
689 /* Find the succeeding interval (lexicographically) to INTERVAL.
690 Sets the `position' field based on that of INTERVAL (see
691 find_interval). */
693 INTERVAL
694 next_interval (interval)
695 register INTERVAL interval;
697 register INTERVAL i = interval;
698 register int next_position;
700 if (NULL_INTERVAL_P (i))
701 return NULL_INTERVAL;
702 next_position = interval->position + LENGTH (interval);
704 if (! NULL_RIGHT_CHILD (i))
706 i = i->right;
707 while (! NULL_LEFT_CHILD (i))
708 i = i->left;
710 i->position = next_position;
711 return i;
714 while (! NULL_PARENT (i))
716 if (AM_LEFT_CHILD (i))
718 i = INTERVAL_PARENT (i);
719 i->position = next_position;
720 return i;
723 i = INTERVAL_PARENT (i);
726 return NULL_INTERVAL;
729 /* Find the preceding interval (lexicographically) to INTERVAL.
730 Sets the `position' field based on that of INTERVAL (see
731 find_interval). */
733 INTERVAL
734 previous_interval (interval)
735 register INTERVAL interval;
737 register INTERVAL i;
739 if (NULL_INTERVAL_P (interval))
740 return NULL_INTERVAL;
742 if (! NULL_LEFT_CHILD (interval))
744 i = interval->left;
745 while (! NULL_RIGHT_CHILD (i))
746 i = i->right;
748 i->position = interval->position - LENGTH (i);
749 return i;
752 i = interval;
753 while (! NULL_PARENT (i))
755 if (AM_RIGHT_CHILD (i))
757 i = INTERVAL_PARENT (i);
759 i->position = interval->position - LENGTH (i);
760 return i;
762 i = INTERVAL_PARENT (i);
765 return NULL_INTERVAL;
768 /* Find the interval containing POS given some non-NULL INTERVAL
769 in the same tree. Note that we need to update interval->position
770 if we go down the tree.
771 To speed up the process, we assume that the ->position of
772 I and all its parents is already uptodate. */
773 INTERVAL
774 update_interval (i, pos)
775 register INTERVAL i;
776 int pos;
778 if (NULL_INTERVAL_P (i))
779 return NULL_INTERVAL;
781 while (1)
783 if (pos < i->position)
785 /* Move left. */
786 if (pos >= i->position - TOTAL_LENGTH (i->left))
788 i->left->position = i->position - TOTAL_LENGTH (i->left)
789 + LEFT_TOTAL_LENGTH (i->left);
790 i = i->left; /* Move to the left child */
792 else if (NULL_PARENT (i))
793 error ("Point before start of properties");
794 else
795 i = INTERVAL_PARENT (i);
796 continue;
798 else if (pos >= INTERVAL_LAST_POS (i))
800 /* Move right. */
801 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
803 i->right->position = INTERVAL_LAST_POS (i)
804 + LEFT_TOTAL_LENGTH (i->right);
805 i = i->right; /* Move to the right child */
807 else if (NULL_PARENT (i))
808 error ("Point %d after end of properties", pos);
809 else
810 i = INTERVAL_PARENT (i);
811 continue;
813 else
814 return i;
819 #if 0
820 /* Traverse a path down the interval tree TREE to the interval
821 containing POSITION, adjusting all nodes on the path for
822 an addition of LENGTH characters. Insertion between two intervals
823 (i.e., point == i->position, where i is second interval) means
824 text goes into second interval.
826 Modifications are needed to handle the hungry bits -- after simply
827 finding the interval at position (don't add length going down),
828 if it's the beginning of the interval, get the previous interval
829 and check the hungry bits of both. Then add the length going back up
830 to the root. */
832 static INTERVAL
833 adjust_intervals_for_insertion (tree, position, length)
834 INTERVAL tree;
835 int position, length;
837 register int relative_position;
838 register INTERVAL this;
840 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
841 abort ();
843 /* If inserting at point-max of a buffer, that position
844 will be out of range */
845 if (position > TOTAL_LENGTH (tree))
846 position = TOTAL_LENGTH (tree);
847 relative_position = position;
848 this = tree;
850 while (1)
852 if (relative_position <= LEFT_TOTAL_LENGTH (this))
854 this->total_length += length;
855 CHECK_TOTAL_LENGTH (this);
856 this = this->left;
858 else if (relative_position > (TOTAL_LENGTH (this)
859 - RIGHT_TOTAL_LENGTH (this)))
861 relative_position -= (TOTAL_LENGTH (this)
862 - RIGHT_TOTAL_LENGTH (this));
863 this->total_length += length;
864 CHECK_TOTAL_LENGTH (this);
865 this = this->right;
867 else
869 /* If we are to use zero-length intervals as buffer pointers,
870 then this code will have to change. */
871 this->total_length += length;
872 CHECK_TOTAL_LENGTH (this);
873 this->position = LEFT_TOTAL_LENGTH (this)
874 + position - relative_position + 1;
875 return tree;
879 #endif
881 /* Effect an adjustment corresponding to the addition of LENGTH characters
882 of text. Do this by finding the interval containing POSITION in the
883 interval tree TREE, and then adjusting all of its ancestors by adding
884 LENGTH to them.
886 If POSITION is the first character of an interval, meaning that point
887 is actually between the two intervals, make the new text belong to
888 the interval which is "sticky".
890 If both intervals are "sticky", then make them belong to the left-most
891 interval. Another possibility would be to create a new interval for
892 this text, and make it have the merged properties of both ends. */
894 static INTERVAL
895 adjust_intervals_for_insertion (tree, position, length)
896 INTERVAL tree;
897 int position, length;
899 register INTERVAL i;
900 register INTERVAL temp;
901 int eobp = 0;
902 Lisp_Object parent;
903 int offset;
905 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
906 abort ();
908 GET_INTERVAL_OBJECT (parent, tree);
909 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
911 /* If inserting at point-max of a buffer, that position will be out
912 of range. Remember that buffer positions are 1-based. */
913 if (position >= TOTAL_LENGTH (tree) + offset)
915 position = TOTAL_LENGTH (tree) + offset;
916 eobp = 1;
919 i = find_interval (tree, position);
921 /* If in middle of an interval which is not sticky either way,
922 we must not just give its properties to the insertion.
923 So split this interval at the insertion point.
925 Originally, the if condition here was this:
926 (! (position == i->position || eobp)
927 && END_NONSTICKY_P (i)
928 && FRONT_NONSTICKY_P (i))
929 But, these macros are now unreliable because of introduction of
930 Vtext_property_default_nonsticky. So, we always check properties
931 one by one if POSITION is in middle of an interval. */
932 if (! (position == i->position || eobp))
934 Lisp_Object tail;
935 Lisp_Object front, rear;
937 tail = i->plist;
939 /* Properties font-sticky and rear-nonsticky override
940 Vtext_property_default_nonsticky. So, if they are t, we can
941 skip one by one checking of properties. */
942 rear = textget (i->plist, Qrear_nonsticky);
943 if (! CONSP (rear) && ! NILP (rear))
945 /* All properties are nonsticky. We split the interval. */
946 goto check_done;
948 front = textget (i->plist, Qfront_sticky);
949 if (! CONSP (front) && ! NILP (front))
951 /* All properties are sticky. We don't split the interval. */
952 tail = Qnil;
953 goto check_done;
956 /* Does any actual property pose an actual problem? We break
957 the loop if we find a nonsticky property. */
958 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
960 Lisp_Object prop, tmp;
961 prop = XCAR (tail);
963 /* Is this particular property front-sticky? */
964 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
965 continue;
967 /* Is this particular property rear-nonsticky? */
968 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
969 break;
971 /* Is this particular property recorded as sticky or
972 nonsticky in Vtext_property_default_nonsticky? */
973 tmp = Fassq (prop, Vtext_property_default_nonsticky);
974 if (CONSP (tmp))
976 if (NILP (tmp))
977 continue;
978 break;
981 /* By default, a text property is rear-sticky, thus we
982 continue the loop. */
985 check_done:
986 /* If any property is a real problem, split the interval. */
987 if (! NILP (tail))
989 temp = split_interval_right (i, position - i->position);
990 copy_properties (i, temp);
991 i = temp;
995 /* If we are positioned between intervals, check the stickiness of
996 both of them. We have to do this too, if we are at BEG or Z. */
997 if (position == i->position || eobp)
999 register INTERVAL prev;
1001 if (position == BEG)
1002 prev = 0;
1003 else if (eobp)
1005 prev = i;
1006 i = 0;
1008 else
1009 prev = previous_interval (i);
1011 /* Even if we are positioned between intervals, we default
1012 to the left one if it exists. We extend it now and split
1013 off a part later, if stickiness demands it. */
1014 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1016 temp->total_length += length;
1017 CHECK_TOTAL_LENGTH (temp);
1018 temp = balance_possible_root_interval (temp);
1021 /* If at least one interval has sticky properties,
1022 we check the stickiness property by property.
1024 Originally, the if condition here was this:
1025 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1026 But, these macros are now unreliable because of introduction
1027 of Vtext_property_default_nonsticky. So, we always have to
1028 check stickiness of properties one by one. If cache of
1029 stickiness is implemented in the future, we may be able to
1030 use those macros again. */
1031 if (1)
1033 Lisp_Object pleft, pright;
1034 struct interval newi;
1036 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1037 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1038 newi.plist = merge_properties_sticky (pleft, pright);
1040 if (! prev) /* i.e. position == BEG */
1042 if (! intervals_equal (i, &newi))
1044 i = split_interval_left (i, length);
1045 i->plist = newi.plist;
1048 else if (! intervals_equal (prev, &newi))
1050 prev = split_interval_right (prev,
1051 position - prev->position);
1052 prev->plist = newi.plist;
1053 if (! NULL_INTERVAL_P (i)
1054 && intervals_equal (prev, i))
1055 merge_interval_right (prev);
1058 /* We will need to update the cache here later. */
1060 else if (! prev && ! NILP (i->plist))
1062 /* Just split off a new interval at the left.
1063 Since I wasn't front-sticky, the empty plist is ok. */
1064 i = split_interval_left (i, length);
1068 /* Otherwise just extend the interval. */
1069 else
1071 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1073 temp->total_length += length;
1074 CHECK_TOTAL_LENGTH (temp);
1075 temp = balance_possible_root_interval (temp);
1079 return tree;
1082 /* Any property might be front-sticky on the left, rear-sticky on the left,
1083 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1084 can be arranged in a matrix with rows denoting the left conditions and
1085 columns denoting the right conditions:
1086 _ __ _
1087 _ FR FR FR FR
1088 FR__ 0 1 2 3
1089 _FR 4 5 6 7
1090 FR 8 9 A B
1091 FR C D E F
1093 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1094 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1095 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1096 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1097 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1098 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1099 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1100 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1102 We inherit from whoever has a sticky side facing us. If both sides
1103 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1104 non-nil value for the current property. If both sides do, then we take
1105 from the left.
1107 When we inherit a property, we get its stickiness as well as its value.
1108 So, when we merge the above two lists, we expect to get this:
1110 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1111 rear-nonsticky (p6 pa)
1112 p0 L p1 L p2 L p3 L p6 R p7 R
1113 pa R pb R pc L pd L pe L pf L)
1115 The optimizable special cases are:
1116 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1117 left rear-nonsticky = t, right front-sticky = t (inherit right)
1118 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1121 Lisp_Object
1122 merge_properties_sticky (pleft, pright)
1123 Lisp_Object pleft, pright;
1125 register Lisp_Object props, front, rear;
1126 Lisp_Object lfront, lrear, rfront, rrear;
1127 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1128 int use_left, use_right;
1129 int lpresent;
1131 props = Qnil;
1132 front = Qnil;
1133 rear = Qnil;
1134 lfront = textget (pleft, Qfront_sticky);
1135 lrear = textget (pleft, Qrear_nonsticky);
1136 rfront = textget (pright, Qfront_sticky);
1137 rrear = textget (pright, Qrear_nonsticky);
1139 /* Go through each element of PRIGHT. */
1140 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1142 Lisp_Object tmp;
1144 sym = XCAR (tail1);
1146 /* Sticky properties get special treatment. */
1147 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1148 continue;
1150 rval = Fcar (XCDR (tail1));
1151 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1152 if (EQ (sym, XCAR (tail2)))
1153 break;
1155 /* Indicate whether the property is explicitly defined on the left.
1156 (We know it is defined explicitly on the right
1157 because otherwise we don't get here.) */
1158 lpresent = ! NILP (tail2);
1159 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1161 /* Even if lrear or rfront say nothing about the stickiness of
1162 SYM, Vtext_property_default_nonsticky may give default
1163 stickiness to SYM. */
1164 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1165 use_left = (lpresent
1166 && ! (TMEM (sym, lrear)
1167 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1168 use_right = (TMEM (sym, rfront)
1169 || (CONSP (tmp) && NILP (XCDR (tmp))));
1170 if (use_left && use_right)
1172 if (NILP (lval))
1173 use_left = 0;
1174 else if (NILP (rval))
1175 use_right = 0;
1177 if (use_left)
1179 /* We build props as (value sym ...) rather than (sym value ...)
1180 because we plan to nreverse it when we're done. */
1181 props = Fcons (lval, Fcons (sym, props));
1182 if (TMEM (sym, lfront))
1183 front = Fcons (sym, front);
1184 if (TMEM (sym, lrear))
1185 rear = Fcons (sym, rear);
1187 else if (use_right)
1189 props = Fcons (rval, Fcons (sym, props));
1190 if (TMEM (sym, rfront))
1191 front = Fcons (sym, front);
1192 if (TMEM (sym, rrear))
1193 rear = Fcons (sym, rear);
1197 /* Now go through each element of PLEFT. */
1198 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1200 Lisp_Object tmp;
1202 sym = XCAR (tail2);
1204 /* Sticky properties get special treatment. */
1205 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1206 continue;
1208 /* If sym is in PRIGHT, we've already considered it. */
1209 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1210 if (EQ (sym, XCAR (tail1)))
1211 break;
1212 if (! NILP (tail1))
1213 continue;
1215 lval = Fcar (XCDR (tail2));
1217 /* Even if lrear or rfront say nothing about the stickiness of
1218 SYM, Vtext_property_default_nonsticky may give default
1219 stickiness to SYM. */
1220 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1222 /* Since rval is known to be nil in this loop, the test simplifies. */
1223 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1225 props = Fcons (lval, Fcons (sym, props));
1226 if (TMEM (sym, lfront))
1227 front = Fcons (sym, front);
1229 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1231 /* The value is nil, but we still inherit the stickiness
1232 from the right. */
1233 front = Fcons (sym, front);
1234 if (TMEM (sym, rrear))
1235 rear = Fcons (sym, rear);
1238 props = Fnreverse (props);
1239 if (! NILP (rear))
1240 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1242 cat = textget (props, Qcategory);
1243 if (! NILP (front)
1245 /* If we have inherited a front-stick category property that is t,
1246 we don't need to set up a detailed one. */
1247 ! (! NILP (cat) && SYMBOLP (cat)
1248 && EQ (Fget (cat, Qfront_sticky), Qt)))
1249 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1250 return props;
1254 /* Delete a node I from its interval tree by merging its subtrees
1255 into one subtree which is then returned. Caller is responsible for
1256 storing the resulting subtree into its parent. */
1258 static INTERVAL
1259 delete_node (i)
1260 register INTERVAL i;
1262 register INTERVAL migrate, this;
1263 register int migrate_amt;
1265 if (NULL_INTERVAL_P (i->left))
1266 return i->right;
1267 if (NULL_INTERVAL_P (i->right))
1268 return i->left;
1270 migrate = i->left;
1271 migrate_amt = i->left->total_length;
1272 this = i->right;
1273 this->total_length += migrate_amt;
1274 while (! NULL_INTERVAL_P (this->left))
1276 this = this->left;
1277 this->total_length += migrate_amt;
1279 CHECK_TOTAL_LENGTH (this);
1280 this->left = migrate;
1281 SET_INTERVAL_PARENT (migrate, this);
1283 return i->right;
1286 /* Delete interval I from its tree by calling `delete_node'
1287 and properly connecting the resultant subtree.
1289 I is presumed to be empty; that is, no adjustments are made
1290 for the length of I. */
1292 void
1293 delete_interval (i)
1294 register INTERVAL i;
1296 register INTERVAL parent;
1297 int amt = LENGTH (i);
1299 if (amt > 0) /* Only used on zero-length intervals now. */
1300 abort ();
1302 if (ROOT_INTERVAL_P (i))
1304 Lisp_Object owner;
1305 GET_INTERVAL_OBJECT (owner, i);
1306 parent = delete_node (i);
1307 if (! NULL_INTERVAL_P (parent))
1308 SET_INTERVAL_OBJECT (parent, owner);
1310 if (BUFFERP (owner))
1311 BUF_INTERVALS (XBUFFER (owner)) = parent;
1312 else if (STRINGP (owner))
1313 STRING_SET_INTERVALS (owner, parent);
1314 else
1315 abort ();
1317 return;
1320 parent = INTERVAL_PARENT (i);
1321 if (AM_LEFT_CHILD (i))
1323 parent->left = delete_node (i);
1324 if (! NULL_INTERVAL_P (parent->left))
1325 SET_INTERVAL_PARENT (parent->left, parent);
1327 else
1329 parent->right = delete_node (i);
1330 if (! NULL_INTERVAL_P (parent->right))
1331 SET_INTERVAL_PARENT (parent->right, parent);
1335 /* Find the interval in TREE corresponding to the relative position
1336 FROM and delete as much as possible of AMOUNT from that interval.
1337 Return the amount actually deleted, and if the interval was
1338 zeroed-out, delete that interval node from the tree.
1340 Note that FROM is actually origin zero, aka relative to the
1341 leftmost edge of tree. This is appropriate since we call ourselves
1342 recursively on subtrees.
1344 Do this by recursing down TREE to the interval in question, and
1345 deleting the appropriate amount of text. */
1347 static int
1348 interval_deletion_adjustment (tree, from, amount)
1349 register INTERVAL tree;
1350 register int from, amount;
1352 register int relative_position = from;
1354 if (NULL_INTERVAL_P (tree))
1355 return 0;
1357 /* Left branch */
1358 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1360 int subtract = interval_deletion_adjustment (tree->left,
1361 relative_position,
1362 amount);
1363 tree->total_length -= subtract;
1364 CHECK_TOTAL_LENGTH (tree);
1365 return subtract;
1367 /* Right branch */
1368 else if (relative_position >= (TOTAL_LENGTH (tree)
1369 - RIGHT_TOTAL_LENGTH (tree)))
1371 int subtract;
1373 relative_position -= (tree->total_length
1374 - RIGHT_TOTAL_LENGTH (tree));
1375 subtract = interval_deletion_adjustment (tree->right,
1376 relative_position,
1377 amount);
1378 tree->total_length -= subtract;
1379 CHECK_TOTAL_LENGTH (tree);
1380 return subtract;
1382 /* Here -- this node. */
1383 else
1385 /* How much can we delete from this interval? */
1386 int my_amount = ((tree->total_length
1387 - RIGHT_TOTAL_LENGTH (tree))
1388 - relative_position);
1390 if (amount > my_amount)
1391 amount = my_amount;
1393 tree->total_length -= amount;
1394 CHECK_TOTAL_LENGTH (tree);
1395 if (LENGTH (tree) == 0)
1396 delete_interval (tree);
1398 return amount;
1401 /* Never reach here. */
1404 /* Effect the adjustments necessary to the interval tree of BUFFER to
1405 correspond to the deletion of LENGTH characters from that buffer
1406 text. The deletion is effected at position START (which is a
1407 buffer position, i.e. origin 1). */
1409 static void
1410 adjust_intervals_for_deletion (buffer, start, length)
1411 struct buffer *buffer;
1412 int start, length;
1414 register int left_to_delete = length;
1415 register INTERVAL tree = BUF_INTERVALS (buffer);
1416 Lisp_Object parent;
1417 int offset;
1419 GET_INTERVAL_OBJECT (parent, tree);
1420 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1422 if (NULL_INTERVAL_P (tree))
1423 return;
1425 if (start > offset + TOTAL_LENGTH (tree)
1426 || start + length > offset + TOTAL_LENGTH (tree))
1427 abort ();
1429 if (length == TOTAL_LENGTH (tree))
1431 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1432 return;
1435 if (ONLY_INTERVAL_P (tree))
1437 tree->total_length -= length;
1438 CHECK_TOTAL_LENGTH (tree);
1439 return;
1442 if (start > offset + TOTAL_LENGTH (tree))
1443 start = offset + TOTAL_LENGTH (tree);
1444 while (left_to_delete > 0)
1446 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1447 left_to_delete);
1448 tree = BUF_INTERVALS (buffer);
1449 if (left_to_delete == tree->total_length)
1451 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1452 return;
1457 /* Make the adjustments necessary to the interval tree of BUFFER to
1458 represent an addition or deletion of LENGTH characters starting
1459 at position START. Addition or deletion is indicated by the sign
1460 of LENGTH. */
1462 INLINE void
1463 offset_intervals (buffer, start, length)
1464 struct buffer *buffer;
1465 int start, length;
1467 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1468 return;
1470 if (length > 0)
1471 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1472 else
1473 adjust_intervals_for_deletion (buffer, start, -length);
1476 /* Merge interval I with its lexicographic successor. The resulting
1477 interval is returned, and has the properties of the original
1478 successor. The properties of I are lost. I is removed from the
1479 interval tree.
1481 IMPORTANT:
1482 The caller must verify that this is not the last (rightmost)
1483 interval. */
1485 INTERVAL
1486 merge_interval_right (i)
1487 register INTERVAL i;
1489 register int absorb = LENGTH (i);
1490 register INTERVAL successor;
1492 /* Zero out this interval. */
1493 i->total_length -= absorb;
1494 CHECK_TOTAL_LENGTH (i);
1496 /* Find the succeeding interval. */
1497 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1498 as we descend. */
1500 successor = i->right;
1501 while (! NULL_LEFT_CHILD (successor))
1503 successor->total_length += absorb;
1504 CHECK_TOTAL_LENGTH (successor);
1505 successor = successor->left;
1508 successor->total_length += absorb;
1509 CHECK_TOTAL_LENGTH (successor);
1510 delete_interval (i);
1511 return successor;
1514 successor = i;
1515 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1516 we ascend. */
1518 if (AM_LEFT_CHILD (successor))
1520 successor = INTERVAL_PARENT (successor);
1521 delete_interval (i);
1522 return successor;
1525 successor = INTERVAL_PARENT (successor);
1526 successor->total_length -= absorb;
1527 CHECK_TOTAL_LENGTH (successor);
1530 /* This must be the rightmost or last interval and cannot
1531 be merged right. The caller should have known. */
1532 abort ();
1535 /* Merge interval I with its lexicographic predecessor. The resulting
1536 interval is returned, and has the properties of the original predecessor.
1537 The properties of I are lost. Interval node I is removed from the tree.
1539 IMPORTANT:
1540 The caller must verify that this is not the first (leftmost) interval. */
1542 INTERVAL
1543 merge_interval_left (i)
1544 register INTERVAL i;
1546 register int absorb = LENGTH (i);
1547 register INTERVAL predecessor;
1549 /* Zero out this interval. */
1550 i->total_length -= absorb;
1551 CHECK_TOTAL_LENGTH (i);
1553 /* Find the preceding interval. */
1554 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1555 adding ABSORB as we go. */
1557 predecessor = i->left;
1558 while (! NULL_RIGHT_CHILD (predecessor))
1560 predecessor->total_length += absorb;
1561 CHECK_TOTAL_LENGTH (predecessor);
1562 predecessor = predecessor->right;
1565 predecessor->total_length += absorb;
1566 CHECK_TOTAL_LENGTH (predecessor);
1567 delete_interval (i);
1568 return predecessor;
1571 predecessor = i;
1572 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1573 subtracting ABSORB. */
1575 if (AM_RIGHT_CHILD (predecessor))
1577 predecessor = INTERVAL_PARENT (predecessor);
1578 delete_interval (i);
1579 return predecessor;
1582 predecessor = INTERVAL_PARENT (predecessor);
1583 predecessor->total_length -= absorb;
1584 CHECK_TOTAL_LENGTH (predecessor);
1587 /* This must be the leftmost or first interval and cannot
1588 be merged left. The caller should have known. */
1589 abort ();
1592 /* Make an exact copy of interval tree SOURCE which descends from
1593 PARENT. This is done by recursing through SOURCE, copying
1594 the current interval and its properties, and then adjusting
1595 the pointers of the copy. */
1597 static INTERVAL
1598 reproduce_tree (source, parent)
1599 INTERVAL source, parent;
1601 register INTERVAL t = make_interval ();
1603 bcopy (source, t, INTERVAL_SIZE);
1604 copy_properties (source, t);
1605 SET_INTERVAL_PARENT (t, parent);
1606 if (! NULL_LEFT_CHILD (source))
1607 t->left = reproduce_tree (source->left, t);
1608 if (! NULL_RIGHT_CHILD (source))
1609 t->right = reproduce_tree (source->right, t);
1611 return t;
1614 static INTERVAL
1615 reproduce_tree_obj (source, parent)
1616 INTERVAL source;
1617 Lisp_Object parent;
1619 register INTERVAL t = make_interval ();
1621 bcopy (source, t, INTERVAL_SIZE);
1622 copy_properties (source, t);
1623 SET_INTERVAL_OBJECT (t, parent);
1624 if (! NULL_LEFT_CHILD (source))
1625 t->left = reproduce_tree (source->left, t);
1626 if (! NULL_RIGHT_CHILD (source))
1627 t->right = reproduce_tree (source->right, t);
1629 return t;
1632 #if 0
1633 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1635 /* Make a new interval of length LENGTH starting at START in the
1636 group of intervals INTERVALS, which is actually an interval tree.
1637 Returns the new interval.
1639 Generate an error if the new positions would overlap an existing
1640 interval. */
1642 static INTERVAL
1643 make_new_interval (intervals, start, length)
1644 INTERVAL intervals;
1645 int start, length;
1647 INTERVAL slot;
1649 slot = find_interval (intervals, start);
1650 if (start + length > slot->position + LENGTH (slot))
1651 error ("Interval would overlap");
1653 if (start == slot->position && length == LENGTH (slot))
1654 return slot;
1656 if (slot->position == start)
1658 /* New right node. */
1659 split_interval_right (slot, length);
1660 return slot;
1663 if (slot->position + LENGTH (slot) == start + length)
1665 /* New left node. */
1666 split_interval_left (slot, LENGTH (slot) - length);
1667 return slot;
1670 /* Convert interval SLOT into three intervals. */
1671 split_interval_left (slot, start - slot->position);
1672 split_interval_right (slot, length);
1673 return slot;
1675 #endif
1677 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1678 LENGTH is the length of the text in SOURCE.
1680 The `position' field of the SOURCE intervals is assumed to be
1681 consistent with its parent; therefore, SOURCE must be an
1682 interval tree made with copy_interval or must be the whole
1683 tree of a buffer or a string.
1685 This is used in insdel.c when inserting Lisp_Strings into the
1686 buffer. The text corresponding to SOURCE is already in the buffer
1687 when this is called. The intervals of new tree are a copy of those
1688 belonging to the string being inserted; intervals are never
1689 shared.
1691 If the inserted text had no intervals associated, and we don't
1692 want to inherit the surrounding text's properties, this function
1693 simply returns -- offset_intervals should handle placing the
1694 text in the correct interval, depending on the sticky bits.
1696 If the inserted text had properties (intervals), then there are two
1697 cases -- either insertion happened in the middle of some interval,
1698 or between two intervals.
1700 If the text goes into the middle of an interval, then new
1701 intervals are created in the middle with only the properties of
1702 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1703 which case the new text has the union of its properties and those
1704 of the text into which it was inserted.
1706 If the text goes between two intervals, then if neither interval
1707 had its appropriate sticky property set (front_sticky, rear_sticky),
1708 the new text has only its properties. If one of the sticky properties
1709 is set, then the new text "sticks" to that region and its properties
1710 depend on merging as above. If both the preceding and succeeding
1711 intervals to the new text are "sticky", then the new text retains
1712 only its properties, as if neither sticky property were set. Perhaps
1713 we should consider merging all three sets of properties onto the new
1714 text... */
1716 void
1717 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1718 INTERVAL source;
1719 int position, length;
1720 struct buffer *buffer;
1721 int inherit;
1723 register INTERVAL under, over, this, prev;
1724 register INTERVAL tree;
1725 int over_used;
1727 tree = BUF_INTERVALS (buffer);
1729 /* If the new text has no properties, then with inheritance it
1730 becomes part of whatever interval it was inserted into.
1731 To prevent inheritance, we must clear out the properties
1732 of the newly inserted text. */
1733 if (NULL_INTERVAL_P (source))
1735 Lisp_Object buf;
1736 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1738 XSETBUFFER (buf, buffer);
1739 set_text_properties_1 (make_number (position),
1740 make_number (position + length),
1741 Qnil, buf, 0);
1743 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1744 /* Shouldn't be necessary. -stef */
1745 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1746 return;
1749 if (NULL_INTERVAL_P (tree))
1751 /* The inserted text constitutes the whole buffer, so
1752 simply copy over the interval structure. */
1753 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1755 Lisp_Object buf;
1756 XSETBUFFER (buf, buffer);
1757 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1758 BUF_INTERVALS (buffer)->position = BEG;
1759 BUF_INTERVALS (buffer)->up_obj = 1;
1761 /* Explicitly free the old tree here? */
1763 return;
1766 /* Create an interval tree in which to place a copy
1767 of the intervals of the inserted string. */
1769 Lisp_Object buf;
1770 XSETBUFFER (buf, buffer);
1771 tree = create_root_interval (buf);
1774 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1775 /* If the buffer contains only the new string, but
1776 there was already some interval tree there, then it may be
1777 some zero length intervals. Eventually, do something clever
1778 about inserting properly. For now, just waste the old intervals. */
1780 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1781 BUF_INTERVALS (buffer)->position = BEG;
1782 BUF_INTERVALS (buffer)->up_obj = 1;
1783 /* Explicitly free the old tree here. */
1785 return;
1787 /* Paranoia -- the text has already been added, so this buffer
1788 should be of non-zero length. */
1789 else if (TOTAL_LENGTH (tree) == 0)
1790 abort ();
1792 this = under = find_interval (tree, position);
1793 if (NULL_INTERVAL_P (under)) /* Paranoia */
1794 abort ();
1795 over = find_interval (source, interval_start_pos (source));
1797 /* Here for insertion in the middle of an interval.
1798 Split off an equivalent interval to the right,
1799 then don't bother with it any more. */
1801 if (position > under->position)
1803 INTERVAL end_unchanged
1804 = split_interval_left (this, position - under->position);
1805 copy_properties (under, end_unchanged);
1806 under->position = position;
1808 else
1810 /* This call may have some effect because previous_interval may
1811 update `position' fields of intervals. Thus, don't ignore it
1812 for the moment. Someone please tell me the truth (K.Handa). */
1813 prev = previous_interval (under);
1814 #if 0
1815 /* But, this code surely has no effect. And, anyway,
1816 END_NONSTICKY_P is unreliable now. */
1817 if (prev && !END_NONSTICKY_P (prev))
1818 prev = 0;
1819 #endif /* 0 */
1822 /* Insertion is now at beginning of UNDER. */
1824 /* The inserted text "sticks" to the interval `under',
1825 which means it gets those properties.
1826 The properties of under are the result of
1827 adjust_intervals_for_insertion, so stickiness has
1828 already been taken care of. */
1830 /* OVER is the interval we are copying from next.
1831 OVER_USED says how many characters' worth of OVER
1832 have already been copied into target intervals.
1833 UNDER is the next interval in the target. */
1834 over_used = 0;
1835 while (! NULL_INTERVAL_P (over))
1837 /* If UNDER is longer than OVER, split it. */
1838 if (LENGTH (over) - over_used < LENGTH (under))
1840 this = split_interval_left (under, LENGTH (over) - over_used);
1841 copy_properties (under, this);
1843 else
1844 this = under;
1846 /* THIS is now the interval to copy or merge into.
1847 OVER covers all of it. */
1848 if (inherit)
1849 merge_properties (over, this);
1850 else
1851 copy_properties (over, this);
1853 /* If THIS and OVER end at the same place,
1854 advance OVER to a new source interval. */
1855 if (LENGTH (this) == LENGTH (over) - over_used)
1857 over = next_interval (over);
1858 over_used = 0;
1860 else
1861 /* Otherwise just record that more of OVER has been used. */
1862 over_used += LENGTH (this);
1864 /* Always advance to a new target interval. */
1865 under = next_interval (this);
1868 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1869 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1870 return;
1873 /* Get the value of property PROP from PLIST,
1874 which is the plist of an interval.
1875 We check for direct properties, for categories with property PROP,
1876 and for PROP appearing on the default-text-properties list. */
1878 Lisp_Object
1879 textget (plist, prop)
1880 Lisp_Object plist;
1881 register Lisp_Object prop;
1883 return lookup_char_property (plist, prop, 1);
1886 Lisp_Object
1887 lookup_char_property (plist, prop, textprop)
1888 Lisp_Object plist;
1889 register Lisp_Object prop;
1890 int textprop;
1892 register Lisp_Object tail, fallback = Qnil;
1894 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1896 register Lisp_Object tem;
1897 tem = XCAR (tail);
1898 if (EQ (prop, tem))
1899 return Fcar (XCDR (tail));
1900 if (EQ (tem, Qcategory))
1902 tem = Fcar (XCDR (tail));
1903 if (SYMBOLP (tem))
1904 fallback = Fget (tem, prop);
1908 if (! NILP (fallback))
1909 return fallback;
1910 /* Check for alternative properties */
1911 tail = Fassq (prop, Vchar_property_alias_alist);
1912 if (! NILP (tail))
1914 tail = XCDR (tail);
1915 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1916 fallback = Fplist_get (plist, XCAR (tail));
1919 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1920 fallback = Fplist_get (Vdefault_text_properties, prop);
1921 return fallback;
1925 /* Set point "temporarily", without checking any text properties. */
1927 INLINE void
1928 temp_set_point (struct buffer *buffer, EMACS_INT charpos)
1930 temp_set_point_both (buffer, charpos,
1931 buf_charpos_to_bytepos (buffer, charpos));
1934 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1935 byte position BYTEPOS. */
1937 INLINE void
1938 temp_set_point_both (struct buffer *buffer,
1939 EMACS_INT charpos, EMACS_INT bytepos)
1941 /* In a single-byte buffer, the two positions must be equal. */
1942 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1943 && charpos != bytepos)
1944 abort ();
1946 if (charpos > bytepos)
1947 abort ();
1949 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1950 abort ();
1952 BUF_PT_BYTE (buffer) = bytepos;
1953 BUF_PT (buffer) = charpos;
1956 /* Set point in BUFFER to CHARPOS. If the target position is
1957 before an intangible character, move to an ok place. */
1959 void
1960 set_point (EMACS_INT charpos)
1962 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1965 /* If there's an invisible character at position POS + TEST_OFFS in the
1966 current buffer, and the invisible property has a `stickiness' such that
1967 inserting a character at position POS would inherit the property it,
1968 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1969 then intangibility is required as well as invisibleness.
1971 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1973 Note that `stickiness' is determined by overlay marker insertion types,
1974 if the invisible property comes from an overlay. */
1976 static int
1977 adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1978 int pos, test_offs, adj, test_intang;
1980 Lisp_Object invis_propval, invis_overlay;
1981 Lisp_Object test_pos;
1983 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1984 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1985 return pos;
1987 test_pos = make_number (pos + test_offs);
1989 invis_propval
1990 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1991 &invis_overlay);
1993 if ((!test_intang
1994 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1995 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1996 /* This next test is true if the invisible property has a stickiness
1997 such that an insertion at POS would inherit it. */
1998 && (NILP (invis_overlay)
1999 /* Invisible property is from a text-property. */
2000 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
2001 == (test_offs == 0 ? 1 : -1))
2002 /* Invisible property is from an overlay. */
2003 : (test_offs == 0
2004 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
2005 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
2006 pos += adj;
2008 return pos;
2011 /* Set point in BUFFER to CHARPOS, which corresponds to byte
2012 position BYTEPOS. If the target position is
2013 before an intangible character, move to an ok place. */
2015 void
2016 set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
2018 register INTERVAL to, from, toprev, fromprev;
2019 EMACS_INT buffer_point;
2020 EMACS_INT old_position = PT;
2021 /* This ensures that we move forward past intangible text when the
2022 initial position is the same as the destination, in the rare
2023 instances where this is important, e.g. in line-move-finish
2024 (simple.el). */
2025 int backwards = (charpos < old_position ? 1 : 0);
2026 int have_overlays;
2027 EMACS_INT original_position;
2029 current_buffer->point_before_scroll = Qnil;
2031 if (charpos == PT)
2032 return;
2034 /* In a single-byte buffer, the two positions must be equal. */
2035 eassert (ZV != ZV_BYTE || charpos == bytepos);
2037 /* Check this now, before checking if the buffer has any intervals.
2038 That way, we can catch conditions which break this sanity check
2039 whether or not there are intervals in the buffer. */
2040 eassert (charpos <= ZV && charpos >= BEGV);
2042 have_overlays = (current_buffer->overlays_before
2043 || current_buffer->overlays_after);
2045 /* If we have no text properties and overlays,
2046 then we can do it quickly. */
2047 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
2049 temp_set_point_both (current_buffer, charpos, bytepos);
2050 return;
2053 /* Set TO to the interval containing the char after CHARPOS,
2054 and TOPREV to the interval containing the char before CHARPOS.
2055 Either one may be null. They may be equal. */
2056 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2057 if (charpos == BEGV)
2058 toprev = 0;
2059 else if (to && to->position == charpos)
2060 toprev = previous_interval (to);
2061 else
2062 toprev = to;
2064 buffer_point = (PT == ZV ? ZV - 1 : PT);
2066 /* Set FROM to the interval containing the char after PT,
2067 and FROMPREV to the interval containing the char before PT.
2068 Either one may be null. They may be equal. */
2069 /* We could cache this and save time. */
2070 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2071 if (buffer_point == BEGV)
2072 fromprev = 0;
2073 else if (from && from->position == PT)
2074 fromprev = previous_interval (from);
2075 else if (buffer_point != PT)
2076 fromprev = from, from = 0;
2077 else
2078 fromprev = from;
2080 /* Moving within an interval. */
2081 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2082 && ! have_overlays)
2084 temp_set_point_both (current_buffer, charpos, bytepos);
2085 return;
2088 original_position = charpos;
2090 /* If the new position is between two intangible characters
2091 with the same intangible property value,
2092 move forward or backward until a change in that property. */
2093 if (NILP (Vinhibit_point_motion_hooks)
2094 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2095 || have_overlays)
2096 /* Intangibility never stops us from positioning at the beginning
2097 or end of the buffer, so don't bother checking in that case. */
2098 && charpos != BEGV && charpos != ZV)
2100 Lisp_Object pos;
2101 Lisp_Object intangible_propval;
2103 if (backwards)
2105 /* If the preceding character is both intangible and invisible,
2106 and the invisible property is `rear-sticky', perturb it so
2107 that the search starts one character earlier -- this ensures
2108 that point can never move to the end of an invisible/
2109 intangible/rear-sticky region. */
2110 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2112 XSETINT (pos, charpos);
2114 /* If following char is intangible,
2115 skip back over all chars with matching intangible property. */
2117 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2119 if (! NILP (intangible_propval))
2121 while (XINT (pos) > BEGV
2122 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2123 Qintangible, Qnil),
2124 intangible_propval))
2125 pos = Fprevious_char_property_change (pos, Qnil);
2127 /* Set CHARPOS from POS, and if the final intangible character
2128 that we skipped over is also invisible, and the invisible
2129 property is `front-sticky', perturb it to be one character
2130 earlier -- this ensures that point can never move to the
2131 beginning of an invisible/intangible/front-sticky region. */
2132 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2135 else
2137 /* If the following character is both intangible and invisible,
2138 and the invisible property is `front-sticky', perturb it so
2139 that the search starts one character later -- this ensures
2140 that point can never move to the beginning of an
2141 invisible/intangible/front-sticky region. */
2142 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2144 XSETINT (pos, charpos);
2146 /* If preceding char is intangible,
2147 skip forward over all chars with matching intangible property. */
2149 intangible_propval = Fget_char_property (make_number (charpos - 1),
2150 Qintangible, Qnil);
2152 if (! NILP (intangible_propval))
2154 while (XINT (pos) < ZV
2155 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2156 intangible_propval))
2157 pos = Fnext_char_property_change (pos, Qnil);
2159 /* Set CHARPOS from POS, and if the final intangible character
2160 that we skipped over is also invisible, and the invisible
2161 property is `rear-sticky', perturb it to be one character
2162 later -- this ensures that point can never move to the
2163 end of an invisible/intangible/rear-sticky region. */
2164 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2168 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2171 if (charpos != original_position)
2173 /* Set TO to the interval containing the char after CHARPOS,
2174 and TOPREV to the interval containing the char before CHARPOS.
2175 Either one may be null. They may be equal. */
2176 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2177 if (charpos == BEGV)
2178 toprev = 0;
2179 else if (to && to->position == charpos)
2180 toprev = previous_interval (to);
2181 else
2182 toprev = to;
2185 /* Here TO is the interval after the stopping point
2186 and TOPREV is the interval before the stopping point.
2187 One or the other may be null. */
2189 temp_set_point_both (current_buffer, charpos, bytepos);
2191 /* We run point-left and point-entered hooks here, if the
2192 two intervals are not equivalent. These hooks take
2193 (old_point, new_point) as arguments. */
2194 if (NILP (Vinhibit_point_motion_hooks)
2195 && (! intervals_equal (from, to)
2196 || ! intervals_equal (fromprev, toprev)))
2198 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2200 if (fromprev)
2201 leave_before = textget (fromprev->plist, Qpoint_left);
2202 else
2203 leave_before = Qnil;
2205 if (from)
2206 leave_after = textget (from->plist, Qpoint_left);
2207 else
2208 leave_after = Qnil;
2210 if (toprev)
2211 enter_before = textget (toprev->plist, Qpoint_entered);
2212 else
2213 enter_before = Qnil;
2215 if (to)
2216 enter_after = textget (to->plist, Qpoint_entered);
2217 else
2218 enter_after = Qnil;
2220 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2221 call2 (leave_before, make_number (old_position),
2222 make_number (charpos));
2223 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2224 call2 (leave_after, make_number (old_position),
2225 make_number (charpos));
2227 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2228 call2 (enter_before, make_number (old_position),
2229 make_number (charpos));
2230 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2231 call2 (enter_after, make_number (old_position),
2232 make_number (charpos));
2236 /* Move point to POSITION, unless POSITION is inside an intangible
2237 segment that reaches all the way to point. */
2239 void
2240 move_if_not_intangible (position)
2241 int position;
2243 Lisp_Object pos;
2244 Lisp_Object intangible_propval;
2246 XSETINT (pos, position);
2248 if (! NILP (Vinhibit_point_motion_hooks))
2249 /* If intangible is inhibited, always move point to POSITION. */
2251 else if (PT < position && XINT (pos) < ZV)
2253 /* We want to move forward, so check the text before POSITION. */
2255 intangible_propval = Fget_char_property (pos,
2256 Qintangible, Qnil);
2258 /* If following char is intangible,
2259 skip back over all chars with matching intangible property. */
2260 if (! NILP (intangible_propval))
2261 while (XINT (pos) > BEGV
2262 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2263 Qintangible, Qnil),
2264 intangible_propval))
2265 pos = Fprevious_char_property_change (pos, Qnil);
2267 else if (XINT (pos) > BEGV)
2269 /* We want to move backward, so check the text after POSITION. */
2271 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2272 Qintangible, Qnil);
2274 /* If following char is intangible,
2275 skip forward over all chars with matching intangible property. */
2276 if (! NILP (intangible_propval))
2277 while (XINT (pos) < ZV
2278 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2279 intangible_propval))
2280 pos = Fnext_char_property_change (pos, Qnil);
2283 else if (position < BEGV)
2284 position = BEGV;
2285 else if (position > ZV)
2286 position = ZV;
2288 /* If the whole stretch between PT and POSITION isn't intangible,
2289 try moving to POSITION (which means we actually move farther
2290 if POSITION is inside of intangible text). */
2292 if (XINT (pos) != PT)
2293 SET_PT (position);
2296 /* If text at position POS has property PROP, set *VAL to the property
2297 value, *START and *END to the beginning and end of a region that
2298 has the same property, and return 1. Otherwise return 0.
2300 OBJECT is the string or buffer to look for the property in;
2301 nil means the current buffer. */
2304 get_property_and_range (pos, prop, val, start, end, object)
2305 int pos;
2306 Lisp_Object prop, *val;
2307 EMACS_INT *start, *end;
2308 Lisp_Object object;
2310 INTERVAL i, prev, next;
2312 if (NILP (object))
2313 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2314 else if (BUFFERP (object))
2315 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2316 else if (STRINGP (object))
2317 i = find_interval (STRING_INTERVALS (object), pos);
2318 else
2319 abort ();
2321 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2322 return 0;
2323 *val = textget (i->plist, prop);
2324 if (NILP (*val))
2325 return 0;
2327 next = i; /* remember it in advance */
2328 prev = previous_interval (i);
2329 while (! NULL_INTERVAL_P (prev)
2330 && EQ (*val, textget (prev->plist, prop)))
2331 i = prev, prev = previous_interval (prev);
2332 *start = i->position;
2334 next = next_interval (i);
2335 while (! NULL_INTERVAL_P (next)
2336 && EQ (*val, textget (next->plist, prop)))
2337 i = next, next = next_interval (next);
2338 *end = i->position + LENGTH (i);
2340 return 1;
2343 /* Return the proper local keymap TYPE for position POSITION in
2344 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2345 specified by the PROP property, if any. Otherwise, if TYPE is
2346 `local-map' use BUFFER's local map.
2348 POSITION must be in the accessible part of BUFFER. */
2350 Lisp_Object
2351 get_local_map (position, buffer, type)
2352 register int position;
2353 register struct buffer *buffer;
2354 Lisp_Object type;
2356 Lisp_Object prop, lispy_position, lispy_buffer;
2357 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2359 /* Perhaps we should just change `position' to the limit. */
2360 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2361 abort ();
2363 /* Ignore narrowing, so that a local map continues to be valid even if
2364 the visible region contains no characters and hence no properties. */
2365 old_begv = BUF_BEGV (buffer);
2366 old_zv = BUF_ZV (buffer);
2367 old_begv_byte = BUF_BEGV_BYTE (buffer);
2368 old_zv_byte = BUF_ZV_BYTE (buffer);
2369 BUF_BEGV (buffer) = BUF_BEG (buffer);
2370 BUF_ZV (buffer) = BUF_Z (buffer);
2371 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2372 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2374 XSETFASTINT (lispy_position, position);
2375 XSETBUFFER (lispy_buffer, buffer);
2376 /* First check if the CHAR has any property. This is because when
2377 we click with the mouse, the mouse pointer is really pointing
2378 to the CHAR after POS. */
2379 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2380 /* If not, look at the POS's properties. This is necessary because when
2381 editing a field with a `local-map' property, we want insertion at the end
2382 to obey the `local-map' property. */
2383 if (NILP (prop))
2384 prop = get_pos_property (lispy_position, type, lispy_buffer);
2386 BUF_BEGV (buffer) = old_begv;
2387 BUF_ZV (buffer) = old_zv;
2388 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2389 BUF_ZV_BYTE (buffer) = old_zv_byte;
2391 /* Use the local map only if it is valid. */
2392 prop = get_keymap (prop, 0, 0);
2393 if (CONSP (prop))
2394 return prop;
2396 if (EQ (type, Qkeymap))
2397 return Qnil;
2398 else
2399 return buffer->keymap;
2402 /* Produce an interval tree reflecting the intervals in
2403 TREE from START to START + LENGTH.
2404 The new interval tree has no parent and has a starting-position of 0. */
2406 INTERVAL
2407 copy_intervals (tree, start, length)
2408 INTERVAL tree;
2409 int start, length;
2411 register INTERVAL i, new, t;
2412 register int got, prevlen;
2414 if (NULL_INTERVAL_P (tree) || length <= 0)
2415 return NULL_INTERVAL;
2417 i = find_interval (tree, start);
2418 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2419 abort ();
2421 /* If there is only one interval and it's the default, return nil. */
2422 if ((start - i->position + 1 + length) < LENGTH (i)
2423 && DEFAULT_INTERVAL_P (i))
2424 return NULL_INTERVAL;
2426 new = make_interval ();
2427 new->position = 0;
2428 got = (LENGTH (i) - (start - i->position));
2429 new->total_length = length;
2430 CHECK_TOTAL_LENGTH (new);
2431 copy_properties (i, new);
2433 t = new;
2434 prevlen = got;
2435 while (got < length)
2437 i = next_interval (i);
2438 t = split_interval_right (t, prevlen);
2439 copy_properties (i, t);
2440 prevlen = LENGTH (i);
2441 got += prevlen;
2444 return balance_an_interval (new);
2447 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2449 INLINE void
2450 copy_intervals_to_string (string, buffer, position, length)
2451 Lisp_Object string;
2452 struct buffer *buffer;
2453 int position, length;
2455 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2456 position, length);
2457 if (NULL_INTERVAL_P (interval_copy))
2458 return;
2460 SET_INTERVAL_OBJECT (interval_copy, string);
2461 STRING_SET_INTERVALS (string, interval_copy);
2464 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2465 Assume they have identical characters. */
2468 compare_string_intervals (s1, s2)
2469 Lisp_Object s1, s2;
2471 INTERVAL i1, i2;
2472 int pos = 0;
2473 int end = SCHARS (s1);
2475 i1 = find_interval (STRING_INTERVALS (s1), 0);
2476 i2 = find_interval (STRING_INTERVALS (s2), 0);
2478 while (pos < end)
2480 /* Determine how far we can go before we reach the end of I1 or I2. */
2481 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2482 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2483 int distance = min (len1, len2);
2485 /* If we ever find a mismatch between the strings,
2486 they differ. */
2487 if (! intervals_equal (i1, i2))
2488 return 0;
2490 /* Advance POS till the end of the shorter interval,
2491 and advance one or both interval pointers for the new position. */
2492 pos += distance;
2493 if (len1 == distance)
2494 i1 = next_interval (i1);
2495 if (len2 == distance)
2496 i2 = next_interval (i2);
2498 return 1;
2501 /* Recursively adjust interval I in the current buffer
2502 for setting enable_multibyte_characters to MULTI_FLAG.
2503 The range of interval I is START ... END in characters,
2504 START_BYTE ... END_BYTE in bytes. */
2506 static void
2507 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2508 INTERVAL i;
2509 int multi_flag;
2510 int start, start_byte, end, end_byte;
2512 /* Fix the length of this interval. */
2513 if (multi_flag)
2514 i->total_length = end - start;
2515 else
2516 i->total_length = end_byte - start_byte;
2517 CHECK_TOTAL_LENGTH (i);
2519 if (TOTAL_LENGTH (i) == 0)
2521 delete_interval (i);
2522 return;
2525 /* Recursively fix the length of the subintervals. */
2526 if (i->left)
2528 int left_end, left_end_byte;
2530 if (multi_flag)
2532 int temp;
2533 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2534 left_end = BYTE_TO_CHAR (left_end_byte);
2536 temp = CHAR_TO_BYTE (left_end);
2538 /* If LEFT_END_BYTE is in the middle of a character,
2539 adjust it and LEFT_END to a char boundary. */
2540 if (left_end_byte > temp)
2542 left_end_byte = temp;
2544 if (left_end_byte < temp)
2546 left_end--;
2547 left_end_byte = CHAR_TO_BYTE (left_end);
2550 else
2552 left_end = start + LEFT_TOTAL_LENGTH (i);
2553 left_end_byte = CHAR_TO_BYTE (left_end);
2556 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2557 left_end, left_end_byte);
2559 if (i->right)
2561 int right_start_byte, right_start;
2563 if (multi_flag)
2565 int temp;
2567 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2568 right_start = BYTE_TO_CHAR (right_start_byte);
2570 /* If RIGHT_START_BYTE is in the middle of a character,
2571 adjust it and RIGHT_START to a char boundary. */
2572 temp = CHAR_TO_BYTE (right_start);
2574 if (right_start_byte < temp)
2576 right_start_byte = temp;
2578 if (right_start_byte > temp)
2580 right_start++;
2581 right_start_byte = CHAR_TO_BYTE (right_start);
2584 else
2586 right_start = end - RIGHT_TOTAL_LENGTH (i);
2587 right_start_byte = CHAR_TO_BYTE (right_start);
2590 set_intervals_multibyte_1 (i->right, multi_flag,
2591 right_start, right_start_byte,
2592 end, end_byte);
2595 /* Rounding to char boundaries can theoretically ake this interval
2596 spurious. If so, delete one child, and copy its property list
2597 to this interval. */
2598 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2600 if ((i)->left)
2602 (i)->plist = (i)->left->plist;
2603 (i)->left->total_length = 0;
2604 delete_interval ((i)->left);
2606 else
2608 (i)->plist = (i)->right->plist;
2609 (i)->right->total_length = 0;
2610 delete_interval ((i)->right);
2615 /* Update the intervals of the current buffer
2616 to fit the contents as multibyte (if MULTI_FLAG is 1)
2617 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2619 void
2620 set_intervals_multibyte (multi_flag)
2621 int multi_flag;
2623 if (BUF_INTERVALS (current_buffer))
2624 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2625 BEG, BEG_BYTE, Z, Z_BYTE);
2628 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2629 (do not change this comment) */