textprop.c 69.1 KB
Newer Older
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1
/* Interface code for dealing with text properties.
2
   Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
3
                 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Joseph Arceneaux's avatar
Joseph Arceneaux committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

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/>.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
19

20
#include <config.h>
21
#include <setjmp.h>
Joseph Arceneaux's avatar
Joseph Arceneaux committed
22 23 24
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
25
#include "window.h"
26 27 28 29

#ifndef NULL
#define NULL (void *)0
#endif
30 31 32 33 34

/* Test for membership, allowing for t (actually any non-cons) to mean the
   universal set.  */

#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
35 36 37 38 39 40


/* NOTES:  previous- and next- property change will have to skip
  zero-length intervals if they are implemented.  This could be done
  inside next_interval and previous_interval.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
41 42
  set_properties needs to deal with the interval property cache.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
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,
Joseph Arceneaux's avatar
Joseph Arceneaux committed
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.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
48 49


50
/* Types of hooks.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
51 52 53 54
Lisp_Object Qmouse_left;
Lisp_Object Qmouse_entered;
Lisp_Object Qpoint_left;
Lisp_Object Qpoint_entered;
55 56
Lisp_Object Qcategory;
Lisp_Object Qlocal_map;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
57

58
/* Visual properties text (including strings) may have.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
59
Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
60
Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
61
Lisp_Object Qminibuffer_prompt;
62 63 64

/* Sticky properties */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
65 66 67 68

/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
   the o1's cdr.  Otherwise, return zero.  This is handy for
   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 77 78 79
/* verify_interval_modification saves insertion hooks here
   to be run later by report_interval_modification.  */
Lisp_Object interval_insert_behind_hooks;
Lisp_Object interval_insert_in_front_hooks;
80

81
static void text_read_only (Lisp_Object) NO_RETURN;
82

83 84 85 86 87

/* Signal a `text-read-only' error.  This function makes it easier
   to capture that error in GDB by putting a breakpoint on it.  */

static void
88
text_read_only (Lisp_Object propval)
89
{
90 91 92 93
  if (STRINGP (propval))
    xsignal1 (Qtext_read_only, propval);

  xsignal0 (Qtext_read_only);
94 95 96
}


Joseph Arceneaux's avatar
Joseph Arceneaux committed
97

Joseph Arceneaux's avatar
Joseph Arceneaux committed
98 99 100 101 102 103
/* Extract the interval at the position pointed to by BEGIN from
   OBJECT, a string or buffer.  Additionally, check that the positions
   pointed to by BEGIN and END are within the bounds of OBJECT, and
   reverse them if *BEGIN is greater than *END.  The objects pointed
   to by BEGIN and END may be integers or markers; if the latter, they
   are coerced to integers.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
104

105 106 107
   When OBJECT is a string, we increment *BEGIN and *END
   to make them origin-one.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
108 109 110 111 112 113 114 115 116
   Note that buffer points don't correspond to interval indices.
   For example, point-max is 1 greater than the index of the last
   character.  This difference is handled in the caller, which uses
   the validated points to determine a length, and operates on that.
   Exceptions are Ftext_properties_at, Fnext_property_change, and
   Fprevious_property_change which call this function with BEGIN == END.
   Handle this case specially.

   If FORCE is soft (0), it's OK to return NULL_INTERVAL.  Otherwise,
Joseph Arceneaux's avatar
Joseph Arceneaux committed
117 118
   create an interval tree for OBJECT if one doesn't exist, provided
   the object actually contains text.  In the current design, if there
119
   is no text, there can be no text properties.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
120 121 122 123

#define soft 0
#define hard 1

Gerd Moellmann's avatar
Gerd Moellmann committed
124
INTERVAL
125
validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
126 127
{
  register INTERVAL i;
128 129
  int searchpos;

130 131 132
  CHECK_STRING_OR_BUFFER (object);
  CHECK_NUMBER_COERCE_MARKER (*begin);
  CHECK_NUMBER_COERCE_MARKER (*end);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
133 134

  /* If we are asked for a point, but from a subr which operates
135
     on a range, then return nothing.  */
136
  if (EQ (*begin, *end) && begin != end)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
137 138 139 140
    return NULL_INTERVAL;

  if (XINT (*begin) > XINT (*end))
    {
141 142
      Lisp_Object n;
      n = *begin;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
143
      *begin = *end;
144
      *end = n;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
145 146
    }

147
  if (BUFFERP (object))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
148 149 150 151 152 153
    {
      register struct buffer *b = XBUFFER (object);

      if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
	    && XINT (*end) <= BUF_ZV (b)))
	args_out_of_range (*begin, *end);
154
      i = BUF_INTERVALS (b);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
155

156
      /* If there's no text, there are no properties.  */
157 158 159 160
      if (BUF_BEGV (b) == BUF_ZV (b))
	return NULL_INTERVAL;

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
161 162 163
    }
  else
    {
164
      int len = SCHARS (object);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
165

166
      if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
167
	     && XINT (*end) <= len))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
168
	args_out_of_range (*begin, *end);
169
      XSETFASTINT (*begin, XFASTINT (*begin));
170
      if (begin != end)
171
	XSETFASTINT (*end, XFASTINT (*end));
172
      i = STRING_INTERVALS (object);
173

174
      if (len == 0)
175 176 177
	return NULL_INTERVAL;

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
178 179 180 181
    }

  if (NULL_INTERVAL_P (i))
    return (force ? create_root_interval (object) : i);
182

183
  return find_interval (i, searchpos);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
184 185 186 187
}

/* Validate LIST as a property list.  If LIST is not a list, then
   make one consisting of (LIST nil).  Otherwise, verify that LIST
188
   is even numbered and thus suitable as a plist.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
189 190

static Lisp_Object
191
validate_plist (Lisp_Object list)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
192 193 194 195 196 197 198 199
{
  if (NILP (list))
    return Qnil;

  if (CONSP (list))
    {
      register int i;
      register Lisp_Object tail;
200
      for (i = 0, tail = list; CONSP (tail); i++)
201
	{
202
	  tail = XCDR (tail);
203 204
	  QUIT;
	}
Joseph Arceneaux's avatar
Joseph Arceneaux committed
205 206 207 208 209 210 211 212 213
      if (i & 1)
	error ("Odd length text property list");
      return list;
    }

  return Fcons (list, Fcons (Qnil, Qnil));
}

/* Return nonzero if interval I has all the properties,
214
   with the same values, of list PLIST.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
215 216

static int
217
interval_has_all_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
218
{
219
  register Lisp_Object tail1, tail2, sym1;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
220 221
  register int found;

222
  /* Go through each element of PLIST.  */
223
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
224
    {
225
      sym1 = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
226 227 228
      found = 0;

      /* Go through I's plist, looking for sym1 */
229 230
      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
	if (EQ (sym1, XCAR (tail2)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
231 232
	  {
	    /* Found the same property on both lists.  If the
233
	       values are unequal, return zero.  */
234
	    if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
235 236
	      return 0;

237
	    /* Property has same value on both lists;  go to next one.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
238 239 240 241 242 243 244 245 246 247 248 249
	    found = 1;
	    break;
	  }

      if (! found)
	return 0;
    }

  return 1;
}

/* Return nonzero if the plist of interval I has any of the
250
   properties of PLIST, regardless of their values.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
251 252

static INLINE int
253
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
254 255 256
{
  register Lisp_Object tail1, tail2, sym;

257
  /* Go through each element of PLIST.  */
258
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
259
    {
260
      sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
261 262

      /* Go through i's plist, looking for tail1 */
263 264
      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
	if (EQ (sym, XCAR (tail2)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
265 266 267 268 269
	  return 1;
    }

  return 0;
}
270 271 272 273 274

/* Return nonzero if the plist of interval I has any of the
   property names in LIST, regardless of their values.  */

static INLINE int
275
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
276 277 278 279
{
  register Lisp_Object tail1, tail2, sym;

  /* Go through each element of LIST.  */
280
  for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
281 282 283 284
    {
      sym = Fcar (tail1);

      /* Go through i's plist, looking for tail1 */
285
      for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
286 287 288 289 290 291
	if (EQ (sym, XCAR (tail2)))
	  return 1;
    }

  return 0;
}
292

293 294 295 296
/* Changing the plists of individual intervals.  */

/* Return the value of PROP in property-list PLIST, or Qunbound if it
   has none.  */
297
static Lisp_Object
298
property_value (Lisp_Object plist, Lisp_Object prop)
299 300 301 302
{
  Lisp_Object value;

  while (PLIST_ELT_P (plist, value))
303 304
    if (EQ (XCAR (plist), prop))
      return XCAR (value);
305
    else
306
      plist = XCDR (value);
307 308 309 310

  return Qunbound;
}

311 312 313 314 315
/* Set the properties of INTERVAL to PROPERTIES,
   and record undo info for the previous values.
   OBJECT is the string or buffer that INTERVAL belongs to.  */

static void
316
set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
317
{
318
  Lisp_Object sym, value;
319

320
  if (BUFFERP (object))
321
    {
322 323 324 325
      /* For each property in the old plist which is missing from PROPERTIES,
	 or has a different value in PROPERTIES, make an undo record.  */
      for (sym = interval->plist;
	   PLIST_ELT_P (sym, value);
326 327 328
	   sym = XCDR (value))
	if (! EQ (property_value (properties, XCAR (sym)),
		  XCAR (value)))
329 330
	  {
	    record_property_change (interval->position, LENGTH (interval),
331
				    XCAR (sym), XCAR (value),
332 333
				    object);
	  }
334 335 336 337 338

      /* For each new property that has no value at all in the old plist,
	 make an undo record binding it to nil, so it will be removed.  */
      for (sym = properties;
	   PLIST_ELT_P (sym, value);
339 340
	   sym = XCDR (value))
	if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
341 342
	  {
	    record_property_change (interval->position, LENGTH (interval),
343
				    XCAR (sym), Qnil,
344 345
				    object);
	  }
346 347 348 349 350
    }

  /* Store new properties.  */
  interval->plist = Fcopy_sequence (properties);
}
Joseph Arceneaux's avatar
Joseph Arceneaux committed
351 352 353 354 355

/* Add the properties of PLIST to the interval I, or set
   the value of I's property to the value of the property on PLIST
   if they are different.

356 357
   OBJECT should be the string or buffer the interval is in.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
358 359 360
   Return nonzero if this changes I (i.e., if any members of PLIST
   are actually added to I's plist) */

361
static int
362
add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
363
{
364
  Lisp_Object tail1, tail2, sym1, val1;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
365 366
  register int changed = 0;
  register int found;
367 368 369 370 371 372 373 374 375
  struct gcpro gcpro1, gcpro2, gcpro3;

  tail1 = plist;
  sym1 = Qnil;
  val1 = Qnil;
  /* No need to protect OBJECT, because we can GC only in the case
     where it is a buffer, and live buffers are always protected.
     I and its plist are also protected, via OBJECT.  */
  GCPRO3 (tail1, sym1, val1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
376

377
  /* Go through each element of PLIST.  */
378
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
379
    {
380 381
      sym1 = XCAR (tail1);
      val1 = Fcar (XCDR (tail1));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
382 383 384
      found = 0;

      /* Go through I's plist, looking for sym1 */
385 386
      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
	if (EQ (sym1, XCAR (tail2)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
387
	  {
388 389
	    /* No need to gcpro, because tail2 protects this
	       and it must be a cons cell (we get an error otherwise).  */
390
	    register Lisp_Object this_cdr;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
391

392
	    this_cdr = XCDR (tail2);
393
	    /* Found the property.  Now check its value.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
394 395 396
	    found = 1;

	    /* The properties have the same value on both lists.
397
	       Continue to the next property.  */
398
	    if (EQ (val1, Fcar (this_cdr)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
399 400
	      break;

401
	    /* Record this change in the buffer, for undo purposes.  */
402
	    if (BUFFERP (object))
403
	      {
404 405
		record_property_change (i->position, LENGTH (i),
					sym1, Fcar (this_cdr), object);
406 407
	      }

Joseph Arceneaux's avatar
Joseph Arceneaux committed
408 409 410 411 412 413 414 415
	    /* I's property has a different value -- change it */
	    Fsetcar (this_cdr, val1);
	    changed++;
	    break;
	  }

      if (! found)
	{
416
	  /* Record this change in the buffer, for undo purposes.  */
417
	  if (BUFFERP (object))
418
	    {
419 420
	      record_property_change (i->position, LENGTH (i),
				      sym1, Qnil, object);
421
	    }
Joseph Arceneaux's avatar
Joseph Arceneaux committed
422 423 424 425 426
	  i->plist = Fcons (sym1, Fcons (val1, i->plist));
	  changed++;
	}
    }

427 428
  UNGCPRO;

Joseph Arceneaux's avatar
Joseph Arceneaux committed
429 430 431
  return changed;
}

432 433 434
/* For any members of PLIST, or LIST,
   which are properties of I, remove them from I's plist.
   (If PLIST is non-nil, use that, otherwise use LIST.)
435
   OBJECT is the string or buffer containing I.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
436

437
static int
438
remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
439
{
440
  register Lisp_Object tail1, tail2, sym, current_plist;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
441 442
  register int changed = 0;

443 444
  /* Nonzero means tail1 is a plist, otherwise it is a list.  */
  int use_plist;
445

446
  current_plist = i->plist;
447 448

  if (! NILP (plist))
449
    tail1 = plist, use_plist = 1;
450
  else
451
    tail1 = list, use_plist = 0;
452 453

  /* Go through each element of LIST or PLIST.  */
454
  while (CONSP (tail1))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
455
    {
456
      sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
457

458
      /* First, remove the symbol if it's at the head of the list */
459
      while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
460
	{
461
	  if (BUFFERP (object))
462 463 464
	    record_property_change (i->position, LENGTH (i),
				    sym, XCAR (XCDR (current_plist)),
				    object);
465

466
	  current_plist = XCDR (XCDR (current_plist));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
467 468 469
	  changed++;
	}

470
      /* Go through I's plist, looking for SYM.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
471 472 473
      tail2 = current_plist;
      while (! NILP (tail2))
	{
474
	  register Lisp_Object this;
475
	  this = XCDR (XCDR (tail2));
476
	  if (CONSP (this) && EQ (sym, XCAR (this)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
477
	    {
478
	      if (BUFFERP (object))
479 480
		record_property_change (i->position, LENGTH (i),
					sym, XCAR (XCDR (this)), object);
481

482
	      Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
483 484 485 486
	      changed++;
	    }
	  tail2 = this;
	}
487 488

      /* Advance thru TAIL1 one way or the other.  */
489 490
      tail1 = XCDR (tail1);
      if (use_plist && CONSP (tail1))
491
	tail1 = XCDR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
492 493 494 495 496 497 498
    }

  if (changed)
    i->plist = current_plist;
  return changed;
}

499
#if 0
Joseph Arceneaux's avatar
Joseph Arceneaux committed
500
/* Remove all properties from interval I.  Return non-zero
501
   if this changes the interval.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
502 503 504 505 506 507 508 509 510 511 512

static INLINE int
erase_properties (i)
     INTERVAL i;
{
  if (NILP (i->plist))
    return 0;

  i->plist = Qnil;
  return 1;
}
513
#endif
Joseph Arceneaux's avatar
Joseph Arceneaux committed
514

515
/* Returns the interval of POSITION in OBJECT.
516 517 518
   POSITION is BEG-based.  */

INTERVAL
519
interval_of (int position, Lisp_Object object)
520 521 522 523 524 525
{
  register INTERVAL i;
  int beg, end;

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
Karl Heuer's avatar
Karl Heuer committed
526 527
  else if (EQ (object, Qt))
    return NULL_INTERVAL;
528

529
  CHECK_STRING_OR_BUFFER (object);
530 531 532 533 534 535 536 537 538 539 540

  if (BUFFERP (object))
    {
      register struct buffer *b = XBUFFER (object);

      beg = BUF_BEGV (b);
      end = BUF_ZV (b);
      i = BUF_INTERVALS (b);
    }
  else
    {
541
      beg = 0;
542 543
      end = SCHARS (object);
      i = STRING_INTERVALS (object);
544 545 546
    }

  if (!(beg <= position && position <= end))
547
    args_out_of_range (make_number (position), make_number (position));
548 549
  if (beg == end || NULL_INTERVAL_P (i))
    return NULL_INTERVAL;
550

551 552 553
  return find_interval (i, position);
}

Joseph Arceneaux's avatar
Joseph Arceneaux committed
554 555
DEFUN ("text-properties-at", Ftext_properties_at,
       Stext_properties_at, 1, 2, 0,
556
       doc: /* Return the list of properties of the character at POSITION in OBJECT.
557 558 559
If the optional second argument OBJECT is a buffer (or nil, which means
the current buffer), POSITION is a buffer position (integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.
560 561
If POSITION is at the end of OBJECT, the value is nil.  */)
     (position, object)
562
     Lisp_Object position, object;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
563 564 565 566
{
  register INTERVAL i;

  if (NILP (object))
567
    XSETBUFFER (object, current_buffer);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
568

569
  i = validate_interval_range (object, &position, &position, soft);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
570 571
  if (NULL_INTERVAL_P (i))
    return Qnil;
572
  /* If POSITION is at the end of the interval,
573 574 575
     it means it's the end of OBJECT.
     There are no properties at the very end,
     since no character follows.  */
576
  if (XINT (position) == LENGTH (i) + i->position)
577
    return Qnil;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
578 579 580 581

  return i->plist;
}

582
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
583 584 585 586
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
OBJECT is optional and defaults to the current buffer.
If POSITION is at the end of OBJECT, the value is nil.  */)
     (position, prop, object)
587
     Lisp_Object position, object;
588
     Lisp_Object prop;
589
{
590
  return textget (Ftext_properties_at (position, object), prop);
591 592
}

593
/* Return the value of char's property PROP, in OBJECT at POSITION.
594 595 596 597 598 599 600 601 602 603 604
   OBJECT is optional and defaults to the current buffer.
   If OVERLAY is non-0, then in the case that the returned property is from
   an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
   returned in *OVERLAY.
   If POSITION is at the end of OBJECT, the value is nil.
   If OBJECT is a buffer, then overlay properties are considered as well as
   text properties.
   If OBJECT is a window, then that window's buffer is used, but
   window-specific overlays are considered only if they are associated
   with OBJECT. */
Lisp_Object
605
get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
606 607 608
{
  struct window *w = 0;

609
  CHECK_NUMBER_COERCE_MARKER (position);
610 611

  if (NILP (object))
612
    XSETBUFFER (object, current_buffer);
613 614 615 616

  if (WINDOWP (object))
    {
      w = XWINDOW (object);
617
      object = w->buffer;
618 619 620 621
    }
  if (BUFFERP (object))
    {
      int noverlays;
622
      Lisp_Object *overlay_vec;
623 624
      struct buffer *obuf = current_buffer;

625 626 627 628
      if (XINT (position) < BUF_BEGV (XBUFFER (object))
	  || XINT (position) > BUF_ZV (XBUFFER (object)))
	xsignal1 (Qargs_out_of_range, position);

629
      set_buffer_temp (XBUFFER (object));
630

631
      GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
632 633
      noverlays = sort_overlays (overlay_vec, noverlays, w);

634 635
      set_buffer_temp (obuf);

636 637 638
      /* Now check the overlays in order of decreasing priority.  */
      while (--noverlays >= 0)
	{
639
	  Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
640
	  if (!NILP (tem))
641 642 643 644 645 646
	    {
	      if (overlay)
		/* Return the overlay we got the property from.  */
		*overlay = overlay_vec[noverlays];
	      return tem;
	    }
647 648
	}
    }
649 650 651 652 653

  if (overlay)
    /* Indicate that the return value is not from an overlay.  */
    *overlay = Qnil;

654 655
  /* Not a buffer, or no appropriate overlay, so fall through to the
     simpler case.  */
656 657 658 659
  return Fget_text_property (position, prop, object);
}

DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
660
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
661
Both overlay properties and text properties are checked.
662 663 664 665 666 667 668
OBJECT is optional and defaults to the current buffer.
If POSITION is at the end of OBJECT, the value is nil.
If OBJECT is a buffer, then overlay properties are considered as well as
text properties.
If OBJECT is a window, then that window's buffer is used, but window-specific
overlays are considered only if they are associated with OBJECT.  */)
     (position, prop, object)
669 670 671 672
     Lisp_Object position, object;
     register Lisp_Object prop;
{
  return get_char_property_and_overlay (position, prop, object, 0);
673
}
674 675 676 677

DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
       Sget_char_property_and_overlay, 2, 3, 0,
       doc: /* Like `get-char-property', but with extra overlay information.
678 679 680
The value is a cons cell.  Its car is the return value of `get-char-property'
with the same arguments--that is, the value of POSITION's property
PROP in OBJECT.  Its cdr is the overlay in which the property was
681
found, or nil, if it was found as a text property or not found at all.
682

683 684 685 686 687 688 689 690 691 692 693 694 695
OBJECT is optional and defaults to the current buffer.  OBJECT may be
a string, a buffer or a window.  For strings, the cdr of the return
value is always nil, since strings do not have overlays.  If OBJECT is
a window, then that window's buffer is used, but window-specific
overlays are considered only if they are associated with OBJECT.  If
POSITION is at the end of OBJECT, both car and cdr are nil.  */)
     (position, prop, object)
     Lisp_Object position, object;
     register Lisp_Object prop;
{
  Lisp_Object overlay;
  Lisp_Object val
    = get_char_property_and_overlay (position, prop, object, &overlay);
Richard M. Stallman's avatar
Richard M. Stallman committed
696
  return Fcons (val, overlay);
697 698
}

699 700 701

DEFUN ("next-char-property-change", Fnext_char_property_change,
       Snext_char_property_change, 1, 2, 0,
702
       doc: /* Return the position of next text property or overlay change.
703 704 705
This scans characters forward in the current buffer from POSITION till
it finds a change in some text property, or the beginning or end of an
overlay, and returns the position of that.
706
If none is found up to (point-max), the function returns (point-max).
707

708
If the optional second argument LIMIT is non-nil, don't search
709 710
past position LIMIT; return LIMIT if nothing is found before LIMIT.
LIMIT is a no-op if it is greater than (point-max).  */)
711
     (position, limit)
712 713 714 715 716 717 718
     Lisp_Object position, limit;
{
  Lisp_Object temp;

  temp = Fnext_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
719
      CHECK_NUMBER_COERCE_MARKER (limit);
720 721 722 723 724 725 726 727
      if (XINT (limit) < XINT (temp))
	temp = limit;
    }
  return Fnext_property_change (position, Qnil, temp);
}

DEFUN ("previous-char-property-change", Fprevious_char_property_change,
       Sprevious_char_property_change, 1, 2, 0,
728
       doc: /* Return the position of previous text property or overlay change.
729 730 731
Scans characters backward in the current buffer from POSITION till it
finds a change in some text property, or the beginning or end of an
overlay, and returns the position of that.
732
If none is found since (point-min), the function returns (point-min).
733

734
If the optional second argument LIMIT is non-nil, don't search
735 736
past position LIMIT; return LIMIT if nothing is found before LIMIT.
LIMIT is a no-op if it is less than (point-min).  */)
737
     (position, limit)
738 739 740
     Lisp_Object position, limit;
{
  Lisp_Object temp;
741

742 743 744
  temp = Fprevious_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
745
      CHECK_NUMBER_COERCE_MARKER (limit);
746 747 748 749 750
      if (XINT (limit) > XINT (temp))
	temp = limit;
    }
  return Fprevious_property_change (position, Qnil, temp);
}
751 752


753 754
DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
       Snext_single_char_property_change, 2, 4, 0,
755 756 757
       doc: /* Return the position of next text property or overlay change for a specific property.
Scans characters forward from POSITION till it finds
a change in the PROP property, then returns the position of the change.
758 759 760 761
If the optional third argument OBJECT is a buffer (or nil, which means
the current buffer), POSITION is a buffer position (integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.

762 763 764
In a string, scan runs to the end of the string.
In a buffer, it runs to (point-max), and the value cannot exceed that.

765 766 767 768 769 770
The property values are compared with `eq'.
If the property is constant all the way to the end of OBJECT, return the
last valid position in OBJECT.
If the optional fourth argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
     (position, prop, object, limit)
771
     Lisp_Object prop, position, object, limit;
772 773 774
{
  if (STRINGP (object))
    {
775 776
      position = Fnext_single_property_change (position, prop, object, limit);
      if (NILP (position))
777 778
	{
	  if (NILP (limit))
779
	    position = make_number (SCHARS (object));
780
	  else
David Kastrup's avatar
David Kastrup committed
781 782 783 784
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
785 786 787 788 789
	}
    }
  else
    {
      Lisp_Object initial_value, value;
Juanma Barranquero's avatar
Juanma Barranquero committed
790
      int count = SPECPDL_INDEX ();
791

792
      if (! NILP (object))
793
	CHECK_BUFFER (object);
794

795 796 797 798 799 800
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}

David Kastrup's avatar
David Kastrup committed
801 802
      CHECK_NUMBER_COERCE_MARKER (position);

803
      initial_value = Fget_char_property (position, prop, object);
804

805
      if (NILP (limit))
806
	XSETFASTINT (limit, ZV);
807
      else
808
	CHECK_NUMBER_COERCE_MARKER (limit);
809

810
      if (XFASTINT (position) >= XFASTINT (limit))
811
	{
812 813 814
	  position = limit;
	  if (XFASTINT (position) > ZV)
	    XSETFASTINT (position, ZV);
815
	}
816 817 818 819 820 821 822 823 824 825 826 827 828 829
      else
	while (1)
	  {
	    position = Fnext_char_property_change (position, limit);
	    if (XFASTINT (position) >= XFASTINT (limit))
	      {
		position = limit;
		break;
	      }

	    value = Fget_char_property (position, prop, object);
	    if (!EQ (value, initial_value))
	      break;
	  }
830 831 832 833

      unbind_to (count, Qnil);
    }

834
  return position;
835 836
}

837 838 839
DEFUN ("previous-single-char-property-change",
       Fprevious_single_char_property_change,
       Sprevious_single_char_property_change, 2, 4, 0,
840 841 842
       doc: /* Return the position of previous text property or overlay change for a specific property.
Scans characters backward from POSITION till it finds
a change in the PROP property, then returns the position of the change.
843 844 845 846
If the optional third argument OBJECT is a buffer (or nil, which means
the current buffer), POSITION is a buffer position (integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.

847 848 849
In a string, scan runs to the start of the string.
In a buffer, it runs to (point-min), and the value cannot be less than that.

850 851 852 853 854 855
The property values are compared with `eq'.
If the property is constant all the way to the start of OBJECT, return the
first valid position in OBJECT.
If the optional fourth argument LIMIT is non-nil, don't search
back past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
     (position, prop, object, limit)
856 857 858 859 860 861 862 863
     Lisp_Object prop, position, object, limit;
{
  if (STRINGP (object))
    {
      position = Fprevious_single_property_change (position, prop, object, limit);
      if (NILP (position))
	{
	  if (NILP (limit))
864
	    position = make_number (0);
865
	  else
David Kastrup's avatar
David Kastrup committed
866 867 868 869
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
870 871 872 873
	}
    }
  else
    {
Juanma Barranquero's avatar
Juanma Barranquero committed
874
      int count = SPECPDL_INDEX ();
875 876

      if (! NILP (object))
877
	CHECK_BUFFER (object);
878

879 880 881 882 883
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}
884

David Kastrup's avatar
David Kastrup committed
885 886
      CHECK_NUMBER_COERCE_MARKER (position);

887
      if (NILP (limit))
888
	XSETFASTINT (limit, BEGV);
889
      else
890
	CHECK_NUMBER_COERCE_MARKER (limit);
891

892
      if (XFASTINT (position) <= XFASTINT (limit))
893 894 895 896 897
	{
	  position = limit;
	  if (XFASTINT (position) < BEGV)
	    XSETFASTINT (position, BEGV);
	}
898
      else
899
	{
900 901 902
	  Lisp_Object initial_value
	    = Fget_char_property (make_number (XFASTINT (position) - 1),
				  prop, object);
903

904
	  while (1)
905 906
	    {
	      position = Fprevious_char_property_change (position, limit);
907

908 909 910 911 912 913 914
	      if (XFASTINT (position) <= XFASTINT (limit))
		{
		  position = limit;
		  break;
		}
	      else
		{
915 916 917
		  Lisp_Object value
		    = Fget_char_property (make_number (XFASTINT (position) - 1),
					  prop, object);
918 919 920 921 922

		  if (!EQ (value, initial_value))
		    break;
		}
	    }
923 924 925 926 927 928 929
	}

      unbind_to (count, Qnil);
    }

  return position;
}
930

Joseph Arceneaux's avatar
Joseph Arceneaux committed
931
DEFUN ("next-property-change", Fnext_property_change,
932
       Snext_property_change, 1, 3, 0,
933 934 935
       doc: /* Return the position of next property change.
Scans characters forward from POSITION in OBJECT till it finds
a change in some text property, then returns the position of the change.
936 937 938
If the optional second argument OBJECT is a buffer (or nil, which means
the current buffer), POSITION is a buffer position (integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.
939 940 941 942 943 944
Return nil if the property is constant all the way to the end of OBJECT.
If the value is non-nil, it is a position greater than POSITION, never equal.

If the optional third argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
     (position, object, limit)
945
     Lisp_Object position, object, limit;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
946 947 948
{
  register INTERVAL i, next;

949
  if (NILP (object))
950
    XSETBUFFER (object, current_buffer);
951

952
  if (!NILP (limit) && !EQ (limit, Qt))
953
    CHECK_NUMBE