(vmotion): Use minibuf_prompt_width despite window-start.
[emacs.git] / src / intervals.c
blob3b9ec9b4ddebb7604fd8cdd18e558bbc2bc62b98
1 /* Code for doing intervals.
2 Copyright (C) 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
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.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 /* NOTES:
23 Have to ensure that we can't put symbol nil on a plist, or some
24 functions may work incorrectly.
26 An idea: Have the owner of the tree keep count of splits and/or
27 insertion lengths (in intervals), and balance after every N.
29 Need to call *_left_hook when buffer is killed.
31 Scan for zero-length, or 0-length to see notes about handling
32 zero length interval-markers.
34 There are comments around about freeing intervals. It might be
35 faster to explicitly free them (put them on the free list) than
36 to GC them.
41 #include <config.h>
42 #include "lisp.h"
43 #include "intervals.h"
44 #include "buffer.h"
45 #include "puresize.h"
47 /* The rest of the file is within this conditional. */
48 #ifdef USE_TEXT_PROPERTIES
50 /* Test for membership, allowing for t (actually any non-cons) to mean the
51 universal set. */
53 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
55 /* Factor for weight-balancing interval trees. */
56 Lisp_Object interval_balance_threshold;
58 Lisp_Object merge_properties_sticky ();
60 /* Utility functions for intervals. */
63 /* Create the root interval of some object, a buffer or string. */
65 INTERVAL
66 create_root_interval (parent)
67 Lisp_Object parent;
69 INTERVAL new;
71 CHECK_IMPURE (parent);
73 new = make_interval ();
75 if (XTYPE (parent) == Lisp_Buffer)
77 new->total_length = (BUF_Z (XBUFFER (parent))
78 - BUF_BEG (XBUFFER (parent)));
79 XBUFFER (parent)->intervals = new;
81 else if (XTYPE (parent) == Lisp_String)
83 new->total_length = XSTRING (parent)->size;
84 XSTRING (parent)->intervals = new;
87 new->parent = (INTERVAL) parent;
88 new->position = 1;
90 return new;
93 /* Make the interval TARGET have exactly the properties of SOURCE */
95 void
96 copy_properties (source, target)
97 register INTERVAL source, target;
99 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
100 return;
102 COPY_INTERVAL_CACHE (source, target);
103 target->plist = Fcopy_sequence (source->plist);
106 /* Merge the properties of interval SOURCE into the properties
107 of interval TARGET. That is to say, each property in SOURCE
108 is added to TARGET if TARGET has no such property as yet. */
110 static void
111 merge_properties (source, target)
112 register INTERVAL source, target;
114 register Lisp_Object o, sym, val;
116 if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
117 return;
119 MERGE_INTERVAL_CACHE (source, target);
121 o = source->plist;
122 while (! EQ (o, Qnil))
124 sym = Fcar (o);
125 val = Fmemq (sym, target->plist);
127 if (NILP (val))
129 o = Fcdr (o);
130 val = Fcar (o);
131 target->plist = Fcons (sym, Fcons (val, target->plist));
132 o = Fcdr (o);
134 else
135 o = Fcdr (Fcdr (o));
139 /* Return 1 if the two intervals have the same properties,
140 0 otherwise. */
143 intervals_equal (i0, i1)
144 INTERVAL i0, i1;
146 register Lisp_Object i0_cdr, i0_sym, i1_val;
147 register i1_len;
149 if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
150 return 1;
152 if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
153 return 0;
155 i1_len = XFASTINT (Flength (i1->plist));
156 if (i1_len & 0x1) /* Paranoia -- plists are always even */
157 abort ();
158 i1_len /= 2;
159 i0_cdr = i0->plist;
160 while (!NILP (i0_cdr))
162 /* Lengths of the two plists were unequal. */
163 if (i1_len == 0)
164 return 0;
166 i0_sym = Fcar (i0_cdr);
167 i1_val = Fmemq (i0_sym, i1->plist);
169 /* i0 has something i1 doesn't. */
170 if (EQ (i1_val, Qnil))
171 return 0;
173 /* i0 and i1 both have sym, but it has different values in each. */
174 i0_cdr = Fcdr (i0_cdr);
175 if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr)))
176 return 0;
178 i0_cdr = Fcdr (i0_cdr);
179 i1_len--;
182 /* Lengths of the two plists were unequal. */
183 if (i1_len > 0)
184 return 0;
186 return 1;
189 static int icount;
190 static int idepth;
191 static int zero_length;
193 /* Traverse an interval tree TREE, performing FUNCTION on each node.
194 Pass FUNCTION two args: an interval, and ARG. */
196 void
197 traverse_intervals (tree, position, depth, function, arg)
198 INTERVAL tree;
199 int position, depth;
200 void (* function) ();
201 Lisp_Object arg;
203 if (NULL_INTERVAL_P (tree))
204 return;
206 traverse_intervals (tree->left, position, depth + 1, function, arg);
207 position += LEFT_TOTAL_LENGTH (tree);
208 tree->position = position;
209 (*function) (tree, arg);
210 position += LENGTH (tree);
211 traverse_intervals (tree->right, position, depth + 1, function, arg);
214 #if 0
215 /* These functions are temporary, for debugging purposes only. */
217 INTERVAL search_interval, found_interval;
219 void
220 check_for_interval (i)
221 register INTERVAL i;
223 if (i == search_interval)
225 found_interval = i;
226 icount++;
230 INTERVAL
231 search_for_interval (i, tree)
232 register INTERVAL i, tree;
234 icount = 0;
235 search_interval = i;
236 found_interval = NULL_INTERVAL;
237 traverse_intervals (tree, 1, 0, &check_for_interval, Qnil);
238 return found_interval;
241 static void
242 inc_interval_count (i)
243 INTERVAL i;
245 icount++;
246 if (LENGTH (i) == 0)
247 zero_length++;
248 if (depth > idepth)
249 idepth = depth;
253 count_intervals (i)
254 register INTERVAL i;
256 icount = 0;
257 idepth = 0;
258 zero_length = 0;
259 traverse_intervals (i, 1, 0, &inc_interval_count, Qnil);
261 return icount;
264 static INTERVAL
265 root_interval (interval)
266 INTERVAL interval;
268 register INTERVAL i = interval;
270 while (! ROOT_INTERVAL_P (i))
271 i = i->parent;
273 return i;
275 #endif
277 /* Assuming that a left child exists, perform the following operation:
280 / \ / \
281 B => A
282 / \ / \
286 static INTERVAL
287 rotate_right (interval)
288 INTERVAL interval;
290 INTERVAL i;
291 INTERVAL B = interval->left;
292 int old_total = interval->total_length;
294 /* Deal with any Parent of A; make it point to B. */
295 if (! ROOT_INTERVAL_P (interval))
296 if (AM_LEFT_CHILD (interval))
297 interval->parent->left = B;
298 else
299 interval->parent->right = B;
300 B->parent = interval->parent;
302 /* Make B the parent of A */
303 i = B->right;
304 B->right = interval;
305 interval->parent = B;
307 /* Make A point to c */
308 interval->left = i;
309 if (! NULL_INTERVAL_P (i))
310 i->parent = interval;
312 /* A's total length is decreased by the length of B and its left child. */
313 interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
315 /* B must have the same total length of A. */
316 B->total_length = old_total;
318 return B;
321 /* Assuming that a right child exists, perform the following operation:
323 A B
324 / \ / \
325 B => A
326 / \ / \
330 static INTERVAL
331 rotate_left (interval)
332 INTERVAL interval;
334 INTERVAL i;
335 INTERVAL B = interval->right;
336 int old_total = interval->total_length;
338 /* Deal with any parent of A; make it point to B. */
339 if (! ROOT_INTERVAL_P (interval))
340 if (AM_LEFT_CHILD (interval))
341 interval->parent->left = B;
342 else
343 interval->parent->right = B;
344 B->parent = interval->parent;
346 /* Make B the parent of A */
347 i = B->left;
348 B->left = interval;
349 interval->parent = B;
351 /* Make A point to c */
352 interval->right = i;
353 if (! NULL_INTERVAL_P (i))
354 i->parent = interval;
356 /* A's total length is decreased by the length of B and its right child. */
357 interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
359 /* B must have the same total length of A. */
360 B->total_length = old_total;
362 return B;
365 /* Balance an interval tree with the assumption that the subtrees
366 themselves are already balanced. */
368 static INTERVAL
369 balance_an_interval (i)
370 INTERVAL i;
372 register int old_diff, new_diff;
374 while (1)
376 old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
377 if (old_diff > 0)
379 new_diff = i->total_length - i->left->total_length
380 + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
381 if (abs (new_diff) >= old_diff)
382 break;
383 i = rotate_right (i);
384 balance_an_interval (i->right);
386 else if (old_diff < 0)
388 new_diff = i->total_length - i->right->total_length
389 + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
390 if (abs (new_diff) >= -old_diff)
391 break;
392 i = rotate_left (i);
393 balance_an_interval (i->left);
395 else
396 break;
398 return i;
401 /* Balance INTERVAL, potentially stuffing it back into its parent
402 Lisp Object. */
404 static INLINE INTERVAL
405 balance_possible_root_interval (interval)
406 register INTERVAL interval;
408 Lisp_Object parent;
410 if (interval->parent == NULL_INTERVAL)
411 return interval;
413 parent = (Lisp_Object) (interval->parent);
414 interval = balance_an_interval (interval);
416 if (XTYPE (parent) == Lisp_Buffer)
417 XBUFFER (parent)->intervals = interval;
418 else if (XTYPE (parent) == Lisp_String)
419 XSTRING (parent)->intervals = interval;
421 return interval;
424 /* Balance the interval tree TREE. Balancing is by weight
425 (the amount of text). */
427 static INTERVAL
428 balance_intervals_internal (tree)
429 register INTERVAL tree;
431 /* Balance within each side. */
432 if (tree->left)
433 balance_intervals (tree->left);
434 if (tree->right)
435 balance_intervals (tree->right);
436 return balance_an_interval (tree);
439 /* Advertised interface to balance intervals. */
441 INTERVAL
442 balance_intervals (tree)
443 INTERVAL tree;
445 if (tree == NULL_INTERVAL)
446 return NULL_INTERVAL;
448 return balance_intervals_internal (tree);
451 /* Split INTERVAL into two pieces, starting the second piece at
452 character position OFFSET (counting from 0), relative to INTERVAL.
453 INTERVAL becomes the left-hand piece, and the right-hand piece
454 (second, lexicographically) is returned.
456 The size and position fields of the two intervals are set based upon
457 those of the original interval. The property list of the new interval
458 is reset, thus it is up to the caller to do the right thing with the
459 result.
461 Note that this does not change the position of INTERVAL; if it is a root,
462 it is still a root after this operation. */
464 INTERVAL
465 split_interval_right (interval, offset)
466 INTERVAL interval;
467 int offset;
469 INTERVAL new = make_interval ();
470 int position = interval->position;
471 int new_length = LENGTH (interval) - offset;
473 new->position = position + offset;
474 new->parent = interval;
476 if (NULL_RIGHT_CHILD (interval))
478 interval->right = new;
479 new->total_length = new_length;
481 return new;
484 /* Insert the new node between INTERVAL and its right child. */
485 new->right = interval->right;
486 interval->right->parent = new;
487 interval->right = new;
488 new->total_length = new_length + new->right->total_length;
490 balance_an_interval (new);
491 balance_possible_root_interval (interval);
493 return new;
496 /* Split INTERVAL into two pieces, starting the second piece at
497 character position OFFSET (counting from 0), relative to INTERVAL.
498 INTERVAL becomes the right-hand piece, and the left-hand piece
499 (first, lexicographically) is returned.
501 The size and position fields of the two intervals are set based upon
502 those of the original interval. The property list of the new interval
503 is reset, thus it is up to the caller to do the right thing with the
504 result.
506 Note that this does not change the position of INTERVAL; if it is a root,
507 it is still a root after this operation. */
509 INTERVAL
510 split_interval_left (interval, offset)
511 INTERVAL interval;
512 int offset;
514 INTERVAL new = make_interval ();
515 int position = interval->position;
516 int new_length = offset;
518 new->position = interval->position;
519 interval->position = interval->position + offset;
520 new->parent = interval;
522 if (NULL_LEFT_CHILD (interval))
524 interval->left = new;
525 new->total_length = new_length;
527 return new;
530 /* Insert the new node between INTERVAL and its left child. */
531 new->left = interval->left;
532 new->left->parent = new;
533 interval->left = new;
534 new->total_length = new_length + new->left->total_length;
536 balance_an_interval (new);
537 balance_possible_root_interval (interval);
539 return new;
542 /* Find the interval containing text position POSITION in the text
543 represented by the interval tree TREE. POSITION is a buffer
544 position; the earliest position is 1. If POSITION is at the end of
545 the buffer, return the interval containing the last character.
547 The `position' field, which is a cache of an interval's position,
548 is updated in the interval found. Other functions (e.g., next_interval)
549 will update this cache based on the result of find_interval. */
551 INLINE INTERVAL
552 find_interval (tree, position)
553 register INTERVAL tree;
554 register int position;
556 /* The distance from the left edge of the subtree at TREE
557 to POSITION. */
558 register int relative_position = position - BEG;
560 if (NULL_INTERVAL_P (tree))
561 return NULL_INTERVAL;
563 if (relative_position > TOTAL_LENGTH (tree))
564 abort (); /* Paranoia */
566 tree = balance_possible_root_interval (tree);
568 while (1)
570 if (relative_position < LEFT_TOTAL_LENGTH (tree))
572 tree = tree->left;
574 else if (! NULL_RIGHT_CHILD (tree)
575 && relative_position >= (TOTAL_LENGTH (tree)
576 - RIGHT_TOTAL_LENGTH (tree)))
578 relative_position -= (TOTAL_LENGTH (tree)
579 - RIGHT_TOTAL_LENGTH (tree));
580 tree = tree->right;
582 else
584 tree->position =
585 (position - relative_position /* the left edge of *tree */
586 + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */
588 return tree;
593 /* Find the succeeding interval (lexicographically) to INTERVAL.
594 Sets the `position' field based on that of INTERVAL (see
595 find_interval). */
597 INTERVAL
598 next_interval (interval)
599 register INTERVAL interval;
601 register INTERVAL i = interval;
602 register int next_position;
604 if (NULL_INTERVAL_P (i))
605 return NULL_INTERVAL;
606 next_position = interval->position + LENGTH (interval);
608 if (! NULL_RIGHT_CHILD (i))
610 i = i->right;
611 while (! NULL_LEFT_CHILD (i))
612 i = i->left;
614 i->position = next_position;
615 return i;
618 while (! NULL_PARENT (i))
620 if (AM_LEFT_CHILD (i))
622 i = i->parent;
623 i->position = next_position;
624 return i;
627 i = i->parent;
630 return NULL_INTERVAL;
633 /* Find the preceding interval (lexicographically) to INTERVAL.
634 Sets the `position' field based on that of INTERVAL (see
635 find_interval). */
637 INTERVAL
638 previous_interval (interval)
639 register INTERVAL interval;
641 register INTERVAL i;
642 register position_of_previous;
644 if (NULL_INTERVAL_P (interval))
645 return NULL_INTERVAL;
647 if (! NULL_LEFT_CHILD (interval))
649 i = interval->left;
650 while (! NULL_RIGHT_CHILD (i))
651 i = i->right;
653 i->position = interval->position - LENGTH (i);
654 return i;
657 i = interval;
658 while (! NULL_PARENT (i))
660 if (AM_RIGHT_CHILD (i))
662 i = i->parent;
664 i->position = interval->position - LENGTH (i);
665 return i;
667 i = i->parent;
670 return NULL_INTERVAL;
673 #if 0
674 /* Traverse a path down the interval tree TREE to the interval
675 containing POSITION, adjusting all nodes on the path for
676 an addition of LENGTH characters. Insertion between two intervals
677 (i.e., point == i->position, where i is second interval) means
678 text goes into second interval.
680 Modifications are needed to handle the hungry bits -- after simply
681 finding the interval at position (don't add length going down),
682 if it's the beginning of the interval, get the previous interval
683 and check the hugry bits of both. Then add the length going back up
684 to the root. */
686 static INTERVAL
687 adjust_intervals_for_insertion (tree, position, length)
688 INTERVAL tree;
689 int position, length;
691 register int relative_position;
692 register INTERVAL this;
694 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
695 abort ();
697 /* If inserting at point-max of a buffer, that position
698 will be out of range */
699 if (position > TOTAL_LENGTH (tree))
700 position = TOTAL_LENGTH (tree);
701 relative_position = position;
702 this = tree;
704 while (1)
706 if (relative_position <= LEFT_TOTAL_LENGTH (this))
708 this->total_length += length;
709 this = this->left;
711 else if (relative_position > (TOTAL_LENGTH (this)
712 - RIGHT_TOTAL_LENGTH (this)))
714 relative_position -= (TOTAL_LENGTH (this)
715 - RIGHT_TOTAL_LENGTH (this));
716 this->total_length += length;
717 this = this->right;
719 else
721 /* If we are to use zero-length intervals as buffer pointers,
722 then this code will have to change. */
723 this->total_length += length;
724 this->position = LEFT_TOTAL_LENGTH (this)
725 + position - relative_position + 1;
726 return tree;
730 #endif
732 /* Effect an adjustment corresponding to the addition of LENGTH characters
733 of text. Do this by finding the interval containing POSITION in the
734 interval tree TREE, and then adjusting all of its ancestors by adding
735 LENGTH to them.
737 If POSITION is the first character of an interval, meaning that point
738 is actually between the two intervals, make the new text belong to
739 the interval which is "sticky".
741 If both intervals are "sticky", then make them belong to the left-most
742 interval. Another possibility would be to create a new interval for
743 this text, and make it have the merged properties of both ends. */
745 static INTERVAL
746 adjust_intervals_for_insertion (tree, position, length)
747 INTERVAL tree;
748 int position, length;
750 register INTERVAL i;
751 register INTERVAL temp;
752 int eobp = 0;
754 if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
755 abort ();
757 /* If inserting at point-max of a buffer, that position will be out
758 of range. Remember that buffer positions are 1-based. */
759 if (position >= BEG + TOTAL_LENGTH (tree)){
760 position = BEG + TOTAL_LENGTH (tree);
761 eobp = 1;
764 i = find_interval (tree, position);
766 /* If in middle of an interval which is not sticky either way,
767 we must not just give its properties to the insertion.
768 So split this interval at the insertion point. */
769 if (! (position == i->position || eobp)
770 && END_NONSTICKY_P (i)
771 && ! FRONT_STICKY_P (i))
773 temp = split_interval_right (i, position - i->position);
774 copy_properties (i, temp);
775 i = temp;
778 /* If we are positioned between intervals, check the stickiness of
779 both of them. We have to do this too, if we are at BEG or Z. */
780 if (position == i->position || eobp)
782 register INTERVAL prev;
784 if (position == BEG)
785 prev = 0;
786 else if (eobp)
788 prev = i;
789 i = 0;
791 else
792 prev = previous_interval (i);
794 /* Even if we are positioned between intervals, we default
795 to the left one if it exists. We extend it now and split
796 off a part later, if stickyness demands it. */
797 for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
799 temp->total_length += length;
800 temp = balance_possible_root_interval (temp);
803 /* If at least one interval has sticky properties,
804 we check the stickyness property by property. */
805 if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
807 Lisp_Object pleft, pright;
808 struct interval newi;
810 pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
811 pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
812 newi.plist = merge_properties_sticky (pleft, pright);
814 if(! prev) /* i.e. position == BEG */
816 if (! intervals_equal (i, &newi))
818 i = split_interval_left (i, length);
819 i->plist = newi.plist;
822 else if (! intervals_equal (prev, &newi))
824 prev = split_interval_right (prev,
825 position - prev->position);
826 prev->plist = newi.plist;
827 if (! NULL_INTERVAL_P (i)
828 && intervals_equal (prev, i))
829 merge_interval_right (prev);
832 /* We will need to update the cache here later. */
834 else if (! prev && ! NILP (i->plist))
836 /* Just split off a new interval at the left.
837 Since I wasn't front-sticky, the empty plist is ok. */
838 i = split_interval_left (i, length);
842 /* Otherwise just extend the interval. */
843 else
845 for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent)
847 temp->total_length += length;
848 temp = balance_possible_root_interval (temp);
852 return tree;
855 /* Any property might be front-sticky on the left, rear-sticky on the left,
856 front-sticky on the right, or rear-sticky on the right; the 16 combinations
857 can be arranged in a matrix with rows denoting the left conditions and
858 columns denoting the right conditions:
859 _ __ _
860 _ FR FR FR FR
861 FR__ 0 1 2 3
862 _FR 4 5 6 7
863 FR 8 9 A B
864 FR C D E F
866 left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf)
867 rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
868 p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
869 p8 L p9 L pa L pb L pc L pd L pe L pf L)
870 right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
871 rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
872 p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
873 p8 R p9 R pa R pb R pc R pd R pe R pf R)
875 We inherit from whoever has a sticky side facing us. If both sides
876 do (cases 2, 3, E, and F), then we inherit from whichever side has a
877 non-nil value for the current property. If both sides do, then we take
878 from the left.
880 When we inherit a property, we get its stickiness as well as its value.
881 So, when we merge the above two lists, we expect to get this:
883 result = '(front-sticky (p6 p7 pa pb pc pd pe pf)
884 rear-nonsticky (p6 pa)
885 p0 L p1 L p2 L p3 L p6 R p7 R
886 pa R pb R pc L pd L pe L pf L)
888 The optimizable special cases are:
889 left rear-nonsticky = nil, right front-sticky = nil (inherit left)
890 left rear-nonsticky = t, right front-sticky = t (inherit right)
891 left rear-nonsticky = t, right front-sticky = nil (inherit none)
894 Lisp_Object
895 merge_properties_sticky (pleft, pright)
896 Lisp_Object pleft, pright;
898 register Lisp_Object props, front, rear;
899 Lisp_Object lfront, lrear, rfront, rrear;
900 register Lisp_Object tail1, tail2, sym, lval, rval;
901 int use_left, use_right;
903 props = Qnil;
904 front = Qnil;
905 rear = Qnil;
906 lfront = textget (pleft, Qfront_sticky);
907 lrear = textget (pleft, Qrear_nonsticky);
908 rfront = textget (pright, Qfront_sticky);
909 rrear = textget (pright, Qrear_nonsticky);
911 /* Go through each element of PRIGHT. */
912 for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
914 sym = Fcar (tail1);
916 /* Sticky properties get special treatment. */
917 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
918 continue;
920 rval = Fcar (Fcdr (tail1));
921 for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
922 if (EQ (sym, Fcar (tail2)))
923 break;
924 lval = (NILP (tail2) ? Qnil : Fcar( Fcdr (tail2)));
926 use_left = ! TMEM (sym, lrear);
927 use_right = TMEM (sym, rfront);
928 if (use_left && use_right)
930 use_left = ! NILP (lval);
931 use_right = ! NILP (rval);
933 if (use_left)
935 /* We build props as (value sym ...) rather than (sym value ...)
936 because we plan to nreverse it when we're done. */
937 if (! NILP (lval))
938 props = Fcons (lval, Fcons (sym, props));
939 if (TMEM (sym, lfront))
940 front = Fcons (sym, front);
941 if (TMEM (sym, lrear))
942 rear = Fcons (sym, rear);
944 else if (use_right)
946 if (! NILP (rval))
947 props = Fcons (rval, Fcons (sym, props));
948 if (TMEM (sym, rfront))
949 front = Fcons (sym, front);
950 if (TMEM (sym, rrear))
951 rear = Fcons (sym, rear);
955 /* Now go through each element of PLEFT. */
956 for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
958 sym = Fcar (tail2);
960 /* Sticky properties get special treatment. */
961 if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
962 continue;
964 /* If sym is in PRIGHT, we've already considered it. */
965 for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
966 if (EQ (sym, Fcar (tail1)))
967 break;
968 if (! NILP (tail1))
969 continue;
971 lval = Fcar (Fcdr (tail2));
973 /* Since rval is known to be nil in this loop, the test simplifies. */
974 if (! TMEM (sym, lrear))
976 if (! NILP (lval))
977 props = Fcons (lval, Fcons (sym, props));
978 if (TMEM (sym, lfront))
979 front = Fcons (sym, front);
981 else if (TMEM (sym, rfront))
983 /* The value is nil, but we still inherit the stickiness
984 from the right. */
985 front = Fcons (sym, front);
986 if (TMEM (sym, rrear))
987 rear = Fcons (sym, rear);
990 props = Fnreverse (props);
991 if (! NILP (rear))
992 props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
993 if (! NILP (front))
994 props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
995 return props;
999 /* Delete an node I from its interval tree by merging its subtrees
1000 into one subtree which is then returned. Caller is responsible for
1001 storing the resulting subtree into its parent. */
1003 static INTERVAL
1004 delete_node (i)
1005 register INTERVAL i;
1007 register INTERVAL migrate, this;
1008 register int migrate_amt;
1010 if (NULL_INTERVAL_P (i->left))
1011 return i->right;
1012 if (NULL_INTERVAL_P (i->right))
1013 return i->left;
1015 migrate = i->left;
1016 migrate_amt = i->left->total_length;
1017 this = i->right;
1018 this->total_length += migrate_amt;
1019 while (! NULL_INTERVAL_P (this->left))
1021 this = this->left;
1022 this->total_length += migrate_amt;
1024 this->left = migrate;
1025 migrate->parent = this;
1027 return i->right;
1030 /* Delete interval I from its tree by calling `delete_node'
1031 and properly connecting the resultant subtree.
1033 I is presumed to be empty; that is, no adjustments are made
1034 for the length of I. */
1036 void
1037 delete_interval (i)
1038 register INTERVAL i;
1040 register INTERVAL parent;
1041 int amt = LENGTH (i);
1043 if (amt > 0) /* Only used on zero-length intervals now. */
1044 abort ();
1046 if (ROOT_INTERVAL_P (i))
1048 Lisp_Object owner;
1049 owner = (Lisp_Object) i->parent;
1050 parent = delete_node (i);
1051 if (! NULL_INTERVAL_P (parent))
1052 parent->parent = (INTERVAL) owner;
1054 if (XTYPE (owner) == Lisp_Buffer)
1055 XBUFFER (owner)->intervals = parent;
1056 else if (XTYPE (owner) == Lisp_String)
1057 XSTRING (owner)->intervals = parent;
1058 else
1059 abort ();
1061 return;
1064 parent = i->parent;
1065 if (AM_LEFT_CHILD (i))
1067 parent->left = delete_node (i);
1068 if (! NULL_INTERVAL_P (parent->left))
1069 parent->left->parent = parent;
1071 else
1073 parent->right = delete_node (i);
1074 if (! NULL_INTERVAL_P (parent->right))
1075 parent->right->parent = parent;
1079 /* Find the interval in TREE corresponding to the relative position
1080 FROM and delete as much as possible of AMOUNT from that interval.
1081 Return the amount actually deleted, and if the interval was
1082 zeroed-out, delete that interval node from the tree.
1084 Note that FROM is actually origin zero, aka relative to the
1085 leftmost edge of tree. This is appropriate since we call ourselves
1086 recursively on subtrees.
1088 Do this by recursing down TREE to the interval in question, and
1089 deleting the appropriate amount of text. */
1091 static int
1092 interval_deletion_adjustment (tree, from, amount)
1093 register INTERVAL tree;
1094 register int from, amount;
1096 register int relative_position = from;
1098 if (NULL_INTERVAL_P (tree))
1099 return 0;
1101 /* Left branch */
1102 if (relative_position < LEFT_TOTAL_LENGTH (tree))
1104 int subtract = interval_deletion_adjustment (tree->left,
1105 relative_position,
1106 amount);
1107 tree->total_length -= subtract;
1108 return subtract;
1110 /* Right branch */
1111 else if (relative_position >= (TOTAL_LENGTH (tree)
1112 - RIGHT_TOTAL_LENGTH (tree)))
1114 int subtract;
1116 relative_position -= (tree->total_length
1117 - RIGHT_TOTAL_LENGTH (tree));
1118 subtract = interval_deletion_adjustment (tree->right,
1119 relative_position,
1120 amount);
1121 tree->total_length -= subtract;
1122 return subtract;
1124 /* Here -- this node. */
1125 else
1127 /* How much can we delete from this interval? */
1128 int my_amount = ((tree->total_length
1129 - RIGHT_TOTAL_LENGTH (tree))
1130 - relative_position);
1132 if (amount > my_amount)
1133 amount = my_amount;
1135 tree->total_length -= amount;
1136 if (LENGTH (tree) == 0)
1137 delete_interval (tree);
1139 return amount;
1142 /* Never reach here. */
1145 /* Effect the adjustments necessary to the interval tree of BUFFER to
1146 correspond to the deletion of LENGTH characters from that buffer
1147 text. The deletion is effected at position START (which is a
1148 buffer position, i.e. origin 1). */
1150 static void
1151 adjust_intervals_for_deletion (buffer, start, length)
1152 struct buffer *buffer;
1153 int start, length;
1155 register int left_to_delete = length;
1156 register INTERVAL tree = buffer->intervals;
1157 register int deleted;
1159 if (NULL_INTERVAL_P (tree))
1160 return;
1162 if (start > BEG + TOTAL_LENGTH (tree)
1163 || start + length > BEG + TOTAL_LENGTH (tree))
1164 abort ();
1166 if (length == TOTAL_LENGTH (tree))
1168 buffer->intervals = NULL_INTERVAL;
1169 return;
1172 if (ONLY_INTERVAL_P (tree))
1174 tree->total_length -= length;
1175 return;
1178 if (start > BEG + TOTAL_LENGTH (tree))
1179 start = BEG + TOTAL_LENGTH (tree);
1180 while (left_to_delete > 0)
1182 left_to_delete -= interval_deletion_adjustment (tree, start - 1,
1183 left_to_delete);
1184 tree = buffer->intervals;
1185 if (left_to_delete == tree->total_length)
1187 buffer->intervals = NULL_INTERVAL;
1188 return;
1193 /* Make the adjustments necessary to the interval tree of BUFFER to
1194 represent an addition or deletion of LENGTH characters starting
1195 at position START. Addition or deletion is indicated by the sign
1196 of LENGTH. */
1198 INLINE void
1199 offset_intervals (buffer, start, length)
1200 struct buffer *buffer;
1201 int start, length;
1203 if (NULL_INTERVAL_P (buffer->intervals) || length == 0)
1204 return;
1206 if (length > 0)
1207 adjust_intervals_for_insertion (buffer->intervals, start, length);
1208 else
1209 adjust_intervals_for_deletion (buffer, start, -length);
1212 /* Merge interval I with its lexicographic successor. The resulting
1213 interval is returned, and has the properties of the original
1214 successor. The properties of I are lost. I is removed from the
1215 interval tree.
1217 IMPORTANT:
1218 The caller must verify that this is not the last (rightmost)
1219 interval. */
1221 INTERVAL
1222 merge_interval_right (i)
1223 register INTERVAL i;
1225 register int absorb = LENGTH (i);
1226 register INTERVAL successor;
1228 /* Zero out this interval. */
1229 i->total_length -= absorb;
1231 /* Find the succeeding interval. */
1232 if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
1233 as we descend. */
1235 successor = i->right;
1236 while (! NULL_LEFT_CHILD (successor))
1238 successor->total_length += absorb;
1239 successor = successor->left;
1242 successor->total_length += absorb;
1243 delete_interval (i);
1244 return successor;
1247 successor = i;
1248 while (! NULL_PARENT (successor)) /* It's above us. Subtract as
1249 we ascend. */
1251 if (AM_LEFT_CHILD (successor))
1253 successor = successor->parent;
1254 delete_interval (i);
1255 return successor;
1258 successor = successor->parent;
1259 successor->total_length -= absorb;
1262 /* This must be the rightmost or last interval and cannot
1263 be merged right. The caller should have known. */
1264 abort ();
1267 /* Merge interval I with its lexicographic predecessor. The resulting
1268 interval is returned, and has the properties of the original predecessor.
1269 The properties of I are lost. Interval node I is removed from the tree.
1271 IMPORTANT:
1272 The caller must verify that this is not the first (leftmost) interval. */
1274 INTERVAL
1275 merge_interval_left (i)
1276 register INTERVAL i;
1278 register int absorb = LENGTH (i);
1279 register INTERVAL predecessor;
1281 /* Zero out this interval. */
1282 i->total_length -= absorb;
1284 /* Find the preceding interval. */
1285 if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
1286 adding ABSORB as we go. */
1288 predecessor = i->left;
1289 while (! NULL_RIGHT_CHILD (predecessor))
1291 predecessor->total_length += absorb;
1292 predecessor = predecessor->right;
1295 predecessor->total_length += absorb;
1296 delete_interval (i);
1297 return predecessor;
1300 predecessor = i;
1301 while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
1302 subtracting ABSORB. */
1304 if (AM_RIGHT_CHILD (predecessor))
1306 predecessor = predecessor->parent;
1307 delete_interval (i);
1308 return predecessor;
1311 predecessor = predecessor->parent;
1312 predecessor->total_length -= absorb;
1315 /* This must be the leftmost or first interval and cannot
1316 be merged left. The caller should have known. */
1317 abort ();
1320 /* Make an exact copy of interval tree SOURCE which descends from
1321 PARENT. This is done by recursing through SOURCE, copying
1322 the current interval and its properties, and then adjusting
1323 the pointers of the copy. */
1325 static INTERVAL
1326 reproduce_tree (source, parent)
1327 INTERVAL source, parent;
1329 register INTERVAL t = make_interval ();
1331 bcopy (source, t, INTERVAL_SIZE);
1332 copy_properties (source, t);
1333 t->parent = parent;
1334 if (! NULL_LEFT_CHILD (source))
1335 t->left = reproduce_tree (source->left, t);
1336 if (! NULL_RIGHT_CHILD (source))
1337 t->right = reproduce_tree (source->right, t);
1339 return t;
1342 #if 0
1343 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */
1345 /* Make a new interval of length LENGTH starting at START in the
1346 group of intervals INTERVALS, which is actually an interval tree.
1347 Returns the new interval.
1349 Generate an error if the new positions would overlap an existing
1350 interval. */
1352 static INTERVAL
1353 make_new_interval (intervals, start, length)
1354 INTERVAL intervals;
1355 int start, length;
1357 INTERVAL slot;
1359 slot = find_interval (intervals, start);
1360 if (start + length > slot->position + LENGTH (slot))
1361 error ("Interval would overlap");
1363 if (start == slot->position && length == LENGTH (slot))
1364 return slot;
1366 if (slot->position == start)
1368 /* New right node. */
1369 split_interval_right (slot, length);
1370 return slot;
1373 if (slot->position + LENGTH (slot) == start + length)
1375 /* New left node. */
1376 split_interval_left (slot, LENGTH (slot) - length);
1377 return slot;
1380 /* Convert interval SLOT into three intervals. */
1381 split_interval_left (slot, start - slot->position);
1382 split_interval_right (slot, length);
1383 return slot;
1385 #endif
1387 /* Insert the intervals of SOURCE into BUFFER at POSITION.
1388 LENGTH is the length of the text in SOURCE.
1390 This is used in insdel.c when inserting Lisp_Strings into the
1391 buffer. The text corresponding to SOURCE is already in the buffer
1392 when this is called. The intervals of new tree are a copy of those
1393 belonging to the string being inserted; intervals are never
1394 shared.
1396 If the inserted text had no intervals associated, and we don't
1397 want to inherit the surrounding text's properties, this function
1398 simply returns -- offset_intervals should handle placing the
1399 text in the correct interval, depending on the sticky bits.
1401 If the inserted text had properties (intervals), then there are two
1402 cases -- either insertion happened in the middle of some interval,
1403 or between two intervals.
1405 If the text goes into the middle of an interval, then new
1406 intervals are created in the middle with only the properties of
1407 the new text, *unless* the macro MERGE_INSERTIONS is true, in
1408 which case the new text has the union of its properties and those
1409 of the text into which it was inserted.
1411 If the text goes between two intervals, then if neither interval
1412 had its appropriate sticky property set (front_sticky, rear_sticky),
1413 the new text has only its properties. If one of the sticky properties
1414 is set, then the new text "sticks" to that region and its properties
1415 depend on merging as above. If both the preceding and succeeding
1416 intervals to the new text are "sticky", then the new text retains
1417 only its properties, as if neither sticky property were set. Perhaps
1418 we should consider merging all three sets of properties onto the new
1419 text... */
1421 void
1422 graft_intervals_into_buffer (source, position, length, buffer, inherit)
1423 INTERVAL source;
1424 int position, length;
1425 struct buffer *buffer;
1426 int inherit;
1428 register INTERVAL under, over, this, prev;
1429 register INTERVAL tree = buffer->intervals;
1430 int middle;
1432 /* If the new text has no properties, it becomes part of whatever
1433 interval it was inserted into. */
1434 if (NULL_INTERVAL_P (source))
1436 Lisp_Object buf;
1437 if (!inherit && ! NULL_INTERVAL_P (tree))
1439 XSET (buf, Lisp_Buffer, buffer);
1440 Fset_text_properties (make_number (position),
1441 make_number (position + length),
1442 Qnil, buf);
1444 if (! NULL_INTERVAL_P (buffer->intervals))
1445 buffer->intervals = balance_an_interval (buffer->intervals);
1446 return;
1449 if (NULL_INTERVAL_P (tree))
1451 /* The inserted text constitutes the whole buffer, so
1452 simply copy over the interval structure. */
1453 if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1455 Lisp_Object buf;
1456 XSET (buf, Lisp_Buffer, buffer);
1457 buffer->intervals = reproduce_tree (source, buf);
1458 /* Explicitly free the old tree here. */
1460 return;
1463 /* Create an interval tree in which to place a copy
1464 of the intervals of the inserted string. */
1466 Lisp_Object buf;
1467 XSET (buf, Lisp_Buffer, buffer);
1468 tree = create_root_interval (buf);
1471 else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1472 /* If the buffer contains only the new string, but
1473 there was already some interval tree there, then it may be
1474 some zero length intervals. Eventually, do something clever
1475 about inserting properly. For now, just waste the old intervals. */
1477 buffer->intervals = reproduce_tree (source, tree->parent);
1478 /* Explicitly free the old tree here. */
1480 return;
1482 /* Paranoia -- the text has already been added, so this buffer
1483 should be of non-zero length. */
1484 else if (TOTAL_LENGTH (tree) == 0)
1485 abort ();
1487 this = under = find_interval (tree, position);
1488 if (NULL_INTERVAL_P (under)) /* Paranoia */
1489 abort ();
1490 over = find_interval (source, 1);
1492 /* Here for insertion in the middle of an interval.
1493 Split off an equivalent interval to the right,
1494 then don't bother with it any more. */
1496 if (position > under->position)
1498 INTERVAL end_unchanged
1499 = split_interval_left (this, position - under->position);
1500 copy_properties (under, end_unchanged);
1501 under->position = position;
1502 prev = 0;
1503 middle = 1;
1505 else
1507 prev = previous_interval (under);
1508 if (prev && !END_NONSTICKY_P (prev))
1509 prev = 0;
1512 /* Insertion is now at beginning of UNDER. */
1514 /* The inserted text "sticks" to the interval `under',
1515 which means it gets those properties.
1516 The properties of under are the result of
1517 adjust_intervals_for_insertion, so stickyness has
1518 already been taken care of. */
1520 while (! NULL_INTERVAL_P (over))
1522 if (LENGTH (over) < LENGTH (under))
1524 this = split_interval_left (under, LENGTH (over));
1525 copy_properties (under, this);
1527 else
1528 this = under;
1529 copy_properties (over, this);
1530 if (inherit)
1531 merge_properties (over, this);
1532 else
1533 copy_properties (over, this);
1534 over = next_interval (over);
1537 if (! NULL_INTERVAL_P (buffer->intervals))
1538 buffer->intervals = balance_an_interval (buffer->intervals);
1539 return;
1542 /* Get the value of property PROP from PLIST,
1543 which is the plist of an interval.
1544 We check for direct properties and for categories with property PROP. */
1546 Lisp_Object
1547 textget (plist, prop)
1548 Lisp_Object plist;
1549 register Lisp_Object prop;
1551 register Lisp_Object tail, fallback;
1552 fallback = Qnil;
1554 for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
1556 register Lisp_Object tem;
1557 tem = Fcar (tail);
1558 if (EQ (prop, tem))
1559 return Fcar (Fcdr (tail));
1560 if (EQ (tem, Qcategory))
1561 fallback = Fget (Fcar (Fcdr (tail)), prop);
1564 return fallback;
1567 /* Get the value of property PROP from PLIST,
1568 which is the plist of an interval.
1569 We check for direct properties only! */
1571 Lisp_Object
1572 textget_direct (plist, prop)
1573 Lisp_Object plist;
1574 register Lisp_Object prop;
1576 register Lisp_Object tail;
1578 for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
1580 if (EQ (prop, Fcar (tail)))
1581 return Fcar (Fcdr (tail));
1584 return Qnil;
1587 /* Set point in BUFFER to POSITION. If the target position is
1588 before an invisible character which is not displayed with a special glyph,
1589 move back to an ok place to display. */
1591 void
1592 set_point (position, buffer)
1593 register int position;
1594 register struct buffer *buffer;
1596 register INTERVAL to, from, toprev, fromprev, target;
1597 int buffer_point;
1598 register Lisp_Object obj;
1599 int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
1600 int old_position = buffer->text.pt;
1602 if (position == buffer->text.pt)
1603 return;
1605 /* Check this now, before checking if the buffer has any intervals.
1606 That way, we can catch conditions which break this sanity check
1607 whether or not there are intervals in the buffer. */
1608 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
1609 abort ();
1611 if (NULL_INTERVAL_P (buffer->intervals))
1613 buffer->text.pt = position;
1614 return;
1617 /* Set TO to the interval containing the char after POSITION,
1618 and TOPREV to the interval containing the char before POSITION.
1619 Either one may be null. They may be equal. */
1620 to = find_interval (buffer->intervals, position);
1621 if (position == BUF_BEGV (buffer))
1622 toprev = 0;
1623 else if (to->position == position)
1624 toprev = previous_interval (to);
1625 else
1626 toprev = to;
1628 buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
1629 ? BUF_ZV (buffer) - 1
1630 : BUF_PT (buffer));
1632 /* Set FROM to the interval containing the char after PT,
1633 and FROMPREV to the interval containing the char before PT.
1634 Either one may be null. They may be equal. */
1635 /* We could cache this and save time. */
1636 from = find_interval (buffer->intervals, buffer_point);
1637 if (buffer_point == BUF_BEGV (buffer))
1638 fromprev = 0;
1639 else if (from->position == BUF_PT (buffer))
1640 fromprev = previous_interval (from);
1641 else if (buffer_point != BUF_PT (buffer))
1642 fromprev = from, from = 0;
1643 else
1644 fromprev = from;
1646 /* Moving within an interval. */
1647 if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
1649 buffer->text.pt = position;
1650 return;
1653 /* If the new position is before an intangible character,
1654 move forward over all such. */
1655 while (! NULL_INTERVAL_P (to)
1656 && ! NILP (textget (to->plist, Qintangible)))
1658 toprev = to;
1659 to = next_interval (to);
1660 if (NULL_INTERVAL_P (to))
1661 position = BUF_ZV (buffer);
1662 else
1663 position = to->position;
1666 buffer->text.pt = position;
1668 /* We run point-left and point-entered hooks here, iff the
1669 two intervals are not equivalent. These hooks take
1670 (old_point, new_point) as arguments. */
1671 if (NILP (Vinhibit_point_motion_hooks)
1672 && (! intervals_equal (from, to)
1673 || ! intervals_equal (fromprev, toprev)))
1675 Lisp_Object leave_after, leave_before, enter_after, enter_before;
1677 if (fromprev)
1678 leave_after = textget (fromprev->plist, Qpoint_left);
1679 else
1680 leave_after = Qnil;
1681 if (from)
1682 leave_before = textget (from->plist, Qpoint_left);
1683 else
1684 leave_before = Qnil;
1686 if (toprev)
1687 enter_after = textget (toprev->plist, Qpoint_entered);
1688 else
1689 enter_after = Qnil;
1690 if (to)
1691 enter_before = textget (to->plist, Qpoint_entered);
1692 else
1693 enter_before = Qnil;
1695 if (! EQ (leave_before, enter_before) && !NILP (leave_before))
1696 call2 (leave_before, old_position, position);
1697 if (! EQ (leave_after, enter_after) && !NILP (leave_after))
1698 call2 (leave_after, old_position, position);
1700 if (! EQ (enter_before, leave_before) && !NILP (enter_before))
1701 call2 (enter_before, old_position, position);
1702 if (! EQ (enter_after, leave_after) && !NILP (enter_after))
1703 call2 (enter_after, old_position, position);
1707 /* Set point temporarily, without checking any text properties. */
1709 INLINE void
1710 temp_set_point (position, buffer)
1711 int position;
1712 struct buffer *buffer;
1714 buffer->text.pt = position;
1717 /* Return the proper local map for position POSITION in BUFFER.
1718 Use the map specified by the local-map property, if any.
1719 Otherwise, use BUFFER's local map. */
1721 Lisp_Object
1722 get_local_map (position, buffer)
1723 register int position;
1724 register struct buffer *buffer;
1726 register INTERVAL interval;
1727 Lisp_Object prop, tem;
1729 if (NULL_INTERVAL_P (buffer->intervals))
1730 return current_buffer->keymap;
1732 /* Perhaps we should just change `position' to the limit. */
1733 if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
1734 abort ();
1736 interval = find_interval (buffer->intervals, position);
1737 prop = textget (interval->plist, Qlocal_map);
1738 if (NILP (prop))
1739 return current_buffer->keymap;
1741 /* Use the local map only if it is valid. */
1742 tem = Fkeymapp (prop);
1743 if (!NILP (tem))
1744 return prop;
1746 return current_buffer->keymap;
1749 /* Call the modification hook functions in LIST, each with START and END. */
1751 static void
1752 call_mod_hooks (list, start, end)
1753 Lisp_Object list, start, end;
1755 struct gcpro gcpro1;
1756 GCPRO1 (list);
1757 while (!NILP (list))
1759 call2 (Fcar (list), start, end);
1760 list = Fcdr (list);
1762 UNGCPRO;
1765 /* Check for read-only intervals and signal an error if we find one.
1766 Then check for any modification hooks in the range START up to
1767 (but not including) TO. Create a list of all these hooks in
1768 lexicographic order, eliminating consecutive extra copies of the
1769 same hook. Then call those hooks in order, with START and END - 1
1770 as arguments. */
1772 void
1773 verify_interval_modification (buf, start, end)
1774 struct buffer *buf;
1775 int start, end;
1777 register INTERVAL intervals = buf->intervals;
1778 register INTERVAL i, prev;
1779 Lisp_Object hooks;
1780 register Lisp_Object prev_mod_hooks;
1781 Lisp_Object mod_hooks;
1782 struct gcpro gcpro1;
1784 hooks = Qnil;
1785 prev_mod_hooks = Qnil;
1786 mod_hooks = Qnil;
1788 if (NULL_INTERVAL_P (intervals))
1789 return;
1791 if (start > end)
1793 int temp = start;
1794 start = end;
1795 end = temp;
1798 /* For an insert operation, check the two chars around the position. */
1799 if (start == end)
1801 INTERVAL prev;
1802 Lisp_Object before, after;
1804 /* Set I to the interval containing the char after START,
1805 and PREV to the interval containing the char before START.
1806 Either one may be null. They may be equal. */
1807 i = find_interval (intervals, start);
1809 if (start == BUF_BEGV (buf))
1810 prev = 0;
1811 else if (i->position == start)
1812 prev = previous_interval (i);
1813 else if (i->position < start)
1814 prev = i;
1815 if (start == BUF_ZV (buf))
1816 i = 0;
1818 /* If Vinhibit_read_only is set and is not a list, we can
1819 skip the read_only checks. */
1820 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
1822 /* If I and PREV differ we need to check for the read-only
1823 property together with its stickyness. If either I or
1824 PREV are 0, this check is all we need.
1825 We have to take special care, since read-only may be
1826 indirectly defined via the category property. */
1827 if (i != prev)
1829 if (! NULL_INTERVAL_P (i))
1831 after = textget (i->plist, Qread_only);
1833 /* If interval I is read-only and read-only is
1834 front-sticky, inhibit insertion.
1835 Check for read-only as well as category. */
1836 if (! NILP (after)
1837 && NILP (Fmemq (after, Vinhibit_read_only)))
1839 Lisp_Object tem;
1841 tem = textget (i->plist, Qfront_sticky);
1842 if (TMEM (Qread_only, tem)
1843 || (NILP (textget_direct (i->plist, Qread_only))
1844 && TMEM (Qcategory, tem)))
1845 error ("Attempt to insert within read-only text");
1849 if (! NULL_INTERVAL_P (prev))
1851 before = textget (prev->plist, Qread_only);
1853 /* If interval PREV is read-only and read-only isn't
1854 rear-nonsticky, inhibit insertion.
1855 Check for read-only as well as category. */
1856 if (! NILP (before)
1857 && NILP (Fmemq (before, Vinhibit_read_only)))
1859 Lisp_Object tem;
1861 tem = textget (prev->plist, Qrear_nonsticky);
1862 if (! TMEM (Qread_only, tem)
1863 && (! NILP (textget_direct (prev->plist,Qread_only))
1864 || ! TMEM (Qcategory, tem)))
1865 error ("Attempt to insert within read-only text");
1869 else if (! NULL_INTERVAL_P (i))
1871 after = textget (i->plist, Qread_only);
1873 /* If interval I is read-only and read-only is
1874 front-sticky, inhibit insertion.
1875 Check for read-only as well as category. */
1876 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
1878 Lisp_Object tem;
1880 tem = textget (i->plist, Qfront_sticky);
1881 if (TMEM (Qread_only, tem)
1882 || (NILP (textget_direct (i->plist, Qread_only))
1883 && TMEM (Qcategory, tem)))
1884 error ("Attempt to insert within read-only text");
1886 tem = textget (prev->plist, Qrear_nonsticky);
1887 if (! TMEM (Qread_only, tem)
1888 && (! NILP (textget_direct (prev->plist, Qread_only))
1889 || ! TMEM (Qcategory, tem)))
1890 error ("Attempt to insert within read-only text");
1895 /* Run both insert hooks (just once if they're the same). */
1896 if (!NULL_INTERVAL_P (prev))
1897 prev_mod_hooks = textget (prev->plist, Qinsert_behind_hooks);
1898 if (!NULL_INTERVAL_P (i))
1899 mod_hooks = textget (i->plist, Qinsert_in_front_hooks);
1900 GCPRO1 (mod_hooks);
1901 if (! NILP (prev_mod_hooks))
1902 call_mod_hooks (prev_mod_hooks, make_number (start),
1903 make_number (end));
1904 UNGCPRO;
1905 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
1906 call_mod_hooks (mod_hooks, make_number (start), make_number (end));
1908 else
1910 /* Loop over intervals on or next to START...END,
1911 collecting their hooks. */
1913 i = find_interval (intervals, start);
1916 if (! INTERVAL_WRITABLE_P (i))
1917 error ("Attempt to modify read-only text");
1919 mod_hooks = textget (i->plist, Qmodification_hooks);
1920 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
1922 hooks = Fcons (mod_hooks, hooks);
1923 prev_mod_hooks = mod_hooks;
1926 i = next_interval (i);
1928 /* Keep going thru the interval containing the char before END. */
1929 while (! NULL_INTERVAL_P (i) && i->position < end);
1931 GCPRO1 (hooks);
1932 hooks = Fnreverse (hooks);
1933 while (! EQ (hooks, Qnil))
1935 call_mod_hooks (Fcar (hooks), make_number (start),
1936 make_number (end));
1937 hooks = Fcdr (hooks);
1939 UNGCPRO;
1943 /* Produce an interval tree reflecting the intervals in
1944 TREE from START to START + LENGTH. */
1946 INTERVAL
1947 copy_intervals (tree, start, length)
1948 INTERVAL tree;
1949 int start, length;
1951 register INTERVAL i, new, t;
1952 register int got, prevlen;
1954 if (NULL_INTERVAL_P (tree) || length <= 0)
1955 return NULL_INTERVAL;
1957 i = find_interval (tree, start);
1958 if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
1959 abort ();
1961 /* If there is only one interval and it's the default, return nil. */
1962 if ((start - i->position + 1 + length) < LENGTH (i)
1963 && DEFAULT_INTERVAL_P (i))
1964 return NULL_INTERVAL;
1966 new = make_interval ();
1967 new->position = 1;
1968 got = (LENGTH (i) - (start - i->position));
1969 new->total_length = length;
1970 copy_properties (i, new);
1972 t = new;
1973 prevlen = got;
1974 while (got < length)
1976 i = next_interval (i);
1977 t = split_interval_right (t, prevlen);
1978 copy_properties (i, t);
1979 prevlen = LENGTH (i);
1980 got += prevlen;
1983 return balance_an_interval (new);
1986 /* Give STRING the properties of BUFFER from POSITION to LENGTH. */
1988 INLINE void
1989 copy_intervals_to_string (string, buffer, position, length)
1990 Lisp_Object string, buffer;
1991 int position, length;
1993 INTERVAL interval_copy = copy_intervals (XBUFFER (buffer)->intervals,
1994 position, length);
1995 if (NULL_INTERVAL_P (interval_copy))
1996 return;
1998 interval_copy->parent = (INTERVAL) string;
1999 XSTRING (string)->intervals = interval_copy;
2002 #endif /* USE_TEXT_PROPERTIES */