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