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