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