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