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