* lisp/emacs-lisp/unsafep.el (unsafep): Handle backquoted forms.
[emacs.git] / src / intervals.c
blobdef63c43cc4f2782f6a7aa4bd26df347f3197808
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009, 2010 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 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* NOTES:
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
36 to GC them.
41 #include <config.h>
42 #include <setjmp.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "buffer.h"
46 #include "puresize.h"
47 #include "keyboard.h"
48 #include "keymap.h"
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
51 universal set. */
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
55 Lisp_Object merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright);
56 static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
57 static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
59 /* Utility functions for intervals. */
62 /* Create the root interval of some object, a buffer or string. */
64 INTERVAL
65 create_root_interval (Lisp_Object parent)
67 INTERVAL new;
69 CHECK_IMPURE (parent);
71 new = make_interval ();
73 if (BUFFERP (parent))
75 new->total_length = (BUF_Z (XBUFFER (parent))
76 - BUF_BEG (XBUFFER (parent)));
77 CHECK_TOTAL_LENGTH (new);
78 BUF_INTERVALS (XBUFFER (parent)) = new;
79 new->position = BEG;
81 else if (STRINGP (parent))
83 new->total_length = SCHARS (parent);
84 CHECK_TOTAL_LENGTH (new);
85 STRING_SET_INTERVALS (parent, new);
86 new->position = 0;
89 SET_INTERVAL_OBJECT (new, parent);
91 return new;
94 /* Make the interval TARGET have exactly the properties of SOURCE */
96 void
97 copy_properties (register INTERVAL source, register INTERVAL target)
99 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
100 return;
102 COPY_INTERVAL_CACHE (source, target);
103 target->plist = Fcopy_sequence (source->plist);
106 /* Merge the properties of interval SOURCE into the properties
107 of interval TARGET. That is to say, each property in SOURCE
108 is added to TARGET if TARGET has no such property as yet. */
110 static void
111 merge_properties (register INTERVAL source, register INTERVAL target)
113 register Lisp_Object o, sym, val;
115 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
116 return;
118 MERGE_INTERVAL_CACHE (source, target);
120 o = source->plist;
121 while (CONSP (o))
123 sym = XCAR (o);
124 o = XCDR (o);
125 CHECK_CONS (o);
127 val = target->plist;
128 while (CONSP (val) && !EQ (XCAR (val), sym))
130 val = XCDR (val);
131 if (!CONSP (val))
132 break;
133 val = XCDR (val);
136 if (NILP (val))
138 val = XCAR (o);
139 target->plist = Fcons (sym, Fcons (val, target->plist));
141 o = XCDR (o);
145 /* Return 1 if the two intervals have the same properties,
146 0 otherwise. */
149 intervals_equal (INTERVAL i0, INTERVAL i1)
151 register Lisp_Object i0_cdr, i0_sym;
152 register Lisp_Object i1_cdr, i1_val;
154 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
155 return 1;
157 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
158 return 0;
160 i0_cdr = i0->plist;
161 i1_cdr = i1->plist;
162 while (CONSP (i0_cdr) && CONSP (i1_cdr))
164 i0_sym = XCAR (i0_cdr);
165 i0_cdr = XCDR (i0_cdr);
166 if (!CONSP (i0_cdr))
167 return 0; /* abort (); */
168 i1_val = i1->plist;
169 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
171 i1_val = XCDR (i1_val);
172 if (!CONSP (i1_val))
173 return 0; /* abort (); */
174 i1_val = XCDR (i1_val);
177 /* i0 has something i1 doesn't. */
178 if (EQ (i1_val, Qnil))
179 return 0;
181 /* i0 and i1 both have sym, but it has different values in each. */
182 if (!CONSP (i1_val)
183 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
184 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
185 return 0;
187 i0_cdr = XCDR (i0_cdr);
189 i1_cdr = XCDR (i1_cdr);
190 if (!CONSP (i1_cdr))
191 return 0; /* abort (); */
192 i1_cdr = XCDR (i1_cdr);
195 /* Lengths of the two plists were equal. */
196 return (NILP (i0_cdr) && NILP (i1_cdr));
200 /* Traverse an interval tree TREE, performing FUNCTION on each node.
201 No guarantee is made about the order of traversal.
202 Pass FUNCTION two args: an interval, and ARG. */
204 void
205 traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
207 /* Minimize stack usage. */
208 while (!NULL_INTERVAL_P (tree))
210 (*function) (tree, arg);
211 if (NULL_INTERVAL_P (tree->right))
212 tree = tree->left;
213 else
215 traverse_intervals_noorder (tree->left, function, arg);
216 tree = tree->right;
221 /* Traverse an interval tree TREE, performing FUNCTION on each node.
222 Pass FUNCTION two args: an interval, and ARG. */
224 void
225 traverse_intervals (INTERVAL tree, EMACS_INT position,
226 void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
228 while (!NULL_INTERVAL_P (tree))
230 traverse_intervals (tree->left, position, function, arg);
231 position += LEFT_TOTAL_LENGTH (tree);
232 tree->position = position;
233 (*function) (tree, arg);
234 position += LENGTH (tree); tree = tree->right;
238 #if 0
240 static int icount;
241 static int idepth;
242 static int zero_length;
244 /* These functions are temporary, for debugging purposes only. */
246 INTERVAL search_interval, found_interval;
248 void
249 check_for_interval (i)
250 register INTERVAL i;
252 if (i == search_interval)
254 found_interval = i;
255 icount++;
259 INTERVAL
260 search_for_interval (i, tree)
261 register INTERVAL i, tree;
263 icount = 0;
264 search_interval = i;
265 found_interval = NULL_INTERVAL;
266 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
267 return found_interval;
270 static void
271 inc_interval_count (i)
272 INTERVAL i;
274 icount++;
275 if (LENGTH (i) == 0)
276 zero_length++;
277 if (depth > idepth)
278 idepth = depth;
282 count_intervals (i)
283 register INTERVAL i;
285 icount = 0;
286 idepth = 0;
287 zero_length = 0;
288 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
290 return icount;
293 static INTERVAL
294 root_interval (interval)
295 INTERVAL interval;
297 register INTERVAL i = interval;
299 while (! ROOT_INTERVAL_P (i))
300 i = INTERVAL_PARENT (i);
302 return i;
304 #endif
306 /* Assuming that a left child exists, perform the following operation:
309 / \ / \
310 B => A
311 / \ / \
315 static INLINE INTERVAL
316 rotate_right (INTERVAL interval)
318 INTERVAL i;
319 INTERVAL B = interval->left;
320 EMACS_INT old_total = interval->total_length;
322 /* Deal with any Parent of A; make it point to B. */
323 if (! ROOT_INTERVAL_P (interval))
325 if (AM_LEFT_CHILD (interval))
326 INTERVAL_PARENT (interval)->left = B;
327 else
328 INTERVAL_PARENT (interval)->right = B;
330 COPY_INTERVAL_PARENT (B, interval);
332 /* Make B the parent of A */
333 i = B->right;
334 B->right = interval;
335 SET_INTERVAL_PARENT (interval, B);
337 /* Make A point to c */
338 interval->left = i;
339 if (! NULL_INTERVAL_P (i))
340 SET_INTERVAL_PARENT (i, interval);
342 /* A's total length is decreased by the length of B and its left child. */
343 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
344 CHECK_TOTAL_LENGTH (interval);
346 /* B must have the same total length of A. */
347 B->total_length = old_total;
348 CHECK_TOTAL_LENGTH (B);
350 return B;
353 /* Assuming that a right child exists, perform the following operation:
356 / \ / \
357 B => A
358 / \ / \
362 static INLINE INTERVAL
363 rotate_left (INTERVAL interval)
365 INTERVAL i;
366 INTERVAL B = interval->right;
367 EMACS_INT old_total = interval->total_length;
369 /* Deal with any parent of A; make it point to B. */
370 if (! ROOT_INTERVAL_P (interval))
372 if (AM_LEFT_CHILD (interval))
373 INTERVAL_PARENT (interval)->left = B;
374 else
375 INTERVAL_PARENT (interval)->right = B;
377 COPY_INTERVAL_PARENT (B, interval);
379 /* Make B the parent of A */
380 i = B->left;
381 B->left = interval;
382 SET_INTERVAL_PARENT (interval, B);
384 /* Make A point to c */
385 interval->right = i;
386 if (! NULL_INTERVAL_P (i))
387 SET_INTERVAL_PARENT (i, interval);
389 /* A's total length is decreased by the length of B and its right child. */
390 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
391 CHECK_TOTAL_LENGTH (interval);
393 /* B must have the same total length of A. */
394 B->total_length = old_total;
395 CHECK_TOTAL_LENGTH (B);
397 return B;
400 /* Balance an interval tree with the assumption that the subtrees
401 themselves are already balanced. */
403 static INTERVAL
404 balance_an_interval (INTERVAL i)
406 register EMACS_INT old_diff, new_diff;
408 while (1)
410 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
411 if (old_diff > 0)
413 /* Since the left child is longer, there must be one. */
414 new_diff = i->total_length - i->left->total_length
415 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
416 if (eabs (new_diff) >= old_diff)
417 break;
418 i = rotate_right (i);
419 balance_an_interval (i->right);
421 else if (old_diff < 0)
423 /* Since the right child is longer, there must be one. */
424 new_diff = i->total_length - i->right->total_length
425 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
426 if (eabs (new_diff) >= -old_diff)
427 break;
428 i = rotate_left (i);
429 balance_an_interval (i->left);
431 else
432 break;
434 return i;
437 /* Balance INTERVAL, potentially stuffing it back into its parent
438 Lisp Object. */
440 static INLINE INTERVAL
441 balance_possible_root_interval (register INTERVAL interval)
443 Lisp_Object parent;
444 int have_parent = 0;
446 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
447 return interval;
449 if (INTERVAL_HAS_OBJECT (interval))
451 have_parent = 1;
452 GET_INTERVAL_OBJECT (parent, interval);
454 interval = balance_an_interval (interval);
456 if (have_parent)
458 if (BUFFERP (parent))
459 BUF_INTERVALS (XBUFFER (parent)) = interval;
460 else if (STRINGP (parent))
461 STRING_SET_INTERVALS (parent, interval);
464 return interval;
467 /* Balance the interval tree TREE. Balancing is by weight
468 (the amount of text). */
470 static INTERVAL
471 balance_intervals_internal (register INTERVAL tree)
473 /* Balance within each side. */
474 if (tree->left)
475 balance_intervals_internal (tree->left);
476 if (tree->right)
477 balance_intervals_internal (tree->right);
478 return balance_an_interval (tree);
481 /* Advertised interface to balance intervals. */
483 INTERVAL
484 balance_intervals (INTERVAL tree)
486 if (tree == NULL_INTERVAL)
487 return NULL_INTERVAL;
489 return balance_intervals_internal (tree);
492 /* Split INTERVAL into two pieces, starting the second piece at
493 character position OFFSET (counting from 0), relative to INTERVAL.
494 INTERVAL becomes the left-hand piece, and the right-hand piece
495 (second, lexicographically) is returned.
497 The size and position fields of the two intervals are set based upon
498 those of the original interval. The property list of the new interval
499 is reset, thus it is up to the caller to do the right thing with the
500 result.
502 Note that this does not change the position of INTERVAL; if it is a root,
503 it is still a root after this operation. */
505 INTERVAL
506 split_interval_right (INTERVAL interval, EMACS_INT offset)
508 INTERVAL new = make_interval ();
509 EMACS_INT position = interval->position;
510 EMACS_INT new_length = LENGTH (interval) - offset;
512 new->position = position + offset;
513 SET_INTERVAL_PARENT (new, interval);
515 if (NULL_RIGHT_CHILD (interval))
517 interval->right = new;
518 new->total_length = new_length;
519 CHECK_TOTAL_LENGTH (new);
521 else
523 /* Insert the new node between INTERVAL and its right child. */
524 new->right = interval->right;
525 SET_INTERVAL_PARENT (interval->right, new);
526 interval->right = new;
527 new->total_length = new_length + new->right->total_length;
528 CHECK_TOTAL_LENGTH (new);
529 balance_an_interval (new);
532 balance_possible_root_interval (interval);
534 return new;
537 /* Split INTERVAL into two pieces, starting the second piece at
538 character position OFFSET (counting from 0), relative to INTERVAL.
539 INTERVAL becomes the right-hand piece, and the left-hand piece
540 (first, lexicographically) is returned.
542 The size and position fields of the two intervals are set based upon
543 those of the original interval. The property list of the new interval
544 is reset, thus it is up to the caller to do the right thing with the
545 result.
547 Note that this does not change the position of INTERVAL; if it is a root,
548 it is still a root after this operation. */
550 INTERVAL
551 split_interval_left (INTERVAL interval, EMACS_INT offset)
553 INTERVAL new = make_interval ();
554 EMACS_INT new_length = offset;
556 new->position = interval->position;
557 interval->position = interval->position + offset;
558 SET_INTERVAL_PARENT (new, interval);
560 if (NULL_LEFT_CHILD (interval))
562 interval->left = new;
563 new->total_length = new_length;
564 CHECK_TOTAL_LENGTH (new);
566 else
568 /* Insert the new node between INTERVAL and its left child. */
569 new->left = interval->left;
570 SET_INTERVAL_PARENT (new->left, new);
571 interval->left = new;
572 new->total_length = new_length + new->left->total_length;
573 CHECK_TOTAL_LENGTH (new);
574 balance_an_interval (new);
577 balance_possible_root_interval (interval);
579 return new;
582 /* Return the proper position for the first character
583 described by the interval tree SOURCE.
584 This is 1 if the parent is a buffer,
585 0 if the parent is a string or if there is no parent.
587 Don't use this function on an interval which is the child
588 of another interval! */
591 interval_start_pos (INTERVAL source)
593 Lisp_Object parent;
595 if (NULL_INTERVAL_P (source))
596 return 0;
598 if (! INTERVAL_HAS_OBJECT (source))
599 return 0;
600 GET_INTERVAL_OBJECT (parent, source);
601 if (BUFFERP (parent))
602 return BUF_BEG (XBUFFER (parent));
603 return 0;
606 /* Find the interval containing text position POSITION in the text
607 represented by the interval tree TREE. POSITION is a buffer
608 position (starting from 1) or a string index (starting from 0).
609 If POSITION is at the end of the buffer or string,
610 return the interval containing the last character.
612 The `position' field, which is a cache of an interval's position,
613 is updated in the interval found. Other functions (e.g., next_interval)
614 will update this cache based on the result of find_interval. */
616 INTERVAL
617 find_interval (register INTERVAL tree, register EMACS_INT position)
619 /* The distance from the left edge of the subtree at TREE
620 to POSITION. */
621 register EMACS_INT relative_position;
623 if (NULL_INTERVAL_P (tree))
624 return NULL_INTERVAL;
626 relative_position = position;
627 if (INTERVAL_HAS_OBJECT (tree))
629 Lisp_Object parent;
630 GET_INTERVAL_OBJECT (parent, tree);
631 if (BUFFERP (parent))
632 relative_position -= BUF_BEG (XBUFFER (parent));
635 if (relative_position > TOTAL_LENGTH (tree))
636 abort (); /* Paranoia */
638 if (!handling_signal)
639 tree = balance_possible_root_interval (tree);
641 while (1)
643 if (relative_position < LEFT_TOTAL_LENGTH (tree))
645 tree = tree->left;
647 else if (! NULL_RIGHT_CHILD (tree)
648 && relative_position >= (TOTAL_LENGTH (tree)
649 - RIGHT_TOTAL_LENGTH (tree)))
651 relative_position -= (TOTAL_LENGTH (tree)
652 - RIGHT_TOTAL_LENGTH (tree));
653 tree = tree->right;
655 else
657 tree->position
658 = (position - relative_position /* left edge of *tree. */
659 + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval. */
661 return tree;
666 /* Find the succeeding interval (lexicographically) to INTERVAL.
667 Sets the `position' field based on that of INTERVAL (see
668 find_interval). */
670 INTERVAL
671 next_interval (register INTERVAL interval)
673 register INTERVAL i = interval;
674 register EMACS_INT next_position;
676 if (NULL_INTERVAL_P (i))
677 return NULL_INTERVAL;
678 next_position = interval->position + LENGTH (interval);
680 if (! NULL_RIGHT_CHILD (i))
682 i = i->right;
683 while (! NULL_LEFT_CHILD (i))
684 i = i->left;
686 i->position = next_position;
687 return i;
690 while (! NULL_PARENT (i))
692 if (AM_LEFT_CHILD (i))
694 i = INTERVAL_PARENT (i);
695 i->position = next_position;
696 return i;
699 i = INTERVAL_PARENT (i);
702 return NULL_INTERVAL;
705 /* Find the preceding interval (lexicographically) to INTERVAL.
706 Sets the `position' field based on that of INTERVAL (see
707 find_interval). */
709 INTERVAL
710 previous_interval (register INTERVAL interval)
712 register INTERVAL i;
714 if (NULL_INTERVAL_P (interval))
715 return NULL_INTERVAL;
717 if (! NULL_LEFT_CHILD (interval))
719 i = interval->left;
720 while (! NULL_RIGHT_CHILD (i))
721 i = i->right;
723 i->position = interval->position - LENGTH (i);
724 return i;
727 i = interval;
728 while (! NULL_PARENT (i))
730 if (AM_RIGHT_CHILD (i))
732 i = INTERVAL_PARENT (i);
734 i->position = interval->position - LENGTH (i);
735 return i;
737 i = INTERVAL_PARENT (i);
740 return NULL_INTERVAL;
743 /* Find the interval containing POS given some non-NULL INTERVAL
744 in the same tree. Note that we need to update interval->position
745 if we go down the tree.
746 To speed up the process, we assume that the ->position of
747 I and all its parents is already uptodate. */
748 INTERVAL
749 update_interval (register INTERVAL i, EMACS_INT pos)
751 if (NULL_INTERVAL_P (i))
752 return NULL_INTERVAL;
754 while (1)
756 if (pos < i->position)
758 /* Move left. */
759 if (pos >= i->position - TOTAL_LENGTH (i->left))
761 i->left->position = i->position - TOTAL_LENGTH (i->left)
762 + LEFT_TOTAL_LENGTH (i->left);
763 i = i->left; /* Move to the left child */
765 else if (NULL_PARENT (i))
766 error ("Point before start of properties");
767 else
768 i = INTERVAL_PARENT (i);
769 continue;
771 else if (pos >= INTERVAL_LAST_POS (i))
773 /* Move right. */
774 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
776 i->right->position = INTERVAL_LAST_POS (i)
777 + LEFT_TOTAL_LENGTH (i->right);
778 i = i->right; /* Move to the right child */
780 else if (NULL_PARENT (i))
781 error ("Point %d after end of properties", pos);
782 else
783 i = INTERVAL_PARENT (i);
784 continue;
786 else
787 return i;
792 #if 0
793 /* Traverse a path down the interval tree TREE to the interval
794 containing POSITION, adjusting all nodes on the path for
795 an addition of LENGTH characters. Insertion between two intervals
796 (i.e., point == i->position, where i is second interval) means
797 text goes into second interval.
799 Modifications are needed to handle the hungry bits -- after simply
800 finding the interval at position (don't add length going down),
801 if it's the beginning of the interval, get the previous interval
802 and check the hungry bits of both. Then add the length going back up
803 to the root. */
805 static INTERVAL
806 adjust_intervals_for_insertion (tree, position, length)
807 INTERVAL tree;
808 int position, length;
810 register int relative_position;
811 register INTERVAL this;
813 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
814 abort ();
816 /* If inserting at point-max of a buffer, that position
817 will be out of range */
818 if (position > TOTAL_LENGTH (tree))
819 position = TOTAL_LENGTH (tree);
820 relative_position = position;
821 this = tree;
823 while (1)
825 if (relative_position <= LEFT_TOTAL_LENGTH (this))
827 this->total_length += length;
828 CHECK_TOTAL_LENGTH (this);
829 this = this->left;
831 else if (relative_position > (TOTAL_LENGTH (this)
832 - RIGHT_TOTAL_LENGTH (this)))
834 relative_position -= (TOTAL_LENGTH (this)
835 - RIGHT_TOTAL_LENGTH (this));
836 this->total_length += length;
837 CHECK_TOTAL_LENGTH (this);
838 this = this->right;
840 else
842 /* If we are to use zero-length intervals as buffer pointers,
843 then this code will have to change. */
844 this->total_length += length;
845 CHECK_TOTAL_LENGTH (this);
846 this->position = LEFT_TOTAL_LENGTH (this)
847 + position - relative_position + 1;
848 return tree;
852 #endif
854 /* Effect an adjustment corresponding to the addition of LENGTH characters
855 of text. Do this by finding the interval containing POSITION in the
856 interval tree TREE, and then adjusting all of its ancestors by adding
857 LENGTH to them.
859 If POSITION is the first character of an interval, meaning that point
860 is actually between the two intervals, make the new text belong to
861 the interval which is "sticky".
863 If both intervals are "sticky", then make them belong to the left-most
864 interval. Another possibility would be to create a new interval for
865 this text, and make it have the merged properties of both ends. */
867 static INTERVAL
868 adjust_intervals_for_insertion (INTERVAL tree,
869 EMACS_INT position, EMACS_INT length)
871 register INTERVAL i;
872 register INTERVAL temp;
873 int eobp = 0;
874 Lisp_Object parent;
875 EMACS_INT offset;
877 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
878 abort ();
880 GET_INTERVAL_OBJECT (parent, tree);
881 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
883 /* If inserting at point-max of a buffer, that position will be out
884 of range. Remember that buffer positions are 1-based. */
885 if (position >= TOTAL_LENGTH (tree) + offset)
887 position = TOTAL_LENGTH (tree) + offset;
888 eobp = 1;
891 i = find_interval (tree, position);
893 /* If in middle of an interval which is not sticky either way,
894 we must not just give its properties to the insertion.
895 So split this interval at the insertion point.
897 Originally, the if condition here was this:
898 (! (position == i->position || eobp)
899 && END_NONSTICKY_P (i)
900 && FRONT_NONSTICKY_P (i))
901 But, these macros are now unreliable because of introduction of
902 Vtext_property_default_nonsticky. So, we always check properties
903 one by one if POSITION is in middle of an interval. */
904 if (! (position == i->position || eobp))
906 Lisp_Object tail;
907 Lisp_Object front, rear;
909 tail = i->plist;
911 /* Properties font-sticky and rear-nonsticky override
912 Vtext_property_default_nonsticky. So, if they are t, we can
913 skip one by one checking of properties. */
914 rear = textget (i->plist, Qrear_nonsticky);
915 if (! CONSP (rear) && ! NILP (rear))
917 /* All properties are nonsticky. We split the interval. */
918 goto check_done;
920 front = textget (i->plist, Qfront_sticky);
921 if (! CONSP (front) && ! NILP (front))
923 /* All properties are sticky. We don't split the interval. */
924 tail = Qnil;
925 goto check_done;
928 /* Does any actual property pose an actual problem? We break
929 the loop if we find a nonsticky property. */
930 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
932 Lisp_Object prop, tmp;
933 prop = XCAR (tail);
935 /* Is this particular property front-sticky? */
936 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
937 continue;
939 /* Is this particular property rear-nonsticky? */
940 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
941 break;
943 /* Is this particular property recorded as sticky or
944 nonsticky in Vtext_property_default_nonsticky? */
945 tmp = Fassq (prop, Vtext_property_default_nonsticky);
946 if (CONSP (tmp))
948 if (NILP (tmp))
949 continue;
950 break;
953 /* By default, a text property is rear-sticky, thus we
954 continue the loop. */
957 check_done:
958 /* If any property is a real problem, split the interval. */
959 if (! NILP (tail))
961 temp = split_interval_right (i, position - i->position);
962 copy_properties (i, temp);
963 i = temp;
967 /* If we are positioned between intervals, check the stickiness of
968 both of them. We have to do this too, if we are at BEG or Z. */
969 if (position == i->position || eobp)
971 register INTERVAL prev;
973 if (position == BEG)
974 prev = 0;
975 else if (eobp)
977 prev = i;
978 i = 0;
980 else
981 prev = previous_interval (i);
983 /* Even if we are positioned between intervals, we default
984 to the left one if it exists. We extend it now and split
985 off a part later, if stickiness demands it. */
986 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
988 temp->total_length += length;
989 CHECK_TOTAL_LENGTH (temp);
990 temp = balance_possible_root_interval (temp);
993 /* If at least one interval has sticky properties,
994 we check the stickiness property by property.
996 Originally, the if condition here was this:
997 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
998 But, these macros are now unreliable because of introduction
999 of Vtext_property_default_nonsticky. So, we always have to
1000 check stickiness of properties one by one. If cache of
1001 stickiness is implemented in the future, we may be able to
1002 use those macros again. */
1003 if (1)
1005 Lisp_Object pleft, pright;
1006 struct interval newi;
1008 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1009 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1010 newi.plist = merge_properties_sticky (pleft, pright);
1012 if (! prev) /* i.e. position == BEG */
1014 if (! intervals_equal (i, &newi))
1016 i = split_interval_left (i, length);
1017 i->plist = newi.plist;
1020 else if (! intervals_equal (prev, &newi))
1022 prev = split_interval_right (prev,
1023 position - prev->position);
1024 prev->plist = newi.plist;
1025 if (! NULL_INTERVAL_P (i)
1026 && intervals_equal (prev, i))
1027 merge_interval_right (prev);
1030 /* We will need to update the cache here later. */
1032 else if (! prev && ! NILP (i->plist))
1034 /* Just split off a new interval at the left.
1035 Since I wasn't front-sticky, the empty plist is ok. */
1036 i = split_interval_left (i, length);
1040 /* Otherwise just extend the interval. */
1041 else
1043 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1045 temp->total_length += length;
1046 CHECK_TOTAL_LENGTH (temp);
1047 temp = balance_possible_root_interval (temp);
1051 return tree;
1054 /* Any property might be front-sticky on the left, rear-sticky on the left,
1055 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1056 can be arranged in a matrix with rows denoting the left conditions and
1057 columns denoting the right conditions:
1058 _ __ _
1059 _ FR FR FR FR
1060 FR__ 0 1 2 3
1061 _FR 4 5 6 7
1062 FR 8 9 A B
1063 FR C D E F
1065 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1066 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1067 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1068 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1069 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1070 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1071 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1072 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1074 We inherit from whoever has a sticky side facing us. If both sides
1075 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1076 non-nil value for the current property. If both sides do, then we take
1077 from the left.
1079 When we inherit a property, we get its stickiness as well as its value.
1080 So, when we merge the above two lists, we expect to get this:
1082 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1083 rear-nonsticky (p6 pa)
1084 p0 L p1 L p2 L p3 L p6 R p7 R
1085 pa R pb R pc L pd L pe L pf L)
1087 The optimizable special cases are:
1088 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1089 left rear-nonsticky = t, right front-sticky = t (inherit right)
1090 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1093 Lisp_Object
1094 merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
1096 register Lisp_Object props, front, rear;
1097 Lisp_Object lfront, lrear, rfront, rrear;
1098 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1099 int use_left, use_right;
1100 int lpresent;
1102 props = Qnil;
1103 front = Qnil;
1104 rear = Qnil;
1105 lfront = textget (pleft, Qfront_sticky);
1106 lrear = textget (pleft, Qrear_nonsticky);
1107 rfront = textget (pright, Qfront_sticky);
1108 rrear = textget (pright, Qrear_nonsticky);
1110 /* Go through each element of PRIGHT. */
1111 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1113 Lisp_Object tmp;
1115 sym = XCAR (tail1);
1117 /* Sticky properties get special treatment. */
1118 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1119 continue;
1121 rval = Fcar (XCDR (tail1));
1122 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1123 if (EQ (sym, XCAR (tail2)))
1124 break;
1126 /* Indicate whether the property is explicitly defined on the left.
1127 (We know it is defined explicitly on the right
1128 because otherwise we don't get here.) */
1129 lpresent = ! NILP (tail2);
1130 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1132 /* Even if lrear or rfront say nothing about the stickiness of
1133 SYM, Vtext_property_default_nonsticky may give default
1134 stickiness to SYM. */
1135 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1136 use_left = (lpresent
1137 && ! (TMEM (sym, lrear)
1138 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1139 use_right = (TMEM (sym, rfront)
1140 || (CONSP (tmp) && NILP (XCDR (tmp))));
1141 if (use_left && use_right)
1143 if (NILP (lval))
1144 use_left = 0;
1145 else if (NILP (rval))
1146 use_right = 0;
1148 if (use_left)
1150 /* We build props as (value sym ...) rather than (sym value ...)
1151 because we plan to nreverse it when we're done. */
1152 props = Fcons (lval, Fcons (sym, props));
1153 if (TMEM (sym, lfront))
1154 front = Fcons (sym, front);
1155 if (TMEM (sym, lrear))
1156 rear = Fcons (sym, rear);
1158 else if (use_right)
1160 props = Fcons (rval, Fcons (sym, props));
1161 if (TMEM (sym, rfront))
1162 front = Fcons (sym, front);
1163 if (TMEM (sym, rrear))
1164 rear = Fcons (sym, rear);
1168 /* Now go through each element of PLEFT. */
1169 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1171 Lisp_Object tmp;
1173 sym = XCAR (tail2);
1175 /* Sticky properties get special treatment. */
1176 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1177 continue;
1179 /* If sym is in PRIGHT, we've already considered it. */
1180 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1181 if (EQ (sym, XCAR (tail1)))
1182 break;
1183 if (! NILP (tail1))
1184 continue;
1186 lval = Fcar (XCDR (tail2));
1188 /* Even if lrear or rfront say nothing about the stickiness of
1189 SYM, Vtext_property_default_nonsticky may give default
1190 stickiness to SYM. */
1191 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1193 /* Since rval is known to be nil in this loop, the test simplifies. */
1194 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1196 props = Fcons (lval, Fcons (sym, props));
1197 if (TMEM (sym, lfront))
1198 front = Fcons (sym, front);
1200 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1202 /* The value is nil, but we still inherit the stickiness
1203 from the right. */
1204 front = Fcons (sym, front);
1205 if (TMEM (sym, rrear))
1206 rear = Fcons (sym, rear);
1209 props = Fnreverse (props);
1210 if (! NILP (rear))
1211 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1213 cat = textget (props, Qcategory);
1214 if (! NILP (front)
1216 /* If we have inherited a front-stick category property that is t,
1217 we don't need to set up a detailed one. */
1218 ! (! NILP (cat) && SYMBOLP (cat)
1219 && EQ (Fget (cat, Qfront_sticky), Qt)))
1220 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1221 return props;
1225 /* Delete a node I from its interval tree by merging its subtrees
1226 into one subtree which is then returned. Caller is responsible for
1227 storing the resulting subtree into its parent. */
1229 static INTERVAL
1230 delete_node (register INTERVAL i)
1232 register INTERVAL migrate, this;
1233 register EMACS_INT migrate_amt;
1235 if (NULL_INTERVAL_P (i->left))
1236 return i->right;
1237 if (NULL_INTERVAL_P (i->right))
1238 return i->left;
1240 migrate = i->left;
1241 migrate_amt = i->left->total_length;
1242 this = i->right;
1243 this->total_length += migrate_amt;
1244 while (! NULL_INTERVAL_P (this->left))
1246 this = this->left;
1247 this->total_length += migrate_amt;
1249 CHECK_TOTAL_LENGTH (this);
1250 this->left = migrate;
1251 SET_INTERVAL_PARENT (migrate, this);
1253 return i->right;
1256 /* Delete interval I from its tree by calling `delete_node'
1257 and properly connecting the resultant subtree.
1259 I is presumed to be empty; that is, no adjustments are made
1260 for the length of I. */
1262 void
1263 delete_interval (register INTERVAL i)
1265 register INTERVAL parent;
1266 EMACS_INT amt = LENGTH (i);
1268 if (amt > 0) /* Only used on zero-length intervals now. */
1269 abort ();
1271 if (ROOT_INTERVAL_P (i))
1273 Lisp_Object owner;
1274 GET_INTERVAL_OBJECT (owner, i);
1275 parent = delete_node (i);
1276 if (! NULL_INTERVAL_P (parent))
1277 SET_INTERVAL_OBJECT (parent, owner);
1279 if (BUFFERP (owner))
1280 BUF_INTERVALS (XBUFFER (owner)) = parent;
1281 else if (STRINGP (owner))
1282 STRING_SET_INTERVALS (owner, parent);
1283 else
1284 abort ();
1286 return;
1289 parent = INTERVAL_PARENT (i);
1290 if (AM_LEFT_CHILD (i))
1292 parent->left = delete_node (i);
1293 if (! NULL_INTERVAL_P (parent->left))
1294 SET_INTERVAL_PARENT (parent->left, parent);
1296 else
1298 parent->right = delete_node (i);
1299 if (! NULL_INTERVAL_P (parent->right))
1300 SET_INTERVAL_PARENT (parent->right, parent);
1304 /* Find the interval in TREE corresponding to the relative position
1305 FROM and delete as much as possible of AMOUNT from that interval.
1306 Return the amount actually deleted, and if the interval was
1307 zeroed-out, delete that interval node from the tree.
1309 Note that FROM is actually origin zero, aka relative to the
1310 leftmost edge of tree. This is appropriate since we call ourselves
1311 recursively on subtrees.
1313 Do this by recursing down TREE to the interval in question, and
1314 deleting the appropriate amount of text. */
1316 static EMACS_INT
1317 interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
1318 register EMACS_INT amount)
1320 register EMACS_INT relative_position = from;
1322 if (NULL_INTERVAL_P (tree))
1323 return 0;
1325 /* Left branch */
1326 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1328 EMACS_INT subtract = interval_deletion_adjustment (tree->left,
1329 relative_position,
1330 amount);
1331 tree->total_length -= subtract;
1332 CHECK_TOTAL_LENGTH (tree);
1333 return subtract;
1335 /* Right branch */
1336 else if (relative_position >= (TOTAL_LENGTH (tree)
1337 - RIGHT_TOTAL_LENGTH (tree)))
1339 EMACS_INT subtract;
1341 relative_position -= (tree->total_length
1342 - RIGHT_TOTAL_LENGTH (tree));
1343 subtract = interval_deletion_adjustment (tree->right,
1344 relative_position,
1345 amount);
1346 tree->total_length -= subtract;
1347 CHECK_TOTAL_LENGTH (tree);
1348 return subtract;
1350 /* Here -- this node. */
1351 else
1353 /* How much can we delete from this interval? */
1354 EMACS_INT my_amount = ((tree->total_length
1355 - RIGHT_TOTAL_LENGTH (tree))
1356 - relative_position);
1358 if (amount > my_amount)
1359 amount = my_amount;
1361 tree->total_length -= amount;
1362 CHECK_TOTAL_LENGTH (tree);
1363 if (LENGTH (tree) == 0)
1364 delete_interval (tree);
1366 return amount;
1369 /* Never reach here. */
1372 /* Effect the adjustments necessary to the interval tree of BUFFER to
1373 correspond to the deletion of LENGTH characters from that buffer
1374 text. The deletion is effected at position START (which is a
1375 buffer position, i.e. origin 1). */
1377 static void
1378 adjust_intervals_for_deletion (struct buffer *buffer,
1379 EMACS_INT start, EMACS_INT length)
1381 register EMACS_INT left_to_delete = length;
1382 register INTERVAL tree = BUF_INTERVALS (buffer);
1383 Lisp_Object parent;
1384 EMACS_INT offset;
1386 GET_INTERVAL_OBJECT (parent, tree);
1387 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1389 if (NULL_INTERVAL_P (tree))
1390 return;
1392 if (start > offset + TOTAL_LENGTH (tree)
1393 || start + length > offset + TOTAL_LENGTH (tree))
1394 abort ();
1396 if (length == TOTAL_LENGTH (tree))
1398 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1399 return;
1402 if (ONLY_INTERVAL_P (tree))
1404 tree->total_length -= length;
1405 CHECK_TOTAL_LENGTH (tree);
1406 return;
1409 if (start > offset + TOTAL_LENGTH (tree))
1410 start = offset + TOTAL_LENGTH (tree);
1411 while (left_to_delete > 0)
1413 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1414 left_to_delete);
1415 tree = BUF_INTERVALS (buffer);
1416 if (left_to_delete == tree->total_length)
1418 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1419 return;
1424 /* Make the adjustments necessary to the interval tree of BUFFER to
1425 represent an addition or deletion of LENGTH characters starting
1426 at position START. Addition or deletion is indicated by the sign
1427 of LENGTH. */
1429 INLINE void
1430 offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
1432 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1433 return;
1435 if (length > 0)
1436 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1437 else
1438 adjust_intervals_for_deletion (buffer, start, -length);
1441 /* Merge interval I with its lexicographic successor. The resulting
1442 interval is returned, and has the properties of the original
1443 successor. The properties of I are lost. I is removed from the
1444 interval tree.
1446 IMPORTANT:
1447 The caller must verify that this is not the last (rightmost)
1448 interval. */
1450 INTERVAL
1451 merge_interval_right (register INTERVAL i)
1453 register EMACS_INT absorb = LENGTH (i);
1454 register INTERVAL successor;
1456 /* Zero out this interval. */
1457 i->total_length -= absorb;
1458 CHECK_TOTAL_LENGTH (i);
1460 /* Find the succeeding interval. */
1461 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1462 as we descend. */
1464 successor = i->right;
1465 while (! NULL_LEFT_CHILD (successor))
1467 successor->total_length += absorb;
1468 CHECK_TOTAL_LENGTH (successor);
1469 successor = successor->left;
1472 successor->total_length += absorb;
1473 CHECK_TOTAL_LENGTH (successor);
1474 delete_interval (i);
1475 return successor;
1478 successor = i;
1479 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1480 we ascend. */
1482 if (AM_LEFT_CHILD (successor))
1484 successor = INTERVAL_PARENT (successor);
1485 delete_interval (i);
1486 return successor;
1489 successor = INTERVAL_PARENT (successor);
1490 successor->total_length -= absorb;
1491 CHECK_TOTAL_LENGTH (successor);
1494 /* This must be the rightmost or last interval and cannot
1495 be merged right. The caller should have known. */
1496 abort ();
1499 /* Merge interval I with its lexicographic predecessor. The resulting
1500 interval is returned, and has the properties of the original predecessor.
1501 The properties of I are lost. Interval node I is removed from the tree.
1503 IMPORTANT:
1504 The caller must verify that this is not the first (leftmost) interval. */
1506 INTERVAL
1507 merge_interval_left (register INTERVAL i)
1509 register EMACS_INT absorb = LENGTH (i);
1510 register INTERVAL predecessor;
1512 /* Zero out this interval. */
1513 i->total_length -= absorb;
1514 CHECK_TOTAL_LENGTH (i);
1516 /* Find the preceding interval. */
1517 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1518 adding ABSORB as we go. */
1520 predecessor = i->left;
1521 while (! NULL_RIGHT_CHILD (predecessor))
1523 predecessor->total_length += absorb;
1524 CHECK_TOTAL_LENGTH (predecessor);
1525 predecessor = predecessor->right;
1528 predecessor->total_length += absorb;
1529 CHECK_TOTAL_LENGTH (predecessor);
1530 delete_interval (i);
1531 return predecessor;
1534 predecessor = i;
1535 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1536 subtracting ABSORB. */
1538 if (AM_RIGHT_CHILD (predecessor))
1540 predecessor = INTERVAL_PARENT (predecessor);
1541 delete_interval (i);
1542 return predecessor;
1545 predecessor = INTERVAL_PARENT (predecessor);
1546 predecessor->total_length -= absorb;
1547 CHECK_TOTAL_LENGTH (predecessor);
1550 /* This must be the leftmost or first interval and cannot
1551 be merged left. The caller should have known. */
1552 abort ();
1555 /* Make an exact copy of interval tree SOURCE which descends from
1556 PARENT. This is done by recursing through SOURCE, copying
1557 the current interval and its properties, and then adjusting
1558 the pointers of the copy. */
1560 static INTERVAL
1561 reproduce_tree (INTERVAL source, INTERVAL parent)
1563 register INTERVAL t = make_interval ();
1565 memcpy (t, source, INTERVAL_SIZE);
1566 copy_properties (source, t);
1567 SET_INTERVAL_PARENT (t, parent);
1568 if (! NULL_LEFT_CHILD (source))
1569 t->left = reproduce_tree (source->left, t);
1570 if (! NULL_RIGHT_CHILD (source))
1571 t->right = reproduce_tree (source->right, t);
1573 return t;
1576 static INTERVAL
1577 reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
1579 register INTERVAL t = make_interval ();
1581 memcpy (t, source, INTERVAL_SIZE);
1582 copy_properties (source, t);
1583 SET_INTERVAL_OBJECT (t, parent);
1584 if (! NULL_LEFT_CHILD (source))
1585 t->left = reproduce_tree (source->left, t);
1586 if (! NULL_RIGHT_CHILD (source))
1587 t->right = reproduce_tree (source->right, t);
1589 return t;
1592 #if 0
1593 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1595 /* Make a new interval of length LENGTH starting at START in the
1596 group of intervals INTERVALS, which is actually an interval tree.
1597 Returns the new interval.
1599 Generate an error if the new positions would overlap an existing
1600 interval. */
1602 static INTERVAL
1603 make_new_interval (intervals, start, length)
1604 INTERVAL intervals;
1605 EMACS_INT start, length;
1607 INTERVAL slot;
1609 slot = find_interval (intervals, start);
1610 if (start + length > slot->position + LENGTH (slot))
1611 error ("Interval would overlap");
1613 if (start == slot->position && length == LENGTH (slot))
1614 return slot;
1616 if (slot->position == start)
1618 /* New right node. */
1619 split_interval_right (slot, length);
1620 return slot;
1623 if (slot->position + LENGTH (slot) == start + length)
1625 /* New left node. */
1626 split_interval_left (slot, LENGTH (slot) - length);
1627 return slot;
1630 /* Convert interval SLOT into three intervals. */
1631 split_interval_left (slot, start - slot->position);
1632 split_interval_right (slot, length);
1633 return slot;
1635 #endif
1637 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1638 LENGTH is the length of the text in SOURCE.
1640 The `position' field of the SOURCE intervals is assumed to be
1641 consistent with its parent; therefore, SOURCE must be an
1642 interval tree made with copy_interval or must be the whole
1643 tree of a buffer or a string.
1645 This is used in insdel.c when inserting Lisp_Strings into the
1646 buffer. The text corresponding to SOURCE is already in the buffer
1647 when this is called. The intervals of new tree are a copy of those
1648 belonging to the string being inserted; intervals are never
1649 shared.
1651 If the inserted text had no intervals associated, and we don't
1652 want to inherit the surrounding text's properties, this function
1653 simply returns -- offset_intervals should handle placing the
1654 text in the correct interval, depending on the sticky bits.
1656 If the inserted text had properties (intervals), then there are two
1657 cases -- either insertion happened in the middle of some interval,
1658 or between two intervals.
1660 If the text goes into the middle of an interval, then new
1661 intervals are created in the middle with only the properties of
1662 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1663 which case the new text has the union of its properties and those
1664 of the text into which it was inserted.
1666 If the text goes between two intervals, then if neither interval
1667 had its appropriate sticky property set (front_sticky, rear_sticky),
1668 the new text has only its properties. If one of the sticky properties
1669 is set, then the new text "sticks" to that region and its properties
1670 depend on merging as above. If both the preceding and succeeding
1671 intervals to the new text are "sticky", then the new text retains
1672 only its properties, as if neither sticky property were set. Perhaps
1673 we should consider merging all three sets of properties onto the new
1674 text... */
1676 void
1677 graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
1678 EMACS_INT length, struct buffer *buffer,
1679 int inherit)
1681 register INTERVAL under, over, this, prev;
1682 register INTERVAL tree;
1683 EMACS_INT over_used;
1685 tree = BUF_INTERVALS (buffer);
1687 /* If the new text has no properties, then with inheritance it
1688 becomes part of whatever interval it was inserted into.
1689 To prevent inheritance, we must clear out the properties
1690 of the newly inserted text. */
1691 if (NULL_INTERVAL_P (source))
1693 Lisp_Object buf;
1694 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1696 XSETBUFFER (buf, buffer);
1697 set_text_properties_1 (make_number (position),
1698 make_number (position + length),
1699 Qnil, buf, 0);
1701 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1702 /* Shouldn't be necessary. -stef */
1703 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1704 return;
1707 if (NULL_INTERVAL_P (tree))
1709 /* The inserted text constitutes the whole buffer, so
1710 simply copy over the interval structure. */
1711 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1713 Lisp_Object buf;
1714 XSETBUFFER (buf, buffer);
1715 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1716 BUF_INTERVALS (buffer)->position = BEG;
1717 BUF_INTERVALS (buffer)->up_obj = 1;
1719 /* Explicitly free the old tree here? */
1721 return;
1724 /* Create an interval tree in which to place a copy
1725 of the intervals of the inserted string. */
1727 Lisp_Object buf;
1728 XSETBUFFER (buf, buffer);
1729 tree = create_root_interval (buf);
1732 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1733 /* If the buffer contains only the new string, but
1734 there was already some interval tree there, then it may be
1735 some zero length intervals. Eventually, do something clever
1736 about inserting properly. For now, just waste the old intervals. */
1738 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1739 BUF_INTERVALS (buffer)->position = BEG;
1740 BUF_INTERVALS (buffer)->up_obj = 1;
1741 /* Explicitly free the old tree here. */
1743 return;
1745 /* Paranoia -- the text has already been added, so this buffer
1746 should be of non-zero length. */
1747 else if (TOTAL_LENGTH (tree) == 0)
1748 abort ();
1750 this = under = find_interval (tree, position);
1751 if (NULL_INTERVAL_P (under)) /* Paranoia */
1752 abort ();
1753 over = find_interval (source, interval_start_pos (source));
1755 /* Here for insertion in the middle of an interval.
1756 Split off an equivalent interval to the right,
1757 then don't bother with it any more. */
1759 if (position > under->position)
1761 INTERVAL end_unchanged
1762 = split_interval_left (this, position - under->position);
1763 copy_properties (under, end_unchanged);
1764 under->position = position;
1766 else
1768 /* This call may have some effect because previous_interval may
1769 update `position' fields of intervals. Thus, don't ignore it
1770 for the moment. Someone please tell me the truth (K.Handa). */
1771 prev = previous_interval (under);
1772 #if 0
1773 /* But, this code surely has no effect. And, anyway,
1774 END_NONSTICKY_P is unreliable now. */
1775 if (prev && !END_NONSTICKY_P (prev))
1776 prev = 0;
1777 #endif /* 0 */
1780 /* Insertion is now at beginning of UNDER. */
1782 /* The inserted text "sticks" to the interval `under',
1783 which means it gets those properties.
1784 The properties of under are the result of
1785 adjust_intervals_for_insertion, so stickiness has
1786 already been taken care of. */
1788 /* OVER is the interval we are copying from next.
1789 OVER_USED says how many characters' worth of OVER
1790 have already been copied into target intervals.
1791 UNDER is the next interval in the target. */
1792 over_used = 0;
1793 while (! NULL_INTERVAL_P (over))
1795 /* If UNDER is longer than OVER, split it. */
1796 if (LENGTH (over) - over_used < LENGTH (under))
1798 this = split_interval_left (under, LENGTH (over) - over_used);
1799 copy_properties (under, this);
1801 else
1802 this = under;
1804 /* THIS is now the interval to copy or merge into.
1805 OVER covers all of it. */
1806 if (inherit)
1807 merge_properties (over, this);
1808 else
1809 copy_properties (over, this);
1811 /* If THIS and OVER end at the same place,
1812 advance OVER to a new source interval. */
1813 if (LENGTH (this) == LENGTH (over) - over_used)
1815 over = next_interval (over);
1816 over_used = 0;
1818 else
1819 /* Otherwise just record that more of OVER has been used. */
1820 over_used += LENGTH (this);
1822 /* Always advance to a new target interval. */
1823 under = next_interval (this);
1826 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1827 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1828 return;
1831 /* Get the value of property PROP from PLIST,
1832 which is the plist of an interval.
1833 We check for direct properties, for categories with property PROP,
1834 and for PROP appearing on the default-text-properties list. */
1836 Lisp_Object
1837 textget (Lisp_Object plist, register Lisp_Object prop)
1839 return lookup_char_property (plist, prop, 1);
1842 Lisp_Object
1843 lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
1845 register Lisp_Object tail, fallback = Qnil;
1847 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1849 register Lisp_Object tem;
1850 tem = XCAR (tail);
1851 if (EQ (prop, tem))
1852 return Fcar (XCDR (tail));
1853 if (EQ (tem, Qcategory))
1855 tem = Fcar (XCDR (tail));
1856 if (SYMBOLP (tem))
1857 fallback = Fget (tem, prop);
1861 if (! NILP (fallback))
1862 return fallback;
1863 /* Check for alternative properties */
1864 tail = Fassq (prop, Vchar_property_alias_alist);
1865 if (! NILP (tail))
1867 tail = XCDR (tail);
1868 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1869 fallback = Fplist_get (plist, XCAR (tail));
1872 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1873 fallback = Fplist_get (Vdefault_text_properties, prop);
1874 return fallback;
1878 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1879 byte position BYTEPOS. */
1881 INLINE void
1882 temp_set_point_both (struct buffer *buffer,
1883 EMACS_INT charpos, EMACS_INT bytepos)
1885 /* In a single-byte buffer, the two positions must be equal. */
1886 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1887 && charpos != bytepos)
1888 abort ();
1890 if (charpos > bytepos)
1891 abort ();
1893 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1894 abort ();
1896 BUF_PT_BYTE (buffer) = bytepos;
1897 BUF_PT (buffer) = charpos;
1900 /* Set point "temporarily", without checking any text properties. */
1902 INLINE void
1903 temp_set_point (struct buffer *buffer, EMACS_INT charpos)
1905 temp_set_point_both (buffer, charpos,
1906 buf_charpos_to_bytepos (buffer, charpos));
1909 /* Set point in BUFFER to CHARPOS. If the target position is
1910 before an intangible character, move to an ok place. */
1912 void
1913 set_point (EMACS_INT charpos)
1915 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1918 /* If there's an invisible character at position POS + TEST_OFFS in the
1919 current buffer, and the invisible property has a `stickiness' such that
1920 inserting a character at position POS would inherit the property it,
1921 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1922 then intangibility is required as well as invisibleness.
1924 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1926 Note that `stickiness' is determined by overlay marker insertion types,
1927 if the invisible property comes from an overlay. */
1929 static EMACS_INT
1930 adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj,
1931 int test_intang)
1933 Lisp_Object invis_propval, invis_overlay;
1934 Lisp_Object test_pos;
1936 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1937 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1938 return pos;
1940 test_pos = make_number (pos + test_offs);
1942 invis_propval
1943 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1944 &invis_overlay);
1946 if ((!test_intang
1947 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1948 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1949 /* This next test is true if the invisible property has a stickiness
1950 such that an insertion at POS would inherit it. */
1951 && (NILP (invis_overlay)
1952 /* Invisible property is from a text-property. */
1953 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1954 == (test_offs == 0 ? 1 : -1))
1955 /* Invisible property is from an overlay. */
1956 : (test_offs == 0
1957 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1958 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1959 pos += adj;
1961 return pos;
1964 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1965 position BYTEPOS. If the target position is
1966 before an intangible character, move to an ok place. */
1968 void
1969 set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
1971 register INTERVAL to, from, toprev, fromprev;
1972 EMACS_INT buffer_point;
1973 EMACS_INT old_position = PT;
1974 /* This ensures that we move forward past intangible text when the
1975 initial position is the same as the destination, in the rare
1976 instances where this is important, e.g. in line-move-finish
1977 (simple.el). */
1978 int backwards = (charpos < old_position ? 1 : 0);
1979 int have_overlays;
1980 EMACS_INT original_position;
1982 current_buffer->point_before_scroll = Qnil;
1984 if (charpos == PT)
1985 return;
1987 /* In a single-byte buffer, the two positions must be equal. */
1988 eassert (ZV != ZV_BYTE || charpos == bytepos);
1990 /* Check this now, before checking if the buffer has any intervals.
1991 That way, we can catch conditions which break this sanity check
1992 whether or not there are intervals in the buffer. */
1993 eassert (charpos <= ZV && charpos >= BEGV);
1995 have_overlays = (current_buffer->overlays_before
1996 || current_buffer->overlays_after);
1998 /* If we have no text properties and overlays,
1999 then we can do it quickly. */
2000 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
2002 temp_set_point_both (current_buffer, charpos, bytepos);
2003 return;
2006 /* Set TO to the interval containing the char after CHARPOS,
2007 and TOPREV to the interval containing the char before CHARPOS.
2008 Either one may be null. They may be equal. */
2009 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2010 if (charpos == BEGV)
2011 toprev = 0;
2012 else if (to && to->position == charpos)
2013 toprev = previous_interval (to);
2014 else
2015 toprev = to;
2017 buffer_point = (PT == ZV ? ZV - 1 : PT);
2019 /* Set FROM to the interval containing the char after PT,
2020 and FROMPREV to the interval containing the char before PT.
2021 Either one may be null. They may be equal. */
2022 /* We could cache this and save time. */
2023 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2024 if (buffer_point == BEGV)
2025 fromprev = 0;
2026 else if (from && from->position == PT)
2027 fromprev = previous_interval (from);
2028 else if (buffer_point != PT)
2029 fromprev = from, from = 0;
2030 else
2031 fromprev = from;
2033 /* Moving within an interval. */
2034 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2035 && ! have_overlays)
2037 temp_set_point_both (current_buffer, charpos, bytepos);
2038 return;
2041 original_position = charpos;
2043 /* If the new position is between two intangible characters
2044 with the same intangible property value,
2045 move forward or backward until a change in that property. */
2046 if (NILP (Vinhibit_point_motion_hooks)
2047 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2048 || have_overlays)
2049 /* Intangibility never stops us from positioning at the beginning
2050 or end of the buffer, so don't bother checking in that case. */
2051 && charpos != BEGV && charpos != ZV)
2053 Lisp_Object pos;
2054 Lisp_Object intangible_propval;
2056 if (backwards)
2058 /* If the preceding character is both intangible and invisible,
2059 and the invisible property is `rear-sticky', perturb it so
2060 that the search starts one character earlier -- this ensures
2061 that point can never move to the end of an invisible/
2062 intangible/rear-sticky region. */
2063 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2065 XSETINT (pos, charpos);
2067 /* If following char is intangible,
2068 skip back over all chars with matching intangible property. */
2070 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2072 if (! NILP (intangible_propval))
2074 while (XINT (pos) > BEGV
2075 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2076 Qintangible, Qnil),
2077 intangible_propval))
2078 pos = Fprevious_char_property_change (pos, Qnil);
2080 /* Set CHARPOS from POS, and if the final intangible character
2081 that we skipped over is also invisible, and the invisible
2082 property is `front-sticky', perturb it to be one character
2083 earlier -- this ensures that point can never move to the
2084 beginning of an invisible/intangible/front-sticky region. */
2085 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2088 else
2090 /* If the following character is both intangible and invisible,
2091 and the invisible property is `front-sticky', perturb it so
2092 that the search starts one character later -- this ensures
2093 that point can never move to the beginning of an
2094 invisible/intangible/front-sticky region. */
2095 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2097 XSETINT (pos, charpos);
2099 /* If preceding char is intangible,
2100 skip forward over all chars with matching intangible property. */
2102 intangible_propval = Fget_char_property (make_number (charpos - 1),
2103 Qintangible, Qnil);
2105 if (! NILP (intangible_propval))
2107 while (XINT (pos) < ZV
2108 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2109 intangible_propval))
2110 pos = Fnext_char_property_change (pos, Qnil);
2112 /* Set CHARPOS from POS, and if the final intangible character
2113 that we skipped over is also invisible, and the invisible
2114 property is `rear-sticky', perturb it to be one character
2115 later -- this ensures that point can never move to the
2116 end of an invisible/intangible/rear-sticky region. */
2117 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2121 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2124 if (charpos != original_position)
2126 /* Set TO to the interval containing the char after CHARPOS,
2127 and TOPREV to the interval containing the char before CHARPOS.
2128 Either one may be null. They may be equal. */
2129 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2130 if (charpos == BEGV)
2131 toprev = 0;
2132 else if (to && to->position == charpos)
2133 toprev = previous_interval (to);
2134 else
2135 toprev = to;
2138 /* Here TO is the interval after the stopping point
2139 and TOPREV is the interval before the stopping point.
2140 One or the other may be null. */
2142 temp_set_point_both (current_buffer, charpos, bytepos);
2144 /* We run point-left and point-entered hooks here, if the
2145 two intervals are not equivalent. These hooks take
2146 (old_point, new_point) as arguments. */
2147 if (NILP (Vinhibit_point_motion_hooks)
2148 && (! intervals_equal (from, to)
2149 || ! intervals_equal (fromprev, toprev)))
2151 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2153 if (fromprev)
2154 leave_before = textget (fromprev->plist, Qpoint_left);
2155 else
2156 leave_before = Qnil;
2158 if (from)
2159 leave_after = textget (from->plist, Qpoint_left);
2160 else
2161 leave_after = Qnil;
2163 if (toprev)
2164 enter_before = textget (toprev->plist, Qpoint_entered);
2165 else
2166 enter_before = Qnil;
2168 if (to)
2169 enter_after = textget (to->plist, Qpoint_entered);
2170 else
2171 enter_after = Qnil;
2173 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2174 call2 (leave_before, make_number (old_position),
2175 make_number (charpos));
2176 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2177 call2 (leave_after, make_number (old_position),
2178 make_number (charpos));
2180 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2181 call2 (enter_before, make_number (old_position),
2182 make_number (charpos));
2183 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2184 call2 (enter_after, make_number (old_position),
2185 make_number (charpos));
2189 /* Move point to POSITION, unless POSITION is inside an intangible
2190 segment that reaches all the way to point. */
2192 void
2193 move_if_not_intangible (EMACS_INT position)
2195 Lisp_Object pos;
2196 Lisp_Object intangible_propval;
2198 XSETINT (pos, position);
2200 if (! NILP (Vinhibit_point_motion_hooks))
2201 /* If intangible is inhibited, always move point to POSITION. */
2203 else if (PT < position && XINT (pos) < ZV)
2205 /* We want to move forward, so check the text before POSITION. */
2207 intangible_propval = Fget_char_property (pos,
2208 Qintangible, Qnil);
2210 /* If following char is intangible,
2211 skip back over all chars with matching intangible property. */
2212 if (! NILP (intangible_propval))
2213 while (XINT (pos) > BEGV
2214 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2215 Qintangible, Qnil),
2216 intangible_propval))
2217 pos = Fprevious_char_property_change (pos, Qnil);
2219 else if (XINT (pos) > BEGV)
2221 /* We want to move backward, so check the text after POSITION. */
2223 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2224 Qintangible, Qnil);
2226 /* If following char is intangible,
2227 skip forward over all chars with matching intangible property. */
2228 if (! NILP (intangible_propval))
2229 while (XINT (pos) < ZV
2230 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2231 intangible_propval))
2232 pos = Fnext_char_property_change (pos, Qnil);
2235 else if (position < BEGV)
2236 position = BEGV;
2237 else if (position > ZV)
2238 position = ZV;
2240 /* If the whole stretch between PT and POSITION isn't intangible,
2241 try moving to POSITION (which means we actually move farther
2242 if POSITION is inside of intangible text). */
2244 if (XINT (pos) != PT)
2245 SET_PT (position);
2248 /* If text at position POS has property PROP, set *VAL to the property
2249 value, *START and *END to the beginning and end of a region that
2250 has the same property, and return 1. Otherwise return 0.
2252 OBJECT is the string or buffer to look for the property in;
2253 nil means the current buffer. */
2256 get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
2257 EMACS_INT *start, EMACS_INT *end, Lisp_Object object)
2259 INTERVAL i, prev, next;
2261 if (NILP (object))
2262 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2263 else if (BUFFERP (object))
2264 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2265 else if (STRINGP (object))
2266 i = find_interval (STRING_INTERVALS (object), pos);
2267 else
2268 abort ();
2270 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2271 return 0;
2272 *val = textget (i->plist, prop);
2273 if (NILP (*val))
2274 return 0;
2276 next = i; /* remember it in advance */
2277 prev = previous_interval (i);
2278 while (! NULL_INTERVAL_P (prev)
2279 && EQ (*val, textget (prev->plist, prop)))
2280 i = prev, prev = previous_interval (prev);
2281 *start = i->position;
2283 next = next_interval (i);
2284 while (! NULL_INTERVAL_P (next)
2285 && EQ (*val, textget (next->plist, prop)))
2286 i = next, next = next_interval (next);
2287 *end = i->position + LENGTH (i);
2289 return 1;
2292 /* Return the proper local keymap TYPE for position POSITION in
2293 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2294 specified by the PROP property, if any. Otherwise, if TYPE is
2295 `local-map' use BUFFER's local map.
2297 POSITION must be in the accessible part of BUFFER. */
2299 Lisp_Object
2300 get_local_map (register EMACS_INT position, register struct buffer *buffer,
2301 Lisp_Object type)
2303 Lisp_Object prop, lispy_position, lispy_buffer;
2304 EMACS_INT old_begv, old_zv, old_begv_byte, old_zv_byte;
2306 /* Perhaps we should just change `position' to the limit. */
2307 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2308 abort ();
2310 /* Ignore narrowing, so that a local map continues to be valid even if
2311 the visible region contains no characters and hence no properties. */
2312 old_begv = BUF_BEGV (buffer);
2313 old_zv = BUF_ZV (buffer);
2314 old_begv_byte = BUF_BEGV_BYTE (buffer);
2315 old_zv_byte = BUF_ZV_BYTE (buffer);
2316 BUF_BEGV (buffer) = BUF_BEG (buffer);
2317 BUF_ZV (buffer) = BUF_Z (buffer);
2318 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2319 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2321 XSETFASTINT (lispy_position, position);
2322 XSETBUFFER (lispy_buffer, buffer);
2323 /* First check if the CHAR has any property. This is because when
2324 we click with the mouse, the mouse pointer is really pointing
2325 to the CHAR after POS. */
2326 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2327 /* If not, look at the POS's properties. This is necessary because when
2328 editing a field with a `local-map' property, we want insertion at the end
2329 to obey the `local-map' property. */
2330 if (NILP (prop))
2331 prop = get_pos_property (lispy_position, type, lispy_buffer);
2333 BUF_BEGV (buffer) = old_begv;
2334 BUF_ZV (buffer) = old_zv;
2335 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2336 BUF_ZV_BYTE (buffer) = old_zv_byte;
2338 /* Use the local map only if it is valid. */
2339 prop = get_keymap (prop, 0, 0);
2340 if (CONSP (prop))
2341 return prop;
2343 if (EQ (type, Qkeymap))
2344 return Qnil;
2345 else
2346 return buffer->keymap;
2349 /* Produce an interval tree reflecting the intervals in
2350 TREE from START to START + LENGTH.
2351 The new interval tree has no parent and has a starting-position of 0. */
2353 INTERVAL
2354 copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
2356 register INTERVAL i, new, t;
2357 register EMACS_INT got, prevlen;
2359 if (NULL_INTERVAL_P (tree) || length <= 0)
2360 return NULL_INTERVAL;
2362 i = find_interval (tree, start);
2363 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2364 abort ();
2366 /* If there is only one interval and it's the default, return nil. */
2367 if ((start - i->position + 1 + length) < LENGTH (i)
2368 && DEFAULT_INTERVAL_P (i))
2369 return NULL_INTERVAL;
2371 new = make_interval ();
2372 new->position = 0;
2373 got = (LENGTH (i) - (start - i->position));
2374 new->total_length = length;
2375 CHECK_TOTAL_LENGTH (new);
2376 copy_properties (i, new);
2378 t = new;
2379 prevlen = got;
2380 while (got < length)
2382 i = next_interval (i);
2383 t = split_interval_right (t, prevlen);
2384 copy_properties (i, t);
2385 prevlen = LENGTH (i);
2386 got += prevlen;
2389 return balance_an_interval (new);
2392 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2394 INLINE void
2395 copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
2396 EMACS_INT position, EMACS_INT length)
2398 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2399 position, length);
2400 if (NULL_INTERVAL_P (interval_copy))
2401 return;
2403 SET_INTERVAL_OBJECT (interval_copy, string);
2404 STRING_SET_INTERVALS (string, interval_copy);
2407 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2408 Assume they have identical characters. */
2411 compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
2413 INTERVAL i1, i2;
2414 EMACS_INT pos = 0;
2415 EMACS_INT end = SCHARS (s1);
2417 i1 = find_interval (STRING_INTERVALS (s1), 0);
2418 i2 = find_interval (STRING_INTERVALS (s2), 0);
2420 while (pos < end)
2422 /* Determine how far we can go before we reach the end of I1 or I2. */
2423 EMACS_INT len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2424 EMACS_INT len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2425 EMACS_INT distance = min (len1, len2);
2427 /* If we ever find a mismatch between the strings,
2428 they differ. */
2429 if (! intervals_equal (i1, i2))
2430 return 0;
2432 /* Advance POS till the end of the shorter interval,
2433 and advance one or both interval pointers for the new position. */
2434 pos += distance;
2435 if (len1 == distance)
2436 i1 = next_interval (i1);
2437 if (len2 == distance)
2438 i2 = next_interval (i2);
2440 return 1;
2443 /* Recursively adjust interval I in the current buffer
2444 for setting enable_multibyte_characters to MULTI_FLAG.
2445 The range of interval I is START ... END in characters,
2446 START_BYTE ... END_BYTE in bytes. */
2448 static void
2449 set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
2450 EMACS_INT start, EMACS_INT start_byte,
2451 EMACS_INT end, EMACS_INT end_byte)
2453 /* Fix the length of this interval. */
2454 if (multi_flag)
2455 i->total_length = end - start;
2456 else
2457 i->total_length = end_byte - start_byte;
2458 CHECK_TOTAL_LENGTH (i);
2460 if (TOTAL_LENGTH (i) == 0)
2462 delete_interval (i);
2463 return;
2466 /* Recursively fix the length of the subintervals. */
2467 if (i->left)
2469 EMACS_INT left_end, left_end_byte;
2471 if (multi_flag)
2473 EMACS_INT temp;
2474 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2475 left_end = BYTE_TO_CHAR (left_end_byte);
2477 temp = CHAR_TO_BYTE (left_end);
2479 /* If LEFT_END_BYTE is in the middle of a character,
2480 adjust it and LEFT_END to a char boundary. */
2481 if (left_end_byte > temp)
2483 left_end_byte = temp;
2485 if (left_end_byte < temp)
2487 left_end--;
2488 left_end_byte = CHAR_TO_BYTE (left_end);
2491 else
2493 left_end = start + LEFT_TOTAL_LENGTH (i);
2494 left_end_byte = CHAR_TO_BYTE (left_end);
2497 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2498 left_end, left_end_byte);
2500 if (i->right)
2502 EMACS_INT right_start_byte, right_start;
2504 if (multi_flag)
2506 EMACS_INT temp;
2508 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2509 right_start = BYTE_TO_CHAR (right_start_byte);
2511 /* If RIGHT_START_BYTE is in the middle of a character,
2512 adjust it and RIGHT_START to a char boundary. */
2513 temp = CHAR_TO_BYTE (right_start);
2515 if (right_start_byte < temp)
2517 right_start_byte = temp;
2519 if (right_start_byte > temp)
2521 right_start++;
2522 right_start_byte = CHAR_TO_BYTE (right_start);
2525 else
2527 right_start = end - RIGHT_TOTAL_LENGTH (i);
2528 right_start_byte = CHAR_TO_BYTE (right_start);
2531 set_intervals_multibyte_1 (i->right, multi_flag,
2532 right_start, right_start_byte,
2533 end, end_byte);
2536 /* Rounding to char boundaries can theoretically ake this interval
2537 spurious. If so, delete one child, and copy its property list
2538 to this interval. */
2539 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2541 if ((i)->left)
2543 (i)->plist = (i)->left->plist;
2544 (i)->left->total_length = 0;
2545 delete_interval ((i)->left);
2547 else
2549 (i)->plist = (i)->right->plist;
2550 (i)->right->total_length = 0;
2551 delete_interval ((i)->right);
2556 /* Update the intervals of the current buffer
2557 to fit the contents as multibyte (if MULTI_FLAG is 1)
2558 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2560 void
2561 set_intervals_multibyte (int multi_flag)
2563 if (BUF_INTERVALS (current_buffer))
2564 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2565 BEG, BEG_BYTE, Z, Z_BYTE);
2568 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2569 (do not change this comment) */