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