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