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