Mention false positives of file-accessible-directory on w32
[emacs.git] / src / intervals.c
blob78e0f50f6fe315559ec6c27340e09ea64a6da880
1 /* Code for doing intervals.
2 Copyright (C) 1993-1995, 1997-1998, 2001-2015 Free Software
3 Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* NOTES:
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
36 to GC them.
41 #include <config.h>
43 #include <intprops.h>
44 #include "lisp.h"
45 #include "intervals.h"
46 #include "character.h"
47 #include "buffer.h"
48 #include "puresize.h"
49 #include "keyboard.h"
50 #include "keymap.h"
52 /* Test for membership, allowing for t (actually any non-cons) to mean the
53 universal set. */
55 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
57 static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object);
58 static INTERVAL merge_interval_right (INTERVAL);
59 static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
61 /* Utility functions for intervals. */
63 /* Use these functions to set pointer slots of struct interval. */
65 static void
66 set_interval_left (INTERVAL i, INTERVAL left)
68 i->left = left;
71 static void
72 set_interval_right (INTERVAL i, INTERVAL right)
74 i->right = right;
77 /* Make the parent of D be whatever the parent of S is, regardless
78 of the type. This is used when balancing an interval tree. */
80 static void
81 copy_interval_parent (INTERVAL d, INTERVAL s)
83 d->up = s->up;
84 d->up_obj = s->up_obj;
87 /* Create the root interval of some object, a buffer or string. */
89 INTERVAL
90 create_root_interval (Lisp_Object parent)
92 INTERVAL new;
94 CHECK_IMPURE (parent);
96 new = make_interval ();
98 if (BUFFERP (parent))
100 new->total_length = (BUF_Z (XBUFFER (parent))
101 - BUF_BEG (XBUFFER (parent)));
102 eassert (TOTAL_LENGTH (new) >= 0);
103 set_buffer_intervals (XBUFFER (parent), new);
104 new->position = BEG;
106 else if (STRINGP (parent))
108 new->total_length = SCHARS (parent);
109 eassert (TOTAL_LENGTH (new) >= 0);
110 set_string_intervals (parent, new);
111 new->position = 0;
113 eassert (LENGTH (new) > 0);
115 set_interval_object (new, parent);
117 return new;
120 /* Make the interval TARGET have exactly the properties of SOURCE. */
122 void
123 copy_properties (register INTERVAL source, register INTERVAL target)
125 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
126 return;
128 COPY_INTERVAL_CACHE (source, target);
129 set_interval_plist (target, Fcopy_sequence (source->plist));
132 /* Merge the properties of interval SOURCE into the properties
133 of interval TARGET. That is to say, each property in SOURCE
134 is added to TARGET if TARGET has no such property as yet. */
136 static void
137 merge_properties (register INTERVAL source, register INTERVAL target)
139 register Lisp_Object o, sym, val;
141 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
142 return;
144 MERGE_INTERVAL_CACHE (source, target);
146 o = source->plist;
147 while (CONSP (o))
149 sym = XCAR (o);
150 o = XCDR (o);
151 CHECK_CONS (o);
153 val = target->plist;
154 while (CONSP (val) && !EQ (XCAR (val), sym))
156 val = XCDR (val);
157 if (!CONSP (val))
158 break;
159 val = XCDR (val);
162 if (NILP (val))
164 val = XCAR (o);
165 set_interval_plist (target, Fcons (sym, Fcons (val, target->plist)));
167 o = XCDR (o);
171 /* Return true if the two intervals have the same properties. */
173 bool
174 intervals_equal (INTERVAL i0, INTERVAL i1)
176 Lisp_Object i0_cdr, i0_sym;
177 Lisp_Object i1_cdr, i1_val;
179 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
180 return true;
182 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
183 return false;
185 i0_cdr = i0->plist;
186 i1_cdr = i1->plist;
187 while (CONSP (i0_cdr) && CONSP (i1_cdr))
189 i0_sym = XCAR (i0_cdr);
190 i0_cdr = XCDR (i0_cdr);
191 if (!CONSP (i0_cdr))
192 return false;
193 i1_val = i1->plist;
194 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
196 i1_val = XCDR (i1_val);
197 if (!CONSP (i1_val))
198 return false;
199 i1_val = XCDR (i1_val);
202 /* i0 has something i1 doesn't. */
203 if (EQ (i1_val, Qnil))
204 return false;
206 /* i0 and i1 both have sym, but it has different values in each. */
207 if (!CONSP (i1_val)
208 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
209 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
210 return false;
212 i0_cdr = XCDR (i0_cdr);
214 i1_cdr = XCDR (i1_cdr);
215 if (!CONSP (i1_cdr))
216 return false;
217 i1_cdr = XCDR (i1_cdr);
220 /* Lengths of the two plists were equal. */
221 return (NILP (i0_cdr) && NILP (i1_cdr));
225 /* Traverse an interval tree TREE, performing FUNCTION on each node.
226 No guarantee is made about the order of traversal.
227 Pass FUNCTION two args: an interval, and ARG. */
229 void
230 traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
232 /* Minimize stack usage. */
233 while (tree)
235 (*function) (tree, arg);
236 if (!tree->right)
237 tree = tree->left;
238 else
240 traverse_intervals_noorder (tree->left, function, arg);
241 tree = tree->right;
246 /* Traverse an interval tree TREE, performing FUNCTION on each node.
247 Pass FUNCTION two args: an interval, and ARG. */
249 void
250 traverse_intervals (INTERVAL tree, ptrdiff_t position,
251 void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
253 while (tree)
255 traverse_intervals (tree->left, position, function, arg);
256 position += LEFT_TOTAL_LENGTH (tree);
257 tree->position = position;
258 (*function) (tree, arg);
259 position += LENGTH (tree); tree = tree->right;
263 #if 0
265 static int icount;
266 static int idepth;
267 static int zero_length;
269 /* These functions are temporary, for debugging purposes only. */
271 INTERVAL search_interval, found_interval;
273 void
274 check_for_interval (INTERVAL i)
276 if (i == search_interval)
278 found_interval = i;
279 icount++;
283 INTERVAL
284 search_for_interval (INTERVAL i, INTERVAL tree)
286 icount = 0;
287 search_interval = i;
288 found_interval = NULL;
289 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
290 return found_interval;
293 static void
294 inc_interval_count (INTERVAL i)
296 icount++;
297 if (LENGTH (i) == 0)
298 zero_length++;
299 if (depth > idepth)
300 idepth = depth;
304 count_intervals (INTERVAL i)
306 icount = 0;
307 idepth = 0;
308 zero_length = 0;
309 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
311 return icount;
314 static INTERVAL
315 root_interval (INTERVAL interval)
317 register INTERVAL i = interval;
319 while (! ROOT_INTERVAL_P (i))
320 i = INTERVAL_PARENT (i);
322 return i;
324 #endif
326 /* Assuming that a left child exists, perform the following operation:
329 / \ / \
330 B => A
331 / \ / \
335 static INTERVAL
336 rotate_right (INTERVAL A)
338 INTERVAL B = A->left;
339 INTERVAL c = B->right;
340 ptrdiff_t old_total = A->total_length;
342 eassert (old_total > 0);
343 eassert (LENGTH (A) > 0);
344 eassert (LENGTH (B) > 0);
346 /* Deal with any Parent of A; make it point to B. */
347 if (! ROOT_INTERVAL_P (A))
349 if (AM_LEFT_CHILD (A))
350 set_interval_left (INTERVAL_PARENT (A), B);
351 else
352 set_interval_right (INTERVAL_PARENT (A), B);
354 copy_interval_parent (B, A);
356 /* Make B the parent of A. */
357 set_interval_right (B, A);
358 set_interval_parent (A, B);
360 /* Make A point to c. */
361 set_interval_left (A, c);
362 if (c)
363 set_interval_parent (c, A);
365 /* A's total length is decreased by the length of B and its left child. */
366 A->total_length -= B->total_length - TOTAL_LENGTH (c);
367 eassert (TOTAL_LENGTH (A) > 0);
368 eassert (LENGTH (A) > 0);
370 /* B must have the same total length of A. */
371 B->total_length = old_total;
372 eassert (LENGTH (B) > 0);
374 return B;
377 /* Assuming that a right child exists, perform the following operation:
380 / \ / \
381 B => A
382 / \ / \
386 static INTERVAL
387 rotate_left (INTERVAL A)
389 INTERVAL B = A->right;
390 INTERVAL c = B->left;
391 ptrdiff_t old_total = A->total_length;
393 eassert (old_total > 0);
394 eassert (LENGTH (A) > 0);
395 eassert (LENGTH (B) > 0);
397 /* Deal with any parent of A; make it point to B. */
398 if (! ROOT_INTERVAL_P (A))
400 if (AM_LEFT_CHILD (A))
401 set_interval_left (INTERVAL_PARENT (A), B);
402 else
403 set_interval_right (INTERVAL_PARENT (A), B);
405 copy_interval_parent (B, A);
407 /* Make B the parent of A. */
408 set_interval_left (B, A);
409 set_interval_parent (A, B);
411 /* Make A point to c. */
412 set_interval_right (A, c);
413 if (c)
414 set_interval_parent (c, A);
416 /* A's total length is decreased by the length of B and its right child. */
417 A->total_length -= B->total_length - TOTAL_LENGTH (c);
418 eassert (TOTAL_LENGTH (A) > 0);
419 eassert (LENGTH (A) > 0);
421 /* B must have the same total length of A. */
422 B->total_length = old_total;
423 eassert (LENGTH (B) > 0);
425 return B;
428 /* Balance an interval tree with the assumption that the subtrees
429 themselves are already balanced. */
431 static INTERVAL
432 balance_an_interval (INTERVAL i)
434 register ptrdiff_t old_diff, new_diff;
436 eassert (LENGTH (i) > 0);
437 eassert (TOTAL_LENGTH (i) >= LENGTH (i));
439 while (1)
441 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
442 if (old_diff > 0)
444 /* Since the left child is longer, there must be one. */
445 new_diff = i->total_length - i->left->total_length
446 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
447 if (eabs (new_diff) >= old_diff)
448 break;
449 i = rotate_right (i);
450 balance_an_interval (i->right);
452 else if (old_diff < 0)
454 /* Since the right child is longer, there must be one. */
455 new_diff = i->total_length - i->right->total_length
456 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
457 if (eabs (new_diff) >= -old_diff)
458 break;
459 i = rotate_left (i);
460 balance_an_interval (i->left);
462 else
463 break;
465 return i;
468 /* Balance INTERVAL, potentially stuffing it back into its parent
469 Lisp Object. */
471 static INTERVAL
472 balance_possible_root_interval (INTERVAL interval)
474 Lisp_Object parent;
475 bool have_parent = false;
477 if (INTERVAL_HAS_OBJECT (interval))
479 have_parent = true;
480 GET_INTERVAL_OBJECT (parent, interval);
482 else if (!INTERVAL_HAS_PARENT (interval))
483 return interval;
485 interval = balance_an_interval (interval);
487 if (have_parent)
489 if (BUFFERP (parent))
490 set_buffer_intervals (XBUFFER (parent), interval);
491 else if (STRINGP (parent))
492 set_string_intervals (parent, interval);
495 return interval;
498 /* Balance the interval tree TREE. Balancing is by weight
499 (the amount of text). */
501 static INTERVAL
502 balance_intervals_internal (register INTERVAL tree)
504 /* Balance within each side. */
505 if (tree->left)
506 balance_intervals_internal (tree->left);
507 if (tree->right)
508 balance_intervals_internal (tree->right);
509 return balance_an_interval (tree);
512 /* Advertised interface to balance intervals. */
514 INTERVAL
515 balance_intervals (INTERVAL tree)
517 return tree ? balance_intervals_internal (tree) : NULL;
520 /* Rebalance text properties of B. */
522 static void
523 buffer_balance_intervals (struct buffer *b)
525 INTERVAL i;
527 eassert (b != NULL);
528 i = buffer_intervals (b);
529 if (i)
530 set_buffer_intervals (b, balance_an_interval (i));
533 /* Split INTERVAL into two pieces, starting the second piece at
534 character position OFFSET (counting from 0), relative to INTERVAL.
535 INTERVAL becomes the left-hand piece, and the right-hand piece
536 (second, lexicographically) is returned.
538 The size and position fields of the two intervals are set based upon
539 those of the original interval. The property list of the new interval
540 is reset, thus it is up to the caller to do the right thing with the
541 result.
543 Note that this does not change the position of INTERVAL; if it is a root,
544 it is still a root after this operation. */
546 INTERVAL
547 split_interval_right (INTERVAL interval, ptrdiff_t offset)
549 INTERVAL new = make_interval ();
550 ptrdiff_t position = interval->position;
551 ptrdiff_t new_length = LENGTH (interval) - offset;
553 new->position = position + offset;
554 set_interval_parent (new, interval);
556 if (NULL_RIGHT_CHILD (interval))
558 set_interval_right (interval, new);
559 new->total_length = new_length;
560 eassert (LENGTH (new) > 0);
562 else
564 /* Insert the new node between INTERVAL and its right child. */
565 set_interval_right (new, interval->right);
566 set_interval_parent (interval->right, new);
567 set_interval_right (interval, new);
568 new->total_length = new_length + new->right->total_length;
569 balance_an_interval (new);
572 balance_possible_root_interval (interval);
574 return new;
577 /* Split INTERVAL into two pieces, starting the second piece at
578 character position OFFSET (counting from 0), relative to INTERVAL.
579 INTERVAL becomes the right-hand piece, and the left-hand piece
580 (first, lexicographically) is returned.
582 The size and position fields of the two intervals are set based upon
583 those of the original interval. The property list of the new interval
584 is reset, thus it is up to the caller to do the right thing with the
585 result.
587 Note that this does not change the position of INTERVAL; if it is a root,
588 it is still a root after this operation. */
590 INTERVAL
591 split_interval_left (INTERVAL interval, ptrdiff_t offset)
593 INTERVAL new = make_interval ();
594 ptrdiff_t new_length = offset;
596 new->position = interval->position;
597 interval->position = interval->position + offset;
598 set_interval_parent (new, interval);
600 if (NULL_LEFT_CHILD (interval))
602 set_interval_left (interval, new);
603 new->total_length = new_length;
604 eassert (LENGTH (new) > 0);
606 else
608 /* Insert the new node between INTERVAL and its left child. */
609 set_interval_left (new, interval->left);
610 set_interval_parent (new->left, new);
611 set_interval_left (interval, new);
612 new->total_length = new_length + new->left->total_length;
613 balance_an_interval (new);
616 balance_possible_root_interval (interval);
618 return new;
621 /* Return the proper position for the first character
622 described by the interval tree SOURCE.
623 This is 1 if the parent is a buffer,
624 0 if the parent is a string or if there is no parent.
626 Don't use this function on an interval which is the child
627 of another interval! */
629 static int
630 interval_start_pos (INTERVAL source)
632 Lisp_Object parent;
634 if (!source)
635 return 0;
637 if (! INTERVAL_HAS_OBJECT (source))
638 return 0;
639 GET_INTERVAL_OBJECT (parent, source);
640 if (BUFFERP (parent))
641 return BUF_BEG (XBUFFER (parent));
642 return 0;
645 /* Find the interval containing text position POSITION in the text
646 represented by the interval tree TREE. POSITION is a buffer
647 position (starting from 1) or a string index (starting from 0).
648 If POSITION is at the end of the buffer or string,
649 return the interval containing the last character.
651 The `position' field, which is a cache of an interval's position,
652 is updated in the interval found. Other functions (e.g., next_interval)
653 will update this cache based on the result of find_interval. */
655 INTERVAL
656 find_interval (register INTERVAL tree, register ptrdiff_t position)
658 /* The distance from the left edge of the subtree at TREE
659 to POSITION. */
660 register ptrdiff_t relative_position;
662 if (!tree)
663 return NULL;
665 relative_position = position;
666 if (INTERVAL_HAS_OBJECT (tree))
668 Lisp_Object parent;
669 GET_INTERVAL_OBJECT (parent, tree);
670 if (BUFFERP (parent))
671 relative_position -= BUF_BEG (XBUFFER (parent));
674 eassert (relative_position <= TOTAL_LENGTH (tree));
676 tree = balance_possible_root_interval (tree);
678 while (1)
680 eassert (tree);
681 if (relative_position < LEFT_TOTAL_LENGTH (tree))
683 tree = tree->left;
685 else if (! NULL_RIGHT_CHILD (tree)
686 && relative_position >= (TOTAL_LENGTH (tree)
687 - RIGHT_TOTAL_LENGTH (tree)))
689 relative_position -= (TOTAL_LENGTH (tree)
690 - RIGHT_TOTAL_LENGTH (tree));
691 tree = tree->right;
693 else
695 tree->position
696 = (position - relative_position /* left edge of *tree. */
697 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
699 return tree;
704 /* Find the succeeding interval (lexicographically) to INTERVAL.
705 Sets the `position' field based on that of INTERVAL (see
706 find_interval). */
708 INTERVAL
709 next_interval (register INTERVAL interval)
711 register INTERVAL i = interval;
712 register ptrdiff_t next_position;
714 if (!i)
715 return NULL;
716 next_position = interval->position + LENGTH (interval);
718 if (! NULL_RIGHT_CHILD (i))
720 i = i->right;
721 while (! NULL_LEFT_CHILD (i))
722 i = i->left;
724 i->position = next_position;
725 return i;
728 while (! NULL_PARENT (i))
730 if (AM_LEFT_CHILD (i))
732 i = INTERVAL_PARENT (i);
733 i->position = next_position;
734 return i;
737 i = INTERVAL_PARENT (i);
740 return NULL;
743 /* Find the preceding interval (lexicographically) to INTERVAL.
744 Sets the `position' field based on that of INTERVAL (see
745 find_interval). */
747 INTERVAL
748 previous_interval (register INTERVAL interval)
750 register INTERVAL i;
752 if (!interval)
753 return NULL;
755 if (! NULL_LEFT_CHILD (interval))
757 i = interval->left;
758 while (! NULL_RIGHT_CHILD (i))
759 i = i->right;
761 i->position = interval->position - LENGTH (i);
762 return i;
765 i = interval;
766 while (! NULL_PARENT (i))
768 if (AM_RIGHT_CHILD (i))
770 i = INTERVAL_PARENT (i);
772 i->position = interval->position - LENGTH (i);
773 return i;
775 i = INTERVAL_PARENT (i);
778 return NULL;
781 /* Find the interval containing POS given some non-NULL INTERVAL
782 in the same tree. Note that we need to update interval->position
783 if we go down the tree.
784 To speed up the process, we assume that the ->position of
785 I and all its parents is already uptodate. */
786 INTERVAL
787 update_interval (register INTERVAL i, ptrdiff_t pos)
789 if (!i)
790 return NULL;
792 while (1)
794 if (pos < i->position)
796 /* Move left. */
797 if (pos >= i->position - TOTAL_LENGTH (i->left))
799 i->left->position = i->position - TOTAL_LENGTH (i->left)
800 + LEFT_TOTAL_LENGTH (i->left);
801 i = i->left; /* Move to the left child. */
803 else if (NULL_PARENT (i))
804 error ("Point before start of properties");
805 else
806 i = INTERVAL_PARENT (i);
807 continue;
809 else if (pos >= INTERVAL_LAST_POS (i))
811 /* Move right. */
812 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
814 i->right->position = INTERVAL_LAST_POS (i)
815 + LEFT_TOTAL_LENGTH (i->right);
816 i = i->right; /* Move to the right child. */
818 else if (NULL_PARENT (i))
819 error ("Point %"pD"d after end of properties", pos);
820 else
821 i = INTERVAL_PARENT (i);
822 continue;
824 else
825 return i;
829 /* Effect an adjustment corresponding to the addition of LENGTH characters
830 of text. Do this by finding the interval containing POSITION in the
831 interval tree TREE, and then adjusting all of its ancestors by adding
832 LENGTH to them.
834 If POSITION is the first character of an interval, meaning that point
835 is actually between the two intervals, make the new text belong to
836 the interval which is "sticky".
838 If both intervals are "sticky", then make them belong to the left-most
839 interval. Another possibility would be to create a new interval for
840 this text, and make it have the merged properties of both ends. */
842 static INTERVAL
843 adjust_intervals_for_insertion (INTERVAL tree,
844 ptrdiff_t position, ptrdiff_t length)
846 INTERVAL i;
847 INTERVAL temp;
848 bool eobp = 0;
849 Lisp_Object parent;
850 ptrdiff_t offset;
852 eassert (TOTAL_LENGTH (tree) > 0);
854 GET_INTERVAL_OBJECT (parent, tree);
855 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
857 /* If inserting at point-max of a buffer, that position will be out
858 of range. Remember that buffer positions are 1-based. */
859 if (position >= TOTAL_LENGTH (tree) + offset)
861 position = TOTAL_LENGTH (tree) + offset;
862 eobp = 1;
865 i = find_interval (tree, position);
867 /* If in middle of an interval which is not sticky either way,
868 we must not just give its properties to the insertion.
869 So split this interval at the insertion point.
871 Originally, the if condition here was this:
872 (! (position == i->position || eobp)
873 && END_NONSTICKY_P (i)
874 && FRONT_NONSTICKY_P (i))
875 But, these macros are now unreliable because of introduction of
876 Vtext_property_default_nonsticky. So, we always check properties
877 one by one if POSITION is in middle of an interval. */
878 if (! (position == i->position || eobp))
880 Lisp_Object tail;
881 Lisp_Object front, rear;
883 tail = i->plist;
885 /* Properties font-sticky and rear-nonsticky override
886 Vtext_property_default_nonsticky. So, if they are t, we can
887 skip one by one checking of properties. */
888 rear = textget (i->plist, Qrear_nonsticky);
889 if (! CONSP (rear) && ! NILP (rear))
891 /* All properties are nonsticky. We split the interval. */
892 goto check_done;
894 front = textget (i->plist, Qfront_sticky);
895 if (! CONSP (front) && ! NILP (front))
897 /* All properties are sticky. We don't split the interval. */
898 tail = Qnil;
899 goto check_done;
902 /* Does any actual property pose an actual problem? We break
903 the loop if we find a nonsticky property. */
904 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
906 Lisp_Object prop, tmp;
907 prop = XCAR (tail);
909 /* Is this particular property front-sticky? */
910 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
911 continue;
913 /* Is this particular property rear-nonsticky? */
914 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
915 break;
917 /* Is this particular property recorded as sticky or
918 nonsticky in Vtext_property_default_nonsticky? */
919 tmp = Fassq (prop, Vtext_property_default_nonsticky);
920 if (CONSP (tmp))
922 if (NILP (tmp))
923 continue;
924 break;
927 /* By default, a text property is rear-sticky, thus we
928 continue the loop. */
931 check_done:
932 /* If any property is a real problem, split the interval. */
933 if (! NILP (tail))
935 temp = split_interval_right (i, position - i->position);
936 copy_properties (i, temp);
937 i = temp;
941 /* If we are positioned between intervals, check the stickiness of
942 both of them. We have to do this too, if we are at BEG or Z. */
943 if (position == i->position || eobp)
945 register INTERVAL prev;
947 if (position == BEG)
948 prev = 0;
949 else if (eobp)
951 prev = i;
952 i = 0;
954 else
955 prev = previous_interval (i);
957 /* Even if we are positioned between intervals, we default
958 to the left one if it exists. We extend it now and split
959 off a part later, if stickiness demands it. */
960 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
962 temp->total_length += length;
963 temp = balance_possible_root_interval (temp);
966 /* If at least one interval has sticky properties,
967 we check the stickiness property by property.
969 Originally, the if condition here was this:
970 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
971 But, these macros are now unreliable because of introduction
972 of Vtext_property_default_nonsticky. So, we always have to
973 check stickiness of properties one by one. If cache of
974 stickiness is implemented in the future, we may be able to
975 use those macros again. */
976 if (1)
978 Lisp_Object pleft, pright;
979 struct interval newi;
981 RESET_INTERVAL (&newi);
982 pleft = prev ? prev->plist : Qnil;
983 pright = i ? i->plist : Qnil;
984 set_interval_plist (&newi, merge_properties_sticky (pleft, pright));
986 if (! prev) /* i.e. position == BEG */
988 if (! intervals_equal (i, &newi))
990 i = split_interval_left (i, length);
991 set_interval_plist (i, newi.plist);
994 else if (! intervals_equal (prev, &newi))
996 prev = split_interval_right (prev, position - prev->position);
997 set_interval_plist (prev, newi.plist);
998 if (i && intervals_equal (prev, i))
999 merge_interval_right (prev);
1002 /* We will need to update the cache here later. */
1004 else if (! prev && ! NILP (i->plist))
1006 /* Just split off a new interval at the left.
1007 Since I wasn't front-sticky, the empty plist is ok. */
1008 i = split_interval_left (i, length);
1012 /* Otherwise just extend the interval. */
1013 else
1015 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1017 temp->total_length += length;
1018 temp = balance_possible_root_interval (temp);
1022 return tree;
1025 /* Any property might be front-sticky on the left, rear-sticky on the left,
1026 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1027 can be arranged in a matrix with rows denoting the left conditions and
1028 columns denoting the right conditions:
1029 _ __ _
1030 _ FR FR FR FR
1031 FR__ 0 1 2 3
1032 _FR 4 5 6 7
1033 FR 8 9 A B
1034 FR C D E F
1036 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1037 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1038 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1039 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1040 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1041 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1042 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1043 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1045 We inherit from whoever has a sticky side facing us. If both sides
1046 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1047 non-nil value for the current property. If both sides do, then we take
1048 from the left.
1050 When we inherit a property, we get its stickiness as well as its value.
1051 So, when we merge the above two lists, we expect to get this:
1053 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1054 rear-nonsticky (p6 pa)
1055 p0 L p1 L p2 L p3 L p6 R p7 R
1056 pa R pb R pc L pd L pe L pf L)
1058 The optimizable special cases are:
1059 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1060 left rear-nonsticky = t, right front-sticky = t (inherit right)
1061 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1064 static Lisp_Object
1065 merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
1067 Lisp_Object props, front, rear;
1068 Lisp_Object lfront, lrear, rfront, rrear;
1069 Lisp_Object tail1, tail2, sym, lval, rval, cat;
1070 bool use_left, use_right, lpresent;
1072 props = Qnil;
1073 front = Qnil;
1074 rear = Qnil;
1075 lfront = textget (pleft, Qfront_sticky);
1076 lrear = textget (pleft, Qrear_nonsticky);
1077 rfront = textget (pright, Qfront_sticky);
1078 rrear = textget (pright, Qrear_nonsticky);
1080 /* Go through each element of PRIGHT. */
1081 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1083 Lisp_Object tmp;
1085 sym = XCAR (tail1);
1087 /* Sticky properties get special treatment. */
1088 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1089 continue;
1091 rval = Fcar (XCDR (tail1));
1092 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1093 if (EQ (sym, XCAR (tail2)))
1094 break;
1096 /* Indicate whether the property is explicitly defined on the left.
1097 (We know it is defined explicitly on the right
1098 because otherwise we don't get here.) */
1099 lpresent = ! NILP (tail2);
1100 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1102 /* Even if lrear or rfront say nothing about the stickiness of
1103 SYM, Vtext_property_default_nonsticky may give default
1104 stickiness to SYM. */
1105 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1106 use_left = (lpresent
1107 && ! (TMEM (sym, lrear)
1108 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1109 use_right = (TMEM (sym, rfront)
1110 || (CONSP (tmp) && NILP (XCDR (tmp))));
1111 if (use_left && use_right)
1113 if (NILP (lval))
1114 use_left = 0;
1115 else if (NILP (rval))
1116 use_right = 0;
1118 if (use_left)
1120 /* We build props as (value sym ...) rather than (sym value ...)
1121 because we plan to nreverse it when we're done. */
1122 props = Fcons (lval, Fcons (sym, props));
1123 if (TMEM (sym, lfront))
1124 front = Fcons (sym, front);
1125 if (TMEM (sym, lrear))
1126 rear = Fcons (sym, rear);
1128 else if (use_right)
1130 props = Fcons (rval, Fcons (sym, props));
1131 if (TMEM (sym, rfront))
1132 front = Fcons (sym, front);
1133 if (TMEM (sym, rrear))
1134 rear = Fcons (sym, rear);
1138 /* Now go through each element of PLEFT. */
1139 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1141 Lisp_Object tmp;
1143 sym = XCAR (tail2);
1145 /* Sticky properties get special treatment. */
1146 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1147 continue;
1149 /* If sym is in PRIGHT, we've already considered it. */
1150 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1151 if (EQ (sym, XCAR (tail1)))
1152 break;
1153 if (! NILP (tail1))
1154 continue;
1156 lval = Fcar (XCDR (tail2));
1158 /* Even if lrear or rfront say nothing about the stickiness of
1159 SYM, Vtext_property_default_nonsticky may give default
1160 stickiness to SYM. */
1161 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1163 /* Since rval is known to be nil in this loop, the test simplifies. */
1164 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1166 props = Fcons (lval, Fcons (sym, props));
1167 if (TMEM (sym, lfront))
1168 front = Fcons (sym, front);
1170 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1172 /* The value is nil, but we still inherit the stickiness
1173 from the right. */
1174 front = Fcons (sym, front);
1175 if (TMEM (sym, rrear))
1176 rear = Fcons (sym, rear);
1179 props = Fnreverse (props);
1180 if (! NILP (rear))
1181 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1183 cat = textget (props, Qcategory);
1184 if (! NILP (front)
1186 /* If we have inherited a front-stick category property that is t,
1187 we don't need to set up a detailed one. */
1188 ! (! NILP (cat) && SYMBOLP (cat)
1189 && EQ (Fget (cat, Qfront_sticky), Qt)))
1190 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1191 return props;
1195 /* Delete a node I from its interval tree by merging its subtrees
1196 into one subtree which is then returned. Caller is responsible for
1197 storing the resulting subtree into its parent. */
1199 static INTERVAL
1200 delete_node (register INTERVAL i)
1202 register INTERVAL migrate, this;
1203 register ptrdiff_t migrate_amt;
1205 if (!i->left)
1206 return i->right;
1207 if (!i->right)
1208 return i->left;
1210 migrate = i->left;
1211 migrate_amt = i->left->total_length;
1212 this = i->right;
1213 this->total_length += migrate_amt;
1214 while (this->left)
1216 this = this->left;
1217 this->total_length += migrate_amt;
1219 set_interval_left (this, migrate);
1220 set_interval_parent (migrate, this);
1221 eassert (LENGTH (this) > 0);
1222 eassert (LENGTH (i->right) > 0);
1224 return i->right;
1227 /* Delete interval I from its tree by calling `delete_node'
1228 and properly connecting the resultant subtree.
1230 I is presumed to be empty; that is, no adjustments are made
1231 for the length of I. */
1233 static void
1234 delete_interval (register INTERVAL i)
1236 register INTERVAL parent;
1237 ptrdiff_t amt = LENGTH (i);
1239 eassert (amt == 0); /* Only used on zero-length intervals now. */
1241 if (ROOT_INTERVAL_P (i))
1243 Lisp_Object owner;
1244 GET_INTERVAL_OBJECT (owner, i);
1245 parent = delete_node (i);
1246 if (parent)
1247 set_interval_object (parent, owner);
1249 if (BUFFERP (owner))
1250 set_buffer_intervals (XBUFFER (owner), parent);
1251 else if (STRINGP (owner))
1252 set_string_intervals (owner, parent);
1253 else
1254 emacs_abort ();
1256 return;
1259 parent = INTERVAL_PARENT (i);
1260 if (AM_LEFT_CHILD (i))
1262 set_interval_left (parent, delete_node (i));
1263 if (parent->left)
1264 set_interval_parent (parent->left, parent);
1266 else
1268 set_interval_right (parent, delete_node (i));
1269 if (parent->right)
1270 set_interval_parent (parent->right, parent);
1274 /* Find the interval in TREE corresponding to the relative position
1275 FROM and delete as much as possible of AMOUNT from that interval.
1276 Return the amount actually deleted, and if the interval was
1277 zeroed-out, delete that interval node from the tree.
1279 Note that FROM is actually origin zero, aka relative to the
1280 leftmost edge of tree. This is appropriate since we call ourselves
1281 recursively on subtrees.
1283 Do this by recursing down TREE to the interval in question, and
1284 deleting the appropriate amount of text. */
1286 static ptrdiff_t
1287 interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from,
1288 register ptrdiff_t amount)
1290 register ptrdiff_t relative_position = from;
1292 if (!tree)
1293 return 0;
1295 /* Left branch. */
1296 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1298 ptrdiff_t subtract = interval_deletion_adjustment (tree->left,
1299 relative_position,
1300 amount);
1301 tree->total_length -= subtract;
1302 eassert (LENGTH (tree) > 0);
1303 return subtract;
1305 /* Right branch. */
1306 else if (relative_position >= (TOTAL_LENGTH (tree)
1307 - RIGHT_TOTAL_LENGTH (tree)))
1309 ptrdiff_t subtract;
1311 relative_position -= (tree->total_length
1312 - RIGHT_TOTAL_LENGTH (tree));
1313 subtract = interval_deletion_adjustment (tree->right,
1314 relative_position,
1315 amount);
1316 tree->total_length -= subtract;
1317 eassert (LENGTH (tree) > 0);
1318 return subtract;
1320 /* Here -- this node. */
1321 else
1323 /* How much can we delete from this interval? */
1324 ptrdiff_t my_amount = ((tree->total_length
1325 - RIGHT_TOTAL_LENGTH (tree))
1326 - relative_position);
1328 if (amount > my_amount)
1329 amount = my_amount;
1331 tree->total_length -= amount;
1332 eassert (LENGTH (tree) >= 0);
1333 if (LENGTH (tree) == 0)
1334 delete_interval (tree);
1336 return amount;
1339 /* Never reach here. */
1342 /* Effect the adjustments necessary to the interval tree of BUFFER to
1343 correspond to the deletion of LENGTH characters from that buffer
1344 text. The deletion is effected at position START (which is a
1345 buffer position, i.e. origin 1). */
1347 static void
1348 adjust_intervals_for_deletion (struct buffer *buffer,
1349 ptrdiff_t start, ptrdiff_t length)
1351 ptrdiff_t left_to_delete = length;
1352 INTERVAL tree = buffer_intervals (buffer);
1353 Lisp_Object parent;
1354 ptrdiff_t offset;
1356 GET_INTERVAL_OBJECT (parent, tree);
1357 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1359 if (!tree)
1360 return;
1362 eassert (start <= offset + TOTAL_LENGTH (tree)
1363 && start + length <= offset + TOTAL_LENGTH (tree));
1365 if (length == TOTAL_LENGTH (tree))
1367 set_buffer_intervals (buffer, NULL);
1368 return;
1371 if (ONLY_INTERVAL_P (tree))
1373 tree->total_length -= length;
1374 eassert (LENGTH (tree) > 0);
1375 return;
1378 if (start > offset + TOTAL_LENGTH (tree))
1379 start = offset + TOTAL_LENGTH (tree);
1380 while (left_to_delete > 0)
1382 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1383 left_to_delete);
1384 tree = buffer_intervals (buffer);
1385 if (left_to_delete == tree->total_length)
1387 set_buffer_intervals (buffer, NULL);
1388 return;
1393 /* Make the adjustments necessary to the interval tree of BUFFER to
1394 represent an addition or deletion of LENGTH characters starting
1395 at position START. Addition or deletion is indicated by the sign
1396 of LENGTH. */
1398 void
1399 offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
1401 if (!buffer_intervals (buffer) || length == 0)
1402 return;
1404 if (length > 0)
1405 adjust_intervals_for_insertion (buffer_intervals (buffer),
1406 start, length);
1407 else
1408 adjust_intervals_for_deletion (buffer, start, -length);
1411 /* Merge interval I with its lexicographic successor. The resulting
1412 interval is returned, and has the properties of the original
1413 successor. The properties of I are lost. I is removed from the
1414 interval tree.
1416 IMPORTANT:
1417 The caller must verify that this is not the last (rightmost)
1418 interval. */
1420 static INTERVAL
1421 merge_interval_right (register INTERVAL i)
1423 register ptrdiff_t absorb = LENGTH (i);
1424 register INTERVAL successor;
1426 /* Find the succeeding interval. */
1427 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1428 as we descend. */
1430 successor = i->right;
1431 while (! NULL_LEFT_CHILD (successor))
1433 successor->total_length += absorb;
1434 eassert (LENGTH (successor) > 0);
1435 successor = successor->left;
1438 successor->total_length += absorb;
1439 eassert (LENGTH (successor) > 0);
1440 delete_interval (i);
1441 return successor;
1444 /* Zero out this interval. */
1445 i->total_length -= absorb;
1446 eassert (TOTAL_LENGTH (i) >= 0);
1448 successor = i;
1449 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1450 we ascend. */
1452 if (AM_LEFT_CHILD (successor))
1454 successor = INTERVAL_PARENT (successor);
1455 delete_interval (i);
1456 return successor;
1459 successor = INTERVAL_PARENT (successor);
1460 successor->total_length -= absorb;
1461 eassert (LENGTH (successor) > 0);
1464 /* This must be the rightmost or last interval and cannot
1465 be merged right. The caller should have known. */
1466 emacs_abort ();
1469 /* Merge interval I with its lexicographic predecessor. The resulting
1470 interval is returned, and has the properties of the original predecessor.
1471 The properties of I are lost. Interval node I is removed from the tree.
1473 IMPORTANT:
1474 The caller must verify that this is not the first (leftmost) interval. */
1476 INTERVAL
1477 merge_interval_left (register INTERVAL i)
1479 register ptrdiff_t absorb = LENGTH (i);
1480 register INTERVAL predecessor;
1482 /* Find the preceding interval. */
1483 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1484 adding ABSORB as we go. */
1486 predecessor = i->left;
1487 while (! NULL_RIGHT_CHILD (predecessor))
1489 predecessor->total_length += absorb;
1490 eassert (LENGTH (predecessor) > 0);
1491 predecessor = predecessor->right;
1494 predecessor->total_length += absorb;
1495 eassert (LENGTH (predecessor) > 0);
1496 delete_interval (i);
1497 return predecessor;
1500 /* Zero out this interval. */
1501 i->total_length -= absorb;
1502 eassert (TOTAL_LENGTH (i) >= 0);
1504 predecessor = i;
1505 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1506 subtracting ABSORB. */
1508 if (AM_RIGHT_CHILD (predecessor))
1510 predecessor = INTERVAL_PARENT (predecessor);
1511 delete_interval (i);
1512 return predecessor;
1515 predecessor = INTERVAL_PARENT (predecessor);
1516 predecessor->total_length -= absorb;
1517 eassert (LENGTH (predecessor) > 0);
1520 /* This must be the leftmost or first interval and cannot
1521 be merged left. The caller should have known. */
1522 emacs_abort ();
1525 /* Create a copy of SOURCE but with the default value of UP. */
1527 static INTERVAL
1528 reproduce_interval (INTERVAL source)
1530 register INTERVAL target = make_interval ();
1532 eassert (LENGTH (source) > 0);
1534 target->total_length = source->total_length;
1535 target->position = source->position;
1537 copy_properties (source, target);
1539 if (! NULL_LEFT_CHILD (source))
1540 set_interval_left (target, reproduce_tree (source->left, target));
1541 if (! NULL_RIGHT_CHILD (source))
1542 set_interval_right (target, reproduce_tree (source->right, target));
1544 eassert (LENGTH (target) > 0);
1545 return target;
1548 /* Make an exact copy of interval tree SOURCE which descends from
1549 PARENT. This is done by recursing through SOURCE, copying
1550 the current interval and its properties, and then adjusting
1551 the pointers of the copy. */
1553 static INTERVAL
1554 reproduce_tree (INTERVAL source, INTERVAL parent)
1556 INTERVAL target = reproduce_interval (source);
1557 set_interval_parent (target, parent);
1558 return target;
1561 static INTERVAL
1562 reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
1564 INTERVAL target = reproduce_interval (source);
1565 set_interval_object (target, parent);
1566 return target;
1569 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1570 LENGTH is the length of the text in SOURCE.
1572 The `position' field of the SOURCE intervals is assumed to be
1573 consistent with its parent; therefore, SOURCE must be an
1574 interval tree made with copy_interval or must be the whole
1575 tree of a buffer or a string.
1577 This is used in insdel.c when inserting Lisp_Strings into the
1578 buffer. The text corresponding to SOURCE is already in the buffer
1579 when this is called. The intervals of new tree are a copy of those
1580 belonging to the string being inserted; intervals are never
1581 shared.
1583 If the inserted text had no intervals associated, and we don't
1584 want to inherit the surrounding text's properties, this function
1585 simply returns -- offset_intervals should handle placing the
1586 text in the correct interval, depending on the sticky bits.
1588 If the inserted text had properties (intervals), then there are two
1589 cases -- either insertion happened in the middle of some interval,
1590 or between two intervals.
1592 If the text goes into the middle of an interval, then new intervals
1593 are created in the middle, and new text has the union of its properties
1594 and those of the text into which it was inserted.
1596 If the text goes between two intervals, then if neither interval
1597 had its appropriate sticky property set (front_sticky, rear_sticky),
1598 the new text has only its properties. If one of the sticky properties
1599 is set, then the new text "sticks" to that region and its properties
1600 depend on merging as above. If both the preceding and succeeding
1601 intervals to the new text are "sticky", then the new text retains
1602 only its properties, as if neither sticky property were set. Perhaps
1603 we should consider merging all three sets of properties onto the new
1604 text... */
1606 void
1607 graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
1608 ptrdiff_t length, struct buffer *buffer,
1609 bool inherit)
1611 INTERVAL tree = buffer_intervals (buffer);
1612 INTERVAL under, over, this;
1613 ptrdiff_t over_used;
1615 /* If the new text has no properties, then with inheritance it
1616 becomes part of whatever interval it was inserted into.
1617 To prevent inheritance, we must clear out the properties
1618 of the newly inserted text. */
1619 if (!source)
1621 Lisp_Object buf;
1622 if (!inherit && tree && length > 0)
1624 XSETBUFFER (buf, buffer);
1625 set_text_properties_1 (make_number (position),
1626 make_number (position + length),
1627 Qnil, buf,
1628 find_interval (tree, position));
1630 /* Shouldn't be necessary. --Stef */
1631 buffer_balance_intervals (buffer);
1632 return;
1635 eassert (length == TOTAL_LENGTH (source));
1637 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == length)
1639 /* The inserted text constitutes the whole buffer, so
1640 simply copy over the interval structure. */
1641 Lisp_Object buf;
1643 XSETBUFFER (buf, buffer);
1644 set_buffer_intervals (buffer, reproduce_tree_obj (source, buf));
1645 buffer_intervals (buffer)->position = BUF_BEG (buffer);
1646 eassert (buffer_intervals (buffer)->up_obj == 1);
1647 return;
1649 else if (!tree)
1651 /* Create an interval tree in which to place a copy
1652 of the intervals of the inserted string. */
1653 Lisp_Object buf;
1655 XSETBUFFER (buf, buffer);
1656 tree = create_root_interval (buf);
1658 /* Paranoia -- the text has already been added, so
1659 this buffer should be of non-zero length. */
1660 eassert (TOTAL_LENGTH (tree) > 0);
1662 this = under = find_interval (tree, position);
1663 eassert (under);
1664 over = find_interval (source, interval_start_pos (source));
1666 /* Here for insertion in the middle of an interval.
1667 Split off an equivalent interval to the right,
1668 then don't bother with it any more. */
1670 if (position > under->position)
1672 INTERVAL end_unchanged
1673 = split_interval_left (this, position - under->position);
1674 copy_properties (under, end_unchanged);
1675 under->position = position;
1677 else
1679 /* This call may have some effect because previous_interval may
1680 update `position' fields of intervals. Thus, don't ignore it
1681 for the moment. Someone please tell me the truth (K.Handa). */
1682 INTERVAL prev = previous_interval (under);
1683 (void) prev;
1684 #if 0
1685 /* But, this code surely has no effect. And, anyway,
1686 END_NONSTICKY_P is unreliable now. */
1687 if (prev && !END_NONSTICKY_P (prev))
1688 prev = 0;
1689 #endif /* 0 */
1692 /* Insertion is now at beginning of UNDER. */
1694 /* The inserted text "sticks" to the interval `under',
1695 which means it gets those properties.
1696 The properties of under are the result of
1697 adjust_intervals_for_insertion, so stickiness has
1698 already been taken care of. */
1700 /* OVER is the interval we are copying from next.
1701 OVER_USED says how many characters' worth of OVER
1702 have already been copied into target intervals.
1703 UNDER is the next interval in the target. */
1704 over_used = 0;
1705 while (over)
1707 /* If UNDER is longer than OVER, split it. */
1708 if (LENGTH (over) - over_used < LENGTH (under))
1710 this = split_interval_left (under, LENGTH (over) - over_used);
1711 copy_properties (under, this);
1713 else
1714 this = under;
1716 /* THIS is now the interval to copy or merge into.
1717 OVER covers all of it. */
1718 if (inherit)
1719 merge_properties (over, this);
1720 else
1721 copy_properties (over, this);
1723 /* If THIS and OVER end at the same place,
1724 advance OVER to a new source interval. */
1725 if (LENGTH (this) == LENGTH (over) - over_used)
1727 over = next_interval (over);
1728 over_used = 0;
1730 else
1731 /* Otherwise just record that more of OVER has been used. */
1732 over_used += LENGTH (this);
1734 /* Always advance to a new target interval. */
1735 under = next_interval (this);
1738 buffer_balance_intervals (buffer);
1741 /* Get the value of property PROP from PLIST,
1742 which is the plist of an interval.
1743 We check for direct properties, for categories with property PROP,
1744 and for PROP appearing on the default-text-properties list. */
1746 Lisp_Object
1747 textget (Lisp_Object plist, register Lisp_Object prop)
1749 return lookup_char_property (plist, prop, 1);
1752 Lisp_Object
1753 lookup_char_property (Lisp_Object plist, Lisp_Object prop, bool textprop)
1755 Lisp_Object tail, fallback = Qnil;
1757 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1759 register Lisp_Object tem;
1760 tem = XCAR (tail);
1761 if (EQ (prop, tem))
1762 return Fcar (XCDR (tail));
1763 if (EQ (tem, Qcategory))
1765 tem = Fcar (XCDR (tail));
1766 if (SYMBOLP (tem))
1767 fallback = Fget (tem, prop);
1771 if (! NILP (fallback))
1772 return fallback;
1773 /* Check for alternative properties. */
1774 tail = Fassq (prop, Vchar_property_alias_alist);
1775 if (! NILP (tail))
1777 tail = XCDR (tail);
1778 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1779 fallback = Fplist_get (plist, XCAR (tail));
1782 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1783 fallback = Fplist_get (Vdefault_text_properties, prop);
1784 return fallback;
1788 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1789 byte position BYTEPOS. */
1791 void
1792 temp_set_point_both (struct buffer *buffer,
1793 ptrdiff_t charpos, ptrdiff_t bytepos)
1795 /* In a single-byte buffer, the two positions must be equal. */
1796 eassert (BUF_ZV (buffer) != BUF_ZV_BYTE (buffer) || charpos == bytepos);
1798 eassert (charpos <= bytepos);
1799 eassert (charpos <= BUF_ZV (buffer) || BUF_BEGV (buffer) <= charpos);
1801 SET_BUF_PT_BOTH (buffer, charpos, bytepos);
1804 /* Set point "temporarily", without checking any text properties. */
1806 void
1807 temp_set_point (struct buffer *buffer, ptrdiff_t charpos)
1809 temp_set_point_both (buffer, charpos,
1810 buf_charpos_to_bytepos (buffer, charpos));
1813 /* Set point in BUFFER to CHARPOS. If the target position is
1814 before an intangible character, move to an ok place. */
1816 void
1817 set_point (ptrdiff_t charpos)
1819 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1822 /* Set PT from MARKER's clipped position. */
1824 void
1825 set_point_from_marker (Lisp_Object marker)
1827 if (XMARKER (marker)->buffer != current_buffer)
1828 signal_error ("Marker points into wrong buffer", marker);
1829 set_point_both
1830 (clip_to_bounds (BEGV, marker_position (marker), ZV),
1831 clip_to_bounds (BEGV_BYTE, marker_byte_position (marker), ZV_BYTE));
1834 /* If there's an invisible character at position POS + TEST_OFFS in the
1835 current buffer, and the invisible property has a `stickiness' such that
1836 inserting a character at position POS would inherit the property it,
1837 return POS + ADJ, otherwise return POS. If TEST_INTANG, intangibility
1838 is required as well as invisibility.
1840 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1842 Note that `stickiness' is determined by overlay marker insertion types,
1843 if the invisible property comes from an overlay. */
1845 static ptrdiff_t
1846 adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj,
1847 bool test_intang)
1849 Lisp_Object invis_propval, invis_overlay;
1850 Lisp_Object test_pos;
1852 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1853 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1854 return pos;
1856 test_pos = make_number (pos + test_offs);
1858 invis_propval
1859 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1860 &invis_overlay);
1862 if ((!test_intang
1863 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1864 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1865 /* This next test is true if the invisible property has a stickiness
1866 such that an insertion at POS would inherit it. */
1867 && (NILP (invis_overlay)
1868 /* Invisible property is from a text-property. */
1869 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1870 == (test_offs == 0 ? 1 : -1))
1871 /* Invisible property is from an overlay. */
1872 : (test_offs == 0
1873 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1874 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1875 pos += adj;
1877 return pos;
1880 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1881 position BYTEPOS. If the target position is
1882 before an intangible character, move to an ok place. */
1884 void
1885 set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
1887 register INTERVAL to, from, toprev, fromprev;
1888 ptrdiff_t buffer_point;
1889 ptrdiff_t old_position = PT;
1890 /* This ensures that we move forward past intangible text when the
1891 initial position is the same as the destination, in the rare
1892 instances where this is important, e.g. in line-move-finish
1893 (simple.el). */
1894 bool backwards = charpos < old_position;
1895 bool have_overlays;
1896 ptrdiff_t original_position;
1898 bset_point_before_scroll (current_buffer, Qnil);
1900 if (charpos == PT)
1901 return;
1903 /* In a single-byte buffer, the two positions must be equal. */
1904 eassert (ZV != ZV_BYTE || charpos == bytepos);
1906 /* Check this now, before checking if the buffer has any intervals.
1907 That way, we can catch conditions which break this sanity check
1908 whether or not there are intervals in the buffer. */
1909 eassert (charpos <= ZV && charpos >= BEGV);
1911 have_overlays = buffer_has_overlays ();
1913 /* If we have no text properties and overlays,
1914 then we can do it quickly. */
1915 if (!buffer_intervals (current_buffer) && ! have_overlays)
1917 temp_set_point_both (current_buffer, charpos, bytepos);
1918 return;
1921 /* Set TO to the interval containing the char after CHARPOS,
1922 and TOPREV to the interval containing the char before CHARPOS.
1923 Either one may be null. They may be equal. */
1924 to = find_interval (buffer_intervals (current_buffer), charpos);
1925 if (charpos == BEGV)
1926 toprev = 0;
1927 else if (to && to->position == charpos)
1928 toprev = previous_interval (to);
1929 else
1930 toprev = to;
1932 buffer_point = (PT == ZV ? ZV - 1 : PT);
1934 /* Set FROM to the interval containing the char after PT,
1935 and FROMPREV to the interval containing the char before PT.
1936 Either one may be null. They may be equal. */
1937 /* We could cache this and save time. */
1938 from = find_interval (buffer_intervals (current_buffer), buffer_point);
1939 if (buffer_point == BEGV)
1940 fromprev = 0;
1941 else if (from && from->position == PT)
1942 fromprev = previous_interval (from);
1943 else if (buffer_point != PT)
1944 fromprev = from, from = 0;
1945 else
1946 fromprev = from;
1948 /* Moving within an interval. */
1949 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
1950 && ! have_overlays)
1952 temp_set_point_both (current_buffer, charpos, bytepos);
1953 return;
1956 original_position = charpos;
1958 /* If the new position is between two intangible characters
1959 with the same intangible property value,
1960 move forward or backward until a change in that property. */
1961 if (NILP (Vinhibit_point_motion_hooks)
1962 && ((to && toprev)
1963 || have_overlays)
1964 /* Intangibility never stops us from positioning at the beginning
1965 or end of the buffer, so don't bother checking in that case. */
1966 && charpos != BEGV && charpos != ZV)
1968 Lisp_Object pos;
1969 Lisp_Object intangible_propval;
1971 if (backwards)
1973 /* If the preceding character is both intangible and invisible,
1974 and the invisible property is `rear-sticky', perturb it so
1975 that the search starts one character earlier -- this ensures
1976 that point can never move to the end of an invisible/
1977 intangible/rear-sticky region. */
1978 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
1980 XSETINT (pos, charpos);
1982 /* If following char is intangible,
1983 skip back over all chars with matching intangible property. */
1985 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
1987 if (! NILP (intangible_propval))
1989 while (XINT (pos) > BEGV
1990 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
1991 Qintangible, Qnil),
1992 intangible_propval))
1993 pos = Fprevious_char_property_change (pos, Qnil);
1995 /* Set CHARPOS from POS, and if the final intangible character
1996 that we skipped over is also invisible, and the invisible
1997 property is `front-sticky', perturb it to be one character
1998 earlier -- this ensures that point can never move to the
1999 beginning of an invisible/intangible/front-sticky region. */
2000 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2003 else
2005 /* If the following character is both intangible and invisible,
2006 and the invisible property is `front-sticky', perturb it so
2007 that the search starts one character later -- this ensures
2008 that point can never move to the beginning of an
2009 invisible/intangible/front-sticky region. */
2010 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2012 XSETINT (pos, charpos);
2014 /* If preceding char is intangible,
2015 skip forward over all chars with matching intangible property. */
2017 intangible_propval = Fget_char_property (make_number (charpos - 1),
2018 Qintangible, Qnil);
2020 if (! NILP (intangible_propval))
2022 while (XINT (pos) < ZV
2023 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2024 intangible_propval))
2025 pos = Fnext_char_property_change (pos, Qnil);
2027 /* Set CHARPOS from POS, and if the final intangible character
2028 that we skipped over is also invisible, and the invisible
2029 property is `rear-sticky', perturb it to be one character
2030 later -- this ensures that point can never move to the
2031 end of an invisible/intangible/rear-sticky region. */
2032 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2036 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2039 if (charpos != original_position)
2041 /* Set TO to the interval containing the char after CHARPOS,
2042 and TOPREV to the interval containing the char before CHARPOS.
2043 Either one may be null. They may be equal. */
2044 to = find_interval (buffer_intervals (current_buffer), charpos);
2045 if (charpos == BEGV)
2046 toprev = 0;
2047 else if (to && to->position == charpos)
2048 toprev = previous_interval (to);
2049 else
2050 toprev = to;
2053 /* Here TO is the interval after the stopping point
2054 and TOPREV is the interval before the stopping point.
2055 One or the other may be null. */
2057 temp_set_point_both (current_buffer, charpos, bytepos);
2059 /* We run point-left and point-entered hooks here, if the
2060 two intervals are not equivalent. These hooks take
2061 (old_point, new_point) as arguments. */
2062 if (NILP (Vinhibit_point_motion_hooks)
2063 && (! intervals_equal (from, to)
2064 || ! intervals_equal (fromprev, toprev)))
2066 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2068 if (fromprev)
2069 leave_before = textget (fromprev->plist, Qpoint_left);
2070 else
2071 leave_before = Qnil;
2073 if (from)
2074 leave_after = textget (from->plist, Qpoint_left);
2075 else
2076 leave_after = Qnil;
2078 if (toprev)
2079 enter_before = textget (toprev->plist, Qpoint_entered);
2080 else
2081 enter_before = Qnil;
2083 if (to)
2084 enter_after = textget (to->plist, Qpoint_entered);
2085 else
2086 enter_after = Qnil;
2088 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2089 call2 (leave_before, make_number (old_position),
2090 make_number (charpos));
2091 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2092 call2 (leave_after, make_number (old_position),
2093 make_number (charpos));
2095 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2096 call2 (enter_before, make_number (old_position),
2097 make_number (charpos));
2098 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2099 call2 (enter_after, make_number (old_position),
2100 make_number (charpos));
2104 /* Move point to POSITION, unless POSITION is inside an intangible
2105 segment that reaches all the way to point. */
2107 void
2108 move_if_not_intangible (ptrdiff_t position)
2110 Lisp_Object pos;
2111 Lisp_Object intangible_propval;
2113 XSETINT (pos, position);
2115 if (! NILP (Vinhibit_point_motion_hooks))
2116 /* If intangible is inhibited, always move point to POSITION. */
2118 else if (PT < position && XINT (pos) < ZV)
2120 /* We want to move forward, so check the text before POSITION. */
2122 intangible_propval = Fget_char_property (pos,
2123 Qintangible, Qnil);
2125 /* If following char is intangible,
2126 skip back over all chars with matching intangible property. */
2127 if (! NILP (intangible_propval))
2128 while (XINT (pos) > BEGV
2129 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2130 Qintangible, Qnil),
2131 intangible_propval))
2132 pos = Fprevious_char_property_change (pos, Qnil);
2134 else if (XINT (pos) > BEGV)
2136 /* We want to move backward, so check the text after POSITION. */
2138 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2139 Qintangible, Qnil);
2141 /* If following char is intangible,
2142 skip forward over all chars with matching intangible property. */
2143 if (! NILP (intangible_propval))
2144 while (XINT (pos) < ZV
2145 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2146 intangible_propval))
2147 pos = Fnext_char_property_change (pos, Qnil);
2150 else if (position < BEGV)
2151 position = BEGV;
2152 else if (position > ZV)
2153 position = ZV;
2155 /* If the whole stretch between PT and POSITION isn't intangible,
2156 try moving to POSITION (which means we actually move farther
2157 if POSITION is inside of intangible text). */
2159 if (XINT (pos) != PT)
2160 SET_PT (position);
2163 /* If text at position POS has property PROP, set *VAL to the property
2164 value, *START and *END to the beginning and end of a region that
2165 has the same property, and return true. Otherwise return false.
2167 OBJECT is the string or buffer to look for the property in;
2168 nil means the current buffer. */
2170 bool
2171 get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val,
2172 ptrdiff_t *start, ptrdiff_t *end, Lisp_Object object)
2174 INTERVAL i, prev, next;
2176 if (NILP (object))
2177 i = find_interval (buffer_intervals (current_buffer), pos);
2178 else if (BUFFERP (object))
2179 i = find_interval (buffer_intervals (XBUFFER (object)), pos);
2180 else if (STRINGP (object))
2181 i = find_interval (string_intervals (object), pos);
2182 else
2183 emacs_abort ();
2185 if (!i || (i->position + LENGTH (i) <= pos))
2186 return 0;
2187 *val = textget (i->plist, prop);
2188 if (NILP (*val))
2189 return 0;
2191 next = i; /* remember it in advance */
2192 prev = previous_interval (i);
2193 while (prev
2194 && EQ (*val, textget (prev->plist, prop)))
2195 i = prev, prev = previous_interval (prev);
2196 *start = i->position;
2198 next = next_interval (i);
2199 while (next && EQ (*val, textget (next->plist, prop)))
2200 i = next, next = next_interval (next);
2201 *end = i->position + LENGTH (i);
2203 return 1;
2206 /* Return the proper local keymap TYPE for position POSITION in
2207 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2208 specified by the PROP property, if any. Otherwise, if TYPE is
2209 `local-map' use BUFFER's local map. */
2211 Lisp_Object
2212 get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type)
2214 Lisp_Object prop, lispy_position, lispy_buffer;
2215 ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte;
2217 position = clip_to_bounds (BUF_BEGV (buffer), position, BUF_ZV (buffer));
2219 /* Ignore narrowing, so that a local map continues to be valid even if
2220 the visible region contains no characters and hence no properties. */
2221 old_begv = BUF_BEGV (buffer);
2222 old_zv = BUF_ZV (buffer);
2223 old_begv_byte = BUF_BEGV_BYTE (buffer);
2224 old_zv_byte = BUF_ZV_BYTE (buffer);
2226 SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer));
2227 SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer));
2229 XSETFASTINT (lispy_position, position);
2230 XSETBUFFER (lispy_buffer, buffer);
2231 /* First check if the CHAR has any property. This is because when
2232 we click with the mouse, the mouse pointer is really pointing
2233 to the CHAR after POS. */
2234 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2235 /* If not, look at the POS's properties. This is necessary because when
2236 editing a field with a `local-map' property, we want insertion at the end
2237 to obey the `local-map' property. */
2238 if (NILP (prop))
2239 prop = Fget_pos_property (lispy_position, type, lispy_buffer);
2241 SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte);
2242 SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte);
2244 /* Use the local map only if it is valid. */
2245 prop = get_keymap (prop, 0, 0);
2246 if (CONSP (prop))
2247 return prop;
2249 if (EQ (type, Qkeymap))
2250 return Qnil;
2251 else
2252 return BVAR (buffer, keymap);
2255 /* Produce an interval tree reflecting the intervals in
2256 TREE from START to START + LENGTH.
2257 The new interval tree has no parent and has a starting-position of 0. */
2259 INTERVAL
2260 copy_intervals (INTERVAL tree, ptrdiff_t start, ptrdiff_t length)
2262 register INTERVAL i, new, t;
2263 register ptrdiff_t got, prevlen;
2265 if (!tree || length <= 0)
2266 return NULL;
2268 i = find_interval (tree, start);
2269 eassert (i && LENGTH (i) > 0);
2271 /* If there is only one interval and it's the default, return nil. */
2272 if ((start - i->position + 1 + length) < LENGTH (i)
2273 && DEFAULT_INTERVAL_P (i))
2274 return NULL;
2276 new = make_interval ();
2277 new->position = 0;
2278 got = (LENGTH (i) - (start - i->position));
2279 new->total_length = length;
2280 eassert (TOTAL_LENGTH (new) >= 0);
2281 copy_properties (i, new);
2283 t = new;
2284 prevlen = got;
2285 while (got < length)
2287 i = next_interval (i);
2288 t = split_interval_right (t, prevlen);
2289 copy_properties (i, t);
2290 prevlen = LENGTH (i);
2291 got += prevlen;
2294 return balance_an_interval (new);
2297 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2299 void
2300 copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
2301 ptrdiff_t position, ptrdiff_t length)
2303 INTERVAL interval_copy = copy_intervals (buffer_intervals (buffer),
2304 position, length);
2305 if (!interval_copy)
2306 return;
2308 set_interval_object (interval_copy, string);
2309 set_string_intervals (string, interval_copy);
2312 /* Return true if strings S1 and S2 have identical properties.
2313 Assume they have identical characters. */
2315 bool
2316 compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
2318 INTERVAL i1, i2;
2319 ptrdiff_t pos = 0;
2320 ptrdiff_t end = SCHARS (s1);
2322 i1 = find_interval (string_intervals (s1), 0);
2323 i2 = find_interval (string_intervals (s2), 0);
2325 while (pos < end)
2327 /* Determine how far we can go before we reach the end of I1 or I2. */
2328 ptrdiff_t len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2329 ptrdiff_t len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2330 ptrdiff_t distance = min (len1, len2);
2332 /* If we ever find a mismatch between the strings,
2333 they differ. */
2334 if (! intervals_equal (i1, i2))
2335 return 0;
2337 /* Advance POS till the end of the shorter interval,
2338 and advance one or both interval pointers for the new position. */
2339 pos += distance;
2340 if (len1 == distance)
2341 i1 = next_interval (i1);
2342 if (len2 == distance)
2343 i2 = next_interval (i2);
2345 return 1;
2348 /* Recursively adjust interval I in the current buffer
2349 for setting enable_multibyte_characters to MULTI_FLAG.
2350 The range of interval I is START ... END in characters,
2351 START_BYTE ... END_BYTE in bytes. */
2353 static void
2354 set_intervals_multibyte_1 (INTERVAL i, bool multi_flag,
2355 ptrdiff_t start, ptrdiff_t start_byte,
2356 ptrdiff_t end, ptrdiff_t end_byte)
2358 /* Fix the length of this interval. */
2359 if (multi_flag)
2360 i->total_length = end - start;
2361 else
2362 i->total_length = end_byte - start_byte;
2363 eassert (TOTAL_LENGTH (i) >= 0);
2365 if (TOTAL_LENGTH (i) == 0)
2367 delete_interval (i);
2368 return;
2371 /* Recursively fix the length of the subintervals. */
2372 if (i->left)
2374 ptrdiff_t left_end, left_end_byte;
2376 if (multi_flag)
2378 ptrdiff_t temp;
2379 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2380 left_end = BYTE_TO_CHAR (left_end_byte);
2382 temp = CHAR_TO_BYTE (left_end);
2384 /* If LEFT_END_BYTE is in the middle of a character,
2385 adjust it and LEFT_END to a char boundary. */
2386 if (left_end_byte > temp)
2388 left_end_byte = temp;
2390 if (left_end_byte < temp)
2392 left_end--;
2393 left_end_byte = CHAR_TO_BYTE (left_end);
2396 else
2398 left_end = start + LEFT_TOTAL_LENGTH (i);
2399 left_end_byte = CHAR_TO_BYTE (left_end);
2402 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2403 left_end, left_end_byte);
2405 if (i->right)
2407 ptrdiff_t right_start_byte, right_start;
2409 if (multi_flag)
2411 ptrdiff_t temp;
2413 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2414 right_start = BYTE_TO_CHAR (right_start_byte);
2416 /* If RIGHT_START_BYTE is in the middle of a character,
2417 adjust it and RIGHT_START to a char boundary. */
2418 temp = CHAR_TO_BYTE (right_start);
2420 if (right_start_byte < temp)
2422 right_start_byte = temp;
2424 if (right_start_byte > temp)
2426 right_start++;
2427 right_start_byte = CHAR_TO_BYTE (right_start);
2430 else
2432 right_start = end - RIGHT_TOTAL_LENGTH (i);
2433 right_start_byte = CHAR_TO_BYTE (right_start);
2436 set_intervals_multibyte_1 (i->right, multi_flag,
2437 right_start, right_start_byte,
2438 end, end_byte);
2441 /* Rounding to char boundaries can theoretically make this interval
2442 spurious. If so, delete one child, and copy its property list
2443 to this interval. */
2444 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2446 if ((i)->left)
2448 set_interval_plist (i, i->left->plist);
2449 (i)->left->total_length = 0;
2450 delete_interval ((i)->left);
2452 else
2454 set_interval_plist (i, i->right->plist);
2455 (i)->right->total_length = 0;
2456 delete_interval ((i)->right);
2461 /* Update the intervals of the current buffer
2462 to fit the contents as multibyte (if MULTI_FLAG)
2463 or to fit them as non-multibyte (if not MULTI_FLAG). */
2465 void
2466 set_intervals_multibyte (bool multi_flag)
2468 INTERVAL i = buffer_intervals (current_buffer);
2470 if (i)
2471 set_intervals_multibyte_1 (i, multi_flag, BEG, BEG_BYTE, Z, Z_BYTE);