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