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