textprop.c 67.6 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
#include "lisp.h"
#include "intervals.h"
23
#include "character.h"
Joseph Arceneaux's avatar
Joseph Arceneaux committed
24
#include "buffer.h"
25
#include "window.h"
26

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

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

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

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

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

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

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

70 71
/* verify_interval_modification saves insertion hooks here
   to be run later by report_interval_modification.  */
72 73
static Lisp_Object interval_insert_behind_hooks;
static Lisp_Object interval_insert_in_front_hooks;
74 75 76 77 78


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

79
static _Noreturn void
80
text_read_only (Lisp_Object propval)
81
{
82 83 84 85
  if (STRINGP (propval))
    xsignal1 (Qtext_read_only, propval);

  xsignal0 (Qtext_read_only);
86 87 88
}


Joseph Arceneaux's avatar
Joseph Arceneaux committed
89

Joseph Arceneaux's avatar
Joseph Arceneaux committed
90 91 92 93 94 95
/* 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
96

97 98 99
   When OBJECT is a string, we increment *BEGIN and *END
   to make them origin-one.

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

#define soft 0
#define hard 1

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

122 123 124
  CHECK_STRING_OR_BUFFER (object);
  CHECK_NUMBER_COERCE_MARKER (*begin);
  CHECK_NUMBER_COERCE_MARKER (*end);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
125 126

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

  if (XINT (*begin) > XINT (*end))
    {
133 134
      Lisp_Object n;
      n = *begin;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
135
      *begin = *end;
136
      *end = n;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
137 138
    }

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

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

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
153 154 155
    }
  else
    {
156
      ptrdiff_t len = SCHARS (object);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
157

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

166
      if (len == 0)
167 168 169
	return NULL_INTERVAL;

      searchpos = XINT (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
170 171 172 173
    }

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

175
  return find_interval (i, searchpos);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
176 177 178 179
}

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

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

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

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

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

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

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

      if (! found)
	return 0;
    }

  return 1;
}

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

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

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

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

  return 0;
}
262 263 264 265

/* 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
266
static inline int
267
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
268 269 270 271
{
  register Lisp_Object tail1, tail2, sym;

  /* Go through each element of LIST.  */
272
  for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
273
    {
274
      sym = XCAR (tail1);
275 276

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

  return 0;
}
284

285 286 287 288
/* Changing the plists of individual intervals.  */

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

  while (PLIST_ELT_P (plist, value))
295 296
    if (EQ (XCAR (plist), prop))
      return XCAR (value);
297
    else
298
      plist = XCDR (value);
299 300 301 302

  return Qunbound;
}

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

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

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

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

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

348 349
   OBJECT should be the string or buffer the interval is in.

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

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

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

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

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

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

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

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

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

419 420
  UNGCPRO;

Joseph Arceneaux's avatar
Joseph Arceneaux committed
421 422 423
  return changed;
}

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

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

435 436
  /* Nonzero means tail1 is a plist, otherwise it is a list.  */
  int use_plist;
437

438
  current_plist = i->plist;
439 440

  if (! NILP (plist))
441
    tail1 = plist, use_plist = 1;
442
  else
443
    tail1 = list, use_plist = 0;
444 445

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

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

458
	  current_plist = XCDR (XCDR (current_plist));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
459 460 461
	  changed++;
	}

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

474
	      Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
Joseph Arceneaux's avatar
Joseph Arceneaux committed
475 476 477 478
	      changed++;
	    }
	  tail2 = this;
	}
479 480

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

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

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

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

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

INTERVAL
510
interval_of (ptrdiff_t position, Lisp_Object object)
511 512
{
  register INTERVAL i;
513
  ptrdiff_t beg, end;
514 515 516

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
Karl Heuer's avatar
Karl Heuer committed
517 518
  else if (EQ (object, Qt))
    return NULL_INTERVAL;
519

520
  CHECK_STRING_OR_BUFFER (object);
521 522 523 524 525 526 527 528 529 530 531

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

      beg = BUF_BEGV (b);
      end = BUF_ZV (b);
      i = BUF_INTERVALS (b);
    }
  else
    {
532
      beg = 0;
533 534
      end = SCHARS (object);
      i = STRING_INTERVALS (object);
535 536 537
    }

  if (!(beg <= position && position <= end))
538
    args_out_of_range (make_number (position), make_number (position));
539 540
  if (beg == end || NULL_INTERVAL_P (i))
    return NULL_INTERVAL;
541

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

  if (NILP (object))
557
    XSETBUFFER (object, current_buffer);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
558

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

  return i->plist;
}

Paul Eggert's avatar
Paul Eggert committed
572
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
573 574 575
       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
576
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
577
{
578
  return textget (Ftext_properties_at (position, object), prop);
579 580
}

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

597
  CHECK_NUMBER_COERCE_MARKER (position);
598 599

  if (NILP (object))
600
    XSETBUFFER (object, current_buffer);
601 602 603 604

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

613 614 615 616
      if (XINT (position) < BUF_BEGV (XBUFFER (object))
	  || XINT (position) > BUF_ZV (XBUFFER (object)))
	xsignal1 (Qargs_out_of_range, position);

617
      set_buffer_temp (XBUFFER (object));
618

619
      GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
620 621
      noverlays = sort_overlays (overlay_vec, noverlays, w);

622 623
      set_buffer_temp (obuf);

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

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

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

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

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

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

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

692
If the optional second argument LIMIT is non-nil, don't search
693 694
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
695
  (Lisp_Object position, Lisp_Object limit)
696 697 698 699 700 701
{
  Lisp_Object temp;

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

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

717
If the optional second argument LIMIT is non-nil, don't search
718 719
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
720
  (Lisp_Object position, Lisp_Object limit)
721 722
{
  Lisp_Object temp;
723

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


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

744 745 746
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.

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

773
      if (! NILP (object))
774
	CHECK_BUFFER (object);
775

776 777 778 779 780 781
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}

David Kastrup's avatar
David Kastrup committed
782 783
      CHECK_NUMBER_COERCE_MARKER (position);

784
      initial_value = Fget_char_property (position, prop, object);
785

786
      if (NILP (limit))
787
	XSETFASTINT (limit, ZV);
788
      else
789
	CHECK_NUMBER_COERCE_MARKER (limit);
790

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

      unbind_to (count, Qnil);
    }

815
  return position;
816 817
}

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

828 829 830
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.

831 832 833
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.
834 835
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
836
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
837 838 839 840 841 842 843
{
  if (STRINGP (object))
    {
      position = Fprevious_single_property_change (position, prop, object, limit);
      if (NILP (position))
	{
	  if (NILP (limit))
844
	    position = make_number (0);
845
	  else
David Kastrup's avatar
David Kastrup committed
846 847 848 849
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
850 851 852 853
	}
    }
  else
    {
854
      ptrdiff_t count = SPECPDL_INDEX ();
855 856

      if (! NILP (object))
857
	CHECK_BUFFER (object);
858

859 860 861 862 863
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}
864

David Kastrup's avatar
David Kastrup committed
865 866
      CHECK_NUMBER_COERCE_MARKER (position);

867
      if (NILP (limit))
868
	XSETFASTINT (limit, BEGV);
869
      else
870
	CHECK_NUMBER_COERCE_MARKER (limit);
871

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

884
	  while (1)
885 886
	    {
	      position = Fprevious_char_property_change (position, limit);
887

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

		  if (!EQ (value, initial_value))
		    break;
		}
	    }
903 904 905 906 907 908 909
	}

      unbind_to (count, Qnil);
    }

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

928
  if (NILP (object))
929
    XSETBUFFER (object, current_buffer);
930

931
  if (!NILP (limit) && !EQ (limit, Qt))
932
    CHECK_NUMBER_COERCE_MARKER (limit);
933

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

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

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

954 955 956 957 958
  if (NULL_INTERVAL_P (i))
    return limit;

  next = next_interval (i);

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

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

Paul Eggert's avatar
Paul Eggert committed
975
DEFUN ("next-single-property-change", Fnext_single_property_change,
976
       Snext_single_property_change, 2, 4, 0,
977 978 979
       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.
980 981 982
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.
983 984 985 986 987 988
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
989
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
990 991 992 993
{
  register INTERVAL i, next;
  register Lisp_Object here_val;

994
  if (NILP (object))
995
    XSETBUFFER (object, current_buffer);
996

997
  if (!NILP (limit))
998
    CHECK_NUMBER_COERCE_MARKER (limit);
999

1000
  i = validate_interval_range (object, &position, &position, soft);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1001
  if (NULL_INTERVAL_P (i))
1002
    return limit;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1003

1004
  here_val = textget (i->plist, prop);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1005
  next = next_interval (i);
1006
  while (! NULL_INTERVAL_P (next)
1007
	 && EQ (here_val, textget (next->plist, prop))
1008
	 && (NILP (limit)