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