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