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