Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
[bpt/emacs.git] / src / intervals.c
1 /* Code for doing intervals.
2 Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20
21 /* NOTES:
22
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
25
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
28
29 Need to call *_left_hook when buffer is killed.
30
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
33
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
36 to GC them.
37
38 */
39
40
41 #include <config.h>
42 #include <setjmp.h>
43 #include "lisp.h"
44 #include "intervals.h"
45 #include "buffer.h"
46 #include "puresize.h"
47 #include "keyboard.h"
48 #include "keymap.h"
49
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
51 universal set. */
52
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
54
55 Lisp_Object merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright);
56 static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
57 static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
58 \f
59 /* Utility functions for intervals. */
60
61
62 /* Create the root interval of some object, a buffer or string. */
63
64 INTERVAL
65 create_root_interval (Lisp_Object parent)
66 {
67 INTERVAL new;
68
69 CHECK_IMPURE (parent);
70
71 new = make_interval ();
72
73 if (BUFFERP (parent))
74 {
75 new->total_length = (BUF_Z (XBUFFER (parent))
76 - BUF_BEG (XBUFFER (parent)));
77 CHECK_TOTAL_LENGTH (new);
78 BUF_INTERVALS (XBUFFER (parent)) = new;
79 new->position = BEG;
80 }
81 else if (STRINGP (parent))
82 {
83 new->total_length = SCHARS (parent);
84 CHECK_TOTAL_LENGTH (new);
85 STRING_SET_INTERVALS (parent, new);
86 new->position = 0;
87 }
88
89 SET_INTERVAL_OBJECT (new, parent);
90
91 return new;
92 }
93
94 /* Make the interval TARGET have exactly the properties of SOURCE */
95
96 void
97 copy_properties (register INTERVAL source, register INTERVAL target)
98 {
99 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
100 return;
101
102 COPY_INTERVAL_CACHE (source, target);
103 target->plist = Fcopy_sequence (source->plist);
104 }
105
106 /* Merge the properties of interval SOURCE into the properties
107 of interval TARGET. That is to say, each property in SOURCE
108 is added to TARGET if TARGET has no such property as yet. */
109
110 static void
111 merge_properties (register INTERVAL source, register INTERVAL target)
112 {
113 register Lisp_Object o, sym, val;
114
115 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
116 return;
117
118 MERGE_INTERVAL_CACHE (source, target);
119
120 o = source->plist;
121 while (CONSP (o))
122 {
123 sym = XCAR (o);
124 o = XCDR (o);
125 CHECK_CONS (o);
126
127 val = target->plist;
128 while (CONSP (val) && !EQ (XCAR (val), sym))
129 {
130 val = XCDR (val);
131 if (!CONSP (val))
132 break;
133 val = XCDR (val);
134 }
135
136 if (NILP (val))
137 {
138 val = XCAR (o);
139 target->plist = Fcons (sym, Fcons (val, target->plist));
140 }
141 o = XCDR (o);
142 }
143 }
144
145 /* Return 1 if the two intervals have the same properties,
146 0 otherwise. */
147
148 int
149 intervals_equal (INTERVAL i0, INTERVAL i1)
150 {
151 register Lisp_Object i0_cdr, i0_sym;
152 register Lisp_Object i1_cdr, i1_val;
153
154 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
155 return 1;
156
157 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
158 return 0;
159
160 i0_cdr = i0->plist;
161 i1_cdr = i1->plist;
162 while (CONSP (i0_cdr) && CONSP (i1_cdr))
163 {
164 i0_sym = XCAR (i0_cdr);
165 i0_cdr = XCDR (i0_cdr);
166 if (!CONSP (i0_cdr))
167 return 0; /* abort (); */
168 i1_val = i1->plist;
169 while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
170 {
171 i1_val = XCDR (i1_val);
172 if (!CONSP (i1_val))
173 return 0; /* abort (); */
174 i1_val = XCDR (i1_val);
175 }
176
177 /* i0 has something i1 doesn't. */
178 if (EQ (i1_val, Qnil))
179 return 0;
180
181 /* i0 and i1 both have sym, but it has different values in each. */
182 if (!CONSP (i1_val)
183 || (i1_val = XCDR (i1_val), !CONSP (i1_val))
184 || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
185 return 0;
186
187 i0_cdr = XCDR (i0_cdr);
188
189 i1_cdr = XCDR (i1_cdr);
190 if (!CONSP (i1_cdr))
191 return 0; /* abort (); */
192 i1_cdr = XCDR (i1_cdr);
193 }
194
195 /* Lengths of the two plists were equal. */
196 return (NILP (i0_cdr) && NILP (i1_cdr));
197 }
198 \f
199
200 /* Traverse an interval tree TREE, performing FUNCTION on each node.
201 No guarantee is made about the order of traversal.
202 Pass FUNCTION two args: an interval, and ARG. */
203
204 void
205 traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
206 {
207 /* Minimize stack usage. */
208 while (!NULL_INTERVAL_P (tree))
209 {
210 (*function) (tree, arg);
211 if (NULL_INTERVAL_P (tree->right))
212 tree = tree->left;
213 else
214 {
215 traverse_intervals_noorder (tree->left, function, arg);
216 tree = tree->right;
217 }
218 }
219 }
220
221 /* Traverse an interval tree TREE, performing FUNCTION on each node.
222 Pass FUNCTION two args: an interval, and ARG. */
223
224 void
225 traverse_intervals (INTERVAL tree, int position, 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 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 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 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, int offset)
506 {
507 INTERVAL new = make_interval ();
508 int position = interval->position;
509 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, int offset)
551 {
552 INTERVAL new = make_interval ();
553 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 int position)
617 {
618 /* The distance from the left edge of the subtree at TREE
619 to POSITION. */
620 register 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 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, 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, int position, int length)
868 {
869 register INTERVAL i;
870 register INTERVAL temp;
871 int eobp = 0;
872 Lisp_Object parent;
873 int offset;
874
875 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
876 abort ();
877
878 GET_INTERVAL_OBJECT (parent, tree);
879 offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
880
881 /* If inserting at point-max of a buffer, that position will be out
882 of range. Remember that buffer positions are 1-based. */
883 if (position >= TOTAL_LENGTH (tree) + offset)
884 {
885 position = TOTAL_LENGTH (tree) + offset;
886 eobp = 1;
887 }
888
889 i = find_interval (tree, position);
890
891 /* If in middle of an interval which is not sticky either way,
892 we must not just give its properties to the insertion.
893 So split this interval at the insertion point.
894
895 Originally, the if condition here was this:
896 (! (position == i->position || eobp)
897 && END_NONSTICKY_P (i)
898 && FRONT_NONSTICKY_P (i))
899 But, these macros are now unreliable because of introduction of
900 Vtext_property_default_nonsticky. So, we always check properties
901 one by one if POSITION is in middle of an interval. */
902 if (! (position == i->position || eobp))
903 {
904 Lisp_Object tail;
905 Lisp_Object front, rear;
906
907 tail = i->plist;
908
909 /* Properties font-sticky and rear-nonsticky override
910 Vtext_property_default_nonsticky. So, if they are t, we can
911 skip one by one checking of properties. */
912 rear = textget (i->plist, Qrear_nonsticky);
913 if (! CONSP (rear) && ! NILP (rear))
914 {
915 /* All properties are nonsticky. We split the interval. */
916 goto check_done;
917 }
918 front = textget (i->plist, Qfront_sticky);
919 if (! CONSP (front) && ! NILP (front))
920 {
921 /* All properties are sticky. We don't split the interval. */
922 tail = Qnil;
923 goto check_done;
924 }
925
926 /* Does any actual property pose an actual problem? We break
927 the loop if we find a nonsticky property. */
928 for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
929 {
930 Lisp_Object prop, tmp;
931 prop = XCAR (tail);
932
933 /* Is this particular property front-sticky? */
934 if (CONSP (front) && ! NILP (Fmemq (prop, front)))
935 continue;
936
937 /* Is this particular property rear-nonsticky? */
938 if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
939 break;
940
941 /* Is this particular property recorded as sticky or
942 nonsticky in Vtext_property_default_nonsticky? */
943 tmp = Fassq (prop, Vtext_property_default_nonsticky);
944 if (CONSP (tmp))
945 {
946 if (NILP (tmp))
947 continue;
948 break;
949 }
950
951 /* By default, a text property is rear-sticky, thus we
952 continue the loop. */
953 }
954
955 check_done:
956 /* If any property is a real problem, split the interval. */
957 if (! NILP (tail))
958 {
959 temp = split_interval_right (i, position - i->position);
960 copy_properties (i, temp);
961 i = temp;
962 }
963 }
964
965 /* If we are positioned between intervals, check the stickiness of
966 both of them. We have to do this too, if we are at BEG or Z. */
967 if (position == i->position || eobp)
968 {
969 register INTERVAL prev;
970
971 if (position == BEG)
972 prev = 0;
973 else if (eobp)
974 {
975 prev = i;
976 i = 0;
977 }
978 else
979 prev = previous_interval (i);
980
981 /* Even if we are positioned between intervals, we default
982 to the left one if it exists. We extend it now and split
983 off a part later, if stickiness demands it. */
984 for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
985 {
986 temp->total_length += length;
987 CHECK_TOTAL_LENGTH (temp);
988 temp = balance_possible_root_interval (temp);
989 }
990
991 /* If at least one interval has sticky properties,
992 we check the stickiness property by property.
993
994 Originally, the if condition here was this:
995 (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
996 But, these macros are now unreliable because of introduction
997 of Vtext_property_default_nonsticky. So, we always have to
998 check stickiness of properties one by one. If cache of
999 stickiness is implemented in the future, we may be able to
1000 use those macros again. */
1001 if (1)
1002 {
1003 Lisp_Object pleft, pright;
1004 struct interval newi;
1005
1006 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1007 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1008 newi.plist = merge_properties_sticky (pleft, pright);
1009
1010 if (! prev) /* i.e. position == BEG */
1011 {
1012 if (! intervals_equal (i, &newi))
1013 {
1014 i = split_interval_left (i, length);
1015 i->plist = newi.plist;
1016 }
1017 }
1018 else if (! intervals_equal (prev, &newi))
1019 {
1020 prev = split_interval_right (prev,
1021 position - prev->position);
1022 prev->plist = newi.plist;
1023 if (! NULL_INTERVAL_P (i)
1024 && intervals_equal (prev, i))
1025 merge_interval_right (prev);
1026 }
1027
1028 /* We will need to update the cache here later. */
1029 }
1030 else if (! prev && ! NILP (i->plist))
1031 {
1032 /* Just split off a new interval at the left.
1033 Since I wasn't front-sticky, the empty plist is ok. */
1034 i = split_interval_left (i, length);
1035 }
1036 }
1037
1038 /* Otherwise just extend the interval. */
1039 else
1040 {
1041 for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1042 {
1043 temp->total_length += length;
1044 CHECK_TOTAL_LENGTH (temp);
1045 temp = balance_possible_root_interval (temp);
1046 }
1047 }
1048
1049 return tree;
1050 }
1051
1052 /* Any property might be front-sticky on the left, rear-sticky on the left,
1053 front-sticky on the right, or rear-sticky on the right; the 16 combinations
1054 can be arranged in a matrix with rows denoting the left conditions and
1055 columns denoting the right conditions:
1056 _ __ _
1057 _ FR FR FR FR
1058 FR__ 0 1 2 3
1059 _FR 4 5 6 7
1060 FR 8 9 A B
1061 FR C D E F
1062
1063 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1064 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1065 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1066 p8 L p9 L pa L pb L pc L pd L pe L pf L)
1067 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1068 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1069 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1070 p8 R p9 R pa R pb R pc R pd R pe R pf R)
1071
1072 We inherit from whoever has a sticky side facing us. If both sides
1073 do (cases 2, 3, E, and F), then we inherit from whichever side has a
1074 non-nil value for the current property. If both sides do, then we take
1075 from the left.
1076
1077 When we inherit a property, we get its stickiness as well as its value.
1078 So, when we merge the above two lists, we expect to get this:
1079
1080 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1081 rear-nonsticky (p6 pa)
1082 p0 L p1 L p2 L p3 L p6 R p7 R
1083 pa R pb R pc L pd L pe L pf L)
1084
1085 The optimizable special cases are:
1086 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1087 left rear-nonsticky = t, right front-sticky = t (inherit right)
1088 left rear-nonsticky = t, right front-sticky = nil (inherit none)
1089 */
1090
1091 Lisp_Object
1092 merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
1093 {
1094 register Lisp_Object props, front, rear;
1095 Lisp_Object lfront, lrear, rfront, rrear;
1096 register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1097 int use_left, use_right;
1098 int lpresent;
1099
1100 props = Qnil;
1101 front = Qnil;
1102 rear = Qnil;
1103 lfront = textget (pleft, Qfront_sticky);
1104 lrear = textget (pleft, Qrear_nonsticky);
1105 rfront = textget (pright, Qfront_sticky);
1106 rrear = textget (pright, Qrear_nonsticky);
1107
1108 /* Go through each element of PRIGHT. */
1109 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1110 {
1111 Lisp_Object tmp;
1112
1113 sym = XCAR (tail1);
1114
1115 /* Sticky properties get special treatment. */
1116 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1117 continue;
1118
1119 rval = Fcar (XCDR (tail1));
1120 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1121 if (EQ (sym, XCAR (tail2)))
1122 break;
1123
1124 /* Indicate whether the property is explicitly defined on the left.
1125 (We know it is defined explicitly on the right
1126 because otherwise we don't get here.) */
1127 lpresent = ! NILP (tail2);
1128 lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1129
1130 /* Even if lrear or rfront say nothing about the stickiness of
1131 SYM, Vtext_property_default_nonsticky may give default
1132 stickiness to SYM. */
1133 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1134 use_left = (lpresent
1135 && ! (TMEM (sym, lrear)
1136 || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1137 use_right = (TMEM (sym, rfront)
1138 || (CONSP (tmp) && NILP (XCDR (tmp))));
1139 if (use_left && use_right)
1140 {
1141 if (NILP (lval))
1142 use_left = 0;
1143 else if (NILP (rval))
1144 use_right = 0;
1145 }
1146 if (use_left)
1147 {
1148 /* We build props as (value sym ...) rather than (sym value ...)
1149 because we plan to nreverse it when we're done. */
1150 props = Fcons (lval, Fcons (sym, props));
1151 if (TMEM (sym, lfront))
1152 front = Fcons (sym, front);
1153 if (TMEM (sym, lrear))
1154 rear = Fcons (sym, rear);
1155 }
1156 else if (use_right)
1157 {
1158 props = Fcons (rval, Fcons (sym, props));
1159 if (TMEM (sym, rfront))
1160 front = Fcons (sym, front);
1161 if (TMEM (sym, rrear))
1162 rear = Fcons (sym, rear);
1163 }
1164 }
1165
1166 /* Now go through each element of PLEFT. */
1167 for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1168 {
1169 Lisp_Object tmp;
1170
1171 sym = XCAR (tail2);
1172
1173 /* Sticky properties get special treatment. */
1174 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1175 continue;
1176
1177 /* If sym is in PRIGHT, we've already considered it. */
1178 for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1179 if (EQ (sym, XCAR (tail1)))
1180 break;
1181 if (! NILP (tail1))
1182 continue;
1183
1184 lval = Fcar (XCDR (tail2));
1185
1186 /* Even if lrear or rfront say nothing about the stickiness of
1187 SYM, Vtext_property_default_nonsticky may give default
1188 stickiness to SYM. */
1189 tmp = Fassq (sym, Vtext_property_default_nonsticky);
1190
1191 /* Since rval is known to be nil in this loop, the test simplifies. */
1192 if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1193 {
1194 props = Fcons (lval, Fcons (sym, props));
1195 if (TMEM (sym, lfront))
1196 front = Fcons (sym, front);
1197 }
1198 else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1199 {
1200 /* The value is nil, but we still inherit the stickiness
1201 from the right. */
1202 front = Fcons (sym, front);
1203 if (TMEM (sym, rrear))
1204 rear = Fcons (sym, rear);
1205 }
1206 }
1207 props = Fnreverse (props);
1208 if (! NILP (rear))
1209 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1210
1211 cat = textget (props, Qcategory);
1212 if (! NILP (front)
1213 &&
1214 /* If we have inherited a front-stick category property that is t,
1215 we don't need to set up a detailed one. */
1216 ! (! NILP (cat) && SYMBOLP (cat)
1217 && EQ (Fget (cat, Qfront_sticky), Qt)))
1218 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1219 return props;
1220 }
1221
1222 \f
1223 /* Delete a node I from its interval tree by merging its subtrees
1224 into one subtree which is then returned. Caller is responsible for
1225 storing the resulting subtree into its parent. */
1226
1227 static INTERVAL
1228 delete_node (register INTERVAL i)
1229 {
1230 register INTERVAL migrate, this;
1231 register int migrate_amt;
1232
1233 if (NULL_INTERVAL_P (i->left))
1234 return i->right;
1235 if (NULL_INTERVAL_P (i->right))
1236 return i->left;
1237
1238 migrate = i->left;
1239 migrate_amt = i->left->total_length;
1240 this = i->right;
1241 this->total_length += migrate_amt;
1242 while (! NULL_INTERVAL_P (this->left))
1243 {
1244 this = this->left;
1245 this->total_length += migrate_amt;
1246 }
1247 CHECK_TOTAL_LENGTH (this);
1248 this->left = migrate;
1249 SET_INTERVAL_PARENT (migrate, this);
1250
1251 return i->right;
1252 }
1253
1254 /* Delete interval I from its tree by calling `delete_node'
1255 and properly connecting the resultant subtree.
1256
1257 I is presumed to be empty; that is, no adjustments are made
1258 for the length of I. */
1259
1260 void
1261 delete_interval (register INTERVAL i)
1262 {
1263 register INTERVAL parent;
1264 int amt = LENGTH (i);
1265
1266 if (amt > 0) /* Only used on zero-length intervals now. */
1267 abort ();
1268
1269 if (ROOT_INTERVAL_P (i))
1270 {
1271 Lisp_Object owner;
1272 GET_INTERVAL_OBJECT (owner, i);
1273 parent = delete_node (i);
1274 if (! NULL_INTERVAL_P (parent))
1275 SET_INTERVAL_OBJECT (parent, owner);
1276
1277 if (BUFFERP (owner))
1278 BUF_INTERVALS (XBUFFER (owner)) = parent;
1279 else if (STRINGP (owner))
1280 STRING_SET_INTERVALS (owner, parent);
1281 else
1282 abort ();
1283
1284 return;
1285 }
1286
1287 parent = INTERVAL_PARENT (i);
1288 if (AM_LEFT_CHILD (i))
1289 {
1290 parent->left = delete_node (i);
1291 if (! NULL_INTERVAL_P (parent->left))
1292 SET_INTERVAL_PARENT (parent->left, parent);
1293 }
1294 else
1295 {
1296 parent->right = delete_node (i);
1297 if (! NULL_INTERVAL_P (parent->right))
1298 SET_INTERVAL_PARENT (parent->right, parent);
1299 }
1300 }
1301 \f
1302 /* Find the interval in TREE corresponding to the relative position
1303 FROM and delete as much as possible of AMOUNT from that interval.
1304 Return the amount actually deleted, and if the interval was
1305 zeroed-out, delete that interval node from the tree.
1306
1307 Note that FROM is actually origin zero, aka relative to the
1308 leftmost edge of tree. This is appropriate since we call ourselves
1309 recursively on subtrees.
1310
1311 Do this by recursing down TREE to the interval in question, and
1312 deleting the appropriate amount of text. */
1313
1314 static int
1315 interval_deletion_adjustment (register INTERVAL tree, register int from, register int amount)
1316 {
1317 register int relative_position = from;
1318
1319 if (NULL_INTERVAL_P (tree))
1320 return 0;
1321
1322 /* Left branch */
1323 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1324 {
1325 int subtract = interval_deletion_adjustment (tree->left,
1326 relative_position,
1327 amount);
1328 tree->total_length -= subtract;
1329 CHECK_TOTAL_LENGTH (tree);
1330 return subtract;
1331 }
1332 /* Right branch */
1333 else if (relative_position >= (TOTAL_LENGTH (tree)
1334 - RIGHT_TOTAL_LENGTH (tree)))
1335 {
1336 int subtract;
1337
1338 relative_position -= (tree->total_length
1339 - RIGHT_TOTAL_LENGTH (tree));
1340 subtract = interval_deletion_adjustment (tree->right,
1341 relative_position,
1342 amount);
1343 tree->total_length -= subtract;
1344 CHECK_TOTAL_LENGTH (tree);
1345 return subtract;
1346 }
1347 /* Here -- this node. */
1348 else
1349 {
1350 /* How much can we delete from this interval? */
1351 int my_amount = ((tree->total_length
1352 - RIGHT_TOTAL_LENGTH (tree))
1353 - relative_position);
1354
1355 if (amount > my_amount)
1356 amount = my_amount;
1357
1358 tree->total_length -= amount;
1359 CHECK_TOTAL_LENGTH (tree);
1360 if (LENGTH (tree) == 0)
1361 delete_interval (tree);
1362
1363 return amount;
1364 }
1365
1366 /* Never reach here. */
1367 }
1368
1369 /* Effect the adjustments necessary to the interval tree of BUFFER to
1370 correspond to the deletion of LENGTH characters from that buffer
1371 text. The deletion is effected at position START (which is a
1372 buffer position, i.e. origin 1). */
1373
1374 static void
1375 adjust_intervals_for_deletion (struct buffer *buffer, int start, int length)
1376 {
1377 register int left_to_delete = length;
1378 register INTERVAL tree = BUF_INTERVALS (buffer);
1379 Lisp_Object parent;
1380 int 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 INLINE void
1426 offset_intervals (struct buffer *buffer, int start, int length)
1427 {
1428 if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1429 return;
1430
1431 if (length > 0)
1432 adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1433 else
1434 adjust_intervals_for_deletion (buffer, start, -length);
1435 }
1436 \f
1437 /* Merge interval I with its lexicographic successor. The resulting
1438 interval is returned, and has the properties of the original
1439 successor. The properties of I are lost. I is removed from the
1440 interval tree.
1441
1442 IMPORTANT:
1443 The caller must verify that this is not the last (rightmost)
1444 interval. */
1445
1446 INTERVAL
1447 merge_interval_right (register INTERVAL i)
1448 {
1449 register int absorb = LENGTH (i);
1450 register INTERVAL successor;
1451
1452 /* Zero out this interval. */
1453 i->total_length -= absorb;
1454 CHECK_TOTAL_LENGTH (i);
1455
1456 /* Find the succeeding interval. */
1457 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1458 as we descend. */
1459 {
1460 successor = i->right;
1461 while (! NULL_LEFT_CHILD (successor))
1462 {
1463 successor->total_length += absorb;
1464 CHECK_TOTAL_LENGTH (successor);
1465 successor = successor->left;
1466 }
1467
1468 successor->total_length += absorb;
1469 CHECK_TOTAL_LENGTH (successor);
1470 delete_interval (i);
1471 return successor;
1472 }
1473
1474 successor = i;
1475 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1476 we ascend. */
1477 {
1478 if (AM_LEFT_CHILD (successor))
1479 {
1480 successor = INTERVAL_PARENT (successor);
1481 delete_interval (i);
1482 return successor;
1483 }
1484
1485 successor = INTERVAL_PARENT (successor);
1486 successor->total_length -= absorb;
1487 CHECK_TOTAL_LENGTH (successor);
1488 }
1489
1490 /* This must be the rightmost or last interval and cannot
1491 be merged right. The caller should have known. */
1492 abort ();
1493 }
1494 \f
1495 /* Merge interval I with its lexicographic predecessor. The resulting
1496 interval is returned, and has the properties of the original predecessor.
1497 The properties of I are lost. Interval node I is removed from the tree.
1498
1499 IMPORTANT:
1500 The caller must verify that this is not the first (leftmost) interval. */
1501
1502 INTERVAL
1503 merge_interval_left (register INTERVAL i)
1504 {
1505 register int absorb = LENGTH (i);
1506 register INTERVAL predecessor;
1507
1508 /* Zero out this interval. */
1509 i->total_length -= absorb;
1510 CHECK_TOTAL_LENGTH (i);
1511
1512 /* Find the preceding interval. */
1513 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1514 adding ABSORB as we go. */
1515 {
1516 predecessor = i->left;
1517 while (! NULL_RIGHT_CHILD (predecessor))
1518 {
1519 predecessor->total_length += absorb;
1520 CHECK_TOTAL_LENGTH (predecessor);
1521 predecessor = predecessor->right;
1522 }
1523
1524 predecessor->total_length += absorb;
1525 CHECK_TOTAL_LENGTH (predecessor);
1526 delete_interval (i);
1527 return predecessor;
1528 }
1529
1530 predecessor = i;
1531 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1532 subtracting ABSORB. */
1533 {
1534 if (AM_RIGHT_CHILD (predecessor))
1535 {
1536 predecessor = INTERVAL_PARENT (predecessor);
1537 delete_interval (i);
1538 return predecessor;
1539 }
1540
1541 predecessor = INTERVAL_PARENT (predecessor);
1542 predecessor->total_length -= absorb;
1543 CHECK_TOTAL_LENGTH (predecessor);
1544 }
1545
1546 /* This must be the leftmost or first interval and cannot
1547 be merged left. The caller should have known. */
1548 abort ();
1549 }
1550 \f
1551 /* Make an exact copy of interval tree SOURCE which descends from
1552 PARENT. This is done by recursing through SOURCE, copying
1553 the current interval and its properties, and then adjusting
1554 the pointers of the copy. */
1555
1556 static INTERVAL
1557 reproduce_tree (INTERVAL source, INTERVAL parent)
1558 {
1559 register INTERVAL t = make_interval ();
1560
1561 memcpy (t, source, INTERVAL_SIZE);
1562 copy_properties (source, t);
1563 SET_INTERVAL_PARENT (t, parent);
1564 if (! NULL_LEFT_CHILD (source))
1565 t->left = reproduce_tree (source->left, t);
1566 if (! NULL_RIGHT_CHILD (source))
1567 t->right = reproduce_tree (source->right, t);
1568
1569 return t;
1570 }
1571
1572 static INTERVAL
1573 reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
1574 {
1575 register INTERVAL t = make_interval ();
1576
1577 memcpy (t, source, INTERVAL_SIZE);
1578 copy_properties (source, t);
1579 SET_INTERVAL_OBJECT (t, parent);
1580 if (! NULL_LEFT_CHILD (source))
1581 t->left = reproduce_tree (source->left, t);
1582 if (! NULL_RIGHT_CHILD (source))
1583 t->right = reproduce_tree (source->right, t);
1584
1585 return t;
1586 }
1587
1588 #if 0
1589 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1590
1591 /* Make a new interval of length LENGTH starting at START in the
1592 group of intervals INTERVALS, which is actually an interval tree.
1593 Returns the new interval.
1594
1595 Generate an error if the new positions would overlap an existing
1596 interval. */
1597
1598 static INTERVAL
1599 make_new_interval (intervals, start, length)
1600 INTERVAL intervals;
1601 int start, length;
1602 {
1603 INTERVAL slot;
1604
1605 slot = find_interval (intervals, start);
1606 if (start + length > slot->position + LENGTH (slot))
1607 error ("Interval would overlap");
1608
1609 if (start == slot->position && length == LENGTH (slot))
1610 return slot;
1611
1612 if (slot->position == start)
1613 {
1614 /* New right node. */
1615 split_interval_right (slot, length);
1616 return slot;
1617 }
1618
1619 if (slot->position + LENGTH (slot) == start + length)
1620 {
1621 /* New left node. */
1622 split_interval_left (slot, LENGTH (slot) - length);
1623 return slot;
1624 }
1625
1626 /* Convert interval SLOT into three intervals. */
1627 split_interval_left (slot, start - slot->position);
1628 split_interval_right (slot, length);
1629 return slot;
1630 }
1631 #endif
1632 \f
1633 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1634 LENGTH is the length of the text in SOURCE.
1635
1636 The `position' field of the SOURCE intervals is assumed to be
1637 consistent with its parent; therefore, SOURCE must be an
1638 interval tree made with copy_interval or must be the whole
1639 tree of a buffer or a string.
1640
1641 This is used in insdel.c when inserting Lisp_Strings into the
1642 buffer. The text corresponding to SOURCE is already in the buffer
1643 when this is called. The intervals of new tree are a copy of those
1644 belonging to the string being inserted; intervals are never
1645 shared.
1646
1647 If the inserted text had no intervals associated, and we don't
1648 want to inherit the surrounding text's properties, this function
1649 simply returns -- offset_intervals should handle placing the
1650 text in the correct interval, depending on the sticky bits.
1651
1652 If the inserted text had properties (intervals), then there are two
1653 cases -- either insertion happened in the middle of some interval,
1654 or between two intervals.
1655
1656 If the text goes into the middle of an interval, then new
1657 intervals are created in the middle with only the properties of
1658 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1659 which case the new text has the union of its properties and those
1660 of the text into which it was inserted.
1661
1662 If the text goes between two intervals, then if neither interval
1663 had its appropriate sticky property set (front_sticky, rear_sticky),
1664 the new text has only its properties. If one of the sticky properties
1665 is set, then the new text "sticks" to that region and its properties
1666 depend on merging as above. If both the preceding and succeeding
1667 intervals to the new text are "sticky", then the new text retains
1668 only its properties, as if neither sticky property were set. Perhaps
1669 we should consider merging all three sets of properties onto the new
1670 text... */
1671
1672 void
1673 graft_intervals_into_buffer (INTERVAL source, int position, int length, struct buffer *buffer, int inherit)
1674 {
1675 register INTERVAL under, over, this, prev;
1676 register INTERVAL tree;
1677 int over_used;
1678
1679 tree = BUF_INTERVALS (buffer);
1680
1681 /* If the new text has no properties, then with inheritance it
1682 becomes part of whatever interval it was inserted into.
1683 To prevent inheritance, we must clear out the properties
1684 of the newly inserted text. */
1685 if (NULL_INTERVAL_P (source))
1686 {
1687 Lisp_Object buf;
1688 if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1689 {
1690 XSETBUFFER (buf, buffer);
1691 set_text_properties_1 (make_number (position),
1692 make_number (position + length),
1693 Qnil, buf, 0);
1694 }
1695 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1696 /* Shouldn't be necessary. -stef */
1697 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1698 return;
1699 }
1700
1701 if (NULL_INTERVAL_P (tree))
1702 {
1703 /* The inserted text constitutes the whole buffer, so
1704 simply copy over the interval structure. */
1705 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1706 {
1707 Lisp_Object buf;
1708 XSETBUFFER (buf, buffer);
1709 BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1710 BUF_INTERVALS (buffer)->position = BEG;
1711 BUF_INTERVALS (buffer)->up_obj = 1;
1712
1713 /* Explicitly free the old tree here? */
1714
1715 return;
1716 }
1717
1718 /* Create an interval tree in which to place a copy
1719 of the intervals of the inserted string. */
1720 {
1721 Lisp_Object buf;
1722 XSETBUFFER (buf, buffer);
1723 tree = create_root_interval (buf);
1724 }
1725 }
1726 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1727 /* If the buffer contains only the new string, but
1728 there was already some interval tree there, then it may be
1729 some zero length intervals. Eventually, do something clever
1730 about inserting properly. For now, just waste the old intervals. */
1731 {
1732 BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1733 BUF_INTERVALS (buffer)->position = BEG;
1734 BUF_INTERVALS (buffer)->up_obj = 1;
1735 /* Explicitly free the old tree here. */
1736
1737 return;
1738 }
1739 /* Paranoia -- the text has already been added, so this buffer
1740 should be of non-zero length. */
1741 else if (TOTAL_LENGTH (tree) == 0)
1742 abort ();
1743
1744 this = under = find_interval (tree, position);
1745 if (NULL_INTERVAL_P (under)) /* Paranoia */
1746 abort ();
1747 over = find_interval (source, interval_start_pos (source));
1748
1749 /* Here for insertion in the middle of an interval.
1750 Split off an equivalent interval to the right,
1751 then don't bother with it any more. */
1752
1753 if (position > under->position)
1754 {
1755 INTERVAL end_unchanged
1756 = split_interval_left (this, position - under->position);
1757 copy_properties (under, end_unchanged);
1758 under->position = position;
1759 }
1760 else
1761 {
1762 /* This call may have some effect because previous_interval may
1763 update `position' fields of intervals. Thus, don't ignore it
1764 for the moment. Someone please tell me the truth (K.Handa). */
1765 prev = previous_interval (under);
1766 #if 0
1767 /* But, this code surely has no effect. And, anyway,
1768 END_NONSTICKY_P is unreliable now. */
1769 if (prev && !END_NONSTICKY_P (prev))
1770 prev = 0;
1771 #endif /* 0 */
1772 }
1773
1774 /* Insertion is now at beginning of UNDER. */
1775
1776 /* The inserted text "sticks" to the interval `under',
1777 which means it gets those properties.
1778 The properties of under are the result of
1779 adjust_intervals_for_insertion, so stickiness has
1780 already been taken care of. */
1781
1782 /* OVER is the interval we are copying from next.
1783 OVER_USED says how many characters' worth of OVER
1784 have already been copied into target intervals.
1785 UNDER is the next interval in the target. */
1786 over_used = 0;
1787 while (! NULL_INTERVAL_P (over))
1788 {
1789 /* If UNDER is longer than OVER, split it. */
1790 if (LENGTH (over) - over_used < LENGTH (under))
1791 {
1792 this = split_interval_left (under, LENGTH (over) - over_used);
1793 copy_properties (under, this);
1794 }
1795 else
1796 this = under;
1797
1798 /* THIS is now the interval to copy or merge into.
1799 OVER covers all of it. */
1800 if (inherit)
1801 merge_properties (over, this);
1802 else
1803 copy_properties (over, this);
1804
1805 /* If THIS and OVER end at the same place,
1806 advance OVER to a new source interval. */
1807 if (LENGTH (this) == LENGTH (over) - over_used)
1808 {
1809 over = next_interval (over);
1810 over_used = 0;
1811 }
1812 else
1813 /* Otherwise just record that more of OVER has been used. */
1814 over_used += LENGTH (this);
1815
1816 /* Always advance to a new target interval. */
1817 under = next_interval (this);
1818 }
1819
1820 if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1821 BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1822 return;
1823 }
1824
1825 /* Get the value of property PROP from PLIST,
1826 which is the plist of an interval.
1827 We check for direct properties, for categories with property PROP,
1828 and for PROP appearing on the default-text-properties list. */
1829
1830 Lisp_Object
1831 textget (Lisp_Object plist, register Lisp_Object prop)
1832 {
1833 return lookup_char_property (plist, prop, 1);
1834 }
1835
1836 Lisp_Object
1837 lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
1838 {
1839 register Lisp_Object tail, fallback = Qnil;
1840
1841 for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1842 {
1843 register Lisp_Object tem;
1844 tem = XCAR (tail);
1845 if (EQ (prop, tem))
1846 return Fcar (XCDR (tail));
1847 if (EQ (tem, Qcategory))
1848 {
1849 tem = Fcar (XCDR (tail));
1850 if (SYMBOLP (tem))
1851 fallback = Fget (tem, prop);
1852 }
1853 }
1854
1855 if (! NILP (fallback))
1856 return fallback;
1857 /* Check for alternative properties */
1858 tail = Fassq (prop, Vchar_property_alias_alist);
1859 if (! NILP (tail))
1860 {
1861 tail = XCDR (tail);
1862 for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1863 fallback = Fplist_get (plist, XCAR (tail));
1864 }
1865
1866 if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1867 fallback = Fplist_get (Vdefault_text_properties, prop);
1868 return fallback;
1869 }
1870
1871 \f
1872 /* Set point "temporarily", without checking any text properties. */
1873
1874 INLINE void
1875 temp_set_point (struct buffer *buffer, EMACS_INT charpos)
1876 {
1877 temp_set_point_both (buffer, charpos,
1878 buf_charpos_to_bytepos (buffer, charpos));
1879 }
1880
1881 /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1882 byte position BYTEPOS. */
1883
1884 INLINE void
1885 temp_set_point_both (struct buffer *buffer,
1886 EMACS_INT charpos, EMACS_INT bytepos)
1887 {
1888 /* In a single-byte buffer, the two positions must be equal. */
1889 if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1890 && charpos != bytepos)
1891 abort ();
1892
1893 if (charpos > bytepos)
1894 abort ();
1895
1896 if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1897 abort ();
1898
1899 BUF_PT_BYTE (buffer) = bytepos;
1900 BUF_PT (buffer) = charpos;
1901 }
1902
1903 /* Set point in BUFFER to CHARPOS. If the target position is
1904 before an intangible character, move to an ok place. */
1905
1906 void
1907 set_point (EMACS_INT charpos)
1908 {
1909 set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
1910 }
1911
1912 /* If there's an invisible character at position POS + TEST_OFFS in the
1913 current buffer, and the invisible property has a `stickiness' such that
1914 inserting a character at position POS would inherit the property it,
1915 return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
1916 then intangibility is required as well as invisibleness.
1917
1918 TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1919
1920 Note that `stickiness' is determined by overlay marker insertion types,
1921 if the invisible property comes from an overlay. */
1922
1923 static int
1924 adjust_for_invis_intang (int pos, int test_offs, int adj, int test_intang)
1925 {
1926 Lisp_Object invis_propval, invis_overlay;
1927 Lisp_Object test_pos;
1928
1929 if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1930 /* POS + ADJ would be beyond the buffer bounds, so do no adjustment. */
1931 return pos;
1932
1933 test_pos = make_number (pos + test_offs);
1934
1935 invis_propval
1936 = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1937 &invis_overlay);
1938
1939 if ((!test_intang
1940 || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
1941 && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
1942 /* This next test is true if the invisible property has a stickiness
1943 such that an insertion at POS would inherit it. */
1944 && (NILP (invis_overlay)
1945 /* Invisible property is from a text-property. */
1946 ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
1947 == (test_offs == 0 ? 1 : -1))
1948 /* Invisible property is from an overlay. */
1949 : (test_offs == 0
1950 ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
1951 : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
1952 pos += adj;
1953
1954 return pos;
1955 }
1956
1957 /* Set point in BUFFER to CHARPOS, which corresponds to byte
1958 position BYTEPOS. If the target position is
1959 before an intangible character, move to an ok place. */
1960
1961 void
1962 set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
1963 {
1964 register INTERVAL to, from, toprev, fromprev;
1965 EMACS_INT buffer_point;
1966 EMACS_INT old_position = PT;
1967 /* This ensures that we move forward past intangible text when the
1968 initial position is the same as the destination, in the rare
1969 instances where this is important, e.g. in line-move-finish
1970 (simple.el). */
1971 int backwards = (charpos < old_position ? 1 : 0);
1972 int have_overlays;
1973 EMACS_INT original_position;
1974
1975 current_buffer->point_before_scroll = Qnil;
1976
1977 if (charpos == PT)
1978 return;
1979
1980 /* In a single-byte buffer, the two positions must be equal. */
1981 eassert (ZV != ZV_BYTE || charpos == bytepos);
1982
1983 /* Check this now, before checking if the buffer has any intervals.
1984 That way, we can catch conditions which break this sanity check
1985 whether or not there are intervals in the buffer. */
1986 eassert (charpos <= ZV && charpos >= BEGV);
1987
1988 have_overlays = (current_buffer->overlays_before
1989 || current_buffer->overlays_after);
1990
1991 /* If we have no text properties and overlays,
1992 then we can do it quickly. */
1993 if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
1994 {
1995 temp_set_point_both (current_buffer, charpos, bytepos);
1996 return;
1997 }
1998
1999 /* Set TO to the interval containing the char after CHARPOS,
2000 and TOPREV to the interval containing the char before CHARPOS.
2001 Either one may be null. They may be equal. */
2002 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2003 if (charpos == BEGV)
2004 toprev = 0;
2005 else if (to && to->position == charpos)
2006 toprev = previous_interval (to);
2007 else
2008 toprev = to;
2009
2010 buffer_point = (PT == ZV ? ZV - 1 : PT);
2011
2012 /* Set FROM to the interval containing the char after PT,
2013 and FROMPREV to the interval containing the char before PT.
2014 Either one may be null. They may be equal. */
2015 /* We could cache this and save time. */
2016 from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
2017 if (buffer_point == BEGV)
2018 fromprev = 0;
2019 else if (from && from->position == PT)
2020 fromprev = previous_interval (from);
2021 else if (buffer_point != PT)
2022 fromprev = from, from = 0;
2023 else
2024 fromprev = from;
2025
2026 /* Moving within an interval. */
2027 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2028 && ! have_overlays)
2029 {
2030 temp_set_point_both (current_buffer, charpos, bytepos);
2031 return;
2032 }
2033
2034 original_position = charpos;
2035
2036 /* If the new position is between two intangible characters
2037 with the same intangible property value,
2038 move forward or backward until a change in that property. */
2039 if (NILP (Vinhibit_point_motion_hooks)
2040 && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2041 || have_overlays)
2042 /* Intangibility never stops us from positioning at the beginning
2043 or end of the buffer, so don't bother checking in that case. */
2044 && charpos != BEGV && charpos != ZV)
2045 {
2046 Lisp_Object pos;
2047 Lisp_Object intangible_propval;
2048
2049 if (backwards)
2050 {
2051 /* If the preceding character is both intangible and invisible,
2052 and the invisible property is `rear-sticky', perturb it so
2053 that the search starts one character earlier -- this ensures
2054 that point can never move to the end of an invisible/
2055 intangible/rear-sticky region. */
2056 charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2057
2058 XSETINT (pos, charpos);
2059
2060 /* If following char is intangible,
2061 skip back over all chars with matching intangible property. */
2062
2063 intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2064
2065 if (! NILP (intangible_propval))
2066 {
2067 while (XINT (pos) > BEGV
2068 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2069 Qintangible, Qnil),
2070 intangible_propval))
2071 pos = Fprevious_char_property_change (pos, Qnil);
2072
2073 /* Set CHARPOS from POS, and if the final intangible character
2074 that we skipped over is also invisible, and the invisible
2075 property is `front-sticky', perturb it to be one character
2076 earlier -- this ensures that point can never move to the
2077 beginning of an invisible/intangible/front-sticky region. */
2078 charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2079 }
2080 }
2081 else
2082 {
2083 /* If the following character is both intangible and invisible,
2084 and the invisible property is `front-sticky', perturb it so
2085 that the search starts one character later -- this ensures
2086 that point can never move to the beginning of an
2087 invisible/intangible/front-sticky region. */
2088 charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2089
2090 XSETINT (pos, charpos);
2091
2092 /* If preceding char is intangible,
2093 skip forward over all chars with matching intangible property. */
2094
2095 intangible_propval = Fget_char_property (make_number (charpos - 1),
2096 Qintangible, Qnil);
2097
2098 if (! NILP (intangible_propval))
2099 {
2100 while (XINT (pos) < ZV
2101 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2102 intangible_propval))
2103 pos = Fnext_char_property_change (pos, Qnil);
2104
2105 /* Set CHARPOS from POS, and if the final intangible character
2106 that we skipped over is also invisible, and the invisible
2107 property is `rear-sticky', perturb it to be one character
2108 later -- this ensures that point can never move to the
2109 end of an invisible/intangible/rear-sticky region. */
2110 charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2111 }
2112 }
2113
2114 bytepos = buf_charpos_to_bytepos (current_buffer, charpos);
2115 }
2116
2117 if (charpos != original_position)
2118 {
2119 /* Set TO to the interval containing the char after CHARPOS,
2120 and TOPREV to the interval containing the char before CHARPOS.
2121 Either one may be null. They may be equal. */
2122 to = find_interval (BUF_INTERVALS (current_buffer), charpos);
2123 if (charpos == BEGV)
2124 toprev = 0;
2125 else if (to && to->position == charpos)
2126 toprev = previous_interval (to);
2127 else
2128 toprev = to;
2129 }
2130
2131 /* Here TO is the interval after the stopping point
2132 and TOPREV is the interval before the stopping point.
2133 One or the other may be null. */
2134
2135 temp_set_point_both (current_buffer, charpos, bytepos);
2136
2137 /* We run point-left and point-entered hooks here, if the
2138 two intervals are not equivalent. These hooks take
2139 (old_point, new_point) as arguments. */
2140 if (NILP (Vinhibit_point_motion_hooks)
2141 && (! intervals_equal (from, to)
2142 || ! intervals_equal (fromprev, toprev)))
2143 {
2144 Lisp_Object leave_after, leave_before, enter_after, enter_before;
2145
2146 if (fromprev)
2147 leave_before = textget (fromprev->plist, Qpoint_left);
2148 else
2149 leave_before = Qnil;
2150
2151 if (from)
2152 leave_after = textget (from->plist, Qpoint_left);
2153 else
2154 leave_after = Qnil;
2155
2156 if (toprev)
2157 enter_before = textget (toprev->plist, Qpoint_entered);
2158 else
2159 enter_before = Qnil;
2160
2161 if (to)
2162 enter_after = textget (to->plist, Qpoint_entered);
2163 else
2164 enter_after = Qnil;
2165
2166 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2167 call2 (leave_before, make_number (old_position),
2168 make_number (charpos));
2169 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2170 call2 (leave_after, make_number (old_position),
2171 make_number (charpos));
2172
2173 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2174 call2 (enter_before, make_number (old_position),
2175 make_number (charpos));
2176 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2177 call2 (enter_after, make_number (old_position),
2178 make_number (charpos));
2179 }
2180 }
2181 \f
2182 /* Move point to POSITION, unless POSITION is inside an intangible
2183 segment that reaches all the way to point. */
2184
2185 void
2186 move_if_not_intangible (int position)
2187 {
2188 Lisp_Object pos;
2189 Lisp_Object intangible_propval;
2190
2191 XSETINT (pos, position);
2192
2193 if (! NILP (Vinhibit_point_motion_hooks))
2194 /* If intangible is inhibited, always move point to POSITION. */
2195 ;
2196 else if (PT < position && XINT (pos) < ZV)
2197 {
2198 /* We want to move forward, so check the text before POSITION. */
2199
2200 intangible_propval = Fget_char_property (pos,
2201 Qintangible, Qnil);
2202
2203 /* If following char is intangible,
2204 skip back over all chars with matching intangible property. */
2205 if (! NILP (intangible_propval))
2206 while (XINT (pos) > BEGV
2207 && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2208 Qintangible, Qnil),
2209 intangible_propval))
2210 pos = Fprevious_char_property_change (pos, Qnil);
2211 }
2212 else if (XINT (pos) > BEGV)
2213 {
2214 /* We want to move backward, so check the text after POSITION. */
2215
2216 intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2217 Qintangible, Qnil);
2218
2219 /* If following char is intangible,
2220 skip forward over all chars with matching intangible property. */
2221 if (! NILP (intangible_propval))
2222 while (XINT (pos) < ZV
2223 && EQ (Fget_char_property (pos, Qintangible, Qnil),
2224 intangible_propval))
2225 pos = Fnext_char_property_change (pos, Qnil);
2226
2227 }
2228 else if (position < BEGV)
2229 position = BEGV;
2230 else if (position > ZV)
2231 position = ZV;
2232
2233 /* If the whole stretch between PT and POSITION isn't intangible,
2234 try moving to POSITION (which means we actually move farther
2235 if POSITION is inside of intangible text). */
2236
2237 if (XINT (pos) != PT)
2238 SET_PT (position);
2239 }
2240 \f
2241 /* If text at position POS has property PROP, set *VAL to the property
2242 value, *START and *END to the beginning and end of a region that
2243 has the same property, and return 1. Otherwise return 0.
2244
2245 OBJECT is the string or buffer to look for the property in;
2246 nil means the current buffer. */
2247
2248 int
2249 get_property_and_range (int pos, Lisp_Object prop, Lisp_Object *val, EMACS_INT *start, EMACS_INT *end, Lisp_Object object)
2250 {
2251 INTERVAL i, prev, next;
2252
2253 if (NILP (object))
2254 i = find_interval (BUF_INTERVALS (current_buffer), pos);
2255 else if (BUFFERP (object))
2256 i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2257 else if (STRINGP (object))
2258 i = find_interval (STRING_INTERVALS (object), pos);
2259 else
2260 abort ();
2261
2262 if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2263 return 0;
2264 *val = textget (i->plist, prop);
2265 if (NILP (*val))
2266 return 0;
2267
2268 next = i; /* remember it in advance */
2269 prev = previous_interval (i);
2270 while (! NULL_INTERVAL_P (prev)
2271 && EQ (*val, textget (prev->plist, prop)))
2272 i = prev, prev = previous_interval (prev);
2273 *start = i->position;
2274
2275 next = next_interval (i);
2276 while (! NULL_INTERVAL_P (next)
2277 && EQ (*val, textget (next->plist, prop)))
2278 i = next, next = next_interval (next);
2279 *end = i->position + LENGTH (i);
2280
2281 return 1;
2282 }
2283 \f
2284 /* Return the proper local keymap TYPE for position POSITION in
2285 BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
2286 specified by the PROP property, if any. Otherwise, if TYPE is
2287 `local-map' use BUFFER's local map.
2288
2289 POSITION must be in the accessible part of BUFFER. */
2290
2291 Lisp_Object
2292 get_local_map (register int position, register struct buffer *buffer, Lisp_Object type)
2293 {
2294 Lisp_Object prop, lispy_position, lispy_buffer;
2295 int old_begv, old_zv, old_begv_byte, old_zv_byte;
2296
2297 /* Perhaps we should just change `position' to the limit. */
2298 if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2299 abort ();
2300
2301 /* Ignore narrowing, so that a local map continues to be valid even if
2302 the visible region contains no characters and hence no properties. */
2303 old_begv = BUF_BEGV (buffer);
2304 old_zv = BUF_ZV (buffer);
2305 old_begv_byte = BUF_BEGV_BYTE (buffer);
2306 old_zv_byte = BUF_ZV_BYTE (buffer);
2307 BUF_BEGV (buffer) = BUF_BEG (buffer);
2308 BUF_ZV (buffer) = BUF_Z (buffer);
2309 BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2310 BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2311
2312 XSETFASTINT (lispy_position, position);
2313 XSETBUFFER (lispy_buffer, buffer);
2314 /* First check if the CHAR has any property. This is because when
2315 we click with the mouse, the mouse pointer is really pointing
2316 to the CHAR after POS. */
2317 prop = Fget_char_property (lispy_position, type, lispy_buffer);
2318 /* If not, look at the POS's properties. This is necessary because when
2319 editing a field with a `local-map' property, we want insertion at the end
2320 to obey the `local-map' property. */
2321 if (NILP (prop))
2322 prop = get_pos_property (lispy_position, type, lispy_buffer);
2323
2324 BUF_BEGV (buffer) = old_begv;
2325 BUF_ZV (buffer) = old_zv;
2326 BUF_BEGV_BYTE (buffer) = old_begv_byte;
2327 BUF_ZV_BYTE (buffer) = old_zv_byte;
2328
2329 /* Use the local map only if it is valid. */
2330 prop = get_keymap (prop, 0, 0);
2331 if (CONSP (prop))
2332 return prop;
2333
2334 if (EQ (type, Qkeymap))
2335 return Qnil;
2336 else
2337 return buffer->keymap;
2338 }
2339 \f
2340 /* Produce an interval tree reflecting the intervals in
2341 TREE from START to START + LENGTH.
2342 The new interval tree has no parent and has a starting-position of 0. */
2343
2344 INTERVAL
2345 copy_intervals (INTERVAL tree, int start, int length)
2346 {
2347 register INTERVAL i, new, t;
2348 register int got, prevlen;
2349
2350 if (NULL_INTERVAL_P (tree) || length <= 0)
2351 return NULL_INTERVAL;
2352
2353 i = find_interval (tree, start);
2354 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2355 abort ();
2356
2357 /* If there is only one interval and it's the default, return nil. */
2358 if ((start - i->position + 1 + length) < LENGTH (i)
2359 && DEFAULT_INTERVAL_P (i))
2360 return NULL_INTERVAL;
2361
2362 new = make_interval ();
2363 new->position = 0;
2364 got = (LENGTH (i) - (start - i->position));
2365 new->total_length = length;
2366 CHECK_TOTAL_LENGTH (new);
2367 copy_properties (i, new);
2368
2369 t = new;
2370 prevlen = got;
2371 while (got < length)
2372 {
2373 i = next_interval (i);
2374 t = split_interval_right (t, prevlen);
2375 copy_properties (i, t);
2376 prevlen = LENGTH (i);
2377 got += prevlen;
2378 }
2379
2380 return balance_an_interval (new);
2381 }
2382
2383 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
2384
2385 INLINE void
2386 copy_intervals_to_string (Lisp_Object string, struct buffer *buffer, int position, int length)
2387 {
2388 INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2389 position, length);
2390 if (NULL_INTERVAL_P (interval_copy))
2391 return;
2392
2393 SET_INTERVAL_OBJECT (interval_copy, string);
2394 STRING_SET_INTERVALS (string, interval_copy);
2395 }
2396 \f
2397 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2398 Assume they have identical characters. */
2399
2400 int
2401 compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
2402 {
2403 INTERVAL i1, i2;
2404 int pos = 0;
2405 int end = SCHARS (s1);
2406
2407 i1 = find_interval (STRING_INTERVALS (s1), 0);
2408 i2 = find_interval (STRING_INTERVALS (s2), 0);
2409
2410 while (pos < end)
2411 {
2412 /* Determine how far we can go before we reach the end of I1 or I2. */
2413 int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2414 int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2415 int distance = min (len1, len2);
2416
2417 /* If we ever find a mismatch between the strings,
2418 they differ. */
2419 if (! intervals_equal (i1, i2))
2420 return 0;
2421
2422 /* Advance POS till the end of the shorter interval,
2423 and advance one or both interval pointers for the new position. */
2424 pos += distance;
2425 if (len1 == distance)
2426 i1 = next_interval (i1);
2427 if (len2 == distance)
2428 i2 = next_interval (i2);
2429 }
2430 return 1;
2431 }
2432 \f
2433 /* Recursively adjust interval I in the current buffer
2434 for setting enable_multibyte_characters to MULTI_FLAG.
2435 The range of interval I is START ... END in characters,
2436 START_BYTE ... END_BYTE in bytes. */
2437
2438 static void
2439 set_intervals_multibyte_1 (INTERVAL i, int multi_flag, int start, int start_byte, int end, int end_byte)
2440 {
2441 /* Fix the length of this interval. */
2442 if (multi_flag)
2443 i->total_length = end - start;
2444 else
2445 i->total_length = end_byte - start_byte;
2446 CHECK_TOTAL_LENGTH (i);
2447
2448 if (TOTAL_LENGTH (i) == 0)
2449 {
2450 delete_interval (i);
2451 return;
2452 }
2453
2454 /* Recursively fix the length of the subintervals. */
2455 if (i->left)
2456 {
2457 int left_end, left_end_byte;
2458
2459 if (multi_flag)
2460 {
2461 int temp;
2462 left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2463 left_end = BYTE_TO_CHAR (left_end_byte);
2464
2465 temp = CHAR_TO_BYTE (left_end);
2466
2467 /* If LEFT_END_BYTE is in the middle of a character,
2468 adjust it and LEFT_END to a char boundary. */
2469 if (left_end_byte > temp)
2470 {
2471 left_end_byte = temp;
2472 }
2473 if (left_end_byte < temp)
2474 {
2475 left_end--;
2476 left_end_byte = CHAR_TO_BYTE (left_end);
2477 }
2478 }
2479 else
2480 {
2481 left_end = start + LEFT_TOTAL_LENGTH (i);
2482 left_end_byte = CHAR_TO_BYTE (left_end);
2483 }
2484
2485 set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2486 left_end, left_end_byte);
2487 }
2488 if (i->right)
2489 {
2490 int right_start_byte, right_start;
2491
2492 if (multi_flag)
2493 {
2494 int temp;
2495
2496 right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2497 right_start = BYTE_TO_CHAR (right_start_byte);
2498
2499 /* If RIGHT_START_BYTE is in the middle of a character,
2500 adjust it and RIGHT_START to a char boundary. */
2501 temp = CHAR_TO_BYTE (right_start);
2502
2503 if (right_start_byte < temp)
2504 {
2505 right_start_byte = temp;
2506 }
2507 if (right_start_byte > temp)
2508 {
2509 right_start++;
2510 right_start_byte = CHAR_TO_BYTE (right_start);
2511 }
2512 }
2513 else
2514 {
2515 right_start = end - RIGHT_TOTAL_LENGTH (i);
2516 right_start_byte = CHAR_TO_BYTE (right_start);
2517 }
2518
2519 set_intervals_multibyte_1 (i->right, multi_flag,
2520 right_start, right_start_byte,
2521 end, end_byte);
2522 }
2523
2524 /* Rounding to char boundaries can theoretically ake this interval
2525 spurious. If so, delete one child, and copy its property list
2526 to this interval. */
2527 if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2528 {
2529 if ((i)->left)
2530 {
2531 (i)->plist = (i)->left->plist;
2532 (i)->left->total_length = 0;
2533 delete_interval ((i)->left);
2534 }
2535 else
2536 {
2537 (i)->plist = (i)->right->plist;
2538 (i)->right->total_length = 0;
2539 delete_interval ((i)->right);
2540 }
2541 }
2542 }
2543
2544 /* Update the intervals of the current buffer
2545 to fit the contents as multibyte (if MULTI_FLAG is 1)
2546 or to fit them as non-multibyte (if MULTI_FLAG is 0). */
2547
2548 void
2549 set_intervals_multibyte (int multi_flag)
2550 {
2551 if (BUF_INTERVALS (current_buffer))
2552 set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2553 BEG, BEG_BYTE, Z, Z_BYTE);
2554 }
2555
2556 /* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2557 (do not change this comment) */