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