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