NEWS, ChangeLog fixes
[emacs.git] / src / intervals.c
blob2c652cd9ad9c8a253bee06ae1b1d54c9450997a2
1 /* Code for doing intervals.
2 Copyright (C) 1993-1995, 1997-1998, 2001-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* NOTES:
22 Have to ensure that we can't put symbol nil on a plist, or some
23 functions may work incorrectly.
25 An idea: Have the owner of the tree keep count of splits and/or
26 insertion lengths (in intervals), and balance after every N.
28 Need to call *_left_hook when buffer is killed.
30 Scan for zero-length, or 0-length to see notes about handling
31 zero length interval-markers.
33 There are comments around about freeing intervals. It might be
34 faster to explicitly free them (put them on the free list) than
35 to GC them.
40 #include <config.h>
41 #include <setjmp.h>
42 #include <intprops.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "character.h"
46 #include "buffer.h"
47 #include "puresize.h"
48 #include "keyboard.h"
49 #include "keymap.h"
51 /* Test for membership, allowing for t (actually any non-cons) to mean the
52 universal set. */
54 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
56 static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object);
57 static INTERVAL merge_interval_right (INTERVAL);
58 static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
59 static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
61 /* Utility functions for intervals. */
64 /* Create the root interval of some object, a buffer or string. */
66 INTERVAL
67 create_root_interval (Lisp_Object parent)
69 INTERVAL new;
71 CHECK_IMPURE (parent);
73 new = make_interval ();
75 if (BUFFERP (parent))
77 new->total_length = (BUF_Z (XBUFFER (parent))
78 - BUF_BEG (XBUFFER (parent)));
79 CHECK_TOTAL_LENGTH (new);
80 BUF_INTERVALS (XBUFFER (parent)) = new;
81 new->position = BEG;
83 else if (STRINGP (parent))
85 new->total_length = SCHARS (parent);
86 CHECK_TOTAL_LENGTH (new);
87 STRING_SET_INTERVALS (parent, new);
88 new->position = 0;
91 SET_INTERVAL_OBJECT (new, parent);
93 return new;
96 /* Make the interval TARGET have exactly the properties of SOURCE */
98 void
99 copy_properties (register INTERVAL source, register INTERVAL 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 (register INTERVAL source, register INTERVAL target)
115 register Lisp_Object o, sym, val;
117 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
118 return;
120 MERGE_INTERVAL_CACHE (source, target);
122 o = source->plist;
123 while (CONSP (o))
125 sym = XCAR (o);
126 o = XCDR (o);
127 CHECK_CONS (o);
129 val = target->plist;
130 while (CONSP (val) && !EQ (XCAR (val), sym))
132 val = XCDR (val);
133 if (!CONSP (val))
134 break;
135 val = XCDR (val);
138 if (NILP (val))
140 val = XCAR (o);
141 target->plist = Fcons (sym, Fcons (val, target->plist));
143 o = XCDR (o);
147 /* Return 1 if the two intervals have the same properties,
148 0 otherwise. */
151 intervals_equal (INTERVAL i0, INTERVAL i1)
153 register Lisp_Object i0_cdr, i0_sym;
154 register Lisp_Object i1_cdr, i1_val;
156 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
157 return 1;
159 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
160 return 0;
162 i0_cdr = i0->plist;
163 i1_cdr = i1->plist;
164 while (CONSP (i0_cdr) && CONSP (i1_cdr))
166 i0_sym = XCAR (i0_cdr);
167 i0_cdr = XCDR (i0_cdr);
168 if (!CONSP (i0_cdr))
169 return 0; /* abort (); */
170 i1_val = i1->plist;
171 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
173 i1_val = XCDR (i1_val);
174 if (!CONSP (i1_val))
175 return 0; /* abort (); */
176 i1_val = XCDR (i1_val);
179 /* i0 has something i1 doesn't. */
180 if (EQ (i1_val, Qnil))
181 return 0;
183 /* i0 and i1 both have sym, but it has different values in each. */
184 if (!CONSP (i1_val)
185 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
186 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
187 return 0;
189 i0_cdr = XCDR (i0_cdr);
191 i1_cdr = XCDR (i1_cdr);
192 if (!CONSP (i1_cdr))
193 return 0; /* abort (); */
194 i1_cdr = XCDR (i1_cdr);
197 /* Lengths of the two plists were equal. */
198 return (NILP (i0_cdr) && NILP (i1_cdr));
202 /* Traverse an interval tree TREE, performing FUNCTION on each node.
203 No guarantee is made about the order of traversal.
204 Pass FUNCTION two args: an interval, and ARG. */
206 void
207 traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
209 /* Minimize stack usage. */
210 while (!NULL_INTERVAL_P (tree))
212 (*function) (tree, arg);
213 if (NULL_INTERVAL_P (tree->right))
214 tree = tree->left;
215 else
217 traverse_intervals_noorder (tree->left, function, arg);
218 tree = tree->right;
223 /* Traverse an interval tree TREE, performing FUNCTION on each node.
224 Pass FUNCTION two args: an interval, and ARG. */
226 void
227 traverse_intervals (INTERVAL tree, ptrdiff_t position,
228 void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
230 while (!NULL_INTERVAL_P (tree))
232 traverse_intervals (tree->left, position, function, arg);
233 position += LEFT_TOTAL_LENGTH (tree);
234 tree->position = position;
235 (*function) (tree, arg);
236 position += LENGTH (tree); tree = tree->right;
240 #if 0
242 static int icount;
243 static int idepth;
244 static int zero_length;
246 /* These functions are temporary, for debugging purposes only. */
248 INTERVAL search_interval, found_interval;
250 void
251 check_for_interval (INTERVAL i)
253 if (i == search_interval)
255 found_interval = i;
256 icount++;
260 INTERVAL
261 search_for_interval (INTERVAL i, INTERVAL tree)
263 icount = 0;
264 search_interval = i;
265 found_interval = NULL_INTERVAL;
266 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
267 return found_interval;
270 static void
271 inc_interval_count (INTERVAL i)
273 icount++;
274 if (LENGTH (i) == 0)
275 zero_length++;
276 if (depth > idepth)
277 idepth = depth;
281 count_intervals (INTERVAL i)
283 icount = 0;
284 idepth = 0;
285 zero_length = 0;
286 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
288 return icount;
291 static INTERVAL
292 root_interval (INTERVAL interval)
294 register INTERVAL i = interval;
296 while (! ROOT_INTERVAL_P (i))
297 i = INTERVAL_PARENT (i);
299 return i;
301 #endif
303 /* Assuming that a left child exists, perform the following operation:
306 / \ / \
307 B => A
308 / \ / \
312 static inline INTERVAL
313 rotate_right (INTERVAL interval)
315 INTERVAL i;
316 INTERVAL B = interval->left;
317 ptrdiff_t old_total = interval->total_length;
319 /* Deal with any Parent of A; make it point to B. */
320 if (! ROOT_INTERVAL_P (interval))
322 if (AM_LEFT_CHILD (interval))
323 INTERVAL_PARENT (interval)->left = B;
324 else
325 INTERVAL_PARENT (interval)->right = B;
327 COPY_INTERVAL_PARENT (B, interval);
329 /* Make B the parent of A */
330 i = B->right;
331 B->right = interval;
332 SET_INTERVAL_PARENT (interval, B);
334 /* Make A point to c */
335 interval->left = i;
336 if (! NULL_INTERVAL_P (i))
337 SET_INTERVAL_PARENT (i, interval);
339 /* A's total length is decreased by the length of B and its left child. */
340 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
341 CHECK_TOTAL_LENGTH (interval);
343 /* B must have the same total length of A. */
344 B->total_length = old_total;
345 CHECK_TOTAL_LENGTH (B);
347 return B;
350 /* Assuming that a right child exists, perform the following operation:
353 / \ / \
354 B => A
355 / \ / \
359 static inline INTERVAL
360 rotate_left (INTERVAL interval)
362 INTERVAL i;
363 INTERVAL B = interval->right;
364 ptrdiff_t old_total = interval->total_length;
366 /* Deal with any parent of A; make it point to B. */
367 if (! ROOT_INTERVAL_P (interval))
369 if (AM_LEFT_CHILD (interval))
370 INTERVAL_PARENT (interval)->left = B;
371 else
372 INTERVAL_PARENT (interval)->right = B;
374 COPY_INTERVAL_PARENT (B, interval);
376 /* Make B the parent of A */
377 i = B->left;
378 B->left = interval;
379 SET_INTERVAL_PARENT (interval, B);
381 /* Make A point to c */
382 interval->right = i;
383 if (! NULL_INTERVAL_P (i))
384 SET_INTERVAL_PARENT (i, interval);
386 /* A's total length is decreased by the length of B and its right child. */
387 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
388 CHECK_TOTAL_LENGTH (interval);
390 /* B must have the same total length of A. */
391 B->total_length = old_total;
392 CHECK_TOTAL_LENGTH (B);
394 return B;
397 /* Balance an interval tree with the assumption that the subtrees
398 themselves are already balanced. */
400 static INTERVAL
401 balance_an_interval (INTERVAL i)
403 register ptrdiff_t old_diff, new_diff;
405 while (1)
407 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
408 if (old_diff > 0)
410 /* Since the left child is longer, there must be one. */
411 new_diff = i->total_length - i->left->total_length
412 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
413 if (eabs (new_diff) >= old_diff)
414 break;
415 i = rotate_right (i);
416 balance_an_interval (i->right);
418 else if (old_diff < 0)
420 /* Since the right child is longer, there must be one. */
421 new_diff = i->total_length - i->right->total_length
422 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
423 if (eabs (new_diff) >= -old_diff)
424 break;
425 i = rotate_left (i);
426 balance_an_interval (i->left);
428 else
429 break;
431 return i;
434 /* Balance INTERVAL, potentially stuffing it back into its parent
435 Lisp Object. */
437 static inline INTERVAL
438 balance_possible_root_interval (register INTERVAL interval)
440 Lisp_Object parent;
441 int have_parent = 0;
443 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
444 return interval;
446 if (INTERVAL_HAS_OBJECT (interval))
448 have_parent = 1;
449 GET_INTERVAL_OBJECT (parent, interval);
451 interval = balance_an_interval (interval);
453 if (have_parent)
455 if (BUFFERP (parent))
456 BUF_INTERVALS (XBUFFER (parent)) = interval;
457 else if (STRINGP (parent))
458 STRING_SET_INTERVALS (parent, interval);
461 return interval;
464 /* Balance the interval tree TREE. Balancing is by weight
465 (the amount of text). */
467 static INTERVAL
468 balance_intervals_internal (register INTERVAL tree)
470 /* Balance within each side. */
471 if (tree->left)
472 balance_intervals_internal (tree->left);
473 if (tree->right)
474 balance_intervals_internal (tree->right);
475 return balance_an_interval (tree);
478 /* Advertised interface to balance intervals. */
480 INTERVAL
481 balance_intervals (INTERVAL tree)
483 if (tree == NULL_INTERVAL)
484 return NULL_INTERVAL;
486 return balance_intervals_internal (tree);
489 /* Split INTERVAL into two pieces, starting the second piece at
490 character position OFFSET (counting from 0), relative to INTERVAL.
491 INTERVAL becomes the left-hand piece, and the right-hand piece
492 (second, lexicographically) is returned.
494 The size and position fields of the two intervals are set based upon
495 those of the original interval. The property list of the new interval
496 is reset, thus it is up to the caller to do the right thing with the
497 result.
499 Note that this does not change the position of INTERVAL; if it is a root,
500 it is still a root after this operation. */
502 INTERVAL
503 split_interval_right (INTERVAL interval, ptrdiff_t offset)
505 INTERVAL new = make_interval ();
506 ptrdiff_t position = interval->position;
507 ptrdiff_t new_length = LENGTH (interval) - offset;
509 new->position = position + offset;
510 SET_INTERVAL_PARENT (new, interval);
512 if (NULL_RIGHT_CHILD (interval))
514 interval->right = new;
515 new->total_length = new_length;
516 CHECK_TOTAL_LENGTH (new);
518 else
520 /* Insert the new node between INTERVAL and its right child. */
521 new->right = interval->right;
522 SET_INTERVAL_PARENT (interval->right, new);
523 interval->right = new;
524 new->total_length = new_length + new->right->total_length;
525 CHECK_TOTAL_LENGTH (new);
526 balance_an_interval (new);
529 balance_possible_root_interval (interval);
531 return new;
534 /* Split INTERVAL into two pieces, starting the second piece at
535 character position OFFSET (counting from 0), relative to INTERVAL.
536 INTERVAL becomes the right-hand piece, and the left-hand piece
537 (first, lexicographically) is returned.
539 The size and position fields of the two intervals are set based upon
540 those of the original interval. The property list of the new interval
541 is reset, thus it is up to the caller to do the right thing with the
542 result.
544 Note that this does not change the position of INTERVAL; if it is a root,
545 it is still a root after this operation. */
547 INTERVAL
548 split_interval_left (INTERVAL interval, ptrdiff_t offset)
550 INTERVAL new = make_interval ();
551 ptrdiff_t new_length = offset;
553 new->position = interval->position;
554 interval->position = interval->position + offset;
555 SET_INTERVAL_PARENT (new, interval);
557 if (NULL_LEFT_CHILD (interval))
559 interval->left = new;
560 new->total_length = new_length;
561 CHECK_TOTAL_LENGTH (new);
563 else
565 /* Insert the new node between INTERVAL and its left child. */
566 new->left = interval->left;
567 SET_INTERVAL_PARENT (new->left, new);
568 interval->left = new;
569 new->total_length = new_length + new->left->total_length;
570 CHECK_TOTAL_LENGTH (new);
571 balance_an_interval (new);
574 balance_possible_root_interval (interval);
576 return new;
579 /* Return the proper position for the first character
580 described by the interval tree SOURCE.
581 This is 1 if the parent is a buffer,
582 0 if the parent is a string or if there is no parent.
584 Don't use this function on an interval which is the child
585 of another interval! */
587 static int
588 interval_start_pos (INTERVAL source)
590 Lisp_Object parent;
592 if (NULL_INTERVAL_P (source))
593 return 0;
595 if (! INTERVAL_HAS_OBJECT (source))
596 return 0;
597 GET_INTERVAL_OBJECT (parent, source);
598 if (BUFFERP (parent))
599 return BUF_BEG (XBUFFER (parent));
600 return 0;
603 /* Find the interval containing text position POSITION in the text
604 represented by the interval tree TREE. POSITION is a buffer
605 position (starting from 1) or a string index (starting from 0).
606 If POSITION is at the end of the buffer or string,
607 return the interval containing the last character.
609 The `position' field, which is a cache of an interval's position,
610 is updated in the interval found. Other functions (e.g., next_interval)
611 will update this cache based on the result of find_interval. */
613 INTERVAL
614 find_interval (register INTERVAL tree, register ptrdiff_t position)
616 /* The distance from the left edge of the subtree at TREE
617 to POSITION. */
618 register ptrdiff_t relative_position;
620 if (NULL_INTERVAL_P (tree))
621 return NULL_INTERVAL;
623 relative_position = position;
624 if (INTERVAL_HAS_OBJECT (tree))
626 Lisp_Object parent;
627 GET_INTERVAL_OBJECT (parent, tree);
628 if (BUFFERP (parent))
629 relative_position -= BUF_BEG (XBUFFER (parent));
632 if (relative_position > TOTAL_LENGTH (tree))
633 abort (); /* Paranoia */
635 if (!handling_signal)
636 tree = balance_possible_root_interval (tree);
638 while (1)
640 if (relative_position < LEFT_TOTAL_LENGTH (tree))
642 tree = tree->left;
644 else if (! NULL_RIGHT_CHILD (tree)
645 && relative_position >= (TOTAL_LENGTH (tree)
646 - RIGHT_TOTAL_LENGTH (tree)))
648 relative_position -= (TOTAL_LENGTH (tree)
649 - RIGHT_TOTAL_LENGTH (tree));
650 tree = tree->right;
652 else
654 tree->position
655 = (position - relative_position /* left edge of *tree. */
656 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
658 return tree;
663 /* Find the succeeding interval (lexicographically) to INTERVAL.
664 Sets the `position' field based on that of INTERVAL (see
665 find_interval). */
667 INTERVAL
668 next_interval (register INTERVAL interval)
670 register INTERVAL i = interval;
671 register ptrdiff_t next_position;
673 if (NULL_INTERVAL_P (i))
674 return NULL_INTERVAL;
675 next_position = interval->position + LENGTH (interval);
677 if (! NULL_RIGHT_CHILD (i))
679 i = i->right;
680 while (! NULL_LEFT_CHILD (i))
681 i = i->left;
683 i->position = next_position;
684 return i;
687 while (! NULL_PARENT (i))
689 if (AM_LEFT_CHILD (i))
691 i = INTERVAL_PARENT (i);
692 i->position = next_position;
693 return i;
696 i = INTERVAL_PARENT (i);
699 return NULL_INTERVAL;
702 /* Find the preceding interval (lexicographically) to INTERVAL.
703 Sets the `position' field based on that of INTERVAL (see
704 find_interval). */
706 INTERVAL
707 previous_interval (register INTERVAL interval)
709 register INTERVAL i;
711 if (NULL_INTERVAL_P (interval))
712 return NULL_INTERVAL;
714 if (! NULL_LEFT_CHILD (interval))
716 i = interval->left;
717 while (! NULL_RIGHT_CHILD (i))
718 i = i->right;
720 i->position = interval->position - LENGTH (i);
721 return i;
724 i = interval;
725 while (! NULL_PARENT (i))
727 if (AM_RIGHT_CHILD (i))
729 i = INTERVAL_PARENT (i);
731 i->position = interval->position - LENGTH (i);
732 return i;
734 i = INTERVAL_PARENT (i);
737 return NULL_INTERVAL;
740 /* Find the interval containing POS given some non-NULL INTERVAL
741 in the same tree. Note that we need to update interval->position
742 if we go down the tree.
743 To speed up the process, we assume that the ->position of
744 I and all its parents is already uptodate. */
745 INTERVAL
746 update_interval (register INTERVAL i, ptrdiff_t pos)
748 if (NULL_INTERVAL_P (i))
749 return NULL_INTERVAL;
751 while (1)
753 if (pos < i->position)
755 /* Move left. */
756 if (pos >= i->position - TOTAL_LENGTH (i->left))
758 i->left->position = i->position - TOTAL_LENGTH (i->left)
759 + LEFT_TOTAL_LENGTH (i->left);
760 i = i->left; /* Move to the left child */
762 else if (NULL_PARENT (i))
763 error ("Point before start of properties");
764 else
765 i = INTERVAL_PARENT (i);
766 continue;
768 else if (pos >= INTERVAL_LAST_POS (i))
770 /* Move right. */
771 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
773 i->right->position = INTERVAL_LAST_POS (i)
774 + LEFT_TOTAL_LENGTH (i->right);
775 i = i->right; /* Move to the right child */
777 else if (NULL_PARENT (i))
778 error ("Point %"pD"d after end of properties", pos);
779 else
780 i = INTERVAL_PARENT (i);
781 continue;
783 else
784 return i;
789 #if 0
790 /* Traverse a path down the interval tree TREE to the interval
791 containing POSITION, adjusting all nodes on the path for
792 an addition of LENGTH characters. Insertion between two intervals
793 (i.e., point == i->position, where i is second interval) means
794 text goes into second interval.
796 Modifications are needed to handle the hungry bits -- after simply
797 finding the interval at position (don't add length going down),
798 if it's the beginning of the interval, get the previous interval
799 and check the hungry bits of both. Then add the length going back up
800 to the root. */
802 static INTERVAL
803 adjust_intervals_for_insertion (INTERVAL tree, ptrdiff_t position,
804 ptrdiff_t length)
806 register ptrdiff_t relative_position;
807 register INTERVAL this;
809 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
810 abort ();
812 /* If inserting at point-max of a buffer, that position
813 will be out of range */
814 if (position > TOTAL_LENGTH (tree))
815 position = TOTAL_LENGTH (tree);
816 relative_position = position;
817 this = tree;
819 while (1)
821 if (relative_position <= LEFT_TOTAL_LENGTH (this))
823 this->total_length += length;
824 CHECK_TOTAL_LENGTH (this);
825 this = this->left;
827 else if (relative_position > (TOTAL_LENGTH (this)
828 - RIGHT_TOTAL_LENGTH (this)))
830 relative_position -= (TOTAL_LENGTH (this)
831 - RIGHT_TOTAL_LENGTH (this));
832 this->total_length += length;
833 CHECK_TOTAL_LENGTH (this);
834 this = this->right;
836 else
838 /* If we are to use zero-length intervals as buffer pointers,
839 then this code will have to change. */
840 this->total_length += length;
841 CHECK_TOTAL_LENGTH (this);
842 this->position = LEFT_TOTAL_LENGTH (this)
843 + position - relative_position + 1;
844 return tree;
848 #endif
850 /* Effect an adjustment corresponding to the addition of LENGTH characters
851 of text. Do this by finding the interval containing POSITION in the
852 interval tree TREE, and then adjusting all of its ancestors by adding
853 LENGTH to them.
855 If POSITION is the first character of an interval, meaning that point
856 is actually between the two intervals, make the new text belong to
857 the interval which is "sticky".
859 If both intervals are "sticky", then make them belong to the left-most
860 interval. Another possibility would be to create a new interval for
861 this text, and make it have the merged properties of both ends. */
863 static INTERVAL
864 adjust_intervals_for_insertion (INTERVAL tree,
865 ptrdiff_t position, ptrdiff_t length)
867 register INTERVAL i;
868 register INTERVAL temp;
869 int eobp = 0;
870 Lisp_Object parent;
871 ptrdiff_t offset;
873 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
874 abort ();
876 GET_INTERVAL_OBJECT (parent, tree);
877 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
879 /* If inserting at point-max of a buffer, that position will be out
880 of range. Remember that buffer positions are 1-based. */
881 if (position >= TOTAL_LENGTH (tree) + offset)
883 position = TOTAL_LENGTH (tree) + offset;
884 eobp = 1;
887 i = find_interval (tree, position);
889 /* If in middle of an interval which is not sticky either way,
890 we must not just give its properties to the insertion.
891 So split this interval at the insertion point.
893 Originally, the if condition here was this:
894 (! (position == i->position || eobp)
895 && END_NONSTICKY_P (i)
896 && FRONT_NONSTICKY_P (i))
897 But, these macros are now unreliable because of introduction of
898 Vtext_property_default_nonsticky. So, we always check properties
899 one by one if POSITION is in middle of an interval. */
900 if (! (position == i->position || eobp))
902 Lisp_Object tail;
903 Lisp_Object front, rear;
905 tail = i->plist;
907 /* Properties font-sticky and rear-nonsticky override
908 Vtext_property_default_nonsticky. So, if they are t, we can
909 skip one by one checking of properties. */
910 rear = textget (i->plist, Qrear_nonsticky);
911 if (! CONSP (rear) && ! NILP (rear))
913 /* All properties are nonsticky. We split the interval. */
914 goto check_done;
916 front = textget (i->plist, Qfront_sticky);
917 if (! CONSP (front) && ! NILP (front))
919 /* All properties are sticky. We don't split the interval. */
920 tail = Qnil;
921 goto check_done;
924 /* Does any actual property pose an actual problem? We break
925 the loop if we find a nonsticky property. */
926 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
928 Lisp_Object prop, tmp;
929 prop = XCAR (tail);
931 /* Is this particular property front-sticky? */
932 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
933 continue;
935 /* Is this particular property rear-nonsticky? */
936 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
937 break;
939 /* Is this particular property recorded as sticky or
940 nonsticky in Vtext_property_default_nonsticky? */
941 tmp = Fassq (prop, Vtext_property_default_nonsticky);
942 if (CONSP (tmp))
944 if (NILP (tmp))
945 continue;
946 break;
949 /* By default, a text property is rear-sticky, thus we
950 continue the loop. */
953 check_done:
954 /* If any property is a real problem, split the interval. */
955 if (! NILP (tail))
957 temp = split_interval_right (i, position - i->position);
958 copy_properties (i, temp);
959 i = temp;
963 /* If we are positioned between intervals, check the stickiness of
964 both of them. We have to do this too, if we are at BEG or Z. */
965 if (position == i->position || eobp)
967 register INTERVAL prev;
969 if (position == BEG)
970 prev = 0;
971 else if (eobp)
973 prev = i;
974 i = 0;
976 else
977 prev = previous_interval (i);
979 /* Even if we are positioned between intervals, we default
980 to the left one if it exists. We extend it now and split
981 off a part later, if stickiness demands it. */
982 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
984 temp->total_length += length;
985 CHECK_TOTAL_LENGTH (temp);
986 temp = balance_possible_root_interval (temp);
989 /* If at least one interval has sticky properties,
990 we check the stickiness property by property.
992 Originally, the if condition here was this:
993 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
994 But, these macros are now unreliable because of introduction
995 of Vtext_property_default_nonsticky. So, we always have to
996 check stickiness of properties one by one. If cache of
997 stickiness is implemented in the future, we may be able to
998 use those macros again. */
999 if (1)
1001 Lisp_Object pleft, pright;
1002 struct interval newi;
1004 RESET_INTERVAL (&newi);
1005 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1006 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1007 newi.plist = merge_properties_sticky (pleft, pright);
1009 if (! prev) /* i.e. position == BEG */
1011 if (! intervals_equal (i, &newi))
1013 i = split_interval_left (i, length);
1014 i->plist = newi.plist;
1017 else if (! intervals_equal (prev, &newi))
1019 prev = split_interval_right (prev,
1020 position - prev->position);
1021 prev->plist = newi.plist;
1022 if (! NULL_INTERVAL_P (i)
1023 && intervals_equal (prev, i))
1024 merge_interval_right (prev);
1027 /* We will need to update the cache here later. */
1029 else if (! prev && ! NILP (i->plist))
1031 /* Just split off a new interval at the left.
1032 Since I wasn't front-sticky, the empty plist is ok. */
1033 i = split_interval_left (i, length);
1037 /* Otherwise just extend the interval. */
1038 else
1040 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1042 temp->total_length += length;
1043 CHECK_TOTAL_LENGTH (temp);
1044 temp = balance_possible_root_interval (temp);
1048 return tree;
1051 /* Any property might be front-sticky on the left, rear-sticky on the left,
1052 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1053 can be arranged in a matrix with rows denoting the left conditions and
1054 columns denoting the right conditions:
1055 _ __ _
1056 _ FR FR FR FR
1057 FR__ 0 1 2 3
1058 _FR 4 5 6 7
1059 FR 8 9 A B
1060 FR C D E F
1062 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1063 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1064 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1065 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1066 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1067 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1068 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1069 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1071 We inherit from whoever has a sticky side facing us. If both sides
1072 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1073 non-nil value for the current property. If both sides do, then we take
1074 from the left.
1076 When we inherit a property, we get its stickiness as well as its value.
1077 So, when we merge the above two lists, we expect to get this:
1079 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1080 rear-nonsticky (p6 pa)
1081 p0 L p1 L p2 L p3 L p6 R p7 R
1082 pa R pb R pc L pd L pe L pf L)
1084 The optimizable special cases are:
1085 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1086 left rear-nonsticky = t, right front-sticky = t (inherit right)
1087 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1090 static Lisp_Object
1091 merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
1093 register Lisp_Object props, front, rear;
1094 Lisp_Object lfront, lrear, rfront, rrear;
1095 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1096 int use_left, use_right;
1097 int lpresent;
1099 props = Qnil;
1100 front = Qnil;
1101 rear = Qnil;
1102 lfront = textget (pleft, Qfront_sticky);
1103 lrear = textget (pleft, Qrear_nonsticky);
1104 rfront = textget (pright, Qfront_sticky);
1105 rrear = textget (pright, Qrear_nonsticky);
1107 /* Go through each element of PRIGHT. */
1108 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1110 Lisp_Object tmp;
1112 sym = XCAR (tail1);
1114 /* Sticky properties get special treatment. */
1115 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1116 continue;
1118 rval = Fcar (XCDR (tail1));
1119 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1120 if (EQ (sym, XCAR (tail2)))
1121 break;
1123 /* Indicate whether the property is explicitly defined on the left.
1124 (We know it is defined explicitly on the right
1125 because otherwise we don't get here.) */
1126 lpresent = ! NILP (tail2);
1127 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1129 /* Even if lrear or rfront say nothing about the stickiness of
1130 SYM, Vtext_property_default_nonsticky may give default
1131 stickiness to SYM. */
1132 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1133 use_left = (lpresent
1134 && ! (TMEM (sym, lrear)
1135 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1136 use_right = (TMEM (sym, rfront)
1137 || (CONSP (tmp) && NILP (XCDR (tmp))));
1138 if (use_left && use_right)
1140 if (NILP (lval))
1141 use_left = 0;
1142 else if (NILP (rval))
1143 use_right = 0;
1145 if (use_left)
1147 /* We build props as (value sym ...) rather than (sym value ...)
1148 because we plan to nreverse it when we're done. */
1149 props = Fcons (lval, Fcons (sym, props));
1150 if (TMEM (sym, lfront))
1151 front = Fcons (sym, front);
1152 if (TMEM (sym, lrear))
1153 rear = Fcons (sym, rear);
1155 else if (use_right)
1157 props = Fcons (rval, Fcons (sym, props));
1158 if (TMEM (sym, rfront))
1159 front = Fcons (sym, front);
1160 if (TMEM (sym, rrear))
1161 rear = Fcons (sym, rear);
1165 /* Now go through each element of PLEFT. */
1166 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1168 Lisp_Object tmp;
1170 sym = XCAR (tail2);
1172 /* Sticky properties get special treatment. */
1173 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1174 continue;
1176 /* If sym is in PRIGHT, we've already considered it. */
1177 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1178 if (EQ (sym, XCAR (tail1)))
1179 break;
1180 if (! NILP (tail1))
1181 continue;
1183 lval = Fcar (XCDR (tail2));
1185 /* Even if lrear or rfront say nothing about the stickiness of
1186 SYM, Vtext_property_default_nonsticky may give default
1187 stickiness to SYM. */
1188 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1190 /* Since rval is known to be nil in this loop, the test simplifies. */
1191 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1193 props = Fcons (lval, Fcons (sym, props));
1194 if (TMEM (sym, lfront))
1195 front = Fcons (sym, front);
1197 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1199 /* The value is nil, but we still inherit the stickiness
1200 from the right. */
1201 front = Fcons (sym, front);
1202 if (TMEM (sym, rrear))
1203 rear = Fcons (sym, rear);
1206 props = Fnreverse (props);
1207 if (! NILP (rear))
1208 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1210 cat = textget (props, Qcategory);
1211 if (! NILP (front)
1213 /* If we have inherited a front-stick category property that is t,
1214 we don't need to set up a detailed one. */
1215 ! (! NILP (cat) && SYMBOLP (cat)
1216 && EQ (Fget (cat, Qfront_sticky), Qt)))
1217 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1218 return props;
1222 /* Delete a node I from its interval tree by merging its subtrees
1223 into one subtree which is then returned. Caller is responsible for
1224 storing the resulting subtree into its parent. */
1226 static INTERVAL
1227 delete_node (register INTERVAL i)
1229 register INTERVAL migrate, this;
1230 register ptrdiff_t migrate_amt;
1232 if (NULL_INTERVAL_P (i->left))
1233 return i->right;
1234 if (NULL_INTERVAL_P (i->right))
1235 return i->left;
1237 migrate = i->left;
1238 migrate_amt = i->left->total_length;
1239 this = i->right;
1240 this->total_length += migrate_amt;
1241 while (! NULL_INTERVAL_P (this->left))
1243 this = this->left;
1244 this->total_length += migrate_amt;
1246 CHECK_TOTAL_LENGTH (this);
1247 this->left = migrate;
1248 SET_INTERVAL_PARENT (migrate, this);
1250 return i->right;
1253 /* Delete interval I from its tree by calling `delete_node'
1254 and properly connecting the resultant subtree.
1256 I is presumed to be empty; that is, no adjustments are made
1257 for the length of I. */
1259 static void
1260 delete_interval (register INTERVAL i)
1262 register INTERVAL parent;
1263 ptrdiff_t amt = LENGTH (i);
1265 if (amt > 0) /* Only used on zero-length intervals now. */
1266 abort ();
1268 if (ROOT_INTERVAL_P (i))
1270 Lisp_Object owner;
1271 GET_INTERVAL_OBJECT (owner, i);
1272 parent = delete_node (i);
1273 if (! NULL_INTERVAL_P (parent))
1274 SET_INTERVAL_OBJECT (parent, owner);
1276 if (BUFFERP (owner))
1277 BUF_INTERVALS (XBUFFER (owner)) = parent;
1278 else if (STRINGP (owner))
1279 STRING_SET_INTERVALS (owner, parent);
1280 else
1281 abort ();
1283 return;
1286 parent = INTERVAL_PARENT (i);
1287 if (AM_LEFT_CHILD (i))
1289 parent->left = delete_node (i);
1290 if (! NULL_INTERVAL_P (parent->left))
1291 SET_INTERVAL_PARENT (parent->left, parent);
1293 else
1295 parent->right = delete_node (i);
1296 if (! NULL_INTERVAL_P (parent->right))
1297 SET_INTERVAL_PARENT (parent->right, parent);
1301 /* Find the interval in TREE corresponding to the relative position
1302 FROM and delete as much as possible of AMOUNT from that interval.
1303 Return the amount actually deleted, and if the interval was
1304 zeroed-out, delete that interval node from the tree.
1306 Note that FROM is actually origin zero, aka relative to the
1307 leftmost edge of tree. This is appropriate since we call ourselves
1308 recursively on subtrees.
1310 Do this by recursing down TREE to the interval in question, and
1311 deleting the appropriate amount of text. */
1313 static ptrdiff_t
1314 interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from,
1315 register ptrdiff_t amount)
1317 register ptrdiff_t relative_position = from;
1319 if (NULL_INTERVAL_P (tree))
1320 return 0;
1322 /* Left branch. */
1323 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1325 ptrdiff_t subtract = interval_deletion_adjustment (tree->left,
1326 relative_position,
1327 amount);
1328 tree->total_length -= subtract;
1329 CHECK_TOTAL_LENGTH (tree);
1330 return subtract;
1332 /* Right branch. */
1333 else if (relative_position >= (TOTAL_LENGTH (tree)
1334 - RIGHT_TOTAL_LENGTH (tree)))
1336 ptrdiff_t subtract;
1338 relative_position -= (tree->total_length
1339 - RIGHT_TOTAL_LENGTH (tree));
1340 subtract = interval_deletion_adjustment (tree->right,
1341 relative_position,
1342 amount);
1343 tree->total_length -= subtract;
1344 CHECK_TOTAL_LENGTH (tree);
1345 return subtract;
1347 /* Here -- this node. */
1348 else
1350 /* How much can we delete from this interval? */
1351 ptrdiff_t my_amount = ((tree->total_length
1352 - RIGHT_TOTAL_LENGTH (tree))
1353 - relative_position);
1355 if (amount > my_amount)
1356 amount = my_amount;
1358 tree->total_length -= amount;
1359 CHECK_TOTAL_LENGTH (tree);
1360 if (LENGTH (tree) == 0)
1361 delete_interval (tree);
1363 return amount;
1366 /* Never reach here. */
1369 /* Effect the adjustments necessary to the interval tree of BUFFER to
1370 correspond to the deletion of LENGTH characters from that buffer
1371 text. The deletion is effected at position START (which is a
1372 buffer position, i.e. origin 1). */
1374 static void
1375 adjust_intervals_for_deletion (struct buffer *buffer,
1376 ptrdiff_t start, ptrdiff_t length)
1378 register ptrdiff_t left_to_delete = length;
1379 register INTERVAL tree = BUF_INTERVALS (buffer);
1380 Lisp_Object parent;
1381 ptrdiff_t offset;
1383 GET_INTERVAL_OBJECT (parent, tree);
1384 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1386 if (NULL_INTERVAL_P (tree))
1387 return;
1389 if (start > offset + TOTAL_LENGTH (tree)
1390 || start + length > offset + TOTAL_LENGTH (tree))
1391 abort ();
1393 if (length == TOTAL_LENGTH (tree))
1395 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1396 return;
1399 if (ONLY_INTERVAL_P (tree))
1401 tree->total_length -= length;
1402 CHECK_TOTAL_LENGTH (tree);
1403 return;
1406 if (start > offset + TOTAL_LENGTH (tree))
1407 start = offset + TOTAL_LENGTH (tree);
1408 while (left_to_delete > 0)
1410 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1411 left_to_delete);
1412 tree = BUF_INTERVALS (buffer);
1413 if (left_to_delete == tree->total_length)
1415 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1416 return;
1421 /* Make the adjustments necessary to the interval tree of BUFFER to
1422 represent an addition or deletion of LENGTH characters starting
1423 at position START. Addition or deletion is indicated by the sign
1424 of LENGTH.
1426 The two inline functions (one static) pacify Sun C 5.8, a pre-C99
1427 compiler that does not allow calling a static function (here,
1428 adjust_intervals_for_deletion) from a non-static inline function. */
1430 void
1431 offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
1433 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1434 return;
1436 if (length > 0)
1437 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1438 else
1440 IF_LINT (if (length < - TYPE_MAXIMUM (ptrdiff_t)) abort ();)
1441 adjust_intervals_for_deletion (buffer, start, -length);
1445 /* Merge interval I with its lexicographic successor. The resulting
1446 interval is returned, and has the properties of the original
1447 successor. The properties of I are lost. I is removed from the
1448 interval tree.
1450 IMPORTANT:
1451 The caller must verify that this is not the last (rightmost)
1452 interval. */
1454 static INTERVAL
1455 merge_interval_right (register INTERVAL i)
1457 register ptrdiff_t absorb = LENGTH (i);
1458 register INTERVAL successor;
1460 /* Zero out this interval. */
1461 i->total_length -= absorb;
1462 CHECK_TOTAL_LENGTH (i);
1464 /* Find the succeeding interval. */
1465 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1466 as we descend. */
1468 successor = i->right;
1469 while (! NULL_LEFT_CHILD (successor))
1471 successor->total_length += absorb;
1472 CHECK_TOTAL_LENGTH (successor);
1473 successor = successor->left;
1476 successor->total_length += absorb;
1477 CHECK_TOTAL_LENGTH (successor);
1478 delete_interval (i);
1479 return successor;
1482 successor = i;
1483 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1484 we ascend. */
1486 if (AM_LEFT_CHILD (successor))
1488 successor = INTERVAL_PARENT (successor);
1489 delete_interval (i);
1490 return successor;
1493 successor = INTERVAL_PARENT (successor);
1494 successor->total_length -= absorb;
1495 CHECK_TOTAL_LENGTH (successor);
1498 /* This must be the rightmost or last interval and cannot
1499 be merged right. The caller should have known. */
1500 abort ();
1503 /* Merge interval I with its lexicographic predecessor. The resulting
1504 interval is returned, and has the properties of the original predecessor.
1505 The properties of I are lost. Interval node I is removed from the tree.
1507 IMPORTANT:
1508 The caller must verify that this is not the first (leftmost) interval. */
1510 INTERVAL
1511 merge_interval_left (register INTERVAL i)
1513 register ptrdiff_t absorb = LENGTH (i);
1514 register INTERVAL predecessor;
1516 /* Zero out this interval. */
1517 i->total_length -= absorb;
1518 CHECK_TOTAL_LENGTH (i);
1520 /* Find the preceding interval. */
1521 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1522 adding ABSORB as we go. */
1524 predecessor = i->left;
1525 while (! NULL_RIGHT_CHILD (predecessor))
1527 predecessor->total_length += absorb;
1528 CHECK_TOTAL_LENGTH (predecessor);
1529 predecessor = predecessor->right;
1532 predecessor->total_length += absorb;
1533 CHECK_TOTAL_LENGTH (predecessor);
1534 delete_interval (i);
1535 return predecessor;
1538 predecessor = i;
1539 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1540 subtracting ABSORB. */
1542 if (AM_RIGHT_CHILD (predecessor))
1544 predecessor = INTERVAL_PARENT (predecessor);
1545 delete_interval (i);
1546 return predecessor;
1549 predecessor = INTERVAL_PARENT (predecessor);
1550 predecessor->total_length -= absorb;
1551 CHECK_TOTAL_LENGTH (predecessor);
1554 /* This must be the leftmost or first interval and cannot
1555 be merged left. The caller should have known. */
1556 abort ();
1559 /* Make an exact copy of interval tree SOURCE which descends from
1560 PARENT. This is done by recursing through SOURCE, copying
1561 the current interval and its properties, and then adjusting
1562 the pointers of the copy. */
1564 static INTERVAL
1565 reproduce_tree (INTERVAL source, INTERVAL parent)
1567 register INTERVAL t = make_interval ();
1569 memcpy (t, source, INTERVAL_SIZE);
1570 copy_properties (source, t);
1571 SET_INTERVAL_PARENT (t, parent);
1572 if (! NULL_LEFT_CHILD (source))
1573 t->left = reproduce_tree (source->left, t);
1574 if (! NULL_RIGHT_CHILD (source))
1575 t->right = reproduce_tree (source->right, t);
1577 return t;
1580 static INTERVAL
1581 reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
1583 register INTERVAL t = make_interval ();
1585 memcpy (t, source, INTERVAL_SIZE);
1586 copy_properties (source, t);
1587 SET_INTERVAL_OBJECT (t, parent);
1588 if (! NULL_LEFT_CHILD (source))
1589 t->left = reproduce_tree (source->left, t);
1590 if (! NULL_RIGHT_CHILD (source))
1591 t->right = reproduce_tree (source->right, t);
1593 return t;
1596 #if 0
1597 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1599 /* Make a new interval of length LENGTH starting at START in the
1600 group of intervals INTERVALS, which is actually an interval tree.
1601 Returns the new interval.
1603 Generate an error if the new positions would overlap an existing
1604 interval. */
1606 static INTERVAL
1607 make_new_interval (INTERVAL intervals, ptrdiff_t start, ptrdiff_t length)
1609 INTERVAL slot;
1611 slot = find_interval (intervals, start);
1612 if (start + length > slot->position + LENGTH (slot))
1613 error ("Interval would overlap");
1615 if (start == slot->position && length == LENGTH (slot))
1616 return slot;
1618 if (slot->position == start)
1620 /* New right node. */
1621 split_interval_right (slot, length);
1622 return slot;
1625 if (slot->position + LENGTH (slot) == start + length)
1627 /* New left node. */
1628 split_interval_left (slot, LENGTH (slot) - length);
1629 return slot;
1632 /* Convert interval SLOT into three intervals. */
1633 split_interval_left (slot, start - slot->position);
1634 split_interval_right (slot, length);
1635 return slot;
1637 #endif
1639 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1640 LENGTH is the length of the text in SOURCE.
1642 The `position' field of the SOURCE intervals is assumed to be
1643 consistent with its parent; therefore, SOURCE must be an
1644 interval tree made with copy_interval or must be the whole
1645 tree of a buffer or a string.
1647 This is used in insdel.c when inserting Lisp_Strings into the
1648 buffer. The text corresponding to SOURCE is already in the buffer
1649 when this is called. The intervals of new tree are a copy of those
1650 belonging to the string being inserted; intervals are never
1651 shared.
1653 If the inserted text had no intervals associated, and we don't
1654 want to inherit the surrounding text's properties, this function
1655 simply returns -- offset_intervals should handle placing the
1656 text in the correct interval, depending on the sticky bits.
1658 If the inserted text had properties (intervals), then there are two
1659 cases -- either insertion happened in the middle of some interval,
1660 or between two intervals.
1662 If the text goes into the middle of an interval, then new
1663 intervals are created in the middle with only the properties of
1664 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1665 which case the new text has the union of its properties and those
1666 of the text into which it was inserted.
1668 If the text goes between two intervals, then if neither interval
1669 had its appropriate sticky property set (front_sticky, rear_sticky),
1670 the new text has only its properties. If one of the sticky properties
1671 is set, then the new text "sticks" to that region and its properties
1672 depend on merging as above. If both the preceding and succeeding
1673 intervals to the new text are "sticky", then the new text retains
1674 only its properties, as if neither sticky property were set. Perhaps
1675 we should consider merging all three sets of properties onto the new
1676 text... */
1678 void
1679 graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
1680 ptrdiff_t length, struct buffer *buffer,
1681 int inherit)
1683 register INTERVAL under, over, this;
1684 register INTERVAL tree;
1685 ptrdiff_t over_used;
1687 tree = BUF_INTERVALS (buffer);
1689 /* If the new text has no properties, then with inheritance it
1690 becomes part of whatever interval it was inserted into.
1691 To prevent inheritance, we must clear out the properties
1692 of the newly inserted text. */
1693 if (NULL_INTERVAL_P (source))
1695 Lisp_Object buf;
1696 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1698 XSETBUFFER (buf, buffer);
1699 set_text_properties_1 (make_number (position),
1700 make_number (position + length),
1701 Qnil, buf, 0);
1703 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1704 /* Shouldn't be necessary. --Stef */
1705 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1706 return;
1709 eassert (length == TOTAL_LENGTH (source));
1711 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == length)
1712 { /* The inserted text constitutes the whole buffer, so
1713 simply copy over the interval structure. */
1714 Lisp_Object buf;
1715 XSETBUFFER (buf, buffer);
1716 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1717 BUF_INTERVALS (buffer)->position = BUF_BEG (buffer);
1718 eassert (BUF_INTERVALS (buffer)->up_obj == 1);
1719 return;
1721 else if (NULL_INTERVAL_P (tree))
1722 { /* Create an interval tree in which to place a copy
1723 of the intervals of the inserted string. */
1724 Lisp_Object buf;
1725 XSETBUFFER (buf, buffer);
1726 tree = create_root_interval (buf);
1728 /* Paranoia -- the text has already been added, so this buffer
1729 should be of non-zero length. */
1730 else if (TOTAL_LENGTH (tree) == 0)
1731 abort ();
1733 this = under = find_interval (tree, position);
1734 if (NULL_INTERVAL_P (under)) /* Paranoia. */
1735 abort ();
1736 over = find_interval (source, interval_start_pos (source));
1738 /* Here for insertion in the middle of an interval.
1739 Split off an equivalent interval to the right,
1740 then don't bother with it any more. */
1742 if (position > under->position)
1744 INTERVAL end_unchanged
1745 = split_interval_left (this, position - under->position);
1746 copy_properties (under, end_unchanged);
1747 under->position = position;
1749 else
1751 /* This call may have some effect because previous_interval may
1752 update `position' fields of intervals. Thus, don't ignore it
1753 for the moment. Someone please tell me the truth (K.Handa). */
1754 INTERVAL prev = previous_interval (under);
1755 (void) prev;
1756 #if 0
1757 /* But, this code surely has no effect. And, anyway,
1758 END_NONSTICKY_P is unreliable now. */
1759 if (prev && !END_NONSTICKY_P (prev))
1760 prev = 0;
1761 #endif /* 0 */
1764 /* Insertion is now at beginning of UNDER. */
1766 /* The inserted text "sticks" to the interval `under',
1767 which means it gets those properties.
1768 The properties of under are the result of
1769 adjust_intervals_for_insertion, so stickiness has
1770 already been taken care of. */
1772 /* OVER is the interval we are copying from next.
1773 OVER_USED says how many characters' worth of OVER
1774 have already been copied into target intervals.
1775 UNDER is the next interval in the target. */
1776 over_used = 0;
1777 while (! NULL_INTERVAL_P (over))
1779 /* If UNDER is longer than OVER, split it. */
1780 if (LENGTH (over) - over_used < LENGTH (under))
1782 this = split_interval_left (under, LENGTH (over) - over_used);
1783 copy_properties (under, this);
1785 else
1786 this = under;
1788 /* THIS is now the interval to copy or merge into.
1789 OVER covers all of it. */
1790 if (inherit)
1791 merge_properties (over, this);
1792 else
1793 copy_properties (over, this);
1795 /* If THIS and OVER end at the same place,
1796 advance OVER to a new source interval. */
1797 if (LENGTH (this) == LENGTH (over) - over_used)
1799 over = next_interval (over);
1800 over_used = 0;
1802 else
1803 /* Otherwise just record that more of OVER has been used. */
1804 over_used += LENGTH (this);
1806 /* Always advance to a new target interval. */
1807 under = next_interval (this);
1810 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1811 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1812 return;
1815 /* Get the value of property PROP from PLIST,
1816 which is the plist of an interval.
1817 We check for direct properties, for categories with property PROP,
1818 and for PROP appearing on the default-text-properties list. */
1820 Lisp_Object
1821 textget (Lisp_Object plist, register Lisp_Object prop)
1823 return lookup_char_property (plist, prop, 1);
1826 Lisp_Object
1827 lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
1829 register Lisp_Object tail, fallback = Qnil;
1831 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1833 register Lisp_Object tem;
1834 tem = XCAR (tail);
1835 if (EQ (prop, tem))
1836 return Fcar (XCDR (tail));
1837 if (EQ (tem, Qcategory))
1839 tem = Fcar (XCDR (tail));
1840 if (SYMBOLP (tem))
1841 fallback = Fget (tem, prop);
1845 if (! NILP (fallback))
1846 return fallback;
1847 /* Check for alternative properties */
1848 tail = Fassq (prop, Vchar_property_alias_alist);
1849 if (! NILP (tail))
1851 tail = XCDR (tail);
1852 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1853 fallback = Fplist_get (plist, XCAR (tail));
1856 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1857 fallback = Fplist_get (Vdefault_text_properties, prop);
1858 return fallback;
1862 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1863 byte position BYTEPOS. */
1865 void
1866 temp_set_point_both (struct buffer *buffer,
1867 ptrdiff_t charpos, ptrdiff_t bytepos)
1869 /* In a single-byte buffer, the two positions must be equal. */
1870 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1871 && charpos != bytepos)
1872 abort ();
1874 if (charpos > bytepos)
1875 abort ();
1877 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1878 abort ();
1880 SET_BUF_PT_BOTH (buffer, charpos, bytepos);
1883 /* Set point "temporarily", without checking any text properties. */
1885 void
1886 temp_set_point (struct buffer *buffer, ptrdiff_t charpos)
1888 temp_set_point_both (buffer, charpos,
1889 buf_charpos_to_bytepos (buffer, charpos));
1892 /* Set point in BUFFER to CHARPOS. If the target position is
1893 before an intangible character, move to an ok place. */
1895 void
1896 set_point (ptrdiff_t charpos)
1898 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1901 /* If there's an invisible character at position POS + TEST_OFFS in the
1902 current buffer, and the invisible property has a `stickiness' such that
1903 inserting a character at position POS would inherit the property it,
1904 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1905 then intangibility is required as well as invisibility.
1907 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1909 Note that `stickiness' is determined by overlay marker insertion types,
1910 if the invisible property comes from an overlay. */
1912 static ptrdiff_t
1913 adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj,
1914 int test_intang)
1916 Lisp_Object invis_propval, invis_overlay;
1917 Lisp_Object test_pos;
1919 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1920 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1921 return pos;
1923 test_pos = make_number (pos + test_offs);
1925 invis_propval
1926 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1927 &invis_overlay);
1929 if ((!test_intang
1930 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1931 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1932 /* This next test is true if the invisible property has a stickiness
1933 such that an insertion at POS would inherit it. */
1934 && (NILP (invis_overlay)
1935 /* Invisible property is from a text-property. */
1936 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1937 == (test_offs == 0 ? 1 : -1))
1938 /* Invisible property is from an overlay. */
1939 : (test_offs == 0
1940 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1941 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1942 pos += adj;
1944 return pos;
1947 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1948 position BYTEPOS. If the target position is
1949 before an intangible character, move to an ok place. */
1951 void
1952 set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
1954 register INTERVAL to, from, toprev, fromprev;
1955 ptrdiff_t buffer_point;
1956 ptrdiff_t old_position = PT;
1957 /* This ensures that we move forward past intangible text when the
1958 initial position is the same as the destination, in the rare
1959 instances where this is important, e.g. in line-move-finish
1960 (simple.el). */
1961 int backwards = (charpos < old_position ? 1 : 0);
1962 int have_overlays;
1963 ptrdiff_t original_position;
1965 BVAR (current_buffer, point_before_scroll) = Qnil;
1967 if (charpos == PT)
1968 return;
1970 /* In a single-byte buffer, the two positions must be equal. */
1971 eassert (ZV != ZV_BYTE || charpos == bytepos);
1973 /* Check this now, before checking if the buffer has any intervals.
1974 That way, we can catch conditions which break this sanity check
1975 whether or not there are intervals in the buffer. */
1976 eassert (charpos <= ZV && charpos >= BEGV);
1978 have_overlays = (current_buffer->overlays_before
1979 || current_buffer->overlays_after);
1981 /* If we have no text properties and overlays,
1982 then we can do it quickly. */
1983 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
1985 temp_set_point_both (current_buffer, charpos, bytepos);
1986 return;
1989 /* Set TO to the interval containing the char after CHARPOS,
1990 and TOPREV to the interval containing the char before CHARPOS.
1991 Either one may be null. They may be equal. */
1992 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
1993 if (charpos == BEGV)
1994 toprev = 0;
1995 else if (to && to->position == charpos)
1996 toprev = previous_interval (to);
1997 else
1998 toprev = to;
2000 buffer_point = (PT == ZV ? ZV - 1 : PT);
2002 /* Set FROM to the interval containing the char after PT,
2003 and FROMPREV to the interval containing the char before PT.
2004 Either one may be null. They may be equal. */
2005 /* We could cache this and save time. */
2006 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2007 if (buffer_point == BEGV)
2008 fromprev = 0;
2009 else if (from && from->position == PT)
2010 fromprev = previous_interval (from);
2011 else if (buffer_point != PT)
2012 fromprev = from, from = 0;
2013 else
2014 fromprev = from;
2016 /* Moving within an interval. */
2017 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2018 && ! have_overlays)
2020 temp_set_point_both (current_buffer, charpos, bytepos);
2021 return;
2024 original_position = charpos;
2026 /* If the new position is between two intangible characters
2027 with the same intangible property value,
2028 move forward or backward until a change in that property. */
2029 if (NILP (Vinhibit_point_motion_hooks)
2030 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2031 || have_overlays)
2032 /* Intangibility never stops us from positioning at the beginning
2033 or end of the buffer, so don't bother checking in that case. */
2034 && charpos != BEGV && charpos != ZV)
2036 Lisp_Object pos;
2037 Lisp_Object intangible_propval;
2039 if (backwards)
2041 /* If the preceding character is both intangible and invisible,
2042 and the invisible property is `rear-sticky', perturb it so
2043 that the search starts one character earlier -- this ensures
2044 that point can never move to the end of an invisible/
2045 intangible/rear-sticky region. */
2046 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2048 XSETINT (pos, charpos);
2050 /* If following char is intangible,
2051 skip back over all chars with matching intangible property. */
2053 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2055 if (! NILP (intangible_propval))
2057 while (XINT (pos) > BEGV
2058 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2059 Qintangible, Qnil),
2060 intangible_propval))
2061 pos = Fprevious_char_property_change (pos, Qnil);
2063 /* Set CHARPOS from POS, and if the final intangible character
2064 that we skipped over is also invisible, and the invisible
2065 property is `front-sticky', perturb it to be one character
2066 earlier -- this ensures that point can never move to the
2067 beginning of an invisible/intangible/front-sticky region. */
2068 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2071 else
2073 /* If the following character is both intangible and invisible,
2074 and the invisible property is `front-sticky', perturb it so
2075 that the search starts one character later -- this ensures
2076 that point can never move to the beginning of an
2077 invisible/intangible/front-sticky region. */
2078 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2080 XSETINT (pos, charpos);
2082 /* If preceding char is intangible,
2083 skip forward over all chars with matching intangible property. */
2085 intangible_propval = Fget_char_property (make_number (charpos - 1),
2086 Qintangible, Qnil);
2088 if (! NILP (intangible_propval))
2090 while (XINT (pos) < ZV
2091 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2092 intangible_propval))
2093 pos = Fnext_char_property_change (pos, Qnil);
2095 /* Set CHARPOS from POS, and if the final intangible character
2096 that we skipped over is also invisible, and the invisible
2097 property is `rear-sticky', perturb it to be one character
2098 later -- this ensures that point can never move to the
2099 end of an invisible/intangible/rear-sticky region. */
2100 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2104 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2107 if (charpos != original_position)
2109 /* Set TO to the interval containing the char after CHARPOS,
2110 and TOPREV to the interval containing the char before CHARPOS.
2111 Either one may be null. They may be equal. */
2112 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2113 if (charpos == BEGV)
2114 toprev = 0;
2115 else if (to && to->position == charpos)
2116 toprev = previous_interval (to);
2117 else
2118 toprev = to;
2121 /* Here TO is the interval after the stopping point
2122 and TOPREV is the interval before the stopping point.
2123 One or the other may be null. */
2125 temp_set_point_both (current_buffer, charpos, bytepos);
2127 /* We run point-left and point-entered hooks here, if the
2128 two intervals are not equivalent. These hooks take
2129 (old_point, new_point) as arguments. */
2130 if (NILP (Vinhibit_point_motion_hooks)
2131 && (! intervals_equal (from, to)
2132 || ! intervals_equal (fromprev, toprev)))
2134 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2136 if (fromprev)
2137 leave_before = textget (fromprev->plist, Qpoint_left);
2138 else
2139 leave_before = Qnil;
2141 if (from)
2142 leave_after = textget (from->plist, Qpoint_left);
2143 else
2144 leave_after = Qnil;
2146 if (toprev)
2147 enter_before = textget (toprev->plist, Qpoint_entered);
2148 else
2149 enter_before = Qnil;
2151 if (to)
2152 enter_after = textget (to->plist, Qpoint_entered);
2153 else
2154 enter_after = Qnil;
2156 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2157 call2 (leave_before, make_number (old_position),
2158 make_number (charpos));
2159 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2160 call2 (leave_after, make_number (old_position),
2161 make_number (charpos));
2163 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2164 call2 (enter_before, make_number (old_position),
2165 make_number (charpos));
2166 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2167 call2 (enter_after, make_number (old_position),
2168 make_number (charpos));
2172 /* Move point to POSITION, unless POSITION is inside an intangible
2173 segment that reaches all the way to point. */
2175 void
2176 move_if_not_intangible (ptrdiff_t position)
2178 Lisp_Object pos;
2179 Lisp_Object intangible_propval;
2181 XSETINT (pos, position);
2183 if (! NILP (Vinhibit_point_motion_hooks))
2184 /* If intangible is inhibited, always move point to POSITION. */
2186 else if (PT < position && XINT (pos) < ZV)
2188 /* We want to move forward, so check the text before POSITION. */
2190 intangible_propval = Fget_char_property (pos,
2191 Qintangible, Qnil);
2193 /* If following char is intangible,
2194 skip back over all chars with matching intangible property. */
2195 if (! NILP (intangible_propval))
2196 while (XINT (pos) > BEGV
2197 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2198 Qintangible, Qnil),
2199 intangible_propval))
2200 pos = Fprevious_char_property_change (pos, Qnil);
2202 else if (XINT (pos) > BEGV)
2204 /* We want to move backward, so check the text after POSITION. */
2206 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2207 Qintangible, Qnil);
2209 /* If following char is intangible,
2210 skip forward over all chars with matching intangible property. */
2211 if (! NILP (intangible_propval))
2212 while (XINT (pos) < ZV
2213 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2214 intangible_propval))
2215 pos = Fnext_char_property_change (pos, Qnil);
2218 else if (position < BEGV)
2219 position = BEGV;
2220 else if (position > ZV)
2221 position = ZV;
2223 /* If the whole stretch between PT and POSITION isn't intangible,
2224 try moving to POSITION (which means we actually move farther
2225 if POSITION is inside of intangible text). */
2227 if (XINT (pos) != PT)
2228 SET_PT (position);
2231 /* If text at position POS has property PROP, set *VAL to the property
2232 value, *START and *END to the beginning and end of a region that
2233 has the same property, and return 1. Otherwise return 0.
2235 OBJECT is the string or buffer to look for the property in;
2236 nil means the current buffer. */
2239 get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val,
2240 ptrdiff_t *start, ptrdiff_t *end, Lisp_Object object)
2242 INTERVAL i, prev, next;
2244 if (NILP (object))
2245 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2246 else if (BUFFERP (object))
2247 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2248 else if (STRINGP (object))
2249 i = find_interval (STRING_INTERVALS (object), pos);
2250 else
2251 abort ();
2253 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2254 return 0;
2255 *val = textget (i->plist, prop);
2256 if (NILP (*val))
2257 return 0;
2259 next = i; /* remember it in advance */
2260 prev = previous_interval (i);
2261 while (! NULL_INTERVAL_P (prev)
2262 && EQ (*val, textget (prev->plist, prop)))
2263 i = prev, prev = previous_interval (prev);
2264 *start = i->position;
2266 next = next_interval (i);
2267 while (! NULL_INTERVAL_P (next)
2268 && EQ (*val, textget (next->plist, prop)))
2269 i = next, next = next_interval (next);
2270 *end = i->position + LENGTH (i);
2272 return 1;
2275 /* Return the proper local keymap TYPE for position POSITION in
2276 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2277 specified by the PROP property, if any. Otherwise, if TYPE is
2278 `local-map' use BUFFER's local map.
2280 POSITION must be in the accessible part of BUFFER. */
2282 Lisp_Object
2283 get_local_map (register ptrdiff_t position, register struct buffer *buffer,
2284 Lisp_Object type)
2286 Lisp_Object prop, lispy_position, lispy_buffer;
2287 ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte;
2289 /* Perhaps we should just change `position' to the limit. */
2290 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2291 abort ();
2293 /* Ignore narrowing, so that a local map continues to be valid even if
2294 the visible region contains no characters and hence no properties. */
2295 old_begv = BUF_BEGV (buffer);
2296 old_zv = BUF_ZV (buffer);
2297 old_begv_byte = BUF_BEGV_BYTE (buffer);
2298 old_zv_byte = BUF_ZV_BYTE (buffer);
2300 SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer));
2301 SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer));
2303 XSETFASTINT (lispy_position, position);
2304 XSETBUFFER (lispy_buffer, buffer);
2305 /* First check if the CHAR has any property. This is because when
2306 we click with the mouse, the mouse pointer is really pointing
2307 to the CHAR after POS. */
2308 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2309 /* If not, look at the POS's properties. This is necessary because when
2310 editing a field with a `local-map' property, we want insertion at the end
2311 to obey the `local-map' property. */
2312 if (NILP (prop))
2313 prop = get_pos_property (lispy_position, type, lispy_buffer);
2315 SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte);
2316 SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte);
2318 /* Use the local map only if it is valid. */
2319 prop = get_keymap (prop, 0, 0);
2320 if (CONSP (prop))
2321 return prop;
2323 if (EQ (type, Qkeymap))
2324 return Qnil;
2325 else
2326 return BVAR (buffer, keymap);
2329 /* Produce an interval tree reflecting the intervals in
2330 TREE from START to START + LENGTH.
2331 The new interval tree has no parent and has a starting-position of 0. */
2333 INTERVAL
2334 copy_intervals (INTERVAL tree, ptrdiff_t start, ptrdiff_t length)
2336 register INTERVAL i, new, t;
2337 register ptrdiff_t got, prevlen;
2339 if (NULL_INTERVAL_P (tree) || length <= 0)
2340 return NULL_INTERVAL;
2342 i = find_interval (tree, start);
2343 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2344 abort ();
2346 /* If there is only one interval and it's the default, return nil. */
2347 if ((start - i->position + 1 + length) < LENGTH (i)
2348 && DEFAULT_INTERVAL_P (i))
2349 return NULL_INTERVAL;
2351 new = make_interval ();
2352 new->position = 0;
2353 got = (LENGTH (i) - (start - i->position));
2354 new->total_length = length;
2355 CHECK_TOTAL_LENGTH (new);
2356 copy_properties (i, new);
2358 t = new;
2359 prevlen = got;
2360 while (got < length)
2362 i = next_interval (i);
2363 t = split_interval_right (t, prevlen);
2364 copy_properties (i, t);
2365 prevlen = LENGTH (i);
2366 got += prevlen;
2369 return balance_an_interval (new);
2372 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2374 void
2375 copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
2376 ptrdiff_t position, ptrdiff_t length)
2378 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2379 position, length);
2380 if (NULL_INTERVAL_P (interval_copy))
2381 return;
2383 SET_INTERVAL_OBJECT (interval_copy, string);
2384 STRING_SET_INTERVALS (string, interval_copy);
2387 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2388 Assume they have identical characters. */
2391 compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
2393 INTERVAL i1, i2;
2394 ptrdiff_t pos = 0;
2395 ptrdiff_t end = SCHARS (s1);
2397 i1 = find_interval (STRING_INTERVALS (s1), 0);
2398 i2 = find_interval (STRING_INTERVALS (s2), 0);
2400 while (pos < end)
2402 /* Determine how far we can go before we reach the end of I1 or I2. */
2403 ptrdiff_t len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2404 ptrdiff_t len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2405 ptrdiff_t distance = min (len1, len2);
2407 /* If we ever find a mismatch between the strings,
2408 they differ. */
2409 if (! intervals_equal (i1, i2))
2410 return 0;
2412 /* Advance POS till the end of the shorter interval,
2413 and advance one or both interval pointers for the new position. */
2414 pos += distance;
2415 if (len1 == distance)
2416 i1 = next_interval (i1);
2417 if (len2 == distance)
2418 i2 = next_interval (i2);
2420 return 1;
2423 /* Recursively adjust interval I in the current buffer
2424 for setting enable_multibyte_characters to MULTI_FLAG.
2425 The range of interval I is START ... END in characters,
2426 START_BYTE ... END_BYTE in bytes. */
2428 static void
2429 set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
2430 ptrdiff_t start, ptrdiff_t start_byte,
2431 ptrdiff_t end, ptrdiff_t end_byte)
2433 /* Fix the length of this interval. */
2434 if (multi_flag)
2435 i->total_length = end - start;
2436 else
2437 i->total_length = end_byte - start_byte;
2438 CHECK_TOTAL_LENGTH (i);
2440 if (TOTAL_LENGTH (i) == 0)
2442 delete_interval (i);
2443 return;
2446 /* Recursively fix the length of the subintervals. */
2447 if (i->left)
2449 ptrdiff_t left_end, left_end_byte;
2451 if (multi_flag)
2453 ptrdiff_t temp;
2454 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2455 left_end = BYTE_TO_CHAR (left_end_byte);
2457 temp = CHAR_TO_BYTE (left_end);
2459 /* If LEFT_END_BYTE is in the middle of a character,
2460 adjust it and LEFT_END to a char boundary. */
2461 if (left_end_byte > temp)
2463 left_end_byte = temp;
2465 if (left_end_byte < temp)
2467 left_end--;
2468 left_end_byte = CHAR_TO_BYTE (left_end);
2471 else
2473 left_end = start + LEFT_TOTAL_LENGTH (i);
2474 left_end_byte = CHAR_TO_BYTE (left_end);
2477 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2478 left_end, left_end_byte);
2480 if (i->right)
2482 ptrdiff_t right_start_byte, right_start;
2484 if (multi_flag)
2486 ptrdiff_t temp;
2488 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2489 right_start = BYTE_TO_CHAR (right_start_byte);
2491 /* If RIGHT_START_BYTE is in the middle of a character,
2492 adjust it and RIGHT_START to a char boundary. */
2493 temp = CHAR_TO_BYTE (right_start);
2495 if (right_start_byte < temp)
2497 right_start_byte = temp;
2499 if (right_start_byte > temp)
2501 right_start++;
2502 right_start_byte = CHAR_TO_BYTE (right_start);
2505 else
2507 right_start = end - RIGHT_TOTAL_LENGTH (i);
2508 right_start_byte = CHAR_TO_BYTE (right_start);
2511 set_intervals_multibyte_1 (i->right, multi_flag,
2512 right_start, right_start_byte,
2513 end, end_byte);
2516 /* Rounding to char boundaries can theoretically ake this interval
2517 spurious. If so, delete one child, and copy its property list
2518 to this interval. */
2519 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2521 if ((i)->left)
2523 (i)->plist = (i)->left->plist;
2524 (i)->left->total_length = 0;
2525 delete_interval ((i)->left);
2527 else
2529 (i)->plist = (i)->right->plist;
2530 (i)->right->total_length = 0;
2531 delete_interval ((i)->right);
2536 /* Update the intervals of the current buffer
2537 to fit the contents as multibyte (if MULTI_FLAG is 1)
2538 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2540 void
2541 set_intervals_multibyte (int multi_flag)
2543 if (BUF_INTERVALS (current_buffer))
2544 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2545 BEG, BEG_BYTE, Z, Z_BYTE);