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