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