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
#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
static void text_read_only (Lisp_Object) NO_RETURN;
76 77
static Lisp_Object Fprevious_property_change (Lisp_Object, Lisp_Object,
					      Lisp_Object);
78

79 80 81 82 83

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

  xsignal0 (Qtext_read_only);
90 91 92
}


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

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

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

#define soft 0
#define hard 1

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      if (! found)
	return 0;
    }

  return 1;
}

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

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

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

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

  return 0;
}
266 267 268 269

/* 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
270
static inline int
271
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
272 273 274 275
{
  register Lisp_Object tail1, tail2, sym;

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

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

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

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

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

  return Qunbound;
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

423 424
  UNGCPRO;

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

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

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

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

442
  current_plist = i->plist;
443 444

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  return i->plist;
}

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

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

601
  CHECK_NUMBER_COERCE_MARKER (position);
602 603

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

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

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

621
      set_buffer_temp (XBUFFER (object));
622

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

626 627
      set_buffer_temp (obuf);

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

      unbind_to (count, Qnil);
    }

819
  return position;
820 821
}

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

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

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

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

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

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

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

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

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

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

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

      unbind_to (count, Qnil);
    }

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

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

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

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

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

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

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

  next = next_interval (i);

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

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

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

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

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

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

1008
  here_val = textget (i->plist, prop);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1009
  next = next_interval (i);
1010
  while (! NULL_INTERVAL_P (next)