root/src/intervals.c

DEFINITIONS

1. set_interval_left
2. set_interval_right
3. copy_interval_parent
4. create_root_interval
5. copy_properties
6. merge_properties
7. intervals_equal_1
8. intervals_equal
9. traverse_intervals_noorder
10. traverse_intervals
11. rotate_right
12. rotate_left
13. balance_an_interval
14. balance_possible_root_interval
15. balance_intervals_internal
16. balance_intervals
17. buffer_balance_intervals
18. split_interval_right
19. split_interval_left
20. interval_start_pos
21. find_interval
22. next_interval
23. previous_interval
24. update_interval
25. adjust_intervals_for_insertion
26. merge_properties_sticky
27. delete_node
28. delete_interval
29. interval_deletion_adjustment
30. adjust_intervals_for_deletion
31. offset_intervals
32. merge_interval_right
33. merge_interval_left
34. reproduce_interval
35. reproduce_tree
36. reproduce_tree_obj
37. graft_intervals_into_buffer
38. textget
39. lookup_char_property
40. temp_set_point_both
41. temp_set_point
42. set_point
43. set_point_from_marker
44. adjust_for_invis_intang
45. set_point_both
46. move_if_not_intangible
47. get_property_and_range
48. get_local_map
49. copy_intervals
50. copy_intervals_to_string
51. compare_string_intervals
52. set_intervals_multibyte_1
53. set_intervals_multibyte

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