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