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