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