(mouse-region-delete-keys): New variable.
[emacs.git] / src / intervals.c
blobc399d40d10f1d516c8cdcf3e877c0d5f46a95509
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* NOTES:
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
27 An idea: Have the owner of the tree keep count of splits and/or
28 insertion lengths (in intervals), and balance after every N.
30 Need to call *_left_hook when buffer is killed.
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
35 There are comments around about freeing intervals. It might be
36 faster to explicitly free them (put them on the free list) than
37 to GC them.
42 #include <config.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "buffer.h"
46 #include "puresize.h"
47 #include "keyboard.h"
49 /* The rest of the file is within this conditional. */
50 #ifdef USE_TEXT_PROPERTIES
52 /* Test for membership, allowing for t (actually any non-cons) to mean the
53 universal set. */
55 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
57 #define min(x, y) ((x) < (y) ? (x) : (y))
59 Lisp_Object merge_properties_sticky ();
61 /* Utility functions for intervals. */
64 /* Create the root interval of some object, a buffer or string. */
66 INTERVAL
67 create_root_interval (parent)
68 Lisp_Object parent;
70 INTERVAL new;
72 CHECK_IMPURE (parent);
74 new = make_interval ();
76 if (BUFFERP (parent))
78 new->total_length = (BUF_Z (XBUFFER (parent))
79 - BUF_BEG (XBUFFER (parent)));
80 BUF_INTERVALS (XBUFFER (parent)) = new;
82 else if (STRINGP (parent))
84 new->total_length = XSTRING (parent)->size;
85 XSTRING (parent)->intervals = new;
88 new->parent = (INTERVAL) parent;
89 new->position = 1;
91 return new;
94 /* Make the interval TARGET have exactly the properties of SOURCE */
96 void
97 copy_properties (source, target)
98 register INTERVAL source, target;
100 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
101 return;
103 COPY_INTERVAL_CACHE (source, target);
104 target->plist = Fcopy_sequence (source->plist);
107 /* Merge the properties of interval SOURCE into the properties
108 of interval TARGET. That is to say, each property in SOURCE
109 is added to TARGET if TARGET has no such property as yet. */
111 static void
112 merge_properties (source, target)
113 register INTERVAL source, target;
115 register Lisp_Object o, sym, val;
117 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
118 return;
120 MERGE_INTERVAL_CACHE (source, target);
122 o = source->plist;
123 while (! EQ (o, Qnil))
125 sym = Fcar (o);
126 val = Fmemq (sym, target->plist);
128 if (NILP (val))
130 o = Fcdr (o);
131 val = Fcar (o);
132 target->plist = Fcons (sym, Fcons (val, target->plist));
133 o = Fcdr (o);
135 else
136 o = Fcdr (Fcdr (o));
140 /* Return 1 if the two intervals have the same properties,
141 0 otherwise. */
144 intervals_equal (i0, i1)
145 INTERVAL i0, i1;
147 register Lisp_Object i0_cdr, i0_sym, i1_val;
148 register i1_len;
150 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
151 return 1;
153 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
154 return 0;
156 i1_len = XFASTINT (Flength (i1->plist));
157 if (i1_len & 0x1) /* Paranoia -- plists are always even */
158 abort ();
159 i1_len /= 2;
160 i0_cdr = i0->plist;
161 while (!NILP (i0_cdr))
163 /* Lengths of the two plists were unequal. */
164 if (i1_len == 0)
165 return 0;
167 i0_sym = Fcar (i0_cdr);
168 i1_val = Fmemq (i0_sym, i1->plist);
170 /* i0 has something i1 doesn't. */
171 if (EQ (i1_val, Qnil))
172 return 0;
174 /* i0 and i1 both have sym, but it has different values in each. */
175 i0_cdr = Fcdr (i0_cdr);
176 if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
177 return 0;
179 i0_cdr = Fcdr (i0_cdr);
180 i1_len--;
183 /* Lengths of the two plists were unequal. */
184 if (i1_len > 0)
185 return 0;
187 return 1;
190 static int icount;
191 static int idepth;
192 static int zero_length;
194 /* Traverse an interval tree TREE, performing FUNCTION on each node.
195 Pass FUNCTION two args: an interval, and ARG. */
197 void
198 traverse_intervals (tree, position, depth, function, arg)
199 INTERVAL tree;
200 int position, depth;
201 void (* function) ();
202 Lisp_Object arg;
204 if (NULL_INTERVAL_P (tree))
205 return;
207 traverse_intervals (tree->left, position, depth + 1, function, arg);
208 position += LEFT_TOTAL_LENGTH (tree);
209 tree->position = position;
210 (*function) (tree, arg);
211 position += LENGTH (tree);
212 traverse_intervals (tree->right, position, depth + 1, function, arg);
215 #if 0
216 /* These functions are temporary, for debugging purposes only. */
218 INTERVAL search_interval, found_interval;
220 void
221 check_for_interval (i)
222 register INTERVAL i;
224 if (i == search_interval)
226 found_interval = i;
227 icount++;
231 INTERVAL
232 search_for_interval (i, tree)
233 register INTERVAL i, tree;
235 icount = 0;
236 search_interval = i;
237 found_interval = NULL_INTERVAL;
238 traverse_intervals (tree, 1, 0, &check_for_interval, Qnil);
239 return found_interval;
242 static void
243 inc_interval_count (i)
244 INTERVAL i;
246 icount++;
247 if (LENGTH (i) == 0)
248 zero_length++;
249 if (depth > idepth)
250 idepth = depth;
254 count_intervals (i)
255 register INTERVAL i;
257 icount = 0;
258 idepth = 0;
259 zero_length = 0;
260 traverse_intervals (i, 1, 0, &inc_interval_count, Qnil);
262 return icount;
265 static INTERVAL
266 root_interval (interval)
267 INTERVAL interval;
269 register INTERVAL i = interval;
271 while (! ROOT_INTERVAL_P (i))
272 i = i->parent;
274 return i;
276 #endif
278 /* Assuming that a left child exists, perform the following operation:
281 / \ / \
282 B => A
283 / \ / \
287 static INTERVAL
288 rotate_right (interval)
289 INTERVAL interval;
291 INTERVAL i;
292 INTERVAL B = interval->left;
293 int old_total = interval->total_length;
295 /* Deal with any Parent of A; make it point to B. */
296 if (! ROOT_INTERVAL_P (interval))
297 if (AM_LEFT_CHILD (interval))
298 interval->parent->left = B;
299 else
300 interval->parent->right = B;
301 B->parent = interval->parent;
303 /* Make B the parent of A */
304 i = B->right;
305 B->right = interval;
306 interval->parent = B;
308 /* Make A point to c */
309 interval->left = i;
310 if (! NULL_INTERVAL_P (i))
311 i->parent = interval;
313 /* A's total length is decreased by the length of B and its left child. */
314 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
316 /* B must have the same total length of A. */
317 B->total_length = old_total;
319 return B;
322 /* Assuming that a right child exists, perform the following operation:
324 A B
325 / \ / \
326 B => A
327 / \ / \
331 static INTERVAL
332 rotate_left (interval)
333 INTERVAL interval;
335 INTERVAL i;
336 INTERVAL B = interval->right;
337 int old_total = interval->total_length;
339 /* Deal with any parent of A; make it point to B. */
340 if (! ROOT_INTERVAL_P (interval))
341 if (AM_LEFT_CHILD (interval))
342 interval->parent->left = B;
343 else
344 interval->parent->right = B;
345 B->parent = interval->parent;
347 /* Make B the parent of A */
348 i = B->left;
349 B->left = interval;
350 interval->parent = B;
352 /* Make A point to c */
353 interval->right = i;
354 if (! NULL_INTERVAL_P (i))
355 i->parent = interval;
357 /* A's total length is decreased by the length of B and its right child. */
358 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
360 /* B must have the same total length of A. */
361 B->total_length = old_total;
363 return B;
366 /* Balance an interval tree with the assumption that the subtrees
367 themselves are already balanced. */
369 static INTERVAL
370 balance_an_interval (i)
371 INTERVAL i;
373 register int old_diff, new_diff;
375 while (1)
377 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
378 if (old_diff > 0)
380 new_diff = i->total_length - i->left->total_length
381 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
382 if (abs (new_diff) >= old_diff)
383 break;
384 i = rotate_right (i);
385 balance_an_interval (i->right);
387 else if (old_diff < 0)
389 new_diff = i->total_length - i->right->total_length
390 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
391 if (abs (new_diff) >= -old_diff)
392 break;
393 i = rotate_left (i);
394 balance_an_interval (i->left);
396 else
397 break;
399 return i;
402 /* Balance INTERVAL, potentially stuffing it back into its parent
403 Lisp Object. */
405 static INLINE INTERVAL
406 balance_possible_root_interval (interval)
407 register INTERVAL interval;
409 Lisp_Object parent;
411 if (interval->parent == NULL_INTERVAL)
412 return interval;
414 parent = (Lisp_Object) (interval->parent);
415 interval = balance_an_interval (interval);
417 if (BUFFERP (parent))
418 BUF_INTERVALS (XBUFFER (parent)) = interval;
419 else if (STRINGP (parent))
420 XSTRING (parent)->intervals = interval;
422 return interval;
425 /* Balance the interval tree TREE. Balancing is by weight
426 (the amount of text). */
428 static INTERVAL
429 balance_intervals_internal (tree)
430 register INTERVAL tree;
432 /* Balance within each side. */
433 if (tree->left)
434 balance_intervals_internal (tree->left);
435 if (tree->right)
436 balance_intervals_internal (tree->right);
437 return balance_an_interval (tree);
440 /* Advertised interface to balance intervals. */
442 INTERVAL
443 balance_intervals (tree)
444 INTERVAL tree;
446 if (tree == NULL_INTERVAL)
447 return NULL_INTERVAL;
449 return balance_intervals_internal (tree);
452 /* Split INTERVAL into two pieces, starting the second piece at
453 character position OFFSET (counting from 0), relative to INTERVAL.
454 INTERVAL becomes the left-hand piece, and the right-hand piece
455 (second, lexicographically) is returned.
457 The size and position fields of the two intervals are set based upon
458 those of the original interval. The property list of the new interval
459 is reset, thus it is up to the caller to do the right thing with the
460 result.
462 Note that this does not change the position of INTERVAL; if it is a root,
463 it is still a root after this operation. */
465 INTERVAL
466 split_interval_right (interval, offset)
467 INTERVAL interval;
468 int offset;
470 INTERVAL new = make_interval ();
471 int position = interval->position;
472 int new_length = LENGTH (interval) - offset;
474 new->position = position + offset;
475 new->parent = interval;
477 if (NULL_RIGHT_CHILD (interval))
479 interval->right = new;
480 new->total_length = new_length;
482 return new;
485 /* Insert the new node between INTERVAL and its right child. */
486 new->right = interval->right;
487 interval->right->parent = new;
488 interval->right = new;
489 new->total_length = new_length + new->right->total_length;
491 balance_an_interval (new);
492 balance_possible_root_interval (interval);
494 return new;
497 /* Split INTERVAL into two pieces, starting the second piece at
498 character position OFFSET (counting from 0), relative to INTERVAL.
499 INTERVAL becomes the right-hand piece, and the left-hand piece
500 (first, lexicographically) is returned.
502 The size and position fields of the two intervals are set based upon
503 those of the original interval. The property list of the new interval
504 is reset, thus it is up to the caller to do the right thing with the
505 result.
507 Note that this does not change the position of INTERVAL; if it is a root,
508 it is still a root after this operation. */
510 INTERVAL
511 split_interval_left (interval, offset)
512 INTERVAL interval;
513 int offset;
515 INTERVAL new = make_interval ();
516 int position = interval->position;
517 int new_length = offset;
519 new->position = interval->position;
520 interval->position = interval->position + offset;
521 new->parent = interval;
523 if (NULL_LEFT_CHILD (interval))
525 interval->left = new;
526 new->total_length = new_length;
528 return new;
531 /* Insert the new node between INTERVAL and its left child. */
532 new->left = interval->left;
533 new->left->parent = new;
534 interval->left = new;
535 new->total_length = new_length + new->left->total_length;
537 balance_an_interval (new);
538 balance_possible_root_interval (interval);
540 return new;
543 /* Find the interval containing text position POSITION in the text
544 represented by the interval tree TREE. POSITION is a buffer
545 position; the earliest position is 1. If POSITION is at the end of
546 the buffer, return the interval containing the last character.
548 The `position' field, which is a cache of an interval's position,
549 is updated in the interval found. Other functions (e.g., next_interval)
550 will update this cache based on the result of find_interval. */
552 INLINE INTERVAL
553 find_interval (tree, position)
554 register INTERVAL tree;
555 register int position;
557 /* The distance from the left edge of the subtree at TREE
558 to POSITION. */
559 register int relative_position = position - BEG;
561 if (NULL_INTERVAL_P (tree))
562 return NULL_INTERVAL;
564 if (relative_position > TOTAL_LENGTH (tree))
565 abort (); /* Paranoia */
567 tree = balance_possible_root_interval (tree);
569 while (1)
571 if (relative_position < LEFT_TOTAL_LENGTH (tree))
573 tree = tree->left;
575 else if (! NULL_RIGHT_CHILD (tree)
576 && relative_position >= (TOTAL_LENGTH (tree)
577 - RIGHT_TOTAL_LENGTH (tree)))
579 relative_position -= (TOTAL_LENGTH (tree)
580 - RIGHT_TOTAL_LENGTH (tree));
581 tree = tree->right;
583 else
585 tree->position =
586 (position - relative_position /* the left edge of *tree */
587 + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
589 return tree;
594 /* Find the succeeding interval (lexicographically) to INTERVAL.
595 Sets the `position' field based on that of INTERVAL (see
596 find_interval). */
598 INTERVAL
599 next_interval (interval)
600 register INTERVAL interval;
602 register INTERVAL i = interval;
603 register int next_position;
605 if (NULL_INTERVAL_P (i))
606 return NULL_INTERVAL;
607 next_position = interval->position + LENGTH (interval);
609 if (! NULL_RIGHT_CHILD (i))
611 i = i->right;
612 while (! NULL_LEFT_CHILD (i))
613 i = i->left;
615 i->position = next_position;
616 return i;
619 while (! NULL_PARENT (i))
621 if (AM_LEFT_CHILD (i))
623 i = i->parent;
624 i->position = next_position;
625 return i;
628 i = i->parent;
631 return NULL_INTERVAL;
634 /* Find the preceding interval (lexicographically) to INTERVAL.
635 Sets the `position' field based on that of INTERVAL (see
636 find_interval). */
638 INTERVAL
639 previous_interval (interval)
640 register INTERVAL interval;
642 register INTERVAL i;
643 register position_of_previous;
645 if (NULL_INTERVAL_P (interval))
646 return NULL_INTERVAL;
648 if (! NULL_LEFT_CHILD (interval))
650 i = interval->left;
651 while (! NULL_RIGHT_CHILD (i))
652 i = i->right;
654 i->position = interval->position - LENGTH (i);
655 return i;
658 i = interval;
659 while (! NULL_PARENT (i))
661 if (AM_RIGHT_CHILD (i))
663 i = i->parent;
665 i->position = interval->position - LENGTH (i);
666 return i;
668 i = i->parent;
671 return NULL_INTERVAL;
674 #if 0
675 /* Traverse a path down the interval tree TREE to the interval
676 containing POSITION, adjusting all nodes on the path for
677 an addition of LENGTH characters. Insertion between two intervals
678 (i.e., point == i->position, where i is second interval) means
679 text goes into second interval.
681 Modifications are needed to handle the hungry bits -- after simply
682 finding the interval at position (don't add length going down),
683 if it's the beginning of the interval, get the previous interval
684 and check the hungry bits of both. Then add the length going back up
685 to the root. */
687 static INTERVAL
688 adjust_intervals_for_insertion (tree, position, length)
689 INTERVAL tree;
690 int position, length;
692 register int relative_position;
693 register INTERVAL this;
695 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
696 abort ();
698 /* If inserting at point-max of a buffer, that position
699 will be out of range */
700 if (position > TOTAL_LENGTH (tree))
701 position = TOTAL_LENGTH (tree);
702 relative_position = position;
703 this = tree;
705 while (1)
707 if (relative_position <= LEFT_TOTAL_LENGTH (this))
709 this->total_length += length;
710 this = this->left;
712 else if (relative_position > (TOTAL_LENGTH (this)
713 - RIGHT_TOTAL_LENGTH (this)))
715 relative_position -= (TOTAL_LENGTH (this)
716 - RIGHT_TOTAL_LENGTH (this));
717 this->total_length += length;
718 this = this->right;
720 else
722 /* If we are to use zero-length intervals as buffer pointers,
723 then this code will have to change. */
724 this->total_length += length;
725 this->position = LEFT_TOTAL_LENGTH (this)
726 + position - relative_position + 1;
727 return tree;
731 #endif
733 /* Effect an adjustment corresponding to the addition of LENGTH characters
734 of text. Do this by finding the interval containing POSITION in the
735 interval tree TREE, and then adjusting all of its ancestors by adding
736 LENGTH to them.
738 If POSITION is the first character of an interval, meaning that point
739 is actually between the two intervals, make the new text belong to
740 the interval which is "sticky".
742 If both intervals are "sticky", then make them belong to the left-most
743 interval. Another possibility would be to create a new interval for
744 this text, and make it have the merged properties of both ends. */
746 static INTERVAL
747 adjust_intervals_for_insertion (tree, position, length)
748 INTERVAL tree;
749 int position, length;
751 register INTERVAL i;
752 register INTERVAL temp;
753 int eobp = 0;
755 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
756 abort ();
758 /* If inserting at point-max of a buffer, that position will be out
759 of range. Remember that buffer positions are 1-based. */
760 if (position >= BEG + TOTAL_LENGTH (tree)){
761 position = BEG + TOTAL_LENGTH (tree);
762 eobp = 1;
765 i = find_interval (tree, position);
767 /* If in middle of an interval which is not sticky either way,
768 we must not just give its properties to the insertion.
769 So split this interval at the insertion point. */
770 if (! (position == i->position || eobp)
771 && END_NONSTICKY_P (i)
772 && ! FRONT_STICKY_P (i))
774 temp = split_interval_right (i, position - i->position);
775 copy_properties (i, temp);
776 i = temp;
779 /* If we are positioned between intervals, check the stickiness of
780 both of them. We have to do this too, if we are at BEG or Z. */
781 if (position == i->position || eobp)
783 register INTERVAL prev;
785 if (position == BEG)
786 prev = 0;
787 else if (eobp)
789 prev = i;
790 i = 0;
792 else
793 prev = previous_interval (i);
795 /* Even if we are positioned between intervals, we default
796 to the left one if it exists. We extend it now and split
797 off a part later, if stickiness demands it. */
798 for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
800 temp->total_length += length;
801 temp = balance_possible_root_interval (temp);
804 /* If at least one interval has sticky properties,
805 we check the stickiness property by property. */
806 if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
808 Lisp_Object pleft, pright;
809 struct interval newi;
811 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
812 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
813 newi.plist = merge_properties_sticky (pleft, pright);
815 if(! prev) /* i.e. position == BEG */
817 if (! intervals_equal (i, &newi))
819 i = split_interval_left (i, length);
820 i->plist = newi.plist;
823 else if (! intervals_equal (prev, &newi))
825 prev = split_interval_right (prev,
826 position - prev->position);
827 prev->plist = newi.plist;
828 if (! NULL_INTERVAL_P (i)
829 && intervals_equal (prev, i))
830 merge_interval_right (prev);
833 /* We will need to update the cache here later. */
835 else if (! prev && ! NILP (i->plist))
837 /* Just split off a new interval at the left.
838 Since I wasn't front-sticky, the empty plist is ok. */
839 i = split_interval_left (i, length);
843 /* Otherwise just extend the interval. */
844 else
846 for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent)
848 temp->total_length += length;
849 temp = balance_possible_root_interval (temp);
853 return tree;
856 /* Any property might be front-sticky on the left, rear-sticky on the left,
857 front-sticky on the right, or rear-sticky on the right; the 16 combinations
858 can be arranged in a matrix with rows denoting the left conditions and
859 columns denoting the right conditions:
860 _ __ _
861 _ FR FR FR FR
862 FR__ 0 1 2 3
863 _FR 4 5 6 7
864 FR 8 9 A B
865 FR C D E F
867 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
868 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
869 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
870 p8 L p9 L pa L pb L pc L pd L pe L pf L)
871 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
872 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
873 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
874 p8 R p9 R pa R pb R pc R pd R pe R pf R)
876 We inherit from whoever has a sticky side facing us. If both sides
877 do (cases 2, 3, E, and F), then we inherit from whichever side has a
878 non-nil value for the current property. If both sides do, then we take
879 from the left.
881 When we inherit a property, we get its stickiness as well as its value.
882 So, when we merge the above two lists, we expect to get this:
884 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
885 rear-nonsticky (p6 pa)
886 p0 L p1 L p2 L p3 L p6 R p7 R
887 pa R pb R pc L pd L pe L pf L)
889 The optimizable special cases are:
890 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
891 left rear-nonsticky = t, right front-sticky = t (inherit right)
892 left rear-nonsticky = t, right front-sticky = nil (inherit none)
895 Lisp_Object
896 merge_properties_sticky (pleft, pright)
897 Lisp_Object pleft, pright;
899 register Lisp_Object props, front, rear;
900 Lisp_Object lfront, lrear, rfront, rrear;
901 register Lisp_Object tail1, tail2, sym, lval, rval;
902 int use_left, use_right;
904 props = Qnil;
905 front = Qnil;
906 rear = Qnil;
907 lfront = textget (pleft, Qfront_sticky);
908 lrear = textget (pleft, Qrear_nonsticky);
909 rfront = textget (pright, Qfront_sticky);
910 rrear = textget (pright, Qrear_nonsticky);
912 /* Go through each element of PRIGHT. */
913 for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
915 sym = Fcar (tail1);
917 /* Sticky properties get special treatment. */
918 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
919 continue;
921 rval = Fcar (Fcdr (tail1));
922 for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
923 if (EQ (sym, Fcar (tail2)))
924 break;
925 lval = (NILP (tail2) ? Qnil : Fcar( Fcdr (tail2)));
927 use_left = ! TMEM (sym, lrear);
928 use_right = TMEM (sym, rfront);
929 if (use_left && use_right)
931 use_left = ! NILP (lval);
932 use_right = ! NILP (rval);
934 if (use_left)
936 /* We build props as (value sym ...) rather than (sym value ...)
937 because we plan to nreverse it when we're done. */
938 if (! NILP (lval))
939 props = Fcons (lval, Fcons (sym, props));
940 if (TMEM (sym, lfront))
941 front = Fcons (sym, front);
942 if (TMEM (sym, lrear))
943 rear = Fcons (sym, rear);
945 else if (use_right)
947 if (! NILP (rval))
948 props = Fcons (rval, Fcons (sym, props));
949 if (TMEM (sym, rfront))
950 front = Fcons (sym, front);
951 if (TMEM (sym, rrear))
952 rear = Fcons (sym, rear);
956 /* Now go through each element of PLEFT. */
957 for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
959 sym = Fcar (tail2);
961 /* Sticky properties get special treatment. */
962 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
963 continue;
965 /* If sym is in PRIGHT, we've already considered it. */
966 for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
967 if (EQ (sym, Fcar (tail1)))
968 break;
969 if (! NILP (tail1))
970 continue;
972 lval = Fcar (Fcdr (tail2));
974 /* Since rval is known to be nil in this loop, the test simplifies. */
975 if (! TMEM (sym, lrear))
977 if (! NILP (lval))
978 props = Fcons (lval, Fcons (sym, props));
979 if (TMEM (sym, lfront))
980 front = Fcons (sym, front);
982 else if (TMEM (sym, rfront))
984 /* The value is nil, but we still inherit the stickiness
985 from the right. */
986 front = Fcons (sym, front);
987 if (TMEM (sym, rrear))
988 rear = Fcons (sym, rear);
991 props = Fnreverse (props);
992 if (! NILP (rear))
993 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
994 if (! NILP (front))
995 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
996 return props;
1000 /* Delete an node I from its interval tree by merging its subtrees
1001 into one subtree which is then returned. Caller is responsible for
1002 storing the resulting subtree into its parent. */
1004 static INTERVAL
1005 delete_node (i)
1006 register INTERVAL i;
1008 register INTERVAL migrate, this;
1009 register int migrate_amt;
1011 if (NULL_INTERVAL_P (i->left))
1012 return i->right;
1013 if (NULL_INTERVAL_P (i->right))
1014 return i->left;
1016 migrate = i->left;
1017 migrate_amt = i->left->total_length;
1018 this = i->right;
1019 this->total_length += migrate_amt;
1020 while (! NULL_INTERVAL_P (this->left))
1022 this = this->left;
1023 this->total_length += migrate_amt;
1025 this->left = migrate;
1026 migrate->parent = this;
1028 return i->right;
1031 /* Delete interval I from its tree by calling `delete_node'
1032 and properly connecting the resultant subtree.
1034 I is presumed to be empty; that is, no adjustments are made
1035 for the length of I. */
1037 void
1038 delete_interval (i)
1039 register INTERVAL i;
1041 register INTERVAL parent;
1042 int amt = LENGTH (i);
1044 if (amt > 0) /* Only used on zero-length intervals now. */
1045 abort ();
1047 if (ROOT_INTERVAL_P (i))
1049 Lisp_Object owner;
1050 owner = (Lisp_Object) i->parent;
1051 parent = delete_node (i);
1052 if (! NULL_INTERVAL_P (parent))
1053 parent->parent = (INTERVAL) owner;
1055 if (BUFFERP (owner))
1056 BUF_INTERVALS (XBUFFER (owner)) = parent;
1057 else if (STRINGP (owner))
1058 XSTRING (owner)->intervals = parent;
1059 else
1060 abort ();
1062 return;
1065 parent = i->parent;
1066 if (AM_LEFT_CHILD (i))
1068 parent->left = delete_node (i);
1069 if (! NULL_INTERVAL_P (parent->left))
1070 parent->left->parent = parent;
1072 else
1074 parent->right = delete_node (i);
1075 if (! NULL_INTERVAL_P (parent->right))
1076 parent->right->parent = parent;
1080 /* Find the interval in TREE corresponding to the relative position
1081 FROM and delete as much as possible of AMOUNT from that interval.
1082 Return the amount actually deleted, and if the interval was
1083 zeroed-out, delete that interval node from the tree.
1085 Note that FROM is actually origin zero, aka relative to the
1086 leftmost edge of tree. This is appropriate since we call ourselves
1087 recursively on subtrees.
1089 Do this by recursing down TREE to the interval in question, and
1090 deleting the appropriate amount of text. */
1092 static int
1093 interval_deletion_adjustment (tree, from, amount)
1094 register INTERVAL tree;
1095 register int from, amount;
1097 register int relative_position = from;
1099 if (NULL_INTERVAL_P (tree))
1100 return 0;
1102 /* Left branch */
1103 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1105 int subtract = interval_deletion_adjustment (tree->left,
1106 relative_position,
1107 amount);
1108 tree->total_length -= subtract;
1109 return subtract;
1111 /* Right branch */
1112 else if (relative_position >= (TOTAL_LENGTH (tree)
1113 - RIGHT_TOTAL_LENGTH (tree)))
1115 int subtract;
1117 relative_position -= (tree->total_length
1118 - RIGHT_TOTAL_LENGTH (tree));
1119 subtract = interval_deletion_adjustment (tree->right,
1120 relative_position,
1121 amount);
1122 tree->total_length -= subtract;
1123 return subtract;
1125 /* Here -- this node. */
1126 else
1128 /* How much can we delete from this interval? */
1129 int my_amount = ((tree->total_length
1130 - RIGHT_TOTAL_LENGTH (tree))
1131 - relative_position);
1133 if (amount > my_amount)
1134 amount = my_amount;
1136 tree->total_length -= amount;
1137 if (LENGTH (tree) == 0)
1138 delete_interval (tree);
1140 return amount;
1143 /* Never reach here. */
1146 /* Effect the adjustments necessary to the interval tree of BUFFER to
1147 correspond to the deletion of LENGTH characters from that buffer
1148 text. The deletion is effected at position START (which is a
1149 buffer position, i.e. origin 1). */
1151 static void
1152 adjust_intervals_for_deletion (buffer, start, length)
1153 struct buffer *buffer;
1154 int start, length;
1156 register int left_to_delete = length;
1157 register INTERVAL tree = BUF_INTERVALS (buffer);
1158 register int deleted;
1160 if (NULL_INTERVAL_P (tree))
1161 return;
1163 if (start > BEG + TOTAL_LENGTH (tree)
1164 || start + length > BEG + TOTAL_LENGTH (tree))
1165 abort ();
1167 if (length == TOTAL_LENGTH (tree))
1169 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1170 return;
1173 if (ONLY_INTERVAL_P (tree))
1175 tree->total_length -= length;
1176 return;
1179 if (start > BEG + TOTAL_LENGTH (tree))
1180 start = BEG + TOTAL_LENGTH (tree);
1181 while (left_to_delete > 0)
1183 left_to_delete -= interval_deletion_adjustment (tree, start - 1,
1184 left_to_delete);
1185 tree = BUF_INTERVALS (buffer);
1186 if (left_to_delete == tree->total_length)
1188 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1189 return;
1194 /* Make the adjustments necessary to the interval tree of BUFFER to
1195 represent an addition or deletion of LENGTH characters starting
1196 at position START. Addition or deletion is indicated by the sign
1197 of LENGTH. */
1199 INLINE void
1200 offset_intervals (buffer, start, length)
1201 struct buffer *buffer;
1202 int start, length;
1204 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1205 return;
1207 if (length > 0)
1208 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1209 else
1210 adjust_intervals_for_deletion (buffer, start, -length);
1213 /* Merge interval I with its lexicographic successor. The resulting
1214 interval is returned, and has the properties of the original
1215 successor. The properties of I are lost. I is removed from the
1216 interval tree.
1218 IMPORTANT:
1219 The caller must verify that this is not the last (rightmost)
1220 interval. */
1222 INTERVAL
1223 merge_interval_right (i)
1224 register INTERVAL i;
1226 register int absorb = LENGTH (i);
1227 register INTERVAL successor;
1229 /* Zero out this interval. */
1230 i->total_length -= absorb;
1232 /* Find the succeeding interval. */
1233 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1234 as we descend. */
1236 successor = i->right;
1237 while (! NULL_LEFT_CHILD (successor))
1239 successor->total_length += absorb;
1240 successor = successor->left;
1243 successor->total_length += absorb;
1244 delete_interval (i);
1245 return successor;
1248 successor = i;
1249 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1250 we ascend. */
1252 if (AM_LEFT_CHILD (successor))
1254 successor = successor->parent;
1255 delete_interval (i);
1256 return successor;
1259 successor = successor->parent;
1260 successor->total_length -= absorb;
1263 /* This must be the rightmost or last interval and cannot
1264 be merged right. The caller should have known. */
1265 abort ();
1268 /* Merge interval I with its lexicographic predecessor. The resulting
1269 interval is returned, and has the properties of the original predecessor.
1270 The properties of I are lost. Interval node I is removed from the tree.
1272 IMPORTANT:
1273 The caller must verify that this is not the first (leftmost) interval. */
1275 INTERVAL
1276 merge_interval_left (i)
1277 register INTERVAL i;
1279 register int absorb = LENGTH (i);
1280 register INTERVAL predecessor;
1282 /* Zero out this interval. */
1283 i->total_length -= absorb;
1285 /* Find the preceding interval. */
1286 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1287 adding ABSORB as we go. */
1289 predecessor = i->left;
1290 while (! NULL_RIGHT_CHILD (predecessor))
1292 predecessor->total_length += absorb;
1293 predecessor = predecessor->right;
1296 predecessor->total_length += absorb;
1297 delete_interval (i);
1298 return predecessor;
1301 predecessor = i;
1302 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1303 subtracting ABSORB. */
1305 if (AM_RIGHT_CHILD (predecessor))
1307 predecessor = predecessor->parent;
1308 delete_interval (i);
1309 return predecessor;
1312 predecessor = predecessor->parent;
1313 predecessor->total_length -= absorb;
1316 /* This must be the leftmost or first interval and cannot
1317 be merged left. The caller should have known. */
1318 abort ();
1321 /* Make an exact copy of interval tree SOURCE which descends from
1322 PARENT. This is done by recursing through SOURCE, copying
1323 the current interval and its properties, and then adjusting
1324 the pointers of the copy. */
1326 static INTERVAL
1327 reproduce_tree (source, parent)
1328 INTERVAL source, parent;
1330 register INTERVAL t = make_interval ();
1332 bcopy (source, t, INTERVAL_SIZE);
1333 copy_properties (source, t);
1334 t->parent = parent;
1335 if (! NULL_LEFT_CHILD (source))
1336 t->left = reproduce_tree (source->left, t);
1337 if (! NULL_RIGHT_CHILD (source))
1338 t->right = reproduce_tree (source->right, t);
1340 return t;
1343 #if 0
1344 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1346 /* Make a new interval of length LENGTH starting at START in the
1347 group of intervals INTERVALS, which is actually an interval tree.
1348 Returns the new interval.
1350 Generate an error if the new positions would overlap an existing
1351 interval. */
1353 static INTERVAL
1354 make_new_interval (intervals, start, length)
1355 INTERVAL intervals;
1356 int start, length;
1358 INTERVAL slot;
1360 slot = find_interval (intervals, start);
1361 if (start + length > slot->position + LENGTH (slot))
1362 error ("Interval would overlap");
1364 if (start == slot->position && length == LENGTH (slot))
1365 return slot;
1367 if (slot->position == start)
1369 /* New right node. */
1370 split_interval_right (slot, length);
1371 return slot;
1374 if (slot->position + LENGTH (slot) == start + length)
1376 /* New left node. */
1377 split_interval_left (slot, LENGTH (slot) - length);
1378 return slot;
1381 /* Convert interval SLOT into three intervals. */
1382 split_interval_left (slot, start - slot->position);
1383 split_interval_right (slot, length);
1384 return slot;
1386 #endif
1388 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1389 LENGTH is the length of the text in SOURCE.
1391 This is used in insdel.c when inserting Lisp_Strings into the
1392 buffer. The text corresponding to SOURCE is already in the buffer
1393 when this is called. The intervals of new tree are a copy of those
1394 belonging to the string being inserted; intervals are never
1395 shared.
1397 If the inserted text had no intervals associated, and we don't
1398 want to inherit the surrounding text's properties, this function
1399 simply returns -- offset_intervals should handle placing the
1400 text in the correct interval, depending on the sticky bits.
1402 If the inserted text had properties (intervals), then there are two
1403 cases -- either insertion happened in the middle of some interval,
1404 or between two intervals.
1406 If the text goes into the middle of an interval, then new
1407 intervals are created in the middle with only the properties of
1408 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1409 which case the new text has the union of its properties and those
1410 of the text into which it was inserted.
1412 If the text goes between two intervals, then if neither interval
1413 had its appropriate sticky property set (front_sticky, rear_sticky),
1414 the new text has only its properties. If one of the sticky properties
1415 is set, then the new text "sticks" to that region and its properties
1416 depend on merging as above. If both the preceding and succeeding
1417 intervals to the new text are "sticky", then the new text retains
1418 only its properties, as if neither sticky property were set. Perhaps
1419 we should consider merging all three sets of properties onto the new
1420 text... */
1422 void
1423 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1424 INTERVAL source;
1425 int position, length;
1426 struct buffer *buffer;
1427 int inherit;
1429 register INTERVAL under, over, this, prev;
1430 register INTERVAL tree;
1431 int middle;
1433 tree = BUF_INTERVALS (buffer);
1435 /* If the new text has no properties, it becomes part of whatever
1436 interval it was inserted into. */
1437 if (NULL_INTERVAL_P (source))
1439 Lisp_Object buf;
1440 if (!inherit && ! NULL_INTERVAL_P (tree))
1442 XSETBUFFER (buf, buffer);
1443 Fset_text_properties (make_number (position),
1444 make_number (position + length),
1445 Qnil, buf);
1447 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1448 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1449 return;
1452 if (NULL_INTERVAL_P (tree))
1454 /* The inserted text constitutes the whole buffer, so
1455 simply copy over the interval structure. */
1456 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1458 Lisp_Object buf;
1459 XSETBUFFER (buf, buffer);
1460 BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
1461 /* Explicitly free the old tree here. */
1463 return;
1466 /* Create an interval tree in which to place a copy
1467 of the intervals of the inserted string. */
1469 Lisp_Object buf;
1470 XSETBUFFER (buf, buffer);
1471 tree = create_root_interval (buf);
1474 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1475 /* If the buffer contains only the new string, but
1476 there was already some interval tree there, then it may be
1477 some zero length intervals. Eventually, do something clever
1478 about inserting properly. For now, just waste the old intervals. */
1480 BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
1481 /* Explicitly free the old tree here. */
1483 return;
1485 /* Paranoia -- the text has already been added, so this buffer
1486 should be of non-zero length. */
1487 else if (TOTAL_LENGTH (tree) == 0)
1488 abort ();
1490 this = under = find_interval (tree, position);
1491 if (NULL_INTERVAL_P (under)) /* Paranoia */
1492 abort ();
1493 over = find_interval (source, 1);
1495 /* Here for insertion in the middle of an interval.
1496 Split off an equivalent interval to the right,
1497 then don't bother with it any more. */
1499 if (position > under->position)
1501 INTERVAL end_unchanged
1502 = split_interval_left (this, position - under->position);
1503 copy_properties (under, end_unchanged);
1504 under->position = position;
1505 prev = 0;
1506 middle = 1;
1508 else
1510 prev = previous_interval (under);
1511 if (prev && !END_NONSTICKY_P (prev))
1512 prev = 0;
1515 /* Insertion is now at beginning of UNDER. */
1517 /* The inserted text "sticks" to the interval `under',
1518 which means it gets those properties.
1519 The properties of under are the result of
1520 adjust_intervals_for_insertion, so stickiness has
1521 already been taken care of. */
1523 while (! NULL_INTERVAL_P (over))
1525 if (LENGTH (over) < LENGTH (under))
1527 this = split_interval_left (under, LENGTH (over));
1528 copy_properties (under, this);
1530 else
1531 this = under;
1532 copy_properties (over, this);
1533 if (inherit)
1534 merge_properties (over, this);
1535 else
1536 copy_properties (over, this);
1537 over = next_interval (over);
1540 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1541 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1542 return;
1545 /* Get the value of property PROP from PLIST,
1546 which is the plist of an interval.
1547 We check for direct properties, for categories with property PROP,
1548 and for PROP appearing on the default-text-properties list. */
1550 Lisp_Object
1551 textget (plist, prop)
1552 Lisp_Object plist;
1553 register Lisp_Object prop;
1555 register Lisp_Object tail, fallback;
1556 fallback = Qnil;
1558 for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
1560 register Lisp_Object tem;
1561 tem = Fcar (tail);
1562 if (EQ (prop, tem))
1563 return Fcar (Fcdr (tail));
1564 if (EQ (tem, Qcategory))
1566 tem = Fcar (Fcdr (tail));
1567 if (SYMBOLP (tem))
1568 fallback = Fget (tem, prop);
1572 if (! NILP (fallback))
1573 return fallback;
1574 if (CONSP (Vdefault_text_properties))
1575 return Fplist_get (Vdefault_text_properties, prop);
1576 return Qnil;
1580 /* Set point in BUFFER to POSITION. If the target position is
1581 before an intangible character, move to an ok place. */
1583 void
1584 set_point (position, buffer)
1585 register int position;
1586 register struct buffer *buffer;
1588 register INTERVAL to, from, toprev, fromprev, target;
1589 int buffer_point;
1590 register Lisp_Object obj;
1591 int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
1592 int old_position = BUF_PT (buffer);
1594 buffer->point_before_scroll = Qnil;
1596 if (position == BUF_PT (buffer))
1597 return;
1599 /* Check this now, before checking if the buffer has any intervals.
1600 That way, we can catch conditions which break this sanity check
1601 whether or not there are intervals in the buffer. */
1602 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
1603 abort ();
1605 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1608 BUF_PT (buffer) = position;
1609 return;
1612 /* Set TO to the interval containing the char after POSITION,
1613 and TOPREV to the interval containing the char before POSITION.
1614 Either one may be null. They may be equal. */
1615 to = find_interval (BUF_INTERVALS (buffer), position);
1616 if (position == BUF_BEGV (buffer))
1617 toprev = 0;
1618 else if (to->position == position)
1619 toprev = previous_interval (to);
1620 else
1621 toprev = to;
1623 buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
1624 ? BUF_ZV (buffer) - 1
1625 : BUF_PT (buffer));
1627 /* Set FROM to the interval containing the char after PT,
1628 and FROMPREV to the interval containing the char before PT.
1629 Either one may be null. They may be equal. */
1630 /* We could cache this and save time. */
1631 from = find_interval (BUF_INTERVALS (buffer), buffer_point);
1632 if (buffer_point == BUF_BEGV (buffer))
1633 fromprev = 0;
1634 else if (from->position == BUF_PT (buffer))
1635 fromprev = previous_interval (from);
1636 else if (buffer_point != BUF_PT (buffer))
1637 fromprev = from, from = 0;
1638 else
1639 fromprev = from;
1641 /* Moving within an interval. */
1642 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
1644 BUF_PT (buffer) = position;
1645 return;
1648 /* If the new position is between two intangible characters
1649 with the same intangible property value,
1650 move forward or backward until a change in that property. */
1651 if (NILP (Vinhibit_point_motion_hooks) && ! NULL_INTERVAL_P (to)
1652 && ! NULL_INTERVAL_P (toprev))
1654 if (backwards)
1656 Lisp_Object intangible_propval;
1657 intangible_propval = textget (to->plist, Qintangible);
1659 /* If following char is intangible,
1660 skip back over all chars with matching intangible property. */
1661 if (! NILP (intangible_propval))
1662 while (to == toprev
1663 || ((! NULL_INTERVAL_P (toprev)
1664 && EQ (textget (toprev->plist, Qintangible),
1665 intangible_propval))))
1667 to = toprev;
1668 toprev = previous_interval (toprev);
1669 if (NULL_INTERVAL_P (toprev))
1670 position = BUF_BEGV (buffer);
1671 else
1672 /* This is the only line that's not
1673 dual to the following loop.
1674 That's because we want the position
1675 at the end of TOPREV. */
1676 position = to->position;
1679 else
1681 Lisp_Object intangible_propval;
1682 intangible_propval = textget (toprev->plist, Qintangible);
1684 /* If previous char is intangible,
1685 skip fwd over all chars with matching intangible property. */
1686 if (! NILP (intangible_propval))
1687 while (to == toprev
1688 || ((! NULL_INTERVAL_P (to)
1689 && EQ (textget (to->plist, Qintangible),
1690 intangible_propval))))
1692 toprev = to;
1693 to = next_interval (to);
1694 if (NULL_INTERVAL_P (to))
1695 position = BUF_ZV (buffer);
1696 else
1697 position = to->position;
1702 /* Here TO is the interval after the stopping point
1703 and TOPREV is the interval before the stopping point.
1704 One or the other may be null. */
1706 BUF_PT (buffer) = position;
1708 /* We run point-left and point-entered hooks here, iff the
1709 two intervals are not equivalent. These hooks take
1710 (old_point, new_point) as arguments. */
1711 if (NILP (Vinhibit_point_motion_hooks)
1712 && (! intervals_equal (from, to)
1713 || ! intervals_equal (fromprev, toprev)))
1715 Lisp_Object leave_after, leave_before, enter_after, enter_before;
1717 if (fromprev)
1718 leave_after = textget (fromprev->plist, Qpoint_left);
1719 else
1720 leave_after = Qnil;
1721 if (from)
1722 leave_before = textget (from->plist, Qpoint_left);
1723 else
1724 leave_before = Qnil;
1726 if (toprev)
1727 enter_after = textget (toprev->plist, Qpoint_entered);
1728 else
1729 enter_after = Qnil;
1730 if (to)
1731 enter_before = textget (to->plist, Qpoint_entered);
1732 else
1733 enter_before = Qnil;
1735 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
1736 call2 (leave_before, old_position, position);
1737 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
1738 call2 (leave_after, old_position, position);
1740 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
1741 call2 (enter_before, old_position, position);
1742 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
1743 call2 (enter_after, old_position, position);
1747 /* Set point temporarily, without checking any text properties. */
1749 INLINE void
1750 temp_set_point (position, buffer)
1751 int position;
1752 struct buffer *buffer;
1754 BUF_PT (buffer) = position;
1757 /* Return the proper local map for position POSITION in BUFFER.
1758 Use the map specified by the local-map property, if any.
1759 Otherwise, use BUFFER's local map. */
1761 Lisp_Object
1762 get_local_map (position, buffer)
1763 register int position;
1764 register struct buffer *buffer;
1766 Lisp_Object prop, tem, lispy_position, lispy_buffer;
1767 int old_begv, old_zv;
1769 /* Perhaps we should just change `position' to the limit. */
1770 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
1771 abort ();
1773 /* Ignore narrowing, so that a local map continues to be valid even if
1774 the visible region contains no characters and hence no properties. */
1775 old_begv = BUF_BEGV (buffer);
1776 old_zv = BUF_ZV (buffer);
1777 BUF_BEGV (buffer) = BUF_BEG (buffer);
1778 BUF_ZV (buffer) = BUF_Z (buffer);
1780 /* There are no properties at the end of the buffer, so in that case
1781 check for a local map on the last character of the buffer instead. */
1782 if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer))
1783 --position;
1784 XSETFASTINT (lispy_position, position);
1785 XSETBUFFER (lispy_buffer, buffer);
1786 prop = Fget_char_property (lispy_position, Qlocal_map, lispy_buffer);
1788 BUF_BEGV (buffer) = old_begv;
1789 BUF_ZV (buffer) = old_zv;
1791 /* Use the local map only if it is valid. */
1792 if (!NILP (prop)
1793 && (tem = Fkeymapp (prop), !NILP (tem)))
1794 return prop;
1796 return buffer->keymap;
1799 /* Produce an interval tree reflecting the intervals in
1800 TREE from START to START + LENGTH. */
1802 INTERVAL
1803 copy_intervals (tree, start, length)
1804 INTERVAL tree;
1805 int start, length;
1807 register INTERVAL i, new, t;
1808 register int got, prevlen;
1810 if (NULL_INTERVAL_P (tree) || length <= 0)
1811 return NULL_INTERVAL;
1813 i = find_interval (tree, start);
1814 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
1815 abort ();
1817 /* If there is only one interval and it's the default, return nil. */
1818 if ((start - i->position + 1 + length) < LENGTH (i)
1819 && DEFAULT_INTERVAL_P (i))
1820 return NULL_INTERVAL;
1822 new = make_interval ();
1823 new->position = 1;
1824 got = (LENGTH (i) - (start - i->position));
1825 new->total_length = length;
1826 copy_properties (i, new);
1828 t = new;
1829 prevlen = got;
1830 while (got < length)
1832 i = next_interval (i);
1833 t = split_interval_right (t, prevlen);
1834 copy_properties (i, t);
1835 prevlen = LENGTH (i);
1836 got += prevlen;
1839 return balance_an_interval (new);
1842 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1844 INLINE void
1845 copy_intervals_to_string (string, buffer, position, length)
1846 Lisp_Object string, buffer;
1847 int position, length;
1849 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (XBUFFER (buffer)),
1850 position, length);
1851 if (NULL_INTERVAL_P (interval_copy))
1852 return;
1854 interval_copy->parent = (INTERVAL) string;
1855 XSTRING (string)->intervals = interval_copy;
1858 /* Return 1 if string S1 and S2 have identical properties; 0 otherwise.
1859 Assume they have identical characters. */
1862 compare_string_intervals (s1, s2)
1863 Lisp_Object s1, s2;
1865 INTERVAL i1, i2;
1866 int pos = 1;
1867 int end = XSTRING (s1)->size + 1;
1869 /* We specify 1 as position because the interval functions
1870 always use positions starting at 1. */
1871 i1 = find_interval (XSTRING (s1)->intervals, 1);
1872 i2 = find_interval (XSTRING (s2)->intervals, 1);
1874 while (pos < end)
1876 /* Determine how far we can go before we reach the end of I1 or I2. */
1877 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
1878 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
1879 int distance = min (len1, len2);
1881 /* If we ever find a mismatch between the strings,
1882 they differ. */
1883 if (! intervals_equal (i1, i2))
1884 return 0;
1886 /* Advance POS till the end of the shorter interval,
1887 and advance one or both interval pointers for the new position. */
1888 pos += distance;
1889 if (len1 == distance)
1890 i1 = next_interval (i1);
1891 if (len2 == distance)
1892 i2 = next_interval (i2);
1894 return 1;
1897 #endif /* USE_TEXT_PROPERTIES */