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