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