Adjust ChangeLog as per Stefan's suggestions.
[emacs.git] / src / intervals.c
blobf9e9c864e131335bbb2ebf7701bb8cf8164dcb43
1 /* Code for doing intervals.
2 Copyright (C) 1993-1995, 1997-1998, 2001-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* NOTES:
22 Have to ensure that we can't put symbol nil on a plist, or some
23 functions may work incorrectly.
25 An idea: Have the owner of the tree keep count of splits and/or
26 insertion lengths (in intervals), and balance after every N.
28 Need to call *_left_hook when buffer is killed.
30 Scan for zero-length, or 0-length to see notes about handling
31 zero length interval-markers.
33 There are comments around about freeing intervals. It might be
34 faster to explicitly free them (put them on the free list) than
35 to GC them.
40 #include <config.h>
41 #include <setjmp.h>
42 #include <intprops.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "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 static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object);
56 static INTERVAL merge_interval_right (INTERVAL);
57 static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
58 static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
60 /* Utility functions for intervals. */
63 /* Create the root interval of some object, a buffer or string. */
65 INTERVAL
66 create_root_interval (Lisp_Object parent)
68 INTERVAL new;
70 CHECK_IMPURE (parent);
72 new = make_interval ();
74 if (BUFFERP (parent))
76 new->total_length = (BUF_Z (XBUFFER (parent))
77 - BUF_BEG (XBUFFER (parent)));
78 CHECK_TOTAL_LENGTH (new);
79 BUF_INTERVALS (XBUFFER (parent)) = new;
80 new->position = BEG;
82 else if (STRINGP (parent))
84 new->total_length = SCHARS (parent);
85 CHECK_TOTAL_LENGTH (new);
86 STRING_SET_INTERVALS (parent, new);
87 new->position = 0;
90 SET_INTERVAL_OBJECT (new, parent);
92 return new;
95 /* Make the interval TARGET have exactly the properties of SOURCE */
97 void
98 copy_properties (register INTERVAL source, register INTERVAL target)
100 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
101 return;
103 COPY_INTERVAL_CACHE (source, target);
104 target->plist = Fcopy_sequence (source->plist);
107 /* Merge the properties of interval SOURCE into the properties
108 of interval TARGET. That is to say, each property in SOURCE
109 is added to TARGET if TARGET has no such property as yet. */
111 static void
112 merge_properties (register INTERVAL source, register INTERVAL target)
114 register Lisp_Object o, sym, val;
116 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
117 return;
119 MERGE_INTERVAL_CACHE (source, target);
121 o = source->plist;
122 while (CONSP (o))
124 sym = XCAR (o);
125 o = XCDR (o);
126 CHECK_CONS (o);
128 val = target->plist;
129 while (CONSP (val) && !EQ (XCAR (val), sym))
131 val = XCDR (val);
132 if (!CONSP (val))
133 break;
134 val = XCDR (val);
137 if (NILP (val))
139 val = XCAR (o);
140 target->plist = Fcons (sym, Fcons (val, target->plist));
142 o = XCDR (o);
146 /* Return 1 if the two intervals have the same properties,
147 0 otherwise. */
150 intervals_equal (INTERVAL i0, INTERVAL i1)
152 register Lisp_Object i0_cdr, i0_sym;
153 register Lisp_Object i1_cdr, i1_val;
155 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
156 return 1;
158 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
159 return 0;
161 i0_cdr = i0->plist;
162 i1_cdr = i1->plist;
163 while (CONSP (i0_cdr) && CONSP (i1_cdr))
165 i0_sym = XCAR (i0_cdr);
166 i0_cdr = XCDR (i0_cdr);
167 if (!CONSP (i0_cdr))
168 return 0; /* abort (); */
169 i1_val = i1->plist;
170 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
172 i1_val = XCDR (i1_val);
173 if (!CONSP (i1_val))
174 return 0; /* abort (); */
175 i1_val = XCDR (i1_val);
178 /* i0 has something i1 doesn't. */
179 if (EQ (i1_val, Qnil))
180 return 0;
182 /* i0 and i1 both have sym, but it has different values in each. */
183 if (!CONSP (i1_val)
184 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
185 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
186 return 0;
188 i0_cdr = XCDR (i0_cdr);
190 i1_cdr = XCDR (i1_cdr);
191 if (!CONSP (i1_cdr))
192 return 0; /* abort (); */
193 i1_cdr = XCDR (i1_cdr);
196 /* Lengths of the two plists were equal. */
197 return (NILP (i0_cdr) && NILP (i1_cdr));
201 /* Traverse an interval tree TREE, performing FUNCTION on each node.
202 No guarantee is made about the order of traversal.
203 Pass FUNCTION two args: an interval, and ARG. */
205 void
206 traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
208 /* Minimize stack usage. */
209 while (!NULL_INTERVAL_P (tree))
211 (*function) (tree, arg);
212 if (NULL_INTERVAL_P (tree->right))
213 tree = tree->left;
214 else
216 traverse_intervals_noorder (tree->left, function, arg);
217 tree = tree->right;
222 /* Traverse an interval tree TREE, performing FUNCTION on each node.
223 Pass FUNCTION two args: an interval, and ARG. */
225 void
226 traverse_intervals (INTERVAL tree, EMACS_INT position,
227 void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
229 while (!NULL_INTERVAL_P (tree))
231 traverse_intervals (tree->left, position, function, arg);
232 position += LEFT_TOTAL_LENGTH (tree);
233 tree->position = position;
234 (*function) (tree, arg);
235 position += LENGTH (tree); tree = tree->right;
239 #if 0
241 static int icount;
242 static int idepth;
243 static int zero_length;
245 /* These functions are temporary, for debugging purposes only. */
247 INTERVAL search_interval, found_interval;
249 void
250 check_for_interval (i)
251 register INTERVAL i;
253 if (i == search_interval)
255 found_interval = i;
256 icount++;
260 INTERVAL
261 search_for_interval (i, tree)
262 register INTERVAL i, tree;
264 icount = 0;
265 search_interval = i;
266 found_interval = NULL_INTERVAL;
267 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
268 return found_interval;
271 static void
272 inc_interval_count (i)
273 INTERVAL i;
275 icount++;
276 if (LENGTH (i) == 0)
277 zero_length++;
278 if (depth > idepth)
279 idepth = depth;
283 count_intervals (i)
284 register INTERVAL i;
286 icount = 0;
287 idepth = 0;
288 zero_length = 0;
289 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
291 return icount;
294 static INTERVAL
295 root_interval (interval)
296 INTERVAL interval;
298 register INTERVAL i = interval;
300 while (! ROOT_INTERVAL_P (i))
301 i = INTERVAL_PARENT (i);
303 return i;
305 #endif
307 /* Assuming that a left child exists, perform the following operation:
310 / \ / \
311 B => A
312 / \ / \
316 static inline INTERVAL
317 rotate_right (INTERVAL interval)
319 INTERVAL i;
320 INTERVAL B = interval->left;
321 EMACS_INT old_total = interval->total_length;
323 /* Deal with any Parent of A; make it point to B. */
324 if (! ROOT_INTERVAL_P (interval))
326 if (AM_LEFT_CHILD (interval))
327 INTERVAL_PARENT (interval)->left = B;
328 else
329 INTERVAL_PARENT (interval)->right = B;
331 COPY_INTERVAL_PARENT (B, interval);
333 /* Make B the parent of A */
334 i = B->right;
335 B->right = interval;
336 SET_INTERVAL_PARENT (interval, B);
338 /* Make A point to c */
339 interval->left = i;
340 if (! NULL_INTERVAL_P (i))
341 SET_INTERVAL_PARENT (i, interval);
343 /* A's total length is decreased by the length of B and its left child. */
344 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
345 CHECK_TOTAL_LENGTH (interval);
347 /* B must have the same total length of A. */
348 B->total_length = old_total;
349 CHECK_TOTAL_LENGTH (B);
351 return B;
354 /* Assuming that a right child exists, perform the following operation:
357 / \ / \
358 B => A
359 / \ / \
363 static inline INTERVAL
364 rotate_left (INTERVAL interval)
366 INTERVAL i;
367 INTERVAL B = interval->right;
368 EMACS_INT old_total = interval->total_length;
370 /* Deal with any parent of A; make it point to B. */
371 if (! ROOT_INTERVAL_P (interval))
373 if (AM_LEFT_CHILD (interval))
374 INTERVAL_PARENT (interval)->left = B;
375 else
376 INTERVAL_PARENT (interval)->right = B;
378 COPY_INTERVAL_PARENT (B, interval);
380 /* Make B the parent of A */
381 i = B->left;
382 B->left = interval;
383 SET_INTERVAL_PARENT (interval, B);
385 /* Make A point to c */
386 interval->right = i;
387 if (! NULL_INTERVAL_P (i))
388 SET_INTERVAL_PARENT (i, interval);
390 /* A's total length is decreased by the length of B and its right child. */
391 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
392 CHECK_TOTAL_LENGTH (interval);
394 /* B must have the same total length of A. */
395 B->total_length = old_total;
396 CHECK_TOTAL_LENGTH (B);
398 return B;
401 /* Balance an interval tree with the assumption that the subtrees
402 themselves are already balanced. */
404 static INTERVAL
405 balance_an_interval (INTERVAL i)
407 register EMACS_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 (eabs (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 (eabs (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 (register INTERVAL interval)
444 Lisp_Object parent;
445 int have_parent = 0;
447 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
448 return interval;
450 if (INTERVAL_HAS_OBJECT (interval))
452 have_parent = 1;
453 GET_INTERVAL_OBJECT (parent, interval);
455 interval = balance_an_interval (interval);
457 if (have_parent)
459 if (BUFFERP (parent))
460 BUF_INTERVALS (XBUFFER (parent)) = interval;
461 else if (STRINGP (parent))
462 STRING_SET_INTERVALS (parent, interval);
465 return interval;
468 /* Balance the interval tree TREE. Balancing is by weight
469 (the amount of text). */
471 static INTERVAL
472 balance_intervals_internal (register INTERVAL tree)
474 /* Balance within each side. */
475 if (tree->left)
476 balance_intervals_internal (tree->left);
477 if (tree->right)
478 balance_intervals_internal (tree->right);
479 return balance_an_interval (tree);
482 /* Advertised interface to balance intervals. */
484 INTERVAL
485 balance_intervals (INTERVAL tree)
487 if (tree == NULL_INTERVAL)
488 return NULL_INTERVAL;
490 return balance_intervals_internal (tree);
493 /* Split INTERVAL into two pieces, starting the second piece at
494 character position OFFSET (counting from 0), relative to INTERVAL.
495 INTERVAL becomes the left-hand piece, and the right-hand piece
496 (second, lexicographically) is returned.
498 The size and position fields of the two intervals are set based upon
499 those of the original interval. The property list of the new interval
500 is reset, thus it is up to the caller to do the right thing with the
501 result.
503 Note that this does not change the position of INTERVAL; if it is a root,
504 it is still a root after this operation. */
506 INTERVAL
507 split_interval_right (INTERVAL interval, EMACS_INT offset)
509 INTERVAL new = make_interval ();
510 EMACS_INT position = interval->position;
511 EMACS_INT new_length = LENGTH (interval) - offset;
513 new->position = position + offset;
514 SET_INTERVAL_PARENT (new, interval);
516 if (NULL_RIGHT_CHILD (interval))
518 interval->right = new;
519 new->total_length = new_length;
520 CHECK_TOTAL_LENGTH (new);
522 else
524 /* Insert the new node between INTERVAL and its right child. */
525 new->right = interval->right;
526 SET_INTERVAL_PARENT (interval->right, new);
527 interval->right = new;
528 new->total_length = new_length + new->right->total_length;
529 CHECK_TOTAL_LENGTH (new);
530 balance_an_interval (new);
533 balance_possible_root_interval (interval);
535 return new;
538 /* Split INTERVAL into two pieces, starting the second piece at
539 character position OFFSET (counting from 0), relative to INTERVAL.
540 INTERVAL becomes the right-hand piece, and the left-hand piece
541 (first, lexicographically) is returned.
543 The size and position fields of the two intervals are set based upon
544 those of the original interval. The property list of the new interval
545 is reset, thus it is up to the caller to do the right thing with the
546 result.
548 Note that this does not change the position of INTERVAL; if it is a root,
549 it is still a root after this operation. */
551 INTERVAL
552 split_interval_left (INTERVAL interval, EMACS_INT offset)
554 INTERVAL new = make_interval ();
555 EMACS_INT new_length = offset;
557 new->position = interval->position;
558 interval->position = interval->position + offset;
559 SET_INTERVAL_PARENT (new, interval);
561 if (NULL_LEFT_CHILD (interval))
563 interval->left = new;
564 new->total_length = new_length;
565 CHECK_TOTAL_LENGTH (new);
567 else
569 /* Insert the new node between INTERVAL and its left child. */
570 new->left = interval->left;
571 SET_INTERVAL_PARENT (new->left, new);
572 interval->left = new;
573 new->total_length = new_length + new->left->total_length;
574 CHECK_TOTAL_LENGTH (new);
575 balance_an_interval (new);
578 balance_possible_root_interval (interval);
580 return new;
583 /* Return the proper position for the first character
584 described by the interval tree SOURCE.
585 This is 1 if the parent is a buffer,
586 0 if the parent is a string or if there is no parent.
588 Don't use this function on an interval which is the child
589 of another interval! */
591 static int
592 interval_start_pos (INTERVAL source)
594 Lisp_Object parent;
596 if (NULL_INTERVAL_P (source))
597 return 0;
599 if (! INTERVAL_HAS_OBJECT (source))
600 return 0;
601 GET_INTERVAL_OBJECT (parent, source);
602 if (BUFFERP (parent))
603 return BUF_BEG (XBUFFER (parent));
604 return 0;
607 /* Find the interval containing text position POSITION in the text
608 represented by the interval tree TREE. POSITION is a buffer
609 position (starting from 1) or a string index (starting from 0).
610 If POSITION is at the end of the buffer or string,
611 return the interval containing the last character.
613 The `position' field, which is a cache of an interval's position,
614 is updated in the interval found. Other functions (e.g., next_interval)
615 will update this cache based on the result of find_interval. */
617 INTERVAL
618 find_interval (register INTERVAL tree, register EMACS_INT position)
620 /* The distance from the left edge of the subtree at TREE
621 to POSITION. */
622 register EMACS_INT relative_position;
624 if (NULL_INTERVAL_P (tree))
625 return NULL_INTERVAL;
627 relative_position = position;
628 if (INTERVAL_HAS_OBJECT (tree))
630 Lisp_Object parent;
631 GET_INTERVAL_OBJECT (parent, tree);
632 if (BUFFERP (parent))
633 relative_position -= BUF_BEG (XBUFFER (parent));
636 if (relative_position > TOTAL_LENGTH (tree))
637 abort (); /* Paranoia */
639 if (!handling_signal)
640 tree = balance_possible_root_interval (tree);
642 while (1)
644 if (relative_position < LEFT_TOTAL_LENGTH (tree))
646 tree = tree->left;
648 else if (! NULL_RIGHT_CHILD (tree)
649 && relative_position >= (TOTAL_LENGTH (tree)
650 - RIGHT_TOTAL_LENGTH (tree)))
652 relative_position -= (TOTAL_LENGTH (tree)
653 - RIGHT_TOTAL_LENGTH (tree));
654 tree = tree->right;
656 else
658 tree->position
659 = (position - relative_position /* left edge of *tree. */
660 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
662 return tree;
667 /* Find the succeeding interval (lexicographically) to INTERVAL.
668 Sets the `position' field based on that of INTERVAL (see
669 find_interval). */
671 INTERVAL
672 next_interval (register INTERVAL interval)
674 register INTERVAL i = interval;
675 register EMACS_INT next_position;
677 if (NULL_INTERVAL_P (i))
678 return NULL_INTERVAL;
679 next_position = interval->position + LENGTH (interval);
681 if (! NULL_RIGHT_CHILD (i))
683 i = i->right;
684 while (! NULL_LEFT_CHILD (i))
685 i = i->left;
687 i->position = next_position;
688 return i;
691 while (! NULL_PARENT (i))
693 if (AM_LEFT_CHILD (i))
695 i = INTERVAL_PARENT (i);
696 i->position = next_position;
697 return i;
700 i = INTERVAL_PARENT (i);
703 return NULL_INTERVAL;
706 /* Find the preceding interval (lexicographically) to INTERVAL.
707 Sets the `position' field based on that of INTERVAL (see
708 find_interval). */
710 INTERVAL
711 previous_interval (register INTERVAL interval)
713 register INTERVAL i;
715 if (NULL_INTERVAL_P (interval))
716 return NULL_INTERVAL;
718 if (! NULL_LEFT_CHILD (interval))
720 i = interval->left;
721 while (! NULL_RIGHT_CHILD (i))
722 i = i->right;
724 i->position = interval->position - LENGTH (i);
725 return i;
728 i = interval;
729 while (! NULL_PARENT (i))
731 if (AM_RIGHT_CHILD (i))
733 i = INTERVAL_PARENT (i);
735 i->position = interval->position - LENGTH (i);
736 return i;
738 i = INTERVAL_PARENT (i);
741 return NULL_INTERVAL;
744 /* Find the interval containing POS given some non-NULL INTERVAL
745 in the same tree. Note that we need to update interval->position
746 if we go down the tree.
747 To speed up the process, we assume that the ->position of
748 I and all its parents is already uptodate. */
749 INTERVAL
750 update_interval (register INTERVAL i, EMACS_INT pos)
752 if (NULL_INTERVAL_P (i))
753 return NULL_INTERVAL;
755 while (1)
757 if (pos < i->position)
759 /* Move left. */
760 if (pos >= i->position - TOTAL_LENGTH (i->left))
762 i->left->position = i->position - TOTAL_LENGTH (i->left)
763 + LEFT_TOTAL_LENGTH (i->left);
764 i = i->left; /* Move to the left child */
766 else if (NULL_PARENT (i))
767 error ("Point before start of properties");
768 else
769 i = INTERVAL_PARENT (i);
770 continue;
772 else if (pos >= INTERVAL_LAST_POS (i))
774 /* Move right. */
775 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
777 i->right->position = INTERVAL_LAST_POS (i)
778 + LEFT_TOTAL_LENGTH (i->right);
779 i = i->right; /* Move to the right child */
781 else if (NULL_PARENT (i))
782 error ("Point %"pI"d after end of properties", pos);
783 else
784 i = INTERVAL_PARENT (i);
785 continue;
787 else
788 return i;
793 #if 0
794 /* Traverse a path down the interval tree TREE to the interval
795 containing POSITION, adjusting all nodes on the path for
796 an addition of LENGTH characters. Insertion between two intervals
797 (i.e., point == i->position, where i is second interval) means
798 text goes into second interval.
800 Modifications are needed to handle the hungry bits -- after simply
801 finding the interval at position (don't add length going down),
802 if it's the beginning of the interval, get the previous interval
803 and check the hungry bits of both. Then add the length going back up
804 to the root. */
806 static INTERVAL
807 adjust_intervals_for_insertion (tree, position, length)
808 INTERVAL tree;
809 EMACS_INT position, length;
811 register EMACS_INT relative_position;
812 register INTERVAL this;
814 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
815 abort ();
817 /* If inserting at point-max of a buffer, that position
818 will be out of range */
819 if (position > TOTAL_LENGTH (tree))
820 position = TOTAL_LENGTH (tree);
821 relative_position = position;
822 this = tree;
824 while (1)
826 if (relative_position <= LEFT_TOTAL_LENGTH (this))
828 this->total_length += length;
829 CHECK_TOTAL_LENGTH (this);
830 this = this->left;
832 else if (relative_position > (TOTAL_LENGTH (this)
833 - RIGHT_TOTAL_LENGTH (this)))
835 relative_position -= (TOTAL_LENGTH (this)
836 - RIGHT_TOTAL_LENGTH (this));
837 this->total_length += length;
838 CHECK_TOTAL_LENGTH (this);
839 this = this->right;
841 else
843 /* If we are to use zero-length intervals as buffer pointers,
844 then this code will have to change. */
845 this->total_length += length;
846 CHECK_TOTAL_LENGTH (this);
847 this->position = LEFT_TOTAL_LENGTH (this)
848 + position - relative_position + 1;
849 return tree;
853 #endif
855 /* Effect an adjustment corresponding to the addition of LENGTH characters
856 of text. Do this by finding the interval containing POSITION in the
857 interval tree TREE, and then adjusting all of its ancestors by adding
858 LENGTH to them.
860 If POSITION is the first character of an interval, meaning that point
861 is actually between the two intervals, make the new text belong to
862 the interval which is "sticky".
864 If both intervals are "sticky", then make them belong to the left-most
865 interval. Another possibility would be to create a new interval for
866 this text, and make it have the merged properties of both ends. */
868 static INTERVAL
869 adjust_intervals_for_insertion (INTERVAL tree,
870 EMACS_INT position, EMACS_INT length)
872 register INTERVAL i;
873 register INTERVAL temp;
874 int eobp = 0;
875 Lisp_Object parent;
876 EMACS_INT offset;
878 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
879 abort ();
881 GET_INTERVAL_OBJECT (parent, tree);
882 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
884 /* If inserting at point-max of a buffer, that position will be out
885 of range. Remember that buffer positions are 1-based. */
886 if (position >= TOTAL_LENGTH (tree) + offset)
888 position = TOTAL_LENGTH (tree) + offset;
889 eobp = 1;
892 i = find_interval (tree, position);
894 /* If in middle of an interval which is not sticky either way,
895 we must not just give its properties to the insertion.
896 So split this interval at the insertion point.
898 Originally, the if condition here was this:
899 (! (position == i->position || eobp)
900 && END_NONSTICKY_P (i)
901 && FRONT_NONSTICKY_P (i))
902 But, these macros are now unreliable because of introduction of
903 Vtext_property_default_nonsticky. So, we always check properties
904 one by one if POSITION is in middle of an interval. */
905 if (! (position == i->position || eobp))
907 Lisp_Object tail;
908 Lisp_Object front, rear;
910 tail = i->plist;
912 /* Properties font-sticky and rear-nonsticky override
913 Vtext_property_default_nonsticky. So, if they are t, we can
914 skip one by one checking of properties. */
915 rear = textget (i->plist, Qrear_nonsticky);
916 if (! CONSP (rear) && ! NILP (rear))
918 /* All properties are nonsticky. We split the interval. */
919 goto check_done;
921 front = textget (i->plist, Qfront_sticky);
922 if (! CONSP (front) && ! NILP (front))
924 /* All properties are sticky. We don't split the interval. */
925 tail = Qnil;
926 goto check_done;
929 /* Does any actual property pose an actual problem? We break
930 the loop if we find a nonsticky property. */
931 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
933 Lisp_Object prop, tmp;
934 prop = XCAR (tail);
936 /* Is this particular property front-sticky? */
937 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
938 continue;
940 /* Is this particular property rear-nonsticky? */
941 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
942 break;
944 /* Is this particular property recorded as sticky or
945 nonsticky in Vtext_property_default_nonsticky? */
946 tmp = Fassq (prop, Vtext_property_default_nonsticky);
947 if (CONSP (tmp))
949 if (NILP (tmp))
950 continue;
951 break;
954 /* By default, a text property is rear-sticky, thus we
955 continue the loop. */
958 check_done:
959 /* If any property is a real problem, split the interval. */
960 if (! NILP (tail))
962 temp = split_interval_right (i, position - i->position);
963 copy_properties (i, temp);
964 i = temp;
968 /* If we are positioned between intervals, check the stickiness of
969 both of them. We have to do this too, if we are at BEG or Z. */
970 if (position == i->position || eobp)
972 register INTERVAL prev;
974 if (position == BEG)
975 prev = 0;
976 else if (eobp)
978 prev = i;
979 i = 0;
981 else
982 prev = previous_interval (i);
984 /* Even if we are positioned between intervals, we default
985 to the left one if it exists. We extend it now and split
986 off a part later, if stickiness demands it. */
987 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
989 temp->total_length += length;
990 CHECK_TOTAL_LENGTH (temp);
991 temp = balance_possible_root_interval (temp);
994 /* If at least one interval has sticky properties,
995 we check the stickiness property by property.
997 Originally, the if condition here was this:
998 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
999 But, these macros are now unreliable because of introduction
1000 of Vtext_property_default_nonsticky. So, we always have to
1001 check stickiness of properties one by one. If cache of
1002 stickiness is implemented in the future, we may be able to
1003 use those macros again. */
1004 if (1)
1006 Lisp_Object pleft, pright;
1007 struct interval newi;
1009 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1010 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1011 newi.plist = merge_properties_sticky (pleft, pright);
1013 if (! prev) /* i.e. position == BEG */
1015 if (! intervals_equal (i, &newi))
1017 i = split_interval_left (i, length);
1018 i->plist = newi.plist;
1021 else if (! intervals_equal (prev, &newi))
1023 prev = split_interval_right (prev,
1024 position - prev->position);
1025 prev->plist = newi.plist;
1026 if (! NULL_INTERVAL_P (i)
1027 && intervals_equal (prev, i))
1028 merge_interval_right (prev);
1031 /* We will need to update the cache here later. */
1033 else if (! prev && ! NILP (i->plist))
1035 /* Just split off a new interval at the left.
1036 Since I wasn't front-sticky, the empty plist is ok. */
1037 i = split_interval_left (i, length);
1041 /* Otherwise just extend the interval. */
1042 else
1044 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1046 temp->total_length += length;
1047 CHECK_TOTAL_LENGTH (temp);
1048 temp = balance_possible_root_interval (temp);
1052 return tree;
1055 /* Any property might be front-sticky on the left, rear-sticky on the left,
1056 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1057 can be arranged in a matrix with rows denoting the left conditions and
1058 columns denoting the right conditions:
1059 _ __ _
1060 _ FR FR FR FR
1061 FR__ 0 1 2 3
1062 _FR 4 5 6 7
1063 FR 8 9 A B
1064 FR C D E F
1066 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1067 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1068 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1069 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1070 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1071 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1072 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1073 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1075 We inherit from whoever has a sticky side facing us. If both sides
1076 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1077 non-nil value for the current property. If both sides do, then we take
1078 from the left.
1080 When we inherit a property, we get its stickiness as well as its value.
1081 So, when we merge the above two lists, we expect to get this:
1083 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1084 rear-nonsticky (p6 pa)
1085 p0 L p1 L p2 L p3 L p6 R p7 R
1086 pa R pb R pc L pd L pe L pf L)
1088 The optimizable special cases are:
1089 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1090 left rear-nonsticky = t, right front-sticky = t (inherit right)
1091 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1094 static Lisp_Object
1095 merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
1097 register Lisp_Object props, front, rear;
1098 Lisp_Object lfront, lrear, rfront, rrear;
1099 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1100 int use_left, use_right;
1101 int lpresent;
1103 props = Qnil;
1104 front = Qnil;
1105 rear = Qnil;
1106 lfront = textget (pleft, Qfront_sticky);
1107 lrear = textget (pleft, Qrear_nonsticky);
1108 rfront = textget (pright, Qfront_sticky);
1109 rrear = textget (pright, Qrear_nonsticky);
1111 /* Go through each element of PRIGHT. */
1112 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1114 Lisp_Object tmp;
1116 sym = XCAR (tail1);
1118 /* Sticky properties get special treatment. */
1119 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1120 continue;
1122 rval = Fcar (XCDR (tail1));
1123 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1124 if (EQ (sym, XCAR (tail2)))
1125 break;
1127 /* Indicate whether the property is explicitly defined on the left.
1128 (We know it is defined explicitly on the right
1129 because otherwise we don't get here.) */
1130 lpresent = ! NILP (tail2);
1131 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1133 /* Even if lrear or rfront say nothing about the stickiness of
1134 SYM, Vtext_property_default_nonsticky may give default
1135 stickiness to SYM. */
1136 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1137 use_left = (lpresent
1138 && ! (TMEM (sym, lrear)
1139 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1140 use_right = (TMEM (sym, rfront)
1141 || (CONSP (tmp) && NILP (XCDR (tmp))));
1142 if (use_left && use_right)
1144 if (NILP (lval))
1145 use_left = 0;
1146 else if (NILP (rval))
1147 use_right = 0;
1149 if (use_left)
1151 /* We build props as (value sym ...) rather than (sym value ...)
1152 because we plan to nreverse it when we're done. */
1153 props = Fcons (lval, Fcons (sym, props));
1154 if (TMEM (sym, lfront))
1155 front = Fcons (sym, front);
1156 if (TMEM (sym, lrear))
1157 rear = Fcons (sym, rear);
1159 else if (use_right)
1161 props = Fcons (rval, Fcons (sym, props));
1162 if (TMEM (sym, rfront))
1163 front = Fcons (sym, front);
1164 if (TMEM (sym, rrear))
1165 rear = Fcons (sym, rear);
1169 /* Now go through each element of PLEFT. */
1170 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1172 Lisp_Object tmp;
1174 sym = XCAR (tail2);
1176 /* Sticky properties get special treatment. */
1177 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1178 continue;
1180 /* If sym is in PRIGHT, we've already considered it. */
1181 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1182 if (EQ (sym, XCAR (tail1)))
1183 break;
1184 if (! NILP (tail1))
1185 continue;
1187 lval = Fcar (XCDR (tail2));
1189 /* Even if lrear or rfront say nothing about the stickiness of
1190 SYM, Vtext_property_default_nonsticky may give default
1191 stickiness to SYM. */
1192 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1194 /* Since rval is known to be nil in this loop, the test simplifies. */
1195 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1197 props = Fcons (lval, Fcons (sym, props));
1198 if (TMEM (sym, lfront))
1199 front = Fcons (sym, front);
1201 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1203 /* The value is nil, but we still inherit the stickiness
1204 from the right. */
1205 front = Fcons (sym, front);
1206 if (TMEM (sym, rrear))
1207 rear = Fcons (sym, rear);
1210 props = Fnreverse (props);
1211 if (! NILP (rear))
1212 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1214 cat = textget (props, Qcategory);
1215 if (! NILP (front)
1217 /* If we have inherited a front-stick category property that is t,
1218 we don't need to set up a detailed one. */
1219 ! (! NILP (cat) && SYMBOLP (cat)
1220 && EQ (Fget (cat, Qfront_sticky), Qt)))
1221 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1222 return props;
1226 /* Delete a node I from its interval tree by merging its subtrees
1227 into one subtree which is then returned. Caller is responsible for
1228 storing the resulting subtree into its parent. */
1230 static INTERVAL
1231 delete_node (register INTERVAL i)
1233 register INTERVAL migrate, this;
1234 register EMACS_INT migrate_amt;
1236 if (NULL_INTERVAL_P (i->left))
1237 return i->right;
1238 if (NULL_INTERVAL_P (i->right))
1239 return i->left;
1241 migrate = i->left;
1242 migrate_amt = i->left->total_length;
1243 this = i->right;
1244 this->total_length += migrate_amt;
1245 while (! NULL_INTERVAL_P (this->left))
1247 this = this->left;
1248 this->total_length += migrate_amt;
1250 CHECK_TOTAL_LENGTH (this);
1251 this->left = migrate;
1252 SET_INTERVAL_PARENT (migrate, this);
1254 return i->right;
1257 /* Delete interval I from its tree by calling `delete_node'
1258 and properly connecting the resultant subtree.
1260 I is presumed to be empty; that is, no adjustments are made
1261 for the length of I. */
1263 static void
1264 delete_interval (register INTERVAL i)
1266 register INTERVAL parent;
1267 EMACS_INT amt = LENGTH (i);
1269 if (amt > 0) /* Only used on zero-length intervals now. */
1270 abort ();
1272 if (ROOT_INTERVAL_P (i))
1274 Lisp_Object owner;
1275 GET_INTERVAL_OBJECT (owner, i);
1276 parent = delete_node (i);
1277 if (! NULL_INTERVAL_P (parent))
1278 SET_INTERVAL_OBJECT (parent, owner);
1280 if (BUFFERP (owner))
1281 BUF_INTERVALS (XBUFFER (owner)) = parent;
1282 else if (STRINGP (owner))
1283 STRING_SET_INTERVALS (owner, parent);
1284 else
1285 abort ();
1287 return;
1290 parent = INTERVAL_PARENT (i);
1291 if (AM_LEFT_CHILD (i))
1293 parent->left = delete_node (i);
1294 if (! NULL_INTERVAL_P (parent->left))
1295 SET_INTERVAL_PARENT (parent->left, parent);
1297 else
1299 parent->right = delete_node (i);
1300 if (! NULL_INTERVAL_P (parent->right))
1301 SET_INTERVAL_PARENT (parent->right, parent);
1305 /* Find the interval in TREE corresponding to the relative position
1306 FROM and delete as much as possible of AMOUNT from that interval.
1307 Return the amount actually deleted, and if the interval was
1308 zeroed-out, delete that interval node from the tree.
1310 Note that FROM is actually origin zero, aka relative to the
1311 leftmost edge of tree. This is appropriate since we call ourselves
1312 recursively on subtrees.
1314 Do this by recursing down TREE to the interval in question, and
1315 deleting the appropriate amount of text. */
1317 static EMACS_INT
1318 interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
1319 register EMACS_INT amount)
1321 register EMACS_INT relative_position = from;
1323 if (NULL_INTERVAL_P (tree))
1324 return 0;
1326 /* Left branch */
1327 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1329 EMACS_INT subtract = interval_deletion_adjustment (tree->left,
1330 relative_position,
1331 amount);
1332 tree->total_length -= subtract;
1333 CHECK_TOTAL_LENGTH (tree);
1334 return subtract;
1336 /* Right branch */
1337 else if (relative_position >= (TOTAL_LENGTH (tree)
1338 - RIGHT_TOTAL_LENGTH (tree)))
1340 EMACS_INT subtract;
1342 relative_position -= (tree->total_length
1343 - RIGHT_TOTAL_LENGTH (tree));
1344 subtract = interval_deletion_adjustment (tree->right,
1345 relative_position,
1346 amount);
1347 tree->total_length -= subtract;
1348 CHECK_TOTAL_LENGTH (tree);
1349 return subtract;
1351 /* Here -- this node. */
1352 else
1354 /* How much can we delete from this interval? */
1355 EMACS_INT my_amount = ((tree->total_length
1356 - RIGHT_TOTAL_LENGTH (tree))
1357 - relative_position);
1359 if (amount > my_amount)
1360 amount = my_amount;
1362 tree->total_length -= amount;
1363 CHECK_TOTAL_LENGTH (tree);
1364 if (LENGTH (tree) == 0)
1365 delete_interval (tree);
1367 return amount;
1370 /* Never reach here. */
1373 /* Effect the adjustments necessary to the interval tree of BUFFER to
1374 correspond to the deletion of LENGTH characters from that buffer
1375 text. The deletion is effected at position START (which is a
1376 buffer position, i.e. origin 1). */
1378 static void
1379 adjust_intervals_for_deletion (struct buffer *buffer,
1380 EMACS_INT start, EMACS_INT length)
1382 register EMACS_INT left_to_delete = length;
1383 register INTERVAL tree = BUF_INTERVALS (buffer);
1384 Lisp_Object parent;
1385 EMACS_INT offset;
1387 GET_INTERVAL_OBJECT (parent, tree);
1388 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1390 if (NULL_INTERVAL_P (tree))
1391 return;
1393 if (start > offset + TOTAL_LENGTH (tree)
1394 || start + length > offset + TOTAL_LENGTH (tree))
1395 abort ();
1397 if (length == TOTAL_LENGTH (tree))
1399 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1400 return;
1403 if (ONLY_INTERVAL_P (tree))
1405 tree->total_length -= length;
1406 CHECK_TOTAL_LENGTH (tree);
1407 return;
1410 if (start > offset + TOTAL_LENGTH (tree))
1411 start = offset + TOTAL_LENGTH (tree);
1412 while (left_to_delete > 0)
1414 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1415 left_to_delete);
1416 tree = BUF_INTERVALS (buffer);
1417 if (left_to_delete == tree->total_length)
1419 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1420 return;
1425 /* Make the adjustments necessary to the interval tree of BUFFER to
1426 represent an addition or deletion of LENGTH characters starting
1427 at position START. Addition or deletion is indicated by the sign
1428 of LENGTH. */
1430 inline void
1431 offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
1433 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1434 return;
1436 if (length > 0)
1437 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1438 else
1440 IF_LINT (if (length < - TYPE_MAXIMUM (EMACS_INT)) abort ();)
1441 adjust_intervals_for_deletion (buffer, start, -length);
1445 /* Merge interval I with its lexicographic successor. The resulting
1446 interval is returned, and has the properties of the original
1447 successor. The properties of I are lost. I is removed from the
1448 interval tree.
1450 IMPORTANT:
1451 The caller must verify that this is not the last (rightmost)
1452 interval. */
1454 static INTERVAL
1455 merge_interval_right (register INTERVAL i)
1457 register EMACS_INT absorb = LENGTH (i);
1458 register INTERVAL successor;
1460 /* Zero out this interval. */
1461 i->total_length -= absorb;
1462 CHECK_TOTAL_LENGTH (i);
1464 /* Find the succeeding interval. */
1465 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1466 as we descend. */
1468 successor = i->right;
1469 while (! NULL_LEFT_CHILD (successor))
1471 successor->total_length += absorb;
1472 CHECK_TOTAL_LENGTH (successor);
1473 successor = successor->left;
1476 successor->total_length += absorb;
1477 CHECK_TOTAL_LENGTH (successor);
1478 delete_interval (i);
1479 return successor;
1482 successor = i;
1483 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1484 we ascend. */
1486 if (AM_LEFT_CHILD (successor))
1488 successor = INTERVAL_PARENT (successor);
1489 delete_interval (i);
1490 return successor;
1493 successor = INTERVAL_PARENT (successor);
1494 successor->total_length -= absorb;
1495 CHECK_TOTAL_LENGTH (successor);
1498 /* This must be the rightmost or last interval and cannot
1499 be merged right. The caller should have known. */
1500 abort ();
1503 /* Merge interval I with its lexicographic predecessor. The resulting
1504 interval is returned, and has the properties of the original predecessor.
1505 The properties of I are lost. Interval node I is removed from the tree.
1507 IMPORTANT:
1508 The caller must verify that this is not the first (leftmost) interval. */
1510 INTERVAL
1511 merge_interval_left (register INTERVAL i)
1513 register EMACS_INT absorb = LENGTH (i);
1514 register INTERVAL predecessor;
1516 /* Zero out this interval. */
1517 i->total_length -= absorb;
1518 CHECK_TOTAL_LENGTH (i);
1520 /* Find the preceding interval. */
1521 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1522 adding ABSORB as we go. */
1524 predecessor = i->left;
1525 while (! NULL_RIGHT_CHILD (predecessor))
1527 predecessor->total_length += absorb;
1528 CHECK_TOTAL_LENGTH (predecessor);
1529 predecessor = predecessor->right;
1532 predecessor->total_length += absorb;
1533 CHECK_TOTAL_LENGTH (predecessor);
1534 delete_interval (i);
1535 return predecessor;
1538 predecessor = i;
1539 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1540 subtracting ABSORB. */
1542 if (AM_RIGHT_CHILD (predecessor))
1544 predecessor = INTERVAL_PARENT (predecessor);
1545 delete_interval (i);
1546 return predecessor;
1549 predecessor = INTERVAL_PARENT (predecessor);
1550 predecessor->total_length -= absorb;
1551 CHECK_TOTAL_LENGTH (predecessor);
1554 /* This must be the leftmost or first interval and cannot
1555 be merged left. The caller should have known. */
1556 abort ();
1559 /* Make an exact copy of interval tree SOURCE which descends from
1560 PARENT. This is done by recursing through SOURCE, copying
1561 the current interval and its properties, and then adjusting
1562 the pointers of the copy. */
1564 static INTERVAL
1565 reproduce_tree (INTERVAL source, INTERVAL parent)
1567 register INTERVAL t = make_interval ();
1569 memcpy (t, source, INTERVAL_SIZE);
1570 copy_properties (source, t);
1571 SET_INTERVAL_PARENT (t, parent);
1572 if (! NULL_LEFT_CHILD (source))
1573 t->left = reproduce_tree (source->left, t);
1574 if (! NULL_RIGHT_CHILD (source))
1575 t->right = reproduce_tree (source->right, t);
1577 return t;
1580 static INTERVAL
1581 reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
1583 register INTERVAL t = make_interval ();
1585 memcpy (t, source, INTERVAL_SIZE);
1586 copy_properties (source, t);
1587 SET_INTERVAL_OBJECT (t, parent);
1588 if (! NULL_LEFT_CHILD (source))
1589 t->left = reproduce_tree (source->left, t);
1590 if (! NULL_RIGHT_CHILD (source))
1591 t->right = reproduce_tree (source->right, t);
1593 return t;
1596 #if 0
1597 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1599 /* Make a new interval of length LENGTH starting at START in the
1600 group of intervals INTERVALS, which is actually an interval tree.
1601 Returns the new interval.
1603 Generate an error if the new positions would overlap an existing
1604 interval. */
1606 static INTERVAL
1607 make_new_interval (intervals, start, length)
1608 INTERVAL intervals;
1609 EMACS_INT start, length;
1611 INTERVAL slot;
1613 slot = find_interval (intervals, start);
1614 if (start + length > slot->position + LENGTH (slot))
1615 error ("Interval would overlap");
1617 if (start == slot->position && length == LENGTH (slot))
1618 return slot;
1620 if (slot->position == start)
1622 /* New right node. */
1623 split_interval_right (slot, length);
1624 return slot;
1627 if (slot->position + LENGTH (slot) == start + length)
1629 /* New left node. */
1630 split_interval_left (slot, LENGTH (slot) - length);
1631 return slot;
1634 /* Convert interval SLOT into three intervals. */
1635 split_interval_left (slot, start - slot->position);
1636 split_interval_right (slot, length);
1637 return slot;
1639 #endif
1641 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1642 LENGTH is the length of the text in SOURCE.
1644 The `position' field of the SOURCE intervals is assumed to be
1645 consistent with its parent; therefore, SOURCE must be an
1646 interval tree made with copy_interval or must be the whole
1647 tree of a buffer or a string.
1649 This is used in insdel.c when inserting Lisp_Strings into the
1650 buffer. The text corresponding to SOURCE is already in the buffer
1651 when this is called. The intervals of new tree are a copy of those
1652 belonging to the string being inserted; intervals are never
1653 shared.
1655 If the inserted text had no intervals associated, and we don't
1656 want to inherit the surrounding text's properties, this function
1657 simply returns -- offset_intervals should handle placing the
1658 text in the correct interval, depending on the sticky bits.
1660 If the inserted text had properties (intervals), then there are two
1661 cases -- either insertion happened in the middle of some interval,
1662 or between two intervals.
1664 If the text goes into the middle of an interval, then new
1665 intervals are created in the middle with only the properties of
1666 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1667 which case the new text has the union of its properties and those
1668 of the text into which it was inserted.
1670 If the text goes between two intervals, then if neither interval
1671 had its appropriate sticky property set (front_sticky, rear_sticky),
1672 the new text has only its properties. If one of the sticky properties
1673 is set, then the new text "sticks" to that region and its properties
1674 depend on merging as above. If both the preceding and succeeding
1675 intervals to the new text are "sticky", then the new text retains
1676 only its properties, as if neither sticky property were set. Perhaps
1677 we should consider merging all three sets of properties onto the new
1678 text... */
1680 void
1681 graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
1682 EMACS_INT length, struct buffer *buffer,
1683 int inherit)
1685 register INTERVAL under, over, this;
1686 register INTERVAL tree;
1687 EMACS_INT over_used;
1689 tree = BUF_INTERVALS (buffer);
1691 /* If the new text has no properties, then with inheritance it
1692 becomes part of whatever interval it was inserted into.
1693 To prevent inheritance, we must clear out the properties
1694 of the newly inserted text. */
1695 if (NULL_INTERVAL_P (source))
1697 Lisp_Object buf;
1698 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1700 XSETBUFFER (buf, buffer);
1701 set_text_properties_1 (make_number (position),
1702 make_number (position + length),
1703 Qnil, buf, 0);
1705 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1706 /* Shouldn't be necessary. -stef */
1707 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1708 return;
1711 if (NULL_INTERVAL_P (tree))
1713 /* The inserted text constitutes the whole buffer, so
1714 simply copy over the interval structure. */
1715 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1717 Lisp_Object buf;
1718 XSETBUFFER (buf, buffer);
1719 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1720 BUF_INTERVALS (buffer)->position = BEG;
1721 BUF_INTERVALS (buffer)->up_obj = 1;
1723 /* Explicitly free the old tree here? */
1725 return;
1728 /* Create an interval tree in which to place a copy
1729 of the intervals of the inserted string. */
1731 Lisp_Object buf;
1732 XSETBUFFER (buf, buffer);
1733 tree = create_root_interval (buf);
1736 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1737 /* If the buffer contains only the new string, but
1738 there was already some interval tree there, then it may be
1739 some zero length intervals. Eventually, do something clever
1740 about inserting properly. For now, just waste the old intervals. */
1742 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1743 BUF_INTERVALS (buffer)->position = BEG;
1744 BUF_INTERVALS (buffer)->up_obj = 1;
1745 /* Explicitly free the old tree here. */
1747 return;
1749 /* Paranoia -- the text has already been added, so this buffer
1750 should be of non-zero length. */
1751 else if (TOTAL_LENGTH (tree) == 0)
1752 abort ();
1754 this = under = find_interval (tree, position);
1755 if (NULL_INTERVAL_P (under)) /* Paranoia */
1756 abort ();
1757 over = find_interval (source, interval_start_pos (source));
1759 /* Here for insertion in the middle of an interval.
1760 Split off an equivalent interval to the right,
1761 then don't bother with it any more. */
1763 if (position > under->position)
1765 INTERVAL end_unchanged
1766 = split_interval_left (this, position - under->position);
1767 copy_properties (under, end_unchanged);
1768 under->position = position;
1770 else
1772 /* This call may have some effect because previous_interval may
1773 update `position' fields of intervals. Thus, don't ignore it
1774 for the moment. Someone please tell me the truth (K.Handa). */
1775 INTERVAL prev = previous_interval (under);
1776 (void) prev;
1777 #if 0
1778 /* But, this code surely has no effect. And, anyway,
1779 END_NONSTICKY_P is unreliable now. */
1780 if (prev && !END_NONSTICKY_P (prev))
1781 prev = 0;
1782 #endif /* 0 */
1785 /* Insertion is now at beginning of UNDER. */
1787 /* The inserted text "sticks" to the interval `under',
1788 which means it gets those properties.
1789 The properties of under are the result of
1790 adjust_intervals_for_insertion, so stickiness has
1791 already been taken care of. */
1793 /* OVER is the interval we are copying from next.
1794 OVER_USED says how many characters' worth of OVER
1795 have already been copied into target intervals.
1796 UNDER is the next interval in the target. */
1797 over_used = 0;
1798 while (! NULL_INTERVAL_P (over))
1800 /* If UNDER is longer than OVER, split it. */
1801 if (LENGTH (over) - over_used < LENGTH (under))
1803 this = split_interval_left (under, LENGTH (over) - over_used);
1804 copy_properties (under, this);
1806 else
1807 this = under;
1809 /* THIS is now the interval to copy or merge into.
1810 OVER covers all of it. */
1811 if (inherit)
1812 merge_properties (over, this);
1813 else
1814 copy_properties (over, this);
1816 /* If THIS and OVER end at the same place,
1817 advance OVER to a new source interval. */
1818 if (LENGTH (this) == LENGTH (over) - over_used)
1820 over = next_interval (over);
1821 over_used = 0;
1823 else
1824 /* Otherwise just record that more of OVER has been used. */
1825 over_used += LENGTH (this);
1827 /* Always advance to a new target interval. */
1828 under = next_interval (this);
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 (Lisp_Object plist, register Lisp_Object prop)
1844 return lookup_char_property (plist, prop, 1);
1847 Lisp_Object
1848 lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
1850 register Lisp_Object tail, fallback = Qnil;
1852 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1854 register Lisp_Object tem;
1855 tem = XCAR (tail);
1856 if (EQ (prop, tem))
1857 return Fcar (XCDR (tail));
1858 if (EQ (tem, Qcategory))
1860 tem = Fcar (XCDR (tail));
1861 if (SYMBOLP (tem))
1862 fallback = Fget (tem, prop);
1866 if (! NILP (fallback))
1867 return fallback;
1868 /* Check for alternative properties */
1869 tail = Fassq (prop, Vchar_property_alias_alist);
1870 if (! NILP (tail))
1872 tail = XCDR (tail);
1873 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1874 fallback = Fplist_get (plist, XCAR (tail));
1877 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1878 fallback = Fplist_get (Vdefault_text_properties, prop);
1879 return fallback;
1883 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1884 byte position BYTEPOS. */
1886 inline void
1887 temp_set_point_both (struct buffer *buffer,
1888 EMACS_INT charpos, EMACS_INT bytepos)
1890 /* In a single-byte buffer, the two positions must be equal. */
1891 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1892 && charpos != bytepos)
1893 abort ();
1895 if (charpos > bytepos)
1896 abort ();
1898 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1899 abort ();
1901 SET_BUF_PT_BOTH (buffer, charpos, bytepos);
1904 /* Set point "temporarily", without checking any text properties. */
1906 inline void
1907 temp_set_point (struct buffer *buffer, EMACS_INT charpos)
1909 temp_set_point_both (buffer, charpos,
1910 buf_charpos_to_bytepos (buffer, charpos));
1913 /* Set point in BUFFER to CHARPOS. If the target position is
1914 before an intangible character, move to an ok place. */
1916 void
1917 set_point (EMACS_INT charpos)
1919 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1922 /* If there's an invisible character at position POS + TEST_OFFS in the
1923 current buffer, and the invisible property has a `stickiness' such that
1924 inserting a character at position POS would inherit the property it,
1925 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1926 then intangibility is required as well as invisibleness.
1928 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1930 Note that `stickiness' is determined by overlay marker insertion types,
1931 if the invisible property comes from an overlay. */
1933 static EMACS_INT
1934 adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj,
1935 int test_intang)
1937 Lisp_Object invis_propval, invis_overlay;
1938 Lisp_Object test_pos;
1940 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1941 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1942 return pos;
1944 test_pos = make_number (pos + test_offs);
1946 invis_propval
1947 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1948 &invis_overlay);
1950 if ((!test_intang
1951 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1952 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1953 /* This next test is true if the invisible property has a stickiness
1954 such that an insertion at POS would inherit it. */
1955 && (NILP (invis_overlay)
1956 /* Invisible property is from a text-property. */
1957 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1958 == (test_offs == 0 ? 1 : -1))
1959 /* Invisible property is from an overlay. */
1960 : (test_offs == 0
1961 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1962 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1963 pos += adj;
1965 return pos;
1968 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1969 position BYTEPOS. If the target position is
1970 before an intangible character, move to an ok place. */
1972 void
1973 set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
1975 register INTERVAL to, from, toprev, fromprev;
1976 EMACS_INT buffer_point;
1977 EMACS_INT old_position = PT;
1978 /* This ensures that we move forward past intangible text when the
1979 initial position is the same as the destination, in the rare
1980 instances where this is important, e.g. in line-move-finish
1981 (simple.el). */
1982 int backwards = (charpos < old_position ? 1 : 0);
1983 int have_overlays;
1984 EMACS_INT original_position;
1986 BVAR (current_buffer, point_before_scroll) = Qnil;
1988 if (charpos == PT)
1989 return;
1991 /* In a single-byte buffer, the two positions must be equal. */
1992 eassert (ZV != ZV_BYTE || charpos == bytepos);
1994 /* Check this now, before checking if the buffer has any intervals.
1995 That way, we can catch conditions which break this sanity check
1996 whether or not there are intervals in the buffer. */
1997 eassert (charpos <= ZV && charpos >= BEGV);
1999 have_overlays = (current_buffer->overlays_before
2000 || current_buffer->overlays_after);
2002 /* If we have no text properties and overlays,
2003 then we can do it quickly. */
2004 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
2006 temp_set_point_both (current_buffer, charpos, bytepos);
2007 return;
2010 /* Set TO to the interval containing the char after CHARPOS,
2011 and TOPREV to the interval containing the char before CHARPOS.
2012 Either one may be null. They may be equal. */
2013 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2014 if (charpos == BEGV)
2015 toprev = 0;
2016 else if (to && to->position == charpos)
2017 toprev = previous_interval (to);
2018 else
2019 toprev = to;
2021 buffer_point = (PT == ZV ? ZV - 1 : PT);
2023 /* Set FROM to the interval containing the char after PT,
2024 and FROMPREV to the interval containing the char before PT.
2025 Either one may be null. They may be equal. */
2026 /* We could cache this and save time. */
2027 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2028 if (buffer_point == BEGV)
2029 fromprev = 0;
2030 else if (from && from->position == PT)
2031 fromprev = previous_interval (from);
2032 else if (buffer_point != PT)
2033 fromprev = from, from = 0;
2034 else
2035 fromprev = from;
2037 /* Moving within an interval. */
2038 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2039 && ! have_overlays)
2041 temp_set_point_both (current_buffer, charpos, bytepos);
2042 return;
2045 original_position = charpos;
2047 /* If the new position is between two intangible characters
2048 with the same intangible property value,
2049 move forward or backward until a change in that property. */
2050 if (NILP (Vinhibit_point_motion_hooks)
2051 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2052 || have_overlays)
2053 /* Intangibility never stops us from positioning at the beginning
2054 or end of the buffer, so don't bother checking in that case. */
2055 && charpos != BEGV && charpos != ZV)
2057 Lisp_Object pos;
2058 Lisp_Object intangible_propval;
2060 if (backwards)
2062 /* If the preceding character is both intangible and invisible,
2063 and the invisible property is `rear-sticky', perturb it so
2064 that the search starts one character earlier -- this ensures
2065 that point can never move to the end of an invisible/
2066 intangible/rear-sticky region. */
2067 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2069 XSETINT (pos, charpos);
2071 /* If following char is intangible,
2072 skip back over all chars with matching intangible property. */
2074 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2076 if (! NILP (intangible_propval))
2078 while (XINT (pos) > BEGV
2079 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2080 Qintangible, Qnil),
2081 intangible_propval))
2082 pos = Fprevious_char_property_change (pos, Qnil);
2084 /* Set CHARPOS from POS, and if the final intangible character
2085 that we skipped over is also invisible, and the invisible
2086 property is `front-sticky', perturb it to be one character
2087 earlier -- this ensures that point can never move to the
2088 beginning of an invisible/intangible/front-sticky region. */
2089 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2092 else
2094 /* If the following character is both intangible and invisible,
2095 and the invisible property is `front-sticky', perturb it so
2096 that the search starts one character later -- this ensures
2097 that point can never move to the beginning of an
2098 invisible/intangible/front-sticky region. */
2099 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2101 XSETINT (pos, charpos);
2103 /* If preceding char is intangible,
2104 skip forward over all chars with matching intangible property. */
2106 intangible_propval = Fget_char_property (make_number (charpos - 1),
2107 Qintangible, Qnil);
2109 if (! NILP (intangible_propval))
2111 while (XINT (pos) < ZV
2112 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2113 intangible_propval))
2114 pos = Fnext_char_property_change (pos, Qnil);
2116 /* Set CHARPOS from POS, and if the final intangible character
2117 that we skipped over is also invisible, and the invisible
2118 property is `rear-sticky', perturb it to be one character
2119 later -- this ensures that point can never move to the
2120 end of an invisible/intangible/rear-sticky region. */
2121 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2125 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2128 if (charpos != original_position)
2130 /* Set TO to the interval containing the char after CHARPOS,
2131 and TOPREV to the interval containing the char before CHARPOS.
2132 Either one may be null. They may be equal. */
2133 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2134 if (charpos == BEGV)
2135 toprev = 0;
2136 else if (to && to->position == charpos)
2137 toprev = previous_interval (to);
2138 else
2139 toprev = to;
2142 /* Here TO is the interval after the stopping point
2143 and TOPREV is the interval before the stopping point.
2144 One or the other may be null. */
2146 temp_set_point_both (current_buffer, charpos, bytepos);
2148 /* We run point-left and point-entered hooks here, if the
2149 two intervals are not equivalent. These hooks take
2150 (old_point, new_point) as arguments. */
2151 if (NILP (Vinhibit_point_motion_hooks)
2152 && (! intervals_equal (from, to)
2153 || ! intervals_equal (fromprev, toprev)))
2155 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2157 if (fromprev)
2158 leave_before = textget (fromprev->plist, Qpoint_left);
2159 else
2160 leave_before = Qnil;
2162 if (from)
2163 leave_after = textget (from->plist, Qpoint_left);
2164 else
2165 leave_after = Qnil;
2167 if (toprev)
2168 enter_before = textget (toprev->plist, Qpoint_entered);
2169 else
2170 enter_before = Qnil;
2172 if (to)
2173 enter_after = textget (to->plist, Qpoint_entered);
2174 else
2175 enter_after = Qnil;
2177 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2178 call2 (leave_before, make_number (old_position),
2179 make_number (charpos));
2180 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2181 call2 (leave_after, make_number (old_position),
2182 make_number (charpos));
2184 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2185 call2 (enter_before, make_number (old_position),
2186 make_number (charpos));
2187 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2188 call2 (enter_after, make_number (old_position),
2189 make_number (charpos));
2193 /* Move point to POSITION, unless POSITION is inside an intangible
2194 segment that reaches all the way to point. */
2196 void
2197 move_if_not_intangible (EMACS_INT position)
2199 Lisp_Object pos;
2200 Lisp_Object intangible_propval;
2202 XSETINT (pos, position);
2204 if (! NILP (Vinhibit_point_motion_hooks))
2205 /* If intangible is inhibited, always move point to POSITION. */
2207 else if (PT < position && XINT (pos) < ZV)
2209 /* We want to move forward, so check the text before POSITION. */
2211 intangible_propval = Fget_char_property (pos,
2212 Qintangible, Qnil);
2214 /* If following char is intangible,
2215 skip back over all chars with matching intangible property. */
2216 if (! NILP (intangible_propval))
2217 while (XINT (pos) > BEGV
2218 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2219 Qintangible, Qnil),
2220 intangible_propval))
2221 pos = Fprevious_char_property_change (pos, Qnil);
2223 else if (XINT (pos) > BEGV)
2225 /* We want to move backward, so check the text after POSITION. */
2227 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2228 Qintangible, Qnil);
2230 /* If following char is intangible,
2231 skip forward over all chars with matching intangible property. */
2232 if (! NILP (intangible_propval))
2233 while (XINT (pos) < ZV
2234 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2235 intangible_propval))
2236 pos = Fnext_char_property_change (pos, Qnil);
2239 else if (position < BEGV)
2240 position = BEGV;
2241 else if (position > ZV)
2242 position = ZV;
2244 /* If the whole stretch between PT and POSITION isn't intangible,
2245 try moving to POSITION (which means we actually move farther
2246 if POSITION is inside of intangible text). */
2248 if (XINT (pos) != PT)
2249 SET_PT (position);
2252 /* If text at position POS has property PROP, set *VAL to the property
2253 value, *START and *END to the beginning and end of a region that
2254 has the same property, and return 1. Otherwise return 0.
2256 OBJECT is the string or buffer to look for the property in;
2257 nil means the current buffer. */
2260 get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
2261 EMACS_INT *start, EMACS_INT *end, Lisp_Object object)
2263 INTERVAL i, prev, next;
2265 if (NILP (object))
2266 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2267 else if (BUFFERP (object))
2268 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2269 else if (STRINGP (object))
2270 i = find_interval (STRING_INTERVALS (object), pos);
2271 else
2272 abort ();
2274 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2275 return 0;
2276 *val = textget (i->plist, prop);
2277 if (NILP (*val))
2278 return 0;
2280 next = i; /* remember it in advance */
2281 prev = previous_interval (i);
2282 while (! NULL_INTERVAL_P (prev)
2283 && EQ (*val, textget (prev->plist, prop)))
2284 i = prev, prev = previous_interval (prev);
2285 *start = i->position;
2287 next = next_interval (i);
2288 while (! NULL_INTERVAL_P (next)
2289 && EQ (*val, textget (next->plist, prop)))
2290 i = next, next = next_interval (next);
2291 *end = i->position + LENGTH (i);
2293 return 1;
2296 /* Return the proper local keymap TYPE for position POSITION in
2297 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2298 specified by the PROP property, if any. Otherwise, if TYPE is
2299 `local-map' use BUFFER's local map.
2301 POSITION must be in the accessible part of BUFFER. */
2303 Lisp_Object
2304 get_local_map (register EMACS_INT position, register struct buffer *buffer,
2305 Lisp_Object type)
2307 Lisp_Object prop, lispy_position, lispy_buffer;
2308 EMACS_INT old_begv, old_zv, old_begv_byte, old_zv_byte;
2310 /* Perhaps we should just change `position' to the limit. */
2311 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2312 abort ();
2314 /* Ignore narrowing, so that a local map continues to be valid even if
2315 the visible region contains no characters and hence no properties. */
2316 old_begv = BUF_BEGV (buffer);
2317 old_zv = BUF_ZV (buffer);
2318 old_begv_byte = BUF_BEGV_BYTE (buffer);
2319 old_zv_byte = BUF_ZV_BYTE (buffer);
2321 SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer));
2322 SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer));
2324 XSETFASTINT (lispy_position, position);
2325 XSETBUFFER (lispy_buffer, buffer);
2326 /* First check if the CHAR has any property. This is because when
2327 we click with the mouse, the mouse pointer is really pointing
2328 to the CHAR after POS. */
2329 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2330 /* If not, look at the POS's properties. This is necessary because when
2331 editing a field with a `local-map' property, we want insertion at the end
2332 to obey the `local-map' property. */
2333 if (NILP (prop))
2334 prop = get_pos_property (lispy_position, type, lispy_buffer);
2336 SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte);
2337 SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte);
2339 /* Use the local map only if it is valid. */
2340 prop = get_keymap (prop, 0, 0);
2341 if (CONSP (prop))
2342 return prop;
2344 if (EQ (type, Qkeymap))
2345 return Qnil;
2346 else
2347 return BVAR (buffer, keymap);
2350 /* Produce an interval tree reflecting the intervals in
2351 TREE from START to START + LENGTH.
2352 The new interval tree has no parent and has a starting-position of 0. */
2354 INTERVAL
2355 copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
2357 register INTERVAL i, new, t;
2358 register EMACS_INT got, prevlen;
2360 if (NULL_INTERVAL_P (tree) || length <= 0)
2361 return NULL_INTERVAL;
2363 i = find_interval (tree, start);
2364 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2365 abort ();
2367 /* If there is only one interval and it's the default, return nil. */
2368 if ((start - i->position + 1 + length) < LENGTH (i)
2369 && DEFAULT_INTERVAL_P (i))
2370 return NULL_INTERVAL;
2372 new = make_interval ();
2373 new->position = 0;
2374 got = (LENGTH (i) - (start - i->position));
2375 new->total_length = length;
2376 CHECK_TOTAL_LENGTH (new);
2377 copy_properties (i, new);
2379 t = new;
2380 prevlen = got;
2381 while (got < length)
2383 i = next_interval (i);
2384 t = split_interval_right (t, prevlen);
2385 copy_properties (i, t);
2386 prevlen = LENGTH (i);
2387 got += prevlen;
2390 return balance_an_interval (new);
2393 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2395 inline void
2396 copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
2397 EMACS_INT position, EMACS_INT length)
2399 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2400 position, length);
2401 if (NULL_INTERVAL_P (interval_copy))
2402 return;
2404 SET_INTERVAL_OBJECT (interval_copy, string);
2405 STRING_SET_INTERVALS (string, interval_copy);
2408 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2409 Assume they have identical characters. */
2412 compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
2414 INTERVAL i1, i2;
2415 EMACS_INT pos = 0;
2416 EMACS_INT end = SCHARS (s1);
2418 i1 = find_interval (STRING_INTERVALS (s1), 0);
2419 i2 = find_interval (STRING_INTERVALS (s2), 0);
2421 while (pos < end)
2423 /* Determine how far we can go before we reach the end of I1 or I2. */
2424 EMACS_INT len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2425 EMACS_INT len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2426 EMACS_INT distance = min (len1, len2);
2428 /* If we ever find a mismatch between the strings,
2429 they differ. */
2430 if (! intervals_equal (i1, i2))
2431 return 0;
2433 /* Advance POS till the end of the shorter interval,
2434 and advance one or both interval pointers for the new position. */
2435 pos += distance;
2436 if (len1 == distance)
2437 i1 = next_interval (i1);
2438 if (len2 == distance)
2439 i2 = next_interval (i2);
2441 return 1;
2444 /* Recursively adjust interval I in the current buffer
2445 for setting enable_multibyte_characters to MULTI_FLAG.
2446 The range of interval I is START ... END in characters,
2447 START_BYTE ... END_BYTE in bytes. */
2449 static void
2450 set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
2451 EMACS_INT start, EMACS_INT start_byte,
2452 EMACS_INT end, EMACS_INT end_byte)
2454 /* Fix the length of this interval. */
2455 if (multi_flag)
2456 i->total_length = end - start;
2457 else
2458 i->total_length = end_byte - start_byte;
2459 CHECK_TOTAL_LENGTH (i);
2461 if (TOTAL_LENGTH (i) == 0)
2463 delete_interval (i);
2464 return;
2467 /* Recursively fix the length of the subintervals. */
2468 if (i->left)
2470 EMACS_INT left_end, left_end_byte;
2472 if (multi_flag)
2474 EMACS_INT temp;
2475 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2476 left_end = BYTE_TO_CHAR (left_end_byte);
2478 temp = CHAR_TO_BYTE (left_end);
2480 /* If LEFT_END_BYTE is in the middle of a character,
2481 adjust it and LEFT_END to a char boundary. */
2482 if (left_end_byte > temp)
2484 left_end_byte = temp;
2486 if (left_end_byte < temp)
2488 left_end--;
2489 left_end_byte = CHAR_TO_BYTE (left_end);
2492 else
2494 left_end = start + LEFT_TOTAL_LENGTH (i);
2495 left_end_byte = CHAR_TO_BYTE (left_end);
2498 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2499 left_end, left_end_byte);
2501 if (i->right)
2503 EMACS_INT right_start_byte, right_start;
2505 if (multi_flag)
2507 EMACS_INT temp;
2509 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2510 right_start = BYTE_TO_CHAR (right_start_byte);
2512 /* If RIGHT_START_BYTE is in the middle of a character,
2513 adjust it and RIGHT_START to a char boundary. */
2514 temp = CHAR_TO_BYTE (right_start);
2516 if (right_start_byte < temp)
2518 right_start_byte = temp;
2520 if (right_start_byte > temp)
2522 right_start++;
2523 right_start_byte = CHAR_TO_BYTE (right_start);
2526 else
2528 right_start = end - RIGHT_TOTAL_LENGTH (i);
2529 right_start_byte = CHAR_TO_BYTE (right_start);
2532 set_intervals_multibyte_1 (i->right, multi_flag,
2533 right_start, right_start_byte,
2534 end, end_byte);
2537 /* Rounding to char boundaries can theoretically ake this interval
2538 spurious. If so, delete one child, and copy its property list
2539 to this interval. */
2540 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2542 if ((i)->left)
2544 (i)->plist = (i)->left->plist;
2545 (i)->left->total_length = 0;
2546 delete_interval ((i)->left);
2548 else
2550 (i)->plist = (i)->right->plist;
2551 (i)->right->total_length = 0;
2552 delete_interval ((i)->right);
2557 /* Update the intervals of the current buffer
2558 to fit the contents as multibyte (if MULTI_FLAG is 1)
2559 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2561 void
2562 set_intervals_multibyte (int multi_flag)
2564 if (BUF_INTERVALS (current_buffer))
2565 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2566 BEG, BEG_BYTE, Z, Z_BYTE);