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