(specpdl_ptr): Declare volatile.
[bpt/emacs.git] / src / intervals.c
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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.
10
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.
15
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. */
20
21
22 /* NOTES:
23
24 Have to ensure that we can't put symbol nil on a plist, or some
25 functions may work incorrectly.
26
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.
29
30 Need to call *_left_hook when buffer is killed.
31
32 Scan for zero-length, or 0-length to see notes about handling
33 zero length interval-markers.
34
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.
38
39 */
40
41
42 #include <config.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"
49
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
51 universal set. */
52
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
54
55 Lisp_Object merge_properties_sticky ();
56 static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
57 static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
58 \f
59 /* Utility functions for intervals. */
60
61
62 /* Create the root interval of some object, a buffer or string. */
63
64 INTERVAL
65 create_root_interval (parent)
66 Lisp_Object parent;
67 {
68 INTERVAL new;
69
70 CHECK_IMPURE (parent);
71
72 new = make_interval ();
73
74 if (BUFFERP (parent))
75 {
76 new->total_length = (BUF_Z (XBUFFER (parent))
77 - BUF_BEG (XBUFFER (parent)));
78 CHECK_TOTAL_LENGTH (new);
79 BUF_INTERVALS (XBUFFER (parent)) = new;
80 new->position = 1;
81 }
82 else if (STRINGP (parent))
83 {
84 new->total_length = SCHARS (parent);
85 CHECK_TOTAL_LENGTH (new);
86 STRING_SET_INTERVALS (parent, new);
87 new->position = 0;
88 }
89
90 SET_INTERVAL_OBJECT (new, parent);
91
92 return new;
93 }
94
95 /* Make the interval TARGET have exactly the properties of SOURCE */
96
97 void
98 copy_properties (source, target)
99 register INTERVAL source, target;
100 {
101 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
102 return;
103
104 COPY_INTERVAL_CACHE (source, target);
105 target->plist = Fcopy_sequence (source->plist);
106 }
107
108 /* Merge the properties of interval SOURCE into the properties
109 of interval TARGET. That is to say, each property in SOURCE
110 is added to TARGET if TARGET has no such property as yet. */
111
112 static void
113 merge_properties (source, target)
114 register INTERVAL source, target;
115 {
116 register Lisp_Object o, sym, val;
117
118 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
119 return;
120
121 MERGE_INTERVAL_CACHE (source, target);
122
123 o = source->plist;
124 while (! EQ (o, Qnil))
125 {
126 sym = Fcar (o);
127 val = Fmemq (sym, target->plist);
128
129 if (NILP (val))
130 {
131 o = Fcdr (o);
132 val = Fcar (o);
133 target->plist = Fcons (sym, Fcons (val, target->plist));
134 o = Fcdr (o);
135 }
136 else
137 o = Fcdr (Fcdr (o));
138 }
139 }
140
141 /* Return 1 if the two intervals have the same properties,
142 0 otherwise. */
143
144 int
145 intervals_equal (i0, i1)
146 INTERVAL i0, i1;
147 {
148 register Lisp_Object i0_cdr, i0_sym, i1_val;
149 register int i1_len;
150
151 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
152 return 1;
153
154 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
155 return 0;
156
157 i1_len = XFASTINT (Flength (i1->plist));
158 if (i1_len & 0x1) /* Paranoia -- plists are always even */
159 abort ();
160 i1_len /= 2;
161 i0_cdr = i0->plist;
162 while (!NILP (i0_cdr))
163 {
164 /* Lengths of the two plists were unequal. */
165 if (i1_len == 0)
166 return 0;
167
168 i0_sym = Fcar (i0_cdr);
169 i1_val = Fmemq (i0_sym, i1->plist);
170
171 /* i0 has something i1 doesn't. */
172 if (EQ (i1_val, Qnil))
173 return 0;
174
175 /* i0 and i1 both have sym, but it has different values in each. */
176 i0_cdr = Fcdr (i0_cdr);
177 if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
178 return 0;
179
180 i0_cdr = Fcdr (i0_cdr);
181 i1_len--;
182 }
183
184 /* Lengths of the two plists were unequal. */
185 if (i1_len > 0)
186 return 0;
187
188 return 1;
189 }
190 \f
191
192 /* Traverse an interval tree TREE, performing FUNCTION on each node.
193 No guarantee is made about the order of traversal.
194 Pass FUNCTION two args: an interval, and ARG. */
195
196 void
197 traverse_intervals_noorder (tree, function, arg)
198 INTERVAL tree;
199 void (* function) P_ ((INTERVAL, Lisp_Object));
200 Lisp_Object arg;
201 {
202 /* Minimize stack usage. */
203 while (!NULL_INTERVAL_P (tree))
204 {
205 (*function) (tree, arg);
206 if (NULL_INTERVAL_P (tree->right))
207 tree = tree->left;
208 else
209 {
210 traverse_intervals_noorder (tree->left, function, arg);
211 tree = tree->right;
212 }
213 }
214 }
215
216 /* Traverse an interval tree TREE, performing FUNCTION on each node.
217 Pass FUNCTION two args: an interval, and ARG. */
218
219 void
220 traverse_intervals (tree, position, function, arg)
221 INTERVAL tree;
222 int position;
223 void (* function) P_ ((INTERVAL, Lisp_Object));
224 Lisp_Object arg;
225 {
226 while (!NULL_INTERVAL_P (tree))
227 {
228 traverse_intervals (tree->left, position, function, arg);
229 position += LEFT_TOTAL_LENGTH (tree);
230 tree->position = position;
231 (*function) (tree, arg);
232 position += LENGTH (tree); tree = tree->right;
233 }
234 }
235 \f
236 #if 0
237
238 static int icount;
239 static int idepth;
240 static int zero_length;
241
242 /* These functions are temporary, for debugging purposes only. */
243
244 INTERVAL search_interval, found_interval;
245
246 void
247 check_for_interval (i)
248 register INTERVAL i;
249 {
250 if (i == search_interval)
251 {
252 found_interval = i;
253 icount++;
254 }
255 }
256
257 INTERVAL
258 search_for_interval (i, tree)
259 register INTERVAL i, tree;
260 {
261 icount = 0;
262 search_interval = i;
263 found_interval = NULL_INTERVAL;
264 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
265 return found_interval;
266 }
267
268 static void
269 inc_interval_count (i)
270 INTERVAL i;
271 {
272 icount++;
273 if (LENGTH (i) == 0)
274 zero_length++;
275 if (depth > idepth)
276 idepth = depth;
277 }
278
279 int
280 count_intervals (i)
281 register INTERVAL i;
282 {
283 icount = 0;
284 idepth = 0;
285 zero_length = 0;
286 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
287
288 return icount;
289 }
290
291 static INTERVAL
292 root_interval (interval)
293 INTERVAL interval;
294 {
295 register INTERVAL i = interval;
296
297 while (! ROOT_INTERVAL_P (i))
298 i = INTERVAL_PARENT (i);
299
300 return i;
301 }
302 #endif
303 \f
304 /* Assuming that a left child exists, perform the following operation:
305
306 A B
307 / \ / \
308 B => A
309 / \ / \
310 c c
311 */
312
313 static INLINE INTERVAL
314 rotate_right (interval)
315 INTERVAL interval;
316 {
317 INTERVAL i;
318 INTERVAL B = interval->left;
319 int old_total = interval->total_length;
320
321 /* Deal with any Parent of A; make it point to B. */
322 if (! ROOT_INTERVAL_P (interval))
323 {
324 if (AM_LEFT_CHILD (interval))
325 INTERVAL_PARENT (interval)->left = B;
326 else
327 INTERVAL_PARENT (interval)->right = B;
328 }
329 COPY_INTERVAL_PARENT (B, interval);
330
331 /* Make B the parent of A */
332 i = B->right;
333 B->right = interval;
334 SET_INTERVAL_PARENT (interval, B);
335
336 /* Make A point to c */
337 interval->left = i;
338 if (! NULL_INTERVAL_P (i))
339 SET_INTERVAL_PARENT (i, interval);
340
341 /* A's total length is decreased by the length of B and its left child. */
342 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
343 CHECK_TOTAL_LENGTH (interval);
344
345 /* B must have the same total length of A. */
346 B->total_length = old_total;
347 CHECK_TOTAL_LENGTH (B);
348
349 return B;
350 }
351
352 /* Assuming that a right child exists, perform the following operation:
353
354 A B
355 / \ / \
356 B => A
357 / \ / \
358 c c
359 */
360
361 static INLINE INTERVAL
362 rotate_left (interval)
363 INTERVAL interval;
364 {
365 INTERVAL i;
366 INTERVAL B = interval->right;
367 int old_total = interval->total_length;
368
369 /* Deal with any parent of A; make it point to B. */
370 if (! ROOT_INTERVAL_P (interval))
371 {
372 if (AM_LEFT_CHILD (interval))
373 INTERVAL_PARENT (interval)->left = B;
374 else
375 INTERVAL_PARENT (interval)->right = B;
376 }
377 COPY_INTERVAL_PARENT (B, interval);
378
379 /* Make B the parent of A */
380 i = B->left;
381 B->left = interval;
382 SET_INTERVAL_PARENT (interval, B);
383
384 /* Make A point to c */
385 interval->right = i;
386 if (! NULL_INTERVAL_P (i))
387 SET_INTERVAL_PARENT (i, interval);
388
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);
392
393 /* B must have the same total length of A. */
394 B->total_length = old_total;
395 CHECK_TOTAL_LENGTH (B);
396
397 return B;
398 }
399 \f
400 /* Balance an interval tree with the assumption that the subtrees
401 themselves are already balanced. */
402
403 static INTERVAL
404 balance_an_interval (i)
405 INTERVAL i;
406 {
407 register int old_diff, new_diff;
408
409 while (1)
410 {
411 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
412 if (old_diff > 0)
413 {
414 /* Since the left child is longer, there must be one. */
415 new_diff = i->total_length - i->left->total_length
416 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
417 if (abs (new_diff) >= old_diff)
418 break;
419 i = rotate_right (i);
420 balance_an_interval (i->right);
421 }
422 else if (old_diff < 0)
423 {
424 /* Since the right child is longer, there must be one. */
425 new_diff = i->total_length - i->right->total_length
426 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
427 if (abs (new_diff) >= -old_diff)
428 break;
429 i = rotate_left (i);
430 balance_an_interval (i->left);
431 }
432 else
433 break;
434 }
435 return i;
436 }
437
438 /* Balance INTERVAL, potentially stuffing it back into its parent
439 Lisp Object. */
440
441 static INLINE INTERVAL
442 balance_possible_root_interval (interval)
443 register INTERVAL interval;
444 {
445 Lisp_Object parent;
446 int have_parent = 0;
447
448 if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
449 return interval;
450
451 if (INTERVAL_HAS_OBJECT (interval))
452 {
453 have_parent = 1;
454 GET_INTERVAL_OBJECT (parent, interval);
455 }
456 interval = balance_an_interval (interval);
457
458 if (have_parent)
459 {
460 if (BUFFERP (parent))
461 BUF_INTERVALS (XBUFFER (parent)) = interval;
462 else if (STRINGP (parent))
463 STRING_SET_INTERVALS (parent, interval);
464 }
465
466 return interval;
467 }
468
469 /* Balance the interval tree TREE. Balancing is by weight
470 (the amount of text). */
471
472 static INTERVAL
473 balance_intervals_internal (tree)
474 register INTERVAL tree;
475 {
476 /* Balance within each side. */
477 if (tree->left)
478 balance_intervals_internal (tree->left);
479 if (tree->right)
480 balance_intervals_internal (tree->right);
481 return balance_an_interval (tree);
482 }
483
484 /* Advertised interface to balance intervals. */
485
486 INTERVAL
487 balance_intervals (tree)
488 INTERVAL tree;
489 {
490 if (tree == NULL_INTERVAL)
491 return NULL_INTERVAL;
492
493 return balance_intervals_internal (tree);
494 }
495 \f
496 /* Split INTERVAL into two pieces, starting the second piece at
497 character position OFFSET (counting from 0), relative to INTERVAL.
498 INTERVAL becomes the left-hand piece, and the right-hand piece
499 (second, lexicographically) is returned.
500
501 The size and position fields of the two intervals are set based upon
502 those of the original interval. The property list of the new interval
503 is reset, thus it is up to the caller to do the right thing with the
504 result.
505
506 Note that this does not change the position of INTERVAL; if it is a root,
507 it is still a root after this operation. */
508
509 INTERVAL
510 split_interval_right (interval, offset)
511 INTERVAL interval;
512 int offset;
513 {
514 INTERVAL new = make_interval ();
515 int position = interval->position;
516 int new_length = LENGTH (interval) - offset;
517
518 new->position = position + offset;
519 SET_INTERVAL_PARENT (new, interval);
520
521 if (NULL_RIGHT_CHILD (interval))
522 {
523 interval->right = new;
524 new->total_length = new_length;
525 CHECK_TOTAL_LENGTH (new);
526 }
527 else
528 {
529 /* Insert the new node between INTERVAL and its right child. */
530 new->right = interval->right;
531 SET_INTERVAL_PARENT (interval->right, new);
532 interval->right = new;
533 new->total_length = new_length + new->right->total_length;
534 CHECK_TOTAL_LENGTH (new);
535 balance_an_interval (new);
536 }
537
538 balance_possible_root_interval (interval);
539
540 return new;
541 }
542
543 /* Split INTERVAL into two pieces, starting the second piece at
544 character position OFFSET (counting from 0), relative to INTERVAL.
545 INTERVAL becomes the right-hand piece, and the left-hand piece
546 (first, lexicographically) is returned.
547
548 The size and position fields of the two intervals are set based upon
549 those of the original interval. The property list of the new interval
550 is reset, thus it is up to the caller to do the right thing with the
551 result.
552
553 Note that this does not change the position of INTERVAL; if it is a root,
554 it is still a root after this operation. */
555
556 INTERVAL
557 split_interval_left (interval, offset)
558 INTERVAL interval;
559 int offset;
560 {
561 INTERVAL new = make_interval ();
562 int new_length = offset;
563
564 new->position = interval->position;
565 interval->position = interval->position + offset;
566 SET_INTERVAL_PARENT (new, interval);
567
568 if (NULL_LEFT_CHILD (interval))
569 {
570 interval->left = new;
571 new->total_length = new_length;
572 CHECK_TOTAL_LENGTH (new);
573 }
574 else
575 {
576 /* Insert the new node between INTERVAL and its left child. */
577 new->left = interval->left;
578 SET_INTERVAL_PARENT (new->left, new);
579 interval->left = new;
580 new->total_length = new_length + new->left->total_length;
581 CHECK_TOTAL_LENGTH (new);
582 balance_an_interval (new);
583 }
584
585 balance_possible_root_interval (interval);
586
587 return new;
588 }
589 \f
590 /* Return the proper position for the first character
591 described by the interval tree SOURCE.
592 This is 1 if the parent is a buffer,
593 0 if the parent is a string or if there is no parent.
594
595 Don't use this function on an interval which is the child
596 of another interval! */
597
598 int
599 interval_start_pos (source)
600 INTERVAL source;
601 {
602 Lisp_Object parent;
603
604 if (NULL_INTERVAL_P (source))
605 return 0;
606
607 if (! INTERVAL_HAS_OBJECT (source))
608 return 0;
609 GET_INTERVAL_OBJECT (parent, source);
610 if (BUFFERP (parent))
611 return BUF_BEG (XBUFFER (parent));
612 return 0;
613 }
614
615 /* Find the interval containing text position POSITION in the text
616 represented by the interval tree TREE. POSITION is a buffer
617 position (starting from 1) or a string index (starting from 0).
618 If POSITION is at the end of the buffer or string,
619 return the interval containing the last character.
620
621 The `position' field, which is a cache of an interval's position,
622 is updated in the interval found. Other functions (e.g., next_interval)
623 will update this cache based on the result of find_interval. */
624
625 INTERVAL
626 find_interval (tree, position)
627 register INTERVAL tree;
628 register int position;
629 {
630 /* The distance from the left edge of the subtree at TREE
631 to POSITION. */
632 register int relative_position;
633
634 if (NULL_INTERVAL_P (tree))
635 return NULL_INTERVAL;
636
637 relative_position = position;
638 if (INTERVAL_HAS_OBJECT (tree))
639 {
640 Lisp_Object parent;
641 GET_INTERVAL_OBJECT (parent, tree);
642 if (BUFFERP (parent))
643 relative_position -= BUF_BEG (XBUFFER (parent));
644 }
645
646 if (relative_position > TOTAL_LENGTH (tree))
647 abort (); /* Paranoia */
648
649 if (!handling_signal)
650 tree = balance_possible_root_interval (tree);
651
652 while (1)
653 {
654 if (relative_position < LEFT_TOTAL_LENGTH (tree))
655 {
656 tree = tree->left;
657 }
658 else if (! NULL_RIGHT_CHILD (tree)
659 && relative_position >= (TOTAL_LENGTH (tree)
660 - RIGHT_TOTAL_LENGTH (tree)))
661 {
662 relative_position -= (TOTAL_LENGTH (tree)
663 - RIGHT_TOTAL_LENGTH (tree));
664 tree = tree->right;
665 }
666 else
667 {
668 tree->position
669 = (position - relative_position /* the left edge of *tree */
670 + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
671
672 return tree;
673 }
674 }
675 }
676 \f
677 /* Find the succeeding interval (lexicographically) to INTERVAL.
678 Sets the `position' field based on that of INTERVAL (see
679 find_interval). */
680
681 INTERVAL
682 next_interval (interval)
683 register INTERVAL interval;
684 {
685 register INTERVAL i = interval;
686 register int next_position;
687
688 if (NULL_INTERVAL_P (i))
689 return NULL_INTERVAL;
690 next_position = interval->position + LENGTH (interval);
691
692 if (! NULL_RIGHT_CHILD (i))
693 {
694 i = i->right;
695 while (! NULL_LEFT_CHILD (i))
696 i = i->left;
697
698 i->position = next_position;
699 return i;
700 }
701
702 while (! NULL_PARENT (i))
703 {
704 if (AM_LEFT_CHILD (i))
705 {
706 i = INTERVAL_PARENT (i);
707 i->position = next_position;
708 return i;
709 }
710
711 i = INTERVAL_PARENT (i);
712 }
713
714 return NULL_INTERVAL;
715 }
716
717 /* Find the preceding interval (lexicographically) to INTERVAL.
718 Sets the `position' field based on that of INTERVAL (see
719 find_interval). */
720
721 INTERVAL
722 previous_interval (interval)
723 register INTERVAL interval;
724 {
725 register INTERVAL i;
726
727 if (NULL_INTERVAL_P (interval))
728 return NULL_INTERVAL;
729
730 if (! NULL_LEFT_CHILD (interval))
731 {
732 i = interval->left;
733 while (! NULL_RIGHT_CHILD (i))
734 i = i->right;
735
736 i->position = interval->position - LENGTH (i);
737 return i;
738 }
739
740 i = interval;
741 while (! NULL_PARENT (i))
742 {
743 if (AM_RIGHT_CHILD (i))
744 {
745 i = INTERVAL_PARENT (i);
746
747 i->position = interval->position - LENGTH (i);
748 return i;
749 }
750 i = INTERVAL_PARENT (i);
751 }
752
753 return NULL_INTERVAL;
754 }
755
756 /* Find the interval containing POS given some non-NULL INTERVAL
757 in the same tree. Note that we need to update interval->position
758 if we go down the tree.
759 To speed up the process, we assume that the ->position of
760 I and all its parents is already uptodate. */
761 INTERVAL
762 update_interval (i, pos)
763 register INTERVAL i;
764 int pos;
765 {
766 if (NULL_INTERVAL_P (i))
767 return NULL_INTERVAL;
768
769 while (1)
770 {
771 if (pos < i->position)
772 {
773 /* Move left. */
774 if (pos >= i->position - TOTAL_LENGTH (i->left))
775 {
776 i->left->position = i->position - TOTAL_LENGTH (i->left)
777 + LEFT_TOTAL_LENGTH (i->left);
778 i = i->left; /* Move to the left child */
779 }
780 else if (NULL_PARENT (i))
781 error ("Point before start of properties");
782 else
783 i = INTERVAL_PARENT (i);
784 continue;
785 }
786 else if (pos >= INTERVAL_LAST_POS (i))
787 {
788 /* Move right. */
789 if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
790 {
791 i->right->position = INTERVAL_LAST_POS (i) +
792 LEFT_TOTAL_LENGTH (i->right);
793 i = i->right; /* Move to the right child */
794 }
795 else if (NULL_PARENT (i))
796 error ("Point after end of properties");
797 else
798 i = INTERVAL_PARENT (i);
799 continue;
800 }
801 else
802 return i;
803 }
804 }
805
806 \f
807 #if 0
808 /* Traverse a path down the interval tree TREE to the interval
809 containing POSITION, adjusting all nodes on the path for
810 an addition of LENGTH characters. Insertion between two intervals
811 (i.e., point == i->position, where i is second interval) means
812 text goes into second interval.
813
814 Modifications are needed to handle the hungry bits -- after simply
815 finding the interval at position (don't add length going down),
816 if it's the beginning of the interval, get the previous interval
817 and check the hungry bits of both. Then add the length going back up
818 to the root. */
819
820 static INTERVAL
821 adjust_intervals_for_insertion (tree, position, length)
822 INTERVAL tree;
823 int position, length;
824 {
825 register int relative_position;
826 register INTERVAL this;
827
828 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
829 abort ();
830
831 /* If inserting at point-max of a buffer, that position
832 will be out of range */
833 if (position > TOTAL_LENGTH (tree))
834 position = TOTAL_LENGTH (tree);
835 relative_position = position;
836 this = tree;
837
838 while (1)
839 {
840 if (relative_position <= LEFT_TOTAL_LENGTH (this))
841 {
842 this->total_length += length;
843 CHECK_TOTAL_LENGTH (this);
844 this = this->left;
845 }
846 else if (relative_position > (TOTAL_LENGTH (this)
847 - RIGHT_TOTAL_LENGTH (this)))
848 {
849 relative_position -= (TOTAL_LENGTH (this)
850 - RIGHT_TOTAL_LENGTH (this));
851 this->total_length += length;
852 CHECK_TOTAL_LENGTH (this);
853 this = this->right;
854 }
855 else
856 {
857 /* If we are to use zero-length intervals as buffer pointers,
858 then this code will have to change. */
859 this->total_length += length;
860 CHECK_TOTAL_LENGTH (this);
861 this->position = LEFT_TOTAL_LENGTH (this)
862 + position - relative_position + 1;
863 return tree;
864 }
865 }
866 }
867 #endif
868
869 /* Effect an adjustment corresponding to the addition of LENGTH characters
870 of text. Do this by finding the interval containing POSITION in the
871 interval tree TREE, and then adjusting all of its ancestors by adding
872 LENGTH to them.
873
874 If POSITION is the first character of an interval, meaning that point
875 is actually between the two intervals, make the new text belong to
876 the interval which is "sticky".
877
878 If both intervals are "sticky", then make them belong to the left-most
879 interval. Another possibility would be to create a new interval for
880 this text, and make it have the merged properties of both ends. */
881
882 static INTERVAL
883 adjust_intervals_for_insertion (tree, position, length)
884 INTERVAL tree;
885 int position, length;
886 {
887 register INTERVAL i;
888 register INTERVAL temp;
889 int eobp = 0;
890 Lisp_Object parent;
891 int offset;
892
893 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
894 abort ();
895
896 GET_INTERVAL_OBJECT (parent, tree);
897 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
898
899 /* If inserting at point-max of a buffer, that position will be out
900 of range. Remember that buffer positions are 1-based. */
901 if (position >= TOTAL_LENGTH (tree) + offset)
902 {
903 position = TOTAL_LENGTH (tree) + offset;
904 eobp = 1;
905 }
906
907 i = find_interval (tree, position);
908
909 /* If in middle of an interval which is not sticky either way,
910 we must not just give its properties to the insertion.
911 So split this interval at the insertion point.
912
913 Originally, the if condition here was this:
914 (! (position == i->position || eobp)
915 && END_NONSTICKY_P (i)
916 && FRONT_NONSTICKY_P (i))
917 But, these macros are now unreliable because of introduction of
918 Vtext_property_default_nonsticky. So, we always check properties
919 one by one if POSITION is in middle of an interval. */
920 if (! (position == i->position || eobp))
921 {
922 Lisp_Object tail;
923 Lisp_Object front, rear;
924
925 tail = i->plist;
926
927 /* Properties font-sticky and rear-nonsticky override
928 Vtext_property_default_nonsticky. So, if they are t, we can
929 skip one by one checking of properties. */
930 rear = textget (i->plist, Qrear_nonsticky);
931 if (! CONSP (rear) && ! NILP (rear))
932 {
933 /* All properties are nonsticky. We split the interval. */
934 goto check_done;
935 }
936 front = textget (i->plist, Qfront_sticky);
937 if (! CONSP (front) && ! NILP (front))
938 {
939 /* All properties are sticky. We don't split the interval. */
940 tail = Qnil;
941 goto check_done;
942 }
943
944 /* Does any actual property pose an actual problem? We break
945 the loop if we find a nonsticky property. */
946 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
947 {
948 Lisp_Object prop, tmp;
949 prop = XCAR (tail);
950
951 /* Is this particular property front-sticky? */
952 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
953 continue;
954
955 /* Is this particular property rear-nonsticky? */
956 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
957 break;
958
959 /* Is this particular property recorded as sticky or
960 nonsticky in Vtext_property_default_nonsticky? */
961 tmp = Fassq (prop, Vtext_property_default_nonsticky);
962 if (CONSP (tmp))
963 {
964 if (NILP (tmp))
965 continue;
966 break;
967 }
968
969 /* By default, a text property is rear-sticky, thus we
970 continue the loop. */
971 }
972
973 check_done:
974 /* If any property is a real problem, split the interval. */
975 if (! NILP (tail))
976 {
977 temp = split_interval_right (i, position - i->position);
978 copy_properties (i, temp);
979 i = temp;
980 }
981 }
982
983 /* If we are positioned between intervals, check the stickiness of
984 both of them. We have to do this too, if we are at BEG or Z. */
985 if (position == i->position || eobp)
986 {
987 register INTERVAL prev;
988
989 if (position == BEG)
990 prev = 0;
991 else if (eobp)
992 {
993 prev = i;
994 i = 0;
995 }
996 else
997 prev = previous_interval (i);
998
999 /* Even if we are positioned between intervals, we default
1000 to the left one if it exists. We extend it now and split
1001 off a part later, if stickiness demands it. */
1002 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1003 {
1004 temp->total_length += length;
1005 CHECK_TOTAL_LENGTH (temp);
1006 temp = balance_possible_root_interval (temp);
1007 }
1008
1009 /* If at least one interval has sticky properties,
1010 we check the stickiness property by property.
1011
1012 Originally, the if condition here was this:
1013 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1014 But, these macros are now unreliable because of introduction
1015 of Vtext_property_default_nonsticky. So, we always have to
1016 check stickiness of properties one by one. If cache of
1017 stickiness is implemented in the future, we may be able to
1018 use those macros again. */
1019 if (1)
1020 {
1021 Lisp_Object pleft, pright;
1022 struct interval newi;
1023
1024 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1025 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1026 newi.plist = merge_properties_sticky (pleft, pright);
1027
1028 if (! prev) /* i.e. position == BEG */
1029 {
1030 if (! intervals_equal (i, &newi))
1031 {
1032 i = split_interval_left (i, length);
1033 i->plist = newi.plist;
1034 }
1035 }
1036 else if (! intervals_equal (prev, &newi))
1037 {
1038 prev = split_interval_right (prev,
1039 position - prev->position);
1040 prev->plist = newi.plist;
1041 if (! NULL_INTERVAL_P (i)
1042 && intervals_equal (prev, i))
1043 merge_interval_right (prev);
1044 }
1045
1046 /* We will need to update the cache here later. */
1047 }
1048 else if (! prev && ! NILP (i->plist))
1049 {
1050 /* Just split off a new interval at the left.
1051 Since I wasn't front-sticky, the empty plist is ok. */
1052 i = split_interval_left (i, length);
1053 }
1054 }
1055
1056 /* Otherwise just extend the interval. */
1057 else
1058 {
1059 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1060 {
1061 temp->total_length += length;
1062 CHECK_TOTAL_LENGTH (temp);
1063 temp = balance_possible_root_interval (temp);
1064 }
1065 }
1066
1067 return tree;
1068 }
1069
1070 /* Any property might be front-sticky on the left, rear-sticky on the left,
1071 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1072 can be arranged in a matrix with rows denoting the left conditions and
1073 columns denoting the right conditions:
1074 _ __ _
1075 _ FR FR FR FR
1076 FR__ 0 1 2 3
1077 _FR 4 5 6 7
1078 FR 8 9 A B
1079 FR C D E F
1080
1081 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1082 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1083 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1084 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1085 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1086 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1087 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1088 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1089
1090 We inherit from whoever has a sticky side facing us. If both sides
1091 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1092 non-nil value for the current property. If both sides do, then we take
1093 from the left.
1094
1095 When we inherit a property, we get its stickiness as well as its value.
1096 So, when we merge the above two lists, we expect to get this:
1097
1098 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1099 rear-nonsticky (p6 pa)
1100 p0 L p1 L p2 L p3 L p6 R p7 R
1101 pa R pb R pc L pd L pe L pf L)
1102
1103 The optimizable special cases are:
1104 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1105 left rear-nonsticky = t, right front-sticky = t (inherit right)
1106 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1107 */
1108
1109 Lisp_Object
1110 merge_properties_sticky (pleft, pright)
1111 Lisp_Object pleft, pright;
1112 {
1113 register Lisp_Object props, front, rear;
1114 Lisp_Object lfront, lrear, rfront, rrear;
1115 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1116 int use_left, use_right;
1117 int lpresent;
1118
1119 props = Qnil;
1120 front = Qnil;
1121 rear = Qnil;
1122 lfront = textget (pleft, Qfront_sticky);
1123 lrear = textget (pleft, Qrear_nonsticky);
1124 rfront = textget (pright, Qfront_sticky);
1125 rrear = textget (pright, Qrear_nonsticky);
1126
1127 /* Go through each element of PRIGHT. */
1128 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (Fcdr (tail1)))
1129 {
1130 Lisp_Object tmp;
1131
1132 sym = Fcar (tail1);
1133
1134 /* Sticky properties get special treatment. */
1135 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1136 continue;
1137
1138 rval = Fcar (Fcdr (tail1));
1139 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (Fcdr (tail2)))
1140 if (EQ (sym, Fcar (tail2)))
1141 break;
1142
1143 /* Indicate whether the property is explicitly defined on the left.
1144 (We know it is defined explicitly on the right
1145 because otherwise we don't get here.) */
1146 lpresent = ! NILP (tail2);
1147 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1148
1149 /* Even if lrear or rfront say nothing about the stickiness of
1150 SYM, Vtext_property_default_nonsticky may give default
1151 stickiness to SYM. */
1152 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1153 use_left = (lpresent
1154 && ! (TMEM (sym, lrear)
1155 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1156 use_right = (TMEM (sym, rfront)
1157 || (CONSP (tmp) && NILP (XCDR (tmp))));
1158 if (use_left && use_right)
1159 {
1160 if (NILP (lval))
1161 use_left = 0;
1162 else if (NILP (rval))
1163 use_right = 0;
1164 }
1165 if (use_left)
1166 {
1167 /* We build props as (value sym ...) rather than (sym value ...)
1168 because we plan to nreverse it when we're done. */
1169 props = Fcons (lval, Fcons (sym, props));
1170 if (TMEM (sym, lfront))
1171 front = Fcons (sym, front);
1172 if (TMEM (sym, lrear))
1173 rear = Fcons (sym, rear);
1174 }
1175 else if (use_right)
1176 {
1177 props = Fcons (rval, Fcons (sym, props));
1178 if (TMEM (sym, rfront))
1179 front = Fcons (sym, front);
1180 if (TMEM (sym, rrear))
1181 rear = Fcons (sym, rear);
1182 }
1183 }
1184
1185 /* Now go through each element of PLEFT. */
1186 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (Fcdr (tail2)))
1187 {
1188 Lisp_Object tmp;
1189
1190 sym = Fcar (tail2);
1191
1192 /* Sticky properties get special treatment. */
1193 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1194 continue;
1195
1196 /* If sym is in PRIGHT, we've already considered it. */
1197 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (Fcdr (tail1)))
1198 if (EQ (sym, Fcar (tail1)))
1199 break;
1200 if (! NILP (tail1))
1201 continue;
1202
1203 lval = Fcar (Fcdr (tail2));
1204
1205 /* Even if lrear or rfront say nothing about the stickiness of
1206 SYM, Vtext_property_default_nonsticky may give default
1207 stickiness to SYM. */
1208 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1209
1210 /* Since rval is known to be nil in this loop, the test simplifies. */
1211 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1212 {
1213 props = Fcons (lval, Fcons (sym, props));
1214 if (TMEM (sym, lfront))
1215 front = Fcons (sym, front);
1216 }
1217 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1218 {
1219 /* The value is nil, but we still inherit the stickiness
1220 from the right. */
1221 front = Fcons (sym, front);
1222 if (TMEM (sym, rrear))
1223 rear = Fcons (sym, rear);
1224 }
1225 }
1226 props = Fnreverse (props);
1227 if (! NILP (rear))
1228 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1229
1230 cat = textget (props, Qcategory);
1231 if (! NILP (front)
1232 &&
1233 /* If we have inherited a front-stick category property that is t,
1234 we don't need to set up a detailed one. */
1235 ! (! NILP (cat) && SYMBOLP (cat)
1236 && EQ (Fget (cat, Qfront_sticky), Qt)))
1237 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1238 return props;
1239 }
1240
1241 \f
1242 /* Delete a node I from its interval tree by merging its subtrees
1243 into one subtree which is then returned. Caller is responsible for
1244 storing the resulting subtree into its parent. */
1245
1246 static INTERVAL
1247 delete_node (i)
1248 register INTERVAL i;
1249 {
1250 register INTERVAL migrate, this;
1251 register int migrate_amt;
1252
1253 if (NULL_INTERVAL_P (i->left))
1254 return i->right;
1255 if (NULL_INTERVAL_P (i->right))
1256 return i->left;
1257
1258 migrate = i->left;
1259 migrate_amt = i->left->total_length;
1260 this = i->right;
1261 this->total_length += migrate_amt;
1262 while (! NULL_INTERVAL_P (this->left))
1263 {
1264 this = this->left;
1265 this->total_length += migrate_amt;
1266 }
1267 CHECK_TOTAL_LENGTH (this);
1268 this->left = migrate;
1269 SET_INTERVAL_PARENT (migrate, this);
1270
1271 return i->right;
1272 }
1273
1274 /* Delete interval I from its tree by calling `delete_node'
1275 and properly connecting the resultant subtree.
1276
1277 I is presumed to be empty; that is, no adjustments are made
1278 for the length of I. */
1279
1280 void
1281 delete_interval (i)
1282 register INTERVAL i;
1283 {
1284 register INTERVAL parent;
1285 int amt = LENGTH (i);
1286
1287 if (amt > 0) /* Only used on zero-length intervals now. */
1288 abort ();
1289
1290 if (ROOT_INTERVAL_P (i))
1291 {
1292 Lisp_Object owner;
1293 GET_INTERVAL_OBJECT (owner, i);
1294 parent = delete_node (i);
1295 if (! NULL_INTERVAL_P (parent))
1296 SET_INTERVAL_OBJECT (parent, owner);
1297
1298 if (BUFFERP (owner))
1299 BUF_INTERVALS (XBUFFER (owner)) = parent;
1300 else if (STRINGP (owner))
1301 STRING_SET_INTERVALS (owner, parent);
1302 else
1303 abort ();
1304
1305 return;
1306 }
1307
1308 parent = INTERVAL_PARENT (i);
1309 if (AM_LEFT_CHILD (i))
1310 {
1311 parent->left = delete_node (i);
1312 if (! NULL_INTERVAL_P (parent->left))
1313 SET_INTERVAL_PARENT (parent->left, parent);
1314 }
1315 else
1316 {
1317 parent->right = delete_node (i);
1318 if (! NULL_INTERVAL_P (parent->right))
1319 SET_INTERVAL_PARENT (parent->right, parent);
1320 }
1321 }
1322 \f
1323 /* Find the interval in TREE corresponding to the relative position
1324 FROM and delete as much as possible of AMOUNT from that interval.
1325 Return the amount actually deleted, and if the interval was
1326 zeroed-out, delete that interval node from the tree.
1327
1328 Note that FROM is actually origin zero, aka relative to the
1329 leftmost edge of tree. This is appropriate since we call ourselves
1330 recursively on subtrees.
1331
1332 Do this by recursing down TREE to the interval in question, and
1333 deleting the appropriate amount of text. */
1334
1335 static int
1336 interval_deletion_adjustment (tree, from, amount)
1337 register INTERVAL tree;
1338 register int from, amount;
1339 {
1340 register int relative_position = from;
1341
1342 if (NULL_INTERVAL_P (tree))
1343 return 0;
1344
1345 /* Left branch */
1346 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1347 {
1348 int subtract = interval_deletion_adjustment (tree->left,
1349 relative_position,
1350 amount);
1351 tree->total_length -= subtract;
1352 CHECK_TOTAL_LENGTH (tree);
1353 return subtract;
1354 }
1355 /* Right branch */
1356 else if (relative_position >= (TOTAL_LENGTH (tree)
1357 - RIGHT_TOTAL_LENGTH (tree)))
1358 {
1359 int subtract;
1360
1361 relative_position -= (tree->total_length
1362 - RIGHT_TOTAL_LENGTH (tree));
1363 subtract = interval_deletion_adjustment (tree->right,
1364 relative_position,
1365 amount);
1366 tree->total_length -= subtract;
1367 CHECK_TOTAL_LENGTH (tree);
1368 return subtract;
1369 }
1370 /* Here -- this node. */
1371 else
1372 {
1373 /* How much can we delete from this interval? */
1374 int my_amount = ((tree->total_length
1375 - RIGHT_TOTAL_LENGTH (tree))
1376 - relative_position);
1377
1378 if (amount > my_amount)
1379 amount = my_amount;
1380
1381 tree->total_length -= amount;
1382 CHECK_TOTAL_LENGTH (tree);
1383 if (LENGTH (tree) == 0)
1384 delete_interval (tree);
1385
1386 return amount;
1387 }
1388
1389 /* Never reach here. */
1390 }
1391
1392 /* Effect the adjustments necessary to the interval tree of BUFFER to
1393 correspond to the deletion of LENGTH characters from that buffer
1394 text. The deletion is effected at position START (which is a
1395 buffer position, i.e. origin 1). */
1396
1397 static void
1398 adjust_intervals_for_deletion (buffer, start, length)
1399 struct buffer *buffer;
1400 int start, length;
1401 {
1402 register int left_to_delete = length;
1403 register INTERVAL tree = BUF_INTERVALS (buffer);
1404 Lisp_Object parent;
1405 int offset;
1406
1407 GET_INTERVAL_OBJECT (parent, tree);
1408 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1409
1410 if (NULL_INTERVAL_P (tree))
1411 return;
1412
1413 if (start > offset + TOTAL_LENGTH (tree)
1414 || start + length > offset + TOTAL_LENGTH (tree))
1415 abort ();
1416
1417 if (length == TOTAL_LENGTH (tree))
1418 {
1419 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1420 return;
1421 }
1422
1423 if (ONLY_INTERVAL_P (tree))
1424 {
1425 tree->total_length -= length;
1426 CHECK_TOTAL_LENGTH (tree);
1427 return;
1428 }
1429
1430 if (start > offset + TOTAL_LENGTH (tree))
1431 start = offset + TOTAL_LENGTH (tree);
1432 while (left_to_delete > 0)
1433 {
1434 left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1435 left_to_delete);
1436 tree = BUF_INTERVALS (buffer);
1437 if (left_to_delete == tree->total_length)
1438 {
1439 BUF_INTERVALS (buffer) = NULL_INTERVAL;
1440 return;
1441 }
1442 }
1443 }
1444 \f
1445 /* Make the adjustments necessary to the interval tree of BUFFER to
1446 represent an addition or deletion of LENGTH characters starting
1447 at position START. Addition or deletion is indicated by the sign
1448 of LENGTH. */
1449
1450 INLINE void
1451 offset_intervals (buffer, start, length)
1452 struct buffer *buffer;
1453 int start, length;
1454 {
1455 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1456 return;
1457
1458 if (length > 0)
1459 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1460 else
1461 adjust_intervals_for_deletion (buffer, start, -length);
1462 }
1463 \f
1464 /* Merge interval I with its lexicographic successor. The resulting
1465 interval is returned, and has the properties of the original
1466 successor. The properties of I are lost. I is removed from the
1467 interval tree.
1468
1469 IMPORTANT:
1470 The caller must verify that this is not the last (rightmost)
1471 interval. */
1472
1473 INTERVAL
1474 merge_interval_right (i)
1475 register INTERVAL i;
1476 {
1477 register int absorb = LENGTH (i);
1478 register INTERVAL successor;
1479
1480 /* Zero out this interval. */
1481 i->total_length -= absorb;
1482 CHECK_TOTAL_LENGTH (i);
1483
1484 /* Find the succeeding interval. */
1485 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1486 as we descend. */
1487 {
1488 successor = i->right;
1489 while (! NULL_LEFT_CHILD (successor))
1490 {
1491 successor->total_length += absorb;
1492 CHECK_TOTAL_LENGTH (successor);
1493 successor = successor->left;
1494 }
1495
1496 successor->total_length += absorb;
1497 CHECK_TOTAL_LENGTH (successor);
1498 delete_interval (i);
1499 return successor;
1500 }
1501
1502 successor = i;
1503 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1504 we ascend. */
1505 {
1506 if (AM_LEFT_CHILD (successor))
1507 {
1508 successor = INTERVAL_PARENT (successor);
1509 delete_interval (i);
1510 return successor;
1511 }
1512
1513 successor = INTERVAL_PARENT (successor);
1514 successor->total_length -= absorb;
1515 CHECK_TOTAL_LENGTH (successor);
1516 }
1517
1518 /* This must be the rightmost or last interval and cannot
1519 be merged right. The caller should have known. */
1520 abort ();
1521 }
1522 \f
1523 /* Merge interval I with its lexicographic predecessor. The resulting
1524 interval is returned, and has the properties of the original predecessor.
1525 The properties of I are lost. Interval node I is removed from the tree.
1526
1527 IMPORTANT:
1528 The caller must verify that this is not the first (leftmost) interval. */
1529
1530 INTERVAL
1531 merge_interval_left (i)
1532 register INTERVAL i;
1533 {
1534 register int absorb = LENGTH (i);
1535 register INTERVAL predecessor;
1536
1537 /* Zero out this interval. */
1538 i->total_length -= absorb;
1539 CHECK_TOTAL_LENGTH (i);
1540
1541 /* Find the preceding interval. */
1542 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1543 adding ABSORB as we go. */
1544 {
1545 predecessor = i->left;
1546 while (! NULL_RIGHT_CHILD (predecessor))
1547 {
1548 predecessor->total_length += absorb;
1549 CHECK_TOTAL_LENGTH (predecessor);
1550 predecessor = predecessor->right;
1551 }
1552
1553 predecessor->total_length += absorb;
1554 CHECK_TOTAL_LENGTH (predecessor);
1555 delete_interval (i);
1556 return predecessor;
1557 }
1558
1559 predecessor = i;
1560 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1561 subtracting ABSORB. */
1562 {
1563 if (AM_RIGHT_CHILD (predecessor))
1564 {
1565 predecessor = INTERVAL_PARENT (predecessor);
1566 delete_interval (i);
1567 return predecessor;
1568 }
1569
1570 predecessor = INTERVAL_PARENT (predecessor);
1571 predecessor->total_length -= absorb;
1572 CHECK_TOTAL_LENGTH (predecessor);
1573 }
1574
1575 /* This must be the leftmost or first interval and cannot
1576 be merged left. The caller should have known. */
1577 abort ();
1578 }
1579 \f
1580 /* Make an exact copy of interval tree SOURCE which descends from
1581 PARENT. This is done by recursing through SOURCE, copying
1582 the current interval and its properties, and then adjusting
1583 the pointers of the copy. */
1584
1585 static INTERVAL
1586 reproduce_tree (source, parent)
1587 INTERVAL source, parent;
1588 {
1589 register INTERVAL t = make_interval ();
1590
1591 bcopy (source, t, INTERVAL_SIZE);
1592 copy_properties (source, t);
1593 SET_INTERVAL_PARENT (t, parent);
1594 if (! NULL_LEFT_CHILD (source))
1595 t->left = reproduce_tree (source->left, t);
1596 if (! NULL_RIGHT_CHILD (source))
1597 t->right = reproduce_tree (source->right, t);
1598
1599 return t;
1600 }
1601
1602 static INTERVAL
1603 reproduce_tree_obj (source, parent)
1604 INTERVAL source;
1605 Lisp_Object parent;
1606 {
1607 register INTERVAL t = make_interval ();
1608
1609 bcopy (source, t, INTERVAL_SIZE);
1610 copy_properties (source, t);
1611 SET_INTERVAL_OBJECT (t, parent);
1612 if (! NULL_LEFT_CHILD (source))
1613 t->left = reproduce_tree (source->left, t);
1614 if (! NULL_RIGHT_CHILD (source))
1615 t->right = reproduce_tree (source->right, t);
1616
1617 return t;
1618 }
1619
1620 #if 0
1621 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1622
1623 /* Make a new interval of length LENGTH starting at START in the
1624 group of intervals INTERVALS, which is actually an interval tree.
1625 Returns the new interval.
1626
1627 Generate an error if the new positions would overlap an existing
1628 interval. */
1629
1630 static INTERVAL
1631 make_new_interval (intervals, start, length)
1632 INTERVAL intervals;
1633 int start, length;
1634 {
1635 INTERVAL slot;
1636
1637 slot = find_interval (intervals, start);
1638 if (start + length > slot->position + LENGTH (slot))
1639 error ("Interval would overlap");
1640
1641 if (start == slot->position && length == LENGTH (slot))
1642 return slot;
1643
1644 if (slot->position == start)
1645 {
1646 /* New right node. */
1647 split_interval_right (slot, length);
1648 return slot;
1649 }
1650
1651 if (slot->position + LENGTH (slot) == start + length)
1652 {
1653 /* New left node. */
1654 split_interval_left (slot, LENGTH (slot) - length);
1655 return slot;
1656 }
1657
1658 /* Convert interval SLOT into three intervals. */
1659 split_interval_left (slot, start - slot->position);
1660 split_interval_right (slot, length);
1661 return slot;
1662 }
1663 #endif
1664 \f
1665 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1666 LENGTH is the length of the text in SOURCE.
1667
1668 The `position' field of the SOURCE intervals is assumed to be
1669 consistent with its parent; therefore, SOURCE must be an
1670 interval tree made with copy_interval or must be the whole
1671 tree of a buffer or a string.
1672
1673 This is used in insdel.c when inserting Lisp_Strings into the
1674 buffer. The text corresponding to SOURCE is already in the buffer
1675 when this is called. The intervals of new tree are a copy of those
1676 belonging to the string being inserted; intervals are never
1677 shared.
1678
1679 If the inserted text had no intervals associated, and we don't
1680 want to inherit the surrounding text's properties, this function
1681 simply returns -- offset_intervals should handle placing the
1682 text in the correct interval, depending on the sticky bits.
1683
1684 If the inserted text had properties (intervals), then there are two
1685 cases -- either insertion happened in the middle of some interval,
1686 or between two intervals.
1687
1688 If the text goes into the middle of an interval, then new
1689 intervals are created in the middle with only the properties of
1690 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1691 which case the new text has the union of its properties and those
1692 of the text into which it was inserted.
1693
1694 If the text goes between two intervals, then if neither interval
1695 had its appropriate sticky property set (front_sticky, rear_sticky),
1696 the new text has only its properties. If one of the sticky properties
1697 is set, then the new text "sticks" to that region and its properties
1698 depend on merging as above. If both the preceding and succeeding
1699 intervals to the new text are "sticky", then the new text retains
1700 only its properties, as if neither sticky property were set. Perhaps
1701 we should consider merging all three sets of properties onto the new
1702 text... */
1703
1704 void
1705 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1706 INTERVAL source;
1707 int position, length;
1708 struct buffer *buffer;
1709 int inherit;
1710 {
1711 register INTERVAL under, over, this, prev;
1712 register INTERVAL tree;
1713
1714 tree = BUF_INTERVALS (buffer);
1715
1716 /* If the new text has no properties, then with inheritance it
1717 becomes part of whatever interval it was inserted into.
1718 To prevent inheritance, we must clear out the properties
1719 of the newly inserted text. */
1720 if (NULL_INTERVAL_P (source))
1721 {
1722 Lisp_Object buf;
1723 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1724 {
1725 XSETBUFFER (buf, buffer);
1726 set_text_properties_1 (make_number (position),
1727 make_number (position + length),
1728 Qnil, buf, 0);
1729 }
1730 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1731 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1732 return;
1733 }
1734
1735 if (NULL_INTERVAL_P (tree))
1736 {
1737 /* The inserted text constitutes the whole buffer, so
1738 simply copy over the interval structure. */
1739 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1740 {
1741 Lisp_Object buf;
1742 XSETBUFFER (buf, buffer);
1743 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1744 BUF_INTERVALS (buffer)->position = 1;
1745
1746 /* Explicitly free the old tree here? */
1747
1748 return;
1749 }
1750
1751 /* Create an interval tree in which to place a copy
1752 of the intervals of the inserted string. */
1753 {
1754 Lisp_Object buf;
1755 XSETBUFFER (buf, buffer);
1756 tree = create_root_interval (buf);
1757 }
1758 }
1759 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1760 /* If the buffer contains only the new string, but
1761 there was already some interval tree there, then it may be
1762 some zero length intervals. Eventually, do something clever
1763 about inserting properly. For now, just waste the old intervals. */
1764 {
1765 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1766 BUF_INTERVALS (buffer)->position = 1;
1767 /* Explicitly free the old tree here. */
1768
1769 return;
1770 }
1771 /* Paranoia -- the text has already been added, so this buffer
1772 should be of non-zero length. */
1773 else if (TOTAL_LENGTH (tree) == 0)
1774 abort ();
1775
1776 this = under = find_interval (tree, position);
1777 if (NULL_INTERVAL_P (under)) /* Paranoia */
1778 abort ();
1779 over = find_interval (source, interval_start_pos (source));
1780
1781 /* Here for insertion in the middle of an interval.
1782 Split off an equivalent interval to the right,
1783 then don't bother with it any more. */
1784
1785 if (position > under->position)
1786 {
1787 INTERVAL end_unchanged
1788 = split_interval_left (this, position - under->position);
1789 copy_properties (under, end_unchanged);
1790 under->position = position;
1791 }
1792 else
1793 {
1794 /* This call may have some effect because previous_interval may
1795 update `position' fields of intervals. Thus, don't ignore it
1796 for the moment. Someone please tell me the truth (K.Handa). */
1797 prev = previous_interval (under);
1798 #if 0
1799 /* But, this code surely has no effect. And, anyway,
1800 END_NONSTICKY_P is unreliable now. */
1801 if (prev && !END_NONSTICKY_P (prev))
1802 prev = 0;
1803 #endif /* 0 */
1804 }
1805
1806 /* Insertion is now at beginning of UNDER. */
1807
1808 /* The inserted text "sticks" to the interval `under',
1809 which means it gets those properties.
1810 The properties of under are the result of
1811 adjust_intervals_for_insertion, so stickiness has
1812 already been taken care of. */
1813
1814 while (! NULL_INTERVAL_P (over))
1815 {
1816 if (LENGTH (over) < LENGTH (under))
1817 {
1818 this = split_interval_left (under, LENGTH (over));
1819 copy_properties (under, this);
1820 }
1821 else
1822 this = under;
1823 copy_properties (over, this);
1824 if (inherit)
1825 merge_properties (over, this);
1826 else
1827 copy_properties (over, this);
1828 over = next_interval (over);
1829 }
1830
1831 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1832 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1833 return;
1834 }
1835
1836 /* Get the value of property PROP from PLIST,
1837 which is the plist of an interval.
1838 We check for direct properties, for categories with property PROP,
1839 and for PROP appearing on the default-text-properties list. */
1840
1841 Lisp_Object
1842 textget (plist, prop)
1843 Lisp_Object plist;
1844 register Lisp_Object prop;
1845 {
1846 return lookup_char_property (plist, prop, 1);
1847 }
1848
1849 Lisp_Object
1850 lookup_char_property (plist, prop, textprop)
1851 Lisp_Object plist;
1852 register Lisp_Object prop;
1853 int textprop;
1854 {
1855 register Lisp_Object tail, fallback = Qnil;
1856
1857 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1858 {
1859 register Lisp_Object tem;
1860 tem = XCAR (tail);
1861 if (EQ (prop, tem))
1862 return Fcar (XCDR (tail));
1863 if (EQ (tem, Qcategory))
1864 {
1865 tem = Fcar (XCDR (tail));
1866 if (SYMBOLP (tem))
1867 fallback = Fget (tem, prop);
1868 }
1869 }
1870
1871 if (! NILP (fallback))
1872 return fallback;
1873 /* Check for alternative properties */
1874 tail = Fassq (prop, Vchar_property_alias_alist);
1875 if (NILP (tail))
1876 return tail;
1877 tail = XCDR (tail);
1878 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1879 fallback = Fplist_get (plist, XCAR (tail));
1880 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1881 fallback = Fplist_get (Vdefault_text_properties, prop);
1882 return fallback;
1883 }
1884
1885 \f
1886 /* Set point "temporarily", without checking any text properties. */
1887
1888 INLINE void
1889 temp_set_point (buffer, charpos)
1890 struct buffer *buffer;
1891 int charpos;
1892 {
1893 temp_set_point_both (buffer, charpos,
1894 buf_charpos_to_bytepos (buffer, charpos));
1895 }
1896
1897 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1898 byte position BYTEPOS. */
1899
1900 INLINE void
1901 temp_set_point_both (buffer, charpos, bytepos)
1902 int charpos, bytepos;
1903 struct buffer *buffer;
1904 {
1905 /* In a single-byte buffer, the two positions must be equal. */
1906 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1907 && charpos != bytepos)
1908 abort ();
1909
1910 if (charpos > bytepos)
1911 abort ();
1912
1913 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1914 abort ();
1915
1916 BUF_PT_BYTE (buffer) = bytepos;
1917 BUF_PT (buffer) = charpos;
1918 }
1919
1920 /* Set point in BUFFER to CHARPOS. If the target position is
1921 before an intangible character, move to an ok place. */
1922
1923 void
1924 set_point (buffer, charpos)
1925 register struct buffer *buffer;
1926 register int charpos;
1927 {
1928 set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
1929 }
1930
1931 /* If there's an invisible character at position POS + TEST_OFFS in the
1932 current buffer, and the invisible property has a `stickiness' such that
1933 inserting a character at position POS would inherit the property it,
1934 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1935 then intangibility is required as well as invisibleness.
1936
1937 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1938
1939 Note that `stickiness' is determined by overlay marker insertion types,
1940 if the invisible property comes from an overlay. */
1941
1942 static int
1943 adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1944 int pos, test_offs, adj, test_intang;
1945 {
1946 Lisp_Object invis_propval, invis_overlay;
1947 Lisp_Object test_pos;
1948
1949 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1950 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1951 return pos;
1952
1953 test_pos = make_number (pos + test_offs);
1954
1955 invis_propval
1956 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1957 &invis_overlay);
1958
1959 if ((!test_intang
1960 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1961 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1962 /* This next test is true if the invisible property has a stickiness
1963 such that an insertion at POS would inherit it. */
1964 && (NILP (invis_overlay)
1965 /* Invisible property is from a text-property. */
1966 ? (text_property_stickiness (Qinvisible, make_number (pos))
1967 == (test_offs == 0 ? 1 : -1))
1968 /* Invisible property is from an overlay. */
1969 : (test_offs == 0
1970 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1971 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1972 pos += adj;
1973
1974 return pos;
1975 }
1976
1977 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1978 position BYTEPOS. If the target position is
1979 before an intangible character, move to an ok place. */
1980
1981 void
1982 set_point_both (buffer, charpos, bytepos)
1983 register struct buffer *buffer;
1984 register int charpos, bytepos;
1985 {
1986 register INTERVAL to, from, toprev, fromprev;
1987 int buffer_point;
1988 int old_position = BUF_PT (buffer);
1989 int backwards = (charpos < old_position ? 1 : 0);
1990 int have_overlays;
1991 int original_position;
1992
1993 buffer->point_before_scroll = Qnil;
1994
1995 if (charpos == BUF_PT (buffer))
1996 return;
1997
1998 /* In a single-byte buffer, the two positions must be equal. */
1999 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
2000 && charpos != bytepos)
2001 abort ();
2002
2003 /* Check this now, before checking if the buffer has any intervals.
2004 That way, we can catch conditions which break this sanity check
2005 whether or not there are intervals in the buffer. */
2006 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
2007 abort ();
2008
2009 have_overlays = (! NILP (buffer->overlays_before)
2010 || ! NILP (buffer->overlays_after));
2011
2012 /* If we have no text properties and overlays,
2013 then we can do it quickly. */
2014 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) && ! have_overlays)
2015 {
2016 temp_set_point_both (buffer, charpos, bytepos);
2017 return;
2018 }
2019
2020 /* Set TO to the interval containing the char after CHARPOS,
2021 and TOPREV to the interval containing the char before CHARPOS.
2022 Either one may be null. They may be equal. */
2023 to = find_interval (BUF_INTERVALS (buffer), charpos);
2024 if (charpos == BUF_BEGV (buffer))
2025 toprev = 0;
2026 else if (to && to->position == charpos)
2027 toprev = previous_interval (to);
2028 else
2029 toprev = to;
2030
2031 buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
2032 ? BUF_ZV (buffer) - 1
2033 : BUF_PT (buffer));
2034
2035 /* Set FROM to the interval containing the char after PT,
2036 and FROMPREV to the interval containing the char before PT.
2037 Either one may be null. They may be equal. */
2038 /* We could cache this and save time. */
2039 from = find_interval (BUF_INTERVALS (buffer), buffer_point);
2040 if (buffer_point == BUF_BEGV (buffer))
2041 fromprev = 0;
2042 else if (from && from->position == BUF_PT (buffer))
2043 fromprev = previous_interval (from);
2044 else if (buffer_point != BUF_PT (buffer))
2045 fromprev = from, from = 0;
2046 else
2047 fromprev = from;
2048
2049 /* Moving within an interval. */
2050 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2051 && ! have_overlays)
2052 {
2053 temp_set_point_both (buffer, charpos, bytepos);
2054 return;
2055 }
2056
2057 original_position = charpos;
2058
2059 /* If the new position is between two intangible characters
2060 with the same intangible property value,
2061 move forward or backward until a change in that property. */
2062 if (NILP (Vinhibit_point_motion_hooks)
2063 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2064 || have_overlays)
2065 /* Intangibility never stops us from positioning at the beginning
2066 or end of the buffer, so don't bother checking in that case. */
2067 && charpos != BEGV && charpos != ZV)
2068 {
2069 Lisp_Object pos;
2070 Lisp_Object intangible_propval;
2071
2072 if (backwards)
2073 {
2074 /* If the preceding character is both intangible and invisible,
2075 and the invisible property is `rear-sticky', perturb it so
2076 that the search starts one character earlier -- this ensures
2077 that point can never move to the end of an invisible/
2078 intangible/rear-sticky region. */
2079 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2080
2081 XSETINT (pos, charpos);
2082
2083 /* If following char is intangible,
2084 skip back over all chars with matching intangible property. */
2085
2086 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2087
2088 if (! NILP (intangible_propval))
2089 {
2090 while (XINT (pos) > BUF_BEGV (buffer)
2091 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2092 Qintangible, Qnil),
2093 intangible_propval))
2094 pos = Fprevious_char_property_change (pos, Qnil);
2095
2096 /* Set CHARPOS from POS, and if the final intangible character
2097 that we skipped over is also invisible, and the invisible
2098 property is `front-sticky', perturb it to be one character
2099 earlier -- this ensures that point can never move to the
2100 beginning of an invisible/intangible/front-sticky region. */
2101 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2102 }
2103 }
2104 else
2105 {
2106 /* If the following character is both intangible and invisible,
2107 and the invisible property is `front-sticky', perturb it so
2108 that the search starts one character later -- this ensures
2109 that point can never move to the beginning of an
2110 invisible/intangible/front-sticky region. */
2111 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2112
2113 XSETINT (pos, charpos);
2114
2115 /* If preceding char is intangible,
2116 skip forward over all chars with matching intangible property. */
2117
2118 intangible_propval = Fget_char_property (make_number (charpos - 1),
2119 Qintangible, Qnil);
2120
2121 if (! NILP (intangible_propval))
2122 {
2123 while (XINT (pos) < BUF_ZV (buffer)
2124 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2125 intangible_propval))
2126 pos = Fnext_char_property_change (pos, Qnil);
2127
2128 /* Set CHARPOS from POS, and if the final intangible character
2129 that we skipped over is also invisible, and the invisible
2130 property is `rear-sticky', perturb it to be one character
2131 later -- this ensures that point can never move to the
2132 end of an invisible/intangible/rear-sticky region. */
2133 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2134 }
2135 }
2136
2137 bytepos = buf_charpos_to_bytepos (buffer, charpos);
2138 }
2139
2140 if (charpos != original_position)
2141 {
2142 /* Set TO to the interval containing the char after CHARPOS,
2143 and TOPREV to the interval containing the char before CHARPOS.
2144 Either one may be null. They may be equal. */
2145 to = find_interval (BUF_INTERVALS (buffer), charpos);
2146 if (charpos == BUF_BEGV (buffer))
2147 toprev = 0;
2148 else if (to && to->position == charpos)
2149 toprev = previous_interval (to);
2150 else
2151 toprev = to;
2152 }
2153
2154 /* Here TO is the interval after the stopping point
2155 and TOPREV is the interval before the stopping point.
2156 One or the other may be null. */
2157
2158 temp_set_point_both (buffer, charpos, bytepos);
2159
2160 /* We run point-left and point-entered hooks here, iff the
2161 two intervals are not equivalent. These hooks take
2162 (old_point, new_point) as arguments. */
2163 if (NILP (Vinhibit_point_motion_hooks)
2164 && (! intervals_equal (from, to)
2165 || ! intervals_equal (fromprev, toprev)))
2166 {
2167 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2168
2169 if (fromprev)
2170 leave_after = textget (fromprev->plist, Qpoint_left);
2171 else
2172 leave_after = Qnil;
2173 if (from)
2174 leave_before = textget (from->plist, Qpoint_left);
2175 else
2176 leave_before = Qnil;
2177
2178 if (toprev)
2179 enter_after = textget (toprev->plist, Qpoint_entered);
2180 else
2181 enter_after = Qnil;
2182 if (to)
2183 enter_before = textget (to->plist, Qpoint_entered);
2184 else
2185 enter_before = Qnil;
2186
2187 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2188 call2 (leave_before, make_number (old_position),
2189 make_number (charpos));
2190 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2191 call2 (leave_after, make_number (old_position),
2192 make_number (charpos));
2193
2194 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2195 call2 (enter_before, make_number (old_position),
2196 make_number (charpos));
2197 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2198 call2 (enter_after, make_number (old_position),
2199 make_number (charpos));
2200 }
2201 }
2202 \f
2203 /* Move point to POSITION, unless POSITION is inside an intangible
2204 segment that reaches all the way to point. */
2205
2206 void
2207 move_if_not_intangible (position)
2208 int position;
2209 {
2210 Lisp_Object pos;
2211 Lisp_Object intangible_propval;
2212
2213 XSETINT (pos, position);
2214
2215 if (! NILP (Vinhibit_point_motion_hooks))
2216 /* If intangible is inhibited, always move point to POSITION. */
2217 ;
2218 else if (PT < position && XINT (pos) < ZV)
2219 {
2220 /* We want to move forward, so check the text before POSITION. */
2221
2222 intangible_propval = Fget_char_property (pos,
2223 Qintangible, Qnil);
2224
2225 /* If following char is intangible,
2226 skip back over all chars with matching intangible property. */
2227 if (! NILP (intangible_propval))
2228 while (XINT (pos) > BEGV
2229 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2230 Qintangible, Qnil),
2231 intangible_propval))
2232 pos = Fprevious_char_property_change (pos, Qnil);
2233 }
2234 else if (XINT (pos) > BEGV)
2235 {
2236 /* We want to move backward, so check the text after POSITION. */
2237
2238 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2239 Qintangible, Qnil);
2240
2241 /* If following char is intangible,
2242 skip forward over all chars with matching intangible property. */
2243 if (! NILP (intangible_propval))
2244 while (XINT (pos) < ZV
2245 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2246 intangible_propval))
2247 pos = Fnext_char_property_change (pos, Qnil);
2248
2249 }
2250
2251 /* If the whole stretch between PT and POSITION isn't intangible,
2252 try moving to POSITION (which means we actually move farther
2253 if POSITION is inside of intangible text). */
2254
2255 if (XINT (pos) != PT)
2256 SET_PT (position);
2257 }
2258 \f
2259 /* If text at position POS has property PROP, set *VAL to the property
2260 value, *START and *END to the beginning and end of a region that
2261 has the same property, and return 1. Otherwise return 0.
2262
2263 OBJECT is the string or buffer to look for the property in;
2264 nil means the current buffer. */
2265
2266 int
2267 get_property_and_range (pos, prop, val, start, end, object)
2268 int pos;
2269 Lisp_Object prop, *val;
2270 int *start, *end;
2271 Lisp_Object object;
2272 {
2273 INTERVAL i, prev, next;
2274
2275 if (NILP (object))
2276 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2277 else if (BUFFERP (object))
2278 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2279 else if (STRINGP (object))
2280 i = find_interval (STRING_INTERVALS (object), pos);
2281 else
2282 abort ();
2283
2284 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2285 return 0;
2286 *val = textget (i->plist, prop);
2287 if (NILP (*val))
2288 return 0;
2289
2290 next = i; /* remember it in advance */
2291 prev = previous_interval (i);
2292 while (! NULL_INTERVAL_P (prev)
2293 && EQ (*val, textget (prev->plist, prop)))
2294 i = prev, prev = previous_interval (prev);
2295 *start = i->position;
2296
2297 next = next_interval (i);
2298 while (! NULL_INTERVAL_P (next)
2299 && EQ (*val, textget (next->plist, prop)))
2300 i = next, next = next_interval (next);
2301 *end = i->position + LENGTH (i);
2302
2303 return 1;
2304 }
2305 \f
2306 /* Return the proper local keymap TYPE for position POSITION in
2307 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2308 specified by the PROP property, if any. Otherwise, if TYPE is
2309 `local-map' use BUFFER's local map. */
2310
2311 Lisp_Object
2312 get_local_map (position, buffer, type)
2313 register int position;
2314 register struct buffer *buffer;
2315 Lisp_Object type;
2316 {
2317 Lisp_Object prop, lispy_position, lispy_buffer;
2318 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2319
2320 /* Perhaps we should just change `position' to the limit. */
2321 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
2322 abort ();
2323
2324 /* Ignore narrowing, so that a local map continues to be valid even if
2325 the visible region contains no characters and hence no properties. */
2326 old_begv = BUF_BEGV (buffer);
2327 old_zv = BUF_ZV (buffer);
2328 old_begv_byte = BUF_BEGV_BYTE (buffer);
2329 old_zv_byte = BUF_ZV_BYTE (buffer);
2330 BUF_BEGV (buffer) = BUF_BEG (buffer);
2331 BUF_ZV (buffer) = BUF_Z (buffer);
2332 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2333 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2334
2335 /* There are no properties at the end of the buffer, so in that case
2336 check for a local map on the last character of the buffer instead. */
2337 if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer))
2338 --position;
2339 XSETFASTINT (lispy_position, position);
2340 XSETBUFFER (lispy_buffer, buffer);
2341 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2342
2343 BUF_BEGV (buffer) = old_begv;
2344 BUF_ZV (buffer) = old_zv;
2345 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2346 BUF_ZV_BYTE (buffer) = old_zv_byte;
2347
2348 /* Use the local map only if it is valid. */
2349 prop = get_keymap (prop, 0, 0);
2350 if (CONSP (prop))
2351 return prop;
2352
2353 if (EQ (type, Qkeymap))
2354 return Qnil;
2355 else
2356 return buffer->keymap;
2357 }
2358 \f
2359 /* Produce an interval tree reflecting the intervals in
2360 TREE from START to START + LENGTH.
2361 The new interval tree has no parent and has a starting-position of 0. */
2362
2363 INTERVAL
2364 copy_intervals (tree, start, length)
2365 INTERVAL tree;
2366 int start, length;
2367 {
2368 register INTERVAL i, new, t;
2369 register int got, prevlen;
2370
2371 if (NULL_INTERVAL_P (tree) || length <= 0)
2372 return NULL_INTERVAL;
2373
2374 i = find_interval (tree, start);
2375 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2376 abort ();
2377
2378 /* If there is only one interval and it's the default, return nil. */
2379 if ((start - i->position + 1 + length) < LENGTH (i)
2380 && DEFAULT_INTERVAL_P (i))
2381 return NULL_INTERVAL;
2382
2383 new = make_interval ();
2384 new->position = 0;
2385 got = (LENGTH (i) - (start - i->position));
2386 new->total_length = length;
2387 CHECK_TOTAL_LENGTH (new);
2388 copy_properties (i, new);
2389
2390 t = new;
2391 prevlen = got;
2392 while (got < length)
2393 {
2394 i = next_interval (i);
2395 t = split_interval_right (t, prevlen);
2396 copy_properties (i, t);
2397 prevlen = LENGTH (i);
2398 got += prevlen;
2399 }
2400
2401 return balance_an_interval (new);
2402 }
2403
2404 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2405
2406 INLINE void
2407 copy_intervals_to_string (string, buffer, position, length)
2408 Lisp_Object string;
2409 struct buffer *buffer;
2410 int position, length;
2411 {
2412 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2413 position, length);
2414 if (NULL_INTERVAL_P (interval_copy))
2415 return;
2416
2417 SET_INTERVAL_OBJECT (interval_copy, string);
2418 STRING_SET_INTERVALS (string, interval_copy);
2419 }
2420 \f
2421 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2422 Assume they have identical characters. */
2423
2424 int
2425 compare_string_intervals (s1, s2)
2426 Lisp_Object s1, s2;
2427 {
2428 INTERVAL i1, i2;
2429 int pos = 0;
2430 int end = SCHARS (s1);
2431
2432 i1 = find_interval (STRING_INTERVALS (s1), 0);
2433 i2 = find_interval (STRING_INTERVALS (s2), 0);
2434
2435 while (pos < end)
2436 {
2437 /* Determine how far we can go before we reach the end of I1 or I2. */
2438 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2439 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2440 int distance = min (len1, len2);
2441
2442 /* If we ever find a mismatch between the strings,
2443 they differ. */
2444 if (! intervals_equal (i1, i2))
2445 return 0;
2446
2447 /* Advance POS till the end of the shorter interval,
2448 and advance one or both interval pointers for the new position. */
2449 pos += distance;
2450 if (len1 == distance)
2451 i1 = next_interval (i1);
2452 if (len2 == distance)
2453 i2 = next_interval (i2);
2454 }
2455 return 1;
2456 }
2457 \f
2458 /* Recursively adjust interval I in the current buffer
2459 for setting enable_multibyte_characters to MULTI_FLAG.
2460 The range of interval I is START ... END in characters,
2461 START_BYTE ... END_BYTE in bytes. */
2462
2463 static void
2464 set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2465 INTERVAL i;
2466 int multi_flag;
2467 int start, start_byte, end, end_byte;
2468 {
2469 /* Fix the length of this interval. */
2470 if (multi_flag)
2471 i->total_length = end - start;
2472 else
2473 i->total_length = end_byte - start_byte;
2474 CHECK_TOTAL_LENGTH (i);
2475
2476 if (TOTAL_LENGTH (i) == 0)
2477 {
2478 delete_interval (i);
2479 return;
2480 }
2481
2482 /* Recursively fix the length of the subintervals. */
2483 if (i->left)
2484 {
2485 int left_end, left_end_byte;
2486
2487 if (multi_flag)
2488 {
2489 int temp;
2490 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2491 left_end = BYTE_TO_CHAR (left_end_byte);
2492
2493 temp = CHAR_TO_BYTE (left_end);
2494
2495 /* If LEFT_END_BYTE is in the middle of a character,
2496 adjust it and LEFT_END to a char boundary. */
2497 if (left_end_byte > temp)
2498 {
2499 left_end_byte = temp;
2500 }
2501 if (left_end_byte < temp)
2502 {
2503 left_end--;
2504 left_end_byte = CHAR_TO_BYTE (left_end);
2505 }
2506 }
2507 else
2508 {
2509 left_end = start + LEFT_TOTAL_LENGTH (i);
2510 left_end_byte = CHAR_TO_BYTE (left_end);
2511 }
2512
2513 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2514 left_end, left_end_byte);
2515 }
2516 if (i->right)
2517 {
2518 int right_start_byte, right_start;
2519
2520 if (multi_flag)
2521 {
2522 int temp;
2523
2524 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2525 right_start = BYTE_TO_CHAR (right_start_byte);
2526
2527 /* If RIGHT_START_BYTE is in the middle of a character,
2528 adjust it and RIGHT_START to a char boundary. */
2529 temp = CHAR_TO_BYTE (right_start);
2530
2531 if (right_start_byte < temp)
2532 {
2533 right_start_byte = temp;
2534 }
2535 if (right_start_byte > temp)
2536 {
2537 right_start++;
2538 right_start_byte = CHAR_TO_BYTE (right_start);
2539 }
2540 }
2541 else
2542 {
2543 right_start = end - RIGHT_TOTAL_LENGTH (i);
2544 right_start_byte = CHAR_TO_BYTE (right_start);
2545 }
2546
2547 set_intervals_multibyte_1 (i->right, multi_flag,
2548 right_start, right_start_byte,
2549 end, end_byte);
2550 }
2551
2552 /* Rounding to char boundaries can theoretically ake this interval
2553 spurious. If so, delete one child, and copy its property list
2554 to this interval. */
2555 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2556 {
2557 if ((i)->left)
2558 {
2559 (i)->plist = (i)->left->plist;
2560 (i)->left->total_length = 0;
2561 delete_interval ((i)->left);
2562 }
2563 else
2564 {
2565 (i)->plist = (i)->right->plist;
2566 (i)->right->total_length = 0;
2567 delete_interval ((i)->right);
2568 }
2569 }
2570 }
2571
2572 /* Update the intervals of the current buffer
2573 to fit the contents as multibyte (if MULTI_FLAG is 1)
2574 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2575
2576 void
2577 set_intervals_multibyte (multi_flag)
2578 int multi_flag;
2579 {
2580 if (BUF_INTERVALS (current_buffer))
2581 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2582 BEG, BEG_BYTE, Z, Z_BYTE);
2583 }