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