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