Ignore errors from font-lock-compile-keywords.
[emacs.git] / src / intervals.c
blob07845f956660aad0b584b7455c3b3ab7ba100826
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002, 2003, 2004,
3 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
23 /* NOTES:
25 Have to ensure that we can't put symbol nil on a plist, or some
26 functions may work incorrectly.
28 An idea: Have the owner of the tree keep count of splits and/or
29 insertion lengths (in intervals), and balance after every N.
31 Need to call *_left_hook when buffer is killed.
33 Scan for zero-length, or 0-length to see notes about handling
34 zero length interval-markers.
36 There are comments around about freeing intervals. It might be
37 faster to explicitly free them (put them on the free list) than
38 to GC them.
43 #include <config.h>
44 #include "lisp.h"
45 #include "intervals.h"
46 #include "buffer.h"
47 #include "puresize.h"
48 #include "keyboard.h"
49 #include "keymap.h"
51 /* Test for membership, allowing for t (actually any non-cons) to mean the
52 universal set. */
54 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
56 Lisp_Object merge_properties_sticky ();
57 static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
58 static INTERVAL reproduce_tree_obj P_ ((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 (parent)
67 Lisp_Object parent;
69 INTERVAL new;
71 CHECK_IMPURE (parent);
73 new = make_interval ();
75 if (BUFFERP (parent))
77 new->total_length = (BUF_Z (XBUFFER (parent))
78 - BUF_BEG (XBUFFER (parent)));
79 CHECK_TOTAL_LENGTH (new);
80 BUF_INTERVALS (XBUFFER (parent)) = new;
81 new->position = BEG;
83 else if (STRINGP (parent))
85 new->total_length = SCHARS (parent);
86 CHECK_TOTAL_LENGTH (new);
87 STRING_SET_INTERVALS (parent, new);
88 new->position = 0;
91 SET_INTERVAL_OBJECT (new, parent);
93 return new;
96 /* Make the interval TARGET have exactly the properties of SOURCE */
98 void
99 copy_properties (source, target)
100 register INTERVAL source, target;
102 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
103 return;
105 COPY_INTERVAL_CACHE (source, target);
106 target->plist = Fcopy_sequence (source->plist);
109 /* Merge the properties of interval SOURCE into the properties
110 of interval TARGET. That is to say, each property in SOURCE
111 is added to TARGET if TARGET has no such property as yet. */
113 static void
114 merge_properties (source, target)
115 register INTERVAL source, target;
117 register Lisp_Object o, sym, val;
119 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
120 return;
122 MERGE_INTERVAL_CACHE (source, target);
124 o = source->plist;
125 while (CONSP (o))
127 sym = XCAR (o);
128 val = Fmemq (sym, target->plist);
130 if (NILP (val))
132 o = XCDR (o);
133 CHECK_CONS (o);
134 val = XCAR (o);
135 target->plist = Fcons (sym, Fcons (val, target->plist));
136 o = XCDR (o);
138 else
139 o = Fcdr (XCDR (o));
143 /* Return 1 if the two intervals have the same properties,
144 0 otherwise. */
147 intervals_equal (i0, i1)
148 INTERVAL i0, i1;
150 register Lisp_Object i0_cdr, i0_sym, i1_val;
151 register int i1_len;
153 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
154 return 1;
156 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
157 return 0;
159 i1_len = XFASTINT (Flength (i1->plist));
160 if (i1_len & 0x1) /* Paranoia -- plists are always even */
161 abort ();
162 i1_len /= 2;
163 i0_cdr = i0->plist;
164 while (CONSP (i0_cdr))
166 /* Lengths of the two plists were unequal. */
167 if (i1_len == 0)
168 return 0;
170 i0_sym = XCAR (i0_cdr);
171 i1_val = Fmemq (i0_sym, i1->plist);
173 /* i0 has something i1 doesn't. */
174 if (EQ (i1_val, Qnil))
175 return 0;
177 /* i0 and i1 both have sym, but it has different values in each. */
178 i0_cdr = XCDR (i0_cdr);
179 CHECK_CONS (i0_cdr);
180 if (!EQ (Fcar (Fcdr (i1_val)), XCAR (i0_cdr)))
181 return 0;
183 i0_cdr = XCDR (i0_cdr);
184 i1_len--;
187 /* Lengths of the two plists were unequal. */
188 if (i1_len > 0)
189 return 0;
191 return 1;
195 /* Traverse an interval tree TREE, performing FUNCTION on each node.
196 No guarantee is made about the order of traversal.
197 Pass FUNCTION two args: an interval, and ARG. */
199 void
200 traverse_intervals_noorder (tree, function, arg)
201 INTERVAL tree;
202 void (* function) P_ ((INTERVAL, Lisp_Object));
203 Lisp_Object arg;
205 /* Minimize stack usage. */
206 while (!NULL_INTERVAL_P (tree))
208 (*function) (tree, arg);
209 if (NULL_INTERVAL_P (tree->right))
210 tree = tree->left;
211 else
213 traverse_intervals_noorder (tree->left, function, arg);
214 tree = tree->right;
219 /* Traverse an interval tree TREE, performing FUNCTION on each node.
220 Pass FUNCTION two args: an interval, and ARG. */
222 void
223 traverse_intervals (tree, position, function, arg)
224 INTERVAL tree;
225 int position;
226 void (* function) P_ ((INTERVAL, Lisp_Object));
227 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)
318 INTERVAL interval;
320 INTERVAL i;
321 INTERVAL B = interval->left;
322 int old_total = interval->total_length;
324 /* Deal with any Parent of A; make it point to B. */
325 if (! ROOT_INTERVAL_P (interval))
327 if (AM_LEFT_CHILD (interval))
328 INTERVAL_PARENT (interval)->left = B;
329 else
330 INTERVAL_PARENT (interval)->right = B;
332 COPY_INTERVAL_PARENT (B, interval);
334 /* Make B the parent of A */
335 i = B->right;
336 B->right = interval;
337 SET_INTERVAL_PARENT (interval, B);
339 /* Make A point to c */
340 interval->left = i;
341 if (! NULL_INTERVAL_P (i))
342 SET_INTERVAL_PARENT (i, interval);
344 /* A's total length is decreased by the length of B and its left child. */
345 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
346 CHECK_TOTAL_LENGTH (interval);
348 /* B must have the same total length of A. */
349 B->total_length = old_total;
350 CHECK_TOTAL_LENGTH (B);
352 return B;
355 /* Assuming that a right child exists, perform the following operation:
358 / \ / \
359 B => A
360 / \ / \
364 static INLINE INTERVAL
365 rotate_left (interval)
366 INTERVAL interval;
368 INTERVAL i;
369 INTERVAL B = interval->right;
370 int old_total = interval->total_length;
372 /* Deal with any parent of A; make it point to B. */
373 if (! ROOT_INTERVAL_P (interval))
375 if (AM_LEFT_CHILD (interval))
376 INTERVAL_PARENT (interval)->left = B;
377 else
378 INTERVAL_PARENT (interval)->right = B;
380 COPY_INTERVAL_PARENT (B, interval);
382 /* Make B the parent of A */
383 i = B->left;
384 B->left = interval;
385 SET_INTERVAL_PARENT (interval, B);
387 /* Make A point to c */
388 interval->right = i;
389 if (! NULL_INTERVAL_P (i))
390 SET_INTERVAL_PARENT (i, interval);
392 /* A's total length is decreased by the length of B and its right child. */
393 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
394 CHECK_TOTAL_LENGTH (interval);
396 /* B must have the same total length of A. */
397 B->total_length = old_total;
398 CHECK_TOTAL_LENGTH (B);
400 return B;
403 /* Balance an interval tree with the assumption that the subtrees
404 themselves are already balanced. */
406 static INTERVAL
407 balance_an_interval (i)
408 INTERVAL i;
410 register int old_diff, new_diff;
412 while (1)
414 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
415 if (old_diff > 0)
417 /* Since the left child is longer, there must be one. */
418 new_diff = i->total_length - i->left->total_length
419 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
420 if (abs (new_diff) >= old_diff)
421 break;
422 i = rotate_right (i);
423 balance_an_interval (i->right);
425 else if (old_diff < 0)
427 /* Since the right child is longer, there must be one. */
428 new_diff = i->total_length - i->right->total_length
429 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
430 if (abs (new_diff) >= -old_diff)
431 break;
432 i = rotate_left (i);
433 balance_an_interval (i->left);
435 else
436 break;
438 return i;
441 /* Balance INTERVAL, potentially stuffing it back into its parent
442 Lisp Object. */
444 static INLINE INTERVAL
445 balance_possible_root_interval (interval)
446 register INTERVAL interval;
448 Lisp_Object parent;
449 int have_parent = 0;
451 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
452 return interval;
454 if (INTERVAL_HAS_OBJECT (interval))
456 have_parent = 1;
457 GET_INTERVAL_OBJECT (parent, interval);
459 interval = balance_an_interval (interval);
461 if (have_parent)
463 if (BUFFERP (parent))
464 BUF_INTERVALS (XBUFFER (parent)) = interval;
465 else if (STRINGP (parent))
466 STRING_SET_INTERVALS (parent, interval);
469 return interval;
472 /* Balance the interval tree TREE. Balancing is by weight
473 (the amount of text). */
475 static INTERVAL
476 balance_intervals_internal (tree)
477 register INTERVAL tree;
479 /* Balance within each side. */
480 if (tree->left)
481 balance_intervals_internal (tree->left);
482 if (tree->right)
483 balance_intervals_internal (tree->right);
484 return balance_an_interval (tree);
487 /* Advertised interface to balance intervals. */
489 INTERVAL
490 balance_intervals (tree)
491 INTERVAL tree;
493 if (tree == NULL_INTERVAL)
494 return NULL_INTERVAL;
496 return balance_intervals_internal (tree);
499 /* Split INTERVAL into two pieces, starting the second piece at
500 character position OFFSET (counting from 0), relative to INTERVAL.
501 INTERVAL becomes the left-hand piece, and the right-hand piece
502 (second, lexicographically) is returned.
504 The size and position fields of the two intervals are set based upon
505 those of the original interval. The property list of the new interval
506 is reset, thus it is up to the caller to do the right thing with the
507 result.
509 Note that this does not change the position of INTERVAL; if it is a root,
510 it is still a root after this operation. */
512 INTERVAL
513 split_interval_right (interval, offset)
514 INTERVAL interval;
515 int offset;
517 INTERVAL new = make_interval ();
518 int position = interval->position;
519 int new_length = LENGTH (interval) - offset;
521 new->position = position + offset;
522 SET_INTERVAL_PARENT (new, interval);
524 if (NULL_RIGHT_CHILD (interval))
526 interval->right = new;
527 new->total_length = new_length;
528 CHECK_TOTAL_LENGTH (new);
530 else
532 /* Insert the new node between INTERVAL and its right child. */
533 new->right = interval->right;
534 SET_INTERVAL_PARENT (interval->right, new);
535 interval->right = new;
536 new->total_length = new_length + new->right->total_length;
537 CHECK_TOTAL_LENGTH (new);
538 balance_an_interval (new);
541 balance_possible_root_interval (interval);
543 return new;
546 /* Split INTERVAL into two pieces, starting the second piece at
547 character position OFFSET (counting from 0), relative to INTERVAL.
548 INTERVAL becomes the right-hand piece, and the left-hand piece
549 (first, lexicographically) is returned.
551 The size and position fields of the two intervals are set based upon
552 those of the original interval. The property list of the new interval
553 is reset, thus it is up to the caller to do the right thing with the
554 result.
556 Note that this does not change the position of INTERVAL; if it is a root,
557 it is still a root after this operation. */
559 INTERVAL
560 split_interval_left (interval, offset)
561 INTERVAL interval;
562 int offset;
564 INTERVAL new = make_interval ();
565 int new_length = offset;
567 new->position = interval->position;
568 interval->position = interval->position + offset;
569 SET_INTERVAL_PARENT (new, interval);
571 if (NULL_LEFT_CHILD (interval))
573 interval->left = new;
574 new->total_length = new_length;
575 CHECK_TOTAL_LENGTH (new);
577 else
579 /* Insert the new node between INTERVAL and its left child. */
580 new->left = interval->left;
581 SET_INTERVAL_PARENT (new->left, new);
582 interval->left = new;
583 new->total_length = new_length + new->left->total_length;
584 CHECK_TOTAL_LENGTH (new);
585 balance_an_interval (new);
588 balance_possible_root_interval (interval);
590 return new;
593 /* Return the proper position for the first character
594 described by the interval tree SOURCE.
595 This is 1 if the parent is a buffer,
596 0 if the parent is a string or if there is no parent.
598 Don't use this function on an interval which is the child
599 of another interval! */
602 interval_start_pos (source)
603 INTERVAL source;
605 Lisp_Object parent;
607 if (NULL_INTERVAL_P (source))
608 return 0;
610 if (! INTERVAL_HAS_OBJECT (source))
611 return 0;
612 GET_INTERVAL_OBJECT (parent, source);
613 if (BUFFERP (parent))
614 return BUF_BEG (XBUFFER (parent));
615 return 0;
618 /* Find the interval containing text position POSITION in the text
619 represented by the interval tree TREE. POSITION is a buffer
620 position (starting from 1) or a string index (starting from 0).
621 If POSITION is at the end of the buffer or string,
622 return the interval containing the last character.
624 The `position' field, which is a cache of an interval's position,
625 is updated in the interval found. Other functions (e.g., next_interval)
626 will update this cache based on the result of find_interval. */
628 INTERVAL
629 find_interval (tree, position)
630 register INTERVAL tree;
631 register int position;
633 /* The distance from the left edge of the subtree at TREE
634 to POSITION. */
635 register int relative_position;
637 if (NULL_INTERVAL_P (tree))
638 return NULL_INTERVAL;
640 relative_position = position;
641 if (INTERVAL_HAS_OBJECT (tree))
643 Lisp_Object parent;
644 GET_INTERVAL_OBJECT (parent, tree);
645 if (BUFFERP (parent))
646 relative_position -= BUF_BEG (XBUFFER (parent));
649 if (relative_position > TOTAL_LENGTH (tree))
650 abort (); /* Paranoia */
652 if (!handling_signal)
653 tree = balance_possible_root_interval (tree);
655 while (1)
657 if (relative_position < LEFT_TOTAL_LENGTH (tree))
659 tree = tree->left;
661 else if (! NULL_RIGHT_CHILD (tree)
662 && relative_position >= (TOTAL_LENGTH (tree)
663 - RIGHT_TOTAL_LENGTH (tree)))
665 relative_position -= (TOTAL_LENGTH (tree)
666 - RIGHT_TOTAL_LENGTH (tree));
667 tree = tree->right;
669 else
671 tree->position
672 = (position - relative_position /* left edge of *tree. */
673 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
675 return tree;
680 /* Find the succeeding interval (lexicographically) to INTERVAL.
681 Sets the `position' field based on that of INTERVAL (see
682 find_interval). */
684 INTERVAL
685 next_interval (interval)
686 register INTERVAL interval;
688 register INTERVAL i = interval;
689 register int next_position;
691 if (NULL_INTERVAL_P (i))
692 return NULL_INTERVAL;
693 next_position = interval->position + LENGTH (interval);
695 if (! NULL_RIGHT_CHILD (i))
697 i = i->right;
698 while (! NULL_LEFT_CHILD (i))
699 i = i->left;
701 i->position = next_position;
702 return i;
705 while (! NULL_PARENT (i))
707 if (AM_LEFT_CHILD (i))
709 i = INTERVAL_PARENT (i);
710 i->position = next_position;
711 return i;
714 i = INTERVAL_PARENT (i);
717 return NULL_INTERVAL;
720 /* Find the preceding interval (lexicographically) to INTERVAL.
721 Sets the `position' field based on that of INTERVAL (see
722 find_interval). */
724 INTERVAL
725 previous_interval (interval)
726 register INTERVAL interval;
728 register INTERVAL i;
730 if (NULL_INTERVAL_P (interval))
731 return NULL_INTERVAL;
733 if (! NULL_LEFT_CHILD (interval))
735 i = interval->left;
736 while (! NULL_RIGHT_CHILD (i))
737 i = i->right;
739 i->position = interval->position - LENGTH (i);
740 return i;
743 i = interval;
744 while (! NULL_PARENT (i))
746 if (AM_RIGHT_CHILD (i))
748 i = INTERVAL_PARENT (i);
750 i->position = interval->position - LENGTH (i);
751 return i;
753 i = INTERVAL_PARENT (i);
756 return NULL_INTERVAL;
759 /* Find the interval containing POS given some non-NULL INTERVAL
760 in the same tree. Note that we need to update interval->position
761 if we go down the tree.
762 To speed up the process, we assume that the ->position of
763 I and all its parents is already uptodate. */
764 INTERVAL
765 update_interval (i, pos)
766 register INTERVAL i;
767 int pos;
769 if (NULL_INTERVAL_P (i))
770 return NULL_INTERVAL;
772 while (1)
774 if (pos < i->position)
776 /* Move left. */
777 if (pos >= i->position - TOTAL_LENGTH (i->left))
779 i->left->position = i->position - TOTAL_LENGTH (i->left)
780 + LEFT_TOTAL_LENGTH (i->left);
781 i = i->left; /* Move to the left child */
783 else if (NULL_PARENT (i))
784 error ("Point before start of properties");
785 else
786 i = INTERVAL_PARENT (i);
787 continue;
789 else if (pos >= INTERVAL_LAST_POS (i))
791 /* Move right. */
792 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
794 i->right->position = INTERVAL_LAST_POS (i)
795 + LEFT_TOTAL_LENGTH (i->right);
796 i = i->right; /* Move to the right child */
798 else if (NULL_PARENT (i))
799 error ("Point %d after end of properties", pos);
800 else
801 i = INTERVAL_PARENT (i);
802 continue;
804 else
805 return i;
810 #if 0
811 /* Traverse a path down the interval tree TREE to the interval
812 containing POSITION, adjusting all nodes on the path for
813 an addition of LENGTH characters. Insertion between two intervals
814 (i.e., point == i->position, where i is second interval) means
815 text goes into second interval.
817 Modifications are needed to handle the hungry bits -- after simply
818 finding the interval at position (don't add length going down),
819 if it's the beginning of the interval, get the previous interval
820 and check the hungry bits of both. Then add the length going back up
821 to the root. */
823 static INTERVAL
824 adjust_intervals_for_insertion (tree, position, length)
825 INTERVAL tree;
826 int position, length;
828 register int relative_position;
829 register INTERVAL this;
831 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
832 abort ();
834 /* If inserting at point-max of a buffer, that position
835 will be out of range */
836 if (position > TOTAL_LENGTH (tree))
837 position = TOTAL_LENGTH (tree);
838 relative_position = position;
839 this = tree;
841 while (1)
843 if (relative_position <= LEFT_TOTAL_LENGTH (this))
845 this->total_length += length;
846 CHECK_TOTAL_LENGTH (this);
847 this = this->left;
849 else if (relative_position > (TOTAL_LENGTH (this)
850 - RIGHT_TOTAL_LENGTH (this)))
852 relative_position -= (TOTAL_LENGTH (this)
853 - RIGHT_TOTAL_LENGTH (this));
854 this->total_length += length;
855 CHECK_TOTAL_LENGTH (this);
856 this = this->right;
858 else
860 /* If we are to use zero-length intervals as buffer pointers,
861 then this code will have to change. */
862 this->total_length += length;
863 CHECK_TOTAL_LENGTH (this);
864 this->position = LEFT_TOTAL_LENGTH (this)
865 + position - relative_position + 1;
866 return tree;
870 #endif
872 /* Effect an adjustment corresponding to the addition of LENGTH characters
873 of text. Do this by finding the interval containing POSITION in the
874 interval tree TREE, and then adjusting all of its ancestors by adding
875 LENGTH to them.
877 If POSITION is the first character of an interval, meaning that point
878 is actually between the two intervals, make the new text belong to
879 the interval which is "sticky".
881 If both intervals are "sticky", then make them belong to the left-most
882 interval. Another possibility would be to create a new interval for
883 this text, and make it have the merged properties of both ends. */
885 static INTERVAL
886 adjust_intervals_for_insertion (tree, position, length)
887 INTERVAL tree;
888 int position, length;
890 register INTERVAL i;
891 register INTERVAL temp;
892 int eobp = 0;
893 Lisp_Object parent;
894 int offset;
896 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
897 abort ();
899 GET_INTERVAL_OBJECT (parent, tree);
900 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
902 /* If inserting at point-max of a buffer, that position will be out
903 of range. Remember that buffer positions are 1-based. */
904 if (position >= TOTAL_LENGTH (tree) + offset)
906 position = TOTAL_LENGTH (tree) + offset;
907 eobp = 1;
910 i = find_interval (tree, position);
912 /* If in middle of an interval which is not sticky either way,
913 we must not just give its properties to the insertion.
914 So split this interval at the insertion point.
916 Originally, the if condition here was this:
917 (! (position == i->position || eobp)
918 && END_NONSTICKY_P (i)
919 && FRONT_NONSTICKY_P (i))
920 But, these macros are now unreliable because of introduction of
921 Vtext_property_default_nonsticky. So, we always check properties
922 one by one if POSITION is in middle of an interval. */
923 if (! (position == i->position || eobp))
925 Lisp_Object tail;
926 Lisp_Object front, rear;
928 tail = i->plist;
930 /* Properties font-sticky and rear-nonsticky override
931 Vtext_property_default_nonsticky. So, if they are t, we can
932 skip one by one checking of properties. */
933 rear = textget (i->plist, Qrear_nonsticky);
934 if (! CONSP (rear) && ! NILP (rear))
936 /* All properties are nonsticky. We split the interval. */
937 goto check_done;
939 front = textget (i->plist, Qfront_sticky);
940 if (! CONSP (front) && ! NILP (front))
942 /* All properties are sticky. We don't split the interval. */
943 tail = Qnil;
944 goto check_done;
947 /* Does any actual property pose an actual problem? We break
948 the loop if we find a nonsticky property. */
949 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
951 Lisp_Object prop, tmp;
952 prop = XCAR (tail);
954 /* Is this particular property front-sticky? */
955 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
956 continue;
958 /* Is this particular property rear-nonsticky? */
959 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
960 break;
962 /* Is this particular property recorded as sticky or
963 nonsticky in Vtext_property_default_nonsticky? */
964 tmp = Fassq (prop, Vtext_property_default_nonsticky);
965 if (CONSP (tmp))
967 if (NILP (tmp))
968 continue;
969 break;
972 /* By default, a text property is rear-sticky, thus we
973 continue the loop. */
976 check_done:
977 /* If any property is a real problem, split the interval. */
978 if (! NILP (tail))
980 temp = split_interval_right (i, position - i->position);
981 copy_properties (i, temp);
982 i = temp;
986 /* If we are positioned between intervals, check the stickiness of
987 both of them. We have to do this too, if we are at BEG or Z. */
988 if (position == i->position || eobp)
990 register INTERVAL prev;
992 if (position == BEG)
993 prev = 0;
994 else if (eobp)
996 prev = i;
997 i = 0;
999 else
1000 prev = previous_interval (i);
1002 /* Even if we are positioned between intervals, we default
1003 to the left one if it exists. We extend it now and split
1004 off a part later, if stickiness demands it. */
1005 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1007 temp->total_length += length;
1008 CHECK_TOTAL_LENGTH (temp);
1009 temp = balance_possible_root_interval (temp);
1012 /* If at least one interval has sticky properties,
1013 we check the stickiness property by property.
1015 Originally, the if condition here was this:
1016 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1017 But, these macros are now unreliable because of introduction
1018 of Vtext_property_default_nonsticky. So, we always have to
1019 check stickiness of properties one by one. If cache of
1020 stickiness is implemented in the future, we may be able to
1021 use those macros again. */
1022 if (1)
1024 Lisp_Object pleft, pright;
1025 struct interval newi;
1027 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1028 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1029 newi.plist = merge_properties_sticky (pleft, pright);
1031 if (! prev) /* i.e. position == BEG */
1033 if (! intervals_equal (i, &newi))
1035 i = split_interval_left (i, length);
1036 i->plist = newi.plist;
1039 else if (! intervals_equal (prev, &newi))
1041 prev = split_interval_right (prev,
1042 position - prev->position);
1043 prev->plist = newi.plist;
1044 if (! NULL_INTERVAL_P (i)
1045 && intervals_equal (prev, i))
1046 merge_interval_right (prev);
1049 /* We will need to update the cache here later. */
1051 else if (! prev && ! NILP (i->plist))
1053 /* Just split off a new interval at the left.
1054 Since I wasn't front-sticky, the empty plist is ok. */
1055 i = split_interval_left (i, length);
1059 /* Otherwise just extend the interval. */
1060 else
1062 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1064 temp->total_length += length;
1065 CHECK_TOTAL_LENGTH (temp);
1066 temp = balance_possible_root_interval (temp);
1070 return tree;
1073 /* Any property might be front-sticky on the left, rear-sticky on the left,
1074 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1075 can be arranged in a matrix with rows denoting the left conditions and
1076 columns denoting the right conditions:
1077 _ __ _
1078 _ FR FR FR FR
1079 FR__ 0 1 2 3
1080 _FR 4 5 6 7
1081 FR 8 9 A B
1082 FR C D E F
1084 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1085 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1086 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1087 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1088 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1089 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1090 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1091 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1093 We inherit from whoever has a sticky side facing us. If both sides
1094 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1095 non-nil value for the current property. If both sides do, then we take
1096 from the left.
1098 When we inherit a property, we get its stickiness as well as its value.
1099 So, when we merge the above two lists, we expect to get this:
1101 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1102 rear-nonsticky (p6 pa)
1103 p0 L p1 L p2 L p3 L p6 R p7 R
1104 pa R pb R pc L pd L pe L pf L)
1106 The optimizable special cases are:
1107 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1108 left rear-nonsticky = t, right front-sticky = t (inherit right)
1109 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1112 Lisp_Object
1113 merge_properties_sticky (pleft, pright)
1114 Lisp_Object pleft, pright;
1116 register Lisp_Object props, front, rear;
1117 Lisp_Object lfront, lrear, rfront, rrear;
1118 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1119 int use_left, use_right;
1120 int lpresent;
1122 props = Qnil;
1123 front = Qnil;
1124 rear = Qnil;
1125 lfront = textget (pleft, Qfront_sticky);
1126 lrear = textget (pleft, Qrear_nonsticky);
1127 rfront = textget (pright, Qfront_sticky);
1128 rrear = textget (pright, Qrear_nonsticky);
1130 /* Go through each element of PRIGHT. */
1131 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1133 Lisp_Object tmp;
1135 sym = XCAR (tail1);
1137 /* Sticky properties get special treatment. */
1138 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1139 continue;
1141 rval = Fcar (XCDR (tail1));
1142 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1143 if (EQ (sym, XCAR (tail2)))
1144 break;
1146 /* Indicate whether the property is explicitly defined on the left.
1147 (We know it is defined explicitly on the right
1148 because otherwise we don't get here.) */
1149 lpresent = ! NILP (tail2);
1150 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1152 /* Even if lrear or rfront say nothing about the stickiness of
1153 SYM, Vtext_property_default_nonsticky may give default
1154 stickiness to SYM. */
1155 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1156 use_left = (lpresent
1157 && ! (TMEM (sym, lrear)
1158 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1159 use_right = (TMEM (sym, rfront)
1160 || (CONSP (tmp) && NILP (XCDR (tmp))));
1161 if (use_left && use_right)
1163 if (NILP (lval))
1164 use_left = 0;
1165 else if (NILP (rval))
1166 use_right = 0;
1168 if (use_left)
1170 /* We build props as (value sym ...) rather than (sym value ...)
1171 because we plan to nreverse it when we're done. */
1172 props = Fcons (lval, Fcons (sym, props));
1173 if (TMEM (sym, lfront))
1174 front = Fcons (sym, front);
1175 if (TMEM (sym, lrear))
1176 rear = Fcons (sym, rear);
1178 else if (use_right)
1180 props = Fcons (rval, Fcons (sym, props));
1181 if (TMEM (sym, rfront))
1182 front = Fcons (sym, front);
1183 if (TMEM (sym, rrear))
1184 rear = Fcons (sym, rear);
1188 /* Now go through each element of PLEFT. */
1189 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1191 Lisp_Object tmp;
1193 sym = XCAR (tail2);
1195 /* Sticky properties get special treatment. */
1196 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1197 continue;
1199 /* If sym is in PRIGHT, we've already considered it. */
1200 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1201 if (EQ (sym, XCAR (tail1)))
1202 break;
1203 if (! NILP (tail1))
1204 continue;
1206 lval = Fcar (XCDR (tail2));
1208 /* Even if lrear or rfront say nothing about the stickiness of
1209 SYM, Vtext_property_default_nonsticky may give default
1210 stickiness to SYM. */
1211 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1213 /* Since rval is known to be nil in this loop, the test simplifies. */
1214 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1216 props = Fcons (lval, Fcons (sym, props));
1217 if (TMEM (sym, lfront))
1218 front = Fcons (sym, front);
1220 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1222 /* The value is nil, but we still inherit the stickiness
1223 from the right. */
1224 front = Fcons (sym, front);
1225 if (TMEM (sym, rrear))
1226 rear = Fcons (sym, rear);
1229 props = Fnreverse (props);
1230 if (! NILP (rear))
1231 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1233 cat = textget (props, Qcategory);
1234 if (! NILP (front)
1236 /* If we have inherited a front-stick category property that is t,
1237 we don't need to set up a detailed one. */
1238 ! (! NILP (cat) && SYMBOLP (cat)
1239 && EQ (Fget (cat, Qfront_sticky), Qt)))
1240 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1241 return props;
1245 /* Delete a node I from its interval tree by merging its subtrees
1246 into one subtree which is then returned. Caller is responsible for
1247 storing the resulting subtree into its parent. */
1249 static INTERVAL
1250 delete_node (i)
1251 register INTERVAL i;
1253 register INTERVAL migrate, this;
1254 register int migrate_amt;
1256 if (NULL_INTERVAL_P (i->left))
1257 return i->right;
1258 if (NULL_INTERVAL_P (i->right))
1259 return i->left;
1261 migrate = i->left;
1262 migrate_amt = i->left->total_length;
1263 this = i->right;
1264 this->total_length += migrate_amt;
1265 while (! NULL_INTERVAL_P (this->left))
1267 this = this->left;
1268 this->total_length += migrate_amt;
1270 CHECK_TOTAL_LENGTH (this);
1271 this->left = migrate;
1272 SET_INTERVAL_PARENT (migrate, this);
1274 return i->right;
1277 /* Delete interval I from its tree by calling `delete_node'
1278 and properly connecting the resultant subtree.
1280 I is presumed to be empty; that is, no adjustments are made
1281 for the length of I. */
1283 void
1284 delete_interval (i)
1285 register INTERVAL i;
1287 register INTERVAL parent;
1288 int amt = LENGTH (i);
1290 if (amt > 0) /* Only used on zero-length intervals now. */
1291 abort ();
1293 if (ROOT_INTERVAL_P (i))
1295 Lisp_Object owner;
1296 GET_INTERVAL_OBJECT (owner, i);
1297 parent = delete_node (i);
1298 if (! NULL_INTERVAL_P (parent))
1299 SET_INTERVAL_OBJECT (parent, owner);
1301 if (BUFFERP (owner))
1302 BUF_INTERVALS (XBUFFER (owner)) = parent;
1303 else if (STRINGP (owner))
1304 STRING_SET_INTERVALS (owner, parent);
1305 else
1306 abort ();
1308 return;
1311 parent = INTERVAL_PARENT (i);
1312 if (AM_LEFT_CHILD (i))
1314 parent->left = delete_node (i);
1315 if (! NULL_INTERVAL_P (parent->left))
1316 SET_INTERVAL_PARENT (parent->left, parent);
1318 else
1320 parent->right = delete_node (i);
1321 if (! NULL_INTERVAL_P (parent->right))
1322 SET_INTERVAL_PARENT (parent->right, parent);
1326 /* Find the interval in TREE corresponding to the relative position
1327 FROM and delete as much as possible of AMOUNT from that interval.
1328 Return the amount actually deleted, and if the interval was
1329 zeroed-out, delete that interval node from the tree.
1331 Note that FROM is actually origin zero, aka relative to the
1332 leftmost edge of tree. This is appropriate since we call ourselves
1333 recursively on subtrees.
1335 Do this by recursing down TREE to the interval in question, and
1336 deleting the appropriate amount of text. */
1338 static int
1339 interval_deletion_adjustment (tree, from, amount)
1340 register INTERVAL tree;
1341 register int from, amount;
1343 register int relative_position = from;
1345 if (NULL_INTERVAL_P (tree))
1346 return 0;
1348 /* Left branch */
1349 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1351 int subtract = interval_deletion_adjustment (tree->left,
1352 relative_position,
1353 amount);
1354 tree->total_length -= subtract;
1355 CHECK_TOTAL_LENGTH (tree);
1356 return subtract;
1358 /* Right branch */
1359 else if (relative_position >= (TOTAL_LENGTH (tree)
1360 - RIGHT_TOTAL_LENGTH (tree)))
1362 int subtract;
1364 relative_position -= (tree->total_length
1365 - RIGHT_TOTAL_LENGTH (tree));
1366 subtract = interval_deletion_adjustment (tree->right,
1367 relative_position,
1368 amount);
1369 tree->total_length -= subtract;
1370 CHECK_TOTAL_LENGTH (tree);
1371 return subtract;
1373 /* Here -- this node. */
1374 else
1376 /* How much can we delete from this interval? */
1377 int my_amount = ((tree->total_length
1378 - RIGHT_TOTAL_LENGTH (tree))
1379 - relative_position);
1381 if (amount > my_amount)
1382 amount = my_amount;
1384 tree->total_length -= amount;
1385 CHECK_TOTAL_LENGTH (tree);
1386 if (LENGTH (tree) == 0)
1387 delete_interval (tree);
1389 return amount;
1392 /* Never reach here. */
1395 /* Effect the adjustments necessary to the interval tree of BUFFER to
1396 correspond to the deletion of LENGTH characters from that buffer
1397 text. The deletion is effected at position START (which is a
1398 buffer position, i.e. origin 1). */
1400 static void
1401 adjust_intervals_for_deletion (buffer, start, length)
1402 struct buffer *buffer;
1403 int start, length;
1405 register int left_to_delete = length;
1406 register INTERVAL tree = BUF_INTERVALS (buffer);
1407 Lisp_Object parent;
1408 int offset;
1410 GET_INTERVAL_OBJECT (parent, tree);
1411 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1413 if (NULL_INTERVAL_P (tree))
1414 return;
1416 if (start > offset + TOTAL_LENGTH (tree)
1417 || start + length > offset + TOTAL_LENGTH (tree))
1418 abort ();
1420 if (length == TOTAL_LENGTH (tree))
1422 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1423 return;
1426 if (ONLY_INTERVAL_P (tree))
1428 tree->total_length -= length;
1429 CHECK_TOTAL_LENGTH (tree);
1430 return;
1433 if (start > offset + TOTAL_LENGTH (tree))
1434 start = offset + TOTAL_LENGTH (tree);
1435 while (left_to_delete > 0)
1437 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1438 left_to_delete);
1439 tree = BUF_INTERVALS (buffer);
1440 if (left_to_delete == tree->total_length)
1442 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1443 return;
1448 /* Make the adjustments necessary to the interval tree of BUFFER to
1449 represent an addition or deletion of LENGTH characters starting
1450 at position START. Addition or deletion is indicated by the sign
1451 of LENGTH. */
1453 INLINE void
1454 offset_intervals (buffer, start, length)
1455 struct buffer *buffer;
1456 int start, length;
1458 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1459 return;
1461 if (length > 0)
1462 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1463 else
1464 adjust_intervals_for_deletion (buffer, start, -length);
1467 /* Merge interval I with its lexicographic successor. The resulting
1468 interval is returned, and has the properties of the original
1469 successor. The properties of I are lost. I is removed from the
1470 interval tree.
1472 IMPORTANT:
1473 The caller must verify that this is not the last (rightmost)
1474 interval. */
1476 INTERVAL
1477 merge_interval_right (i)
1478 register INTERVAL i;
1480 register int absorb = LENGTH (i);
1481 register INTERVAL successor;
1483 /* Zero out this interval. */
1484 i->total_length -= absorb;
1485 CHECK_TOTAL_LENGTH (i);
1487 /* Find the succeeding interval. */
1488 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1489 as we descend. */
1491 successor = i->right;
1492 while (! NULL_LEFT_CHILD (successor))
1494 successor->total_length += absorb;
1495 CHECK_TOTAL_LENGTH (successor);
1496 successor = successor->left;
1499 successor->total_length += absorb;
1500 CHECK_TOTAL_LENGTH (successor);
1501 delete_interval (i);
1502 return successor;
1505 successor = i;
1506 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1507 we ascend. */
1509 if (AM_LEFT_CHILD (successor))
1511 successor = INTERVAL_PARENT (successor);
1512 delete_interval (i);
1513 return successor;
1516 successor = INTERVAL_PARENT (successor);
1517 successor->total_length -= absorb;
1518 CHECK_TOTAL_LENGTH (successor);
1521 /* This must be the rightmost or last interval and cannot
1522 be merged right. The caller should have known. */
1523 abort ();
1526 /* Merge interval I with its lexicographic predecessor. The resulting
1527 interval is returned, and has the properties of the original predecessor.
1528 The properties of I are lost. Interval node I is removed from the tree.
1530 IMPORTANT:
1531 The caller must verify that this is not the first (leftmost) interval. */
1533 INTERVAL
1534 merge_interval_left (i)
1535 register INTERVAL i;
1537 register int absorb = LENGTH (i);
1538 register INTERVAL predecessor;
1540 /* Zero out this interval. */
1541 i->total_length -= absorb;
1542 CHECK_TOTAL_LENGTH (i);
1544 /* Find the preceding interval. */
1545 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1546 adding ABSORB as we go. */
1548 predecessor = i->left;
1549 while (! NULL_RIGHT_CHILD (predecessor))
1551 predecessor->total_length += absorb;
1552 CHECK_TOTAL_LENGTH (predecessor);
1553 predecessor = predecessor->right;
1556 predecessor->total_length += absorb;
1557 CHECK_TOTAL_LENGTH (predecessor);
1558 delete_interval (i);
1559 return predecessor;
1562 predecessor = i;
1563 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1564 subtracting ABSORB. */
1566 if (AM_RIGHT_CHILD (predecessor))
1568 predecessor = INTERVAL_PARENT (predecessor);
1569 delete_interval (i);
1570 return predecessor;
1573 predecessor = INTERVAL_PARENT (predecessor);
1574 predecessor->total_length -= absorb;
1575 CHECK_TOTAL_LENGTH (predecessor);
1578 /* This must be the leftmost or first interval and cannot
1579 be merged left. The caller should have known. */
1580 abort ();
1583 /* Make an exact copy of interval tree SOURCE which descends from
1584 PARENT. This is done by recursing through SOURCE, copying
1585 the current interval and its properties, and then adjusting
1586 the pointers of the copy. */
1588 static INTERVAL
1589 reproduce_tree (source, parent)
1590 INTERVAL source, parent;
1592 register INTERVAL t = make_interval ();
1594 bcopy (source, t, INTERVAL_SIZE);
1595 copy_properties (source, t);
1596 SET_INTERVAL_PARENT (t, parent);
1597 if (! NULL_LEFT_CHILD (source))
1598 t->left = reproduce_tree (source->left, t);
1599 if (! NULL_RIGHT_CHILD (source))
1600 t->right = reproduce_tree (source->right, t);
1602 return t;
1605 static INTERVAL
1606 reproduce_tree_obj (source, parent)
1607 INTERVAL source;
1608 Lisp_Object parent;
1610 register INTERVAL t = make_interval ();
1612 bcopy (source, t, INTERVAL_SIZE);
1613 copy_properties (source, t);
1614 SET_INTERVAL_OBJECT (t, parent);
1615 if (! NULL_LEFT_CHILD (source))
1616 t->left = reproduce_tree (source->left, t);
1617 if (! NULL_RIGHT_CHILD (source))
1618 t->right = reproduce_tree (source->right, t);
1620 return t;
1623 #if 0
1624 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1626 /* Make a new interval of length LENGTH starting at START in the
1627 group of intervals INTERVALS, which is actually an interval tree.
1628 Returns the new interval.
1630 Generate an error if the new positions would overlap an existing
1631 interval. */
1633 static INTERVAL
1634 make_new_interval (intervals, start, length)
1635 INTERVAL intervals;
1636 int start, length;
1638 INTERVAL slot;
1640 slot = find_interval (intervals, start);
1641 if (start + length > slot->position + LENGTH (slot))
1642 error ("Interval would overlap");
1644 if (start == slot->position && length == LENGTH (slot))
1645 return slot;
1647 if (slot->position == start)
1649 /* New right node. */
1650 split_interval_right (slot, length);
1651 return slot;
1654 if (slot->position + LENGTH (slot) == start + length)
1656 /* New left node. */
1657 split_interval_left (slot, LENGTH (slot) - length);
1658 return slot;
1661 /* Convert interval SLOT into three intervals. */
1662 split_interval_left (slot, start - slot->position);
1663 split_interval_right (slot, length);
1664 return slot;
1666 #endif
1668 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1669 LENGTH is the length of the text in SOURCE.
1671 The `position' field of the SOURCE intervals is assumed to be
1672 consistent with its parent; therefore, SOURCE must be an
1673 interval tree made with copy_interval or must be the whole
1674 tree of a buffer or a string.
1676 This is used in insdel.c when inserting Lisp_Strings into the
1677 buffer. The text corresponding to SOURCE is already in the buffer
1678 when this is called. The intervals of new tree are a copy of those
1679 belonging to the string being inserted; intervals are never
1680 shared.
1682 If the inserted text had no intervals associated, and we don't
1683 want to inherit the surrounding text's properties, this function
1684 simply returns -- offset_intervals should handle placing the
1685 text in the correct interval, depending on the sticky bits.
1687 If the inserted text had properties (intervals), then there are two
1688 cases -- either insertion happened in the middle of some interval,
1689 or between two intervals.
1691 If the text goes into the middle of an interval, then new
1692 intervals are created in the middle with only the properties of
1693 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1694 which case the new text has the union of its properties and those
1695 of the text into which it was inserted.
1697 If the text goes between two intervals, then if neither interval
1698 had its appropriate sticky property set (front_sticky, rear_sticky),
1699 the new text has only its properties. If one of the sticky properties
1700 is set, then the new text "sticks" to that region and its properties
1701 depend on merging as above. If both the preceding and succeeding
1702 intervals to the new text are "sticky", then the new text retains
1703 only its properties, as if neither sticky property were set. Perhaps
1704 we should consider merging all three sets of properties onto the new
1705 text... */
1707 void
1708 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1709 INTERVAL source;
1710 int position, length;
1711 struct buffer *buffer;
1712 int inherit;
1714 register INTERVAL under, over, this, prev;
1715 register INTERVAL tree;
1716 int over_used;
1718 tree = BUF_INTERVALS (buffer);
1720 /* If the new text has no properties, then with inheritance it
1721 becomes part of whatever interval it was inserted into.
1722 To prevent inheritance, we must clear out the properties
1723 of the newly inserted text. */
1724 if (NULL_INTERVAL_P (source))
1726 Lisp_Object buf;
1727 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1729 XSETBUFFER (buf, buffer);
1730 set_text_properties_1 (make_number (position),
1731 make_number (position + length),
1732 Qnil, buf, 0);
1734 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1735 /* Shouldn't be necessary. -stef */
1736 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1737 return;
1740 if (NULL_INTERVAL_P (tree))
1742 /* The inserted text constitutes the whole buffer, so
1743 simply copy over the interval structure. */
1744 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1746 Lisp_Object buf;
1747 XSETBUFFER (buf, buffer);
1748 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1749 BUF_INTERVALS (buffer)->position = BEG;
1750 BUF_INTERVALS (buffer)->up_obj = 1;
1752 /* Explicitly free the old tree here? */
1754 return;
1757 /* Create an interval tree in which to place a copy
1758 of the intervals of the inserted string. */
1760 Lisp_Object buf;
1761 XSETBUFFER (buf, buffer);
1762 tree = create_root_interval (buf);
1765 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1766 /* If the buffer contains only the new string, but
1767 there was already some interval tree there, then it may be
1768 some zero length intervals. Eventually, do something clever
1769 about inserting properly. For now, just waste the old intervals. */
1771 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1772 BUF_INTERVALS (buffer)->position = BEG;
1773 BUF_INTERVALS (buffer)->up_obj = 1;
1774 /* Explicitly free the old tree here. */
1776 return;
1778 /* Paranoia -- the text has already been added, so this buffer
1779 should be of non-zero length. */
1780 else if (TOTAL_LENGTH (tree) == 0)
1781 abort ();
1783 this = under = find_interval (tree, position);
1784 if (NULL_INTERVAL_P (under)) /* Paranoia */
1785 abort ();
1786 over = find_interval (source, interval_start_pos (source));
1788 /* Here for insertion in the middle of an interval.
1789 Split off an equivalent interval to the right,
1790 then don't bother with it any more. */
1792 if (position > under->position)
1794 INTERVAL end_unchanged
1795 = split_interval_left (this, position - under->position);
1796 copy_properties (under, end_unchanged);
1797 under->position = position;
1799 else
1801 /* This call may have some effect because previous_interval may
1802 update `position' fields of intervals. Thus, don't ignore it
1803 for the moment. Someone please tell me the truth (K.Handa). */
1804 prev = previous_interval (under);
1805 #if 0
1806 /* But, this code surely has no effect. And, anyway,
1807 END_NONSTICKY_P is unreliable now. */
1808 if (prev && !END_NONSTICKY_P (prev))
1809 prev = 0;
1810 #endif /* 0 */
1813 /* Insertion is now at beginning of UNDER. */
1815 /* The inserted text "sticks" to the interval `under',
1816 which means it gets those properties.
1817 The properties of under are the result of
1818 adjust_intervals_for_insertion, so stickiness has
1819 already been taken care of. */
1821 /* OVER is the interval we are copying from next.
1822 OVER_USED says how many characters' worth of OVER
1823 have already been copied into target intervals.
1824 UNDER is the next interval in the target. */
1825 over_used = 0;
1826 while (! NULL_INTERVAL_P (over))
1828 /* If UNDER is longer than OVER, split it. */
1829 if (LENGTH (over) - over_used < LENGTH (under))
1831 this = split_interval_left (under, LENGTH (over) - over_used);
1832 copy_properties (under, this);
1834 else
1835 this = under;
1837 /* THIS is now the interval to copy or merge into.
1838 OVER covers all of it. */
1839 if (inherit)
1840 merge_properties (over, this);
1841 else
1842 copy_properties (over, this);
1844 /* If THIS and OVER end at the same place,
1845 advance OVER to a new source interval. */
1846 if (LENGTH (this) == LENGTH (over) - over_used)
1848 over = next_interval (over);
1849 over_used = 0;
1851 else
1852 /* Otherwise just record that more of OVER has been used. */
1853 over_used += LENGTH (this);
1855 /* Always advance to a new target interval. */
1856 under = next_interval (this);
1859 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1860 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1861 return;
1864 /* Get the value of property PROP from PLIST,
1865 which is the plist of an interval.
1866 We check for direct properties, for categories with property PROP,
1867 and for PROP appearing on the default-text-properties list. */
1869 Lisp_Object
1870 textget (plist, prop)
1871 Lisp_Object plist;
1872 register Lisp_Object prop;
1874 return lookup_char_property (plist, prop, 1);
1877 Lisp_Object
1878 lookup_char_property (plist, prop, textprop)
1879 Lisp_Object plist;
1880 register Lisp_Object prop;
1881 int textprop;
1883 register Lisp_Object tail, fallback = Qnil;
1885 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1887 register Lisp_Object tem;
1888 tem = XCAR (tail);
1889 if (EQ (prop, tem))
1890 return Fcar (XCDR (tail));
1891 if (EQ (tem, Qcategory))
1893 tem = Fcar (XCDR (tail));
1894 if (SYMBOLP (tem))
1895 fallback = Fget (tem, prop);
1899 if (! NILP (fallback))
1900 return fallback;
1901 /* Check for alternative properties */
1902 tail = Fassq (prop, Vchar_property_alias_alist);
1903 if (! NILP (tail))
1905 tail = XCDR (tail);
1906 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1907 fallback = Fplist_get (plist, XCAR (tail));
1910 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1911 fallback = Fplist_get (Vdefault_text_properties, prop);
1912 return fallback;
1916 /* Set point "temporarily", without checking any text properties. */
1918 INLINE void
1919 temp_set_point (buffer, charpos)
1920 struct buffer *buffer;
1921 int charpos;
1923 temp_set_point_both (buffer, charpos,
1924 buf_charpos_to_bytepos (buffer, charpos));
1927 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1928 byte position BYTEPOS. */
1930 INLINE void
1931 temp_set_point_both (buffer, charpos, bytepos)
1932 int charpos, bytepos;
1933 struct buffer *buffer;
1935 /* In a single-byte buffer, the two positions must be equal. */
1936 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1937 && charpos != bytepos)
1938 abort ();
1940 if (charpos > bytepos)
1941 abort ();
1943 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1944 abort ();
1946 BUF_PT_BYTE (buffer) = bytepos;
1947 BUF_PT (buffer) = charpos;
1950 /* Set point in BUFFER to CHARPOS. If the target position is
1951 before an intangible character, move to an ok place. */
1953 void
1954 set_point (buffer, charpos)
1955 register struct buffer *buffer;
1956 register int charpos;
1958 set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
1961 /* If there's an invisible character at position POS + TEST_OFFS in the
1962 current buffer, and the invisible property has a `stickiness' such that
1963 inserting a character at position POS would inherit the property it,
1964 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1965 then intangibility is required as well as invisibleness.
1967 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1969 Note that `stickiness' is determined by overlay marker insertion types,
1970 if the invisible property comes from an overlay. */
1972 static int
1973 adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1974 int pos, test_offs, adj, test_intang;
1976 Lisp_Object invis_propval, invis_overlay;
1977 Lisp_Object test_pos;
1979 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1980 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1981 return pos;
1983 test_pos = make_number (pos + test_offs);
1985 invis_propval
1986 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1987 &invis_overlay);
1989 if ((!test_intang
1990 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1991 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1992 /* This next test is true if the invisible property has a stickiness
1993 such that an insertion at POS would inherit it. */
1994 && (NILP (invis_overlay)
1995 /* Invisible property is from a text-property. */
1996 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1997 == (test_offs == 0 ? 1 : -1))
1998 /* Invisible property is from an overlay. */
1999 : (test_offs == 0
2000 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
2001 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
2002 pos += adj;
2004 return pos;
2007 /* Set point in BUFFER to CHARPOS, which corresponds to byte
2008 position BYTEPOS. If the target position is
2009 before an intangible character, move to an ok place. */
2011 void
2012 set_point_both (buffer, charpos, bytepos)
2013 register struct buffer *buffer;
2014 register int charpos, bytepos;
2016 register INTERVAL to, from, toprev, fromprev;
2017 int buffer_point;
2018 int old_position = BUF_PT (buffer);
2019 int backwards = (charpos < old_position ? 1 : 0);
2020 int have_overlays;
2021 int original_position;
2023 buffer->point_before_scroll = Qnil;
2025 if (charpos == BUF_PT (buffer))
2026 return;
2028 /* In a single-byte buffer, the two positions must be equal. */
2029 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
2030 && charpos != bytepos)
2031 abort ();
2033 /* Check this now, before checking if the buffer has any intervals.
2034 That way, we can catch conditions which break this sanity check
2035 whether or not there are intervals in the buffer. */
2036 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
2037 abort ();
2039 have_overlays = (buffer->overlays_before || buffer->overlays_after);
2041 /* If we have no text properties and overlays,
2042 then we can do it quickly. */
2043 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) && ! have_overlays)
2045 temp_set_point_both (buffer, charpos, bytepos);
2046 return;
2049 /* Set TO to the interval containing the char after CHARPOS,
2050 and TOPREV to the interval containing the char before CHARPOS.
2051 Either one may be null. They may be equal. */
2052 to = find_interval (BUF_INTERVALS (buffer), charpos);
2053 if (charpos == BUF_BEGV (buffer))
2054 toprev = 0;
2055 else if (to && to->position == charpos)
2056 toprev = previous_interval (to);
2057 else
2058 toprev = to;
2060 buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
2061 ? BUF_ZV (buffer) - 1
2062 : BUF_PT (buffer));
2064 /* Set FROM to the interval containing the char after PT,
2065 and FROMPREV to the interval containing the char before PT.
2066 Either one may be null. They may be equal. */
2067 /* We could cache this and save time. */
2068 from = find_interval (BUF_INTERVALS (buffer), buffer_point);
2069 if (buffer_point == BUF_BEGV (buffer))
2070 fromprev = 0;
2071 else if (from && from->position == BUF_PT (buffer))
2072 fromprev = previous_interval (from);
2073 else if (buffer_point != BUF_PT (buffer))
2074 fromprev = from, from = 0;
2075 else
2076 fromprev = from;
2078 /* Moving within an interval. */
2079 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2080 && ! have_overlays)
2082 temp_set_point_both (buffer, charpos, bytepos);
2083 return;
2086 original_position = charpos;
2088 /* If the new position is between two intangible characters
2089 with the same intangible property value,
2090 move forward or backward until a change in that property. */
2091 if (NILP (Vinhibit_point_motion_hooks)
2092 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2093 || have_overlays)
2094 /* Intangibility never stops us from positioning at the beginning
2095 or end of the buffer, so don't bother checking in that case. */
2096 && charpos != BEGV && charpos != ZV)
2098 Lisp_Object pos;
2099 Lisp_Object intangible_propval;
2101 if (backwards)
2103 /* If the preceding character is both intangible and invisible,
2104 and the invisible property is `rear-sticky', perturb it so
2105 that the search starts one character earlier -- this ensures
2106 that point can never move to the end of an invisible/
2107 intangible/rear-sticky region. */
2108 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2110 XSETINT (pos, charpos);
2112 /* If following char is intangible,
2113 skip back over all chars with matching intangible property. */
2115 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2117 if (! NILP (intangible_propval))
2119 while (XINT (pos) > BUF_BEGV (buffer)
2120 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2121 Qintangible, Qnil),
2122 intangible_propval))
2123 pos = Fprevious_char_property_change (pos, Qnil);
2125 /* Set CHARPOS from POS, and if the final intangible character
2126 that we skipped over is also invisible, and the invisible
2127 property is `front-sticky', perturb it to be one character
2128 earlier -- this ensures that point can never move to the
2129 beginning of an invisible/intangible/front-sticky region. */
2130 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2133 else
2135 /* If the following character is both intangible and invisible,
2136 and the invisible property is `front-sticky', perturb it so
2137 that the search starts one character later -- this ensures
2138 that point can never move to the beginning of an
2139 invisible/intangible/front-sticky region. */
2140 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2142 XSETINT (pos, charpos);
2144 /* If preceding char is intangible,
2145 skip forward over all chars with matching intangible property. */
2147 intangible_propval = Fget_char_property (make_number (charpos - 1),
2148 Qintangible, Qnil);
2150 if (! NILP (intangible_propval))
2152 while (XINT (pos) < BUF_ZV (buffer)
2153 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2154 intangible_propval))
2155 pos = Fnext_char_property_change (pos, Qnil);
2157 /* Set CHARPOS from POS, and if the final intangible character
2158 that we skipped over is also invisible, and the invisible
2159 property is `rear-sticky', perturb it to be one character
2160 later -- this ensures that point can never move to the
2161 end of an invisible/intangible/rear-sticky region. */
2162 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2166 bytepos = buf_charpos_to_bytepos (buffer, charpos);
2169 if (charpos != original_position)
2171 /* Set TO to the interval containing the char after CHARPOS,
2172 and TOPREV to the interval containing the char before CHARPOS.
2173 Either one may be null. They may be equal. */
2174 to = find_interval (BUF_INTERVALS (buffer), charpos);
2175 if (charpos == BUF_BEGV (buffer))
2176 toprev = 0;
2177 else if (to && to->position == charpos)
2178 toprev = previous_interval (to);
2179 else
2180 toprev = to;
2183 /* Here TO is the interval after the stopping point
2184 and TOPREV is the interval before the stopping point.
2185 One or the other may be null. */
2187 temp_set_point_both (buffer, charpos, bytepos);
2189 /* We run point-left and point-entered hooks here, iff the
2190 two intervals are not equivalent. These hooks take
2191 (old_point, new_point) as arguments. */
2192 if (NILP (Vinhibit_point_motion_hooks)
2193 && (! intervals_equal (from, to)
2194 || ! intervals_equal (fromprev, toprev)))
2196 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2198 if (fromprev)
2199 leave_after = textget (fromprev->plist, Qpoint_left);
2200 else
2201 leave_after = Qnil;
2202 if (from)
2203 leave_before = textget (from->plist, Qpoint_left);
2204 else
2205 leave_before = Qnil;
2207 if (toprev)
2208 enter_after = textget (toprev->plist, Qpoint_entered);
2209 else
2210 enter_after = Qnil;
2211 if (to)
2212 enter_before = textget (to->plist, Qpoint_entered);
2213 else
2214 enter_before = Qnil;
2216 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2217 call2 (leave_before, make_number (old_position),
2218 make_number (charpos));
2219 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2220 call2 (leave_after, make_number (old_position),
2221 make_number (charpos));
2223 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2224 call2 (enter_before, make_number (old_position),
2225 make_number (charpos));
2226 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2227 call2 (enter_after, make_number (old_position),
2228 make_number (charpos));
2232 /* Move point to POSITION, unless POSITION is inside an intangible
2233 segment that reaches all the way to point. */
2235 void
2236 move_if_not_intangible (position)
2237 int position;
2239 Lisp_Object pos;
2240 Lisp_Object intangible_propval;
2242 XSETINT (pos, position);
2244 if (! NILP (Vinhibit_point_motion_hooks))
2245 /* If intangible is inhibited, always move point to POSITION. */
2247 else if (PT < position && XINT (pos) < ZV)
2249 /* We want to move forward, so check the text before POSITION. */
2251 intangible_propval = Fget_char_property (pos,
2252 Qintangible, Qnil);
2254 /* If following char is intangible,
2255 skip back over all chars with matching intangible property. */
2256 if (! NILP (intangible_propval))
2257 while (XINT (pos) > BEGV
2258 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2259 Qintangible, Qnil),
2260 intangible_propval))
2261 pos = Fprevious_char_property_change (pos, Qnil);
2263 else if (XINT (pos) > BEGV)
2265 /* We want to move backward, so check the text after POSITION. */
2267 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2268 Qintangible, Qnil);
2270 /* If following char is intangible,
2271 skip forward over all chars with matching intangible property. */
2272 if (! NILP (intangible_propval))
2273 while (XINT (pos) < ZV
2274 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2275 intangible_propval))
2276 pos = Fnext_char_property_change (pos, Qnil);
2279 else if (position < BEGV)
2280 position = BEGV;
2281 else if (position > ZV)
2282 position = ZV;
2284 /* If the whole stretch between PT and POSITION isn't intangible,
2285 try moving to POSITION (which means we actually move farther
2286 if POSITION is inside of intangible text). */
2288 if (XINT (pos) != PT)
2289 SET_PT (position);
2292 /* If text at position POS has property PROP, set *VAL to the property
2293 value, *START and *END to the beginning and end of a region that
2294 has the same property, and return 1. Otherwise return 0.
2296 OBJECT is the string or buffer to look for the property in;
2297 nil means the current buffer. */
2300 get_property_and_range (pos, prop, val, start, end, object)
2301 int pos;
2302 Lisp_Object prop, *val;
2303 int *start, *end;
2304 Lisp_Object object;
2306 INTERVAL i, prev, next;
2308 if (NILP (object))
2309 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2310 else if (BUFFERP (object))
2311 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2312 else if (STRINGP (object))
2313 i = find_interval (STRING_INTERVALS (object), pos);
2314 else
2315 abort ();
2317 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2318 return 0;
2319 *val = textget (i->plist, prop);
2320 if (NILP (*val))
2321 return 0;
2323 next = i; /* remember it in advance */
2324 prev = previous_interval (i);
2325 while (! NULL_INTERVAL_P (prev)
2326 && EQ (*val, textget (prev->plist, prop)))
2327 i = prev, prev = previous_interval (prev);
2328 *start = i->position;
2330 next = next_interval (i);
2331 while (! NULL_INTERVAL_P (next)
2332 && EQ (*val, textget (next->plist, prop)))
2333 i = next, next = next_interval (next);
2334 *end = i->position + LENGTH (i);
2336 return 1;
2339 /* Return the proper local keymap TYPE for position POSITION in
2340 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2341 specified by the PROP property, if any. Otherwise, if TYPE is
2342 `local-map' use BUFFER's local map. */
2344 Lisp_Object
2345 get_local_map (position, buffer, type)
2346 register int position;
2347 register struct buffer *buffer;
2348 Lisp_Object type;
2350 Lisp_Object prop, lispy_position, lispy_buffer;
2351 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2353 /* Perhaps we should just change `position' to the limit. */
2354 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
2355 abort ();
2357 /* Ignore narrowing, so that a local map continues to be valid even if
2358 the visible region contains no characters and hence no properties. */
2359 old_begv = BUF_BEGV (buffer);
2360 old_zv = BUF_ZV (buffer);
2361 old_begv_byte = BUF_BEGV_BYTE (buffer);
2362 old_zv_byte = BUF_ZV_BYTE (buffer);
2363 BUF_BEGV (buffer) = BUF_BEG (buffer);
2364 BUF_ZV (buffer) = BUF_Z (buffer);
2365 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2366 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2368 XSETFASTINT (lispy_position, position);
2369 XSETBUFFER (lispy_buffer, buffer);
2370 /* First check if the CHAR has any property. This is because when
2371 we click with the mouse, the mouse pointer is really pointing
2372 to the CHAR after POS. */
2373 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2374 /* If not, look at the POS's properties. This is necessary because when
2375 editing a field with a `local-map' property, we want insertion at the end
2376 to obey the `local-map' property. */
2377 if (NILP (prop))
2378 prop = get_pos_property (lispy_position, type, lispy_buffer);
2380 BUF_BEGV (buffer) = old_begv;
2381 BUF_ZV (buffer) = old_zv;
2382 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2383 BUF_ZV_BYTE (buffer) = old_zv_byte;
2385 /* Use the local map only if it is valid. */
2386 prop = get_keymap (prop, 0, 0);
2387 if (CONSP (prop))
2388 return prop;
2390 if (EQ (type, Qkeymap))
2391 return Qnil;
2392 else
2393 return buffer->keymap;
2396 /* Produce an interval tree reflecting the intervals in
2397 TREE from START to START + LENGTH.
2398 The new interval tree has no parent and has a starting-position of 0. */
2400 INTERVAL
2401 copy_intervals (tree, start, length)
2402 INTERVAL tree;
2403 int start, length;
2405 register INTERVAL i, new, t;
2406 register int got, prevlen;
2408 if (NULL_INTERVAL_P (tree) || length <= 0)
2409 return NULL_INTERVAL;
2411 i = find_interval (tree, start);
2412 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2413 abort ();
2415 /* If there is only one interval and it's the default, return nil. */
2416 if ((start - i->position + 1 + length) < LENGTH (i)
2417 && DEFAULT_INTERVAL_P (i))
2418 return NULL_INTERVAL;
2420 new = make_interval ();
2421 new->position = 0;
2422 got = (LENGTH (i) - (start - i->position));
2423 new->total_length = length;
2424 CHECK_TOTAL_LENGTH (new);
2425 copy_properties (i, new);
2427 t = new;
2428 prevlen = got;
2429 while (got < length)
2431 i = next_interval (i);
2432 t = split_interval_right (t, prevlen);
2433 copy_properties (i, t);
2434 prevlen = LENGTH (i);
2435 got += prevlen;
2438 return balance_an_interval (new);
2441 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2443 INLINE void
2444 copy_intervals_to_string (string, buffer, position, length)
2445 Lisp_Object string;
2446 struct buffer *buffer;
2447 int position, length;
2449 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2450 position, length);
2451 if (NULL_INTERVAL_P (interval_copy))
2452 return;
2454 SET_INTERVAL_OBJECT (interval_copy, string);
2455 STRING_SET_INTERVALS (string, interval_copy);
2458 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2459 Assume they have identical characters. */
2462 compare_string_intervals (s1, s2)
2463 Lisp_Object s1, s2;
2465 INTERVAL i1, i2;
2466 int pos = 0;
2467 int end = SCHARS (s1);
2469 i1 = find_interval (STRING_INTERVALS (s1), 0);
2470 i2 = find_interval (STRING_INTERVALS (s2), 0);
2472 while (pos < end)
2474 /* Determine how far we can go before we reach the end of I1 or I2. */
2475 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2476 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2477 int distance = min (len1, len2);
2479 /* If we ever find a mismatch between the strings,
2480 they differ. */
2481 if (! intervals_equal (i1, i2))
2482 return 0;
2484 /* Advance POS till the end of the shorter interval,
2485 and advance one or both interval pointers for the new position. */
2486 pos += distance;
2487 if (len1 == distance)
2488 i1 = next_interval (i1);
2489 if (len2 == distance)
2490 i2 = next_interval (i2);
2492 return 1;
2495 /* Recursively adjust interval I in the current buffer
2496 for setting enable_multibyte_characters to MULTI_FLAG.
2497 The range of interval I is START ... END in characters,
2498 START_BYTE ... END_BYTE in bytes. */
2500 static void
2501 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2502 INTERVAL i;
2503 int multi_flag;
2504 int start, start_byte, end, end_byte;
2506 /* Fix the length of this interval. */
2507 if (multi_flag)
2508 i->total_length = end - start;
2509 else
2510 i->total_length = end_byte - start_byte;
2511 CHECK_TOTAL_LENGTH (i);
2513 if (TOTAL_LENGTH (i) == 0)
2515 delete_interval (i);
2516 return;
2519 /* Recursively fix the length of the subintervals. */
2520 if (i->left)
2522 int left_end, left_end_byte;
2524 if (multi_flag)
2526 int temp;
2527 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2528 left_end = BYTE_TO_CHAR (left_end_byte);
2530 temp = CHAR_TO_BYTE (left_end);
2532 /* If LEFT_END_BYTE is in the middle of a character,
2533 adjust it and LEFT_END to a char boundary. */
2534 if (left_end_byte > temp)
2536 left_end_byte = temp;
2538 if (left_end_byte < temp)
2540 left_end--;
2541 left_end_byte = CHAR_TO_BYTE (left_end);
2544 else
2546 left_end = start + LEFT_TOTAL_LENGTH (i);
2547 left_end_byte = CHAR_TO_BYTE (left_end);
2550 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2551 left_end, left_end_byte);
2553 if (i->right)
2555 int right_start_byte, right_start;
2557 if (multi_flag)
2559 int temp;
2561 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2562 right_start = BYTE_TO_CHAR (right_start_byte);
2564 /* If RIGHT_START_BYTE is in the middle of a character,
2565 adjust it and RIGHT_START to a char boundary. */
2566 temp = CHAR_TO_BYTE (right_start);
2568 if (right_start_byte < temp)
2570 right_start_byte = temp;
2572 if (right_start_byte > temp)
2574 right_start++;
2575 right_start_byte = CHAR_TO_BYTE (right_start);
2578 else
2580 right_start = end - RIGHT_TOTAL_LENGTH (i);
2581 right_start_byte = CHAR_TO_BYTE (right_start);
2584 set_intervals_multibyte_1 (i->right, multi_flag,
2585 right_start, right_start_byte,
2586 end, end_byte);
2589 /* Rounding to char boundaries can theoretically ake this interval
2590 spurious. If so, delete one child, and copy its property list
2591 to this interval. */
2592 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2594 if ((i)->left)
2596 (i)->plist = (i)->left->plist;
2597 (i)->left->total_length = 0;
2598 delete_interval ((i)->left);
2600 else
2602 (i)->plist = (i)->right->plist;
2603 (i)->right->total_length = 0;
2604 delete_interval ((i)->right);
2609 /* Update the intervals of the current buffer
2610 to fit the contents as multibyte (if MULTI_FLAG is 1)
2611 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2613 void
2614 set_intervals_multibyte (multi_flag)
2615 int multi_flag;
2617 if (BUF_INTERVALS (current_buffer))
2618 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2619 BEG, BEG_BYTE, Z, Z_BYTE);
2622 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2623 (do not change this comment) */