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