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 Free Software Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs; see the file COPYING. If not, write to 19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. */ 21 22#include <config.h> 23#include "lisp.h" 24#include "intervals.h" 25#include "buffer.h" 26#include "window.h" 27 28#ifndef NULL 29#define NULL (void *)0 30#endif 31 32/* Test for membership, allowing for t (actually any non-cons) to mean the 33 universal set. */ 34 35#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set)) 36 37 38/* NOTES: previous- and next- property change will have to skip 39 zero-length intervals if they are implemented. This could be done 40 inside next_interval and previous_interval. 41 42 set_properties needs to deal with the interval property cache. 43 44 It is assumed that for any interval plist, a property appears 45 only once on the list. Although some code i.e., remove_properties, 46 handles the more general case, the uniqueness of properties is 47 necessary for the system to remain consistent. This requirement 48 is enforced by the subrs installing properties onto the intervals. */ 49 50 51/* Types of hooks. */ 52Lisp_Object Qmouse_left; 53Lisp_Object Qmouse_entered; 54Lisp_Object Qpoint_left; 55Lisp_Object Qpoint_entered; 56Lisp_Object Qcategory; 57Lisp_Object Qlocal_map; 58 59/* Visual properties text (including strings) may have. */ 60Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple; 61Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face; 62 63/* Sticky properties */ 64Lisp_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 71Lisp_Object Vinhibit_point_motion_hooks; 72Lisp_Object Vdefault_text_properties; 73Lisp_Object Vchar_property_alias_alist; 74Lisp_Object Vtext_property_default_nonsticky; 75 76/* verify_interval_modification saves insertion hooks here 77 to be run later by report_interval_modification. */ 78Lisp_Object interval_insert_behind_hooks; 79Lisp_Object interval_insert_in_front_hooks; 80 81static 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 87static void 88text_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 125INTERVAL 126validate_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 193static Lisp_Object 194validate_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; !NILP (tail); i++) 205 { 206 tail = Fcdr (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 220static int 221interval_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; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) 230 { 231 sym1 = Fcar (tail1); 232 found = 0; 233 234 /* Go through I's plist, looking for sym1 */ 235 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) 236 if (EQ (sym1, Fcar (tail2))) 237 { 238 /* Found the same property on both lists. If the 239 values are unequal, return zero. */ 240 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (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 258static INLINE int 259interval_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; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) 267 { 268 sym = Fcar (tail1); 269 270 /* Go through i's plist, looking for tail1 */ 271 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) 272 if (EQ (sym, Fcar (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 282static INLINE int 283interval_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; ! NILP (tail1); tail1 = XCDR (tail1)) 291 { 292 sym = Fcar (tail1); 293 294 /* Go through i's plist, looking for tail1 */ 295 for (tail2 = i->plist; ! NILP (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. */ 307static Lisp_Object 308property_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 326static void 327set_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 374static int 375add_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; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) 395 { 396 sym1 = Fcar (tail1); 397 val1 = Fcar (Fcdr (tail1)); 398 found = 0; 399 400 /* Go through I's plist, looking for sym1 */ 401 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) 402 if (EQ (sym1, Fcar (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 = Fcdr (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 453static int 454remove_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 522static INLINE int 523erase_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 537INTERVAL 538interval_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 575DEFUN ("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. 578If the optional second argument OBJECT is a buffer (or nil, which means 579the current buffer), POSITION is a buffer position (integer or marker). 580If OBJECT is a string, POSITION is a 0-based index into it. 581If 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 603DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0, 604 doc: /* Return the value of POSITION's property PROP, in OBJECT. 605OBJECT is optional and defaults to the current buffer. 606If 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. */ 625Lisp_Object 626get_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 set_buffer_temp (XBUFFER (object)); 650 651 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0); 652 noverlays = sort_overlays (overlay_vec, noverlays, w); 653 654 set_buffer_temp (obuf); 655 656 /* Now check the overlays in order of decreasing priority. */ 657 while (--noverlays >= 0) 658 { 659 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop); 660 if (!NILP (tem)) 661 { 662 if (overlay) 663 /* Return the overlay we got the property from. */ 664 *overlay = overlay_vec[noverlays]; 665 return tem; 666 } 667 } 668 } 669 670 if (overlay) 671 /* Indicate that the return value is not from an overlay. */ 672 *overlay = Qnil; 673 674 /* Not a buffer, or no appropriate overlay, so fall through to the 675 simpler case. */ 676 return Fget_text_property (position, prop, object); 677} 678 679DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, 680 doc: /* Return the value of POSITION's property PROP, in OBJECT. 681Both overlay properties and text properties are checked. 682OBJECT is optional and defaults to the current buffer. 683If POSITION is at the end of OBJECT, the value is nil. 684If OBJECT is a buffer, then overlay properties are considered as well as 685text properties. 686If OBJECT is a window, then that window's buffer is used, but window-specific 687overlays are considered only if they are associated with OBJECT. */) 688 (position, prop, object) 689 Lisp_Object position, object; 690 register Lisp_Object prop; 691{ 692 return get_char_property_and_overlay (position, prop, object, 0); 693} 694 695DEFUN ("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. 698The value is a cons cell. Its car is the return value of `get-char-property' 699with the same arguments--that is, the value of POSITION's property 700PROP in OBJECT. Its cdr is the overlay in which the property was 701found, or nil, if it was found as a text property or not found at all. 702 703OBJECT is optional and defaults to the current buffer. OBJECT may be 704a string, a buffer or a window. For strings, the cdr of the return 705value is always nil, since strings do not have overlays. If OBJECT is 706a window, then that window's buffer is used, but window-specific 707overlays are considered only if they are associated with OBJECT. If 708POSITION is at the end of OBJECT, both car and cdr are nil. */) 709 (position, prop, object) 710 Lisp_Object position, object; 711 register Lisp_Object prop; 712{ 713 Lisp_Object overlay; 714 Lisp_Object val 715 = get_char_property_and_overlay (position, prop, object, &overlay); 716 return Fcons(val, overlay); 717} 718 719 720DEFUN ("next-char-property-change", Fnext_char_property_change, 721 Snext_char_property_change, 1, 2, 0, 722 doc: /* Return the position of next text property or overlay change. 723This scans characters forward in the current buffer from POSITION till 724it finds a change in some text property, or the beginning or end of an 725overlay, and returns the position of that. 726If none is found up to (point-max), the function returns (point-max). 727 728If the optional second argument LIMIT is non-nil, don't search 729past position LIMIT; return LIMIT if nothing is found before LIMIT. 730LIMIT is a no-op if it is greater than (point-max). */) 731 (position, limit) 732 Lisp_Object position, limit; 733{ 734 Lisp_Object temp; 735 736 temp = Fnext_overlay_change (position); 737 if (! NILP (limit)) 738 { 739 CHECK_NUMBER_COERCE_MARKER (limit); 740 if (XINT (limit) < XINT (temp)) 741 temp = limit; 742 } 743 return Fnext_property_change (position, Qnil, temp); 744} 745 746DEFUN ("previous-char-property-change", Fprevious_char_property_change, 747 Sprevious_char_property_change, 1, 2, 0, 748 doc: /* Return the position of previous text property or overlay change. 749Scans characters backward in the current buffer from POSITION till it 750finds a change in some text property, or the beginning or end of an 751overlay, and returns the position of that. 752If none is found since (point-min), the function returns (point-min). 753 754If the optional second argument LIMIT is non-nil, don't search 755past position LIMIT; return LIMIT if nothing is found before LIMIT. 756LIMIT is a no-op if it is less than (point-min). */) 757 (position, limit) 758 Lisp_Object position, limit; 759{ 760 Lisp_Object temp; 761 762 temp = Fprevious_overlay_change (position); 763 if (! NILP (limit)) 764 { 765 CHECK_NUMBER_COERCE_MARKER (limit); 766 if (XINT (limit) > XINT (temp)) 767 temp = limit; 768 } 769 return Fprevious_property_change (position, Qnil, temp); 770} 771 772 773DEFUN ("next-single-char-property-change", Fnext_single_char_property_change, 774 Snext_single_char_property_change, 2, 4, 0, 775 doc: /* Return the position of next text property or overlay change for a specific property. 776Scans characters forward from POSITION till it finds 777a change in the PROP property, then returns the position of the change. 778If the optional third argument OBJECT is a buffer (or nil, which means 779the current buffer), POSITION is a buffer position (integer or marker). 780If OBJECT is a string, POSITION is a 0-based index into it. 781 782In a string, scan runs to the end of the string. 783In a buffer, it runs to (point-max), and the value cannot exceed that. 784 785The property values are compared with `eq'. 786If the property is constant all the way to the end of OBJECT, return the 787last valid position in OBJECT. 788If the optional fourth argument LIMIT is non-nil, don't search 789past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 790 (position, prop, object, limit) 791 Lisp_Object prop, position, object, limit; 792{ 793 if (STRINGP (object)) 794 { 795 position = Fnext_single_property_change (position, prop, object, limit); 796 if (NILP (position)) 797 { 798 if (NILP (limit)) 799 position = make_number (SCHARS (object)); 800 else 801 { 802 CHECK_NUMBER (limit); 803 position = limit; 804 } 805 } 806 } 807 else 808 { 809 Lisp_Object initial_value, value; 810 int count = SPECPDL_INDEX (); 811 812 if (! NILP (object)) 813 CHECK_BUFFER (object); 814 815 if (BUFFERP (object) && current_buffer != XBUFFER (object)) 816 { 817 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); 818 Fset_buffer (object); 819 } 820 821 CHECK_NUMBER_COERCE_MARKER (position); 822 823 initial_value = Fget_char_property (position, prop, object); 824 825 if (NILP (limit)) 826 XSETFASTINT (limit, ZV); 827 else 828 CHECK_NUMBER_COERCE_MARKER (limit); 829 830 if (XFASTINT (position) >= XFASTINT (limit)) 831 { 832 position = limit; 833 if (XFASTINT (position) > ZV) 834 XSETFASTINT (position, ZV); 835 } 836 else 837 while (1) 838 { 839 position = Fnext_char_property_change (position, limit); 840 if (XFASTINT (position) >= XFASTINT (limit)) 841 { 842 position = limit; 843 break; 844 } 845 846 value = Fget_char_property (position, prop, object); 847 if (!EQ (value, initial_value)) 848 break; 849 } 850 851 unbind_to (count, Qnil); 852 } 853 854 return position; 855} 856 857DEFUN ("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. 861Scans characters backward from POSITION till it finds 862a change in the PROP property, then returns the position of the change. 863If the optional third argument OBJECT is a buffer (or nil, which means 864the current buffer), POSITION is a buffer position (integer or marker). 865If OBJECT is a string, POSITION is a 0-based index into it. 866 867In a string, scan runs to the start of the string. 868In a buffer, it runs to (point-min), and the value cannot be less than that. 869 870The property values are compared with `eq'. 871If the property is constant all the way to the start of OBJECT, return the 872first valid position in OBJECT. 873If the optional fourth argument LIMIT is non-nil, don't search 874back past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 875 (position, prop, object, limit) 876 Lisp_Object prop, position, 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_number (SCHARS (object)); 885 else 886 { 887 CHECK_NUMBER (limit); 888 position = limit; 889 } 890 } 891 } 892 else 893 { 894 int 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_protect (Fset_buffer, Fcurrent_buffer ()); 902 Fset_buffer (object); 903 } 904 905 CHECK_NUMBER_COERCE_MARKER (position); 906 907 if (NILP (limit)) 908 XSETFASTINT (limit, BEGV); 909 else 910 CHECK_NUMBER_COERCE_MARKER (limit); 911 912 if (XFASTINT (position) <= XFASTINT (limit)) 913 { 914 position = limit; 915 if (XFASTINT (position) < BEGV) 916 XSETFASTINT (position, BEGV); 917 } 918 else 919 { 920 Lisp_Object initial_value 921 = Fget_char_property (make_number (XFASTINT (position) - 1), 922 prop, object); 923 924 while (1) 925 { 926 position = Fprevious_char_property_change (position, limit); 927 928 if (XFASTINT (position) <= XFASTINT (limit)) 929 { 930 position = limit; 931 break; 932 } 933 else 934 { 935 Lisp_Object value 936 = Fget_char_property (make_number (XFASTINT (position) - 1), 937 prop, object); 938 939 if (!EQ (value, initial_value)) 940 break; 941 } 942 } 943 } 944 945 unbind_to (count, Qnil); 946 } 947 948 return position; 949} 950 951DEFUN ("next-property-change", Fnext_property_change, 952 Snext_property_change, 1, 3, 0, 953 doc: /* Return the position of next property change. 954Scans characters forward from POSITION in OBJECT till it finds 955a change in some text property, then returns the position of the change. 956If the optional second argument OBJECT is a buffer (or nil, which means 957the current buffer), POSITION is a buffer position (integer or marker). 958If OBJECT is a string, POSITION is a 0-based index into it. 959Return nil if the property is constant all the way to the end of OBJECT. 960If the value is non-nil, it is a position greater than POSITION, never equal. 961 962If the optional third argument LIMIT is non-nil, don't search 963past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 964 (position, object, limit) 965 Lisp_Object position, object, limit; 966{ 967 register INTERVAL i, next; 968 969 if (NILP (object)) 970 XSETBUFFER (object, current_buffer); 971 972 if (!NILP (limit) && !EQ (limit, Qt)) 973 CHECK_NUMBER_COERCE_MARKER (limit); 974 975 i = validate_interval_range (object, &position, &position, soft); 976 977 /* If LIMIT is t, return start of next interval--don't 978 bother checking further intervals. */ 979 if (EQ (limit, Qt)) 980 { 981 if (NULL_INTERVAL_P (i)) 982 next = i; 983 else 984 next = next_interval (i); 985 986 if (NULL_INTERVAL_P (next)) 987 XSETFASTINT (position, (STRINGP (object) 988 ? SCHARS (object) 989 : BUF_ZV (XBUFFER (object)))); 990 else 991 XSETFASTINT (position, next->position); 992 return position; 993 } 994 995 if (NULL_INTERVAL_P (i)) 996 return limit; 997 998 next = next_interval (i); 999 1000 while (!NULL_INTERVAL_P (next) && intervals_equal (i, next) 1001 && (NILP (limit) || next->position < XFASTINT (limit))) 1002 next = next_interval (next); 1003 1004 if (NULL_INTERVAL_P (next) 1005 || (next->position 1006 >= (INTEGERP (limit) 1007 ? XFASTINT (limit) 1008 : (STRINGP (object) 1009 ? SCHARS (object) 1010 : BUF_ZV (XBUFFER (object)))))) 1011 return limit; 1012 else 1013 return make_number (next->position); 1014} 1015 1016/* Return 1 if there's a change in some property between BEG and END. */ 1017 1018int 1019property_change_between_p (beg, end) 1020 int beg, end; 1021{ 1022 register INTERVAL i, next; 1023 Lisp_Object object, pos; 1024 1025 XSETBUFFER (object, current_buffer); 1026 XSETFASTINT (pos, beg); 1027 1028 i = validate_interval_range (object, &pos, &pos, soft); 1029 if (NULL_INTERVAL_P (i)) 1030 return 0; 1031 1032 next = next_interval (i); 1033 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)) 1034 { 1035 next = next_interval (next); 1036 if (NULL_INTERVAL_P (next)) 1037 return 0; 1038 if (next->position >= end) 1039 return 0; 1040 } 1041 1042 if (NULL_INTERVAL_P (next)) 1043 return 0; 1044 1045 return 1; 1046} 1047 1048DEFUN ("next-single-property-change", Fnext_single_property_change, 1049 Snext_single_property_change, 2, 4, 0, 1050 doc: /* Return the position of next property change for a specific property. 1051Scans characters forward from POSITION till it finds 1052a change in the PROP property, then returns the position of the change. 1053If the optional third argument OBJECT is a buffer (or nil, which means 1054the current buffer), POSITION is a buffer position (integer or marker). 1055If OBJECT is a string, POSITION is a 0-based index into it. 1056The property values are compared with `eq'. 1057Return nil if the property is constant all the way to the end of OBJECT. 1058If the value is non-nil, it is a position greater than POSITION, never equal. 1059 1060If the optional fourth argument LIMIT is non-nil, don't search 1061past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 1062 (position, prop, object, limit) 1063 Lisp_Object position, prop, object, limit; 1064{ 1065 register INTERVAL i, next; 1066 register Lisp_Object here_val; 1067 1068 if (NILP (object)) 1069 XSETBUFFER (object, current_buffer); 1070 1071 if (!NILP (limit)) 1072 CHECK_NUMBER_COERCE_MARKER (limit); 1073 1074 i = validate_interval_range (object, &position, &position, soft); 1075 if (NULL_INTERVAL_P (i)) 1076 return limit; 1077 1078 here_val = textget (i->plist, prop); 1079 next = next_interval (i); 1080 while (! NULL_INTERVAL_P (next) 1081 && EQ (here_val, textget (next->plist, prop)) 1082 && (NILP (limit) || next->position < XFASTINT (limit))) 1083 next = next_interval (next); 1084 1085 if (NULL_INTERVAL_P (next) 1086 || (next->position 1087 >= (INTEGERP (limit) 1088 ? XFASTINT (limit) 1089 : (STRINGP (object) 1090 ? SCHARS (object) 1091 : BUF_ZV (XBUFFER (object)))))) 1092 return limit; 1093 else 1094 return make_number (next->position); 1095} 1096 1097DEFUN ("previous-property-change", Fprevious_property_change, 1098 Sprevious_property_change, 1, 3, 0, 1099 doc: /* Return the position of previous property change. 1100Scans characters backwards from POSITION in OBJECT till it finds 1101a change in some text property, then returns the position of the change. 1102If the optional second argument OBJECT is a buffer (or nil, which means 1103the current buffer), POSITION is a buffer position (integer or marker). 1104If OBJECT is a string, POSITION is a 0-based index into it. 1105Return nil if the property is constant all the way to the start of OBJECT. 1106If the value is non-nil, it is a position less than POSITION, never equal. 1107 1108If the optional third argument LIMIT is non-nil, don't search 1109back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) 1110 (position, object, limit) 1111 Lisp_Object position, object, limit; 1112{ 1113 register INTERVAL i, previous; 1114 1115 if (NILP (object)) 1116 XSETBUFFER (object, current_buffer); 1117 1118 if (!NILP (limit)) 1119 CHECK_NUMBER_COERCE_MARKER (limit); 1120 1121 i = validate_interval_range (object, &position, &position, soft); 1122 if (NULL_INTERVAL_P (i)) 1123 return limit; 1124 1125 /* Start with the interval containing the char before point. */ 1126 if (i->position == XFASTINT (position)) 1127 i = previous_interval (i); 1128 1129 previous = previous_interval (i); 1130 while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i) 1131 && (NILP (limit) 1132 || (previous->position + LENGTH (previous) > XFASTINT (limit)))) 1133 previous = previous_interval (previous); 1134 1135 if (NULL_INTERVAL_P (previous) 1136 || (previous->position + LENGTH (previous) 1137 <= (INTEGERP (limit) 1138 ? XFASTINT (limit) 1139 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) 1140 return limit; 1141 else 1142 return make_number (previous->position + LENGTH (previous)); 1143} 1144 1145DEFUN ("previous-single-property-change", Fprevious_single_property_change, 1146 Sprevious_single_property_change, 2, 4, 0, 1147 doc: /* Return the position of previous property change for a specific property. 1148Scans characters backward from POSITION till it finds 1149a change in the PROP property, then returns the position of the change. 1150If the optional third argument OBJECT is a buffer (or nil, which means 1151the current buffer), POSITION is a buffer position (integer or marker). 1152If OBJECT is a string, POSITION is a 0-based index into it. 1153The property values are compared with `eq'. 1154Return nil if the property is constant all the way to the start of OBJECT. 1155If the value is non-nil, it is a position less than POSITION, never equal. 1156 1157If the optional fourth argument LIMIT is non-nil, don't search 1158back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) 1159 (position, prop, object, limit) 1160 Lisp_Object position, prop, object, limit; 1161{ 1162 register INTERVAL i, previous; 1163 register Lisp_Object here_val; 1164 1165 if (NILP (object)) 1166 XSETBUFFER (object, current_buffer); 1167 1168 if (!NILP (limit)) 1169 CHECK_NUMBER_COERCE_MARKER (limit); 1170 1171 i = validate_interval_range (object, &position, &position, soft); 1172 1173 /* Start with the interval containing the char before point. */ 1174 if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position)) 1175 i = previous_interval (i); 1176 1177 if (NULL_INTERVAL_P (i)) 1178 return limit; 1179 1180 here_val = textget (i->plist, prop); 1181 previous = previous_interval (i); 1182 while (!NULL_INTERVAL_P (previous) 1183 && EQ (here_val, textget (previous->plist, prop)) 1184 && (NILP (limit) 1185 || (previous->position + LENGTH (previous) > XFASTINT (limit)))) 1186 previous = previous_interval (previous); 1187 1188 if (NULL_INTERVAL_P (previous) 1189 || (previous->position + LENGTH (previous) 1190 <= (INTEGERP (limit) 1191 ? XFASTINT (limit) 1192 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)))))) 1193 return limit; 1194 else 1195 return make_number (previous->position + LENGTH (previous)); 1196} 1197 1198/* Callers note, this can GC when OBJECT is a buffer (or nil). */ 1199 1200DEFUN ("add-text-properties", Fadd_text_properties, 1201 Sadd_text_properties, 3, 4, 0, 1202 doc: /* Add properties to the text from START to END. 1203The third argument PROPERTIES is a property list 1204specifying the property values to add. If the optional fourth argument 1205OBJECT is a buffer (or nil, which means the current buffer), 1206START and END are buffer positions (integers or markers). 1207If OBJECT is a string, START and END are 0-based indices into it. 1208Return t if any property value actually changed, nil otherwise. */) 1209 (start, end, properties, object) 1210 Lisp_Object start, end, properties, object; 1211{ 1212 register INTERVAL i, unchanged; 1213 register int s, len, modified = 0; 1214 struct gcpro gcpro1; 1215 1216 properties = validate_plist (properties); 1217 if (NILP (properties)) 1218 return Qnil; 1219 1220 if (NILP (object)) 1221 XSETBUFFER (object, current_buffer); 1222 1223 i = validate_interval_range (object, &start, &end, hard); 1224 if (NULL_INTERVAL_P (i)) 1225 return Qnil; 1226 1227 s = XINT (start); 1228 len = XINT (end) - s; 1229 1230 /* No need to protect OBJECT, because we GC only if it's a buffer, 1231 and live buffers are always protected. */ 1232 GCPRO1 (properties); 1233 1234 /* If we're not starting on an interval boundary, we have to 1235 split this interval. */ 1236 if (i->position != s) 1237 { 1238 /* If this interval already has the properties, we can 1239 skip it. */ 1240 if (interval_has_all_properties (properties, i)) 1241 { 1242 int got = (LENGTH (i) - (s - i->position)); 1243 if (got >= len) 1244 RETURN_UNGCPRO (Qnil); 1245 len -= got; 1246 i = next_interval (i); 1247 } 1248 else 1249 { 1250 unchanged = i; 1251 i = split_interval_right (unchanged, s - unchanged->position); 1252 copy_properties (unchanged, i); 1253 } 1254 } 1255 1256 if (BUFFERP (object)) 1257 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1258 1259 /* We are at the beginning of interval I, with LEN chars to scan. */ 1260 for (;;) 1261 { 1262 if (i == 0) 1263 abort (); 1264 1265 if (LENGTH (i) >= len) 1266 { 1267 /* We can UNGCPRO safely here, because there will be just 1268 one more chance to gc, in the next call to add_properties, 1269 and after that we will not need PROPERTIES or OBJECT again. */ 1270 UNGCPRO; 1271 1272 if (interval_has_all_properties (properties, i)) 1273 { 1274 if (BUFFERP (object)) 1275 signal_after_change (XINT (start), XINT (end) - XINT (start), 1276 XINT (end) - XINT (start)); 1277 1278 return modified ? Qt : Qnil; 1279 } 1280 1281 if (LENGTH (i) == len) 1282 { 1283 add_properties (properties, i, object); 1284 if (BUFFERP (object)) 1285 signal_after_change (XINT (start), XINT (end) - XINT (start), 1286 XINT (end) - XINT (start)); 1287 return Qt; 1288 } 1289 1290 /* i doesn't have the properties, and goes past the change limit */ 1291 unchanged = i; 1292 i = split_interval_left (unchanged, len); 1293 copy_properties (unchanged, i); 1294 add_properties (properties, i, object); 1295 if (BUFFERP (object)) 1296 signal_after_change (XINT (start), XINT (end) - XINT (start), 1297 XINT (end) - XINT (start)); 1298 return Qt; 1299 } 1300 1301 len -= LENGTH (i); 1302 modified += add_properties (properties, i, object); 1303 i = next_interval (i); 1304 } 1305} 1306 1307/* Callers note, this can GC when OBJECT is a buffer (or nil). */ 1308 1309DEFUN ("put-text-property", Fput_text_property, 1310 Sput_text_property, 4, 5, 0, 1311 doc: /* Set one property of the text from START to END. 1312The third and fourth arguments PROPERTY and VALUE 1313specify the property to add. 1314If the optional fifth argument OBJECT is a buffer (or nil, which means 1315the current buffer), START and END are buffer positions (integers or 1316markers). If OBJECT is a string, START and END are 0-based indices into it. */) 1317 (start, end, property, value, object) 1318 Lisp_Object start, end, property, value, object; 1319{ 1320 Fadd_text_properties (start, end, 1321 Fcons (property, Fcons (value, Qnil)), 1322 object); 1323 return Qnil; 1324} 1325 1326DEFUN ("set-text-properties", Fset_text_properties, 1327 Sset_text_properties, 3, 4, 0, 1328 doc: /* Completely replace properties of text from START to END. 1329The third argument PROPERTIES is the new property list. 1330If the optional fourth argument OBJECT is a buffer (or nil, which means 1331the current buffer), START and END are buffer positions (integers or 1332markers). If OBJECT is a string, START and END are 0-based indices into it. 1333If PROPERTIES is nil, the effect is to remove all properties from 1334the designated part of OBJECT. */) 1335 (start, end, properties, object) 1336 Lisp_Object start, end, properties, object; 1337{ 1338 return set_text_properties (start, end, properties, object, Qt); 1339} 1340 1341 1342/* Replace properties of text from START to END with new list of 1343 properties PROPERTIES. OBJECT is the buffer or string containing 1344 the text. OBJECT nil means use the current buffer. 1345 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value 1346 is nil if the function _detected_ that it did not replace any 1347 properties, non-nil otherwise. */ 1348 1349Lisp_Object 1350set_text_properties (start, end, properties, object, signal_after_change_p) 1351 Lisp_Object start, end, properties, object, signal_after_change_p; 1352{ 1353 register INTERVAL i; 1354 Lisp_Object ostart, oend; 1355 1356 ostart = start; 1357 oend = end; 1358 1359 properties = validate_plist (properties); 1360 1361 if (NILP (object)) 1362 XSETBUFFER (object, current_buffer); 1363 1364 /* If we want no properties for a whole string, 1365 get rid of its intervals. */ 1366 if (NILP (properties) && STRINGP (object) 1367 && XFASTINT (start) == 0 1368 && XFASTINT (end) == SCHARS (object)) 1369 { 1370 if (! STRING_INTERVALS (object)) 1371 return Qnil; 1372 1373 STRING_SET_INTERVALS (object, NULL_INTERVAL); 1374 return Qt; 1375 } 1376 1377 i = validate_interval_range (object, &start, &end, soft); 1378 1379 if (NULL_INTERVAL_P (i)) 1380 { 1381 /* If buffer has no properties, and we want none, return now. */ 1382 if (NILP (properties)) 1383 return Qnil; 1384 1385 /* Restore the original START and END values 1386 because validate_interval_range increments them for strings. */ 1387 start = ostart; 1388 end = oend; 1389 1390 i = validate_interval_range (object, &start, &end, hard); 1391 /* This can return if start == end. */ 1392 if (NULL_INTERVAL_P (i)) 1393 return Qnil; 1394 } 1395 1396 if (BUFFERP (object)) 1397 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1398 1399 set_text_properties_1 (start, end, properties, object, i); 1400 1401 if (BUFFERP (object) && !NILP (signal_after_change_p)) 1402 signal_after_change (XINT (start), XINT (end) - XINT (start), 1403 XINT (end) - XINT (start)); 1404 return Qt; 1405} 1406 1407/* Replace properties of text from START to END with new list of 1408 properties PROPERTIES. BUFFER is the buffer containing 1409 the text. This does not obey any hooks. 1410 You can provide the interval that START is located in as I, 1411 or pass NULL for I and this function will find it. 1412 START and END can be in any order. */ 1413 1414void 1415set_text_properties_1 (start, end, properties, buffer, i) 1416 Lisp_Object start, end, properties, buffer; 1417 INTERVAL i; 1418{ 1419 register INTERVAL prev_changed = NULL_INTERVAL; 1420 register int s, len; 1421 INTERVAL unchanged; 1422 1423 s = XINT (start); 1424 len = XINT (end) - s; 1425 if (len == 0) 1426 return; 1427 if (len < 0) 1428 { 1429 s = s + len; 1430 len = - len; 1431 } 1432 1433 if (i == 0) 1434 i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s); 1435 1436 if (i->position != s) 1437 { 1438 unchanged = i; 1439 i = split_interval_right (unchanged, s - unchanged->position); 1440 1441 if (LENGTH (i) > len) 1442 { 1443 copy_properties (unchanged, i); 1444 i = split_interval_left (i, len); 1445 set_properties (properties, i, buffer); 1446 return; 1447 } 1448 1449 set_properties (properties, i, buffer); 1450 1451 if (LENGTH (i) == len) 1452 return; 1453 1454 prev_changed = i; 1455 len -= LENGTH (i); 1456 i = next_interval (i); 1457 } 1458 1459 /* We are starting at the beginning of an interval, I */ 1460 while (len > 0) 1461 { 1462 if (i == 0) 1463 abort (); 1464 1465 if (LENGTH (i) >= len) 1466 { 1467 if (LENGTH (i) > len) 1468 i = split_interval_left (i, len); 1469 1470 /* We have to call set_properties even if we are going to 1471 merge the intervals, so as to make the undo records 1472 and cause redisplay to happen. */ 1473 set_properties (properties, i, buffer); 1474 if (!NULL_INTERVAL_P (prev_changed)) 1475 merge_interval_left (i); 1476 return; 1477 } 1478 1479 len -= LENGTH (i); 1480 1481 /* We have to call set_properties even if we are going to 1482 merge the intervals, so as to make the undo records 1483 and cause redisplay to happen. */ 1484 set_properties (properties, i, buffer); 1485 if (NULL_INTERVAL_P (prev_changed)) 1486 prev_changed = i; 1487 else 1488 prev_changed = i = merge_interval_left (i); 1489 1490 i = next_interval (i); 1491 } 1492} 1493 1494DEFUN ("remove-text-properties", Fremove_text_properties, 1495 Sremove_text_properties, 3, 4, 0, 1496 doc: /* Remove some properties from text from START to END. 1497The third argument PROPERTIES is a property list 1498whose property names specify the properties to remove. 1499\(The values stored in PROPERTIES are ignored.) 1500If the optional fourth argument OBJECT is a buffer (or nil, which means 1501the current buffer), START and END are buffer positions (integers or 1502markers). If OBJECT is a string, START and END are 0-based indices into it. 1503Return t if any property was actually removed, nil otherwise. 1504 1505Use set-text-properties if you want to remove all text properties. */) 1506 (start, end, properties, object) 1507 Lisp_Object start, end, properties, object; 1508{ 1509 register INTERVAL i, unchanged; 1510 register int s, len, modified = 0; 1511 1512 if (NILP (object)) 1513 XSETBUFFER (object, current_buffer); 1514 1515 i = validate_interval_range (object, &start, &end, soft); 1516 if (NULL_INTERVAL_P (i)) 1517 return Qnil; 1518 1519 s = XINT (start); 1520 len = XINT (end) - s; 1521 1522 if (i->position != s) 1523 { 1524 /* No properties on this first interval -- return if 1525 it covers the entire region. */ 1526 if (! interval_has_some_properties (properties, i)) 1527 { 1528 int got = (LENGTH (i) - (s - i->position)); 1529 if (got >= len) 1530 return Qnil; 1531 len -= got; 1532 i = next_interval (i); 1533 } 1534 /* Split away the beginning of this interval; what we don't 1535 want to modify. */ 1536 else 1537 { 1538 unchanged = i; 1539 i = split_interval_right (unchanged, s - unchanged->position); 1540 copy_properties (unchanged, i); 1541 } 1542 } 1543 1544 if (BUFFERP (object)) 1545 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1546 1547 /* We are at the beginning of an interval, with len to scan */ 1548 for (;;) 1549 { 1550 if (i == 0) 1551 abort (); 1552 1553 if (LENGTH (i) >= len) 1554 { 1555 if (! interval_has_some_properties (properties, i)) 1556 return modified ? Qt : Qnil; 1557 1558 if (LENGTH (i) == len) 1559 { 1560 remove_properties (properties, Qnil, i, object); 1561 if (BUFFERP (object)) 1562 signal_after_change (XINT (start), XINT (end) - XINT (start), 1563 XINT (end) - XINT (start)); 1564 return Qt; 1565 } 1566 1567 /* i has the properties, and goes past the change limit */ 1568 unchanged = i; 1569 i = split_interval_left (i, len); 1570 copy_properties (unchanged, i); 1571 remove_properties (properties, Qnil, i, object); 1572 if (BUFFERP (object)) 1573 signal_after_change (XINT (start), XINT (end) - XINT (start), 1574 XINT (end) - XINT (start)); 1575 return Qt; 1576 } 1577 1578 len -= LENGTH (i); 1579 modified += remove_properties (properties, Qnil, i, object); 1580 i = next_interval (i); 1581 } 1582} 1583 1584DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties, 1585 Sremove_list_of_text_properties, 3, 4, 0, 1586 doc: /* Remove some properties from text from START to END. 1587The third argument LIST-OF-PROPERTIES is a list of property names to remove. 1588If the optional fourth argument OBJECT is a buffer (or nil, which means 1589the current buffer), START and END are buffer positions (integers or 1590markers). If OBJECT is a string, START and END are 0-based indices into it. 1591Return t if any property was actually removed, nil otherwise. */) 1592 (start, end, list_of_properties, object) 1593 Lisp_Object start, end, list_of_properties, object; 1594{ 1595 register INTERVAL i, unchanged; 1596 register int s, len, modified = 0; 1597 Lisp_Object properties; 1598 properties = list_of_properties; 1599 1600 if (NILP (object)) 1601 XSETBUFFER (object, current_buffer); 1602 1603 i = validate_interval_range (object, &start, &end, soft); 1604 if (NULL_INTERVAL_P (i)) 1605 return Qnil; 1606 1607 s = XINT (start); 1608 len = XINT (end) - s; 1609 1610 if (i->position != s) 1611 { 1612 /* No properties on this first interval -- return if 1613 it covers the entire region. */ 1614 if (! interval_has_some_properties_list (properties, i)) 1615 { 1616 int got = (LENGTH (i) - (s - i->position)); 1617 if (got >= len) 1618 return Qnil; 1619 len -= got; 1620 i = next_interval (i); 1621 } 1622 /* Split away the beginning of this interval; what we don't 1623 want to modify. */ 1624 else 1625 { 1626 unchanged = i; 1627 i = split_interval_right (unchanged, s - unchanged->position); 1628 copy_properties (unchanged, i); 1629 } 1630 } 1631 1632 /* We are at the beginning of an interval, with len to scan. 1633 The flag `modified' records if changes have been made. 1634 When object is a buffer, we must call modify_region before changes are 1635 made and signal_after_change when we are done. 1636 We call modify_region before calling remove_properties iff modified == 0, 1637 and we call signal_after_change before returning iff modified != 0. */ 1638 for (;;) 1639 { 1640 if (i == 0) 1641 abort (); 1642 1643 if (LENGTH (i) >= len) 1644 { 1645 if (! interval_has_some_properties_list (properties, i)) 1646 if (modified) 1647 { 1648 if (BUFFERP (object)) 1649 signal_after_change (XINT (start), XINT (end) - XINT (start), 1650 XINT (end) - XINT (start)); 1651 return Qt; 1652 } 1653 else 1654 return Qnil; 1655 1656 if (LENGTH (i) == len) 1657 { 1658 if (!modified && BUFFERP (object)) 1659 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1660 remove_properties (Qnil, properties, i, object); 1661 if (BUFFERP (object)) 1662 signal_after_change (XINT (start), XINT (end) - XINT (start), 1663 XINT (end) - XINT (start)); 1664 return Qt; 1665 } 1666 1667 /* i has the properties, and goes past the change limit */ 1668 unchanged = i; 1669 i = split_interval_left (i, len); 1670 copy_properties (unchanged, i); 1671 if (!modified && BUFFERP (object)) 1672 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1673 remove_properties (Qnil, properties, i, object); 1674 if (BUFFERP (object)) 1675 signal_after_change (XINT (start), XINT (end) - XINT (start), 1676 XINT (end) - XINT (start)); 1677 return Qt; 1678 } 1679 1680 if (interval_has_some_properties_list (properties, i)) 1681 { 1682 if (!modified && BUFFERP (object)) 1683 modify_region (XBUFFER (object), XINT (start), XINT (end), 1); 1684 remove_properties (Qnil, properties, i, object); 1685 modified = 1; 1686 } 1687 len -= LENGTH (i); 1688 i = next_interval (i); 1689 } 1690} 1691 1692DEFUN ("text-property-any", Ftext_property_any, 1693 Stext_property_any, 4, 5, 0, 1694 doc: /* Check text from START to END for property PROPERTY equalling VALUE. 1695If so, return the position of the first character whose property PROPERTY 1696is `eq' to VALUE. Otherwise return nil. 1697If the optional fifth argument OBJECT is a buffer (or nil, which means 1698the current buffer), START and END are buffer positions (integers or 1699markers). If OBJECT is a string, START and END are 0-based indices into it. */) 1700 (start, end, property, value, object) 1701 Lisp_Object start, end, property, value, object; 1702{ 1703 register INTERVAL i; 1704 register int e, pos; 1705 1706 if (NILP (object)) 1707 XSETBUFFER (object, current_buffer); 1708 i = validate_interval_range (object, &start, &end, soft); 1709 if (NULL_INTERVAL_P (i)) 1710 return (!NILP (value) || EQ (start, end) ? Qnil : start); 1711 e = XINT (end); 1712 1713 while (! NULL_INTERVAL_P (i)) 1714 { 1715 if (i->position >= e) 1716 break; 1717 if (EQ (textget (i->plist, property), value)) 1718 { 1719 pos = i->position; 1720 if (pos < XINT (start)) 1721 pos = XINT (start); 1722 return make_number (pos); 1723 } 1724 i = next_interval (i); 1725 } 1726 return Qnil; 1727} 1728 1729DEFUN ("text-property-not-all", Ftext_property_not_all, 1730 Stext_property_not_all, 4, 5, 0, 1731 doc: /* Check text from START to END for property PROPERTY not equalling VALUE. 1732If so, return the position of the first character whose property PROPERTY 1733is not `eq' to VALUE. Otherwise, return nil. 1734If the optional fifth argument OBJECT is a buffer (or nil, which means 1735the current buffer), START and END are buffer positions (integers or 1736markers). If OBJECT is a string, START and END are 0-based indices into it. */) 1737 (start, end, property, value, object) 1738 Lisp_Object start, end, property, value, object; 1739{ 1740 register INTERVAL i; 1741 register int s, e; 1742 1743 if (NILP (object)) 1744 XSETBUFFER (object, current_buffer); 1745 i = validate_interval_range (object, &start, &end, soft); 1746 if (NULL_INTERVAL_P (i)) 1747 return (NILP (value) || EQ (start, end)) ? Qnil : start; 1748 s = XINT (start); 1749 e = XINT (end); 1750 1751 while (! NULL_INTERVAL_P (i)) 1752 { 1753 if (i->position >= e) 1754 break; 1755 if (! EQ (textget (i->plist, property), value)) 1756 { 1757 if (i->position > s) 1758 s = i->position; 1759 return make_number (s); 1760 } 1761 i = next_interval (i); 1762 } 1763 return Qnil; 1764} 1765 1766 1767/* Return the direction from which the text-property PROP would be 1768 inherited by any new text inserted at POS: 1 if it would be 1769 inherited from the char after POS, -1 if it would be inherited from 1770 the char before POS, and 0 if from neither. 1771 BUFFER can be either a buffer or nil (meaning current buffer). */ 1772 1773int 1774text_property_stickiness (prop, pos, buffer) 1775 Lisp_Object prop, pos, buffer; 1776{ 1777 Lisp_Object prev_pos, front_sticky; 1778 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */ 1779 1780 if (NILP (buffer)) 1781 XSETBUFFER (buffer, current_buffer); 1782 1783 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer))) 1784 /* Consider previous character. */ 1785 { 1786 Lisp_Object rear_non_sticky; 1787 1788 prev_pos = make_number (XINT (pos) - 1); 1789 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer); 1790 1791 if (!NILP (CONSP (rear_non_sticky) 1792 ? Fmemq (prop, rear_non_sticky) 1793 : rear_non_sticky)) 1794 /* PROP is rear-non-sticky. */ 1795 is_rear_sticky = 0; 1796 } 1797 else 1798 return 0; 1799 1800 /* Consider following character. */ 1801 /* This signals an arg-out-of-range error if pos is outside the 1802 buffer's accessible range. */ 1803 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer); 1804 1805 if (EQ (front_sticky, Qt) 1806 || (CONSP (front_sticky) 1807 && !NILP (Fmemq (prop, front_sticky)))) 1808 /* PROP is inherited from after. */ 1809 is_front_sticky = 1; 1810 1811 /* Simple cases, where the properties are consistent. */ 1812 if (is_rear_sticky && !is_front_sticky) 1813 return -1; 1814 else if (!is_rear_sticky && is_front_sticky) 1815 return 1; 1816 else if (!is_rear_sticky && !is_front_sticky) 1817 return 0; 1818 1819 /* The stickiness properties are inconsistent, so we have to 1820 disambiguate. Basically, rear-sticky wins, _except_ if the 1821 property that would be inherited has a value of nil, in which case 1822 front-sticky wins. */ 1823 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer)) 1824 || NILP (Fget_text_property (prev_pos, prop, buffer))) 1825 return 1; 1826 else 1827 return -1; 1828} 1829 1830 1831/* I don't think this is the right interface to export; how often do you 1832 want to do something like this, other than when you're copying objects 1833 around? 1834 1835 I think it would be better to have a pair of functions, one which 1836 returns the text properties of a region as a list of ranges and 1837 plists, and another which applies such a list to another object. */ 1838 1839/* Add properties from SRC to SRC of SRC, starting at POS in DEST. 1840 SRC and DEST may each refer to strings or buffers. 1841 Optional sixth argument PROP causes only that property to be copied. 1842 Properties are copied to DEST as if by `add-text-properties'. 1843 Return t if any property value actually changed, nil otherwise. */ 1844 1845/* Note this can GC when DEST is a buffer. */ 1846 1847Lisp_Object 1848copy_text_properties (start, end, src, pos, dest, prop) 1849 Lisp_Object start, end, src, pos, dest, prop; 1850{ 1851 INTERVAL i; 1852 Lisp_Object res; 1853 Lisp_Object stuff; 1854 Lisp_Object plist; 1855 int s, e, e2, p, len, modified = 0; 1856 struct gcpro gcpro1, gcpro2; 1857 1858 i = validate_interval_range (src, &start, &end, soft); 1859 if (NULL_INTERVAL_P (i)) 1860 return Qnil; 1861 1862 CHECK_NUMBER_COERCE_MARKER (pos); 1863 { 1864 Lisp_Object dest_start, dest_end; 1865 1866 dest_start = pos; 1867 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start))); 1868 /* Apply this to a copy of pos; it will try to increment its arguments, 1869 which we don't want. */ 1870 validate_interval_range (dest, &dest_start, &dest_end, soft); 1871 } 1872 1873 s = XINT (start); 1874 e = XINT (end); 1875 p = XINT (pos); 1876 1877 stuff = Qnil; 1878 1879 while (s < e) 1880 { 1881 e2 = i->position + LENGTH (i); 1882 if (e2 > e) 1883 e2 = e; 1884 len = e2 - s; 1885 1886 plist = i->plist; 1887 if (! NILP (prop)) 1888 while (! NILP (plist)) 1889 { 1890 if (EQ (Fcar (plist), prop)) 1891 { 1892 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); 1893 break; 1894 } 1895 plist = Fcdr (Fcdr (plist)); 1896 } 1897 if (! NILP (plist)) 1898 { 1899 /* Must defer modifications to the interval tree in case src 1900 and dest refer to the same string or buffer. */ 1901 stuff = Fcons (Fcons (make_number (p), 1902 Fcons (make_number (p + len), 1903 Fcons (plist, Qnil))), 1904 stuff); 1905 } 1906 1907 i = next_interval (i); 1908 if (NULL_INTERVAL_P (i)) 1909 break; 1910 1911 p += len; 1912 s = i->position; 1913 } 1914 1915 GCPRO2 (stuff, dest); 1916 1917 while (! NILP (stuff)) 1918 { 1919 res = Fcar (stuff); 1920 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)), 1921 Fcar (Fcdr (Fcdr (res))), dest); 1922 if (! NILP (res)) 1923 modified++; 1924 stuff = Fcdr (stuff); 1925 } 1926 1927 UNGCPRO; 1928 1929 return modified ? Qt : Qnil; 1930} 1931 1932 1933/* Return a list representing the text properties of OBJECT between 1934 START and END. if PROP is non-nil, report only on that property. 1935 Each result list element has the form (S E PLIST), where S and E 1936 are positions in OBJECT and PLIST is a property list containing the 1937 text properties of OBJECT between S and E. Value is nil if OBJECT 1938 doesn't contain text properties between START and END. */ 1939 1940Lisp_Object 1941text_property_list (object, start, end, prop) 1942 Lisp_Object object, start, end, prop; 1943{ 1944 struct interval *i; 1945 Lisp_Object result; 1946 1947 result = Qnil; 1948 1949 i = validate_interval_range (object, &start, &end, soft); 1950 if (!NULL_INTERVAL_P (i)) 1951 { 1952 int s = XINT (start); 1953 int e = XINT (end); 1954 1955 while (s < e) 1956 { 1957 int interval_end, len; 1958 Lisp_Object plist; 1959 1960 interval_end = i->position + LENGTH (i); 1961 if (interval_end > e) 1962 interval_end = e; 1963 len = interval_end - s; 1964 1965 plist = i->plist; 1966 1967 if (!NILP (prop)) 1968 for (; !NILP (plist); plist = Fcdr (Fcdr (plist))) 1969 if (EQ (Fcar (plist), prop)) 1970 { 1971 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); 1972 break; 1973 } 1974 1975 if (!NILP (plist)) 1976 result = Fcons (Fcons (make_number (s), 1977 Fcons (make_number (s + len), 1978 Fcons (plist, Qnil))), 1979 result); 1980 1981 i = next_interval (i); 1982 if (NULL_INTERVAL_P (i)) 1983 break; 1984 s = i->position; 1985 } 1986 } 1987 1988 return result; 1989} 1990 1991 1992/* Add text properties to OBJECT from LIST. LIST is a list of triples 1993 (START END PLIST), where START and END are positions and PLIST is a 1994 property list containing the text properties to add. Adjust START 1995 and END positions by DELTA before adding properties. Value is 1996 non-zero if OBJECT was modified. */ 1997 1998int 1999add_text_properties_from_list (object, list, delta) 2000 Lisp_Object object, list, delta; 2001{ 2002 struct gcpro gcpro1, gcpro2; 2003 int modified_p = 0; 2004 2005 GCPRO2 (list, object); 2006 2007 for (; CONSP (list); list = XCDR (list)) 2008 { 2009 Lisp_Object item, start, end, plist, tem; 2010 2011 item = XCAR (list); 2012 start = make_number (XINT (XCAR (item)) + XINT (delta)); 2013 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta)); 2014 plist = XCAR (XCDR (XCDR (item))); 2015 2016 tem = Fadd_text_properties (start, end, plist, object); 2017 if (!NILP (tem)) 2018 modified_p = 1; 2019 } 2020 2021 UNGCPRO; 2022 return modified_p; 2023} 2024 2025 2026 2027/* Modify end-points of ranges in LIST destructively. LIST is a list 2028 as returned from text_property_list. Change end-points equal to 2029 OLD_END to NEW_END. */ 2030 2031void 2032extend_property_ranges (list, old_end, new_end) 2033 Lisp_Object list, old_end, new_end; 2034{ 2035 for (; CONSP (list); list = XCDR (list)) 2036 { 2037 Lisp_Object item, end; 2038 2039 item = XCAR (list); 2040 end = XCAR (XCDR (item)); 2041 2042 if (EQ (end, old_end)) 2043 XSETCAR (XCDR (item), new_end); 2044 } 2045} 2046 2047 2048 2049/* Call the modification hook functions in LIST, each with START and END. */ 2050 2051static void 2052call_mod_hooks (list, start, end) 2053 Lisp_Object list, start, end; 2054{ 2055 struct gcpro gcpro1; 2056 GCPRO1 (list); 2057 while (!NILP (list)) 2058 { 2059 call2 (Fcar (list), start, end); 2060 list = Fcdr (list); 2061 } 2062 UNGCPRO; 2063} 2064 2065/* Check for read-only intervals between character positions START ... END, 2066 in BUF, and signal an error if we find one. 2067 2068 Then check for any modification hooks in the range. 2069 Create a list of all these hooks in lexicographic order, 2070 eliminating consecutive extra copies of the same hook. Then call 2071 those hooks in order, with START and END - 1 as arguments. */ 2072 2073void 2074verify_interval_modification (buf, start, end) 2075 struct buffer *buf; 2076 int start, end; 2077{ 2078 register INTERVAL intervals = BUF_INTERVALS (buf); 2079 register INTERVAL i; 2080 Lisp_Object hooks; 2081 register Lisp_Object prev_mod_hooks; 2082 Lisp_Object mod_hooks; 2083 struct gcpro gcpro1; 2084 2085 hooks = Qnil; 2086 prev_mod_hooks = Qnil; 2087 mod_hooks = Qnil; 2088 2089 interval_insert_behind_hooks = Qnil; 2090 interval_insert_in_front_hooks = Qnil; 2091 2092 if (NULL_INTERVAL_P (intervals)) 2093 return; 2094 2095 if (start > end) 2096 { 2097 int temp = start; 2098 start = end; 2099 end = temp; 2100 } 2101 2102 /* For an insert operation, check the two chars around the position. */ 2103 if (start == end) 2104 { 2105 INTERVAL prev = NULL; 2106 Lisp_Object before, after; 2107 2108 /* Set I to the interval containing the char after START, 2109 and PREV to the interval containing the char before START. 2110 Either one may be null. They may be equal. */ 2111 i = find_interval (intervals, start); 2112 2113 if (start == BUF_BEGV (buf)) 2114 prev = 0; 2115 else if (i->position == start) 2116 prev = previous_interval (i); 2117 else if (i->position < start) 2118 prev = i; 2119 if (start == BUF_ZV (buf)) 2120 i = 0; 2121 2122 /* If Vinhibit_read_only is set and is not a list, we can 2123 skip the read_only checks. */ 2124 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only)) 2125 { 2126 /* If I and PREV differ we need to check for the read-only 2127 property together with its stickiness. If either I or 2128 PREV are 0, this check is all we need. 2129 We have to take special care, since read-only may be 2130 indirectly defined via the category property. */ 2131 if (i != prev) 2132 { 2133 if (! NULL_INTERVAL_P (i)) 2134 { 2135 after = textget (i->plist, Qread_only); 2136 2137 /* If interval I is read-only and read-only is 2138 front-sticky, inhibit insertion. 2139 Check for read-only as well as category. */ 2140 if (! NILP (after) 2141 && NILP (Fmemq (after, Vinhibit_read_only))) 2142 { 2143 Lisp_Object tem; 2144 2145 tem = textget (i->plist, Qfront_sticky); 2146 if (TMEM (Qread_only, tem) 2147 || (NILP (Fplist_get (i->plist, Qread_only)) 2148 && TMEM (Qcategory, tem))) 2149 text_read_only (after); 2150 } 2151 } 2152 2153 if (! NULL_INTERVAL_P (prev)) 2154 { 2155 before = textget (prev->plist, Qread_only); 2156 2157 /* If interval PREV is read-only and read-only isn't 2158 rear-nonsticky, inhibit insertion. 2159 Check for read-only as well as category. */ 2160 if (! NILP (before) 2161 && NILP (Fmemq (before, Vinhibit_read_only))) 2162 { 2163 Lisp_Object tem; 2164 2165 tem = textget (prev->plist, Qrear_nonsticky); 2166 if (! TMEM (Qread_only, tem) 2167 && (! NILP (Fplist_get (prev->plist,Qread_only)) 2168 || ! TMEM (Qcategory, tem))) 2169 text_read_only (before); 2170 } 2171 } 2172 } 2173 else if (! NULL_INTERVAL_P (i)) 2174 { 2175 after = textget (i->plist, Qread_only); 2176 2177 /* If interval I is read-only and read-only is 2178 front-sticky, inhibit insertion. 2179 Check for read-only as well as category. */ 2180 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only))) 2181 { 2182 Lisp_Object tem; 2183 2184 tem = textget (i->plist, Qfront_sticky); 2185 if (TMEM (Qread_only, tem) 2186 || (NILP (Fplist_get (i->plist, Qread_only)) 2187 && TMEM (Qcategory, tem))) 2188 text_read_only (after); 2189 2190 tem = textget (prev->plist, Qrear_nonsticky); 2191 if (! TMEM (Qread_only, tem) 2192 && (! NILP (Fplist_get (prev->plist, Qread_only)) 2193 || ! TMEM (Qcategory, tem))) 2194 text_read_only (after); 2195 } 2196 } 2197 } 2198 2199 /* Run both insert hooks (just once if they're the same). */ 2200 if (!NULL_INTERVAL_P (prev)) 2201 interval_insert_behind_hooks 2202 = textget (prev->plist, Qinsert_behind_hooks); 2203 if (!NULL_INTERVAL_P (i)) 2204 interval_insert_in_front_hooks 2205 = textget (i->plist, Qinsert_in_front_hooks); 2206 } 2207 else 2208 { 2209 /* Loop over intervals on or next to START...END, 2210 collecting their hooks. */ 2211 2212 i = find_interval (intervals, start); 2213 do 2214 { 2215 if (! INTERVAL_WRITABLE_P (i)) 2216 text_read_only (textget (i->plist, Qread_only)); 2217 2218 if (!inhibit_modification_hooks) 2219 { 2220 mod_hooks = textget (i->plist, Qmodification_hooks); 2221 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks)) 2222 { 2223 hooks = Fcons (mod_hooks, hooks); 2224 prev_mod_hooks = mod_hooks; 2225 } 2226 } 2227 2228 i = next_interval (i); 2229 } 2230 /* Keep going thru the interval containing the char before END. */ 2231 while (! NULL_INTERVAL_P (i) && i->position < end); 2232 2233 if (!inhibit_modification_hooks) 2234 { 2235 GCPRO1 (hooks); 2236 hooks = Fnreverse (hooks); 2237 while (! EQ (hooks, Qnil)) 2238 { 2239 call_mod_hooks (Fcar (hooks), make_number (start), 2240 make_number (end)); 2241 hooks = Fcdr (hooks); 2242 } 2243 UNGCPRO; 2244 } 2245 } 2246} 2247 2248/* Run the interval hooks for an insertion on character range START ... END. 2249 verify_interval_modification chose which hooks to run; 2250 this function is called after the insertion happens 2251 so it can indicate the range of inserted text. */ 2252 2253void 2254report_interval_modification (start, end) 2255 Lisp_Object start, end; 2256{ 2257 if (! NILP (interval_insert_behind_hooks)) 2258 call_mod_hooks (interval_insert_behind_hooks, start, end); 2259 if (! NILP (interval_insert_in_front_hooks) 2260 && ! EQ (interval_insert_in_front_hooks, 2261 interval_insert_behind_hooks)) 2262 call_mod_hooks (interval_insert_in_front_hooks, start, end); 2263} 2264 2265void 2266syms_of_textprop () 2267{ 2268 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties, 2269 doc: /* Property-list used as default values. 2270The value of a property in this list is seen as the value for every 2271character that does not have its own value for that property. */); 2272 Vdefault_text_properties = Qnil; 2273 2274 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist, 2275 doc: /* Alist of alternative properties for properties without a value. 2276Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...). 2277If a piece of text has no direct value for a particular property, then 2278this alist is consulted. If that property appears in the alist, then 2279the first non-nil value from the associated alternative properties is 2280returned. */); 2281 Vchar_property_alias_alist = Qnil; 2282 2283 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks, 2284 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties. 2285This also inhibits the use of the `intangible' text property. */); 2286 Vinhibit_point_motion_hooks = Qnil; 2287 2288 DEFVAR_LISP ("text-property-default-nonsticky", 2289 &Vtext_property_default_nonsticky, 2290 doc: /* Alist of properties vs the corresponding non-stickinesses. 2291Each element has the form (PROPERTY . NONSTICKINESS). 2292 2293If a character in a buffer has PROPERTY, new text inserted adjacent to 2294the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil, 2295inherits it if NONSTICKINESS is nil. The front-sticky and 2296rear-nonsticky properties of the character overrides NONSTICKINESS. */); 2297 /* Text property `syntax-table' should be nonsticky by default. */ 2298 Vtext_property_default_nonsticky 2299 = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil); 2300 2301 staticpro (&interval_insert_behind_hooks); 2302 staticpro (&interval_insert_in_front_hooks); 2303 interval_insert_behind_hooks = Qnil; 2304 interval_insert_in_front_hooks = Qnil; 2305 2306 2307 /* Common attributes one might give text */ 2308 2309 staticpro (&Qforeground); 2310 Qforeground = intern ("foreground"); 2311 staticpro (&Qbackground); 2312 Qbackground = intern ("background"); 2313 staticpro (&Qfont); 2314 Qfont = intern ("font"); 2315 staticpro (&Qstipple); 2316 Qstipple = intern ("stipple"); 2317 staticpro (&Qunderline); 2318 Qunderline = intern ("underline"); 2319 staticpro (&Qread_only); 2320 Qread_only = intern ("read-only"); 2321 staticpro (&Qinvisible); 2322 Qinvisible = intern ("invisible"); 2323 staticpro (&Qintangible); 2324 Qintangible = intern ("intangible"); 2325 staticpro (&Qcategory); 2326 Qcategory = intern ("category"); 2327 staticpro (&Qlocal_map); 2328 Qlocal_map = intern ("local-map"); 2329 staticpro (&Qfront_sticky); 2330 Qfront_sticky = intern ("front-sticky"); 2331 staticpro (&Qrear_nonsticky); 2332 Qrear_nonsticky = intern ("rear-nonsticky"); 2333 staticpro (&Qmouse_face); 2334 Qmouse_face = intern ("mouse-face"); 2335 2336 /* Properties that text might use to specify certain actions */ 2337 2338 staticpro (&Qmouse_left); 2339 Qmouse_left = intern ("mouse-left"); 2340 staticpro (&Qmouse_entered); 2341 Qmouse_entered = intern ("mouse-entered"); 2342 staticpro (&Qpoint_left); 2343 Qpoint_left = intern ("point-left"); 2344 staticpro (&Qpoint_entered); 2345 Qpoint_entered = intern ("point-entered"); 2346 2347 defsubr (&Stext_properties_at); 2348 defsubr (&Sget_text_property); 2349 defsubr (&Sget_char_property); 2350 defsubr (&Sget_char_property_and_overlay); 2351 defsubr (&Snext_char_property_change); 2352 defsubr (&Sprevious_char_property_change); 2353 defsubr (&Snext_single_char_property_change); 2354 defsubr (&Sprevious_single_char_property_change); 2355 defsubr (&Snext_property_change); 2356 defsubr (&Snext_single_property_change); 2357 defsubr (&Sprevious_property_change); 2358 defsubr (&Sprevious_single_property_change); 2359 defsubr (&Sadd_text_properties); 2360 defsubr (&Sput_text_property); 2361 defsubr (&Sset_text_properties); 2362 defsubr (&Sremove_text_properties); 2363 defsubr (&Sremove_list_of_text_properties); 2364 defsubr (&Stext_property_any); 2365 defsubr (&Stext_property_not_all); 2366/* defsubr (&Serase_text_properties); */ 2367/* defsubr (&Scopy_text_properties); */ 2368} 2369 2370/* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479 2371 (do not change this comment) */ 2372