Unify FRAME_window_system_DISPLAY_INFO macros between all ports.
[bpt/emacs.git] / src / textprop.c
CommitLineData
d418ef42 1/* Interface code for dealing with text properties.
ab422c4d
PE
2 Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
3 Inc.
d418ef42
JA
4
5This file is part of GNU Emacs.
6
9ec0b715 7GNU Emacs is free software: you can redistribute it and/or modify
d418ef42 8it under the terms of the GNU General Public License as published by
9ec0b715
GM
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
d418ef42
JA
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
9ec0b715 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
d418ef42 19
18160b98 20#include <config.h>
0328b6de 21
d418ef42
JA
22#include "lisp.h"
23#include "intervals.h"
e5560ff7 24#include "character.h"
d418ef42 25#include "buffer.h"
f5957179 26#include "window.h"
59a486ab 27
318d2fa8
RS
28/* Test for membership, allowing for t (actually any non-cons) to mean the
29 universal set. */
30
31#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
d418ef42
JA
32\f
33
34/* NOTES: previous- and next- property change will have to skip
35 zero-length intervals if they are implemented. This could be done
36 inside next_interval and previous_interval.
37
9c79dd1b
JA
38 set_properties needs to deal with the interval property cache.
39
d418ef42 40 It is assumed that for any interval plist, a property appears
d4b530ad 41 only once on the list. Although some code i.e., remove_properties,
d418ef42 42 handles the more general case, the uniqueness of properties is
eb8c3be9 43 necessary for the system to remain consistent. This requirement
cdf3e5a2 44 is enforced by the subrs installing properties onto the intervals. */
d418ef42
JA
45
46\f
cdf3e5a2 47/* Types of hooks. */
955cbe7b
PE
48static Lisp_Object Qmouse_left;
49static Lisp_Object Qmouse_entered;
d418ef42
JA
50Lisp_Object Qpoint_left;
51Lisp_Object Qpoint_entered;
dc70cea7
RS
52Lisp_Object Qcategory;
53Lisp_Object Qlocal_map;
d418ef42 54
cdf3e5a2 55/* Visual properties text (including strings) may have. */
955cbe7b
PE
56static Lisp_Object Qforeground, Qbackground, Qunderline;
57Lisp_Object Qfont;
58static Lisp_Object Qstipple;
59Lisp_Object Qinvisible, Qintangible, Qmouse_face;
60static Lisp_Object Qread_only;
54b33868 61Lisp_Object Qminibuffer_prompt;
19e1c426 62
708e05f6
LMI
63enum property_set_type
64{
65 TEXT_PROPERTY_REPLACE,
66 TEXT_PROPERTY_PREPEND,
67 TEXT_PROPERTY_APPEND
68};
69
cbae07d5 70/* Sticky properties. */
19e1c426 71Lisp_Object Qfront_sticky, Qrear_nonsticky;
d7b4e137
JB
72
73/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
74 the o1's cdr. Otherwise, return zero. This is handy for
75 traversing plists. */
70949dac 76#define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
d7b4e137 77
318d2fa8
RS
78/* verify_interval_modification saves insertion hooks here
79 to be run later by report_interval_modification. */
50436f33
PE
80static Lisp_Object interval_insert_behind_hooks;
81static Lisp_Object interval_insert_in_front_hooks;
7cb66899
GM
82
83
84/* Signal a `text-read-only' error. This function makes it easier
85 to capture that error in GDB by putting a breakpoint on it. */
86
845ca893 87static _Noreturn void
971de7fb 88text_read_only (Lisp_Object propval)
7cb66899 89{
d0a29e1d
KS
90 if (STRINGP (propval))
91 xsignal1 (Qtext_read_only, propval);
92
93 xsignal0 (Qtext_read_only);
7cb66899
GM
94}
95
00012b86 96/* Prepare to modify the text properties of BUFFER from START to END. */
20edc1c9
DA
97
98static void
00012b86 99modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
20edc1c9 100{
00012b86 101 ptrdiff_t b = XINT (start), e = XINT (end);
20edc1c9
DA
102 struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
103
104 set_buffer_internal (buf);
00012b86
DA
105
106 prepare_to_modify_buffer_1 (b, e, NULL);
107
108 BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
109 if (MODIFF <= SAVE_MODIFF)
110 record_first_change ();
111 MODIFF++;
112
113 bset_point_before_scroll (current_buffer, Qnil);
114
20edc1c9
DA
115 set_buffer_internal (old);
116}
7cb66899 117
84575e67
PE
118/* Complain if object is not string or buffer type. */
119
120static void
121CHECK_STRING_OR_BUFFER (Lisp_Object x)
122{
123 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
124}
125
ac876a79
JA
126/* Extract the interval at the position pointed to by BEGIN from
127 OBJECT, a string or buffer. Additionally, check that the positions
128 pointed to by BEGIN and END are within the bounds of OBJECT, and
129 reverse them if *BEGIN is greater than *END. The objects pointed
130 to by BEGIN and END may be integers or markers; if the latter, they
131 are coerced to integers.
d418ef42 132
d4b530ad
RS
133 When OBJECT is a string, we increment *BEGIN and *END
134 to make them origin-one.
135
d418ef42
JA
136 Note that buffer points don't correspond to interval indices.
137 For example, point-max is 1 greater than the index of the last
138 character. This difference is handled in the caller, which uses
139 the validated points to determine a length, and operates on that.
140 Exceptions are Ftext_properties_at, Fnext_property_change, and
141 Fprevious_property_change which call this function with BEGIN == END.
142 Handle this case specially.
143
77c7bcb1 144 If FORCE is soft (0), it's OK to return NULL. Otherwise,
ac876a79
JA
145 create an interval tree for OBJECT if one doesn't exist, provided
146 the object actually contains text. In the current design, if there
d4b530ad 147 is no text, there can be no text properties. */
d418ef42
JA
148
149#define soft 0
150#define hard 1
151
9dd7eec6 152INTERVAL
81c23309
PE
153validate_interval_range (Lisp_Object object, Lisp_Object *begin,
154 Lisp_Object *end, bool force)
d418ef42 155{
81c23309 156 INTERVAL i;
d311d28c 157 ptrdiff_t searchpos;
d4b530ad 158
b7826503
PJ
159 CHECK_STRING_OR_BUFFER (object);
160 CHECK_NUMBER_COERCE_MARKER (*begin);
161 CHECK_NUMBER_COERCE_MARKER (*end);
d418ef42
JA
162
163 /* If we are asked for a point, but from a subr which operates
cdf3e5a2 164 on a range, then return nothing. */
64a49ca7 165 if (EQ (*begin, *end) && begin != end)
77c7bcb1 166 return NULL;
d418ef42
JA
167
168 if (XINT (*begin) > XINT (*end))
169 {
d4b530ad
RS
170 Lisp_Object n;
171 n = *begin;
d418ef42 172 *begin = *end;
d4b530ad 173 *end = n;
d418ef42
JA
174 }
175
5d2fa46f 176 if (BUFFERP (object))
d418ef42
JA
177 {
178 register struct buffer *b = XBUFFER (object);
179
d418ef42
JA
180 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
181 && XINT (*end) <= BUF_ZV (b)))
182 args_out_of_range (*begin, *end);
0c94c8d6 183 i = buffer_intervals (b);
d418ef42 184
cdf3e5a2 185 /* If there's no text, there are no properties. */
d4b530ad 186 if (BUF_BEGV (b) == BUF_ZV (b))
77c7bcb1 187 return NULL;
d4b530ad
RS
188
189 searchpos = XINT (*begin);
d418ef42
JA
190 }
191 else
192 {
d311d28c 193 ptrdiff_t len = SCHARS (object);
d418ef42 194
d4b530ad 195 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
943afcc7 196 && XINT (*end) <= len))
d418ef42 197 args_out_of_range (*begin, *end);
ad077db0 198 XSETFASTINT (*begin, XFASTINT (*begin));
b1e94638 199 if (begin != end)
ad077db0 200 XSETFASTINT (*end, XFASTINT (*end));
0c94c8d6 201 i = string_intervals (object);
d4b530ad 202
943afcc7 203 if (len == 0)
77c7bcb1 204 return NULL;
d4b530ad
RS
205
206 searchpos = XINT (*begin);
d418ef42
JA
207 }
208
77c7bcb1 209 if (!i)
d418ef42 210 return (force ? create_root_interval (object) : i);
81f6e55f 211
d4b530ad 212 return find_interval (i, searchpos);
d418ef42
JA
213}
214
215/* Validate LIST as a property list. If LIST is not a list, then
216 make one consisting of (LIST nil). Otherwise, verify that LIST
cdf3e5a2 217 is even numbered and thus suitable as a plist. */
d418ef42
JA
218
219static Lisp_Object
971de7fb 220validate_plist (Lisp_Object list)
d418ef42
JA
221{
222 if (NILP (list))
223 return Qnil;
224
225 if (CONSP (list))
226 {
ecc0fdd4
PE
227 bool odd_length = 0;
228 Lisp_Object tail;
229 for (tail = list; CONSP (tail); tail = XCDR (tail))
b1e94638 230 {
ecc0fdd4 231 odd_length ^= 1;
b1e94638
JB
232 QUIT;
233 }
ecc0fdd4 234 if (odd_length)
d418ef42
JA
235 error ("Odd length text property list");
236 return list;
237 }
238
6c6f1994 239 return list2 (list, Qnil);
d418ef42
JA
240}
241
ecc0fdd4 242/* Return true if interval I has all the properties,
cdf3e5a2 243 with the same values, of list PLIST. */
d418ef42 244
ecc0fdd4 245static bool
971de7fb 246interval_has_all_properties (Lisp_Object plist, INTERVAL i)
d418ef42 247{
ecc0fdd4 248 Lisp_Object tail1, tail2;
d418ef42 249
cdf3e5a2 250 /* Go through each element of PLIST. */
99784d63 251 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
d418ef42 252 {
ecc0fdd4
PE
253 Lisp_Object sym1 = XCAR (tail1);
254 bool found = 0;
d418ef42
JA
255
256 /* Go through I's plist, looking for sym1 */
99784d63
SM
257 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
258 if (EQ (sym1, XCAR (tail2)))
d418ef42
JA
259 {
260 /* Found the same property on both lists. If the
cdf3e5a2 261 values are unequal, return zero. */
99784d63 262 if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
d418ef42
JA
263 return 0;
264
224a3131 265 /* Property has same value on both lists; go to next one. */
d418ef42
JA
266 found = 1;
267 break;
268 }
269
270 if (! found)
271 return 0;
272 }
273
274 return 1;
275}
276
ecc0fdd4 277/* Return true if the plist of interval I has any of the
cdf3e5a2 278 properties of PLIST, regardless of their values. */
d418ef42 279
ecc0fdd4 280static bool
971de7fb 281interval_has_some_properties (Lisp_Object plist, INTERVAL i)
d418ef42 282{
ecc0fdd4 283 Lisp_Object tail1, tail2, sym;
d418ef42 284
cdf3e5a2 285 /* Go through each element of PLIST. */
99784d63 286 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
d418ef42 287 {
99784d63 288 sym = XCAR (tail1);
d418ef42
JA
289
290 /* Go through i's plist, looking for tail1 */
99784d63
SM
291 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
292 if (EQ (sym, XCAR (tail2)))
d418ef42
JA
293 return 1;
294 }
295
296 return 0;
297}
11713b6d
RS
298
299/* Return nonzero if the plist of interval I has any of the
300 property names in LIST, regardless of their values. */
301
ecc0fdd4 302static bool
971de7fb 303interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
11713b6d 304{
ecc0fdd4 305 Lisp_Object tail1, tail2, sym;
11713b6d
RS
306
307 /* Go through each element of LIST. */
99784d63 308 for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
11713b6d 309 {
7d7bbefd 310 sym = XCAR (tail1);
11713b6d
RS
311
312 /* Go through i's plist, looking for tail1 */
99784d63 313 for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
11713b6d
RS
314 if (EQ (sym, XCAR (tail2)))
315 return 1;
316 }
317
318 return 0;
319}
d4b530ad 320\f
d7b4e137
JB
321/* Changing the plists of individual intervals. */
322
323/* Return the value of PROP in property-list PLIST, or Qunbound if it
324 has none. */
64a49ca7 325static Lisp_Object
971de7fb 326property_value (Lisp_Object plist, Lisp_Object prop)
d7b4e137
JB
327{
328 Lisp_Object value;
329
330 while (PLIST_ELT_P (plist, value))
70949dac
KR
331 if (EQ (XCAR (plist), prop))
332 return XCAR (value);
d7b4e137 333 else
70949dac 334 plist = XCDR (value);
d7b4e137
JB
335
336 return Qunbound;
337}
338
d4b530ad
RS
339/* Set the properties of INTERVAL to PROPERTIES,
340 and record undo info for the previous values.
341 OBJECT is the string or buffer that INTERVAL belongs to. */
342
343static void
971de7fb 344set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
d4b530ad 345{
d7b4e137 346 Lisp_Object sym, value;
d4b530ad 347
d7b4e137 348 if (BUFFERP (object))
d4b530ad 349 {
d7b4e137
JB
350 /* For each property in the old plist which is missing from PROPERTIES,
351 or has a different value in PROPERTIES, make an undo record. */
352 for (sym = interval->plist;
353 PLIST_ELT_P (sym, value);
70949dac
KR
354 sym = XCDR (value))
355 if (! EQ (property_value (properties, XCAR (sym)),
356 XCAR (value)))
f7a9275a 357 {
f7a9275a 358 record_property_change (interval->position, LENGTH (interval),
70949dac 359 XCAR (sym), XCAR (value),
f7a9275a
RS
360 object);
361 }
d7b4e137
JB
362
363 /* For each new property that has no value at all in the old plist,
364 make an undo record binding it to nil, so it will be removed. */
365 for (sym = properties;
366 PLIST_ELT_P (sym, value);
70949dac
KR
367 sym = XCDR (value))
368 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
f7a9275a 369 {
f7a9275a 370 record_property_change (interval->position, LENGTH (interval),
70949dac 371 XCAR (sym), Qnil,
f7a9275a
RS
372 object);
373 }
d4b530ad
RS
374 }
375
376 /* Store new properties. */
0c94c8d6 377 set_interval_plist (interval, Fcopy_sequence (properties));
d4b530ad 378}
d418ef42
JA
379
380/* Add the properties of PLIST to the interval I, or set
381 the value of I's property to the value of the property on PLIST
382 if they are different.
383
d4b530ad
RS
384 OBJECT should be the string or buffer the interval is in.
385
ecc0fdd4 386 Return true if this changes I (i.e., if any members of PLIST
d418ef42
JA
387 are actually added to I's plist) */
388
ecc0fdd4 389static bool
708e05f6
LMI
390add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
391 enum property_set_type set_type)
d418ef42 392{
c98da214 393 Lisp_Object tail1, tail2, sym1, val1;
ecc0fdd4 394 bool changed = 0;
c98da214
RS
395 struct gcpro gcpro1, gcpro2, gcpro3;
396
397 tail1 = plist;
398 sym1 = Qnil;
399 val1 = Qnil;
400 /* No need to protect OBJECT, because we can GC only in the case
401 where it is a buffer, and live buffers are always protected.
402 I and its plist are also protected, via OBJECT. */
403 GCPRO3 (tail1, sym1, val1);
d418ef42 404
cdf3e5a2 405 /* Go through each element of PLIST. */
99784d63 406 for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
d418ef42 407 {
ecc0fdd4 408 bool found = 0;
99784d63
SM
409 sym1 = XCAR (tail1);
410 val1 = Fcar (XCDR (tail1));
d418ef42
JA
411
412 /* Go through I's plist, looking for sym1 */
99784d63
SM
413 for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
414 if (EQ (sym1, XCAR (tail2)))
d418ef42 415 {
c98da214
RS
416 /* No need to gcpro, because tail2 protects this
417 and it must be a cons cell (we get an error otherwise). */
3814ccf5 418 register Lisp_Object this_cdr;
d418ef42 419
99784d63 420 this_cdr = XCDR (tail2);
cdf3e5a2 421 /* Found the property. Now check its value. */
d418ef42
JA
422 found = 1;
423
424 /* The properties have the same value on both lists.
cdf3e5a2 425 Continue to the next property. */
734c51b2 426 if (EQ (val1, Fcar (this_cdr)))
d418ef42
JA
427 break;
428
d4b530ad 429 /* Record this change in the buffer, for undo purposes. */
5d2fa46f 430 if (BUFFERP (object))
d4b530ad 431 {
f7a9275a
RS
432 record_property_change (i->position, LENGTH (i),
433 sym1, Fcar (this_cdr), object);
d4b530ad
RS
434 }
435
d418ef42 436 /* I's property has a different value -- change it */
708e05f6
LMI
437 if (set_type == TEXT_PROPERTY_REPLACE)
438 Fsetcar (this_cdr, val1);
439 else {
440 if (CONSP (Fcar (this_cdr)) &&
441 /* Special-case anonymous face properties. */
442 (! EQ (sym1, Qface) ||
443 NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
444 /* The previous value is a list, so prepend (or
445 append) the new value to this list. */
446 if (set_type == TEXT_PROPERTY_PREPEND)
447 Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
448 else
6c6f1994 449 nconc2 (Fcar (this_cdr), list1 (val1));
708e05f6
LMI
450 else {
451 /* The previous value is a single value, so make it
452 into a list. */
453 if (set_type == TEXT_PROPERTY_PREPEND)
6c6f1994 454 Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
708e05f6 455 else
6c6f1994 456 Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
708e05f6
LMI
457 }
458 }
ecc0fdd4 459 changed = 1;
d418ef42
JA
460 break;
461 }
462
463 if (! found)
464 {
d4b530ad 465 /* Record this change in the buffer, for undo purposes. */
5d2fa46f 466 if (BUFFERP (object))
d4b530ad 467 {
f7a9275a
RS
468 record_property_change (i->position, LENGTH (i),
469 sym1, Qnil, object);
d4b530ad 470 }
0c94c8d6 471 set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
ecc0fdd4 472 changed = 1;
d418ef42
JA
473 }
474 }
475
c98da214
RS
476 UNGCPRO;
477
d418ef42
JA
478 return changed;
479}
480
11713b6d
RS
481/* For any members of PLIST, or LIST,
482 which are properties of I, remove them from I's plist.
483 (If PLIST is non-nil, use that, otherwise use LIST.)
d4b530ad 484 OBJECT is the string or buffer containing I. */
d418ef42 485
ecc0fdd4 486static bool
971de7fb 487remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object object)
d418ef42 488{
ecc0fdd4
PE
489 Lisp_Object tail1, tail2, sym, current_plist;
490 bool changed = 0;
d418ef42 491
ecc0fdd4
PE
492 /* True means tail1 is a plist, otherwise it is a list. */
493 bool use_plist;
11713b6d 494
3814ccf5 495 current_plist = i->plist;
11713b6d
RS
496
497 if (! NILP (plist))
f25d60d6 498 tail1 = plist, use_plist = 1;
11713b6d 499 else
f25d60d6 500 tail1 = list, use_plist = 0;
11713b6d
RS
501
502 /* Go through each element of LIST or PLIST. */
b079118d 503 while (CONSP (tail1))
d418ef42 504 {
11713b6d 505 sym = XCAR (tail1);
d418ef42 506
11713b6d 507 /* First, remove the symbol if it's at the head of the list */
b079118d 508 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
d418ef42 509 {
5d2fa46f 510 if (BUFFERP (object))
11713b6d
RS
511 record_property_change (i->position, LENGTH (i),
512 sym, XCAR (XCDR (current_plist)),
513 object);
d4b530ad 514
11713b6d 515 current_plist = XCDR (XCDR (current_plist));
ecc0fdd4 516 changed = 1;
d418ef42
JA
517 }
518
11713b6d 519 /* Go through I's plist, looking for SYM. */
d418ef42
JA
520 tail2 = current_plist;
521 while (! NILP (tail2))
522 {
3814ccf5 523 register Lisp_Object this;
11713b6d 524 this = XCDR (XCDR (tail2));
b079118d 525 if (CONSP (this) && EQ (sym, XCAR (this)))
d418ef42 526 {
5d2fa46f 527 if (BUFFERP (object))
11713b6d
RS
528 record_property_change (i->position, LENGTH (i),
529 sym, XCAR (XCDR (this)), object);
d4b530ad 530
11713b6d 531 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
ecc0fdd4 532 changed = 1;
d418ef42
JA
533 }
534 tail2 = this;
535 }
11713b6d
RS
536
537 /* Advance thru TAIL1 one way or the other. */
f25d60d6
KS
538 tail1 = XCDR (tail1);
539 if (use_plist && CONSP (tail1))
11713b6d 540 tail1 = XCDR (tail1);
d418ef42
JA
541 }
542
543 if (changed)
0c94c8d6 544 set_interval_plist (i, current_plist);
d418ef42
JA
545 return changed;
546}
d418ef42 547\f
81f6e55f 548/* Returns the interval of POSITION in OBJECT.
cdf3e5a2
RS
549 POSITION is BEG-based. */
550
551INTERVAL
d311d28c 552interval_of (ptrdiff_t position, Lisp_Object object)
cdf3e5a2
RS
553{
554 register INTERVAL i;
d311d28c 555 ptrdiff_t beg, end;
cdf3e5a2
RS
556
557 if (NILP (object))
558 XSETBUFFER (object, current_buffer);
d0cb872a 559 else if (EQ (object, Qt))
77c7bcb1 560 return NULL;
cdf3e5a2 561
b7826503 562 CHECK_STRING_OR_BUFFER (object);
cdf3e5a2
RS
563
564 if (BUFFERP (object))
565 {
566 register struct buffer *b = XBUFFER (object);
567
568 beg = BUF_BEGV (b);
569 end = BUF_ZV (b);
0c94c8d6 570 i = buffer_intervals (b);
cdf3e5a2
RS
571 }
572 else
573 {
ad077db0 574 beg = 0;
943afcc7 575 end = SCHARS (object);
0c94c8d6 576 i = string_intervals (object);
cdf3e5a2
RS
577 }
578
579 if (!(beg <= position && position <= end))
c7ef8e24 580 args_out_of_range (make_number (position), make_number (position));
77c7bcb1
DA
581 if (beg == end || !i)
582 return NULL;
81f6e55f 583
cdf3e5a2
RS
584 return find_interval (i, position);
585}
586\f
a7ca3326 587DEFUN ("text-properties-at", Ftext_properties_at,
d418ef42 588 Stext_properties_at, 1, 2, 0,
8c1a1077 589 doc: /* Return the list of properties of the character at POSITION in OBJECT.
81f6e55f
FP
590If the optional second argument OBJECT is a buffer (or nil, which means
591the current buffer), POSITION is a buffer position (integer or marker).
592If OBJECT is a string, POSITION is a 0-based index into it.
8c1a1077 593If POSITION is at the end of OBJECT, the value is nil. */)
5842a27b 594 (Lisp_Object position, Lisp_Object object)
d418ef42
JA
595{
596 register INTERVAL i;
d418ef42
JA
597
598 if (NILP (object))
c8a4fc3d 599 XSETBUFFER (object, current_buffer);
d418ef42 600
1f5e848a 601 i = validate_interval_range (object, &position, &position, soft);
77c7bcb1 602 if (!i)
d418ef42 603 return Qnil;
1f5e848a 604 /* If POSITION is at the end of the interval,
d4b530ad
RS
605 it means it's the end of OBJECT.
606 There are no properties at the very end,
607 since no character follows. */
1f5e848a 608 if (XINT (position) == LENGTH (i) + i->position)
d4b530ad 609 return Qnil;
d418ef42
JA
610
611 return i->plist;
612}
613
a7ca3326 614DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
8c1a1077 615 doc: /* Return the value of POSITION's property PROP, in OBJECT.
b4f5313e
CY
616OBJECT should be a buffer or a string; if omitted or nil, it defaults
617to the current buffer.
8c1a1077 618If POSITION is at the end of OBJECT, the value is nil. */)
5842a27b 619 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
5fbe2a44 620{
1f5e848a 621 return textget (Ftext_properties_at (position, object), prop);
5fbe2a44
RS
622}
623
bcf97349 624/* Return the value of char's property PROP, in OBJECT at POSITION.
8d41abc4
MB
625 OBJECT is optional and defaults to the current buffer.
626 If OVERLAY is non-0, then in the case that the returned property is from
627 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
628 returned in *OVERLAY.
629 If POSITION is at the end of OBJECT, the value is nil.
630 If OBJECT is a buffer, then overlay properties are considered as well as
631 text properties.
632 If OBJECT is a window, then that window's buffer is used, but
633 window-specific overlays are considered only if they are associated
634 with OBJECT. */
635Lisp_Object
971de7fb 636get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object object, Lisp_Object *overlay)
f5957179
KH
637{
638 struct window *w = 0;
639
b7826503 640 CHECK_NUMBER_COERCE_MARKER (position);
f5957179
KH
641
642 if (NILP (object))
c8a4fc3d 643 XSETBUFFER (object, current_buffer);
f5957179
KH
644
645 if (WINDOWP (object))
646 {
e74aeda8 647 CHECK_LIVE_WINDOW (object);
f5957179 648 w = XWINDOW (object);
e74aeda8 649 object = w->contents;
f5957179
KH
650 }
651 if (BUFFERP (object))
652 {
b081724f 653 ptrdiff_t noverlays;
b5be4dbe 654 Lisp_Object *overlay_vec;
cbc55f55
RS
655 struct buffer *obuf = current_buffer;
656
dd6f2802
RS
657 if (XINT (position) < BUF_BEGV (XBUFFER (object))
658 || XINT (position) > BUF_ZV (XBUFFER (object)))
659 xsignal1 (Qargs_out_of_range, position);
660
cbc55f55 661 set_buffer_temp (XBUFFER (object));
f5957179 662
b5be4dbe 663 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
f5957179
KH
664 noverlays = sort_overlays (overlay_vec, noverlays, w);
665
cbc55f55
RS
666 set_buffer_temp (obuf);
667
f5957179
KH
668 /* Now check the overlays in order of decreasing priority. */
669 while (--noverlays >= 0)
670 {
b5be4dbe 671 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
f5957179 672 if (!NILP (tem))
8d41abc4
MB
673 {
674 if (overlay)
675 /* Return the overlay we got the property from. */
676 *overlay = overlay_vec[noverlays];
677 return tem;
678 }
f5957179
KH
679 }
680 }
8d41abc4
MB
681
682 if (overlay)
683 /* Indicate that the return value is not from an overlay. */
684 *overlay = Qnil;
685
f5957179
KH
686 /* Not a buffer, or no appropriate overlay, so fall through to the
687 simpler case. */
8d41abc4
MB
688 return Fget_text_property (position, prop, object);
689}
690
a7ca3326 691DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
8c1a1077 692 doc: /* Return the value of POSITION's property PROP, in OBJECT.
8faef085 693Both overlay properties and text properties are checked.
8c1a1077
PJ
694OBJECT is optional and defaults to the current buffer.
695If POSITION is at the end of OBJECT, the value is nil.
696If OBJECT is a buffer, then overlay properties are considered as well as
697text properties.
698If OBJECT is a window, then that window's buffer is used, but window-specific
699overlays are considered only if they are associated with OBJECT. */)
5842a27b 700 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
8d41abc4
MB
701{
702 return get_char_property_and_overlay (position, prop, object, 0);
f5957179 703}
97a1bc63
LT
704
705DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
706 Sget_char_property_and_overlay, 2, 3, 0,
707 doc: /* Like `get-char-property', but with extra overlay information.
95555145
RS
708The value is a cons cell. Its car is the return value of `get-char-property'
709with the same arguments--that is, the value of POSITION's property
710PROP in OBJECT. Its cdr is the overlay in which the property was
97a1bc63 711found, or nil, if it was found as a text property or not found at all.
95555145 712
97a1bc63
LT
713OBJECT is optional and defaults to the current buffer. OBJECT may be
714a string, a buffer or a window. For strings, the cdr of the return
715value is always nil, since strings do not have overlays. If OBJECT is
716a window, then that window's buffer is used, but window-specific
717overlays are considered only if they are associated with OBJECT. If
718POSITION is at the end of OBJECT, both car and cdr are nil. */)
5842a27b 719 (Lisp_Object position, Lisp_Object prop, Lisp_Object object)
97a1bc63
LT
720{
721 Lisp_Object overlay;
722 Lisp_Object val
723 = get_char_property_and_overlay (position, prop, object, &overlay);
6519d955 724 return Fcons (val, overlay);
97a1bc63
LT
725}
726
fcab51aa 727\f
a7ca3326 728DEFUN ("next-char-property-change", Fnext_char_property_change,
fcab51aa 729 Snext_char_property_change, 1, 2, 0,
8c1a1077 730 doc: /* Return the position of next text property or overlay change.
81f6e55f
FP
731This scans characters forward in the current buffer from POSITION till
732it finds a change in some text property, or the beginning or end of an
733overlay, and returns the position of that.
85cc6738 734If none is found up to (point-max), the function returns (point-max).
8c1a1077 735
a41292c2 736If the optional second argument LIMIT is non-nil, don't search
85cc6738
RS
737past position LIMIT; return LIMIT if nothing is found before LIMIT.
738LIMIT is a no-op if it is greater than (point-max). */)
5842a27b 739 (Lisp_Object position, Lisp_Object limit)
fcab51aa
RS
740{
741 Lisp_Object temp;
742
743 temp = Fnext_overlay_change (position);
744 if (! NILP (limit))
745 {
d615870a 746 CHECK_NUMBER_COERCE_MARKER (limit);
fcab51aa
RS
747 if (XINT (limit) < XINT (temp))
748 temp = limit;
749 }
750 return Fnext_property_change (position, Qnil, temp);
751}
752
a7ca3326 753DEFUN ("previous-char-property-change", Fprevious_char_property_change,
fcab51aa 754 Sprevious_char_property_change, 1, 2, 0,
8c1a1077 755 doc: /* Return the position of previous text property or overlay change.
81f6e55f
FP
756Scans characters backward in the current buffer from POSITION till it
757finds a change in some text property, or the beginning or end of an
758overlay, and returns the position of that.
85cc6738 759If none is found since (point-min), the function returns (point-min).
8c1a1077 760
a41292c2 761If the optional second argument LIMIT is non-nil, don't search
85cc6738
RS
762past position LIMIT; return LIMIT if nothing is found before LIMIT.
763LIMIT is a no-op if it is less than (point-min). */)
5842a27b 764 (Lisp_Object position, Lisp_Object limit)
fcab51aa
RS
765{
766 Lisp_Object temp;
f5957179 767
fcab51aa
RS
768 temp = Fprevious_overlay_change (position);
769 if (! NILP (limit))
770 {
d615870a 771 CHECK_NUMBER_COERCE_MARKER (limit);
fcab51aa
RS
772 if (XINT (limit) > XINT (temp))
773 temp = limit;
774 }
775 return Fprevious_property_change (position, Qnil, temp);
776}
0b0737d1
GM
777
778
a7ca3326 779DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
b7e047fb 780 Snext_single_char_property_change, 2, 4, 0,
8c1a1077
PJ
781 doc: /* Return the position of next text property or overlay change for a specific property.
782Scans characters forward from POSITION till it finds
783a change in the PROP property, then returns the position of the change.
81f6e55f
FP
784If the optional third argument OBJECT is a buffer (or nil, which means
785the current buffer), POSITION is a buffer position (integer or marker).
786If OBJECT is a string, POSITION is a 0-based index into it.
787
85cc6738
RS
788In a string, scan runs to the end of the string.
789In a buffer, it runs to (point-max), and the value cannot exceed that.
790
8c1a1077
PJ
791The property values are compared with `eq'.
792If the property is constant all the way to the end of OBJECT, return the
793last valid position in OBJECT.
794If the optional fourth argument LIMIT is non-nil, don't search
795past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
5842a27b 796 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
0b0737d1
GM
797{
798 if (STRINGP (object))
799 {
b7e047fb
MB
800 position = Fnext_single_property_change (position, prop, object, limit);
801 if (NILP (position))
0b0737d1
GM
802 {
803 if (NILP (limit))
d5db4077 804 position = make_number (SCHARS (object));
0b0737d1 805 else
d615870a
DK
806 {
807 CHECK_NUMBER (limit);
808 position = limit;
809 }
0b0737d1
GM
810 }
811 }
812 else
813 {
814 Lisp_Object initial_value, value;
d311d28c 815 ptrdiff_t count = SPECPDL_INDEX ();
0b0737d1 816
b7e047fb 817 if (! NILP (object))
b7826503 818 CHECK_BUFFER (object);
81f6e55f 819
0b0737d1
GM
820 if (BUFFERP (object) && current_buffer != XBUFFER (object))
821 {
66322887 822 record_unwind_current_buffer ();
0b0737d1
GM
823 Fset_buffer (object);
824 }
825
d615870a
DK
826 CHECK_NUMBER_COERCE_MARKER (position);
827
b7e047fb 828 initial_value = Fget_char_property (position, prop, object);
81f6e55f 829
b7e047fb 830 if (NILP (limit))
85cc6738 831 XSETFASTINT (limit, ZV);
b7e047fb 832 else
b7826503 833 CHECK_NUMBER_COERCE_MARKER (limit);
b7e047fb 834
85cc6738 835 if (XFASTINT (position) >= XFASTINT (limit))
0b0737d1 836 {
85cc6738
RS
837 position = limit;
838 if (XFASTINT (position) > ZV)
839 XSETFASTINT (position, ZV);
0b0737d1 840 }
85cc6738
RS
841 else
842 while (1)
843 {
844 position = Fnext_char_property_change (position, limit);
845 if (XFASTINT (position) >= XFASTINT (limit))
846 {
847 position = limit;
848 break;
849 }
850
851 value = Fget_char_property (position, prop, object);
852 if (!EQ (value, initial_value))
853 break;
854 }
0b0737d1
GM
855
856 unbind_to (count, Qnil);
857 }
858
b7e047fb 859 return position;
0b0737d1
GM
860}
861
a7ca3326 862DEFUN ("previous-single-char-property-change",
b7e047fb
MB
863 Fprevious_single_char_property_change,
864 Sprevious_single_char_property_change, 2, 4, 0,
8c1a1077
PJ
865 doc: /* Return the position of previous text property or overlay change for a specific property.
866Scans characters backward from POSITION till it finds
867a change in the PROP property, then returns the position of the change.
81f6e55f
FP
868If the optional third argument OBJECT is a buffer (or nil, which means
869the current buffer), POSITION is a buffer position (integer or marker).
870If OBJECT is a string, POSITION is a 0-based index into it.
871
85cc6738
RS
872In a string, scan runs to the start of the string.
873In a buffer, it runs to (point-min), and the value cannot be less than that.
874
8c1a1077
PJ
875The property values are compared with `eq'.
876If the property is constant all the way to the start of OBJECT, return the
877first valid position in OBJECT.
e531bdff
DA
878If the optional fourth argument LIMIT is non-nil, don't search back past
879position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
5842a27b 880 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
b7e047fb
MB
881{
882 if (STRINGP (object))
883 {
884 position = Fprevious_single_property_change (position, prop, object, limit);
885 if (NILP (position))
886 {
887 if (NILP (limit))
1e02f3cb 888 position = make_number (0);
b7e047fb 889 else
d615870a
DK
890 {
891 CHECK_NUMBER (limit);
892 position = limit;
893 }
b7e047fb
MB
894 }
895 }
896 else
897 {
d311d28c 898 ptrdiff_t count = SPECPDL_INDEX ();
b7e047fb
MB
899
900 if (! NILP (object))
b7826503 901 CHECK_BUFFER (object);
81f6e55f 902
b7e047fb
MB
903 if (BUFFERP (object) && current_buffer != XBUFFER (object))
904 {
66322887 905 record_unwind_current_buffer ();
b7e047fb
MB
906 Fset_buffer (object);
907 }
81f6e55f 908
d615870a
DK
909 CHECK_NUMBER_COERCE_MARKER (position);
910
b7e047fb 911 if (NILP (limit))
85cc6738 912 XSETFASTINT (limit, BEGV);
b7e047fb 913 else
b7826503 914 CHECK_NUMBER_COERCE_MARKER (limit);
b7e047fb 915
ce6b02e0 916 if (XFASTINT (position) <= XFASTINT (limit))
85cc6738
RS
917 {
918 position = limit;
919 if (XFASTINT (position) < BEGV)
920 XSETFASTINT (position, BEGV);
921 }
ce6b02e0 922 else
b7e047fb 923 {
85cc6738
RS
924 Lisp_Object initial_value
925 = Fget_char_property (make_number (XFASTINT (position) - 1),
926 prop, object);
81f6e55f 927
85cc6738 928 while (1)
ce6b02e0
MB
929 {
930 position = Fprevious_char_property_change (position, limit);
0b0737d1 931
ce6b02e0
MB
932 if (XFASTINT (position) <= XFASTINT (limit))
933 {
934 position = limit;
935 break;
936 }
937 else
938 {
85cc6738
RS
939 Lisp_Object value
940 = Fget_char_property (make_number (XFASTINT (position) - 1),
941 prop, object);
ce6b02e0
MB
942
943 if (!EQ (value, initial_value))
944 break;
945 }
946 }
b7e047fb
MB
947 }
948
949 unbind_to (count, Qnil);
950 }
951
952 return position;
953}
fcab51aa 954\f
a7ca3326 955DEFUN ("next-property-change", Fnext_property_change,
111b637d 956 Snext_property_change, 1, 3, 0,
8c1a1077
PJ
957 doc: /* Return the position of next property change.
958Scans characters forward from POSITION in OBJECT till it finds
959a change in some text property, then returns the position of the change.
81f6e55f
FP
960If the optional second argument OBJECT is a buffer (or nil, which means
961the current buffer), POSITION is a buffer position (integer or marker).
962If OBJECT is a string, POSITION is a 0-based index into it.
8c1a1077
PJ
963Return nil if the property is constant all the way to the end of OBJECT.
964If the value is non-nil, it is a position greater than POSITION, never equal.
965
966If the optional third argument LIMIT is non-nil, don't search
967past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
5842a27b 968 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
d418ef42
JA
969{
970 register INTERVAL i, next;
971
5fbe2a44 972 if (NILP (object))
c8a4fc3d 973 XSETBUFFER (object, current_buffer);
5fbe2a44 974
3a232704 975 if (!NILP (limit) && !EQ (limit, Qt))
b7826503 976 CHECK_NUMBER_COERCE_MARKER (limit);
1387d54e 977
1f5e848a 978 i = validate_interval_range (object, &position, &position, soft);
d418ef42 979
041aa96f
RS
980 /* If LIMIT is t, return start of next interval--don't
981 bother checking further intervals. */
982 if (EQ (limit, Qt))
983 {
77c7bcb1 984 if (!i)
44214c1b
RS
985 next = i;
986 else
987 next = next_interval (i);
81f6e55f 988
77c7bcb1 989 if (!next)
1f5e848a 990 XSETFASTINT (position, (STRINGP (object)
d5db4077 991 ? SCHARS (object)
1f5e848a 992 : BUF_ZV (XBUFFER (object))));
c7b6dfa6 993 else
ad077db0 994 XSETFASTINT (position, next->position);
1f5e848a 995 return position;
041aa96f
RS
996 }
997
77c7bcb1 998 if (!i)
44214c1b
RS
999 return limit;
1000
1001 next = next_interval (i);
1002
77c7bcb1 1003 while (next && intervals_equal (i, next)
ad077db0 1004 && (NILP (limit) || next->position < XFASTINT (limit)))
d418ef42
JA
1005 next = next_interval (next);
1006
77c7bcb1 1007 if (!next
52c0f270
CY
1008 || (next->position
1009 >= (INTEGERP (limit)
1010 ? XFASTINT (limit)
1011 : (STRINGP (object)
1012 ? SCHARS (object)
1013 : BUF_ZV (XBUFFER (object))))))
111b637d 1014 return limit;
52c0f270
CY
1015 else
1016 return make_number (next->position);
19e1c426
RS
1017}
1018
a7ca3326 1019DEFUN ("next-single-property-change", Fnext_single_property_change,
111b637d 1020 Snext_single_property_change, 2, 4, 0,
8c1a1077
PJ
1021 doc: /* Return the position of next property change for a specific property.
1022Scans characters forward from POSITION till it finds
1023a change in the PROP property, then returns the position of the change.
81f6e55f
FP
1024If the optional third argument OBJECT is a buffer (or nil, which means
1025the current buffer), POSITION is a buffer position (integer or marker).
1026If OBJECT is a string, POSITION is a 0-based index into it.
8c1a1077
PJ
1027The property values are compared with `eq'.
1028Return nil if the property is constant all the way to the end of OBJECT.
1029If the value is non-nil, it is a position greater than POSITION, never equal.
1030
1031If the optional fourth argument LIMIT is non-nil, don't search
1032past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
5842a27b 1033 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
9c79dd1b
JA
1034{
1035 register INTERVAL i, next;
1036 register Lisp_Object here_val;
1037
5fbe2a44 1038 if (NILP (object))
c8a4fc3d 1039 XSETBUFFER (object, current_buffer);
5fbe2a44 1040
1387d54e 1041 if (!NILP (limit))
b7826503 1042 CHECK_NUMBER_COERCE_MARKER (limit);
1387d54e 1043
1f5e848a 1044 i = validate_interval_range (object, &position, &position, soft);
77c7bcb1 1045 if (!i)
111b637d 1046 return limit;
9c79dd1b 1047
6a0486dd 1048 here_val = textget (i->plist, prop);
9c79dd1b 1049 next = next_interval (i);
77c7bcb1 1050 while (next
111b637d 1051 && EQ (here_val, textget (next->plist, prop))
ad077db0 1052 && (NILP (limit) || next->position < XFASTINT (limit)))
9c79dd1b
JA
1053 next = next_interval (next);
1054
77c7bcb1 1055 if (!next
52c0f270
CY
1056 || (next->position
1057 >= (INTEGERP (limit)
1058 ? XFASTINT (limit)
1059 : (STRINGP (object)
1060 ? SCHARS (object)
1061 : BUF_ZV (XBUFFER (object))))))
111b637d 1062 return limit;
52c0f270
CY
1063 else
1064 return make_number (next->position);
9c79dd1b
JA
1065}
1066
a7ca3326 1067DEFUN ("previous-property-change", Fprevious_property_change,
111b637d 1068 Sprevious_property_change, 1, 3, 0,
8c1a1077
PJ
1069 doc: /* Return the position of previous property change.
1070Scans characters backwards from POSITION in OBJECT till it finds
1071a change in some text property, then returns the position of the change.
81f6e55f
FP
1072If the optional second argument OBJECT is a buffer (or nil, which means
1073the current buffer), POSITION is a buffer position (integer or marker).
1074If OBJECT is a string, POSITION is a 0-based index into it.
8c1a1077
PJ
1075Return nil if the property is constant all the way to the start of OBJECT.
1076If the value is non-nil, it is a position less than POSITION, never equal.
1077
1078If the optional third argument LIMIT is non-nil, don't search
1079back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
5842a27b 1080 (Lisp_Object position, Lisp_Object object, Lisp_Object limit)
d418ef42
JA
1081{
1082 register INTERVAL i, previous;
1083
5fbe2a44 1084 if (NILP (object))
c8a4fc3d 1085 XSETBUFFER (object, current_buffer);
5fbe2a44 1086
1387d54e 1087 if (!NILP (limit))
b7826503 1088 CHECK_NUMBER_COERCE_MARKER (limit);
1387d54e 1089
1f5e848a 1090 i = validate_interval_range (object, &position, &position, soft);
77c7bcb1 1091 if (!i)
111b637d 1092 return limit;
d418ef42 1093
53b7feec 1094 /* Start with the interval containing the char before point. */
1f5e848a 1095 if (i->position == XFASTINT (position))
53b7feec
RS
1096 i = previous_interval (i);
1097
d418ef42 1098 previous = previous_interval (i);
77c7bcb1 1099 while (previous && intervals_equal (previous, i)
111b637d 1100 && (NILP (limit)
ad077db0 1101 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
d418ef42 1102 previous = previous_interval (previous);
d418ef42 1103
77c7bcb1 1104 if (!previous
52c0f270
CY
1105 || (previous->position + LENGTH (previous)
1106 <= (INTEGERP (limit)
1107 ? XFASTINT (limit)
1108 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1109 return limit;
1110 else
1111 return make_number (previous->position + LENGTH (previous));
d418ef42
JA
1112}
1113
a7ca3326 1114DEFUN ("previous-single-property-change", Fprevious_single_property_change,
111b637d 1115 Sprevious_single_property_change, 2, 4, 0,
8c1a1077
PJ
1116 doc: /* Return the position of previous property change for a specific property.
1117Scans characters backward from POSITION till it finds
1118a change in the PROP property, then returns the position of the change.
81f6e55f
FP
1119If the optional third argument OBJECT is a buffer (or nil, which means
1120the current buffer), POSITION is a buffer position (integer or marker).
1121If OBJECT is a string, POSITION is a 0-based index into it.
8c1a1077
PJ
1122The property values are compared with `eq'.
1123Return nil if the property is constant all the way to the start of OBJECT.
1124If the value is non-nil, it is a position less than POSITION, never equal.
1125
1126If the optional fourth argument LIMIT is non-nil, don't search
1127back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
5842a27b 1128 (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit)
9c79dd1b
JA
1129{
1130 register INTERVAL i, previous;
1131 register Lisp_Object here_val;
1132
5fbe2a44 1133 if (NILP (object))
c8a4fc3d 1134 XSETBUFFER (object, current_buffer);
5fbe2a44 1135
1387d54e 1136 if (!NILP (limit))
b7826503 1137 CHECK_NUMBER_COERCE_MARKER (limit);
1387d54e 1138
1f5e848a 1139 i = validate_interval_range (object, &position, &position, soft);
9c79dd1b 1140
53b7feec 1141 /* Start with the interval containing the char before point. */
77c7bcb1 1142 if (i && i->position == XFASTINT (position))
53b7feec
RS
1143 i = previous_interval (i);
1144
77c7bcb1 1145 if (!i)
6873cfa3
KH
1146 return limit;
1147
6a0486dd 1148 here_val = textget (i->plist, prop);
9c79dd1b 1149 previous = previous_interval (i);
77c7bcb1 1150 while (previous
111b637d
RS
1151 && EQ (here_val, textget (previous->plist, prop))
1152 && (NILP (limit)
ad077db0 1153 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
9c79dd1b 1154 previous = previous_interval (previous);
9c79dd1b 1155
77c7bcb1 1156 if (!previous
52c0f270
CY
1157 || (previous->position + LENGTH (previous)
1158 <= (INTEGERP (limit)
1159 ? XFASTINT (limit)
1160 : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
1161 return limit;
1162 else
1163 return make_number (previous->position + LENGTH (previous));
9c79dd1b 1164}
fcab51aa 1165\f
708e05f6 1166/* Used by add-text-properties and add-face-text-property. */
c98da214 1167
708e05f6
LMI
1168static Lisp_Object
1169add_text_properties_1 (Lisp_Object start, Lisp_Object end,
1170 Lisp_Object properties, Lisp_Object object,
1171 enum property_set_type set_type) {
ecc0fdd4
PE
1172 INTERVAL i, unchanged;
1173 ptrdiff_t s, len;
1174 bool modified = 0;
c98da214 1175 struct gcpro gcpro1;
81c23309 1176 bool first_time = 1;
d418ef42
JA
1177
1178 properties = validate_plist (properties);
1179 if (NILP (properties))
1180 return Qnil;
1181
5fbe2a44 1182 if (NILP (object))
c8a4fc3d 1183 XSETBUFFER (object, current_buffer);
5fbe2a44 1184
18f2ac09 1185 retry:
d418ef42 1186 i = validate_interval_range (object, &start, &end, hard);
77c7bcb1 1187 if (!i)
d418ef42
JA
1188 return Qnil;
1189
1190 s = XINT (start);
1191 len = XINT (end) - s;
1192
c98da214
RS
1193 /* No need to protect OBJECT, because we GC only if it's a buffer,
1194 and live buffers are always protected. */
1195 GCPRO1 (properties);
1196
0248b0d7
EZ
1197 /* If this interval already has the properties, we can skip it. */
1198 if (interval_has_all_properties (properties, i))
d418ef42 1199 {
ecc0fdd4
PE
1200 ptrdiff_t got = LENGTH (i) - (s - i->position);
1201
1202 do
1203 {
1204 if (got >= len)
1205 RETURN_UNGCPRO (Qnil);
1206 len -= got;
1207 i = next_interval (i);
1208 got = LENGTH (i);
1209 }
1210 while (interval_has_all_properties (properties, i));
0248b0d7
EZ
1211 }
1212 else if (i->position != s)
1213 {
1214 /* If we're not starting on an interval boundary, we have to
1215 split this interval. */
1216 unchanged = i;
1217 i = split_interval_right (unchanged, s - unchanged->position);
1218 copy_properties (unchanged, i);
d418ef42
JA
1219 }
1220
18f2ac09
EZ
1221 if (BUFFERP (object) && first_time)
1222 {
1223 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1224 ptrdiff_t prev_pos = i->position;
1225
00012b86 1226 modify_text_properties (object, start, end);
18f2ac09 1227 /* If someone called us recursively as a side effect of
00012b86 1228 modify_text_properties, and changed the intervals behind our back
18f2ac09
EZ
1229 (could happen if lock_file, called by prepare_to_modify_buffer,
1230 triggers redisplay, and that calls add-text-properties again
1231 in the same buffer), we cannot continue with I, because its
1232 data changed. So we restart the interval analysis anew. */
1233 if (TOTAL_LENGTH (i) != prev_total_length
1234 || i->position != prev_pos)
1235 {
1236 first_time = 0;
1237 goto retry;
1238 }
1239 }
26c76ace 1240
daa5e28f 1241 /* We are at the beginning of interval I, with LEN chars to scan. */
caa31568 1242 for (;;)
d418ef42 1243 {
cce7fefc 1244 eassert (i != 0);
d4b530ad 1245
d418ef42
JA
1246 if (LENGTH (i) >= len)
1247 {
c98da214
RS
1248 /* We can UNGCPRO safely here, because there will be just
1249 one more chance to gc, in the next call to add_properties,
1250 and after that we will not need PROPERTIES or OBJECT again. */
1251 UNGCPRO;
1252
d418ef42 1253 if (interval_has_all_properties (properties, i))
26c76ace 1254 {
2a631db1
RS
1255 if (BUFFERP (object))
1256 signal_after_change (XINT (start), XINT (end) - XINT (start),
1257 XINT (end) - XINT (start));
26c76ace 1258
0248b0d7
EZ
1259 eassert (modified);
1260 return Qt;
26c76ace 1261 }
d418ef42
JA
1262
1263 if (LENGTH (i) == len)
1264 {
708e05f6 1265 add_properties (properties, i, object, set_type);
2a631db1
RS
1266 if (BUFFERP (object))
1267 signal_after_change (XINT (start), XINT (end) - XINT (start),
1268 XINT (end) - XINT (start));
d418ef42
JA
1269 return Qt;
1270 }
1271
1272 /* i doesn't have the properties, and goes past the change limit */
1273 unchanged = i;
ad9c1940 1274 i = split_interval_left (unchanged, len);
d418ef42 1275 copy_properties (unchanged, i);
708e05f6 1276 add_properties (properties, i, object, set_type);
2a631db1
RS
1277 if (BUFFERP (object))
1278 signal_after_change (XINT (start), XINT (end) - XINT (start),
1279 XINT (end) - XINT (start));
d418ef42
JA
1280 return Qt;
1281 }
1282
1283 len -= LENGTH (i);
708e05f6 1284 modified |= add_properties (properties, i, object, set_type);
d418ef42
JA
1285 i = next_interval (i);
1286 }
1287}
1288
c98da214
RS
1289/* Callers note, this can GC when OBJECT is a buffer (or nil). */
1290
708e05f6
LMI
1291DEFUN ("add-text-properties", Fadd_text_properties,
1292 Sadd_text_properties, 3, 4, 0,
1293 doc: /* Add properties to the text from START to END.
1294The third argument PROPERTIES is a property list
1295specifying the property values to add. If the optional fourth argument
1296OBJECT is a buffer (or nil, which means the current buffer),
1297START and END are buffer positions (integers or markers).
1298If OBJECT is a string, START and END are 0-based indices into it.
1299Return t if any property value actually changed, nil otherwise. */)
1300 (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1301 Lisp_Object object)
1302{
1303 return add_text_properties_1 (start, end, properties, object,
1304 TEXT_PROPERTY_REPLACE);
1305}
1306
1307/* Callers note, this can GC when OBJECT is a buffer (or nil). */
1308
a7ca3326 1309DEFUN ("put-text-property", Fput_text_property,
d4b530ad 1310 Sput_text_property, 4, 5, 0,
8c1a1077
PJ
1311 doc: /* Set one property of the text from START to END.
1312The third and fourth arguments PROPERTY and VALUE
1313specify the property to add.
81f6e55f
FP
1314If the optional fifth argument OBJECT is a buffer (or nil, which means
1315the current buffer), START and END are buffer positions (integers or
1316markers). If OBJECT is a string, START and END are 0-based indices into it. */)
5842a27b 1317 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
d4b530ad 1318{
6c6f1994 1319 Fadd_text_properties (start, end, list2 (property, value), object);
d4b530ad
RS
1320 return Qnil;
1321}
1322
a7ca3326 1323DEFUN ("set-text-properties", Fset_text_properties,
5fbe2a44 1324 Sset_text_properties, 3, 4, 0,
8c1a1077
PJ
1325 doc: /* Completely replace properties of text from START to END.
1326The third argument PROPERTIES is the new property list.
81f6e55f
FP
1327If the optional fourth argument OBJECT is a buffer (or nil, which means
1328the current buffer), START and END are buffer positions (integers or
1329markers). If OBJECT is a string, START and END are 0-based indices into it.
8c1a1077
PJ
1330If PROPERTIES is nil, the effect is to remove all properties from
1331the designated part of OBJECT. */)
5842a27b 1332 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
0087ade6
GM
1333{
1334 return set_text_properties (start, end, properties, object, Qt);
1335}
1336
1337
708e05f6
LMI
1338DEFUN ("add-face-text-property", Fadd_face_text_property,
1339 Sadd_face_text_property, 3, 5, 0,
1340 doc: /* Add the face property to the text from START to END.
1341The third argument FACE specifies the face to add.
1342If any text in the region already has any face properties, this new
1343face property will be added to the front of the face property list.
1344If the optional fourth argument APPENDP is non-nil, append to the end
1345of the face property list instead.
1346If the optional fifth argument OBJECT is a buffer (or nil, which means
1347the current buffer), START and END are buffer positions (integers or
1348markers). If OBJECT is a string, START and END are 0-based indices
1349into it. */)
1350 (Lisp_Object start, Lisp_Object end, Lisp_Object face,
1351 Lisp_Object appendp, Lisp_Object object)
1352{
6c6f1994
PE
1353 add_text_properties_1 (start, end, list2 (Qface, face), object,
1354 (NILP (appendp)
1355 ? TEXT_PROPERTY_PREPEND
1356 : TEXT_PROPERTY_APPEND));
708e05f6
LMI
1357 return Qnil;
1358}
1359
0087ade6
GM
1360/* Replace properties of text from START to END with new list of
1361 properties PROPERTIES. OBJECT is the buffer or string containing
1362 the text. OBJECT nil means use the current buffer.
9c345213
AM
1363 COHERENT_CHANGE_P nil means this is being called as an internal
1364 subroutine, rather than as a change primitive with checking of
1365 read-only, invoking change hooks, etc.. Value is nil if the
1366 function _detected_ that it did not replace any properties, non-nil
1367 otherwise. */
0087ade6
GM
1368
1369Lisp_Object
00012b86
DA
1370set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
1371 Lisp_Object object, Lisp_Object coherent_change_p)
d418ef42 1372{
28ff4293 1373 register INTERVAL i;
33d7d0df
RS
1374 Lisp_Object ostart, oend;
1375
1376 ostart = start;
1377 oend = end;
d418ef42 1378
1f5e848a 1379 properties = validate_plist (properties);
d418ef42 1380
5fbe2a44 1381 if (NILP (object))
c8a4fc3d 1382 XSETBUFFER (object, current_buffer);
5fbe2a44 1383
919fa9cb
RS
1384 /* If we want no properties for a whole string,
1385 get rid of its intervals. */
1f5e848a 1386 if (NILP (properties) && STRINGP (object)
919fa9cb 1387 && XFASTINT (start) == 0
d5db4077 1388 && XFASTINT (end) == SCHARS (object))
919fa9cb 1389 {
0c94c8d6 1390 if (!string_intervals (object))
537562fa 1391 return Qnil;
26c76ace 1392
0c94c8d6 1393 set_string_intervals (object, NULL);
919fa9cb
RS
1394 return Qt;
1395 }
1396
facc570e 1397 i = validate_interval_range (object, &start, &end, soft);
919fa9cb 1398
77c7bcb1 1399 if (!i)
facc570e 1400 {
1f5e848a
EN
1401 /* If buffer has no properties, and we want none, return now. */
1402 if (NILP (properties))
facc570e
RS
1403 return Qnil;
1404
33d7d0df
RS
1405 /* Restore the original START and END values
1406 because validate_interval_range increments them for strings. */
1407 start = ostart;
1408 end = oend;
1409
facc570e
RS
1410 i = validate_interval_range (object, &start, &end, hard);
1411 /* This can return if start == end. */
77c7bcb1 1412 if (!i)
facc570e
RS
1413 return Qnil;
1414 }
d418ef42 1415
9c345213 1416 if (BUFFERP (object) && !NILP (coherent_change_p))
00012b86 1417 modify_text_properties (object, start, end);
26c76ace 1418
78ff4175
RS
1419 set_text_properties_1 (start, end, properties, object, i);
1420
9c345213 1421 if (BUFFERP (object) && !NILP (coherent_change_p))
78ff4175
RS
1422 signal_after_change (XINT (start), XINT (end) - XINT (start),
1423 XINT (end) - XINT (start));
1424 return Qt;
1425}
1426
1427/* Replace properties of text from START to END with new list of
1687fb14 1428 properties PROPERTIES. OBJECT is the buffer or string containing
78ff4175 1429 the text. This does not obey any hooks.
1687fb14 1430 You should provide the interval that START is located in as I.
49f68fd2 1431 START and END can be in any order. */
78ff4175
RS
1432
1433void
1687fb14 1434set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, INTERVAL i)
78ff4175 1435{
77c7bcb1 1436 register INTERVAL prev_changed = NULL;
d311d28c 1437 register ptrdiff_t s, len;
78ff4175
RS
1438 INTERVAL unchanged;
1439
67769ffc 1440 if (XINT (start) < XINT (end))
49f68fd2 1441 {
67769ffc
PE
1442 s = XINT (start);
1443 len = XINT (end) - s;
49f68fd2 1444 }
67769ffc
PE
1445 else if (XINT (end) < XINT (start))
1446 {
1447 s = XINT (end);
1448 len = XINT (start) - s;
1449 }
1450 else
1451 return;
49f68fd2 1452
1687fb14 1453 eassert (i);
78ff4175 1454
d418ef42
JA
1455 if (i->position != s)
1456 {
1457 unchanged = i;
ad9c1940 1458 i = split_interval_right (unchanged, s - unchanged->position);
7855e674 1459
d418ef42
JA
1460 if (LENGTH (i) > len)
1461 {
9c79dd1b 1462 copy_properties (unchanged, i);
ad9c1940 1463 i = split_interval_left (i, len);
1687fb14 1464 set_properties (properties, i, object);
78ff4175 1465 return;
d418ef42
JA
1466 }
1467
1687fb14 1468 set_properties (properties, i, object);
daa5e28f 1469
9c79dd1b 1470 if (LENGTH (i) == len)
78ff4175 1471 return;
9c79dd1b
JA
1472
1473 prev_changed = i;
d418ef42
JA
1474 len -= LENGTH (i);
1475 i = next_interval (i);
1476 }
1477
1e792e4d
PE
1478 /* We are starting at the beginning of an interval I. LEN is positive. */
1479 do
d418ef42 1480 {
cce7fefc 1481 eassert (i != 0);
d4b530ad 1482
d418ef42
JA
1483 if (LENGTH (i) >= len)
1484 {
cd7d971d 1485 if (LENGTH (i) > len)
ad9c1940 1486 i = split_interval_left (i, len);
d418ef42 1487
6f232881
RS
1488 /* We have to call set_properties even if we are going to
1489 merge the intervals, so as to make the undo records
1490 and cause redisplay to happen. */
1687fb14 1491 set_properties (properties, i, object);
77c7bcb1 1492 if (prev_changed)
9c79dd1b 1493 merge_interval_left (i);
78ff4175 1494 return;
d418ef42
JA
1495 }
1496
1497 len -= LENGTH (i);
6f232881
RS
1498
1499 /* We have to call set_properties even if we are going to
1500 merge the intervals, so as to make the undo records
1501 and cause redisplay to happen. */
1687fb14 1502 set_properties (properties, i, object);
77c7bcb1 1503 if (!prev_changed)
6f232881 1504 prev_changed = i;
9c79dd1b
JA
1505 else
1506 prev_changed = i = merge_interval_left (i);
1507
d418ef42
JA
1508 i = next_interval (i);
1509 }
1e792e4d 1510 while (len > 0);
d418ef42
JA
1511}
1512
a7ca3326 1513DEFUN ("remove-text-properties", Fremove_text_properties,
5fbe2a44 1514 Sremove_text_properties, 3, 4, 0,
8c1a1077
PJ
1515 doc: /* Remove some properties from text from START to END.
1516The third argument PROPERTIES is a property list
1517whose property names specify the properties to remove.
1518\(The values stored in PROPERTIES are ignored.)
81f6e55f
FP
1519If the optional fourth argument OBJECT is a buffer (or nil, which means
1520the current buffer), START and END are buffer positions (integers or
1521markers). If OBJECT is a string, START and END are 0-based indices into it.
1522Return t if any property was actually removed, nil otherwise.
1523
518c0b83 1524Use `set-text-properties' if you want to remove all text properties. */)
5842a27b 1525 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
d418ef42 1526{
ecc0fdd4
PE
1527 INTERVAL i, unchanged;
1528 ptrdiff_t s, len;
1529 bool modified = 0;
81c23309 1530 bool first_time = 1;
d418ef42 1531
5fbe2a44 1532 if (NILP (object))
c8a4fc3d 1533 XSETBUFFER (object, current_buffer);
5fbe2a44 1534
18f2ac09 1535 retry:
d418ef42 1536 i = validate_interval_range (object, &start, &end, soft);
77c7bcb1 1537 if (!i)
d418ef42
JA
1538 return Qnil;
1539
1540 s = XINT (start);
1541 len = XINT (end) - s;
9c79dd1b 1542
0248b0d7
EZ
1543 /* If there are no properties on this entire interval, return. */
1544 if (! interval_has_some_properties (properties, i))
d418ef42 1545 {
ecc0fdd4
PE
1546 ptrdiff_t got = LENGTH (i) - (s - i->position);
1547
1548 do
1549 {
1550 if (got >= len)
1551 return Qnil;
1552 len -= got;
1553 i = next_interval (i);
1554 got = LENGTH (i);
1555 }
1556 while (! interval_has_some_properties (properties, i));
0248b0d7
EZ
1557 }
1558 /* Split away the beginning of this interval; what we don't
1559 want to modify. */
1560 else if (i->position != s)
1561 {
1562 unchanged = i;
1563 i = split_interval_right (unchanged, s - unchanged->position);
1564 copy_properties (unchanged, i);
d418ef42
JA
1565 }
1566
18f2ac09
EZ
1567 if (BUFFERP (object) && first_time)
1568 {
1569 ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
1570 ptrdiff_t prev_pos = i->position;
1571
00012b86 1572 modify_text_properties (object, start, end);
18f2ac09 1573 /* If someone called us recursively as a side effect of
00012b86 1574 modify_text_properties, and changed the intervals behind our back
18f2ac09
EZ
1575 (could happen if lock_file, called by prepare_to_modify_buffer,
1576 triggers redisplay, and that calls add-text-properties again
1577 in the same buffer), we cannot continue with I, because its
1578 data changed. So we restart the interval analysis anew. */
1579 if (TOTAL_LENGTH (i) != prev_total_length
1580 || i->position != prev_pos)
1581 {
1582 first_time = 0;
1583 goto retry;
1584 }
1585 }
26c76ace 1586
d418ef42 1587 /* We are at the beginning of an interval, with len to scan */
caa31568 1588 for (;;)
d418ef42 1589 {
cce7fefc 1590 eassert (i != 0);
d4b530ad 1591
d418ef42
JA
1592 if (LENGTH (i) >= len)
1593 {
1f5e848a 1594 if (! interval_has_some_properties (properties, i))
0248b0d7
EZ
1595 {
1596 eassert (modified);
1597 if (BUFFERP (object))
1598 signal_after_change (XINT (start), XINT (end) - XINT (start),
1599 XINT (end) - XINT (start));
1600 return Qt;
1601 }
d418ef42
JA
1602
1603 if (LENGTH (i) == len)
1604 {
11713b6d
RS
1605 remove_properties (properties, Qnil, i, object);
1606 if (BUFFERP (object))
1607 signal_after_change (XINT (start), XINT (end) - XINT (start),
1608 XINT (end) - XINT (start));
1609 return Qt;
1610 }
1611
1612 /* i has the properties, and goes past the change limit */
1613 unchanged = i;
1614 i = split_interval_left (i, len);
1615 copy_properties (unchanged, i);
1616 remove_properties (properties, Qnil, i, object);
1617 if (BUFFERP (object))
1618 signal_after_change (XINT (start), XINT (end) - XINT (start),
1619 XINT (end) - XINT (start));
1620 return Qt;
1621 }
1622
1623 len -= LENGTH (i);
ecc0fdd4 1624 modified |= remove_properties (properties, Qnil, i, object);
11713b6d
RS
1625 i = next_interval (i);
1626 }
1627}
1628
a7ca3326 1629DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
11713b6d
RS
1630 Sremove_list_of_text_properties, 3, 4, 0,
1631 doc: /* Remove some properties from text from START to END.
1632The third argument LIST-OF-PROPERTIES is a list of property names to remove.
81f6e55f
FP
1633If the optional fourth argument OBJECT is a buffer (or nil, which means
1634the current buffer), START and END are buffer positions (integers or
1635markers). If OBJECT is a string, START and END are 0-based indices into it.
11713b6d 1636Return t if any property was actually removed, nil otherwise. */)
5842a27b 1637 (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
11713b6d 1638{
ecc0fdd4
PE
1639 INTERVAL i, unchanged;
1640 ptrdiff_t s, len;
1641 bool modified = 0;
11713b6d
RS
1642 Lisp_Object properties;
1643 properties = list_of_properties;
1644
1645 if (NILP (object))
1646 XSETBUFFER (object, current_buffer);
1647
1648 i = validate_interval_range (object, &start, &end, soft);
77c7bcb1 1649 if (!i)
11713b6d
RS
1650 return Qnil;
1651
1652 s = XINT (start);
1653 len = XINT (end) - s;
1654
0248b0d7
EZ
1655 /* If there are no properties on the interval, return. */
1656 if (! interval_has_some_properties_list (properties, i))
11713b6d 1657 {
ecc0fdd4
PE
1658 ptrdiff_t got = LENGTH (i) - (s - i->position);
1659
1660 do
1661 {
1662 if (got >= len)
1663 return Qnil;
1664 len -= got;
1665 i = next_interval (i);
1666 got = LENGTH (i);
1667 }
1668 while (! interval_has_some_properties_list (properties, i));
0248b0d7
EZ
1669 }
1670 /* Split away the beginning of this interval; what we don't
1671 want to modify. */
1672 else if (i->position != s)
1673 {
1674 unchanged = i;
1675 i = split_interval_right (unchanged, s - unchanged->position);
1676 copy_properties (unchanged, i);
11713b6d
RS
1677 }
1678
9b17c9f5
LH
1679 /* We are at the beginning of an interval, with len to scan.
1680 The flag `modified' records if changes have been made.
00012b86
DA
1681 When object is a buffer, we must call modify_text_properties
1682 before changes are made and signal_after_change when we are done.
1683 We call modify_text_properties before calling remove_properties if modified == 0,
e0f24100 1684 and we call signal_after_change before returning if modified != 0. */
11713b6d
RS
1685 for (;;)
1686 {
cce7fefc 1687 eassert (i != 0);
11713b6d
RS
1688
1689 if (LENGTH (i) >= len)
1690 {
1691 if (! interval_has_some_properties_list (properties, i))
ef1b0ba7
SM
1692 {
1693 if (modified)
1694 {
1695 if (BUFFERP (object))
1696 signal_after_change (XINT (start),
1697 XINT (end) - XINT (start),
1698 XINT (end) - XINT (start));
1699 return Qt;
1700 }
1701 else
1702 return Qnil;
1703 }
1704 else if (LENGTH (i) == len)
11713b6d 1705 {
9b17c9f5 1706 if (!modified && BUFFERP (object))
00012b86 1707 modify_text_properties (object, start, end);
11713b6d 1708 remove_properties (Qnil, properties, i, object);
2a631db1
RS
1709 if (BUFFERP (object))
1710 signal_after_change (XINT (start), XINT (end) - XINT (start),
1711 XINT (end) - XINT (start));
d418ef42
JA
1712 return Qt;
1713 }
ef1b0ba7
SM
1714 else
1715 { /* i has the properties, and goes past the change limit. */
1716 unchanged = i;
1717 i = split_interval_left (i, len);
1718 copy_properties (unchanged, i);
1719 if (!modified && BUFFERP (object))
00012b86 1720 modify_text_properties (object, start, end);
ef1b0ba7
SM
1721 remove_properties (Qnil, properties, i, object);
1722 if (BUFFERP (object))
1723 signal_after_change (XINT (start), XINT (end) - XINT (start),
1724 XINT (end) - XINT (start));
1725 return Qt;
1726 }
d418ef42 1727 }
9b17c9f5
LH
1728 if (interval_has_some_properties_list (properties, i))
1729 {
1730 if (!modified && BUFFERP (object))
00012b86 1731 modify_text_properties (object, start, end);
9b17c9f5
LH
1732 remove_properties (Qnil, properties, i, object);
1733 modified = 1;
1734 }
d418ef42 1735 len -= LENGTH (i);
d418ef42
JA
1736 i = next_interval (i);
1737 }
1738}
fcab51aa 1739\f
a7ca3326 1740DEFUN ("text-property-any", Ftext_property_any,
ad9c1940 1741 Stext_property_any, 4, 5, 0,
fa463103 1742 doc: /* Check text from START to END for property PROPERTY equaling VALUE.
8c1a1077
PJ
1743If so, return the position of the first character whose property PROPERTY
1744is `eq' to VALUE. Otherwise return nil.
81f6e55f
FP
1745If the optional fifth argument OBJECT is a buffer (or nil, which means
1746the current buffer), START and END are buffer positions (integers or
1747markers). If OBJECT is a string, START and END are 0-based indices into it. */)
5842a27b 1748 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
ad9c1940
JB
1749{
1750 register INTERVAL i;
d311d28c 1751 register ptrdiff_t e, pos;
ad9c1940
JB
1752
1753 if (NILP (object))
c8a4fc3d 1754 XSETBUFFER (object, current_buffer);
ad9c1940 1755 i = validate_interval_range (object, &start, &end, soft);
77c7bcb1 1756 if (!i)
2084fddb 1757 return (!NILP (value) || EQ (start, end) ? Qnil : start);
ad9c1940
JB
1758 e = XINT (end);
1759
77c7bcb1 1760 while (i)
ad9c1940
JB
1761 {
1762 if (i->position >= e)
1763 break;
1f5e848a 1764 if (EQ (textget (i->plist, property), value))
ad9c1940
JB
1765 {
1766 pos = i->position;
1767 if (pos < XINT (start))
1768 pos = XINT (start);
ad077db0 1769 return make_number (pos);
ad9c1940
JB
1770 }
1771 i = next_interval (i);
1772 }
1773 return Qnil;
1774}
1775
1776DEFUN ("text-property-not-all", Ftext_property_not_all,
1777 Stext_property_not_all, 4, 5, 0,
fa463103 1778 doc: /* Check text from START to END for property PROPERTY not equaling VALUE.
8c1a1077
PJ
1779If so, return the position of the first character whose property PROPERTY
1780is not `eq' to VALUE. Otherwise, return nil.
81f6e55f
FP
1781If the optional fifth argument OBJECT is a buffer (or nil, which means
1782the current buffer), START and END are buffer positions (integers or
1783markers). If OBJECT is a string, START and END are 0-based indices into it. */)
5842a27b 1784 (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
ad9c1940
JB
1785{
1786 register INTERVAL i;
d311d28c 1787 register ptrdiff_t s, e;
ad9c1940
JB
1788
1789 if (NILP (object))
c8a4fc3d 1790 XSETBUFFER (object, current_buffer);
ad9c1940 1791 i = validate_interval_range (object, &start, &end, soft);
77c7bcb1 1792 if (!i)
916a3119 1793 return (NILP (value) || EQ (start, end)) ? Qnil : start;
ad9c1940
JB
1794 s = XINT (start);
1795 e = XINT (end);
1796
77c7bcb1 1797 while (i)
ad9c1940
JB
1798 {
1799 if (i->position >= e)
1800 break;
1f5e848a 1801 if (! EQ (textget (i->plist, property), value))
ad9c1940
JB
1802 {
1803 if (i->position > s)
1804 s = i->position;
ad077db0 1805 return make_number (s);
ad9c1940
JB
1806 }
1807 i = next_interval (i);
1808 }
1809 return Qnil;
1810}
e138dfdc
MB
1811
1812\f
1813/* Return the direction from which the text-property PROP would be
1814 inherited by any new text inserted at POS: 1 if it would be
1815 inherited from the char after POS, -1 if it would be inherited from
6f716644
SM
1816 the char before POS, and 0 if from neither.
1817 BUFFER can be either a buffer or nil (meaning current buffer). */
e138dfdc
MB
1818
1819int
971de7fb 1820text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
e138dfdc
MB
1821{
1822 Lisp_Object prev_pos, front_sticky;
ecc0fdd4 1823 bool is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
cabf1cac 1824 Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
e138dfdc 1825
6f716644
SM
1826 if (NILP (buffer))
1827 XSETBUFFER (buffer, current_buffer);
1828
cabf1cac
SM
1829 if (CONSP (defalt) && !NILP (XCDR (defalt)))
1830 is_rear_sticky = 0;
1831
6f716644 1832 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
e138dfdc
MB
1833 /* Consider previous character. */
1834 {
1835 Lisp_Object rear_non_sticky;
1836
1837 prev_pos = make_number (XINT (pos) - 1);
6f716644 1838 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
e138dfdc
MB
1839
1840 if (!NILP (CONSP (rear_non_sticky)
1841 ? Fmemq (prop, rear_non_sticky)
1842 : rear_non_sticky))
1843 /* PROP is rear-non-sticky. */
1844 is_rear_sticky = 0;
1845 }
506d2f9a
CY
1846 else
1847 return 0;
e138dfdc
MB
1848
1849 /* Consider following character. */
506d2f9a
CY
1850 /* This signals an arg-out-of-range error if pos is outside the
1851 buffer's accessible range. */
6f716644 1852 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
e138dfdc
MB
1853
1854 if (EQ (front_sticky, Qt)
1855 || (CONSP (front_sticky)
1856 && !NILP (Fmemq (prop, front_sticky))))
1857 /* PROP is inherited from after. */
1858 is_front_sticky = 1;
1859
1860 /* Simple cases, where the properties are consistent. */
1861 if (is_rear_sticky && !is_front_sticky)
1862 return -1;
1863 else if (!is_rear_sticky && is_front_sticky)
1864 return 1;
1865 else if (!is_rear_sticky && !is_front_sticky)
1866 return 0;
1867
1868 /* The stickiness properties are inconsistent, so we have to
1869 disambiguate. Basically, rear-sticky wins, _except_ if the
1870 property that would be inherited has a value of nil, in which case
1871 front-sticky wins. */
6f716644
SM
1872 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
1873 || NILP (Fget_text_property (prev_pos, prop, buffer)))
e138dfdc
MB
1874 return 1;
1875 else
1876 return -1;
1877}
1878
fcab51aa 1879\f
e2ad650c 1880/* Copying properties between objects. */
15e4954b 1881
e2ad650c 1882/* Add properties from START to END of SRC, starting at POS in DEST.
c98da214
RS
1883 SRC and DEST may each refer to strings or buffers.
1884 Optional sixth argument PROP causes only that property to be copied.
1885 Properties are copied to DEST as if by `add-text-properties'.
1886 Return t if any property value actually changed, nil otherwise. */
1887
1888/* Note this can GC when DEST is a buffer. */
ad077db0 1889
15e4954b 1890Lisp_Object
971de7fb 1891copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
15e4954b
JB
1892{
1893 INTERVAL i;
1894 Lisp_Object res;
1895 Lisp_Object stuff;
1896 Lisp_Object plist;
d311d28c 1897 ptrdiff_t s, e, e2, p, len;
ecc0fdd4 1898 bool modified = 0;
c98da214 1899 struct gcpro gcpro1, gcpro2;
15e4954b
JB
1900
1901 i = validate_interval_range (src, &start, &end, soft);
77c7bcb1 1902 if (!i)
15e4954b
JB
1903 return Qnil;
1904
b7826503 1905 CHECK_NUMBER_COERCE_MARKER (pos);
15e4954b
JB
1906 {
1907 Lisp_Object dest_start, dest_end;
1908
d311d28c
PE
1909 e = XINT (pos) + (XINT (end) - XINT (start));
1910 if (MOST_POSITIVE_FIXNUM < e)
1911 args_out_of_range (pos, end);
15e4954b 1912 dest_start = pos;
d311d28c 1913 XSETFASTINT (dest_end, e);
15e4954b
JB
1914 /* Apply this to a copy of pos; it will try to increment its arguments,
1915 which we don't want. */
1916 validate_interval_range (dest, &dest_start, &dest_end, soft);
1917 }
1918
1919 s = XINT (start);
1920 e = XINT (end);
1921 p = XINT (pos);
1922
1923 stuff = Qnil;
1924
1925 while (s < e)
1926 {
1927 e2 = i->position + LENGTH (i);
1928 if (e2 > e)
1929 e2 = e;
1930 len = e2 - s;
1931
1932 plist = i->plist;
1933 if (! NILP (prop))
1934 while (! NILP (plist))
1935 {
1936 if (EQ (Fcar (plist), prop))
1937 {
6c6f1994 1938 plist = list2 (prop, Fcar (Fcdr (plist)));
15e4954b
JB
1939 break;
1940 }
1941 plist = Fcdr (Fcdr (plist));
1942 }
1943 if (! NILP (plist))
1944 {
1945 /* Must defer modifications to the interval tree in case src
cdf3e5a2 1946 and dest refer to the same string or buffer. */
6c6f1994
PE
1947 stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
1948 stuff);
15e4954b
JB
1949 }
1950
1951 i = next_interval (i);
77c7bcb1 1952 if (!i)
15e4954b
JB
1953 break;
1954
1955 p += len;
1956 s = i->position;
1957 }
1958
c98da214
RS
1959 GCPRO2 (stuff, dest);
1960
15e4954b
JB
1961 while (! NILP (stuff))
1962 {
1963 res = Fcar (stuff);
1964 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
1965 Fcar (Fcdr (Fcdr (res))), dest);
1966 if (! NILP (res))
ecc0fdd4 1967 modified = 1;
15e4954b
JB
1968 stuff = Fcdr (stuff);
1969 }
1970
c98da214
RS
1971 UNGCPRO;
1972
15e4954b
JB
1973 return modified ? Qt : Qnil;
1974}
9dd7eec6
GM
1975
1976
1977/* Return a list representing the text properties of OBJECT between
1978 START and END. if PROP is non-nil, report only on that property.
1979 Each result list element has the form (S E PLIST), where S and E
1980 are positions in OBJECT and PLIST is a property list containing the
1981 text properties of OBJECT between S and E. Value is nil if OBJECT
1982 doesn't contain text properties between START and END. */
1983
1984Lisp_Object
971de7fb 1985text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object prop)
9dd7eec6
GM
1986{
1987 struct interval *i;
1988 Lisp_Object result;
9dd7eec6
GM
1989
1990 result = Qnil;
81f6e55f 1991
9dd7eec6 1992 i = validate_interval_range (object, &start, &end, soft);
77c7bcb1 1993 if (i)
9dd7eec6 1994 {
d311d28c
PE
1995 ptrdiff_t s = XINT (start);
1996 ptrdiff_t e = XINT (end);
81f6e55f 1997
9dd7eec6
GM
1998 while (s < e)
1999 {
d311d28c 2000 ptrdiff_t interval_end, len;
9dd7eec6 2001 Lisp_Object plist;
81f6e55f 2002
9dd7eec6
GM
2003 interval_end = i->position + LENGTH (i);
2004 if (interval_end > e)
2005 interval_end = e;
2006 len = interval_end - s;
81f6e55f 2007
9dd7eec6
GM
2008 plist = i->plist;
2009
2010 if (!NILP (prop))
99784d63
SM
2011 for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
2012 if (EQ (XCAR (plist), prop))
9dd7eec6 2013 {
6c6f1994 2014 plist = list2 (prop, Fcar (XCDR (plist)));
9dd7eec6
GM
2015 break;
2016 }
2017
2018 if (!NILP (plist))
6c6f1994
PE
2019 result = Fcons (list3 (make_number (s), make_number (s + len),
2020 plist),
9dd7eec6 2021 result);
81f6e55f 2022
9dd7eec6 2023 i = next_interval (i);
77c7bcb1 2024 if (!i)
9dd7eec6
GM
2025 break;
2026 s = i->position;
2027 }
2028 }
81f6e55f 2029
9dd7eec6
GM
2030 return result;
2031}
2032
2033
2034/* Add text properties to OBJECT from LIST. LIST is a list of triples
2035 (START END PLIST), where START and END are positions and PLIST is a
2036 property list containing the text properties to add. Adjust START
ecc0fdd4 2037 and END positions by DELTA before adding properties. */
9dd7eec6 2038
ecc0fdd4 2039void
971de7fb 2040add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
9dd7eec6
GM
2041{
2042 struct gcpro gcpro1, gcpro2;
81f6e55f 2043
9dd7eec6 2044 GCPRO2 (list, object);
81f6e55f 2045
9dd7eec6
GM
2046 for (; CONSP (list); list = XCDR (list))
2047 {
ecc0fdd4 2048 Lisp_Object item, start, end, plist;
81f6e55f 2049
9dd7eec6
GM
2050 item = XCAR (list);
2051 start = make_number (XINT (XCAR (item)) + XINT (delta));
2052 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
2053 plist = XCAR (XCDR (XCDR (item)));
81f6e55f 2054
ecc0fdd4 2055 Fadd_text_properties (start, end, plist, object);
9dd7eec6
GM
2056 }
2057
2058 UNGCPRO;
9dd7eec6
GM
2059}
2060
2061
2062
e398c61c
CY
2063/* Modify end-points of ranges in LIST destructively, and return the
2064 new list. LIST is a list as returned from text_property_list.
2065 Discard properties that begin at or after NEW_END, and limit
2066 end-points to NEW_END. */
9dd7eec6 2067
e398c61c 2068Lisp_Object
971de7fb 2069extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
9dd7eec6 2070{
e398c61c 2071 Lisp_Object prev = Qnil, head = list;
d311d28c 2072 ptrdiff_t max = XINT (new_end);
e398c61c
CY
2073
2074 for (; CONSP (list); prev = list, list = XCDR (list))
9dd7eec6 2075 {
e398c61c 2076 Lisp_Object item, beg, end;
81f6e55f 2077
9dd7eec6 2078 item = XCAR (list);
e398c61c 2079 beg = XCAR (item);
9dd7eec6
GM
2080 end = XCAR (XCDR (item));
2081
e398c61c
CY
2082 if (XINT (beg) >= max)
2083 {
2084 /* The start-point is past the end of the new string.
2085 Discard this property. */
2086 if (EQ (head, list))
2087 head = XCDR (list);
2088 else
2089 XSETCDR (prev, XCDR (list));
2090 }
2091 else if (XINT (end) > max)
2092 /* The end-point is past the end of the new string. */
f3fbd155 2093 XSETCAR (XCDR (item), new_end);
9dd7eec6 2094 }
e398c61c
CY
2095
2096 return head;
9dd7eec6
GM
2097}
2098
2099
318d2fa8
RS
2100\f
2101/* Call the modification hook functions in LIST, each with START and END. */
2102
2103static void
971de7fb 2104call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
318d2fa8
RS
2105{
2106 struct gcpro gcpro1;
2107 GCPRO1 (list);
2108 while (!NILP (list))
2109 {
2110 call2 (Fcar (list), start, end);
2111 list = Fcdr (list);
2112 }
2113 UNGCPRO;
2114}
2115
96f90544
RS
2116/* Check for read-only intervals between character positions START ... END,
2117 in BUF, and signal an error if we find one.
2118
2119 Then check for any modification hooks in the range.
2120 Create a list of all these hooks in lexicographic order,
2121 eliminating consecutive extra copies of the same hook. Then call
2122 those hooks in order, with START and END - 1 as arguments. */
15e4954b 2123
318d2fa8 2124void
d1dfb56c 2125verify_interval_modification (struct buffer *buf,
d311d28c 2126 ptrdiff_t start, ptrdiff_t end)
318d2fa8 2127{
0c94c8d6
PE
2128 INTERVAL intervals = buffer_intervals (buf);
2129 INTERVAL i;
318d2fa8 2130 Lisp_Object hooks;
0c94c8d6 2131 Lisp_Object prev_mod_hooks;
318d2fa8
RS
2132 Lisp_Object mod_hooks;
2133 struct gcpro gcpro1;
2134
2135 hooks = Qnil;
2136 prev_mod_hooks = Qnil;
2137 mod_hooks = Qnil;
2138
2139 interval_insert_behind_hooks = Qnil;
2140 interval_insert_in_front_hooks = Qnil;
2141
77c7bcb1 2142 if (!intervals)
318d2fa8
RS
2143 return;
2144
2145 if (start > end)
2146 {
d311d28c 2147 ptrdiff_t temp = start;
318d2fa8
RS
2148 start = end;
2149 end = temp;
2150 }
2151
2152 /* For an insert operation, check the two chars around the position. */
2153 if (start == end)
2154 {
7cb66899 2155 INTERVAL prev = NULL;
318d2fa8
RS
2156 Lisp_Object before, after;
2157
2158 /* Set I to the interval containing the char after START,
2159 and PREV to the interval containing the char before START.
2160 Either one may be null. They may be equal. */
2161 i = find_interval (intervals, start);
2162
2163 if (start == BUF_BEGV (buf))
2164 prev = 0;
2165 else if (i->position == start)
2166 prev = previous_interval (i);
2167 else if (i->position < start)
2168 prev = i;
2169 if (start == BUF_ZV (buf))
2170 i = 0;
2171
2172 /* If Vinhibit_read_only is set and is not a list, we can
2173 skip the read_only checks. */
2174 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
2175 {
2176 /* If I and PREV differ we need to check for the read-only
cdf3e5a2 2177 property together with its stickiness. If either I or
318d2fa8
RS
2178 PREV are 0, this check is all we need.
2179 We have to take special care, since read-only may be
2180 indirectly defined via the category property. */
2181 if (i != prev)
2182 {
77c7bcb1 2183 if (i)
318d2fa8
RS
2184 {
2185 after = textget (i->plist, Qread_only);
81f6e55f 2186
318d2fa8
RS
2187 /* If interval I is read-only and read-only is
2188 front-sticky, inhibit insertion.
2189 Check for read-only as well as category. */
2190 if (! NILP (after)
2191 && NILP (Fmemq (after, Vinhibit_read_only)))
2192 {
2193 Lisp_Object tem;
2194
2195 tem = textget (i->plist, Qfront_sticky);
2196 if (TMEM (Qread_only, tem)
2197 || (NILP (Fplist_get (i->plist, Qread_only))
2198 && TMEM (Qcategory, tem)))
bcf97349 2199 text_read_only (after);
318d2fa8
RS
2200 }
2201 }
2202
77c7bcb1 2203 if (prev)
318d2fa8
RS
2204 {
2205 before = textget (prev->plist, Qread_only);
81f6e55f 2206
318d2fa8
RS
2207 /* If interval PREV is read-only and read-only isn't
2208 rear-nonsticky, inhibit insertion.
2209 Check for read-only as well as category. */
2210 if (! NILP (before)
2211 && NILP (Fmemq (before, Vinhibit_read_only)))
2212 {
2213 Lisp_Object tem;
2214
2215 tem = textget (prev->plist, Qrear_nonsticky);
2216 if (! TMEM (Qread_only, tem)
2217 && (! NILP (Fplist_get (prev->plist,Qread_only))
2218 || ! TMEM (Qcategory, tem)))
bcf97349 2219 text_read_only (before);
318d2fa8
RS
2220 }
2221 }
2222 }
77c7bcb1 2223 else if (i)
318d2fa8
RS
2224 {
2225 after = textget (i->plist, Qread_only);
81f6e55f 2226
318d2fa8
RS
2227 /* If interval I is read-only and read-only is
2228 front-sticky, inhibit insertion.
2229 Check for read-only as well as category. */
2230 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
2231 {
2232 Lisp_Object tem;
2233
2234 tem = textget (i->plist, Qfront_sticky);
2235 if (TMEM (Qread_only, tem)
2236 || (NILP (Fplist_get (i->plist, Qread_only))
2237 && TMEM (Qcategory, tem)))
bcf97349 2238 text_read_only (after);
318d2fa8
RS
2239
2240 tem = textget (prev->plist, Qrear_nonsticky);
2241 if (! TMEM (Qread_only, tem)
2242 && (! NILP (Fplist_get (prev->plist, Qread_only))
2243 || ! TMEM (Qcategory, tem)))
bcf97349 2244 text_read_only (after);
318d2fa8
RS
2245 }
2246 }
2247 }
2248
2249 /* Run both insert hooks (just once if they're the same). */
77c7bcb1 2250 if (prev)
318d2fa8
RS
2251 interval_insert_behind_hooks
2252 = textget (prev->plist, Qinsert_behind_hooks);
77c7bcb1 2253 if (i)
318d2fa8
RS
2254 interval_insert_in_front_hooks
2255 = textget (i->plist, Qinsert_in_front_hooks);
2256 }
0ba7995b 2257 else
318d2fa8
RS
2258 {
2259 /* Loop over intervals on or next to START...END,
2260 collecting their hooks. */
2261
2262 i = find_interval (intervals, start);
2263 do
2264 {
2265 if (! INTERVAL_WRITABLE_P (i))
bcf97349 2266 text_read_only (textget (i->plist, Qread_only));
318d2fa8 2267
0ba7995b 2268 if (!inhibit_modification_hooks)
318d2fa8 2269 {
0ba7995b
GM
2270 mod_hooks = textget (i->plist, Qmodification_hooks);
2271 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
2272 {
2273 hooks = Fcons (mod_hooks, hooks);
2274 prev_mod_hooks = mod_hooks;
2275 }
318d2fa8
RS
2276 }
2277
2278 i = next_interval (i);
2279 }
2280 /* Keep going thru the interval containing the char before END. */
77c7bcb1 2281 while (i && i->position < end);
318d2fa8 2282
0ba7995b 2283 if (!inhibit_modification_hooks)
318d2fa8 2284 {
0ba7995b
GM
2285 GCPRO1 (hooks);
2286 hooks = Fnreverse (hooks);
2287 while (! EQ (hooks, Qnil))
2288 {
2289 call_mod_hooks (Fcar (hooks), make_number (start),
2290 make_number (end));
2291 hooks = Fcdr (hooks);
2292 }
2293 UNGCPRO;
318d2fa8 2294 }
318d2fa8
RS
2295 }
2296}
2297
96f90544 2298/* Run the interval hooks for an insertion on character range START ... END.
318d2fa8
RS
2299 verify_interval_modification chose which hooks to run;
2300 this function is called after the insertion happens
2301 so it can indicate the range of inserted text. */
2302
2303void
971de7fb 2304report_interval_modification (Lisp_Object start, Lisp_Object end)
318d2fa8
RS
2305{
2306 if (! NILP (interval_insert_behind_hooks))
2e34157c 2307 call_mod_hooks (interval_insert_behind_hooks, start, end);
318d2fa8
RS
2308 if (! NILP (interval_insert_in_front_hooks)
2309 && ! EQ (interval_insert_in_front_hooks,
2310 interval_insert_behind_hooks))
2e34157c 2311 call_mod_hooks (interval_insert_in_front_hooks, start, end);
318d2fa8
RS
2312}
2313\f
d418ef42 2314void
971de7fb 2315syms_of_textprop (void)
d418ef42 2316{
29208e82 2317 DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
8c1a1077
PJ
2318 doc: /* Property-list used as default values.
2319The value of a property in this list is seen as the value for every
2320character that does not have its own value for that property. */);
ad1b2f20 2321 Vdefault_text_properties = Qnil;
c7dd82a3 2322
29208e82 2323 DEFVAR_LISP ("char-property-alias-alist", Vchar_property_alias_alist,
49d110a8
CW
2324 doc: /* Alist of alternative properties for properties without a value.
2325Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
2326If a piece of text has no direct value for a particular property, then
2327this alist is consulted. If that property appears in the alist, then
2328the first non-nil value from the associated alternative properties is
2329returned. */);
2330 Vchar_property_alias_alist = Qnil;
2331
29208e82 2332 DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
8c1a1077
PJ
2333 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
2334This also inhibits the use of the `intangible' text property. */);
688a5a0f 2335 Vinhibit_point_motion_hooks = Qnil;
318d2fa8 2336
abc2f676 2337 DEFVAR_LISP ("text-property-default-nonsticky",
29208e82 2338 Vtext_property_default_nonsticky,
22bcf204 2339 doc: /* Alist of properties vs the corresponding non-stickiness.
8c1a1077
PJ
2340Each element has the form (PROPERTY . NONSTICKINESS).
2341
2342If a character in a buffer has PROPERTY, new text inserted adjacent to
2343the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
518c0b83
JB
2344inherits it if NONSTICKINESS is nil. The `front-sticky' and
2345`rear-nonsticky' properties of the character override NONSTICKINESS. */);
cabf1cac
SM
2346 /* Text properties `syntax-table'and `display' should be nonsticky
2347 by default. */
98ebf860 2348 Vtext_property_default_nonsticky
6c6f1994
PE
2349 = list2 (Fcons (intern_c_string ("syntax-table"), Qt),
2350 Fcons (intern_c_string ("display"), Qt));
abc2f676 2351
318d2fa8
RS
2352 staticpro (&interval_insert_behind_hooks);
2353 staticpro (&interval_insert_in_front_hooks);
2354 interval_insert_behind_hooks = Qnil;
2355 interval_insert_in_front_hooks = Qnil;
2356
81f6e55f 2357
d418ef42
JA
2358 /* Common attributes one might give text */
2359
cd3520a4
JB
2360 DEFSYM (Qforeground, "foreground");
2361 DEFSYM (Qbackground, "background");
2362 DEFSYM (Qfont, "font");
708e05f6 2363 DEFSYM (Qface, "face");
cd3520a4
JB
2364 DEFSYM (Qstipple, "stipple");
2365 DEFSYM (Qunderline, "underline");
2366 DEFSYM (Qread_only, "read-only");
2367 DEFSYM (Qinvisible, "invisible");
2368 DEFSYM (Qintangible, "intangible");
2369 DEFSYM (Qcategory, "category");
2370 DEFSYM (Qlocal_map, "local-map");
2371 DEFSYM (Qfront_sticky, "front-sticky");
2372 DEFSYM (Qrear_nonsticky, "rear-nonsticky");
2373 DEFSYM (Qmouse_face, "mouse-face");
2374 DEFSYM (Qminibuffer_prompt, "minibuffer-prompt");
d418ef42
JA
2375
2376 /* Properties that text might use to specify certain actions */
2377
cd3520a4
JB
2378 DEFSYM (Qmouse_left, "mouse-left");
2379 DEFSYM (Qmouse_entered, "mouse-entered");
2380 DEFSYM (Qpoint_left, "point-left");
2381 DEFSYM (Qpoint_entered, "point-entered");
d418ef42
JA
2382
2383 defsubr (&Stext_properties_at);
5fbe2a44 2384 defsubr (&Sget_text_property);
eb769fd7 2385 defsubr (&Sget_char_property);
97a1bc63 2386 defsubr (&Sget_char_property_and_overlay);
fcab51aa
RS
2387 defsubr (&Snext_char_property_change);
2388 defsubr (&Sprevious_char_property_change);
b7e047fb
MB
2389 defsubr (&Snext_single_char_property_change);
2390 defsubr (&Sprevious_single_char_property_change);
d418ef42 2391 defsubr (&Snext_property_change);
9c79dd1b 2392 defsubr (&Snext_single_property_change);
d418ef42 2393 defsubr (&Sprevious_property_change);
9c79dd1b 2394 defsubr (&Sprevious_single_property_change);
d418ef42 2395 defsubr (&Sadd_text_properties);
d4b530ad 2396 defsubr (&Sput_text_property);
d418ef42 2397 defsubr (&Sset_text_properties);
708e05f6 2398 defsubr (&Sadd_face_text_property);
d418ef42 2399 defsubr (&Sremove_text_properties);
11713b6d 2400 defsubr (&Sremove_list_of_text_properties);
ad9c1940
JB
2401 defsubr (&Stext_property_any);
2402 defsubr (&Stext_property_not_all);
d418ef42 2403}