(cl-map-keymap): Redefine as alias.
[emacs.git] / src / intervals.c
blob21048f93cb1cc9e781cf32f54daa38d427a2fb87
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 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; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* NOTES:
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
27 An idea: Have the owner of the tree keep count of splits and/or
28 insertion lengths (in intervals), and balance after every N.
30 Need to call *_left_hook when buffer is killed.
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
35 There are comments around about freeing intervals. It might be
36 faster to explicitly free them (put them on the free list) than
37 to GC them.
42 #include <config.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 = 1;
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 (! EQ (o, Qnil))
126 sym = Fcar (o);
127 val = Fmemq (sym, target->plist);
129 if (NILP (val))
131 o = Fcdr (o);
132 val = Fcar (o);
133 target->plist = Fcons (sym, Fcons (val, target->plist));
134 o = Fcdr (o);
136 else
137 o = Fcdr (Fcdr (o));
141 /* Return 1 if the two intervals have the same properties,
142 0 otherwise. */
145 intervals_equal (i0, i1)
146 INTERVAL i0, i1;
148 register Lisp_Object i0_cdr, i0_sym, i1_val;
149 register int i1_len;
151 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
152 return 1;
154 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
155 return 0;
157 i1_len = XFASTINT (Flength (i1->plist));
158 if (i1_len & 0x1) /* Paranoia -- plists are always even */
159 abort ();
160 i1_len /= 2;
161 i0_cdr = i0->plist;
162 while (!NILP (i0_cdr))
164 /* Lengths of the two plists were unequal. */
165 if (i1_len == 0)
166 return 0;
168 i0_sym = Fcar (i0_cdr);
169 i1_val = Fmemq (i0_sym, i1->plist);
171 /* i0 has something i1 doesn't. */
172 if (EQ (i1_val, Qnil))
173 return 0;
175 /* i0 and i1 both have sym, but it has different values in each. */
176 i0_cdr = Fcdr (i0_cdr);
177 if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
178 return 0;
180 i0_cdr = Fcdr (i0_cdr);
181 i1_len--;
184 /* Lengths of the two plists were unequal. */
185 if (i1_len > 0)
186 return 0;
188 return 1;
192 /* Traverse an interval tree TREE, performing FUNCTION on each node.
193 No guarantee is made about the order of traversal.
194 Pass FUNCTION two args: an interval, and ARG. */
196 void
197 traverse_intervals_noorder (tree, function, arg)
198 INTERVAL tree;
199 void (* function) P_ ((INTERVAL, Lisp_Object));
200 Lisp_Object arg;
202 /* Minimize stack usage. */
203 while (!NULL_INTERVAL_P (tree))
205 (*function) (tree, arg);
206 if (NULL_INTERVAL_P (tree->right))
207 tree = tree->left;
208 else
210 traverse_intervals_noorder (tree->left, function, arg);
211 tree = tree->right;
216 /* Traverse an interval tree TREE, performing FUNCTION on each node.
217 Pass FUNCTION two args: an interval, and ARG. */
219 void
220 traverse_intervals (tree, position, function, arg)
221 INTERVAL tree;
222 int position;
223 void (* function) P_ ((INTERVAL, Lisp_Object));
224 Lisp_Object arg;
226 while (!NULL_INTERVAL_P (tree))
228 traverse_intervals (tree->left, position, function, arg);
229 position += LEFT_TOTAL_LENGTH (tree);
230 tree->position = position;
231 (*function) (tree, arg);
232 position += LENGTH (tree); tree = tree->right;
236 #if 0
238 static int icount;
239 static int idepth;
240 static int zero_length;
242 /* These functions are temporary, for debugging purposes only. */
244 INTERVAL search_interval, found_interval;
246 void
247 check_for_interval (i)
248 register INTERVAL i;
250 if (i == search_interval)
252 found_interval = i;
253 icount++;
257 INTERVAL
258 search_for_interval (i, tree)
259 register INTERVAL i, tree;
261 icount = 0;
262 search_interval = i;
263 found_interval = NULL_INTERVAL;
264 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
265 return found_interval;
268 static void
269 inc_interval_count (i)
270 INTERVAL i;
272 icount++;
273 if (LENGTH (i) == 0)
274 zero_length++;
275 if (depth > idepth)
276 idepth = depth;
280 count_intervals (i)
281 register 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)
293 INTERVAL interval;
295 register INTERVAL i = interval;
297 while (! ROOT_INTERVAL_P (i))
298 i = INTERVAL_PARENT (i);
300 return i;
302 #endif
304 /* Assuming that a left child exists, perform the following operation:
307 / \ / \
308 B => A
309 / \ / \
313 static INLINE INTERVAL
314 rotate_right (interval)
315 INTERVAL interval;
317 INTERVAL i;
318 INTERVAL B = interval->left;
319 int old_total = interval->total_length;
321 /* Deal with any Parent of A; make it point to B. */
322 if (! ROOT_INTERVAL_P (interval))
324 if (AM_LEFT_CHILD (interval))
325 INTERVAL_PARENT (interval)->left = B;
326 else
327 INTERVAL_PARENT (interval)->right = B;
329 COPY_INTERVAL_PARENT (B, interval);
331 /* Make B the parent of A */
332 i = B->right;
333 B->right = interval;
334 SET_INTERVAL_PARENT (interval, B);
336 /* Make A point to c */
337 interval->left = i;
338 if (! NULL_INTERVAL_P (i))
339 SET_INTERVAL_PARENT (i, interval);
341 /* A's total length is decreased by the length of B and its left child. */
342 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
343 CHECK_TOTAL_LENGTH (interval);
345 /* B must have the same total length of A. */
346 B->total_length = old_total;
347 CHECK_TOTAL_LENGTH (B);
349 return B;
352 /* Assuming that a right child exists, perform the following operation:
355 / \ / \
356 B => A
357 / \ / \
361 static INLINE INTERVAL
362 rotate_left (interval)
363 INTERVAL interval;
365 INTERVAL i;
366 INTERVAL B = interval->right;
367 int old_total = interval->total_length;
369 /* Deal with any parent of A; make it point to B. */
370 if (! ROOT_INTERVAL_P (interval))
372 if (AM_LEFT_CHILD (interval))
373 INTERVAL_PARENT (interval)->left = B;
374 else
375 INTERVAL_PARENT (interval)->right = B;
377 COPY_INTERVAL_PARENT (B, interval);
379 /* Make B the parent of A */
380 i = B->left;
381 B->left = interval;
382 SET_INTERVAL_PARENT (interval, B);
384 /* Make A point to c */
385 interval->right = i;
386 if (! NULL_INTERVAL_P (i))
387 SET_INTERVAL_PARENT (i, interval);
389 /* A's total length is decreased by the length of B and its right child. */
390 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
391 CHECK_TOTAL_LENGTH (interval);
393 /* B must have the same total length of A. */
394 B->total_length = old_total;
395 CHECK_TOTAL_LENGTH (B);
397 return B;
400 /* Balance an interval tree with the assumption that the subtrees
401 themselves are already balanced. */
403 static INTERVAL
404 balance_an_interval (i)
405 INTERVAL i;
407 register int old_diff, new_diff;
409 while (1)
411 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
412 if (old_diff > 0)
414 /* Since the left child is longer, there must be one. */
415 new_diff = i->total_length - i->left->total_length
416 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
417 if (abs (new_diff) >= old_diff)
418 break;
419 i = rotate_right (i);
420 balance_an_interval (i->right);
422 else if (old_diff < 0)
424 /* Since the right child is longer, there must be one. */
425 new_diff = i->total_length - i->right->total_length
426 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
427 if (abs (new_diff) >= -old_diff)
428 break;
429 i = rotate_left (i);
430 balance_an_interval (i->left);
432 else
433 break;
435 return i;
438 /* Balance INTERVAL, potentially stuffing it back into its parent
439 Lisp Object. */
441 static INLINE INTERVAL
442 balance_possible_root_interval (interval)
443 register INTERVAL interval;
445 Lisp_Object parent;
446 int have_parent = 0;
448 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
449 return interval;
451 if (INTERVAL_HAS_OBJECT (interval))
453 have_parent = 1;
454 GET_INTERVAL_OBJECT (parent, interval);
456 interval = balance_an_interval (interval);
458 if (have_parent)
460 if (BUFFERP (parent))
461 BUF_INTERVALS (XBUFFER (parent)) = interval;
462 else if (STRINGP (parent))
463 STRING_SET_INTERVALS (parent, interval);
466 return interval;
469 /* Balance the interval tree TREE. Balancing is by weight
470 (the amount of text). */
472 static INTERVAL
473 balance_intervals_internal (tree)
474 register INTERVAL tree;
476 /* Balance within each side. */
477 if (tree->left)
478 balance_intervals_internal (tree->left);
479 if (tree->right)
480 balance_intervals_internal (tree->right);
481 return balance_an_interval (tree);
484 /* Advertised interface to balance intervals. */
486 INTERVAL
487 balance_intervals (tree)
488 INTERVAL tree;
490 if (tree == NULL_INTERVAL)
491 return NULL_INTERVAL;
493 return balance_intervals_internal (tree);
496 /* Split INTERVAL into two pieces, starting the second piece at
497 character position OFFSET (counting from 0), relative to INTERVAL.
498 INTERVAL becomes the left-hand piece, and the right-hand piece
499 (second, lexicographically) is returned.
501 The size and position fields of the two intervals are set based upon
502 those of the original interval. The property list of the new interval
503 is reset, thus it is up to the caller to do the right thing with the
504 result.
506 Note that this does not change the position of INTERVAL; if it is a root,
507 it is still a root after this operation. */
509 INTERVAL
510 split_interval_right (interval, offset)
511 INTERVAL interval;
512 int offset;
514 INTERVAL new = make_interval ();
515 int position = interval->position;
516 int new_length = LENGTH (interval) - offset;
518 new->position = position + offset;
519 SET_INTERVAL_PARENT (new, interval);
521 if (NULL_RIGHT_CHILD (interval))
523 interval->right = new;
524 new->total_length = new_length;
525 CHECK_TOTAL_LENGTH (new);
527 else
529 /* Insert the new node between INTERVAL and its right child. */
530 new->right = interval->right;
531 SET_INTERVAL_PARENT (interval->right, new);
532 interval->right = new;
533 new->total_length = new_length + new->right->total_length;
534 CHECK_TOTAL_LENGTH (new);
535 balance_an_interval (new);
538 balance_possible_root_interval (interval);
540 return new;
543 /* Split INTERVAL into two pieces, starting the second piece at
544 character position OFFSET (counting from 0), relative to INTERVAL.
545 INTERVAL becomes the right-hand piece, and the left-hand piece
546 (first, lexicographically) is returned.
548 The size and position fields of the two intervals are set based upon
549 those of the original interval. The property list of the new interval
550 is reset, thus it is up to the caller to do the right thing with the
551 result.
553 Note that this does not change the position of INTERVAL; if it is a root,
554 it is still a root after this operation. */
556 INTERVAL
557 split_interval_left (interval, offset)
558 INTERVAL interval;
559 int offset;
561 INTERVAL new = make_interval ();
562 int new_length = offset;
564 new->position = interval->position;
565 interval->position = interval->position + offset;
566 SET_INTERVAL_PARENT (new, interval);
568 if (NULL_LEFT_CHILD (interval))
570 interval->left = new;
571 new->total_length = new_length;
572 CHECK_TOTAL_LENGTH (new);
574 else
576 /* Insert the new node between INTERVAL and its left child. */
577 new->left = interval->left;
578 SET_INTERVAL_PARENT (new->left, new);
579 interval->left = new;
580 new->total_length = new_length + new->left->total_length;
581 CHECK_TOTAL_LENGTH (new);
582 balance_an_interval (new);
585 balance_possible_root_interval (interval);
587 return new;
590 /* Return the proper position for the first character
591 described by the interval tree SOURCE.
592 This is 1 if the parent is a buffer,
593 0 if the parent is a string or if there is no parent.
595 Don't use this function on an interval which is the child
596 of another interval! */
599 interval_start_pos (source)
600 INTERVAL source;
602 Lisp_Object parent;
604 if (NULL_INTERVAL_P (source))
605 return 0;
607 if (! INTERVAL_HAS_OBJECT (source))
608 return 0;
609 GET_INTERVAL_OBJECT (parent, source);
610 if (BUFFERP (parent))
611 return BUF_BEG (XBUFFER (parent));
612 return 0;
615 /* Find the interval containing text position POSITION in the text
616 represented by the interval tree TREE. POSITION is a buffer
617 position (starting from 1) or a string index (starting from 0).
618 If POSITION is at the end of the buffer or string,
619 return the interval containing the last character.
621 The `position' field, which is a cache of an interval's position,
622 is updated in the interval found. Other functions (e.g., next_interval)
623 will update this cache based on the result of find_interval. */
625 INTERVAL
626 find_interval (tree, position)
627 register INTERVAL tree;
628 register int position;
630 /* The distance from the left edge of the subtree at TREE
631 to POSITION. */
632 register int relative_position;
634 if (NULL_INTERVAL_P (tree))
635 return NULL_INTERVAL;
637 relative_position = position;
638 if (INTERVAL_HAS_OBJECT (tree))
640 Lisp_Object parent;
641 GET_INTERVAL_OBJECT (parent, tree);
642 if (BUFFERP (parent))
643 relative_position -= BUF_BEG (XBUFFER (parent));
646 if (relative_position > TOTAL_LENGTH (tree))
647 abort (); /* Paranoia */
649 if (!handling_signal)
650 tree = balance_possible_root_interval (tree);
652 while (1)
654 if (relative_position < LEFT_TOTAL_LENGTH (tree))
656 tree = tree->left;
658 else if (! NULL_RIGHT_CHILD (tree)
659 && relative_position >= (TOTAL_LENGTH (tree)
660 - RIGHT_TOTAL_LENGTH (tree)))
662 relative_position -= (TOTAL_LENGTH (tree)
663 - RIGHT_TOTAL_LENGTH (tree));
664 tree = tree->right;
666 else
668 tree->position
669 = (position - relative_position /* the left edge of *tree */
670 + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
672 return tree;
677 /* Find the succeeding interval (lexicographically) to INTERVAL.
678 Sets the `position' field based on that of INTERVAL (see
679 find_interval). */
681 INTERVAL
682 next_interval (interval)
683 register INTERVAL interval;
685 register INTERVAL i = interval;
686 register int next_position;
688 if (NULL_INTERVAL_P (i))
689 return NULL_INTERVAL;
690 next_position = interval->position + LENGTH (interval);
692 if (! NULL_RIGHT_CHILD (i))
694 i = i->right;
695 while (! NULL_LEFT_CHILD (i))
696 i = i->left;
698 i->position = next_position;
699 return i;
702 while (! NULL_PARENT (i))
704 if (AM_LEFT_CHILD (i))
706 i = INTERVAL_PARENT (i);
707 i->position = next_position;
708 return i;
711 i = INTERVAL_PARENT (i);
714 return NULL_INTERVAL;
717 /* Find the preceding interval (lexicographically) to INTERVAL.
718 Sets the `position' field based on that of INTERVAL (see
719 find_interval). */
721 INTERVAL
722 previous_interval (interval)
723 register INTERVAL interval;
725 register INTERVAL i;
727 if (NULL_INTERVAL_P (interval))
728 return NULL_INTERVAL;
730 if (! NULL_LEFT_CHILD (interval))
732 i = interval->left;
733 while (! NULL_RIGHT_CHILD (i))
734 i = i->right;
736 i->position = interval->position - LENGTH (i);
737 return i;
740 i = interval;
741 while (! NULL_PARENT (i))
743 if (AM_RIGHT_CHILD (i))
745 i = INTERVAL_PARENT (i);
747 i->position = interval->position - LENGTH (i);
748 return i;
750 i = INTERVAL_PARENT (i);
753 return NULL_INTERVAL;
756 /* Find the interval containing POS given some non-NULL INTERVAL
757 in the same tree. Note that we need to update interval->position
758 if we go down the tree.
759 To speed up the process, we assume that the ->position of
760 I and all its parents is already uptodate. */
761 INTERVAL
762 update_interval (i, pos)
763 register INTERVAL i;
764 int pos;
766 if (NULL_INTERVAL_P (i))
767 return NULL_INTERVAL;
769 while (1)
771 if (pos < i->position)
773 /* Move left. */
774 if (pos >= i->position - TOTAL_LENGTH (i->left))
776 i->left->position = i->position - TOTAL_LENGTH (i->left)
777 + LEFT_TOTAL_LENGTH (i->left);
778 i = i->left; /* Move to the left child */
780 else if (NULL_PARENT (i))
781 error ("Point before start of properties");
782 else
783 i = INTERVAL_PARENT (i);
784 continue;
786 else if (pos >= INTERVAL_LAST_POS (i))
788 /* Move right. */
789 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
791 i->right->position = INTERVAL_LAST_POS (i) +
792 LEFT_TOTAL_LENGTH (i->right);
793 i = i->right; /* Move to the right child */
795 else if (NULL_PARENT (i))
796 error ("Point after end of properties");
797 else
798 i = INTERVAL_PARENT (i);
799 continue;
801 else
802 return i;
807 #if 0
808 /* Traverse a path down the interval tree TREE to the interval
809 containing POSITION, adjusting all nodes on the path for
810 an addition of LENGTH characters. Insertion between two intervals
811 (i.e., point == i->position, where i is second interval) means
812 text goes into second interval.
814 Modifications are needed to handle the hungry bits -- after simply
815 finding the interval at position (don't add length going down),
816 if it's the beginning of the interval, get the previous interval
817 and check the hungry bits of both. Then add the length going back up
818 to the root. */
820 static INTERVAL
821 adjust_intervals_for_insertion (tree, position, length)
822 INTERVAL tree;
823 int position, length;
825 register int relative_position;
826 register INTERVAL this;
828 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
829 abort ();
831 /* If inserting at point-max of a buffer, that position
832 will be out of range */
833 if (position > TOTAL_LENGTH (tree))
834 position = TOTAL_LENGTH (tree);
835 relative_position = position;
836 this = tree;
838 while (1)
840 if (relative_position <= LEFT_TOTAL_LENGTH (this))
842 this->total_length += length;
843 CHECK_TOTAL_LENGTH (this);
844 this = this->left;
846 else if (relative_position > (TOTAL_LENGTH (this)
847 - RIGHT_TOTAL_LENGTH (this)))
849 relative_position -= (TOTAL_LENGTH (this)
850 - RIGHT_TOTAL_LENGTH (this));
851 this->total_length += length;
852 CHECK_TOTAL_LENGTH (this);
853 this = this->right;
855 else
857 /* If we are to use zero-length intervals as buffer pointers,
858 then this code will have to change. */
859 this->total_length += length;
860 CHECK_TOTAL_LENGTH (this);
861 this->position = LEFT_TOTAL_LENGTH (this)
862 + position - relative_position + 1;
863 return tree;
867 #endif
869 /* Effect an adjustment corresponding to the addition of LENGTH characters
870 of text. Do this by finding the interval containing POSITION in the
871 interval tree TREE, and then adjusting all of its ancestors by adding
872 LENGTH to them.
874 If POSITION is the first character of an interval, meaning that point
875 is actually between the two intervals, make the new text belong to
876 the interval which is "sticky".
878 If both intervals are "sticky", then make them belong to the left-most
879 interval. Another possibility would be to create a new interval for
880 this text, and make it have the merged properties of both ends. */
882 static INTERVAL
883 adjust_intervals_for_insertion (tree, position, length)
884 INTERVAL tree;
885 int position, length;
887 register INTERVAL i;
888 register INTERVAL temp;
889 int eobp = 0;
890 Lisp_Object parent;
891 int offset;
893 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
894 abort ();
896 GET_INTERVAL_OBJECT (parent, tree);
897 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
899 /* If inserting at point-max of a buffer, that position will be out
900 of range. Remember that buffer positions are 1-based. */
901 if (position >= TOTAL_LENGTH (tree) + offset)
903 position = TOTAL_LENGTH (tree) + offset;
904 eobp = 1;
907 i = find_interval (tree, position);
909 /* If in middle of an interval which is not sticky either way,
910 we must not just give its properties to the insertion.
911 So split this interval at the insertion point.
913 Originally, the if condition here was this:
914 (! (position == i->position || eobp)
915 && END_NONSTICKY_P (i)
916 && FRONT_NONSTICKY_P (i))
917 But, these macros are now unreliable because of introduction of
918 Vtext_property_default_nonsticky. So, we always check properties
919 one by one if POSITION is in middle of an interval. */
920 if (! (position == i->position || eobp))
922 Lisp_Object tail;
923 Lisp_Object front, rear;
925 tail = i->plist;
927 /* Properties font-sticky and rear-nonsticky override
928 Vtext_property_default_nonsticky. So, if they are t, we can
929 skip one by one checking of properties. */
930 rear = textget (i->plist, Qrear_nonsticky);
931 if (! CONSP (rear) && ! NILP (rear))
933 /* All properties are nonsticky. We split the interval. */
934 goto check_done;
936 front = textget (i->plist, Qfront_sticky);
937 if (! CONSP (front) && ! NILP (front))
939 /* All properties are sticky. We don't split the interval. */
940 tail = Qnil;
941 goto check_done;
944 /* Does any actual property pose an actual problem? We break
945 the loop if we find a nonsticky property. */
946 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
948 Lisp_Object prop, tmp;
949 prop = XCAR (tail);
951 /* Is this particular property front-sticky? */
952 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
953 continue;
955 /* Is this particular property rear-nonsticky? */
956 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
957 break;
959 /* Is this particular property recorded as sticky or
960 nonsticky in Vtext_property_default_nonsticky? */
961 tmp = Fassq (prop, Vtext_property_default_nonsticky);
962 if (CONSP (tmp))
964 if (NILP (tmp))
965 continue;
966 break;
969 /* By default, a text property is rear-sticky, thus we
970 continue the loop. */
973 check_done:
974 /* If any property is a real problem, split the interval. */
975 if (! NILP (tail))
977 temp = split_interval_right (i, position - i->position);
978 copy_properties (i, temp);
979 i = temp;
983 /* If we are positioned between intervals, check the stickiness of
984 both of them. We have to do this too, if we are at BEG or Z. */
985 if (position == i->position || eobp)
987 register INTERVAL prev;
989 if (position == BEG)
990 prev = 0;
991 else if (eobp)
993 prev = i;
994 i = 0;
996 else
997 prev = previous_interval (i);
999 /* Even if we are positioned between intervals, we default
1000 to the left one if it exists. We extend it now and split
1001 off a part later, if stickiness demands it. */
1002 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1004 temp->total_length += length;
1005 CHECK_TOTAL_LENGTH (temp);
1006 temp = balance_possible_root_interval (temp);
1009 /* If at least one interval has sticky properties,
1010 we check the stickiness property by property.
1012 Originally, the if condition here was this:
1013 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1014 But, these macros are now unreliable because of introduction
1015 of Vtext_property_default_nonsticky. So, we always have to
1016 check stickiness of properties one by one. If cache of
1017 stickiness is implemented in the future, we may be able to
1018 use those macros again. */
1019 if (1)
1021 Lisp_Object pleft, pright;
1022 struct interval newi;
1024 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1025 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1026 newi.plist = merge_properties_sticky (pleft, pright);
1028 if (! prev) /* i.e. position == BEG */
1030 if (! intervals_equal (i, &newi))
1032 i = split_interval_left (i, length);
1033 i->plist = newi.plist;
1036 else if (! intervals_equal (prev, &newi))
1038 prev = split_interval_right (prev,
1039 position - prev->position);
1040 prev->plist = newi.plist;
1041 if (! NULL_INTERVAL_P (i)
1042 && intervals_equal (prev, i))
1043 merge_interval_right (prev);
1046 /* We will need to update the cache here later. */
1048 else if (! prev && ! NILP (i->plist))
1050 /* Just split off a new interval at the left.
1051 Since I wasn't front-sticky, the empty plist is ok. */
1052 i = split_interval_left (i, length);
1056 /* Otherwise just extend the interval. */
1057 else
1059 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1061 temp->total_length += length;
1062 CHECK_TOTAL_LENGTH (temp);
1063 temp = balance_possible_root_interval (temp);
1067 return tree;
1070 /* Any property might be front-sticky on the left, rear-sticky on the left,
1071 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1072 can be arranged in a matrix with rows denoting the left conditions and
1073 columns denoting the right conditions:
1074 _ __ _
1075 _ FR FR FR FR
1076 FR__ 0 1 2 3
1077 _FR 4 5 6 7
1078 FR 8 9 A B
1079 FR C D E F
1081 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1082 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1083 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1084 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1085 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1086 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1087 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1088 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1090 We inherit from whoever has a sticky side facing us. If both sides
1091 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1092 non-nil value for the current property. If both sides do, then we take
1093 from the left.
1095 When we inherit a property, we get its stickiness as well as its value.
1096 So, when we merge the above two lists, we expect to get this:
1098 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1099 rear-nonsticky (p6 pa)
1100 p0 L p1 L p2 L p3 L p6 R p7 R
1101 pa R pb R pc L pd L pe L pf L)
1103 The optimizable special cases are:
1104 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1105 left rear-nonsticky = t, right front-sticky = t (inherit right)
1106 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1109 Lisp_Object
1110 merge_properties_sticky (pleft, pright)
1111 Lisp_Object pleft, pright;
1113 register Lisp_Object props, front, rear;
1114 Lisp_Object lfront, lrear, rfront, rrear;
1115 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1116 int use_left, use_right;
1117 int lpresent;
1119 props = Qnil;
1120 front = Qnil;
1121 rear = Qnil;
1122 lfront = textget (pleft, Qfront_sticky);
1123 lrear = textget (pleft, Qrear_nonsticky);
1124 rfront = textget (pright, Qfront_sticky);
1125 rrear = textget (pright, Qrear_nonsticky);
1127 /* Go through each element of PRIGHT. */
1128 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (Fcdr (tail1)))
1130 Lisp_Object tmp;
1132 sym = Fcar (tail1);
1134 /* Sticky properties get special treatment. */
1135 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1136 continue;
1138 rval = Fcar (Fcdr (tail1));
1139 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (Fcdr (tail2)))
1140 if (EQ (sym, Fcar (tail2)))
1141 break;
1143 /* Indicate whether the property is explicitly defined on the left.
1144 (We know it is defined explicitly on the right
1145 because otherwise we don't get here.) */
1146 lpresent = ! NILP (tail2);
1147 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1149 /* Even if lrear or rfront say nothing about the stickiness of
1150 SYM, Vtext_property_default_nonsticky may give default
1151 stickiness to SYM. */
1152 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1153 use_left = (lpresent
1154 && ! (TMEM (sym, lrear)
1155 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1156 use_right = (TMEM (sym, rfront)
1157 || (CONSP (tmp) && NILP (XCDR (tmp))));
1158 if (use_left && use_right)
1160 if (NILP (lval))
1161 use_left = 0;
1162 else if (NILP (rval))
1163 use_right = 0;
1165 if (use_left)
1167 /* We build props as (value sym ...) rather than (sym value ...)
1168 because we plan to nreverse it when we're done. */
1169 props = Fcons (lval, Fcons (sym, props));
1170 if (TMEM (sym, lfront))
1171 front = Fcons (sym, front);
1172 if (TMEM (sym, lrear))
1173 rear = Fcons (sym, rear);
1175 else if (use_right)
1177 props = Fcons (rval, Fcons (sym, props));
1178 if (TMEM (sym, rfront))
1179 front = Fcons (sym, front);
1180 if (TMEM (sym, rrear))
1181 rear = Fcons (sym, rear);
1185 /* Now go through each element of PLEFT. */
1186 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (Fcdr (tail2)))
1188 Lisp_Object tmp;
1190 sym = Fcar (tail2);
1192 /* Sticky properties get special treatment. */
1193 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1194 continue;
1196 /* If sym is in PRIGHT, we've already considered it. */
1197 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (Fcdr (tail1)))
1198 if (EQ (sym, Fcar (tail1)))
1199 break;
1200 if (! NILP (tail1))
1201 continue;
1203 lval = Fcar (Fcdr (tail2));
1205 /* Even if lrear or rfront say nothing about the stickiness of
1206 SYM, Vtext_property_default_nonsticky may give default
1207 stickiness to SYM. */
1208 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1210 /* Since rval is known to be nil in this loop, the test simplifies. */
1211 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1213 props = Fcons (lval, Fcons (sym, props));
1214 if (TMEM (sym, lfront))
1215 front = Fcons (sym, front);
1217 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1219 /* The value is nil, but we still inherit the stickiness
1220 from the right. */
1221 front = Fcons (sym, front);
1222 if (TMEM (sym, rrear))
1223 rear = Fcons (sym, rear);
1226 props = Fnreverse (props);
1227 if (! NILP (rear))
1228 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1230 cat = textget (props, Qcategory);
1231 if (! NILP (front)
1233 /* If we have inherited a front-stick category property that is t,
1234 we don't need to set up a detailed one. */
1235 ! (! NILP (cat) && SYMBOLP (cat)
1236 && EQ (Fget (cat, Qfront_sticky), Qt)))
1237 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1238 return props;
1242 /* Delete a node I from its interval tree by merging its subtrees
1243 into one subtree which is then returned. Caller is responsible for
1244 storing the resulting subtree into its parent. */
1246 static INTERVAL
1247 delete_node (i)
1248 register INTERVAL i;
1250 register INTERVAL migrate, this;
1251 register int migrate_amt;
1253 if (NULL_INTERVAL_P (i->left))
1254 return i->right;
1255 if (NULL_INTERVAL_P (i->right))
1256 return i->left;
1258 migrate = i->left;
1259 migrate_amt = i->left->total_length;
1260 this = i->right;
1261 this->total_length += migrate_amt;
1262 while (! NULL_INTERVAL_P (this->left))
1264 this = this->left;
1265 this->total_length += migrate_amt;
1267 CHECK_TOTAL_LENGTH (this);
1268 this->left = migrate;
1269 SET_INTERVAL_PARENT (migrate, this);
1271 return i->right;
1274 /* Delete interval I from its tree by calling `delete_node'
1275 and properly connecting the resultant subtree.
1277 I is presumed to be empty; that is, no adjustments are made
1278 for the length of I. */
1280 void
1281 delete_interval (i)
1282 register INTERVAL i;
1284 register INTERVAL parent;
1285 int amt = LENGTH (i);
1287 if (amt > 0) /* Only used on zero-length intervals now. */
1288 abort ();
1290 if (ROOT_INTERVAL_P (i))
1292 Lisp_Object owner;
1293 GET_INTERVAL_OBJECT (owner, i);
1294 parent = delete_node (i);
1295 if (! NULL_INTERVAL_P (parent))
1296 SET_INTERVAL_OBJECT (parent, owner);
1298 if (BUFFERP (owner))
1299 BUF_INTERVALS (XBUFFER (owner)) = parent;
1300 else if (STRINGP (owner))
1301 STRING_SET_INTERVALS (owner, parent);
1302 else
1303 abort ();
1305 return;
1308 parent = INTERVAL_PARENT (i);
1309 if (AM_LEFT_CHILD (i))
1311 parent->left = delete_node (i);
1312 if (! NULL_INTERVAL_P (parent->left))
1313 SET_INTERVAL_PARENT (parent->left, parent);
1315 else
1317 parent->right = delete_node (i);
1318 if (! NULL_INTERVAL_P (parent->right))
1319 SET_INTERVAL_PARENT (parent->right, parent);
1323 /* Find the interval in TREE corresponding to the relative position
1324 FROM and delete as much as possible of AMOUNT from that interval.
1325 Return the amount actually deleted, and if the interval was
1326 zeroed-out, delete that interval node from the tree.
1328 Note that FROM is actually origin zero, aka relative to the
1329 leftmost edge of tree. This is appropriate since we call ourselves
1330 recursively on subtrees.
1332 Do this by recursing down TREE to the interval in question, and
1333 deleting the appropriate amount of text. */
1335 static int
1336 interval_deletion_adjustment (tree, from, amount)
1337 register INTERVAL tree;
1338 register int from, amount;
1340 register int relative_position = from;
1342 if (NULL_INTERVAL_P (tree))
1343 return 0;
1345 /* Left branch */
1346 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1348 int subtract = interval_deletion_adjustment (tree->left,
1349 relative_position,
1350 amount);
1351 tree->total_length -= subtract;
1352 CHECK_TOTAL_LENGTH (tree);
1353 return subtract;
1355 /* Right branch */
1356 else if (relative_position >= (TOTAL_LENGTH (tree)
1357 - RIGHT_TOTAL_LENGTH (tree)))
1359 int subtract;
1361 relative_position -= (tree->total_length
1362 - RIGHT_TOTAL_LENGTH (tree));
1363 subtract = interval_deletion_adjustment (tree->right,
1364 relative_position,
1365 amount);
1366 tree->total_length -= subtract;
1367 CHECK_TOTAL_LENGTH (tree);
1368 return subtract;
1370 /* Here -- this node. */
1371 else
1373 /* How much can we delete from this interval? */
1374 int my_amount = ((tree->total_length
1375 - RIGHT_TOTAL_LENGTH (tree))
1376 - relative_position);
1378 if (amount > my_amount)
1379 amount = my_amount;
1381 tree->total_length -= amount;
1382 CHECK_TOTAL_LENGTH (tree);
1383 if (LENGTH (tree) == 0)
1384 delete_interval (tree);
1386 return amount;
1389 /* Never reach here. */
1392 /* Effect the adjustments necessary to the interval tree of BUFFER to
1393 correspond to the deletion of LENGTH characters from that buffer
1394 text. The deletion is effected at position START (which is a
1395 buffer position, i.e. origin 1). */
1397 static void
1398 adjust_intervals_for_deletion (buffer, start, length)
1399 struct buffer *buffer;
1400 int start, length;
1402 register int left_to_delete = length;
1403 register INTERVAL tree = BUF_INTERVALS (buffer);
1404 Lisp_Object parent;
1405 int offset;
1407 GET_INTERVAL_OBJECT (parent, tree);
1408 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1410 if (NULL_INTERVAL_P (tree))
1411 return;
1413 if (start > offset + TOTAL_LENGTH (tree)
1414 || start + length > offset + TOTAL_LENGTH (tree))
1415 abort ();
1417 if (length == TOTAL_LENGTH (tree))
1419 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1420 return;
1423 if (ONLY_INTERVAL_P (tree))
1425 tree->total_length -= length;
1426 CHECK_TOTAL_LENGTH (tree);
1427 return;
1430 if (start > offset + TOTAL_LENGTH (tree))
1431 start = offset + TOTAL_LENGTH (tree);
1432 while (left_to_delete > 0)
1434 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1435 left_to_delete);
1436 tree = BUF_INTERVALS (buffer);
1437 if (left_to_delete == tree->total_length)
1439 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1440 return;
1445 /* Make the adjustments necessary to the interval tree of BUFFER to
1446 represent an addition or deletion of LENGTH characters starting
1447 at position START. Addition or deletion is indicated by the sign
1448 of LENGTH. */
1450 INLINE void
1451 offset_intervals (buffer, start, length)
1452 struct buffer *buffer;
1453 int start, length;
1455 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1456 return;
1458 if (length > 0)
1459 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1460 else
1461 adjust_intervals_for_deletion (buffer, start, -length);
1464 /* Merge interval I with its lexicographic successor. The resulting
1465 interval is returned, and has the properties of the original
1466 successor. The properties of I are lost. I is removed from the
1467 interval tree.
1469 IMPORTANT:
1470 The caller must verify that this is not the last (rightmost)
1471 interval. */
1473 INTERVAL
1474 merge_interval_right (i)
1475 register INTERVAL i;
1477 register int absorb = LENGTH (i);
1478 register INTERVAL successor;
1480 /* Zero out this interval. */
1481 i->total_length -= absorb;
1482 CHECK_TOTAL_LENGTH (i);
1484 /* Find the succeeding interval. */
1485 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1486 as we descend. */
1488 successor = i->right;
1489 while (! NULL_LEFT_CHILD (successor))
1491 successor->total_length += absorb;
1492 CHECK_TOTAL_LENGTH (successor);
1493 successor = successor->left;
1496 successor->total_length += absorb;
1497 CHECK_TOTAL_LENGTH (successor);
1498 delete_interval (i);
1499 return successor;
1502 successor = i;
1503 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1504 we ascend. */
1506 if (AM_LEFT_CHILD (successor))
1508 successor = INTERVAL_PARENT (successor);
1509 delete_interval (i);
1510 return successor;
1513 successor = INTERVAL_PARENT (successor);
1514 successor->total_length -= absorb;
1515 CHECK_TOTAL_LENGTH (successor);
1518 /* This must be the rightmost or last interval and cannot
1519 be merged right. The caller should have known. */
1520 abort ();
1523 /* Merge interval I with its lexicographic predecessor. The resulting
1524 interval is returned, and has the properties of the original predecessor.
1525 The properties of I are lost. Interval node I is removed from the tree.
1527 IMPORTANT:
1528 The caller must verify that this is not the first (leftmost) interval. */
1530 INTERVAL
1531 merge_interval_left (i)
1532 register INTERVAL i;
1534 register int absorb = LENGTH (i);
1535 register INTERVAL predecessor;
1537 /* Zero out this interval. */
1538 i->total_length -= absorb;
1539 CHECK_TOTAL_LENGTH (i);
1541 /* Find the preceding interval. */
1542 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1543 adding ABSORB as we go. */
1545 predecessor = i->left;
1546 while (! NULL_RIGHT_CHILD (predecessor))
1548 predecessor->total_length += absorb;
1549 CHECK_TOTAL_LENGTH (predecessor);
1550 predecessor = predecessor->right;
1553 predecessor->total_length += absorb;
1554 CHECK_TOTAL_LENGTH (predecessor);
1555 delete_interval (i);
1556 return predecessor;
1559 predecessor = i;
1560 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1561 subtracting ABSORB. */
1563 if (AM_RIGHT_CHILD (predecessor))
1565 predecessor = INTERVAL_PARENT (predecessor);
1566 delete_interval (i);
1567 return predecessor;
1570 predecessor = INTERVAL_PARENT (predecessor);
1571 predecessor->total_length -= absorb;
1572 CHECK_TOTAL_LENGTH (predecessor);
1575 /* This must be the leftmost or first interval and cannot
1576 be merged left. The caller should have known. */
1577 abort ();
1580 /* Make an exact copy of interval tree SOURCE which descends from
1581 PARENT. This is done by recursing through SOURCE, copying
1582 the current interval and its properties, and then adjusting
1583 the pointers of the copy. */
1585 static INTERVAL
1586 reproduce_tree (source, parent)
1587 INTERVAL source, parent;
1589 register INTERVAL t = make_interval ();
1591 bcopy (source, t, INTERVAL_SIZE);
1592 copy_properties (source, t);
1593 SET_INTERVAL_PARENT (t, parent);
1594 if (! NULL_LEFT_CHILD (source))
1595 t->left = reproduce_tree (source->left, t);
1596 if (! NULL_RIGHT_CHILD (source))
1597 t->right = reproduce_tree (source->right, t);
1599 return t;
1602 static INTERVAL
1603 reproduce_tree_obj (source, parent)
1604 INTERVAL source;
1605 Lisp_Object parent;
1607 register INTERVAL t = make_interval ();
1609 bcopy (source, t, INTERVAL_SIZE);
1610 copy_properties (source, t);
1611 SET_INTERVAL_OBJECT (t, parent);
1612 if (! NULL_LEFT_CHILD (source))
1613 t->left = reproduce_tree (source->left, t);
1614 if (! NULL_RIGHT_CHILD (source))
1615 t->right = reproduce_tree (source->right, t);
1617 return t;
1620 #if 0
1621 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1623 /* Make a new interval of length LENGTH starting at START in the
1624 group of intervals INTERVALS, which is actually an interval tree.
1625 Returns the new interval.
1627 Generate an error if the new positions would overlap an existing
1628 interval. */
1630 static INTERVAL
1631 make_new_interval (intervals, start, length)
1632 INTERVAL intervals;
1633 int start, length;
1635 INTERVAL slot;
1637 slot = find_interval (intervals, start);
1638 if (start + length > slot->position + LENGTH (slot))
1639 error ("Interval would overlap");
1641 if (start == slot->position && length == LENGTH (slot))
1642 return slot;
1644 if (slot->position == start)
1646 /* New right node. */
1647 split_interval_right (slot, length);
1648 return slot;
1651 if (slot->position + LENGTH (slot) == start + length)
1653 /* New left node. */
1654 split_interval_left (slot, LENGTH (slot) - length);
1655 return slot;
1658 /* Convert interval SLOT into three intervals. */
1659 split_interval_left (slot, start - slot->position);
1660 split_interval_right (slot, length);
1661 return slot;
1663 #endif
1665 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1666 LENGTH is the length of the text in SOURCE.
1668 The `position' field of the SOURCE intervals is assumed to be
1669 consistent with its parent; therefore, SOURCE must be an
1670 interval tree made with copy_interval or must be the whole
1671 tree of a buffer or a string.
1673 This is used in insdel.c when inserting Lisp_Strings into the
1674 buffer. The text corresponding to SOURCE is already in the buffer
1675 when this is called. The intervals of new tree are a copy of those
1676 belonging to the string being inserted; intervals are never
1677 shared.
1679 If the inserted text had no intervals associated, and we don't
1680 want to inherit the surrounding text's properties, this function
1681 simply returns -- offset_intervals should handle placing the
1682 text in the correct interval, depending on the sticky bits.
1684 If the inserted text had properties (intervals), then there are two
1685 cases -- either insertion happened in the middle of some interval,
1686 or between two intervals.
1688 If the text goes into the middle of an interval, then new
1689 intervals are created in the middle with only the properties of
1690 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1691 which case the new text has the union of its properties and those
1692 of the text into which it was inserted.
1694 If the text goes between two intervals, then if neither interval
1695 had its appropriate sticky property set (front_sticky, rear_sticky),
1696 the new text has only its properties. If one of the sticky properties
1697 is set, then the new text "sticks" to that region and its properties
1698 depend on merging as above. If both the preceding and succeeding
1699 intervals to the new text are "sticky", then the new text retains
1700 only its properties, as if neither sticky property were set. Perhaps
1701 we should consider merging all three sets of properties onto the new
1702 text... */
1704 void
1705 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1706 INTERVAL source;
1707 int position, length;
1708 struct buffer *buffer;
1709 int inherit;
1711 register INTERVAL under, over, this, prev;
1712 register INTERVAL tree;
1714 tree = BUF_INTERVALS (buffer);
1716 /* If the new text has no properties, then with inheritance it
1717 becomes part of whatever interval it was inserted into.
1718 To prevent inheritance, we must clear out the properties
1719 of the newly inserted text. */
1720 if (NULL_INTERVAL_P (source))
1722 Lisp_Object buf;
1723 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1725 XSETBUFFER (buf, buffer);
1726 set_text_properties_1 (make_number (position),
1727 make_number (position + length),
1728 Qnil, buf, 0);
1730 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1731 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1732 return;
1735 if (NULL_INTERVAL_P (tree))
1737 /* The inserted text constitutes the whole buffer, so
1738 simply copy over the interval structure. */
1739 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1741 Lisp_Object buf;
1742 XSETBUFFER (buf, buffer);
1743 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1744 BUF_INTERVALS (buffer)->position = 1;
1746 /* Explicitly free the old tree here? */
1748 return;
1751 /* Create an interval tree in which to place a copy
1752 of the intervals of the inserted string. */
1754 Lisp_Object buf;
1755 XSETBUFFER (buf, buffer);
1756 tree = create_root_interval (buf);
1759 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1760 /* If the buffer contains only the new string, but
1761 there was already some interval tree there, then it may be
1762 some zero length intervals. Eventually, do something clever
1763 about inserting properly. For now, just waste the old intervals. */
1765 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1766 BUF_INTERVALS (buffer)->position = 1;
1767 /* Explicitly free the old tree here. */
1769 return;
1771 /* Paranoia -- the text has already been added, so this buffer
1772 should be of non-zero length. */
1773 else if (TOTAL_LENGTH (tree) == 0)
1774 abort ();
1776 this = under = find_interval (tree, position);
1777 if (NULL_INTERVAL_P (under)) /* Paranoia */
1778 abort ();
1779 over = find_interval (source, interval_start_pos (source));
1781 /* Here for insertion in the middle of an interval.
1782 Split off an equivalent interval to the right,
1783 then don't bother with it any more. */
1785 if (position > under->position)
1787 INTERVAL end_unchanged
1788 = split_interval_left (this, position - under->position);
1789 copy_properties (under, end_unchanged);
1790 under->position = position;
1792 else
1794 /* This call may have some effect because previous_interval may
1795 update `position' fields of intervals. Thus, don't ignore it
1796 for the moment. Someone please tell me the truth (K.Handa). */
1797 prev = previous_interval (under);
1798 #if 0
1799 /* But, this code surely has no effect. And, anyway,
1800 END_NONSTICKY_P is unreliable now. */
1801 if (prev && !END_NONSTICKY_P (prev))
1802 prev = 0;
1803 #endif /* 0 */
1806 /* Insertion is now at beginning of UNDER. */
1808 /* The inserted text "sticks" to the interval `under',
1809 which means it gets those properties.
1810 The properties of under are the result of
1811 adjust_intervals_for_insertion, so stickiness has
1812 already been taken care of. */
1814 while (! NULL_INTERVAL_P (over))
1816 if (LENGTH (over) < LENGTH (under))
1818 this = split_interval_left (under, LENGTH (over));
1819 copy_properties (under, this);
1821 else
1822 this = under;
1823 copy_properties (over, this);
1824 if (inherit)
1825 merge_properties (over, this);
1826 else
1827 copy_properties (over, this);
1828 over = next_interval (over);
1831 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1832 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1833 return;
1836 /* Get the value of property PROP from PLIST,
1837 which is the plist of an interval.
1838 We check for direct properties, for categories with property PROP,
1839 and for PROP appearing on the default-text-properties list. */
1841 Lisp_Object
1842 textget (plist, prop)
1843 Lisp_Object plist;
1844 register Lisp_Object prop;
1846 return lookup_char_property (plist, prop, 1);
1849 Lisp_Object
1850 lookup_char_property (plist, prop, textprop)
1851 Lisp_Object plist;
1852 register Lisp_Object prop;
1853 int textprop;
1855 register Lisp_Object tail, fallback = Qnil;
1857 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1859 register Lisp_Object tem;
1860 tem = XCAR (tail);
1861 if (EQ (prop, tem))
1862 return Fcar (XCDR (tail));
1863 if (EQ (tem, Qcategory))
1865 tem = Fcar (XCDR (tail));
1866 if (SYMBOLP (tem))
1867 fallback = Fget (tem, prop);
1871 if (! NILP (fallback))
1872 return fallback;
1873 /* Check for alternative properties */
1874 tail = Fassq (prop, Vchar_property_alias_alist);
1875 if (NILP (tail))
1876 return tail;
1877 tail = XCDR (tail);
1878 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1879 fallback = Fplist_get (plist, XCAR (tail));
1880 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1881 fallback = Fplist_get (Vdefault_text_properties, prop);
1882 return fallback;
1886 /* Set point "temporarily", without checking any text properties. */
1888 INLINE void
1889 temp_set_point (buffer, charpos)
1890 struct buffer *buffer;
1891 int charpos;
1893 temp_set_point_both (buffer, charpos,
1894 buf_charpos_to_bytepos (buffer, charpos));
1897 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1898 byte position BYTEPOS. */
1900 INLINE void
1901 temp_set_point_both (buffer, charpos, bytepos)
1902 int charpos, bytepos;
1903 struct buffer *buffer;
1905 /* In a single-byte buffer, the two positions must be equal. */
1906 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1907 && charpos != bytepos)
1908 abort ();
1910 if (charpos > bytepos)
1911 abort ();
1913 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1914 abort ();
1916 BUF_PT_BYTE (buffer) = bytepos;
1917 BUF_PT (buffer) = charpos;
1920 /* Set point in BUFFER to CHARPOS. If the target position is
1921 before an intangible character, move to an ok place. */
1923 void
1924 set_point (buffer, charpos)
1925 register struct buffer *buffer;
1926 register int charpos;
1928 set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
1931 /* If there's an invisible character at position POS + TEST_OFFS in the
1932 current buffer, and the invisible property has a `stickiness' such that
1933 inserting a character at position POS would inherit the property it,
1934 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1935 then intangibility is required as well as invisibleness.
1937 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1939 Note that `stickiness' is determined by overlay marker insertion types,
1940 if the invisible property comes from an overlay. */
1942 static int
1943 adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1944 int pos, test_offs, adj, test_intang;
1946 Lisp_Object invis_propval, invis_overlay;
1947 Lisp_Object test_pos;
1949 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1950 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1951 return pos;
1953 test_pos = make_number (pos + test_offs);
1955 invis_propval
1956 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1957 &invis_overlay);
1959 if ((!test_intang
1960 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1961 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1962 /* This next test is true if the invisible property has a stickiness
1963 such that an insertion at POS would inherit it. */
1964 && (NILP (invis_overlay)
1965 /* Invisible property is from a text-property. */
1966 ? (text_property_stickiness (Qinvisible, make_number (pos))
1967 == (test_offs == 0 ? 1 : -1))
1968 /* Invisible property is from an overlay. */
1969 : (test_offs == 0
1970 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1971 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1972 pos += adj;
1974 return pos;
1977 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1978 position BYTEPOS. If the target position is
1979 before an intangible character, move to an ok place. */
1981 void
1982 set_point_both (buffer, charpos, bytepos)
1983 register struct buffer *buffer;
1984 register int charpos, bytepos;
1986 register INTERVAL to, from, toprev, fromprev;
1987 int buffer_point;
1988 int old_position = BUF_PT (buffer);
1989 int backwards = (charpos < old_position ? 1 : 0);
1990 int have_overlays;
1991 int original_position;
1993 buffer->point_before_scroll = Qnil;
1995 if (charpos == BUF_PT (buffer))
1996 return;
1998 /* In a single-byte buffer, the two positions must be equal. */
1999 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
2000 && charpos != bytepos)
2001 abort ();
2003 /* Check this now, before checking if the buffer has any intervals.
2004 That way, we can catch conditions which break this sanity check
2005 whether or not there are intervals in the buffer. */
2006 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
2007 abort ();
2009 have_overlays = (! NILP (buffer->overlays_before)
2010 || ! NILP (buffer->overlays_after));
2012 /* If we have no text properties and overlays,
2013 then we can do it quickly. */
2014 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) && ! have_overlays)
2016 temp_set_point_both (buffer, charpos, bytepos);
2017 return;
2020 /* Set TO to the interval containing the char after CHARPOS,
2021 and TOPREV to the interval containing the char before CHARPOS.
2022 Either one may be null. They may be equal. */
2023 to = find_interval (BUF_INTERVALS (buffer), charpos);
2024 if (charpos == BUF_BEGV (buffer))
2025 toprev = 0;
2026 else if (to && to->position == charpos)
2027 toprev = previous_interval (to);
2028 else
2029 toprev = to;
2031 buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
2032 ? BUF_ZV (buffer) - 1
2033 : BUF_PT (buffer));
2035 /* Set FROM to the interval containing the char after PT,
2036 and FROMPREV to the interval containing the char before PT.
2037 Either one may be null. They may be equal. */
2038 /* We could cache this and save time. */
2039 from = find_interval (BUF_INTERVALS (buffer), buffer_point);
2040 if (buffer_point == BUF_BEGV (buffer))
2041 fromprev = 0;
2042 else if (from && from->position == BUF_PT (buffer))
2043 fromprev = previous_interval (from);
2044 else if (buffer_point != BUF_PT (buffer))
2045 fromprev = from, from = 0;
2046 else
2047 fromprev = from;
2049 /* Moving within an interval. */
2050 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2051 && ! have_overlays)
2053 temp_set_point_both (buffer, charpos, bytepos);
2054 return;
2057 original_position = charpos;
2059 /* If the new position is between two intangible characters
2060 with the same intangible property value,
2061 move forward or backward until a change in that property. */
2062 if (NILP (Vinhibit_point_motion_hooks)
2063 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2064 || have_overlays)
2065 /* Intangibility never stops us from positioning at the beginning
2066 or end of the buffer, so don't bother checking in that case. */
2067 && charpos != BEGV && charpos != ZV)
2069 Lisp_Object pos;
2070 Lisp_Object intangible_propval;
2072 if (backwards)
2074 /* If the preceding character is both intangible and invisible,
2075 and the invisible property is `rear-sticky', perturb it so
2076 that the search starts one character earlier -- this ensures
2077 that point can never move to the end of an invisible/
2078 intangible/rear-sticky region. */
2079 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2081 XSETINT (pos, charpos);
2083 /* If following char is intangible,
2084 skip back over all chars with matching intangible property. */
2086 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2088 if (! NILP (intangible_propval))
2090 while (XINT (pos) > BUF_BEGV (buffer)
2091 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2092 Qintangible, Qnil),
2093 intangible_propval))
2094 pos = Fprevious_char_property_change (pos, Qnil);
2096 /* Set CHARPOS from POS, and if the final intangible character
2097 that we skipped over is also invisible, and the invisible
2098 property is `front-sticky', perturb it to be one character
2099 earlier -- this ensures that point can never move to the
2100 beginning of an invisible/intangible/front-sticky region. */
2101 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2104 else
2106 /* If the following character is both intangible and invisible,
2107 and the invisible property is `front-sticky', perturb it so
2108 that the search starts one character later -- this ensures
2109 that point can never move to the beginning of an
2110 invisible/intangible/front-sticky region. */
2111 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2113 XSETINT (pos, charpos);
2115 /* If preceding char is intangible,
2116 skip forward over all chars with matching intangible property. */
2118 intangible_propval = Fget_char_property (make_number (charpos - 1),
2119 Qintangible, Qnil);
2121 if (! NILP (intangible_propval))
2123 while (XINT (pos) < BUF_ZV (buffer)
2124 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2125 intangible_propval))
2126 pos = Fnext_char_property_change (pos, Qnil);
2128 /* Set CHARPOS from POS, and if the final intangible character
2129 that we skipped over is also invisible, and the invisible
2130 property is `rear-sticky', perturb it to be one character
2131 later -- this ensures that point can never move to the
2132 end of an invisible/intangible/rear-sticky region. */
2133 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2137 bytepos = buf_charpos_to_bytepos (buffer, charpos);
2140 if (charpos != original_position)
2142 /* Set TO to the interval containing the char after CHARPOS,
2143 and TOPREV to the interval containing the char before CHARPOS.
2144 Either one may be null. They may be equal. */
2145 to = find_interval (BUF_INTERVALS (buffer), charpos);
2146 if (charpos == BUF_BEGV (buffer))
2147 toprev = 0;
2148 else if (to && to->position == charpos)
2149 toprev = previous_interval (to);
2150 else
2151 toprev = to;
2154 /* Here TO is the interval after the stopping point
2155 and TOPREV is the interval before the stopping point.
2156 One or the other may be null. */
2158 temp_set_point_both (buffer, charpos, bytepos);
2160 /* We run point-left and point-entered hooks here, iff the
2161 two intervals are not equivalent. These hooks take
2162 (old_point, new_point) as arguments. */
2163 if (NILP (Vinhibit_point_motion_hooks)
2164 && (! intervals_equal (from, to)
2165 || ! intervals_equal (fromprev, toprev)))
2167 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2169 if (fromprev)
2170 leave_after = textget (fromprev->plist, Qpoint_left);
2171 else
2172 leave_after = Qnil;
2173 if (from)
2174 leave_before = textget (from->plist, Qpoint_left);
2175 else
2176 leave_before = Qnil;
2178 if (toprev)
2179 enter_after = textget (toprev->plist, Qpoint_entered);
2180 else
2181 enter_after = Qnil;
2182 if (to)
2183 enter_before = textget (to->plist, Qpoint_entered);
2184 else
2185 enter_before = Qnil;
2187 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2188 call2 (leave_before, make_number (old_position),
2189 make_number (charpos));
2190 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2191 call2 (leave_after, make_number (old_position),
2192 make_number (charpos));
2194 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2195 call2 (enter_before, make_number (old_position),
2196 make_number (charpos));
2197 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2198 call2 (enter_after, make_number (old_position),
2199 make_number (charpos));
2203 /* Move point to POSITION, unless POSITION is inside an intangible
2204 segment that reaches all the way to point. */
2206 void
2207 move_if_not_intangible (position)
2208 int position;
2210 Lisp_Object pos;
2211 Lisp_Object intangible_propval;
2213 XSETINT (pos, position);
2215 if (! NILP (Vinhibit_point_motion_hooks))
2216 /* If intangible is inhibited, always move point to POSITION. */
2218 else if (PT < position && XINT (pos) < ZV)
2220 /* We want to move forward, so check the text before POSITION. */
2222 intangible_propval = Fget_char_property (pos,
2223 Qintangible, Qnil);
2225 /* If following char is intangible,
2226 skip back over all chars with matching intangible property. */
2227 if (! NILP (intangible_propval))
2228 while (XINT (pos) > BEGV
2229 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2230 Qintangible, Qnil),
2231 intangible_propval))
2232 pos = Fprevious_char_property_change (pos, Qnil);
2234 else if (XINT (pos) > BEGV)
2236 /* We want to move backward, so check the text after POSITION. */
2238 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2239 Qintangible, Qnil);
2241 /* If following char is intangible,
2242 skip forward over all chars with matching intangible property. */
2243 if (! NILP (intangible_propval))
2244 while (XINT (pos) < ZV
2245 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2246 intangible_propval))
2247 pos = Fnext_char_property_change (pos, Qnil);
2251 /* If the whole stretch between PT and POSITION isn't intangible,
2252 try moving to POSITION (which means we actually move farther
2253 if POSITION is inside of intangible text). */
2255 if (XINT (pos) != PT)
2256 SET_PT (position);
2259 /* If text at position POS has property PROP, set *VAL to the property
2260 value, *START and *END to the beginning and end of a region that
2261 has the same property, and return 1. Otherwise return 0.
2263 OBJECT is the string or buffer to look for the property in;
2264 nil means the current buffer. */
2267 get_property_and_range (pos, prop, val, start, end, object)
2268 int pos;
2269 Lisp_Object prop, *val;
2270 int *start, *end;
2271 Lisp_Object object;
2273 INTERVAL i, prev, next;
2275 if (NILP (object))
2276 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2277 else if (BUFFERP (object))
2278 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2279 else if (STRINGP (object))
2280 i = find_interval (STRING_INTERVALS (object), pos);
2281 else
2282 abort ();
2284 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2285 return 0;
2286 *val = textget (i->plist, prop);
2287 if (NILP (*val))
2288 return 0;
2290 next = i; /* remember it in advance */
2291 prev = previous_interval (i);
2292 while (! NULL_INTERVAL_P (prev)
2293 && EQ (*val, textget (prev->plist, prop)))
2294 i = prev, prev = previous_interval (prev);
2295 *start = i->position;
2297 next = next_interval (i);
2298 while (! NULL_INTERVAL_P (next)
2299 && EQ (*val, textget (next->plist, prop)))
2300 i = next, next = next_interval (next);
2301 *end = i->position + LENGTH (i);
2303 return 1;
2306 /* Return the proper local keymap TYPE for position POSITION in
2307 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2308 specified by the PROP property, if any. Otherwise, if TYPE is
2309 `local-map' use BUFFER's local map. */
2311 Lisp_Object
2312 get_local_map (position, buffer, type)
2313 register int position;
2314 register struct buffer *buffer;
2315 Lisp_Object type;
2317 Lisp_Object prop, lispy_position, lispy_buffer;
2318 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2320 /* Perhaps we should just change `position' to the limit. */
2321 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
2322 abort ();
2324 /* Ignore narrowing, so that a local map continues to be valid even if
2325 the visible region contains no characters and hence no properties. */
2326 old_begv = BUF_BEGV (buffer);
2327 old_zv = BUF_ZV (buffer);
2328 old_begv_byte = BUF_BEGV_BYTE (buffer);
2329 old_zv_byte = BUF_ZV_BYTE (buffer);
2330 BUF_BEGV (buffer) = BUF_BEG (buffer);
2331 BUF_ZV (buffer) = BUF_Z (buffer);
2332 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2333 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2335 /* There are no properties at the end of the buffer, so in that case
2336 check for a local map on the last character of the buffer instead. */
2337 if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer))
2338 --position;
2339 XSETFASTINT (lispy_position, position);
2340 XSETBUFFER (lispy_buffer, buffer);
2341 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2343 BUF_BEGV (buffer) = old_begv;
2344 BUF_ZV (buffer) = old_zv;
2345 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2346 BUF_ZV_BYTE (buffer) = old_zv_byte;
2348 /* Use the local map only if it is valid. */
2349 prop = get_keymap (prop, 0, 0);
2350 if (CONSP (prop))
2351 return prop;
2353 if (EQ (type, Qkeymap))
2354 return Qnil;
2355 else
2356 return buffer->keymap;
2359 /* Produce an interval tree reflecting the intervals in
2360 TREE from START to START + LENGTH.
2361 The new interval tree has no parent and has a starting-position of 0. */
2363 INTERVAL
2364 copy_intervals (tree, start, length)
2365 INTERVAL tree;
2366 int start, length;
2368 register INTERVAL i, new, t;
2369 register int got, prevlen;
2371 if (NULL_INTERVAL_P (tree) || length <= 0)
2372 return NULL_INTERVAL;
2374 i = find_interval (tree, start);
2375 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2376 abort ();
2378 /* If there is only one interval and it's the default, return nil. */
2379 if ((start - i->position + 1 + length) < LENGTH (i)
2380 && DEFAULT_INTERVAL_P (i))
2381 return NULL_INTERVAL;
2383 new = make_interval ();
2384 new->position = 0;
2385 got = (LENGTH (i) - (start - i->position));
2386 new->total_length = length;
2387 CHECK_TOTAL_LENGTH (new);
2388 copy_properties (i, new);
2390 t = new;
2391 prevlen = got;
2392 while (got < length)
2394 i = next_interval (i);
2395 t = split_interval_right (t, prevlen);
2396 copy_properties (i, t);
2397 prevlen = LENGTH (i);
2398 got += prevlen;
2401 return balance_an_interval (new);
2404 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2406 INLINE void
2407 copy_intervals_to_string (string, buffer, position, length)
2408 Lisp_Object string;
2409 struct buffer *buffer;
2410 int position, length;
2412 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2413 position, length);
2414 if (NULL_INTERVAL_P (interval_copy))
2415 return;
2417 SET_INTERVAL_OBJECT (interval_copy, string);
2418 STRING_SET_INTERVALS (string, interval_copy);
2421 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2422 Assume they have identical characters. */
2425 compare_string_intervals (s1, s2)
2426 Lisp_Object s1, s2;
2428 INTERVAL i1, i2;
2429 int pos = 0;
2430 int end = SCHARS (s1);
2432 i1 = find_interval (STRING_INTERVALS (s1), 0);
2433 i2 = find_interval (STRING_INTERVALS (s2), 0);
2435 while (pos < end)
2437 /* Determine how far we can go before we reach the end of I1 or I2. */
2438 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2439 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2440 int distance = min (len1, len2);
2442 /* If we ever find a mismatch between the strings,
2443 they differ. */
2444 if (! intervals_equal (i1, i2))
2445 return 0;
2447 /* Advance POS till the end of the shorter interval,
2448 and advance one or both interval pointers for the new position. */
2449 pos += distance;
2450 if (len1 == distance)
2451 i1 = next_interval (i1);
2452 if (len2 == distance)
2453 i2 = next_interval (i2);
2455 return 1;
2458 /* Recursively adjust interval I in the current buffer
2459 for setting enable_multibyte_characters to MULTI_FLAG.
2460 The range of interval I is START ... END in characters,
2461 START_BYTE ... END_BYTE in bytes. */
2463 static void
2464 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2465 INTERVAL i;
2466 int multi_flag;
2467 int start, start_byte, end, end_byte;
2469 /* Fix the length of this interval. */
2470 if (multi_flag)
2471 i->total_length = end - start;
2472 else
2473 i->total_length = end_byte - start_byte;
2474 CHECK_TOTAL_LENGTH (i);
2476 if (TOTAL_LENGTH (i) == 0)
2478 delete_interval (i);
2479 return;
2482 /* Recursively fix the length of the subintervals. */
2483 if (i->left)
2485 int left_end, left_end_byte;
2487 if (multi_flag)
2489 int temp;
2490 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2491 left_end = BYTE_TO_CHAR (left_end_byte);
2493 temp = CHAR_TO_BYTE (left_end);
2495 /* If LEFT_END_BYTE is in the middle of a character,
2496 adjust it and LEFT_END to a char boundary. */
2497 if (left_end_byte > temp)
2499 left_end_byte = temp;
2501 if (left_end_byte < temp)
2503 left_end--;
2504 left_end_byte = CHAR_TO_BYTE (left_end);
2507 else
2509 left_end = start + LEFT_TOTAL_LENGTH (i);
2510 left_end_byte = CHAR_TO_BYTE (left_end);
2513 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2514 left_end, left_end_byte);
2516 if (i->right)
2518 int right_start_byte, right_start;
2520 if (multi_flag)
2522 int temp;
2524 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2525 right_start = BYTE_TO_CHAR (right_start_byte);
2527 /* If RIGHT_START_BYTE is in the middle of a character,
2528 adjust it and RIGHT_START to a char boundary. */
2529 temp = CHAR_TO_BYTE (right_start);
2531 if (right_start_byte < temp)
2533 right_start_byte = temp;
2535 if (right_start_byte > temp)
2537 right_start++;
2538 right_start_byte = CHAR_TO_BYTE (right_start);
2541 else
2543 right_start = end - RIGHT_TOTAL_LENGTH (i);
2544 right_start_byte = CHAR_TO_BYTE (right_start);
2547 set_intervals_multibyte_1 (i->right, multi_flag,
2548 right_start, right_start_byte,
2549 end, end_byte);
2552 /* Rounding to char boundaries can theoretically ake this interval
2553 spurious. If so, delete one child, and copy its property list
2554 to this interval. */
2555 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2557 if ((i)->left)
2559 (i)->plist = (i)->left->plist;
2560 (i)->left->total_length = 0;
2561 delete_interval ((i)->left);
2563 else
2565 (i)->plist = (i)->right->plist;
2566 (i)->right->total_length = 0;
2567 delete_interval ((i)->right);
2572 /* Update the intervals of the current buffer
2573 to fit the contents as multibyte (if MULTI_FLAG is 1)
2574 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2576 void
2577 set_intervals_multibyte (multi_flag)
2578 int multi_flag;
2580 if (BUF_INTERVALS (current_buffer))
2581 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2582 BEG, BEG_BYTE, Z, Z_BYTE);