textprop.c 69.2 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
  EMACS_INT searchpos;
129

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
      EMACS_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
{
  register INTERVAL i;
522
  EMACS_INT beg, end;
523 524 525

  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
If POSITION is at the end of OBJECT, the value is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
561
  (Lisp_Object position, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
562 563 564 565
{
  register INTERVAL i;

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

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

  return i->plist;
}

581
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
582 583 584
       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
585
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
586
{
587
  return textget (Ftext_properties_at (position, object), prop);
588 589
}

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

606
  CHECK_NUMBER_COERCE_MARKER (position);
607 608

  if (NILP (object))
609
    XSETBUFFER (object, current_buffer);
610 611 612 613

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

622 623 624 625
      if (XINT (position) < BUF_BEGV (XBUFFER (object))
	  || XINT (position) > BUF_ZV (XBUFFER (object)))
	xsignal1 (Qargs_out_of_range, position);

626
      set_buffer_temp (XBUFFER (object));
627

628
      GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
629 630
      noverlays = sort_overlays (overlay_vec, noverlays, w);

631 632
      set_buffer_temp (obuf);

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

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

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

DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
657
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
658
Both overlay properties and text properties are checked.
659 660 661 662 663 664
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
665
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
666 667
{
  return get_char_property_and_overlay (position, prop, object, 0);
668
}
669 670 671 672

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.
673 674 675
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
676
found, or nil, if it was found as a text property or not found at all.
677

678 679 680 681 682 683
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
684
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
685 686 687 688
{
  Lisp_Object overlay;
  Lisp_Object val
    = get_char_property_and_overlay (position, prop, object, &overlay);
Richard M. Stallman's avatar
Richard M. Stallman committed
689
  return Fcons (val, overlay);
690 691
}

692 693 694

DEFUN ("next-char-property-change", Fnext_char_property_change,
       Snext_char_property_change, 1, 2, 0,
695
       doc: /* Return the position of next text property or overlay change.
696 697 698
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.
699
If none is found up to (point-max), the function returns (point-max).
700

701
If the optional second argument LIMIT is non-nil, don't search
702 703
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
704
  (Lisp_Object position, Lisp_Object limit)
705 706 707 708 709 710
{
  Lisp_Object temp;

  temp = Fnext_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
711
      CHECK_NUMBER_COERCE_MARKER (limit);
712 713 714 715 716 717 718 719
      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,
720
       doc: /* Return the position of previous text property or overlay change.
721 722 723
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.
724
If none is found since (point-min), the function returns (point-min).
725

726
If the optional second argument LIMIT is non-nil, don't search
727 728
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
729
  (Lisp_Object position, Lisp_Object limit)
730 731
{
  Lisp_Object temp;
732

733 734 735
  temp = Fprevious_overlay_change (position);
  if (! NILP (limit))
    {
David Kastrup's avatar
David Kastrup committed
736
      CHECK_NUMBER_COERCE_MARKER (limit);
737 738 739 740 741
      if (XINT (limit) > XINT (temp))
	temp = limit;
    }
  return Fprevious_property_change (position, Qnil, temp);
}
742 743


744 745
DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
       Snext_single_char_property_change, 2, 4, 0,
746 747 748
       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.
749 750 751 752
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.

753 754 755
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.

756 757 758 759 760
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
761
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
762 763 764
{
  if (STRINGP (object))
    {
765 766
      position = Fnext_single_property_change (position, prop, object, limit);
      if (NILP (position))
767 768
	{
	  if (NILP (limit))
769
	    position = make_number (SCHARS (object));
770
	  else
David Kastrup's avatar
David Kastrup committed
771 772 773 774
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
775 776 777 778 779
	}
    }
  else
    {
      Lisp_Object initial_value, value;
Juanma Barranquero's avatar
Juanma Barranquero committed
780
      int count = SPECPDL_INDEX ();
781

782
      if (! NILP (object))
783
	CHECK_BUFFER (object);
784

785 786 787 788 789 790
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}

David Kastrup's avatar
David Kastrup committed
791 792
      CHECK_NUMBER_COERCE_MARKER (position);

793
      initial_value = Fget_char_property (position, prop, object);
794

795
      if (NILP (limit))
796
	XSETFASTINT (limit, ZV);
797
      else
798
	CHECK_NUMBER_COERCE_MARKER (limit);
799

800
      if (XFASTINT (position) >= XFASTINT (limit))
801
	{
802 803 804
	  position = limit;
	  if (XFASTINT (position) > ZV)
	    XSETFASTINT (position, ZV);
805
	}
806 807 808 809 810 811 812 813 814 815 816 817 818 819
      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;
	  }
820 821 822 823

      unbind_to (count, Qnil);
    }

824
  return position;
825 826
}

827 828 829
DEFUN ("previous-single-char-property-change",
       Fprevious_single_char_property_change,
       Sprevious_single_char_property_change, 2, 4, 0,
830 831 832
       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.
833 834 835 836
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.

837 838 839
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.

840 841 842 843 844
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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
845
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
846 847 848 849 850 851 852
{
  if (STRINGP (object))
    {
      position = Fprevious_single_property_change (position, prop, object, limit);
      if (NILP (position))
	{
	  if (NILP (limit))
853
	    position = make_number (0);
854
	  else
David Kastrup's avatar
David Kastrup committed
855 856 857 858
	    {
	      CHECK_NUMBER (limit);
	      position = limit;
	    }
859 860 861 862
	}
    }
  else
    {
Juanma Barranquero's avatar
Juanma Barranquero committed
863
      int count = SPECPDL_INDEX ();
864 865

      if (! NILP (object))
866
	CHECK_BUFFER (object);
867

868 869 870 871 872
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
	  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
	  Fset_buffer (object);
	}
873

David Kastrup's avatar
David Kastrup committed
874 875
      CHECK_NUMBER_COERCE_MARKER (position);

876
      if (NILP (limit))
877
	XSETFASTINT (limit, BEGV);
878
      else
879
	CHECK_NUMBER_COERCE_MARKER (limit);
880

881
      if (XFASTINT (position) <= XFASTINT (limit))
882 883 884 885 886
	{
	  position = limit;
	  if (XFASTINT (position) < BEGV)
	    XSETFASTINT (position, BEGV);
	}
887
      else
888
	{
889 890 891
	  Lisp_Object initial_value
	    = Fget_char_property (make_number (XFASTINT (position) - 1),
				  prop, object);
892

893
	  while (1)
894 895
	    {
	      position = Fprevious_char_property_change (position, limit);
896

897 898 899 900 901 902 903
	      if (XFASTINT (position) <= XFASTINT (limit))
		{
		  position = limit;
		  break;
		}
	      else
		{
904 905 906
		  Lisp_Object value
		    = Fget_char_property (make_number (XFASTINT (position) - 1),
					  prop, object);
907 908 909 910 911

		  if (!EQ (value, initial_value))
		    break;
		}
	    }
912 913 914 915 916 917 918
	}

      unbind_to (count, Qnil);
    }

  return position;
}
919

Joseph Arceneaux's avatar
Joseph Arceneaux committed
920
DEFUN ("next-property-change", Fnext_property_change,
921
       Snext_property_change, 1, 3, 0,
922 923 924
       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.
925 926 927
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.
928 929 930 931 932
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
933
  (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
934 935 936
{
  register INTERVAL i, next;

937
  if (NILP (object))
938
    XSETBUFFER (object, current_buffer);
939