root/src/textprop.c

DEFINITIONS

1. text_read_only
2. modify_text_properties
3. CHECK_STRING_OR_BUFFER
4. validate_interval_range
5. validate_plist
6. interval_has_all_properties
7. interval_has_some_properties
8. interval_has_some_properties_list
9. property_value
10. set_properties
11. add_properties
12. remove_properties
13. interval_of
14. get_char_property_and_overlay
15. add_text_properties_1
16. set_text_properties
17. set_text_properties_1
18. text_property_stickiness
19. copy_text_properties
20. text_property_list
21. add_text_properties_from_list
22. extend_property_ranges
23. call_mod_hooks
24. verify_interval_modification
25. report_interval_modification
26. syms_of_textprop

     1 /* Interface code for dealing with text properties.
     2    Copyright (C) 1993-2023 Free Software Foundation, Inc.
     3 
     4 This file is part of GNU Emacs.
     5 
     6 GNU Emacs is free software: you can redistribute it and/or modify
     7 it under the terms of the GNU General Public License as published by
     8 the Free Software Foundation, either version 3 of the License, or (at
     9 your option) any later version.
    10 
    11 GNU Emacs is distributed in the hope that it will be useful,
    12 but WITHOUT ANY WARRANTY; without even the implied warranty of
    13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14 GNU General Public License for more details.
    15 
    16 You should have received a copy of the GNU General Public License
    17 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    18 
    19 #include <config.h>
    20 
    21 #include "lisp.h"
    22 #include "intervals.h"
    23 #include "buffer.h"
    24 #include "window.h"
    25 
    26 /* Test for membership, allowing for t (actually any non-cons) to mean the
    27    universal set.  */
    28 
    29 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
    30 
    31 
    32 /* NOTES:  previous- and next- property change will have to skip
    33   zero-length intervals if they are implemented.  This could be done
    34   inside next_interval and previous_interval.
    35 
    36   set_properties needs to deal with the interval property cache.
    37 
    38   It is assumed that for any interval plist, a property appears
    39   only once on the list.  Although some code i.e., remove_properties,
    40   handles the more general case, the uniqueness of properties is
    41   necessary for the system to remain consistent.  This requirement
    42   is enforced by the subrs installing properties onto the intervals.  */
    43 
    44 
    45 
    46 enum property_set_type
    47 {
    48   TEXT_PROPERTY_REPLACE,
    49   TEXT_PROPERTY_PREPEND,
    50   TEXT_PROPERTY_APPEND
    51 };
    52 
    53 /* If o1 is a cons whose cdr is a cons, return true and set o2 to
    54    the o1's cdr.  Otherwise, return false.  This is handy for
    55    traversing plists.  */
    56 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
    57 
    58 /* verify_interval_modification saves insertion hooks here
    59    to be run later by report_interval_modification.  */
    60 Lisp_Object interval_insert_behind_hooks;
    61 Lisp_Object interval_insert_in_front_hooks;
    62 
    63 /* Signal a `text-read-only' error.  This function makes it easier
    64    to capture that error in GDB by putting a breakpoint on it.  */
    65 
    66 static AVOID
    67 text_read_only (Lisp_Object propval)
    68 {
    69   if (STRINGP (propval))
    70     xsignal1 (Qtext_read_only, propval);
    71 
    72   xsignal0 (Qtext_read_only);
    73 }
    74 
    75 /* Prepare to modify the text properties of BUFFER from START to END.  */
    76 
    77 static void
    78 modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
    79 {
    80   ptrdiff_t b = XFIXNUM (start), e = XFIXNUM (end);
    81   struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
    82 
    83   set_buffer_internal (buf);
    84 
    85   prepare_to_modify_buffer_1 (b, e, NULL);
    86 
    87   BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
    88   if (MODIFF <= SAVE_MODIFF)
    89     record_first_change ();
    90   modiff_incr (&MODIFF, 1);
    91 
    92   bset_point_before_scroll (current_buffer, Qnil);
    93 
    94   set_buffer_internal (old);
    95 }
    96 
    97 /* Complain if object is not string or buffer type.  */
    98 
    99 static void
   100 CHECK_STRING_OR_BUFFER (Lisp_Object x)
   101 {
   102   CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
   103 }
   104 
   105 /* Extract the interval at the position pointed to by BEGIN from
   106    OBJECT, a string or buffer.  Additionally, check that the positions
   107    pointed to by BEGIN and END are within the bounds of OBJECT, and
   108    reverse them if *BEGIN is greater than *END.  The objects pointed
   109    to by BEGIN and END may be integers or markers; if the latter, they
   110    are coerced to integers.
   111 
   112    Note that buffer points don't correspond to interval indices.
   113    For example, point-max is 1 greater than the index of the last
   114    character.  This difference is handled in the caller, which uses
   115    the validated points to determine a length, and operates on that.
   116    Exceptions are Ftext_properties_at, Fnext_property_change, and
   117    Fprevious_property_change which call this function with BEGIN == END.
   118    Handle this case specially.
   119 
   120    If FORCE is soft (false), it's OK to return NULL.  Otherwise,
   121    create an interval tree for OBJECT if one doesn't exist, provided
   122    the object actually contains text.  In the current design, if there
   123    is no text, there can be no text properties.  */
   124 
   125 enum { soft = false, hard = true };
   126 
   127 INTERVAL
   128 validate_interval_range (Lisp_Object object, Lisp_Object *begin,
   129                          Lisp_Object *end, bool force)
   130 {
   131   INTERVAL i;
   132   ptrdiff_t searchpos;
   133   Lisp_Object begin0 = *begin, end0 = *end;
   134 
   135   CHECK_STRING_OR_BUFFER (object);
   136   CHECK_FIXNUM_COERCE_MARKER (*begin);
   137   CHECK_FIXNUM_COERCE_MARKER (*end);
   138 
   139   /* If we are asked for a point, but from a subr which operates
   140      on a range, then return nothing.  */
   141   if (EQ (*begin, *end) && begin != end)
   142     return NULL;
   143 
   144   if (XFIXNUM (*begin) > XFIXNUM (*end))
   145     {
   146       Lisp_Object n;
   147       n = *begin;
   148       *begin = *end;
   149       *end = n;
   150     }
   151 
   152   if (BUFFERP (object))
   153     {
   154       register struct buffer *b = XBUFFER (object);
   155 
   156       if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
   157             && XFIXNUM (*end) <= BUF_ZV (b)))
   158         args_out_of_range (begin0, end0);
   159       i = buffer_intervals (b);
   160 
   161       /* If there's no text, there are no properties.  */
   162       if (BUF_BEGV (b) == BUF_ZV (b))
   163         return NULL;
   164 
   165       searchpos = XFIXNUM (*begin);
   166     }
   167   else
   168     {
   169       ptrdiff_t len = SCHARS (object);
   170 
   171       if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
   172              && XFIXNUM (*end) <= len))
   173         args_out_of_range (begin0, end0);
   174       i = string_intervals (object);
   175 
   176       if (len == 0)
   177         return NULL;
   178 
   179       searchpos = XFIXNUM (*begin);
   180     }
   181 
   182   if (!i)
   183     return (force ? create_root_interval (object) : i);
   184 
   185   return find_interval (i, searchpos);
   186 }
   187 
   188 /* Validate LIST as a property list.  If LIST is not a list, then
   189    make one consisting of (LIST nil).  Otherwise, verify that LIST
   190    is even numbered and thus suitable as a plist.  */
   191 
   192 static Lisp_Object
   193 validate_plist (Lisp_Object list)
   194 {
   195   if (NILP (list))
   196     return Qnil;
   197 
   198   if (CONSP (list))
   199     {
   200       Lisp_Object tail = list;
   201       do
   202         {
   203           tail = XCDR (tail);
   204           if (! CONSP (tail))
   205             error ("Odd length text property list");
   206           tail = XCDR (tail);
   207           maybe_quit ();
   208         }
   209       while (CONSP (tail));
   210 
   211       return list;
   212     }
   213 
   214   return list2 (list, Qnil);
   215 }
   216 
   217 /* Return true if interval I has all the properties,
   218    with the same values, of list PLIST.  */
   219 
   220 static bool
   221 interval_has_all_properties (Lisp_Object plist, INTERVAL i)
   222 {
   223   Lisp_Object tail1, tail2;
   224 
   225   /* Go through each element of PLIST.  */
   226   for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
   227     {
   228       Lisp_Object sym1 = XCAR (tail1);
   229       bool found = false;
   230 
   231       /* Go through I's plist, looking for sym1 */
   232       for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
   233         if (EQ (sym1, XCAR (tail2)))
   234           {
   235             /* Found the same property on both lists.  If the
   236                values are unequal, return false.  */
   237             if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
   238               return false;
   239 
   240             /* Property has same value on both lists; go to next one.  */
   241             found = true;
   242             break;
   243           }
   244 
   245       if (! found)
   246         return false;
   247     }
   248 
   249   return true;
   250 }
   251 
   252 /* Return true if the plist of interval I has any of the
   253    properties of PLIST, regardless of their values.  */
   254 
   255 static bool
   256 interval_has_some_properties (Lisp_Object plist, INTERVAL i)
   257 {
   258   Lisp_Object tail1, tail2, sym;
   259 
   260   /* Go through each element of PLIST.  */
   261   for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
   262     {
   263       sym = XCAR (tail1);
   264 
   265       /* Go through i's plist, looking for tail1 */
   266       for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
   267         if (EQ (sym, XCAR (tail2)))
   268           return true;
   269     }
   270 
   271   return false;
   272 }
   273 
   274 /* Return true if the plist of interval I has any of the
   275    property names in LIST, regardless of their values.  */
   276 
   277 static bool
   278 interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
   279 {
   280   Lisp_Object tail1, tail2, sym;
   281 
   282   /* Go through each element of LIST.  */
   283   for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
   284     {
   285       sym = XCAR (tail1);
   286 
   287       /* Go through i's plist, looking for tail1 */
   288       for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
   289         if (EQ (sym, XCAR (tail2)))
   290           return true;
   291     }
   292 
   293   return false;
   294 }
   295 
   296 /* Changing the plists of individual intervals.  */
   297 
   298 /* Return the value of PROP in property-list PLIST, or Qunbound if it
   299    has none.  */
   300 static Lisp_Object
   301 property_value (Lisp_Object plist, Lisp_Object prop)
   302 {
   303   Lisp_Object value;
   304 
   305   while (PLIST_ELT_P (plist, value))
   306     if (EQ (XCAR (plist), prop))
   307       return XCAR (value);
   308     else
   309       plist = XCDR (value);
   310 
   311   return Qunbound;
   312 }
   313 
   314 /* Set the properties of INTERVAL to PROPERTIES,
   315    and record undo info for the previous values.
   316    OBJECT is the string or buffer that INTERVAL belongs to.  */
   317 
   318 static void
   319 set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
   320 {
   321   Lisp_Object sym, value;
   322 
   323   if (BUFFERP (object))
   324     {
   325       /* For each property in the old plist which is missing from PROPERTIES,
   326          or has a different value in PROPERTIES, make an undo record.  */
   327       for (sym = interval->plist;
   328            PLIST_ELT_P (sym, value);
   329            sym = XCDR (value))
   330         if (! EQ (property_value (properties, XCAR (sym)),
   331                   XCAR (value)))
   332           {
   333             record_property_change (interval->position, LENGTH (interval),
   334                                     XCAR (sym), XCAR (value),
   335                                     object);
   336           }
   337 
   338       /* For each new property that has no value at all in the old plist,
   339          make an undo record binding it to nil, so it will be removed.  */
   340       for (sym = properties;
   341            PLIST_ELT_P (sym, value);
   342            sym = XCDR (value))
   343         if (BASE_EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
   344           {
   345             record_property_change (interval->position, LENGTH (interval),
   346                                     XCAR (sym), Qnil,
   347                                     object);
   348           }
   349     }
   350 
   351   /* Store new properties.  */
   352   set_interval_plist (interval, Fcopy_sequence (properties));
   353 }
   354 
   355 /* Add the properties of PLIST to the interval I, or set
   356    the value of I's property to the value of the property on PLIST
   357    if they are different.
   358 
   359    OBJECT should be the string or buffer the interval is in.
   360 
   361    If DESTRUCTIVE, the function is allowed to reuse list values in the
   362    properties.
   363 
   364    Return true if this changes I (i.e., if any members of PLIST
   365    are actually added to I's plist) */
   366 
   367 static bool
   368 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
   369                 enum property_set_type set_type, bool destructive)
   370 {
   371   Lisp_Object tail1, tail2, sym1, val1;
   372   bool changed = false;
   373 
   374   tail1 = plist;
   375   sym1 = Qnil;
   376   val1 = Qnil;
   377 
   378   /* Go through each element of PLIST.  */
   379   for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
   380     {
   381       bool found = false;
   382       sym1 = XCAR (tail1);
   383       val1 = Fcar (XCDR (tail1));
   384 
   385       /* Go through I's plist, looking for sym1 */
   386       for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
   387         if (EQ (sym1, XCAR (tail2)))
   388           {
   389             Lisp_Object this_cdr;
   390 
   391             this_cdr = XCDR (tail2);
   392             /* Found the property.  Now check its value.  */
   393             found = true;
   394 
   395             /* The properties have the same value on both lists.
   396                Continue to the next property.  */
   397             if (EQ (val1, Fcar (this_cdr)))
   398               break;
   399 
   400             /* Record this change in the buffer, for undo purposes.  */
   401             if (BUFFERP (object))
   402               {
   403                 record_property_change (i->position, LENGTH (i),
   404                                         sym1, Fcar (this_cdr), object);
   405               }
   406 
   407             /* I's property has a different value -- change it */
   408             if (set_type == TEXT_PROPERTY_REPLACE)
   409               Fsetcar (this_cdr, val1);
   410             else {
   411               if (CONSP (Fcar (this_cdr)) &&
   412                   /* Special-case anonymous face properties. */
   413                   (! EQ (sym1, Qface) ||
   414                    NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
   415                 /* The previous value is a list, so prepend (or
   416                    append) the new value to this list. */
   417                 if (set_type == TEXT_PROPERTY_PREPEND)
   418                   Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
   419                 else
   420                   {
   421                     /* Appending. */
   422                     if (destructive)
   423                       nconc2 (Fcar (this_cdr), list1 (val1));
   424                     else
   425                       Fsetcar (this_cdr, CALLN (Fappend,
   426                                                 Fcar (this_cdr),
   427                                                 list1 (val1)));
   428                   }
   429               else {
   430                 /* The previous value is a single value, so make it
   431                    into a list. */
   432                 if (set_type == TEXT_PROPERTY_PREPEND)
   433                   Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
   434                 else
   435                   Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
   436               }
   437             }
   438             changed = true;
   439             break;
   440           }
   441 
   442       if (! found)
   443         {
   444           /* Record this change in the buffer, for undo purposes.  */
   445           if (BUFFERP (object))
   446             {
   447               record_property_change (i->position, LENGTH (i),
   448                                       sym1, Qnil, object);
   449             }
   450           set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
   451           changed = true;
   452         }
   453     }
   454 
   455   return changed;
   456 }
   457 
   458 /* For any members of PLIST, or LIST,
   459    which are properties of I, remove them from I's plist.
   460    (If PLIST is non-nil, use that, otherwise use LIST.)
   461    OBJECT is the string or buffer containing I.  */
   462 
   463 static bool
   464 remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
   465 {
   466   bool changed = false;
   467 
   468   /* True means tail1 is a plist, otherwise it is a list.  */
   469   bool use_plist = ! NILP (plist);
   470   Lisp_Object tail1 = use_plist ? plist : list;
   471 
   472   Lisp_Object current_plist = i->plist;
   473 
   474   /* Go through each element of LIST or PLIST.  */
   475   while (CONSP (tail1))
   476     {
   477       Lisp_Object sym = XCAR (tail1);
   478 
   479       /* First, remove the symbol if it's at the head of the list */
   480       while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
   481         {
   482           if (BUFFERP (object))
   483             record_property_change (i->position, LENGTH (i),
   484                                     sym, XCAR (XCDR (current_plist)),
   485                                     object);
   486 
   487           current_plist = XCDR (XCDR (current_plist));
   488           changed = true;
   489         }
   490 
   491       /* Go through I's plist, looking for SYM.  */
   492       Lisp_Object tail2 = current_plist;
   493       while (! NILP (tail2))
   494         {
   495           Lisp_Object this = XCDR (XCDR (tail2));
   496           if (CONSP (this) && EQ (sym, XCAR (this)))
   497             {
   498               if (BUFFERP (object))
   499                 record_property_change (i->position, LENGTH (i),
   500                                         sym, XCAR (XCDR (this)), object);
   501 
   502               Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
   503               changed = true;
   504             }
   505           tail2 = this;
   506         }
   507 
   508       /* Advance thru TAIL1 one way or the other.  */
   509       tail1 = XCDR (tail1);
   510       if (use_plist && CONSP (tail1))
   511         tail1 = XCDR (tail1);
   512     }
   513 
   514   if (changed)
   515     set_interval_plist (i, current_plist);
   516   return changed;
   517 }
   518 
   519 /* Returns the interval of POSITION in OBJECT.
   520    POSITION is BEG-based.  */
   521 
   522 INTERVAL
   523 interval_of (ptrdiff_t position, Lisp_Object object)
   524 {
   525   register INTERVAL i;
   526   ptrdiff_t beg, end;
   527 
   528   if (NILP (object))
   529     XSETBUFFER (object, current_buffer);
   530   else if (EQ (object, Qt))
   531     return NULL;
   532 
   533   CHECK_STRING_OR_BUFFER (object);
   534 
   535   if (BUFFERP (object))
   536     {
   537       register struct buffer *b = XBUFFER (object);
   538 
   539       beg = BUF_BEGV (b);
   540       end = BUF_ZV (b);
   541       i = buffer_intervals (b);
   542     }
   543   else
   544     {
   545       beg = 0;
   546       end = SCHARS (object);
   547       i = string_intervals (object);
   548     }
   549 
   550   if (!(beg <= position && position <= end))
   551     args_out_of_range (make_fixnum (position), make_fixnum (position));
   552   if (beg == end || !i)
   553     return NULL;
   554 
   555   return find_interval (i, position);
   556 }
   557 
   558 DEFUN ("text-properties-at", Ftext_properties_at,
   559        Stext_properties_at, 1, 2, 0,
   560        doc: /* Return the list of properties of the character at POSITION in OBJECT.
   561 If the optional second argument OBJECT is a buffer (or nil, which means
   562 the current buffer), POSITION is a buffer position (integer or marker).
   563 
   564 If OBJECT is a string, POSITION is a 0-based index into it.
   565 
   566 If POSITION is at the end of OBJECT, the value is nil, but note that
   567 buffer narrowing does not affect the value.  That is, if OBJECT is a
   568 buffer or nil, and the buffer is narrowed and POSITION is at the end
   569 of the narrowed buffer, the result may be non-nil.
   570 
   571 If you want to display the text properties at point in a human-readable
   572 form, use the `describe-text-properties' command.  */)
   573   (Lisp_Object position, Lisp_Object object)
   574 {
   575   register INTERVAL i;
   576 
   577   if (NILP (object))
   578     XSETBUFFER (object, current_buffer);
   579 
   580   i = validate_interval_range (object, &position, &position, soft);
   581   if (!i)
   582     return Qnil;
   583   /* If POSITION is at the end of the interval,
   584      it means it's the end of OBJECT.
   585      There are no properties at the very end,
   586      since no character follows.  */
   587   if (XFIXNUM (position) == LENGTH (i) + i->position)
   588     return Qnil;
   589 
   590   return i->plist;
   591 }
   592 
   593 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
   594        doc: /* Return the value of POSITION's property PROP, in OBJECT.
   595 OBJECT should be a buffer or a string; if omitted or nil, it defaults
   596 to the current buffer.
   597 
   598 If POSITION is at the end of OBJECT, the value is nil, but note that
   599 buffer narrowing does not affect the value.  That is, if the buffer is
   600 narrowed and POSITION is at the end of the narrowed buffer, the result
   601 may be non-nil.  */)
   602   (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
   603 {
   604   return textget (Ftext_properties_at (position, object), prop);
   605 }
   606 
   607 /* Return the value of char's property PROP, in OBJECT at POSITION.
   608    OBJECT is optional and defaults to the current buffer.
   609    If OVERLAY is non-0, then in the case that the returned property is from
   610    an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
   611    returned in *OVERLAY.
   612    If POSITION is at the end of OBJECT, the value is nil.
   613    If OBJECT is a buffer, then overlay properties are considered as well as
   614    text properties.
   615    If OBJECT is a window, then that window's buffer is used, but
   616    window-specific overlays are considered only if they are associated
   617    with OBJECT. */
   618 Lisp_Object
   619 get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
   620 {
   621   struct window *w = 0;
   622 
   623   EMACS_INT pos = fix_position (position);
   624 
   625   if (NILP (object))
   626     XSETBUFFER (object, current_buffer);
   627 
   628   if (WINDOWP (object))
   629     {
   630       CHECK_LIVE_WINDOW (object);
   631       w = XWINDOW (object);
   632       object = w->contents;
   633     }
   634   if (BUFFERP (object))
   635     {
   636       struct buffer *b = XBUFFER (object);
   637       struct itree_node *node;
   638       struct sortvec items[2];
   639       struct sortvec *result = NULL;
   640       Lisp_Object result_tem = Qnil;
   641 
   642       if (! (BUF_BEGV (b) <= pos
   643              && pos <= BUF_ZV (b)))
   644         xsignal1 (Qargs_out_of_range, position);
   645 
   646       /* Now check the overlays in order of decreasing priority.  */
   647       ITREE_FOREACH (node, b->overlays, pos, pos + 1, ASCENDING)
   648         {
   649           Lisp_Object tem = Foverlay_get (node->data, prop);
   650           struct sortvec *this;
   651 
   652           if (NILP (tem) || node->end < pos + 1
   653               || (w && ! overlay_matches_window (w, node->data)))
   654             continue;
   655 
   656           this = (result == items ? items + 1 : items);
   657           make_sortvec_item (this, node->data);
   658           if (! result || (compare_overlays (result, this) < 0))
   659             {
   660               result = this;
   661               result_tem = tem;
   662             }
   663         }
   664       if (result)
   665         {
   666           if (overlay)
   667             *overlay = result->overlay;
   668           return result_tem;
   669         }
   670     }
   671 
   672   if (overlay)
   673     /* Indicate that the return value is not from an overlay.  */
   674     *overlay = Qnil;
   675 
   676   /* Not a buffer, or no appropriate overlay, so fall through to the
   677      simpler case.  */
   678   return Fget_text_property (make_fixnum (pos), prop, object);
   679 }
   680 
   681 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
   682        doc: /* Return the value of POSITION's property PROP, in OBJECT.
   683 Both overlay properties and text properties are checked.
   684 OBJECT is optional and defaults to the current buffer.
   685 If POSITION is at the end of OBJECT, the value is nil.
   686 If OBJECT is a buffer, then overlay properties are considered as well as
   687 text properties.
   688 If OBJECT is a window, then that window's buffer is used, but window-specific
   689 overlays are considered only if they are associated with OBJECT.  */)
   690   (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
   691 {
   692   return get_char_property_and_overlay (position, prop, object, 0);
   693 }
   694 
   695 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
   696        Sget_char_property_and_overlay, 2, 3, 0,
   697        doc: /* Like `get-char-property', but with extra overlay information.
   698 The value is a cons cell.  Its car is the return value of `get-char-property'
   699 with the same arguments--that is, the value of POSITION's property
   700 PROP in OBJECT.  Its cdr is the overlay in which the property was
   701 found, or nil, if it was found as a text property or not found at all.
   702 
   703 OBJECT is optional and defaults to the current buffer.  OBJECT may be
   704 a string, a buffer or a window.  For strings, the cdr of the return
   705 value is always nil, since strings do not have overlays.  If OBJECT is
   706 a window, then that window's buffer is used, but window-specific
   707 overlays are considered only if they are associated with OBJECT.  If
   708 POSITION is at the end of OBJECT, both car and cdr are nil.  */)
   709   (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
   710 {
   711   Lisp_Object overlay;
   712   Lisp_Object val
   713     = get_char_property_and_overlay (position, prop, object, &overlay);
   714   return Fcons (val, overlay);
   715 }
   716 
   717 
   718 DEFUN ("next-char-property-change", Fnext_char_property_change,
   719        Snext_char_property_change, 1, 2, 0,
   720        doc: /* Return the position of next text property or overlay change.
   721 This scans characters forward in the current buffer from POSITION till
   722 it finds a change in some text property, or the beginning or end of an
   723 overlay, and returns the position of that.
   724 If none is found, and LIMIT is nil or omitted, the function
   725 returns (point-max).
   726 
   727 If the optional second argument LIMIT is non-nil, the function doesn't
   728 search past position LIMIT, and returns LIMIT if nothing is found
   729 before LIMIT.  LIMIT is a no-op if it is greater than (point-max).  */)
   730   (Lisp_Object position, Lisp_Object limit)
   731 {
   732   Lisp_Object temp;
   733 
   734   temp = Fnext_overlay_change (position);
   735   if (! NILP (limit))
   736     {
   737       CHECK_FIXNUM_COERCE_MARKER (limit);
   738       if (XFIXNUM (limit) < XFIXNUM (temp))
   739         temp = limit;
   740     }
   741   return Fnext_property_change (position, Qnil, temp);
   742 }
   743 
   744 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
   745        Sprevious_char_property_change, 1, 2, 0,
   746        doc: /* Return the position of previous text property or overlay change.
   747 Scans characters backward in the current buffer from POSITION till it
   748 finds a change in some text property, or the beginning or end of an
   749 overlay, and returns the position of that.
   750 If none is found, and LIMIT is nil or omitted, the function
   751 returns (point-min).
   752 
   753 If the optional second argument LIMIT is non-nil, the function doesn't
   754 search before position LIMIT, and returns LIMIT if nothing is found
   755 before LIMIT.  LIMIT is a no-op if it is less than (point-min).  */)
   756   (Lisp_Object position, Lisp_Object limit)
   757 {
   758   Lisp_Object temp;
   759 
   760   temp = Fprevious_overlay_change (position);
   761   if (! NILP (limit))
   762     {
   763       CHECK_FIXNUM_COERCE_MARKER (limit);
   764       if (XFIXNUM (limit) > XFIXNUM (temp))
   765         temp = limit;
   766     }
   767   return Fprevious_property_change (position, Qnil, temp);
   768 }
   769 
   770 
   771 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
   772        Snext_single_char_property_change, 2, 4, 0,
   773        doc: /* Return the position of next text property or overlay change for a specific property.
   774 Scans characters forward from POSITION till it finds
   775 a change in the PROP property, then returns the position of the change.
   776 If the optional third argument OBJECT is a buffer (or nil, which means
   777 the current buffer), POSITION is a buffer position (integer or marker).
   778 If OBJECT is a string, POSITION is a 0-based index into it.
   779 
   780 In a string, scan runs to the end of the string, unless LIMIT is non-nil.
   781 In a buffer, scan runs to end of buffer, unless LIMIT is non-nil.
   782 If the optional fourth argument LIMIT is non-nil, don't search
   783 past position LIMIT; return LIMIT if nothing is found before LIMIT.
   784 However, if OBJECT is a buffer and LIMIT is beyond the end of the
   785 buffer, this function returns `point-max', not LIMIT.
   786 
   787 The property values are compared with `eq'.  */)
   788   (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
   789 {
   790   if (STRINGP (object))
   791     {
   792       position = Fnext_single_property_change (position, prop, object, limit);
   793       if (NILP (position))
   794         {
   795           if (NILP (limit))
   796             position = make_fixnum (SCHARS (object));
   797           else
   798             {
   799               CHECK_FIXNUM (limit);
   800               position = limit;
   801             }
   802         }
   803     }
   804   else
   805     {
   806       Lisp_Object initial_value, value;
   807       specpdl_ref count = SPECPDL_INDEX ();
   808 
   809       if (! NILP (object))
   810         CHECK_BUFFER (object);
   811 
   812       if (BUFFERP (object) && current_buffer != XBUFFER (object))
   813         {
   814           record_unwind_current_buffer ();
   815           Fset_buffer (object);
   816         }
   817 
   818       CHECK_FIXNUM_COERCE_MARKER (position);
   819 
   820       initial_value = Fget_char_property (position, prop, object);
   821 
   822       if (NILP (limit))
   823         XSETFASTINT (limit, ZV);
   824       else
   825         CHECK_FIXNUM_COERCE_MARKER (limit);
   826 
   827       if (XFIXNUM (position) >= XFIXNUM (limit))
   828         {
   829           position = limit;
   830           if (XFIXNUM (position) > ZV)
   831             XSETFASTINT (position, ZV);
   832         }
   833       else
   834         while (true)
   835           {
   836             position = Fnext_char_property_change (position, limit);
   837             if (XFIXNAT (position) >= XFIXNAT (limit))
   838               {
   839                 position = limit;
   840                 break;
   841               }
   842 
   843             value = Fget_char_property (position, prop, object);
   844             if (!EQ (value, initial_value))
   845               break;
   846 
   847             if (XFIXNAT (position) >= ZV)
   848               break;
   849           }
   850 
   851       position = unbind_to (count, position);
   852     }
   853 
   854   return position;
   855 }
   856 
   857 DEFUN ("previous-single-char-property-change",
   858        Fprevious_single_char_property_change,
   859        Sprevious_single_char_property_change, 2, 4, 0,
   860        doc: /* Return the position of previous text property or overlay change for a specific property.
   861 Scans characters backward from POSITION till it finds
   862 a change in the PROP property, then returns the position of the change.
   863 If the optional third argument OBJECT is a buffer (or nil, which means
   864 the current buffer), POSITION is a buffer position (integer or marker).
   865 If OBJECT is a string, POSITION is a 0-based index into it.
   866 
   867 In a string, scan runs to the start of the string, unless LIMIT is non-nil.
   868 In a buffer, if LIMIT is nil or omitted, it runs to (point-min), and the
   869 value cannot be less than that.
   870 If the optional fourth argument LIMIT is non-nil, don't search back past
   871 position LIMIT; return LIMIT if nothing is found before reaching LIMIT.
   872 
   873 The property values are compared with `eq'.
   874 If the property is constant all the way to the start of OBJECT, return the
   875 first valid position in OBJECT.  */)
   876   (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
   877 {
   878   if (STRINGP (object))
   879     {
   880       position = Fprevious_single_property_change (position, prop, object, limit);
   881       if (NILP (position))
   882         {
   883           if (NILP (limit))
   884             position = make_fixnum (0);
   885           else
   886             {
   887               CHECK_FIXNUM (limit);
   888               position = limit;
   889             }
   890         }
   891     }
   892   else
   893     {
   894       specpdl_ref count = SPECPDL_INDEX ();
   895 
   896       if (! NILP (object))
   897         CHECK_BUFFER (object);
   898 
   899       if (BUFFERP (object) && current_buffer != XBUFFER (object))
   900         {
   901           record_unwind_current_buffer ();
   902           Fset_buffer (object);
   903         }
   904 
   905       CHECK_FIXNUM_COERCE_MARKER (position);
   906 
   907       if (NILP (limit))
   908         XSETFASTINT (limit, BEGV);
   909       else
   910         CHECK_FIXNUM_COERCE_MARKER (limit);
   911 
   912       if (XFIXNUM (position) <= XFIXNUM (limit))
   913         {
   914           position = limit;
   915           if (XFIXNUM (position) < BEGV)
   916             XSETFASTINT (position, BEGV);
   917         }
   918       else
   919         {
   920           Lisp_Object initial_value
   921             = Fget_char_property (make_fixnum (XFIXNUM (position)
   922                                                - (0 <= XFIXNUM (position))),
   923                                   prop, object);
   924 
   925           while (true)
   926             {
   927               position = Fprevious_char_property_change (position, limit);
   928 
   929               if (XFIXNAT (position) <= XFIXNAT (limit))
   930                 {
   931                   position = limit;
   932                   break;
   933                 }
   934               else
   935                 {
   936                   Lisp_Object value
   937                     = Fget_char_property (make_fixnum (XFIXNAT (position) - 1),
   938                                           prop, object);
   939 
   940                   if (!EQ (value, initial_value))
   941                     break;
   942                 }
   943             }
   944         }
   945 
   946       position = unbind_to (count, position);
   947     }
   948 
   949   return position;
   950 }
   951 
   952 DEFUN ("next-property-change", Fnext_property_change,
   953        Snext_property_change, 1, 3, 0,
   954        doc: /* Return the position of next property change.
   955 Scans characters forward from POSITION in OBJECT till it finds
   956 a change in some text property, then returns the position of the change.
   957 If the optional second argument OBJECT is a buffer (or nil, which means
   958 the current buffer), POSITION is a buffer position (integer or marker).
   959 If OBJECT is a string, POSITION is a 0-based index into it.
   960 Return nil if LIMIT is nil or omitted, and the property is constant all
   961 the way to the end of OBJECT; if the value is non-nil, it is a position
   962 greater than POSITION, never equal.
   963 
   964 If the optional third argument LIMIT is non-nil, don't search
   965 past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
   966   (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
   967 {
   968   register INTERVAL i, next;
   969 
   970   if (NILP (object))
   971     XSETBUFFER (object, current_buffer);
   972 
   973   if (!NILP (limit) && !EQ (limit, Qt))
   974     CHECK_FIXNUM_COERCE_MARKER (limit);
   975 
   976   i = validate_interval_range (object, &position, &position, soft);
   977 
   978   /* If LIMIT is t, return start of next interval--don't
   979      bother checking further intervals.  */
   980   if (EQ (limit, Qt))
   981     {
   982       if (!i)
   983         next = i;
   984       else
   985         next = next_interval (i);
   986 
   987       if (!next)
   988         XSETFASTINT (position, (STRINGP (object)
   989                                 ? SCHARS (object)
   990                                 : BUF_ZV (XBUFFER (object))));
   991       else
   992         XSETFASTINT (position, next->position);
   993       return position;
   994     }
   995 
   996   if (!i)
   997     return limit;
   998 
   999   next = next_interval (i);
  1000 
  1001   while (next && intervals_equal (i, next)
  1002          && (NILP (limit) || next->position < XFIXNUM (limit)))
  1003     next = next_interval (next);
  1004 
  1005   if (!next
  1006       || (next->position
  1007           >= (FIXNUMP (limit)
  1008               ? XFIXNUM (limit)
  1009               : (STRINGP (object)
  1010                  ? SCHARS (object)
  1011                  : BUF_ZV (XBUFFER (object))))))
  1012     return limit;
  1013   else
  1014     return make_fixnum (next->position);
  1015 }
  1016 
  1017 DEFUN ("next-single-property-change", Fnext_single_property_change,
  1018        Snext_single_property_change, 2, 4, 0,
  1019        doc: /* Return the position of next property change for a specific property.
  1020 Scans characters forward from POSITION till it finds
  1021 a change in the PROP property, then returns the position of the change.
  1022 If the optional third argument OBJECT is a buffer (or nil, which means
  1023 the current buffer), POSITION is a buffer position (integer or marker).
  1024 If OBJECT is a string, POSITION is a 0-based index into it.
  1025 The property values are compared with `eq'.
  1026 Return nil if LIMIT is nil or omitted, and the property is constant all
  1027 the way to the end of OBJECT; if the value is non-nil, it is a position
  1028 greater than POSITION, never equal.
  1029 
  1030 If the optional fourth argument LIMIT is non-nil, don't search
  1031 past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
  1032   (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
  1033 {
  1034   register INTERVAL i, next;
  1035   register Lisp_Object here_val;
  1036 
  1037   if (NILP (object))
  1038     XSETBUFFER (object, current_buffer);
  1039 
  1040   if (!NILP (limit))
  1041     CHECK_FIXNUM_COERCE_MARKER (limit);
  1042 
  1043   i = validate_interval_range (object, &position, &position, soft);
  1044   if (!i)
  1045     return limit;
  1046 
  1047   here_val = textget (i->plist, prop);
  1048   next = next_interval (i);
  1049   while (next
  1050          && EQ (here_val, textget (next->plist, prop))
  1051          && (NILP (limit) || next->position < XFIXNUM (limit)))
  1052     next = next_interval (next);
  1053 
  1054   if (!next
  1055       || (next->position
  1056           >= (FIXNUMP (limit)
  1057               ? XFIXNUM (limit)
  1058               : (STRINGP (object)
  1059                  ? SCHARS (object)
  1060                  : BUF_ZV (XBUFFER (object))))))
  1061     return limit;
  1062   else
  1063     return make_fixnum (next->position);
  1064 }
  1065 
  1066 DEFUN ("previous-property-change", Fprevious_property_change,
  1067        Sprevious_property_change, 1, 3, 0,
  1068        doc: /* Return the position of previous property change.
  1069 Scans characters backwards from POSITION in OBJECT till it finds
  1070 a change in some text property, then returns the position of the change.
  1071 If the optional second argument OBJECT is a buffer (or nil, which means
  1072 the current buffer), POSITION is a buffer position (integer or marker).
  1073 If OBJECT is a string, POSITION is a 0-based index into it.
  1074 Return nil if LIMIT is nil or omitted, and the property is constant all
  1075 the way to the start of OBJECT; if the value is non-nil, it is a position
  1076 less than POSITION, never equal.
  1077 
  1078 If the optional third argument LIMIT is non-nil, don't search
  1079 back past position LIMIT; return LIMIT if nothing is found until LIMIT.  */)
  1080   (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
  1081 {
  1082   register INTERVAL i, previous;
  1083 
  1084   if (NILP (object))
  1085     XSETBUFFER (object, current_buffer);
  1086 
  1087   if (!NILP (limit))
  1088     CHECK_FIXNUM_COERCE_MARKER (limit);
  1089 
  1090   i = validate_interval_range (object, &position, &position, soft);
  1091   if (!i)
  1092     return limit;
  1093 
  1094   /* Start with the interval containing the char before point.  */
  1095   if (i->position == XFIXNAT (position))
  1096     i = previous_interval (i);
  1097 
  1098   previous = previous_interval (i);
  1099   while (previous && intervals_equal (previous, i)
  1100          && (NILP (limit)
  1101              || (previous->position + LENGTH (previous) > XFIXNUM (limit))))
  1102     previous = previous_interval (previous);
  1103 
  1104   if (!previous
  1105       || (previous->position + LENGTH (previous)
  1106           <= (FIXNUMP (limit)
  1107               ? XFIXNUM (limit)
  1108               : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
  1109     return limit;
  1110   else
  1111     return make_fixnum (previous->position + LENGTH (previous));
  1112 }
  1113 
  1114 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
  1115        Sprevious_single_property_change, 2, 4, 0,
  1116        doc: /* Return the position of previous property change for a specific property.
  1117 Scans characters backward from POSITION till it finds
  1118 a change in the PROP property, then returns the position of the change.
  1119 If the optional third argument OBJECT is a buffer (or nil, which means
  1120 the current buffer), POSITION is a buffer position (integer or marker).
  1121 If OBJECT is a string, POSITION is a 0-based index into it.
  1122 The property values are compared with `eq'.
  1123 Return nil if LIMIT is nil or omitted, and the property is constant all
  1124 the way to the start of OBJECT; if the value is non-nil, it is a position
  1125 less than POSITION, never equal.
  1126 
  1127 If the optional fourth argument LIMIT is non-nil, don't search
  1128 back past position LIMIT; return LIMIT if nothing is found until LIMIT.  */)
  1129   (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
  1130 {
  1131   register INTERVAL i, previous;
  1132   register Lisp_Object here_val;
  1133 
  1134   if (NILP (object))
  1135     XSETBUFFER (object, current_buffer);
  1136 
  1137   if (!NILP (limit))
  1138     CHECK_FIXNUM_COERCE_MARKER (limit);
  1139 
  1140   i = validate_interval_range (object, &position, &position, soft);
  1141 
  1142   /* Start with the interval containing the char before point.  */
  1143   if (i && i->position == XFIXNAT (position))
  1144     i = previous_interval (i);
  1145 
  1146   if (!i)
  1147     return limit;
  1148 
  1149   here_val = textget (i->plist, prop);
  1150   previous = previous_interval (i);
  1151   while (previous
  1152          && EQ (here_val, textget (previous->plist, prop))
  1153          && (NILP (limit)
  1154              || (previous->position + LENGTH (previous) > XFIXNUM (limit))))
  1155     previous = previous_interval (previous);
  1156 
  1157   if (!previous
  1158       || (previous->position + LENGTH (previous)
  1159           <= (FIXNUMP (limit)
  1160               ? XFIXNUM (limit)
  1161               : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
  1162     return limit;
  1163   else
  1164     return make_fixnum (previous->position + LENGTH (previous));
  1165 }
  1166 
  1167 /* Used by add-text-properties and add-face-text-property. */
  1168 
  1169 static Lisp_Object
  1170 add_text_properties_1 (Lisp_Object start, Lisp_Object end,
  1171                        Lisp_Object properties, Lisp_Object object,
  1172                        enum property_set_type set_type,
  1173                        bool destructive) {
  1174   /* Ensure we run the modification hooks for the right buffer,
  1175      without switching buffers twice (bug 36190).  FIXME: Switching
  1176      buffers is slow and often unnecessary.  */
  1177   if (BUFFERP (object) && XBUFFER (object) != current_buffer)
  1178     {
  1179       specpdl_ref count = SPECPDL_INDEX ();
  1180       record_unwind_current_buffer ();
  1181       set_buffer_internal (XBUFFER (object));
  1182       return unbind_to (count, add_text_properties_1 (start, end, properties,
  1183                                                       object, set_type,
  1184                                                       destructive));
  1185     }
  1186 
  1187   INTERVAL i, unchanged;
  1188   ptrdiff_t s, len;
  1189   bool modified = false;
  1190   bool first_time = true;
  1191 
  1192   properties = validate_plist (properties);
  1193   if (NILP (properties))
  1194     return Qnil;
  1195 
  1196   if (NILP (object))
  1197     XSETBUFFER (object, current_buffer);
  1198 
  1199  retry:
  1200   i = validate_interval_range (object, &start, &end, hard);
  1201   if (!i)
  1202     return Qnil;
  1203 
  1204   s = XFIXNUM (start);
  1205   len = XFIXNUM (end) - s;
  1206 
  1207   /* If this interval already has the properties, we can skip it.  */
  1208   if (interval_has_all_properties (properties, i))
  1209     {
  1210       ptrdiff_t got = LENGTH (i) - (s - i->position);
  1211 
  1212       do
  1213         {
  1214           if (got >= len)
  1215             return Qnil;
  1216           len -= got;
  1217           i = next_interval (i);
  1218           got = LENGTH (i);
  1219         }
  1220       while (interval_has_all_properties (properties, i));
  1221     }
  1222   else if (i->position != s)
  1223     {
  1224       /* If we're not starting on an interval boundary, we have to
  1225          split this interval.  */
  1226       unchanged = i;
  1227       i = split_interval_right (unchanged, s - unchanged->position);
  1228       copy_properties (unchanged, i);
  1229     }
  1230 
  1231   if (BUFFERP (object) && first_time)
  1232     {
  1233       ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
  1234       ptrdiff_t prev_pos = i->position;
  1235 
  1236       modify_text_properties (object, start, end);
  1237       /* If someone called us recursively as a side effect of
  1238          modify_text_properties, and changed the intervals behind our back
  1239          (could happen if lock_file, called by prepare_to_modify_buffer,
  1240          triggers redisplay, and that calls add-text-properties again
  1241          in the same buffer), we cannot continue with I, because its
  1242          data changed.  So we restart the interval analysis anew.  */
  1243       if (TOTAL_LENGTH (i) != prev_total_length
  1244           || i->position != prev_pos)
  1245         {
  1246           first_time = false;
  1247           goto retry;
  1248         }
  1249     }
  1250 
  1251   /* We are at the beginning of interval I, with LEN chars to scan.  */
  1252   for (;;)
  1253     {
  1254       eassert (i != 0);
  1255 
  1256       if (LENGTH (i) >= len)
  1257         {
  1258           if (interval_has_all_properties (properties, i))
  1259             {
  1260               if (BUFFERP (object))
  1261                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1262                                      XFIXNUM (end) - XFIXNUM (start));
  1263 
  1264               eassert (modified);
  1265               return Qt;
  1266             }
  1267 
  1268           if (LENGTH (i) == len)
  1269             {
  1270               add_properties (properties, i, object, set_type, destructive);
  1271               if (BUFFERP (object))
  1272                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1273                                      XFIXNUM (end) - XFIXNUM (start));
  1274               return Qt;
  1275             }
  1276 
  1277           /* i doesn't have the properties, and goes past the change limit */
  1278           unchanged = i;
  1279           i = split_interval_left (unchanged, len);
  1280           copy_properties (unchanged, i);
  1281           add_properties (properties, i, object, set_type, destructive);
  1282           if (BUFFERP (object))
  1283             signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1284                                  XFIXNUM (end) - XFIXNUM (start));
  1285           return Qt;
  1286         }
  1287 
  1288       len -= LENGTH (i);
  1289       modified |= add_properties (properties, i, object, set_type, destructive);
  1290       i = next_interval (i);
  1291     }
  1292 }
  1293 
  1294 /* Callers note, this can GC when OBJECT is a buffer (or nil).  */
  1295 
  1296 DEFUN ("add-text-properties", Fadd_text_properties,
  1297        Sadd_text_properties, 3, 4, 0,
  1298        doc: /* Add properties to the text from START to END.
  1299 The third argument PROPERTIES is a property list
  1300 specifying the property values to add.  If the optional fourth argument
  1301 OBJECT is a buffer (or nil, which means the current buffer),
  1302 START and END are buffer positions (integers or markers).
  1303 If OBJECT is a string, START and END are 0-based indices into it.
  1304 Return t if any property value actually changed, nil otherwise.  */)
  1305   (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
  1306    Lisp_Object object)
  1307 {
  1308   return add_text_properties_1 (start, end, properties, object,
  1309                                 TEXT_PROPERTY_REPLACE, true);
  1310 }
  1311 
  1312 /* Callers note, this can GC when OBJECT is a buffer (or nil).  */
  1313 
  1314 DEFUN ("put-text-property", Fput_text_property,
  1315        Sput_text_property, 4, 5, 0,
  1316        doc: /* Set one property of the text from START to END.
  1317 The third and fourth arguments PROPERTY and VALUE
  1318 specify the property to add.
  1319 If the optional fifth argument OBJECT is a buffer (or nil, which means
  1320 the current buffer), START and END are buffer positions (integers or
  1321 markers).  If OBJECT is a string, START and END are 0-based indices into it.  */)
  1322   (Lisp_Object start, Lisp_Object end, Lisp_Object property,
  1323    Lisp_Object value, Lisp_Object object)
  1324 {
  1325   AUTO_LIST2 (properties, property, value);
  1326   Fadd_text_properties (start, end, properties, object);
  1327   return Qnil;
  1328 }
  1329 
  1330 DEFUN ("set-text-properties", Fset_text_properties,
  1331        Sset_text_properties, 3, 4, 0,
  1332        doc: /* Completely replace properties of text from START to END.
  1333 The third argument PROPERTIES is the new property list.
  1334 If the optional fourth argument OBJECT is a buffer (or nil, which means
  1335 the current buffer), START and END are buffer positions (integers or
  1336 markers).  If OBJECT is a string, START and END are 0-based indices into it.
  1337 If PROPERTIES is nil, the effect is to remove all properties from
  1338 the designated part of OBJECT.  */)
  1339   (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
  1340 {
  1341   return set_text_properties (start, end, properties, object, Qt);
  1342 }
  1343 
  1344 
  1345 DEFUN ("add-face-text-property", Fadd_face_text_property,
  1346        Sadd_face_text_property, 3, 5, 0,
  1347        doc: /* Add the face property to the text from START to END.
  1348 FACE specifies the face to add.  It should be a valid value of the
  1349 `face' property (typically a face name or a plist of face attributes
  1350 and values).
  1351 
  1352 If any text in the region already has a non-nil `face' property, those
  1353 face(s) are retained.  This is done by setting the `face' property to
  1354 a list of faces, with FACE as the first element (by default) and the
  1355 pre-existing faces as the remaining elements.
  1356 
  1357 If optional fourth argument APPEND is non-nil, append FACE to the end
  1358 of the face list instead.
  1359 
  1360 If optional fifth argument OBJECT is a buffer (or nil, which means the
  1361 current buffer), START and END are buffer positions (integers or
  1362 markers).  If OBJECT is a string, START and END are 0-based indices
  1363 into it.  */)
  1364   (Lisp_Object start, Lisp_Object end, Lisp_Object face,
  1365    Lisp_Object append, Lisp_Object object)
  1366 {
  1367   AUTO_LIST2 (properties, Qface, face);
  1368   add_text_properties_1 (start, end, properties, object,
  1369                          (NILP (append)
  1370                           ? TEXT_PROPERTY_PREPEND
  1371                           : TEXT_PROPERTY_APPEND),
  1372                          false);
  1373   return Qnil;
  1374 }
  1375 
  1376 /* Replace properties of text from START to END with new list of
  1377    properties PROPERTIES.  OBJECT is the buffer or string containing
  1378    the text.  OBJECT nil means use the current buffer.
  1379    COHERENT_CHANGE_P nil means this is being called as an internal
  1380    subroutine, rather than as a change primitive with checking of
  1381    read-only, invoking change hooks, etc..  Value is nil if the
  1382    function _detected_ that it did not replace any properties, non-nil
  1383    otherwise.  */
  1384 
  1385 Lisp_Object
  1386 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
  1387                      Lisp_Object object, Lisp_Object coherent_change_p)
  1388 {
  1389   /* Ensure we run the modification hooks for the right buffer,
  1390      without switching buffers twice (bug 36190).  FIXME: Switching
  1391      buffers is slow and often unnecessary.  */
  1392   if (BUFFERP (object) && XBUFFER (object) != current_buffer)
  1393     {
  1394       specpdl_ref count = SPECPDL_INDEX ();
  1395       record_unwind_current_buffer ();
  1396       set_buffer_internal (XBUFFER (object));
  1397       return unbind_to (count,
  1398                         set_text_properties (start, end, properties,
  1399                                              object, coherent_change_p));
  1400     }
  1401 
  1402   INTERVAL i;
  1403   bool first_time = true;
  1404 
  1405   properties = validate_plist (properties);
  1406 
  1407   if (NILP (object))
  1408     XSETBUFFER (object, current_buffer);
  1409 
  1410   /* If we want no properties for a whole string,
  1411      get rid of its intervals.  */
  1412   if (NILP (properties) && STRINGP (object)
  1413       && BASE_EQ (start, make_fixnum (0))
  1414       && BASE_EQ (end, make_fixnum (SCHARS (object))))
  1415     {
  1416       if (!string_intervals (object))
  1417         return Qnil;
  1418 
  1419       set_string_intervals (object, NULL);
  1420       return Qt;
  1421     }
  1422 
  1423  retry:
  1424   i = validate_interval_range (object, &start, &end, soft);
  1425 
  1426   if (!i)
  1427     {
  1428       /* If buffer has no properties, and we want none, return now.  */
  1429       if (NILP (properties))
  1430         return Qnil;
  1431 
  1432       i = validate_interval_range (object, &start, &end, hard);
  1433       /* This can return if start == end.  */
  1434       if (!i)
  1435         return Qnil;
  1436     }
  1437 
  1438   if (BUFFERP (object) && !NILP (coherent_change_p) && first_time)
  1439     {
  1440       ptrdiff_t prev_length = LENGTH (i);
  1441       ptrdiff_t prev_pos = i->position;
  1442 
  1443       modify_text_properties (object, start, end);
  1444       /* If someone called us recursively as a side effect of
  1445          modify_text_properties, and changed the intervals behind our
  1446          back, we cannot continue with I, because its data changed.
  1447          So we restart the interval analysis anew.  */
  1448       if (LENGTH (i) != prev_length || i->position != prev_pos)
  1449         {
  1450           first_time = false;
  1451           goto retry;
  1452         }
  1453     }
  1454 
  1455   set_text_properties_1 (start, end, properties, object, i);
  1456 
  1457   if (BUFFERP (object) && !NILP (coherent_change_p))
  1458     signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1459                          XFIXNUM (end) - XFIXNUM (start));
  1460   return Qt;
  1461 }
  1462 
  1463 /* Replace properties of text from START to END with new list of
  1464    properties PROPERTIES.  OBJECT is the buffer or string containing
  1465    the text.  This does not obey any hooks.
  1466    I is the interval that START is located in.  */
  1467 
  1468 void
  1469 set_text_properties_1 (Lisp_Object start, Lisp_Object end,
  1470                        Lisp_Object properties, Lisp_Object object, INTERVAL i)
  1471 {
  1472   /* Ensure we run the modification hooks for the right buffer,
  1473      without switching buffers twice (bug 36190).  FIXME: Switching
  1474      buffers is slow and often unnecessary.  */
  1475   if (BUFFERP (object) && XBUFFER (object) != current_buffer)
  1476     {
  1477       specpdl_ref count = SPECPDL_INDEX ();
  1478       record_unwind_current_buffer ();
  1479       set_buffer_internal (XBUFFER (object));
  1480 
  1481       set_text_properties_1 (start, end, properties, object, i);
  1482       unbind_to (count, Qnil);
  1483       return;
  1484     }
  1485 
  1486   INTERVAL prev_changed = NULL;
  1487   ptrdiff_t s = XFIXNUM (start);
  1488   ptrdiff_t len = XFIXNUM (end) - s;
  1489 
  1490   if (len == 0)
  1491     return;
  1492   eassert (0 < len);
  1493 
  1494   eassert (i);
  1495 
  1496   if (i->position != s)
  1497     {
  1498       INTERVAL unchanged = i;
  1499       i = split_interval_right (unchanged, s - unchanged->position);
  1500 
  1501       if (LENGTH (i) > len)
  1502         {
  1503           copy_properties (unchanged, i);
  1504           i = split_interval_left (i, len);
  1505           set_properties (properties, i, object);
  1506           return;
  1507         }
  1508 
  1509       set_properties (properties, i, object);
  1510 
  1511       if (LENGTH (i) == len)
  1512         return;
  1513 
  1514       prev_changed = i;
  1515       len -= LENGTH (i);
  1516       i = next_interval (i);
  1517     }
  1518 
  1519   /* We are starting at the beginning of an interval I.  LEN is positive.  */
  1520   do
  1521     {
  1522       eassert (i != 0);
  1523 
  1524       if (LENGTH (i) >= len)
  1525         {
  1526           if (LENGTH (i) > len)
  1527             i = split_interval_left (i, len);
  1528 
  1529           /* We have to call set_properties even if we are going to
  1530              merge the intervals, so as to make the undo records
  1531              and cause redisplay to happen.  */
  1532           set_properties (properties, i, object);
  1533           if (prev_changed)
  1534             merge_interval_left (i);
  1535           return;
  1536         }
  1537 
  1538       len -= LENGTH (i);
  1539 
  1540       /* We have to call set_properties even if we are going to
  1541          merge the intervals, so as to make the undo records
  1542          and cause redisplay to happen.  */
  1543       set_properties (properties, i, object);
  1544       if (!prev_changed)
  1545         prev_changed = i;
  1546       else
  1547         prev_changed = i = merge_interval_left (i);
  1548 
  1549       i = next_interval (i);
  1550     }
  1551   while (len > 0);
  1552 }
  1553 
  1554 DEFUN ("remove-text-properties", Fremove_text_properties,
  1555        Sremove_text_properties, 3, 4, 0,
  1556        doc: /* Remove some properties from text from START to END.
  1557 The third argument PROPERTIES is a property list
  1558 whose property names specify the properties to remove.
  1559 \(The values stored in PROPERTIES are ignored.)
  1560 If the optional fourth argument OBJECT is a buffer (or nil, which means
  1561 the current buffer), START and END are buffer positions (integers or
  1562 markers).  If OBJECT is a string, START and END are 0-based indices into it.
  1563 Return t if any property was actually removed, nil otherwise.
  1564 
  1565 Use `set-text-properties' if you want to remove all text properties.  */)
  1566   (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
  1567 {
  1568   /* Ensure we run the modification hooks for the right buffer,
  1569      without switching buffers twice (bug 36190).  FIXME: Switching
  1570      buffers is slow and often unnecessary.  */
  1571   if (BUFFERP (object) && XBUFFER (object) != current_buffer)
  1572     {
  1573       specpdl_ref count = SPECPDL_INDEX ();
  1574       record_unwind_current_buffer ();
  1575       set_buffer_internal (XBUFFER (object));
  1576       return unbind_to (count,
  1577                         Fremove_text_properties (start, end, properties,
  1578                                                  object));
  1579     }
  1580 
  1581   INTERVAL i, unchanged;
  1582   ptrdiff_t s, len;
  1583   bool modified = false;
  1584   bool first_time = true;
  1585 
  1586   if (NILP (object))
  1587     XSETBUFFER (object, current_buffer);
  1588 
  1589  retry:
  1590   i = validate_interval_range (object, &start, &end, soft);
  1591   if (!i)
  1592     return Qnil;
  1593 
  1594   s = XFIXNUM (start);
  1595   len = XFIXNUM (end) - s;
  1596 
  1597   /* If there are no properties on this entire interval, return.  */
  1598   if (! interval_has_some_properties (properties, i))
  1599     {
  1600       ptrdiff_t got = LENGTH (i) - (s - i->position);
  1601 
  1602       do
  1603         {
  1604           if (got >= len)
  1605             return Qnil;
  1606           len -= got;
  1607           i = next_interval (i);
  1608           got = LENGTH (i);
  1609         }
  1610       while (! interval_has_some_properties (properties, i));
  1611     }
  1612   /* Split away the beginning of this interval; what we don't
  1613      want to modify.  */
  1614   else if (i->position != s)
  1615     {
  1616       unchanged = i;
  1617       i = split_interval_right (unchanged, s - unchanged->position);
  1618       copy_properties (unchanged, i);
  1619     }
  1620 
  1621   if (BUFFERP (object) && first_time)
  1622     {
  1623       ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
  1624       ptrdiff_t prev_pos = i->position;
  1625 
  1626       modify_text_properties (object, start, end);
  1627       /* If someone called us recursively as a side effect of
  1628          modify_text_properties, and changed the intervals behind our back
  1629          (could happen if lock_file, called by prepare_to_modify_buffer,
  1630          triggers redisplay, and that calls add-text-properties again
  1631          in the same buffer), we cannot continue with I, because its
  1632          data changed.  So we restart the interval analysis anew.  */
  1633       if (TOTAL_LENGTH (i) != prev_total_length
  1634           || i->position != prev_pos)
  1635         {
  1636           first_time = false;
  1637           goto retry;
  1638         }
  1639     }
  1640 
  1641   /* We are at the beginning of an interval, with len to scan */
  1642   for (;;)
  1643     {
  1644       eassert (i != 0);
  1645 
  1646       if (LENGTH (i) >= len)
  1647         {
  1648           if (! interval_has_some_properties (properties, i))
  1649             {
  1650               eassert (modified);
  1651               if (BUFFERP (object))
  1652                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1653                                      XFIXNUM (end) - XFIXNUM (start));
  1654               return Qt;
  1655             }
  1656 
  1657           if (LENGTH (i) == len)
  1658             {
  1659               remove_properties (properties, Qnil, i, object);
  1660               if (BUFFERP (object))
  1661                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1662                                      XFIXNUM (end) - XFIXNUM (start));
  1663               return Qt;
  1664             }
  1665 
  1666           /* i has the properties, and goes past the change limit */
  1667           unchanged = i;
  1668           i = split_interval_left (i, len);
  1669           copy_properties (unchanged, i);
  1670           remove_properties (properties, Qnil, i, object);
  1671           if (BUFFERP (object))
  1672             signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1673                                  XFIXNUM (end) - XFIXNUM (start));
  1674           return Qt;
  1675         }
  1676 
  1677       len -= LENGTH (i);
  1678       modified |= remove_properties (properties, Qnil, i, object);
  1679       i = next_interval (i);
  1680     }
  1681 }
  1682 
  1683 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
  1684        Sremove_list_of_text_properties, 3, 4, 0,
  1685        doc: /* Remove some properties from text from START to END.
  1686 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
  1687 If the optional fourth argument OBJECT is a buffer (or nil, which means
  1688 the current buffer), START and END are buffer positions (integers or
  1689 markers).  If OBJECT is a string, START and END are 0-based indices into it.
  1690 Return t if any property was actually removed, nil otherwise.  */)
  1691   (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
  1692 {
  1693   /* Ensure we run the modification hooks for the right buffer,
  1694      without switching buffers twice (bug 36190).  FIXME: Switching
  1695      buffers is slow and often unnecessary.  */
  1696   if (BUFFERP (object) && XBUFFER (object) != current_buffer)
  1697     {
  1698       specpdl_ref count = SPECPDL_INDEX ();
  1699       record_unwind_current_buffer ();
  1700       set_buffer_internal (XBUFFER (object));
  1701       return unbind_to (count,
  1702                         Fremove_list_of_text_properties (start, end,
  1703                                                          list_of_properties,
  1704                                                          object));
  1705     }
  1706 
  1707   INTERVAL i, unchanged;
  1708   ptrdiff_t s, len;
  1709   bool modified = false;
  1710   Lisp_Object properties;
  1711   properties = list_of_properties;
  1712 
  1713   if (NILP (object))
  1714     XSETBUFFER (object, current_buffer);
  1715 
  1716   i = validate_interval_range (object, &start, &end, soft);
  1717   if (!i)
  1718     return Qnil;
  1719 
  1720   s = XFIXNUM (start);
  1721   len = XFIXNUM (end) - s;
  1722 
  1723   /* If there are no properties on the interval, return.  */
  1724   if (! interval_has_some_properties_list (properties, i))
  1725     {
  1726       ptrdiff_t got = LENGTH (i) - (s - i->position);
  1727 
  1728       do
  1729         {
  1730           if (got >= len)
  1731             return Qnil;
  1732           len -= got;
  1733           i = next_interval (i);
  1734           got = LENGTH (i);
  1735         }
  1736       while (! interval_has_some_properties_list (properties, i));
  1737     }
  1738   /* Split away the beginning of this interval; what we don't
  1739      want to modify.  */
  1740   else if (i->position != s)
  1741     {
  1742       unchanged = i;
  1743       i = split_interval_right (unchanged, s - unchanged->position);
  1744       copy_properties (unchanged, i);
  1745     }
  1746 
  1747   /* We are at the beginning of an interval, with len to scan.
  1748      The flag MODIFIED records if changes have been made.
  1749      When object is a buffer, we must call modify_text_properties
  1750      before changes are made and signal_after_change when we are done.
  1751      Call modify_text_properties before calling remove_properties if !MODIFIED,
  1752      and call signal_after_change before returning if MODIFIED. */
  1753   for (;;)
  1754     {
  1755       eassert (i != 0);
  1756 
  1757       if (LENGTH (i) >= len)
  1758         {
  1759           if (! interval_has_some_properties_list (properties, i))
  1760             {
  1761               if (modified)
  1762                 {
  1763                   if (BUFFERP (object))
  1764                     signal_after_change (XFIXNUM (start),
  1765                                          XFIXNUM (end) - XFIXNUM (start),
  1766                                          XFIXNUM (end) - XFIXNUM (start));
  1767                   return Qt;
  1768                 }
  1769               else
  1770                 return Qnil;
  1771             }
  1772           else if (LENGTH (i) == len)
  1773             {
  1774               if (!modified && BUFFERP (object))
  1775                 modify_text_properties (object, start, end);
  1776               remove_properties (Qnil, properties, i, object);
  1777               if (BUFFERP (object))
  1778                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1779                                      XFIXNUM (end) - XFIXNUM (start));
  1780               return Qt;
  1781             }
  1782           else
  1783             { /* i has the properties, and goes past the change limit.  */
  1784               unchanged = i;
  1785               i = split_interval_left (i, len);
  1786               copy_properties (unchanged, i);
  1787               if (!modified && BUFFERP (object))
  1788                 modify_text_properties (object, start, end);
  1789               remove_properties (Qnil, properties, i, object);
  1790               if (BUFFERP (object))
  1791                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  1792                                      XFIXNUM (end) - XFIXNUM (start));
  1793               return Qt;
  1794             }
  1795         }
  1796       if (interval_has_some_properties_list (properties, i))
  1797         {
  1798           if (!modified && BUFFERP (object))
  1799             modify_text_properties (object, start, end);
  1800           remove_properties (Qnil, properties, i, object);
  1801           modified = true;
  1802         }
  1803       len -= LENGTH (i);
  1804       i = next_interval (i);
  1805       if (!i)
  1806         {
  1807           if (modified)
  1808             {
  1809               if (BUFFERP (object))
  1810                 signal_after_change (XFIXNUM (start),
  1811                                      XFIXNUM (end) - XFIXNUM (start),
  1812                                      XFIXNUM (end) - XFIXNUM (start));
  1813               return Qt;
  1814             }
  1815           else
  1816             return Qnil;
  1817         }
  1818     }
  1819 }
  1820 
  1821 DEFUN ("text-property-any", Ftext_property_any,
  1822        Stext_property_any, 4, 5, 0,
  1823        doc: /* Check text from START to END for property PROPERTY equaling VALUE.
  1824 If so, return the position of the first character whose property PROPERTY
  1825 is `eq' to VALUE.  Otherwise return nil.
  1826 If the optional fifth argument OBJECT is a buffer (or nil, which means
  1827 the current buffer), START and END are buffer positions (integers or
  1828 markers).  If OBJECT is a string, START and END are 0-based indices into it.  */)
  1829   (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
  1830 {
  1831   register INTERVAL i;
  1832   register ptrdiff_t e, pos;
  1833 
  1834   if (NILP (object))
  1835     XSETBUFFER (object, current_buffer);
  1836   i = validate_interval_range (object, &start, &end, soft);
  1837   if (!i)
  1838     return (!NILP (value) || EQ (start, end) ? Qnil : start);
  1839   e = XFIXNUM (end);
  1840 
  1841   while (i)
  1842     {
  1843       if (i->position >= e)
  1844         break;
  1845       if (EQ (textget (i->plist, property), value))
  1846         {
  1847           pos = i->position;
  1848           if (pos < XFIXNUM (start))
  1849             pos = XFIXNUM (start);
  1850           return make_fixnum (pos);
  1851         }
  1852       i = next_interval (i);
  1853     }
  1854   return Qnil;
  1855 }
  1856 
  1857 DEFUN ("text-property-not-all", Ftext_property_not_all,
  1858        Stext_property_not_all, 4, 5, 0,
  1859        doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
  1860 If so, return the position of the first character whose property PROPERTY
  1861 is not `eq' to VALUE.  Otherwise, return nil.
  1862 If the optional fifth argument OBJECT is a buffer (or nil, which means
  1863 the current buffer), START and END are buffer positions (integers or
  1864 markers).  If OBJECT is a string, START and END are 0-based indices into it.  */)
  1865   (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
  1866 {
  1867   register INTERVAL i;
  1868   register ptrdiff_t s, e;
  1869 
  1870   if (NILP (object))
  1871     XSETBUFFER (object, current_buffer);
  1872   i = validate_interval_range (object, &start, &end, soft);
  1873   if (!i)
  1874     return (NILP (value) || EQ (start, end)) ? Qnil : start;
  1875   s = XFIXNUM (start);
  1876   e = XFIXNUM (end);
  1877 
  1878   while (i)
  1879     {
  1880       if (i->position >= e)
  1881         break;
  1882       if (! EQ (textget (i->plist, property), value))
  1883         {
  1884           if (i->position > s)
  1885             s = i->position;
  1886           return make_fixnum (s);
  1887         }
  1888       i = next_interval (i);
  1889     }
  1890   return Qnil;
  1891 }
  1892 
  1893 
  1894 /* Return the direction from which the text-property PROP would be
  1895    inherited by any new text inserted at POS: 1 if it would be
  1896    inherited from the char after POS, -1 if it would be inherited from
  1897    the char before POS, and 0 if from neither.
  1898    BUFFER can be either a buffer or nil (meaning current buffer).  */
  1899 
  1900 int
  1901 text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
  1902 {
  1903   bool ignore_previous_character;
  1904   Lisp_Object prev_pos = make_fixnum (XFIXNUM (pos) - 1);
  1905   Lisp_Object front_sticky;
  1906   bool is_rear_sticky = true, is_front_sticky = false; /* defaults */
  1907   Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
  1908 
  1909   if (NILP (buffer))
  1910     XSETBUFFER (buffer, current_buffer);
  1911 
  1912   ignore_previous_character = XFIXNUM (pos) <= BUF_BEGV (XBUFFER (buffer));
  1913 
  1914   if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt))))
  1915     is_rear_sticky = false;
  1916   else
  1917     {
  1918       Lisp_Object rear_non_sticky
  1919         = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
  1920 
  1921       if (!NILP (CONSP (rear_non_sticky)
  1922                  ? Fmemq (prop, rear_non_sticky)
  1923                  : rear_non_sticky))
  1924         /* PROP is rear-non-sticky.  */
  1925         is_rear_sticky = false;
  1926     }
  1927 
  1928   /* Consider following character.  */
  1929   /* This signals an arg-out-of-range error if pos is outside the
  1930      buffer's accessible range.  */
  1931   front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
  1932 
  1933   if (EQ (front_sticky, Qt)
  1934       || (CONSP (front_sticky)
  1935           && !NILP (Fmemq (prop, front_sticky))))
  1936     /* PROP is inherited from after.  */
  1937     is_front_sticky = true;
  1938 
  1939   /* Simple cases, where the properties are consistent.  */
  1940   if (is_rear_sticky && !is_front_sticky)
  1941     return -1;
  1942   else if (!is_rear_sticky && is_front_sticky)
  1943     return 1;
  1944   else if (!is_rear_sticky && !is_front_sticky)
  1945     return 0;
  1946 
  1947   /* The stickiness properties are inconsistent, so we have to
  1948      disambiguate.  Basically, rear-sticky wins, _except_ if the
  1949      property that would be inherited has a value of nil, in which case
  1950      front-sticky wins.  */
  1951   if (ignore_previous_character
  1952       || NILP (Fget_text_property (prev_pos, prop, buffer)))
  1953     return 1;
  1954   else
  1955     return -1;
  1956 }
  1957 
  1958 
  1959 /* Copying properties between objects. */
  1960 
  1961 /* Add properties from START to END of SRC, starting at POS in DEST.
  1962    SRC and DEST may each refer to strings or buffers.
  1963    Optional sixth argument PROP causes only that property to be copied.
  1964    Properties are copied to DEST as if by `add-text-properties'.
  1965    Return t if any property value actually changed, nil otherwise.  */
  1966 
  1967 /* Note this can GC when DEST is a buffer.  */
  1968 
  1969 Lisp_Object
  1970 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
  1971                       Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
  1972 {
  1973   INTERVAL i = validate_interval_range (src, &start, &end, soft);
  1974   if (!i)
  1975     return Qnil;
  1976 
  1977   CHECK_FIXNUM_COERCE_MARKER (pos);
  1978 
  1979   EMACS_INT dest_e = XFIXNUM (pos) + (XFIXNUM (end) - XFIXNUM (start));
  1980   if (MOST_POSITIVE_FIXNUM < dest_e)
  1981     args_out_of_range (pos, end);
  1982   Lisp_Object dest_end = make_fixnum (dest_e);
  1983   validate_interval_range (dest, &pos, &dest_end, soft);
  1984 
  1985   ptrdiff_t s = XFIXNUM (start), e = XFIXNUM (end), p = XFIXNUM (pos);
  1986 
  1987   Lisp_Object stuff = Qnil;
  1988 
  1989   while (s < e)
  1990     {
  1991       ptrdiff_t e2 = i->position + LENGTH (i);
  1992       if (e2 > e)
  1993         e2 = e;
  1994       ptrdiff_t len = e2 - s;
  1995 
  1996       Lisp_Object plist = i->plist;
  1997       if (! NILP (prop))
  1998         while (! NILP (plist))
  1999           {
  2000             if (EQ (Fcar (plist), prop))
  2001               {
  2002                 plist = list2 (prop, Fcar (Fcdr (plist)));
  2003                 break;
  2004               }
  2005             plist = Fcdr (Fcdr (plist));
  2006           }
  2007       if (! NILP (plist))
  2008         /* Must defer modifications to the interval tree in case
  2009            src and dest refer to the same string or buffer.  */
  2010         stuff = Fcons (list3 (make_fixnum (p), make_fixnum (p + len), plist),
  2011                        stuff);
  2012 
  2013       i = next_interval (i);
  2014       if (!i)
  2015         break;
  2016 
  2017       p += len;
  2018       s = i->position;
  2019     }
  2020 
  2021   bool modified = false;
  2022 
  2023   while (! NILP (stuff))
  2024     {
  2025       Lisp_Object res = Fcar (stuff);
  2026       res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
  2027                                   Fcar (Fcdr (Fcdr (res))), dest);
  2028       if (! NILP (res))
  2029         modified = true;
  2030       stuff = Fcdr (stuff);
  2031     }
  2032 
  2033   return modified ? Qt : Qnil;
  2034 }
  2035 
  2036 
  2037 /* Return a list representing the text properties of OBJECT between
  2038    START and END.  if PROP is non-nil, report only on that property.
  2039    Each result list element has the form (S E PLIST), where S and E
  2040    are positions in OBJECT and PLIST is a property list containing the
  2041    text properties of OBJECT between S and E.  Value is nil if OBJECT
  2042    doesn't contain text properties between START and END.  */
  2043 
  2044 Lisp_Object
  2045 text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
  2046 {
  2047   struct interval *i;
  2048   Lisp_Object result;
  2049 
  2050   result = Qnil;
  2051 
  2052   i = validate_interval_range (object, &start, &end, soft);
  2053   if (i)
  2054     {
  2055       ptrdiff_t s = XFIXNUM (start);
  2056       ptrdiff_t e = XFIXNUM (end);
  2057 
  2058       while (s < e)
  2059         {
  2060           ptrdiff_t interval_end, len;
  2061           Lisp_Object plist;
  2062 
  2063           interval_end = i->position + LENGTH (i);
  2064           if (interval_end > e)
  2065             interval_end = e;
  2066           len = interval_end - s;
  2067 
  2068           plist = i->plist;
  2069 
  2070           if (!NILP (prop))
  2071             for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
  2072               if (EQ (XCAR (plist), prop))
  2073                 {
  2074                   plist = list2 (prop, Fcar (XCDR (plist)));
  2075                   break;
  2076                 }
  2077 
  2078           if (!NILP (plist))
  2079             result = Fcons (list3 (make_fixnum (s), make_fixnum (s + len),
  2080                                    plist),
  2081                             result);
  2082 
  2083           i = next_interval (i);
  2084           if (!i)
  2085             break;
  2086           s = i->position;
  2087         }
  2088     }
  2089 
  2090   return result;
  2091 }
  2092 
  2093 
  2094 /* Add text properties to OBJECT from LIST.  LIST is a list of triples
  2095    (START END PLIST), where START and END are positions and PLIST is a
  2096    property list containing the text properties to add.  Adjust START
  2097    and END positions by DELTA before adding properties.  */
  2098 
  2099 void
  2100 add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
  2101 {
  2102   for (; CONSP (list); list = XCDR (list))
  2103     {
  2104       Lisp_Object item, start, end, plist;
  2105 
  2106       item = XCAR (list);
  2107       start = make_fixnum (XFIXNUM (XCAR (item)) + XFIXNUM (delta));
  2108       end = make_fixnum (XFIXNUM (XCAR (XCDR (item))) + XFIXNUM (delta));
  2109       plist = XCAR (XCDR (XCDR (item)));
  2110 
  2111       Fadd_text_properties (start, end, plist, object);
  2112     }
  2113 }
  2114 
  2115 
  2116 
  2117 /* Modify end-points of ranges in LIST destructively, and return the
  2118    new list.  LIST is a list as returned from text_property_list.
  2119    Discard properties that begin at or after NEW_END, and limit
  2120    end-points to NEW_END.  */
  2121 
  2122 Lisp_Object
  2123 extend_property_ranges (Lisp_Object list, Lisp_Object old_end, Lisp_Object new_end)
  2124 {
  2125   Lisp_Object prev = Qnil, head = list;
  2126   ptrdiff_t max = XFIXNUM (new_end);
  2127 
  2128   for (; CONSP (list); prev = list, list = XCDR (list))
  2129     {
  2130       Lisp_Object item, beg;
  2131       ptrdiff_t end;
  2132 
  2133       item = XCAR (list);
  2134       beg = XCAR (item);
  2135       end = XFIXNUM (XCAR (XCDR (item)));
  2136 
  2137       if (XFIXNUM (beg) >= max)
  2138         {
  2139           /* The start-point is past the end of the new string.
  2140              Discard this property.  */
  2141           if (EQ (head, list))
  2142             head = XCDR (list);
  2143           else
  2144             XSETCDR (prev, XCDR (list));
  2145         }
  2146       else if ((end == XFIXNUM (old_end) && end != max)
  2147                || end > max)
  2148         {
  2149           /* Either the end-point is past the end of the new string,
  2150              and we need to discard the properties past the new end,
  2151              or the caller is extending the property range, and we
  2152              should update all end-points that are on the old end of
  2153              the range to reflect that.  */
  2154           XSETCAR (XCDR (item), new_end);
  2155         }
  2156     }
  2157 
  2158   return head;
  2159 }
  2160 
  2161 
  2162 
  2163 /* Call the modification hook functions in LIST, each with START and END.  */
  2164 
  2165 static void
  2166 call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
  2167 {
  2168   while (!NILP (list))
  2169     {
  2170       call2 (Fcar (list), start, end);
  2171       list = Fcdr (list);
  2172     }
  2173 }
  2174 
  2175 /* Check for read-only intervals between character positions START ... END,
  2176    in BUF, and signal an error if we find one.
  2177 
  2178    Then check for any modification hooks in the range.
  2179    Create a list of all these hooks in lexicographic order,
  2180    eliminating consecutive extra copies of the same hook.  Then call
  2181    those hooks in order, with START and END - 1 as arguments.  */
  2182 
  2183 void
  2184 verify_interval_modification (struct buffer *buf,
  2185                               ptrdiff_t start, ptrdiff_t end)
  2186 {
  2187   INTERVAL intervals = buffer_intervals (buf);
  2188   INTERVAL i;
  2189   Lisp_Object hooks;
  2190   Lisp_Object prev_mod_hooks;
  2191   Lisp_Object mod_hooks;
  2192 
  2193   hooks = Qnil;
  2194   prev_mod_hooks = Qnil;
  2195   mod_hooks = Qnil;
  2196 
  2197   interval_insert_behind_hooks = Qnil;
  2198   interval_insert_in_front_hooks = Qnil;
  2199 
  2200   if (!intervals)
  2201     return;
  2202 
  2203   if (start > end)
  2204     {
  2205       ptrdiff_t temp = start;
  2206       start = end;
  2207       end = temp;
  2208     }
  2209 
  2210   /* For an insert operation, check the two chars around the position.  */
  2211   if (start == end)
  2212     {
  2213       INTERVAL prev = NULL;
  2214       Lisp_Object before, after;
  2215 
  2216       /* Set I to the interval containing the char after START,
  2217          and PREV to the interval containing the char before START.
  2218          Either one may be null.  They may be equal.  */
  2219       i = find_interval (intervals, start);
  2220 
  2221       if (start == BUF_BEGV (buf))
  2222         prev = 0;
  2223       else if (i->position == start)
  2224         prev = previous_interval (i);
  2225       else if (i->position < start)
  2226         prev = i;
  2227       if (start == BUF_ZV (buf))
  2228         i = 0;
  2229 
  2230       /* If Vinhibit_read_only is set and is not a list, we can
  2231          skip the read_only checks.  */
  2232       if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
  2233         {
  2234           /* If I and PREV differ we need to check for the read-only
  2235              property together with its stickiness.  If either I or
  2236              PREV are 0, this check is all we need.
  2237              We have to take special care, since read-only may be
  2238              indirectly defined via the category property.  */
  2239           if (i != prev)
  2240             {
  2241               if (i)
  2242                 {
  2243                   after = textget (i->plist, Qread_only);
  2244 
  2245                   /* If interval I is read-only and read-only is
  2246                      front-sticky, inhibit insertion.
  2247                      Check for read-only as well as category.  */
  2248                   if (! NILP (after)
  2249                       && NILP (Fmemq (after, Vinhibit_read_only)))
  2250                     {
  2251                       Lisp_Object tem;
  2252 
  2253                       tem = textget (i->plist, Qfront_sticky);
  2254                       if (TMEM (Qread_only, tem)
  2255                           || (NILP (plist_get (i->plist, Qread_only))
  2256                               && TMEM (Qcategory, tem)))
  2257                         text_read_only (after);
  2258                     }
  2259                 }
  2260 
  2261               if (prev)
  2262                 {
  2263                   before = textget (prev->plist, Qread_only);
  2264 
  2265                   /* If interval PREV is read-only and read-only isn't
  2266                      rear-nonsticky, inhibit insertion.
  2267                      Check for read-only as well as category.  */
  2268                   if (! NILP (before)
  2269                       && NILP (Fmemq (before, Vinhibit_read_only)))
  2270                     {
  2271                       Lisp_Object tem;
  2272 
  2273                       tem = textget (prev->plist, Qrear_nonsticky);
  2274                       if (! TMEM (Qread_only, tem)
  2275                           && (! NILP (plist_get (prev->plist,Qread_only))
  2276                               || ! TMEM (Qcategory, tem)))
  2277                         text_read_only (before);
  2278                     }
  2279                 }
  2280             }
  2281           else if (i)
  2282             {
  2283               after = textget (i->plist, Qread_only);
  2284 
  2285               /* If interval I is read-only and read-only is
  2286                  front-sticky, inhibit insertion.
  2287                  Check for read-only as well as category.  */
  2288               if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
  2289                 {
  2290                   Lisp_Object tem;
  2291 
  2292                   tem = textget (i->plist, Qfront_sticky);
  2293                   if (TMEM (Qread_only, tem)
  2294                       || (NILP (plist_get (i->plist, Qread_only))
  2295                           && TMEM (Qcategory, tem)))
  2296                     text_read_only (after);
  2297 
  2298                   tem = textget (prev->plist, Qrear_nonsticky);
  2299                   if (! TMEM (Qread_only, tem)
  2300                       && (! NILP (plist_get (prev->plist, Qread_only))
  2301                           || ! TMEM (Qcategory, tem)))
  2302                     text_read_only (after);
  2303                 }
  2304             }
  2305         }
  2306 
  2307       /* Run both insert hooks (just once if they're the same).  */
  2308       if (prev)
  2309         interval_insert_behind_hooks
  2310           = textget (prev->plist, Qinsert_behind_hooks);
  2311       if (i)
  2312         interval_insert_in_front_hooks
  2313           = textget (i->plist, Qinsert_in_front_hooks);
  2314     }
  2315   else
  2316     {
  2317       /* Loop over intervals on or next to START...END,
  2318          collecting their hooks.  */
  2319 
  2320       i = find_interval (intervals, start);
  2321       do
  2322         {
  2323           if (! INTERVAL_WRITABLE_P (i))
  2324             text_read_only (textget (i->plist, Qread_only));
  2325 
  2326           if (!inhibit_modification_hooks)
  2327             {
  2328               mod_hooks = textget (i->plist, Qmodification_hooks);
  2329               if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
  2330                 {
  2331                   hooks = Fcons (mod_hooks, hooks);
  2332                   prev_mod_hooks = mod_hooks;
  2333                 }
  2334             }
  2335 
  2336           if (i->position + LENGTH (i) < end
  2337               && (!NILP (BVAR (current_buffer, read_only))
  2338                   && NILP (Vinhibit_read_only)))
  2339             xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
  2340 
  2341           i = next_interval (i);
  2342         }
  2343       /* Keep going thru the interval containing the char before END.  */
  2344       while (i && i->position < end);
  2345 
  2346       if (!inhibit_modification_hooks)
  2347         {
  2348           hooks = Fnreverse (hooks);
  2349           while (! NILP (hooks))
  2350             {
  2351               call_mod_hooks (Fcar (hooks), make_fixnum (start),
  2352                               make_fixnum (end));
  2353               hooks = Fcdr (hooks);
  2354             }
  2355         }
  2356     }
  2357 }
  2358 
  2359 /* Run the interval hooks for an insertion on character range START ... END.
  2360    verify_interval_modification chose which hooks to run;
  2361    this function is called after the insertion happens
  2362    so it can indicate the range of inserted text.  */
  2363 
  2364 void
  2365 report_interval_modification (Lisp_Object start, Lisp_Object end)
  2366 {
  2367   if (! NILP (interval_insert_behind_hooks))
  2368     call_mod_hooks (interval_insert_behind_hooks, start, end);
  2369   if (! NILP (interval_insert_in_front_hooks)
  2370       && ! EQ (interval_insert_in_front_hooks,
  2371                interval_insert_behind_hooks))
  2372     call_mod_hooks (interval_insert_in_front_hooks, start, end);
  2373 }
  2374 
  2375 void
  2376 syms_of_textprop (void)
  2377 {
  2378   DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
  2379                doc: /* Property-list used as default values.
  2380 The value of a property in this list is seen as the value for every
  2381 character that does not have its own value for that property.  */);
  2382   Vdefault_text_properties = Qnil;
  2383 
  2384   DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
  2385                doc: /* Alist of alternative properties for properties without a value.
  2386 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
  2387 If a piece of text has no direct value for a particular property, then
  2388 this alist is consulted.  If that property appears in the alist, then
  2389 the first non-nil value from the associated alternative properties is
  2390 returned. */);
  2391   Vchar_property_alias_alist = Qnil;
  2392 
  2393   DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
  2394                doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
  2395 This also inhibits the use of the `intangible' text property.  */);
  2396   Vinhibit_point_motion_hooks = Qt;
  2397 
  2398   DEFVAR_LISP ("text-property-default-nonsticky",
  2399                Vtext_property_default_nonsticky,
  2400                doc: /* Alist of properties vs the corresponding non-stickiness.
  2401 Each element has the form (PROPERTY . NONSTICKINESS).
  2402 
  2403 If a character in a buffer has PROPERTY, new text inserted adjacent to
  2404 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
  2405 inherits it if NONSTICKINESS is nil.  The `front-sticky' and
  2406 `rear-nonsticky' properties of the character override NONSTICKINESS.  */);
  2407   /* Text properties `syntax-table'and `display' should be nonsticky
  2408      by default.  */
  2409   Vtext_property_default_nonsticky
  2410     = list2 (Fcons (Qsyntax_table, Qt), Fcons (Qdisplay, Qt));
  2411 
  2412   interval_insert_behind_hooks = Qnil;
  2413   interval_insert_in_front_hooks = Qnil;
  2414   staticpro (&interval_insert_behind_hooks);
  2415   staticpro (&interval_insert_in_front_hooks);
  2416 
  2417   /* Common attributes one might give text.  */
  2418 
  2419   DEFSYM (Qfont, "font");
  2420   DEFSYM (Qface, "face");
  2421   DEFSYM (Qread_only, "read-only");
  2422   DEFSYM (Qinvisible, "invisible");
  2423   DEFSYM (Qintangible, "intangible");
  2424   DEFSYM (Qcategory, "category");
  2425   DEFSYM (Qlocal_map, "local-map");
  2426   DEFSYM (Qfront_sticky, "front-sticky");
  2427   DEFSYM (Qrear_nonsticky, "rear-nonsticky");
  2428   DEFSYM (Qmouse_face, "mouse-face");
  2429   DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
  2430 
  2431   /* Properties that text might use to specify certain actions.  */
  2432 
  2433   DEFSYM (Qpoint_left, "point-left");
  2434   DEFSYM (Qpoint_entered, "point-entered");
  2435 
  2436   defsubr (&Stext_properties_at);
  2437   defsubr (&Sget_text_property);
  2438   defsubr (&Sget_char_property);
  2439   defsubr (&Sget_char_property_and_overlay);
  2440   defsubr (&Snext_char_property_change);
  2441   defsubr (&Sprevious_char_property_change);
  2442   defsubr (&Snext_single_char_property_change);
  2443   defsubr (&Sprevious_single_char_property_change);
  2444   defsubr (&Snext_property_change);
  2445   defsubr (&Snext_single_property_change);
  2446   defsubr (&Sprevious_property_change);
  2447   defsubr (&Sprevious_single_property_change);
  2448   defsubr (&Sadd_text_properties);
  2449   defsubr (&Sput_text_property);
  2450   defsubr (&Sset_text_properties);
  2451   defsubr (&Sadd_face_text_property);
  2452   defsubr (&Sremove_text_properties);
  2453   defsubr (&Sremove_list_of_text_properties);
  2454   defsubr (&Stext_property_any);
  2455   defsubr (&Stext_property_not_all);
  2456 }