textprop.c 67.7 KB
Newer Older
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1
/* Interface code for dealing with text properties.
2
   Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
3 4 5

This file is part of GNU Emacs.

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

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
17
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
18

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

26 27 28 29
/* 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
30 31 32 33 34 35


/* 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
36 37
  set_properties needs to deal with the interval property cache.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
38
  It is assumed that for any interval plist, a property appears
39
  only once on the list.  Although some code i.e., remove_properties,
Joseph Arceneaux's avatar
Joseph Arceneaux committed
40
  handles the more general case, the uniqueness of properties is
41
  necessary for the system to remain consistent.  This requirement
42
  is enforced by the subrs installing properties onto the intervals.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
43 44


45
/* Types of hooks.  */
46 47
static Lisp_Object Qmouse_left;
static Lisp_Object Qmouse_entered;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
48 49
Lisp_Object Qpoint_left;
Lisp_Object Qpoint_entered;
50 51
Lisp_Object Qcategory;
Lisp_Object Qlocal_map;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
52

53
/* Visual properties text (including strings) may have.  */
54 55 56 57 58
static Lisp_Object Qforeground, Qbackground, Qunderline;
Lisp_Object Qfont;
static Lisp_Object Qstipple;
Lisp_Object Qinvisible, Qintangible, Qmouse_face;
static Lisp_Object Qread_only;
59
Lisp_Object Qminibuffer_prompt;
60 61 62

/* Sticky properties */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
63 64 65 66

/* 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.  */
67
#define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
68

69 70
/* verify_interval_modification saves insertion hooks here
   to be run later by report_interval_modification.  */
71 72
static Lisp_Object interval_insert_behind_hooks;
static Lisp_Object interval_insert_in_front_hooks;
73

74
static void text_read_only (Lisp_Object) NO_RETURN;
75 76
static Lisp_Object Fprevious_property_change (Lisp_Object, Lisp_Object,
					      Lisp_Object);
77

78 79 80 81 82

/* 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
83
text_read_only (Lisp_Object propval)
84
{
85 86 87 88
  if (STRINGP (propval))
    xsignal1 (Qtext_read_only, propval);

  xsignal0 (Qtext_read_only);
89 90 91
}


Joseph Arceneaux's avatar
Joseph Arceneaux committed
92

Joseph Arceneaux's avatar
Joseph Arceneaux committed
93 94 95 96 97 98
/* 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
99

100 101 102
   When OBJECT is a string, we increment *BEGIN and *END
   to make them origin-one.

Joseph Arceneaux's avatar
Joseph Arceneaux committed
103 104 105 106 107 108 109 110 111
   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
112 113
   create an interval tree for OBJECT if one doesn't exist, provided
   the object actually contains text.  In the current design, if there
114
   is no text, there can be no text properties.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
115 116 117 118

#define soft 0
#define hard 1

Gerd Moellmann's avatar
Gerd Moellmann committed
119
INTERVAL
120
validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
121 122
{
  register INTERVAL i;
123
  ptrdiff_t searchpos;
124

125 126 127
  CHECK_STRING_OR_BUFFER (object);
  CHECK_NUMBER_COERCE_MARKER (*begin);
  CHECK_NUMBER_COERCE_MARKER (*end);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
128 129

  /* If we are asked for a point, but from a subr which operates
130
     on a range, then return nothing.  */
131
  if (EQ (*begin, *end) && begin != end)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
132 133 134 135
    return NULL_INTERVAL;

  if (XINT (*begin) > XINT (*end))
    {
136 137
      Lisp_Object n;
      n = *begin;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
138
      *begin = *end;
139
      *end = n;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
140 141
    }

142
  if (BUFFERP (object))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
143 144 145 146 147 148
    {
      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);
149
      i = BUF_INTERVALS (b);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
150

151
      /* If there's no text, there are no properties.  */
152 153 154 155
      if (BUF_BEGV (b) == BUF_ZV (b))
	return NULL_INTERVAL;

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
156 157 158
    }
  else
    {
159
      ptrdiff_t len = SCHARS (object);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
160

161
      if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
162
	     && XINT (*end) <= len))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
163
	args_out_of_range (*begin, *end);
164
      XSETFASTINT (*begin, XFASTINT (*begin));
165
      if (begin != end)
166
	XSETFASTINT (*end, XFASTINT (*end));
167
      i = STRING_INTERVALS (object);
168

169
      if (len == 0)
170 171 172
	return NULL_INTERVAL;

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
173 174 175 176
    }

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

178
  return find_interval (i, searchpos);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
179 180 181 182
}

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

static Lisp_Object
186
validate_plist (Lisp_Object list)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
187 188 189 190 191 192 193 194
{
  if (NILP (list))
    return Qnil;

  if (CONSP (list))
    {
      register int i;
      register Lisp_Object tail;
195
      for (i = 0, tail = list; CONSP (tail); i++)
196
	{
197
	  tail = XCDR (tail);
198 199
	  QUIT;
	}
Joseph Arceneaux's avatar
Joseph Arceneaux committed
200 201 202 203 204 205 206 207 208
      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,
209
   with the same values, of list PLIST.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
210 211

static int
212
interval_has_all_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
213
{
214
  register Lisp_Object tail1, tail2, sym1;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
215 216
  register int found;

217
  /* Go through each element of PLIST.  */
218
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
219
    {
220
      sym1 = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
221 222 223
      found = 0;

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

232
	    /* Property has same value on both lists; go to next one.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
233 234 235 236 237 238 239 240 241 242 243 244
	    found = 1;
	    break;
	  }

      if (! found)
	return 0;
    }

  return 1;
}

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

Paul Eggert's avatar
Paul Eggert committed
247
static inline int
248
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
249 250 251
{
  register Lisp_Object tail1, tail2, sym;

252
  /* Go through each element of PLIST.  */
253
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
254
    {
255
      sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
256 257

      /* Go through i's plist, looking for tail1 */
258 259
      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
	if (EQ (sym, XCAR (tail2)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
260 261 262 263 264
	  return 1;
    }

  return 0;
}
265 266 267 268

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

Paul Eggert's avatar
Paul Eggert committed
269
static inline int
270
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
271 272 273 274
{
  register Lisp_Object tail1, tail2, sym;

  /* Go through each element of LIST.  */
275
  for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
276 277 278 279
    {
      sym = Fcar (tail1);

      /* Go through i's plist, looking for tail1 */
280
      for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
281 282 283 284 285 286
	if (EQ (sym, XCAR (tail2)))
	  return 1;
    }

  return 0;
}
287

288 289 290 291
/* Changing the plists of individual intervals.  */

/* Return the value of PROP in property-list PLIST, or Qunbound if it
   has none.  */
292
static Lisp_Object
293
property_value (Lisp_Object plist, Lisp_Object prop)
294 295 296 297
{
  Lisp_Object value;

  while (PLIST_ELT_P (plist, value))
298 299
    if (EQ (XCAR (plist), prop))
      return XCAR (value);
300
    else
301
      plist = XCDR (value);
302 303 304 305

  return Qunbound;
}

306 307 308 309 310
/* 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
311
set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
312
{
313
  Lisp_Object sym, value;
314

315
  if (BUFFERP (object))
316
    {
317 318 319 320
      /* 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);
321 322 323
	   sym = XCDR (value))
	if (! EQ (property_value (properties, XCAR (sym)),
		  XCAR (value)))
324 325
	  {
	    record_property_change (interval->position, LENGTH (interval),
326
				    XCAR (sym), XCAR (value),
327 328
				    object);
	  }
329 330 331 332 333

      /* 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);
334 335
	   sym = XCDR (value))
	if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
336 337
	  {
	    record_property_change (interval->position, LENGTH (interval),
338
				    XCAR (sym), Qnil,
339 340
				    object);
	  }
341 342 343 344 345
    }

  /* Store new properties.  */
  interval->plist = Fcopy_sequence (properties);
}
Joseph Arceneaux's avatar
Joseph Arceneaux committed
346 347 348 349 350

/* 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.

351 352
   OBJECT should be the string or buffer the interval is in.

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

356
static int
357
add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
358
{
359
  Lisp_Object tail1, tail2, sym1, val1;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
360 361
  register int changed = 0;
  register int found;
362 363 364 365 366 367 368 369 370
  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
371

372
  /* Go through each element of PLIST.  */
373
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
374
    {
375 376
      sym1 = XCAR (tail1);
      val1 = Fcar (XCDR (tail1));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
377 378 379
      found = 0;

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

387
	    this_cdr = XCDR (tail2);
388
	    /* Found the property.  Now check its value.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
389 390 391
	    found = 1;

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

396
	    /* Record this change in the buffer, for undo purposes.  */
397
	    if (BUFFERP (object))
398
	      {
399 400
		record_property_change (i->position, LENGTH (i),
					sym1, Fcar (this_cdr), object);
401 402
	      }

Joseph Arceneaux's avatar
Joseph Arceneaux committed
403 404 405 406 407 408 409 410
	    /* I's property has a different value -- change it */
	    Fsetcar (this_cdr, val1);
	    changed++;
	    break;
	  }

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

422 423
  UNGCPRO;

Joseph Arceneaux's avatar
Joseph Arceneaux committed
424 425 426
  return changed;
}

427 428 429
/* 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.)
430
   OBJECT is the string or buffer containing I.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
431

432
static int
433
remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
434
{
435
  register Lisp_Object tail1, tail2, sym, current_plist;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
436 437
  register int changed = 0;

438 439
  /* Nonzero means tail1 is a plist, otherwise it is a list.  */
  int use_plist;
440

441
  current_plist = i->plist;
442 443

  if (! NILP (plist))
444
    tail1 = plist, use_plist = 1;
445
  else
446
    tail1 = list, use_plist = 0;
447 448

  /* Go through each element of LIST or PLIST.  */
449
  while (CONSP (tail1))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
450
    {
451
      sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
452

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

461
	  current_plist = XCDR (XCDR (current_plist));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
462 463 464
	  changed++;
	}

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

477
	      Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
478 479 480 481
	      changed++;
	    }
	  tail2 = this;
	}
482 483

      /* Advance thru TAIL1 one way or the other.  */
484 485
      tail1 = XCDR (tail1);
      if (use_plist && CONSP (tail1))
486
	tail1 = XCDR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
487 488 489 490 491 492 493
    }

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

494
#if 0
Joseph Arceneaux's avatar
Joseph Arceneaux committed
495
/* Remove all properties from interval I.  Return non-zero
496
   if this changes the interval.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
497

Paul Eggert's avatar
Paul Eggert committed
498
static inline int
Andreas Schwab's avatar
Andreas Schwab committed
499
erase_properties (INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
500 501 502 503 504 505 506
{
  if (NILP (i->plist))
    return 0;

  i->plist = Qnil;
  return 1;
}
507
#endif
Joseph Arceneaux's avatar
Joseph Arceneaux committed
508

509
/* Returns the interval of POSITION in OBJECT.
510 511 512
   POSITION is BEG-based.  */

INTERVAL
513
interval_of (ptrdiff_t position, Lisp_Object object)
514 515
{
  register INTERVAL i;
516
  ptrdiff_t beg, end;
517 518 519

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
Karl Heuer's avatar
Karl Heuer committed
520 521
  else if (EQ (object, Qt))
    return NULL_INTERVAL;
522

523
  CHECK_STRING_OR_BUFFER (object);
524 525 526 527 528 529 530 531 532 533 534

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

      beg = BUF_BEGV (b);
      end = BUF_ZV (b);
      i = BUF_INTERVALS (b);
    }
  else
    {
535
      beg = 0;
536 537
      end = SCHARS (object);
      i = STRING_INTERVALS (object);
538 539 540
    }

  if (!(beg <= position && position <= end))
541
    args_out_of_range (make_number (position), make_number (position));
542 543
  if (beg == end || NULL_INTERVAL_P (i))
    return NULL_INTERVAL;
544

545 546 547
  return find_interval (i, position);
}

Paul Eggert's avatar
Paul Eggert committed
548
DEFUN ("text-properties-at", Ftext_properties_at,
Joseph Arceneaux's avatar
Joseph Arceneaux committed
549
       Stext_properties_at, 1, 2, 0,
550
       doc: /* Return the list of properties of the character at POSITION in OBJECT.
551 552 553
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.
554
If POSITION is at the end of OBJECT, the value is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
555
  (Lisp_Object position, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
556 557 558 559
{
  register INTERVAL i;

  if (NILP (object))
560
    XSETBUFFER (object, current_buffer);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
561

562
  i = validate_interval_range (object, &position, &position, soft);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
563 564
  if (NULL_INTERVAL_P (i))
    return Qnil;
565
  /* If POSITION is at the end of the interval,
566 567 568
     it means it's the end of OBJECT.
     There are no properties at the very end,
     since no character follows.  */
569
  if (XINT (position) == LENGTH (i) + i->position)
570
    return Qnil;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
571 572 573 574

  return i->plist;
}

Paul Eggert's avatar
Paul Eggert committed
575
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
576 577 578
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
579
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
580
{
581
  return textget (Ftext_properties_at (position, object), prop);
582 583
}

584
/* Return the value of char's property PROP, in OBJECT at POSITION.
585 586 587 588 589 590 591 592 593 594 595
   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
596
get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
597 598 599
{
  struct window *w = 0;

600
  CHECK_NUMBER_COERCE_MARKER (position);
601 602

  if (NILP (object))
603
    XSETBUFFER (object, current_buffer);
604 605 606 607

  if (WINDOWP (object))
    {
      w = XWINDOW (object);
608
      object = w->buffer;
609 610 611
    }
  if (BUFFERP (object))
    {
612
      ptrdiff_t noverlays;
613
      Lisp_Object *overlay_vec;
614 615
      struct buffer *obuf = current_buffer;

616 617 618 619
      if (XINT (position) < BUF_BEGV (XBUFFER (object))
	  || XINT (position) > BUF_ZV (XBUFFER (object)))
	xsignal1 (Qargs_out_of_range, position);

620
      set_buffer_temp (XBUFFER (object));
621

622
      GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
623 624
      noverlays = sort_overlays (overlay_vec, noverlays, w);

625 626
      set_buffer_temp (obuf);

627 628 629
      /* Now check the overlays in order of decreasing priority.  */
      while (--noverlays >= 0)
	{
630
	  Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
631
	  if (!NILP (tem))
632 633 634 635 636 637
	    {
	      if (overlay)
		/* Return the overlay we got the property from.  */
		*overlay = overlay_vec[noverlays];
	      return tem;
	    }
638 639
	}
    }
640 641 642 643 644

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

645 646
  /* Not a buffer, or no appropriate overlay, so fall through to the
     simpler case.  */
647 648 649
  return Fget_text_property (position, prop, object);
}

Paul Eggert's avatar
Paul Eggert committed
650
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
651
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
652
Both overlay properties and text properties are checked.
653 654 655 656 657 658
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
659
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
660 661
{
  return get_char_property_and_overlay (position, prop, object, 0);
662
}
663 664 665 666

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.
667 668 669
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
670
found, or nil, if it was found as a text property or not found at all.
671

672 673 674 675 676 677
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
678
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
679 680 681 682
{
  Lisp_Object overlay;
  Lisp_Object val
    = get_char_property_and_overlay (position, prop, object, &overlay);
Richard M. Stallman's avatar
Richard M. Stallman committed
683
  return Fcons (val, overlay);
684 685
}

686

Paul Eggert's avatar
Paul Eggert committed
687
DEFUN ("next-char-property-change", Fnext_char_property_change,
688
       Snext_char_property_change, 1, 2, 0,
689
       doc: /* Return the position of next text property or overlay change.
690 691 692
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.
693
If none is found up to (point-max), the function returns (point-max).
694

695
If the optional second argument LIMIT is non-nil, don't search
696 697
past position LIMIT; return LIMIT if nothing is found before LIMIT.
LIMIT is a no-op if it is greater than (point-max).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
698
  (Lisp_Object position, Lisp_Object limit)
699 700 701 702 703 704
{
  Lisp_Object temp;

  temp = Fnext_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
705
      CHECK_NUMBER_COERCE_MARKER (limit);
706 707 708 709 710 711
      if (XINT (limit) < XINT (temp))
	temp = limit;
    }
  return Fnext_property_change (position, Qnil, temp);
}

Paul Eggert's avatar
Paul Eggert committed
712
DEFUN ("previous-char-property-change", Fprevious_char_property_change,
713
       Sprevious_char_property_change, 1, 2, 0,
714
       doc: /* Return the position of previous text property or overlay change.
715 716 717
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.
718
If none is found since (point-min), the function returns (point-min).
719

720
If the optional second argument LIMIT is non-nil, don't search
721 722
past position LIMIT; return LIMIT if nothing is found before LIMIT.
LIMIT is a no-op if it is less than (point-min).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
723
  (Lisp_Object position, Lisp_Object limit)
724 725
{
  Lisp_Object temp;
726

727 728 729
  temp = Fprevious_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
730
      CHECK_NUMBER_COERCE_MARKER (limit);
731 732 733 734 735
      if (XINT (limit) > XINT (temp))
	temp = limit;
    }
  return Fprevious_property_change (position, Qnil, temp);
}
736 737


Paul Eggert's avatar
Paul Eggert committed
738
DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
739
       Snext_single_char_property_change, 2, 4, 0,
740 741 742
       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.
743 744 745 746
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.

747 748 749
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.

750 751 752 753 754
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
755
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
756 757 758
{
  if (STRINGP (object))
    {
759 760
      position = Fnext_single_property_change (position, prop, object, limit);
      if (NILP (position))
761 762
	{
	  if (NILP (limit))
763
	    position = make_number (SCHARS (object));
764
	  else
David Kastrup's avatar
David Kastrup committed
765 766 767 768
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
769 770 771 772 773
	}
    }
  else
    {
      Lisp_Object initial_value, value;
774
      ptrdiff_t count = SPECPDL_INDEX ();
775

776
      if (! NILP (object))
777
	CHECK_BUFFER (object);
778

779 780 781 782 783 784
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}

David Kastrup's avatar
David Kastrup committed
785 786
      CHECK_NUMBER_COERCE_MARKER (position);

787
      initial_value = Fget_char_property (position, prop, object);
788

789
      if (NILP (limit))
790
	XSETFASTINT (limit, ZV);
791
      else
792
	CHECK_NUMBER_COERCE_MARKER (limit);
793

794
      if (XFASTINT (position) >= XFASTINT (limit))
795
	{
796 797 798
	  position = limit;
	  if (XFASTINT (position) > ZV)
	    XSETFASTINT (position, ZV);
799
	}
800 801 802 803 804 805 806 807 808 809 810 811 812 813
      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;
	  }
814 815 816 817

      unbind_to (count, Qnil);
    }

818
  return position;
819 820
}

Paul Eggert's avatar
Paul Eggert committed
821
DEFUN ("previous-single-char-property-change",
822 823
       Fprevious_single_char_property_change,
       Sprevious_single_char_property_change, 2, 4, 0,
824 825 826
       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.
827 828 829 830
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.

831 832 833
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.

834 835 836
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.
837 838
If the optional fourth argument LIMIT is non-nil, don't search back past
position LIMIT; return LIMIT if nothing is found before reaching LIMIT.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
839
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
840 841 842 843 844 845 846
{
  if (STRINGP (object))
    {
      position = Fprevious_single_property_change (position, prop, object, limit);
      if (NILP (position))
	{
	  if (NILP (limit))
847
	    position = make_number (0);
848
	  else
David Kastrup's avatar
David Kastrup committed
849 850 851 852
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
853 854 855 856
	}
    }
  else
    {
857
      ptrdiff_t count = SPECPDL_INDEX ();
858 859

      if (! NILP (object))
860
	CHECK_BUFFER (object);
861

862 863 864 865 866
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}
867

David Kastrup's avatar
David Kastrup committed
868 869
      CHECK_NUMBER_COERCE_MARKER (position);

870
      if (NILP (limit))
871
	XSETFASTINT (limit, BEGV);
872
      else
873
	CHECK_NUMBER_COERCE_MARKER (limit);
874

875
      if (XFASTINT (position) <= XFASTINT (limit))
876 877 878 879 880
	{
	  position = limit;
	  if (XFASTINT (position) < BEGV)
	    XSETFASTINT (position, BEGV);
	}
881
      else
882
	{
883 884 885
	  Lisp_Object initial_value
	    = Fget_char_property (make_number (XFASTINT (position) - 1),
				  prop, object);
886

887
	  while (1)
888 889
	    {
	      position = Fprevious_char_property_change (position, limit);
890

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

		  if (!EQ (value, initial_value))
		    break;
		}
	    }
906 907 908 909 910 911 912
	}

      unbind_to (count, Qnil);
    }

  return position;
}
913

Paul Eggert's avatar
Paul Eggert committed
914
DEFUN ("next-property-change", Fnext_property_change,
915
       Snext_property_change, 1, 3, 0,
916 917 918
       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.
919 920 921
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.
922 923 924 925 926
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
927
  (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
928 929 930
{
  register INTERVAL i, next;

931
  if (NILP (object))
932
    XSETBUFFER (object, current_buffer);
933

934
  if (!NILP (limit) && !EQ (limit, Qt))
935
    CHECK_NUMBER_COERCE_MARKER (limit);
936

937
  i = validate_interval_range (object, &position, &position, soft);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
938

939 940 941 942
  /* If LIMIT is t, return start of next interval--don't
     bother checking further intervals.  */
  if (EQ (limit, Qt))
    {
943 944 945 946
      if (NULL_INTERVAL_P (i))
	next = i;
      else
	next = next_interval (i);
947

948
      if (NULL_INTERVAL_P (next))
949
	XSETFASTINT (position, (STRINGP (object)
950
				? SCHARS (object)
951
				: BUF_ZV (XBUFFER (object))));
952
      else
953
	XSETFASTINT (position, next->position);
954
      return position;
955 956
    }

957 958 959 960 961
  if (NULL_INTERVAL_P (i))
    return limit;

  next = next_interval (i);

962
  while (!NULL_INTERVAL_P (next) && intervals_equal (i, next)
963
	 && (NILP (limit) || next->position < XFASTINT (limit)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
964 965
    next = next_interval (next);

966 967 968 969 970 971 972
  if (NULL_INTERVAL_P (next)
      || (next->position
	  >= (INTEGERP (limit)
	      ? XFASTINT (limit)
	      : (STRINGP (object)
		 ? SCHARS (object)
		 : BUF_ZV (XBUFFER (object))))))
973
    return limit;
974 975
  else
    return make_number (next->position);
976 977
}

Paul Eggert's avatar
Paul Eggert committed
978
DEFUN ("next-single-property-change", Fnext_single_property_change,
979
       Snext_single_property_change, 2, 4, 0,
980 981 982
       doc: /* Return the position of next property 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.
983 984 985
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.
986 987 988 989 990 991
The property values are compared with `eq'.
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 fourth argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
992
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
993 994 995 996
{
  register INTERVAL i, next;
  register Lisp_Object here_val;

997
  if (NILP (object))
998
    XSETBUFFER (object, current_buffer);
999

1000
  if (!NILP (limit))
1001
    CHECK_NUMBER_COERCE_MARKER (limit);
1002

1003
  i = validate_interval_range (object, &position, &position, soft);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1004
  if (NULL_INTERVAL_P (i))
1005
    return limit;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1006

1007
  here_val = textget (i->plist, prop);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1008
  next = next_interval (i);
1009
  while (! NULL_INTERVAL_P (next)
1010
	 && EQ (here_val, textget (next->plist, prop))
1011
	 && (NILP (limit) || next->position