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