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