textprop.c 73.7 KB
Newer Older
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1
/* Interface code for dealing with text properties.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1993-1995, 1997, 1999-2020 Free Software Foundation,
3
   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 <https://www.gnu.org/licenses/>.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
19

20
#include <config.h>
21

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 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

47 48 49 50 51 52 53
enum property_set_type
{
  TEXT_PROPERTY_REPLACE,
  TEXT_PROPERTY_PREPEND,
  TEXT_PROPERTY_APPEND
};

54 55
/* If o1 is a cons whose cdr is a cons, return true and set o2 to
   the o1's cdr.  Otherwise, return false.  This is handy for
56
   traversing plists.  */
57
#define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
58

59 60
/* verify_interval_modification saves insertion hooks here
   to be run later by report_interval_modification.  */
61 62
Lisp_Object interval_insert_behind_hooks;
Lisp_Object interval_insert_in_front_hooks;
63 64 65 66

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

67
static AVOID
68
text_read_only (Lisp_Object propval)
69
{
70 71 72 73
  if (STRINGP (propval))
    xsignal1 (Qtext_read_only, propval);

  xsignal0 (Qtext_read_only);
74 75
}

76
/* Prepare to modify the text properties of BUFFER from START to END.  */
77 78

static void
79
modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
80
{
Tom Tromey's avatar
Tom Tromey committed
81
  ptrdiff_t b = XFIXNUM (start), e = XFIXNUM (end);
82 83 84
  struct buffer *buf = XBUFFER (buffer), *old = current_buffer;

  set_buffer_internal (buf);
85 86 87 88 89 90

  prepare_to_modify_buffer_1 (b, e, NULL);

  BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
  if (MODIFF <= SAVE_MODIFF)
    record_first_change ();
91
  modiff_incr (&MODIFF);
92 93 94

  bset_point_before_scroll (current_buffer, Qnil);

95 96
  set_buffer_internal (old);
}
97

98 99 100 101 102 103 104 105
/* Complain if object is not string or buffer type.  */

static void
CHECK_STRING_OR_BUFFER (Lisp_Object x)
{
  CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
}

Joseph Arceneaux's avatar
Joseph Arceneaux committed
106 107 108 109 110 111
/* 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
112 113 114 115 116 117 118 119 120

   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.

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

126
enum { soft = false, hard = true };
Joseph Arceneaux's avatar
Joseph Arceneaux committed
127

Gerd Moellmann's avatar
Gerd Moellmann committed
128
INTERVAL
129 130
validate_interval_range (Lisp_Object object, Lisp_Object *begin,
			 Lisp_Object *end, bool force)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
131
{
132
  INTERVAL i;
133
  ptrdiff_t searchpos;
134
  Lisp_Object begin0 = *begin, end0 = *end;
135

136
  CHECK_STRING_OR_BUFFER (object);
137 138
  CHECK_FIXNUM_COERCE_MARKER (*begin);
  CHECK_FIXNUM_COERCE_MARKER (*end);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
139 140

  /* If we are asked for a point, but from a subr which operates
141
     on a range, then return nothing.  */
142
  if (EQ (*begin, *end) && begin != end)
Dmitry Antipov's avatar
Dmitry Antipov committed
143
    return NULL;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
144

Tom Tromey's avatar
Tom Tromey committed
145
  if (XFIXNUM (*begin) > XFIXNUM (*end))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
146
    {
147 148
      Lisp_Object n;
      n = *begin;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
149
      *begin = *end;
150
      *end = n;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
151 152
    }

153
  if (BUFFERP (object))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
154 155 156
    {
      register struct buffer *b = XBUFFER (object);

Tom Tromey's avatar
Tom Tromey committed
157 158
      if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
	    && XFIXNUM (*end) <= BUF_ZV (b)))
159
	args_out_of_range (begin0, end0);
160
      i = buffer_intervals (b);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
161

162
      /* If there's no text, there are no properties.  */
163
      if (BUF_BEGV (b) == BUF_ZV (b))
Dmitry Antipov's avatar
Dmitry Antipov committed
164
	return NULL;
165

Tom Tromey's avatar
Tom Tromey committed
166
      searchpos = XFIXNUM (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
167 168 169
    }
  else
    {
170
      ptrdiff_t len = SCHARS (object);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
171

Tom Tromey's avatar
Tom Tromey committed
172 173
      if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
	     && XFIXNUM (*end) <= len))
174
	args_out_of_range (begin0, end0);
175
      i = string_intervals (object);
176

177
      if (len == 0)
Dmitry Antipov's avatar
Dmitry Antipov committed
178
	return NULL;
179

Tom Tromey's avatar
Tom Tromey committed
180
      searchpos = XFIXNUM (*begin);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
181 182
    }

Dmitry Antipov's avatar
Dmitry Antipov committed
183
  if (!i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
184
    return (force ? create_root_interval (object) : i);
185

186
  return find_interval (i, searchpos);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
187 188 189 190
}

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

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

  if (CONSP (list))
    {
201 202
      Lisp_Object tail = list;
      do
203
	{
204 205 206 207
	  tail = XCDR (tail);
	  if (! CONSP (tail))
	    error ("Odd length text property list");
	  tail = XCDR (tail);
Paul Eggert's avatar
Paul Eggert committed
208
	  maybe_quit ();
209
	}
210 211
      while (CONSP (tail));

Joseph Arceneaux's avatar
Joseph Arceneaux committed
212 213 214
      return list;
    }

215
  return list2 (list, Qnil);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
216 217
}

Paul Eggert's avatar
Paul Eggert committed
218
/* Return true if interval I has all the properties,
219
   with the same values, of list PLIST.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
220

Paul Eggert's avatar
Paul Eggert committed
221
static bool
222
interval_has_all_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
223
{
Paul Eggert's avatar
Paul Eggert committed
224
  Lisp_Object tail1, tail2;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
225

226
  /* Go through each element of PLIST.  */
227
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
228
    {
Paul Eggert's avatar
Paul Eggert committed
229
      Lisp_Object sym1 = XCAR (tail1);
230
      bool found = false;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
231 232

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

241
	    /* Property has same value on both lists; go to next one.  */
242
	    found = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
243 244 245 246
	    break;
	  }

      if (! found)
247
	return false;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
248 249
    }

250
  return true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
251 252
}

Paul Eggert's avatar
Paul Eggert committed
253
/* Return true if the plist of interval I has any of the
254
   properties of PLIST, regardless of their values.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
255

Paul Eggert's avatar
Paul Eggert committed
256
static bool
257
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
258
{
Paul Eggert's avatar
Paul Eggert committed
259
  Lisp_Object tail1, tail2, sym;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
260

261
  /* Go through each element of PLIST.  */
262
  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
263
    {
264
      sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
265 266

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

272
  return false;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
273
}
274

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

Paul Eggert's avatar
Paul Eggert committed
278
static bool
279
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
280
{
Paul Eggert's avatar
Paul Eggert committed
281
  Lisp_Object tail1, tail2, sym;
282 283

  /* Go through each element of LIST.  */
284
  for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
285
    {
286
      sym = XCAR (tail1);
287 288

      /* Go through i's plist, looking for tail1 */
289
      for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
290
	if (EQ (sym, XCAR (tail2)))
291
	  return true;
292 293
    }

294
  return false;
295
}
296

297 298 299 300
/* Changing the plists of individual intervals.  */

/* Return the value of PROP in property-list PLIST, or Qunbound if it
   has none.  */
301
static Lisp_Object
302
property_value (Lisp_Object plist, Lisp_Object prop)
303 304 305 306
{
  Lisp_Object value;

  while (PLIST_ELT_P (plist, value))
307 308
    if (EQ (XCAR (plist), prop))
      return XCAR (value);
309
    else
310
      plist = XCDR (value);
311 312 313 314

  return Qunbound;
}

315 316 317 318 319
/* 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
320
set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
321
{
322
  Lisp_Object sym, value;
323

324
  if (BUFFERP (object))
325
    {
326 327 328 329
      /* 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);
330 331 332
	   sym = XCDR (value))
	if (! EQ (property_value (properties, XCAR (sym)),
		  XCAR (value)))
333 334
	  {
	    record_property_change (interval->position, LENGTH (interval),
335
				    XCAR (sym), XCAR (value),
336 337
				    object);
	  }
338 339 340 341 342

      /* 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);
343 344
	   sym = XCDR (value))
	if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
345 346
	  {
	    record_property_change (interval->position, LENGTH (interval),
347
				    XCAR (sym), Qnil,
348 349
				    object);
	  }
350 351 352
    }

  /* Store new properties.  */
353
  set_interval_plist (interval, Fcopy_sequence (properties));
354
}
Joseph Arceneaux's avatar
Joseph Arceneaux committed
355 356 357 358 359

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

360 361
   OBJECT should be the string or buffer the interval is in.

362 363 364
   If DESTRUCTIVE, the function is allowed to reuse list values in the
   properties.

Paul Eggert's avatar
Paul Eggert committed
365
   Return true if this changes I (i.e., if any members of PLIST
Joseph Arceneaux's avatar
Joseph Arceneaux committed
366 367
   are actually added to I's plist) */

Paul Eggert's avatar
Paul Eggert committed
368
static bool
369
add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
370
		enum property_set_type set_type, bool destructive)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
371
{
372
  Lisp_Object tail1, tail2, sym1, val1;
373
  bool changed = false;
374 375 376 377

  tail1 = plist;
  sym1 = Qnil;
  val1 = Qnil;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
378

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

      /* Go through I's plist, looking for sym1 */
387 388
      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
	if (EQ (sym1, XCAR (tail2)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
389
	  {
390
	    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.  */
394
	    found = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
395 396

	    /* 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
	    /* I's property has a different value -- change it */
409 410 411 412 413 414 415 416 417 418 419 420
	    if (set_type == TEXT_PROPERTY_REPLACE)
	      Fsetcar (this_cdr, val1);
	    else {
	      if (CONSP (Fcar (this_cdr)) &&
		  /* Special-case anonymous face properties. */
		  (! EQ (sym1, Qface) ||
		   NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
		/* The previous value is a list, so prepend (or
		   append) the new value to this list. */
		if (set_type == TEXT_PROPERTY_PREPEND)
		  Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
		else
421 422 423 424 425 426 427 428 429
		  {
		    /* Appending. */
		    if (destructive)
		      nconc2 (Fcar (this_cdr), list1 (val1));
		    else
		      Fsetcar (this_cdr, CALLN (Fappend,
						Fcar (this_cdr),
						list1 (val1)));
		  }
430 431 432 433
	      else {
		/* The previous value is a single value, so make it
		   into a list. */
		if (set_type == TEXT_PROPERTY_PREPEND)
434
		  Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
435
		else
436
		  Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
437 438
	      }
	    }
439
	    changed = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
440 441 442 443 444
	    break;
	  }

      if (! found)
	{
445
	  /* Record this change in the buffer, for undo purposes.  */
446
	  if (BUFFERP (object))
447
	    {
448 449
	      record_property_change (i->position, LENGTH (i),
				      sym1, Qnil, object);
450
	    }
451
	  set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
452
	  changed = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
453 454 455 456 457 458
	}
    }

  return changed;
}

459 460 461
/* 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.)
462
   OBJECT is the string or buffer containing I.  */
Joseph Arceneaux's avatar
Joseph Arceneaux committed
463

Paul Eggert's avatar
Paul Eggert committed
464
static bool
465
remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
466
{
467
  bool changed = false;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
468

Paul Eggert's avatar
Paul Eggert committed
469
  /* True means tail1 is a plist, otherwise it is a list.  */
470 471
  bool use_plist = ! NILP (plist);
  Lisp_Object tail1 = use_plist ? plist : list;
472

473
  Lisp_Object current_plist = i->plist;
474 475

  /* Go through each element of LIST or PLIST.  */
476
  while (CONSP (tail1))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
477
    {
478
      Lisp_Object sym = XCAR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
479

480
      /* First, remove the symbol if it's at the head of the list */
481
      while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
482
	{
483
	  if (BUFFERP (object))
484 485 486
	    record_property_change (i->position, LENGTH (i),
				    sym, XCAR (XCDR (current_plist)),
				    object);
487

488
	  current_plist = XCDR (XCDR (current_plist));
489
	  changed = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
490 491
	}

492
      /* Go through I's plist, looking for SYM.  */
493
      Lisp_Object tail2 = current_plist;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
494 495
      while (! NILP (tail2))
	{
496
	  Lisp_Object this = XCDR (XCDR (tail2));
497
	  if (CONSP (this) && EQ (sym, XCAR (this)))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
498
	    {
499
	      if (BUFFERP (object))
500 501
		record_property_change (i->position, LENGTH (i),
					sym, XCAR (XCDR (this)), object);
502

503
	      Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
504
	      changed = true;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
505 506 507
	    }
	  tail2 = this;
	}
508 509

      /* Advance thru TAIL1 one way or the other.  */
510 511
      tail1 = XCDR (tail1);
      if (use_plist && CONSP (tail1))
512
	tail1 = XCDR (tail1);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
513 514 515
    }

  if (changed)
516
    set_interval_plist (i, current_plist);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
517 518 519
  return changed;
}

520
/* Returns the interval of POSITION in OBJECT.
521 522 523
   POSITION is BEG-based.  */

INTERVAL
524
interval_of (ptrdiff_t position, Lisp_Object object)
525 526
{
  register INTERVAL i;
527
  ptrdiff_t beg, end;
528 529 530

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
Karl Heuer's avatar
Karl Heuer committed
531
  else if (EQ (object, Qt))
Dmitry Antipov's avatar
Dmitry Antipov committed
532
    return NULL;
533

534
  CHECK_STRING_OR_BUFFER (object);
535 536 537 538 539 540 541

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

      beg = BUF_BEGV (b);
      end = BUF_ZV (b);
542
      i = buffer_intervals (b);
543 544 545
    }
  else
    {
546
      beg = 0;
547
      end = SCHARS (object);
548
      i = string_intervals (object);
549 550 551
    }

  if (!(beg <= position && position <= end))
552
    args_out_of_range (make_fixnum (position), make_fixnum (position));
Dmitry Antipov's avatar
Dmitry Antipov committed
553 554
  if (beg == end || !i)
    return NULL;
555

556 557 558
  return find_interval (i, position);
}

Paul Eggert's avatar
Paul Eggert committed
559
DEFUN ("text-properties-at", Ftext_properties_at,
Joseph Arceneaux's avatar
Joseph Arceneaux committed
560
       Stext_properties_at, 1, 2, 0,
561
       doc: /* Return the list of properties of the character at POSITION in OBJECT.
562 563 564
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.
565 566 567
If POSITION is at the end of OBJECT, the value is nil.

If you want to display the text properties at point in a human-readable
568
form, use the `describe-text-properties' command.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
569
  (Lisp_Object position, Lisp_Object object)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
570 571 572 573
{
  register INTERVAL i;

  if (NILP (object))
574
    XSETBUFFER (object, current_buffer);
Joseph Arceneaux's avatar
Joseph Arceneaux committed
575

576
  i = validate_interval_range (object, &position, &position, soft);
Dmitry Antipov's avatar
Dmitry Antipov committed
577
  if (!i)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
578
    return Qnil;
579
  /* If POSITION is at the end of the interval,
580 581 582
     it means it's the end of OBJECT.
     There are no properties at the very end,
     since no character follows.  */
Tom Tromey's avatar
Tom Tromey committed
583
  if (XFIXNUM (position) == LENGTH (i) + i->position)
584
    return Qnil;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
585 586 587 588

  return i->plist;
}

Paul Eggert's avatar
Paul Eggert committed
589
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
590
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
591 592
OBJECT should be a buffer or a string; if omitted or nil, it defaults
to the current buffer.
593
If POSITION is at the end of OBJECT, the value is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
594
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
595
{
596
  return textget (Ftext_properties_at (position, object), prop);
597 598
}

599
/* Return the value of char's property PROP, in OBJECT at POSITION.
600 601 602 603 604 605 606 607 608 609 610
   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
611
get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
612 613 614
{
  struct window *w = 0;

615
  EMACS_INT pos = fix_position (position);
616 617

  if (NILP (object))
618
    XSETBUFFER (object, current_buffer);
619 620 621

  if (WINDOWP (object))
    {
622
      CHECK_LIVE_WINDOW (object);
623
      w = XWINDOW (object);
624
      object = w->contents;
625 626 627
    }
  if (BUFFERP (object))
    {
628
      ptrdiff_t noverlays;
629
      Lisp_Object *overlay_vec;
630 631
      struct buffer *obuf = current_buffer;

632 633
      if (! (BUF_BEGV (XBUFFER (object)) <= pos
	     && pos <= BUF_ZV (XBUFFER (object))))
634 635
	xsignal1 (Qargs_out_of_range, position);

636
      set_buffer_temp (XBUFFER (object));
637

638
      USE_SAFE_ALLOCA;
639
      GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
640 641
      noverlays = sort_overlays (overlay_vec, noverlays, w);

642 643
      set_buffer_temp (obuf);

644 645 646
      /* Now check the overlays in order of decreasing priority.  */
      while (--noverlays >= 0)
	{
647
	  Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
648
	  if (!NILP (tem))
649 650 651 652
	    {
	      if (overlay)
		/* Return the overlay we got the property from.  */
		*overlay = overlay_vec[noverlays];
653
	      SAFE_FREE ();
654 655
	      return tem;
	    }
656
	}
657
      SAFE_FREE ();
658
    }
659 660 661 662 663

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

664 665
  /* Not a buffer, or no appropriate overlay, so fall through to the
     simpler case.  */
666
  return Fget_text_property (make_fixnum (pos), prop, object);
667 668
}

Paul Eggert's avatar
Paul Eggert committed
669
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
670
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
671
Both overlay properties and text properties are checked.
672 673 674 675 676 677
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
678
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
679 680
{
  return get_char_property_and_overlay (position, prop, object, 0);
681
}
682 683 684 685

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.
686 687 688
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
689
found, or nil, if it was found as a text property or not found at all.
690

691 692 693 694 695 696
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
697
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
698 699 700 701
{
  Lisp_Object overlay;
  Lisp_Object val
    = get_char_property_and_overlay (position, prop, object, &overlay);
Richard M. Stallman's avatar
Richard M. Stallman committed
702
  return Fcons (val, overlay);
703 704
}

705

Paul Eggert's avatar
Paul Eggert committed
706
DEFUN ("next-char-property-change", Fnext_char_property_change,
707
       Snext_char_property_change, 1, 2, 0,
708
       doc: /* Return the position of next text property or overlay change.
709 710 711
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.
712 713
If none is found, and LIMIT is nil or omitted, the function
returns (point-max).
714

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

  temp = Fnext_overlay_change (position);
  if (! NILP (limit))
    {
725
      CHECK_FIXNUM_COERCE_MARKER (limit);
Tom Tromey's avatar
Tom Tromey committed
726
      if (XFIXNUM (limit) < XFIXNUM (temp))
727 728 729 730 731
	temp = limit;
    }
  return Fnext_property_change (position, Qnil, temp);
}

Paul Eggert's avatar
Paul Eggert committed
732
DEFUN ("previous-char-property-change", Fprevious_char_property_change,
733
       Sprevious_char_property_change, 1, 2, 0,
734
       doc: /* Return the position of previous text property or overlay change.
735 736 737
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.
Paul Eggert's avatar
Paul Eggert committed
738
If none is found, and LIMIT is nil or omitted, the function
739
returns (point-min).
740

741 742 743
If the optional second argument LIMIT is non-nil, the function doesn't
search before position LIMIT, and returns 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
744
  (Lisp_Object position, Lisp_Object limit)
745 746
{
  Lisp_Object temp;
747

748 749 750
  temp = Fprevious_overlay_change (position);
  if (! NILP (limit))
    {
751
      CHECK_FIXNUM_COERCE_MARKER (limit);
Tom Tromey's avatar
Tom Tromey committed
752
      if (XFIXNUM (limit) > XFIXNUM (temp))
753 754 755 756
	temp = limit;
    }
  return Fprevious_property_change (position, Qnil, temp);
}
757 758


Paul Eggert's avatar
Paul Eggert committed
759
DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
760
       Snext_single_char_property_change, 2, 4, 0,
761 762 763
       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.
764 765 766 767
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.

768
In a string, scan runs to the end of the string, unless LIMIT is non-nil.
769
In a buffer, scan runs to end of buffer, unless LIMIT is non-nil.
770 771
If the optional fourth argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.
772 773
However, if OBJECT is a buffer and LIMIT is beyond the end of the
buffer, this function returns `point-max', not LIMIT.
774

775
The property values are compared with `eq'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
776
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
777 778 779
{
  if (STRINGP (object))
    {
780 781
      position = Fnext_single_property_change (position, prop, object, limit);
      if (NILP (position))
782 783
	{
	  if (NILP (limit))
784
	    position = make_fixnum (SCHARS (object));
785
	  else
David Kastrup's avatar
David Kastrup committed
786
	    {
787
	      CHECK_FIXNUM (limit);
David Kastrup's avatar
David Kastrup committed
788 789
	      position = limit;
	    }
790 791 792 793 794
	}
    }
  else
    {
      Lisp_Object initial_value, value;
795
      ptrdiff_t count = SPECPDL_INDEX ();
796

797
      if (! NILP (object))
798
	CHECK_BUFFER (object);
799

800 801
      if (BUFFERP (object) && current_buffer != XBUFFER (object))
	{
802
	  record_unwind_current_buffer ();
803 804 805
	  Fset_buffer (object);
	}

806
      CHECK_FIXNUM_COERCE_MARKER (position);
David Kastrup's avatar
David Kastrup committed
807

808
      initial_value = Fget_char_property (position, prop, object);
809

810
      if (NILP (limit))
811
	XSETFASTINT (limit, ZV);
812
      else
813
	CHECK_FIXNUM_COERCE_MARKER (limit);
814

815
      if (XFIXNUM (position) >= XFIXNUM (limit))
816
	{
817
	  position = limit;
818
	  if (XFIXNUM (position) > ZV)
819
	    XSETFASTINT (position, ZV);
820
	}
821
      else
822
	while (true)
823 824
	  {
	    position = Fnext_char_property_change (position, limit);
Tom Tromey's avatar
Tom Tromey committed
825
	    if (XFIXNAT (position) >= XFIXNAT (limit))
826 827 828 829 830 831 832 833
	      {
		position = limit;
		break;
	      }

	    value = Fget_char_property (position, prop, object);
	    if (!EQ (value, initial_value))
	      break;
834 835 836

	    if (XFIXNAT (position) >= ZV)
	      break;
837
	  }
838

Paul Eggert's avatar
Paul Eggert committed
839
      position = unbind_to (count, position);
840 841
    }

842
  return position;
843 844
}

Paul Eggert's avatar
Paul Eggert committed
845
DEFUN ("previous-single-char-property-change",
846 847
       Fprevious_single_char_property_change,
       Sprevious_single_char_property_change, 2, 4, 0,
848 849 850
       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.
851 852 853 854
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.

855 856 857 858 859
In a string, scan runs to the start of the string, unless LIMIT is non-nil.
In a buffer, if LIMIT is nil or omitted, it runs to (point-min), and the
value cannot be less than that.
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.
860

861 862
The property values are compared with `eq'.
If the property is constant all the way to the start of OBJECT, return the
863
first valid position in OBJECT.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
864
  (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
865 866 867 868 869 870 871
{
  if (STRINGP (object))
    {
      position = Fprevious_single_property_change (position, prop, object, limit);
      if (NILP (position))
	{
	  if (NILP (limit))
872
	    position = make_fixnum (0);
873
	  else
David Kastrup's avatar
David Kastrup committed
874
	    {