Backport 2011-04-04T22:08:01Z!lekktu@gmail.com and 2011-04-04T22:33:12Z!lekktu@gmail...
[emacs.git] / src / intervals.c
blobfd8f3f55479deb8cb73f4f0e0f86b419a4e1830d
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 SET_BUF_PT_BOTH (buffer, charpos, bytepos);
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);
2369 SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer));
2370 SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer));
2372 XSETFASTINT (lispy_position, position);
2373 XSETBUFFER (lispy_buffer, buffer);
2374 /* First check if the CHAR has any property. This is because when
2375 we click with the mouse, the mouse pointer is really pointing
2376 to the CHAR after POS. */
2377 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2378 /* If not, look at the POS's properties. This is necessary because when
2379 editing a field with a `local-map' property, we want insertion at the end
2380 to obey the `local-map' property. */
2381 if (NILP (prop))
2382 prop = get_pos_property (lispy_position, type, lispy_buffer);
2384 SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte);
2385 SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte);
2387 /* Use the local map only if it is valid. */
2388 prop = get_keymap (prop, 0, 0);
2389 if (CONSP (prop))
2390 return prop;
2392 if (EQ (type, Qkeymap))
2393 return Qnil;
2394 else
2395 return buffer->keymap;
2398 /* Produce an interval tree reflecting the intervals in
2399 TREE from START to START + LENGTH.
2400 The new interval tree has no parent and has a starting-position of 0. */
2402 INTERVAL
2403 copy_intervals (tree, start, length)
2404 INTERVAL tree;
2405 int start, length;
2407 register INTERVAL i, new, t;
2408 register int got, prevlen;
2410 if (NULL_INTERVAL_P (tree) || length <= 0)
2411 return NULL_INTERVAL;
2413 i = find_interval (tree, start);
2414 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2415 abort ();
2417 /* If there is only one interval and it's the default, return nil. */
2418 if ((start - i->position + 1 + length) < LENGTH (i)
2419 && DEFAULT_INTERVAL_P (i))
2420 return NULL_INTERVAL;
2422 new = make_interval ();
2423 new->position = 0;
2424 got = (LENGTH (i) - (start - i->position));
2425 new->total_length = length;
2426 CHECK_TOTAL_LENGTH (new);
2427 copy_properties (i, new);
2429 t = new;
2430 prevlen = got;
2431 while (got < length)
2433 i = next_interval (i);
2434 t = split_interval_right (t, prevlen);
2435 copy_properties (i, t);
2436 prevlen = LENGTH (i);
2437 got += prevlen;
2440 return balance_an_interval (new);
2443 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2445 INLINE void
2446 copy_intervals_to_string (string, buffer, position, length)
2447 Lisp_Object string;
2448 struct buffer *buffer;
2449 int position, length;
2451 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2452 position, length);
2453 if (NULL_INTERVAL_P (interval_copy))
2454 return;
2456 SET_INTERVAL_OBJECT (interval_copy, string);
2457 STRING_SET_INTERVALS (string, interval_copy);
2460 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2461 Assume they have identical characters. */
2464 compare_string_intervals (s1, s2)
2465 Lisp_Object s1, s2;
2467 INTERVAL i1, i2;
2468 int pos = 0;
2469 int end = SCHARS (s1);
2471 i1 = find_interval (STRING_INTERVALS (s1), 0);
2472 i2 = find_interval (STRING_INTERVALS (s2), 0);
2474 while (pos < end)
2476 /* Determine how far we can go before we reach the end of I1 or I2. */
2477 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2478 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2479 int distance = min (len1, len2);
2481 /* If we ever find a mismatch between the strings,
2482 they differ. */
2483 if (! intervals_equal (i1, i2))
2484 return 0;
2486 /* Advance POS till the end of the shorter interval,
2487 and advance one or both interval pointers for the new position. */
2488 pos += distance;
2489 if (len1 == distance)
2490 i1 = next_interval (i1);
2491 if (len2 == distance)
2492 i2 = next_interval (i2);
2494 return 1;
2497 /* Recursively adjust interval I in the current buffer
2498 for setting enable_multibyte_characters to MULTI_FLAG.
2499 The range of interval I is START ... END in characters,
2500 START_BYTE ... END_BYTE in bytes. */
2502 static void
2503 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2504 INTERVAL i;
2505 int multi_flag;
2506 int start, start_byte, end, end_byte;
2508 /* Fix the length of this interval. */
2509 if (multi_flag)
2510 i->total_length = end - start;
2511 else
2512 i->total_length = end_byte - start_byte;
2513 CHECK_TOTAL_LENGTH (i);
2515 if (TOTAL_LENGTH (i) == 0)
2517 delete_interval (i);
2518 return;
2521 /* Recursively fix the length of the subintervals. */
2522 if (i->left)
2524 int left_end, left_end_byte;
2526 if (multi_flag)
2528 int temp;
2529 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2530 left_end = BYTE_TO_CHAR (left_end_byte);
2532 temp = CHAR_TO_BYTE (left_end);
2534 /* If LEFT_END_BYTE is in the middle of a character,
2535 adjust it and LEFT_END to a char boundary. */
2536 if (left_end_byte > temp)
2538 left_end_byte = temp;
2540 if (left_end_byte < temp)
2542 left_end--;
2543 left_end_byte = CHAR_TO_BYTE (left_end);
2546 else
2548 left_end = start + LEFT_TOTAL_LENGTH (i);
2549 left_end_byte = CHAR_TO_BYTE (left_end);
2552 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2553 left_end, left_end_byte);
2555 if (i->right)
2557 int right_start_byte, right_start;
2559 if (multi_flag)
2561 int temp;
2563 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2564 right_start = BYTE_TO_CHAR (right_start_byte);
2566 /* If RIGHT_START_BYTE is in the middle of a character,
2567 adjust it and RIGHT_START to a char boundary. */
2568 temp = CHAR_TO_BYTE (right_start);
2570 if (right_start_byte < temp)
2572 right_start_byte = temp;
2574 if (right_start_byte > temp)
2576 right_start++;
2577 right_start_byte = CHAR_TO_BYTE (right_start);
2580 else
2582 right_start = end - RIGHT_TOTAL_LENGTH (i);
2583 right_start_byte = CHAR_TO_BYTE (right_start);
2586 set_intervals_multibyte_1 (i->right, multi_flag,
2587 right_start, right_start_byte,
2588 end, end_byte);
2591 /* Rounding to char boundaries can theoretically ake this interval
2592 spurious. If so, delete one child, and copy its property list
2593 to this interval. */
2594 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2596 if ((i)->left)
2598 (i)->plist = (i)->left->plist;
2599 (i)->left->total_length = 0;
2600 delete_interval ((i)->left);
2602 else
2604 (i)->plist = (i)->right->plist;
2605 (i)->right->total_length = 0;
2606 delete_interval ((i)->right);
2611 /* Update the intervals of the current buffer
2612 to fit the contents as multibyte (if MULTI_FLAG is 1)
2613 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2615 void
2616 set_intervals_multibyte (multi_flag)
2617 int multi_flag;
2619 if (BUF_INTERVALS (current_buffer))
2620 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2621 BEG, BEG_BYTE, Z, Z_BYTE);
2624 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2625 (do not change this comment) */