Commit | Line | Data |
---|---|---|
d418ef42 | 1 | /* Interface code for dealing with text properties. |
23ad4658 | 2 | Copyright (C) 1993 Free Software Foundation, Inc. |
d418ef42 JA |
3 | |
4 | This file is part of GNU Emacs. | |
5 | ||
6 | GNU Emacs is free software; you can redistribute it and/or modify | |
7 | it under the terms of the GNU General Public License as published by | |
71dfa9f4 | 8 | the Free Software Foundation; either version 2, or (at your option) |
d418ef42 JA |
9 | any later version. |
10 | ||
11 | GNU Emacs is distributed in the hope that it will be useful, | |
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | GNU General Public License for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License | |
17 | along with GNU Emacs; see the file COPYING. If not, write to | |
18 | the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | ||
18160b98 | 20 | #include <config.h> |
d418ef42 JA |
21 | #include "lisp.h" |
22 | #include "intervals.h" | |
23 | #include "buffer.h" | |
24 | \f | |
25 | ||
26 | /* NOTES: previous- and next- property change will have to skip | |
27 | zero-length intervals if they are implemented. This could be done | |
28 | inside next_interval and previous_interval. | |
29 | ||
9c79dd1b JA |
30 | set_properties needs to deal with the interval property cache. |
31 | ||
d418ef42 | 32 | It is assumed that for any interval plist, a property appears |
d4b530ad | 33 | only once on the list. Although some code i.e., remove_properties, |
d418ef42 | 34 | handles the more general case, the uniqueness of properties is |
eb8c3be9 | 35 | necessary for the system to remain consistent. This requirement |
d418ef42 JA |
36 | is enforced by the subrs installing properties onto the intervals. */ |
37 | ||
25013c26 JA |
38 | /* The rest of the file is within this conditional */ |
39 | #ifdef USE_TEXT_PROPERTIES | |
d418ef42 JA |
40 | \f |
41 | /* Types of hooks. */ | |
42 | Lisp_Object Qmouse_left; | |
43 | Lisp_Object Qmouse_entered; | |
44 | Lisp_Object Qpoint_left; | |
45 | Lisp_Object Qpoint_entered; | |
dc70cea7 RS |
46 | Lisp_Object Qcategory; |
47 | Lisp_Object Qlocal_map; | |
d418ef42 JA |
48 | |
49 | /* Visual properties text (including strings) may have. */ | |
50 | Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple; | |
19e1c426 RS |
51 | Lisp_Object Qinvisible, Qread_only, Qhidden; |
52 | ||
53 | /* Sticky properties */ | |
54 | Lisp_Object Qfront_sticky, Qrear_nonsticky; | |
d7b4e137 JB |
55 | |
56 | /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to | |
57 | the o1's cdr. Otherwise, return zero. This is handy for | |
58 | traversing plists. */ | |
59 | #define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr)) | |
60 | ||
688a5a0f RS |
61 | Lisp_Object Vinhibit_point_motion_hooks; |
62 | ||
d418ef42 | 63 | \f |
ac876a79 JA |
64 | /* Extract the interval at the position pointed to by BEGIN from |
65 | OBJECT, a string or buffer. Additionally, check that the positions | |
66 | pointed to by BEGIN and END are within the bounds of OBJECT, and | |
67 | reverse them if *BEGIN is greater than *END. The objects pointed | |
68 | to by BEGIN and END may be integers or markers; if the latter, they | |
69 | are coerced to integers. | |
d418ef42 | 70 | |
d4b530ad RS |
71 | When OBJECT is a string, we increment *BEGIN and *END |
72 | to make them origin-one. | |
73 | ||
d418ef42 JA |
74 | Note that buffer points don't correspond to interval indices. |
75 | For example, point-max is 1 greater than the index of the last | |
76 | character. This difference is handled in the caller, which uses | |
77 | the validated points to determine a length, and operates on that. | |
78 | Exceptions are Ftext_properties_at, Fnext_property_change, and | |
79 | Fprevious_property_change which call this function with BEGIN == END. | |
80 | Handle this case specially. | |
81 | ||
82 | If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise, | |
ac876a79 JA |
83 | create an interval tree for OBJECT if one doesn't exist, provided |
84 | the object actually contains text. In the current design, if there | |
d4b530ad | 85 | is no text, there can be no text properties. */ |
d418ef42 JA |
86 | |
87 | #define soft 0 | |
88 | #define hard 1 | |
89 | ||
90 | static INTERVAL | |
91 | validate_interval_range (object, begin, end, force) | |
92 | Lisp_Object object, *begin, *end; | |
93 | int force; | |
94 | { | |
95 | register INTERVAL i; | |
d4b530ad RS |
96 | int searchpos; |
97 | ||
d418ef42 JA |
98 | CHECK_STRING_OR_BUFFER (object, 0); |
99 | CHECK_NUMBER_COERCE_MARKER (*begin, 0); | |
100 | CHECK_NUMBER_COERCE_MARKER (*end, 0); | |
101 | ||
102 | /* If we are asked for a point, but from a subr which operates | |
103 | on a range, then return nothing. */ | |
104 | if (*begin == *end && begin != end) | |
105 | return NULL_INTERVAL; | |
106 | ||
107 | if (XINT (*begin) > XINT (*end)) | |
108 | { | |
d4b530ad RS |
109 | Lisp_Object n; |
110 | n = *begin; | |
d418ef42 | 111 | *begin = *end; |
d4b530ad | 112 | *end = n; |
d418ef42 JA |
113 | } |
114 | ||
115 | if (XTYPE (object) == Lisp_Buffer) | |
116 | { | |
117 | register struct buffer *b = XBUFFER (object); | |
118 | ||
d418ef42 JA |
119 | if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end) |
120 | && XINT (*end) <= BUF_ZV (b))) | |
121 | args_out_of_range (*begin, *end); | |
122 | i = b->intervals; | |
123 | ||
d4b530ad RS |
124 | /* If there's no text, there are no properties. */ |
125 | if (BUF_BEGV (b) == BUF_ZV (b)) | |
126 | return NULL_INTERVAL; | |
127 | ||
128 | searchpos = XINT (*begin); | |
d418ef42 JA |
129 | } |
130 | else | |
131 | { | |
132 | register struct Lisp_String *s = XSTRING (object); | |
133 | ||
d4b530ad | 134 | if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end) |
d418ef42 JA |
135 | && XINT (*end) <= s->size)) |
136 | args_out_of_range (*begin, *end); | |
d4b530ad RS |
137 | /* User-level Positions in strings start with 0, |
138 | but the interval code always wants positions starting with 1. */ | |
139 | XFASTINT (*begin) += 1; | |
b1e94638 JB |
140 | if (begin != end) |
141 | XFASTINT (*end) += 1; | |
d418ef42 | 142 | i = s->intervals; |
d4b530ad RS |
143 | |
144 | if (s->size == 0) | |
145 | return NULL_INTERVAL; | |
146 | ||
147 | searchpos = XINT (*begin); | |
d418ef42 JA |
148 | } |
149 | ||
150 | if (NULL_INTERVAL_P (i)) | |
151 | return (force ? create_root_interval (object) : i); | |
152 | ||
d4b530ad | 153 | return find_interval (i, searchpos); |
d418ef42 JA |
154 | } |
155 | ||
156 | /* Validate LIST as a property list. If LIST is not a list, then | |
157 | make one consisting of (LIST nil). Otherwise, verify that LIST | |
158 | is even numbered and thus suitable as a plist. */ | |
159 | ||
160 | static Lisp_Object | |
161 | validate_plist (list) | |
4d780c76 | 162 | Lisp_Object list; |
d418ef42 JA |
163 | { |
164 | if (NILP (list)) | |
165 | return Qnil; | |
166 | ||
167 | if (CONSP (list)) | |
168 | { | |
169 | register int i; | |
170 | register Lisp_Object tail; | |
171 | for (i = 0, tail = list; !NILP (tail); i++) | |
b1e94638 JB |
172 | { |
173 | tail = Fcdr (tail); | |
174 | QUIT; | |
175 | } | |
d418ef42 JA |
176 | if (i & 1) |
177 | error ("Odd length text property list"); | |
178 | return list; | |
179 | } | |
180 | ||
181 | return Fcons (list, Fcons (Qnil, Qnil)); | |
182 | } | |
183 | ||
d418ef42 JA |
184 | /* Return nonzero if interval I has all the properties, |
185 | with the same values, of list PLIST. */ | |
186 | ||
187 | static int | |
188 | interval_has_all_properties (plist, i) | |
189 | Lisp_Object plist; | |
190 | INTERVAL i; | |
191 | { | |
192 | register Lisp_Object tail1, tail2, sym1, sym2; | |
193 | register int found; | |
194 | ||
195 | /* Go through each element of PLIST. */ | |
196 | for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
197 | { | |
198 | sym1 = Fcar (tail1); | |
199 | found = 0; | |
200 | ||
201 | /* Go through I's plist, looking for sym1 */ | |
202 | for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
203 | if (EQ (sym1, Fcar (tail2))) | |
204 | { | |
205 | /* Found the same property on both lists. If the | |
206 | values are unequal, return zero. */ | |
734c51b2 | 207 | if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2)))) |
d418ef42 JA |
208 | return 0; |
209 | ||
210 | /* Property has same value on both lists; go to next one. */ | |
211 | found = 1; | |
212 | break; | |
213 | } | |
214 | ||
215 | if (! found) | |
216 | return 0; | |
217 | } | |
218 | ||
219 | return 1; | |
220 | } | |
221 | ||
222 | /* Return nonzero if the plist of interval I has any of the | |
223 | properties of PLIST, regardless of their values. */ | |
224 | ||
225 | static INLINE int | |
226 | interval_has_some_properties (plist, i) | |
227 | Lisp_Object plist; | |
228 | INTERVAL i; | |
229 | { | |
230 | register Lisp_Object tail1, tail2, sym; | |
231 | ||
232 | /* Go through each element of PLIST. */ | |
233 | for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
234 | { | |
235 | sym = Fcar (tail1); | |
236 | ||
237 | /* Go through i's plist, looking for tail1 */ | |
238 | for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
239 | if (EQ (sym, Fcar (tail2))) | |
240 | return 1; | |
241 | } | |
242 | ||
243 | return 0; | |
244 | } | |
d4b530ad | 245 | \f |
d7b4e137 JB |
246 | /* Changing the plists of individual intervals. */ |
247 | ||
248 | /* Return the value of PROP in property-list PLIST, or Qunbound if it | |
249 | has none. */ | |
250 | static int | |
251 | property_value (plist, prop) | |
252 | { | |
253 | Lisp_Object value; | |
254 | ||
255 | while (PLIST_ELT_P (plist, value)) | |
256 | if (EQ (XCONS (plist)->car, prop)) | |
257 | return XCONS (value)->car; | |
258 | else | |
259 | plist = XCONS (value)->cdr; | |
260 | ||
261 | return Qunbound; | |
262 | } | |
263 | ||
d4b530ad RS |
264 | /* Set the properties of INTERVAL to PROPERTIES, |
265 | and record undo info for the previous values. | |
266 | OBJECT is the string or buffer that INTERVAL belongs to. */ | |
267 | ||
268 | static void | |
269 | set_properties (properties, interval, object) | |
270 | Lisp_Object properties, object; | |
271 | INTERVAL interval; | |
272 | { | |
d7b4e137 | 273 | Lisp_Object sym, value; |
d4b530ad | 274 | |
d7b4e137 | 275 | if (BUFFERP (object)) |
d4b530ad | 276 | { |
d7b4e137 JB |
277 | /* For each property in the old plist which is missing from PROPERTIES, |
278 | or has a different value in PROPERTIES, make an undo record. */ | |
279 | for (sym = interval->plist; | |
280 | PLIST_ELT_P (sym, value); | |
281 | sym = XCONS (value)->cdr) | |
282 | if (! EQ (property_value (properties, XCONS (sym)->car), | |
283 | XCONS (value)->car)) | |
f7a9275a RS |
284 | { |
285 | modify_region (XBUFFER (object), | |
286 | make_number (interval->position), | |
287 | make_number (interval->position + LENGTH (interval))); | |
288 | record_property_change (interval->position, LENGTH (interval), | |
289 | XCONS (sym)->car, XCONS (value)->car, | |
290 | object); | |
291 | } | |
d7b4e137 JB |
292 | |
293 | /* For each new property that has no value at all in the old plist, | |
294 | make an undo record binding it to nil, so it will be removed. */ | |
295 | for (sym = properties; | |
296 | PLIST_ELT_P (sym, value); | |
297 | sym = XCONS (value)->cdr) | |
298 | if (EQ (property_value (interval->plist, XCONS (sym)->car), Qunbound)) | |
f7a9275a RS |
299 | { |
300 | modify_region (XBUFFER (object), | |
301 | make_number (interval->position), | |
302 | make_number (interval->position + LENGTH (interval))); | |
303 | record_property_change (interval->position, LENGTH (interval), | |
304 | XCONS (sym)->car, Qnil, | |
305 | object); | |
306 | } | |
d4b530ad RS |
307 | } |
308 | ||
309 | /* Store new properties. */ | |
310 | interval->plist = Fcopy_sequence (properties); | |
311 | } | |
d418ef42 JA |
312 | |
313 | /* Add the properties of PLIST to the interval I, or set | |
314 | the value of I's property to the value of the property on PLIST | |
315 | if they are different. | |
316 | ||
d4b530ad RS |
317 | OBJECT should be the string or buffer the interval is in. |
318 | ||
d418ef42 JA |
319 | Return nonzero if this changes I (i.e., if any members of PLIST |
320 | are actually added to I's plist) */ | |
321 | ||
d4b530ad RS |
322 | static int |
323 | add_properties (plist, i, object) | |
d418ef42 JA |
324 | Lisp_Object plist; |
325 | INTERVAL i; | |
d4b530ad | 326 | Lisp_Object object; |
d418ef42 JA |
327 | { |
328 | register Lisp_Object tail1, tail2, sym1, val1; | |
329 | register int changed = 0; | |
330 | register int found; | |
331 | ||
332 | /* Go through each element of PLIST. */ | |
333 | for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
334 | { | |
335 | sym1 = Fcar (tail1); | |
336 | val1 = Fcar (Fcdr (tail1)); | |
337 | found = 0; | |
338 | ||
339 | /* Go through I's plist, looking for sym1 */ | |
340 | for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
341 | if (EQ (sym1, Fcar (tail2))) | |
342 | { | |
343 | register Lisp_Object this_cdr = Fcdr (tail2); | |
344 | ||
345 | /* Found the property. Now check its value. */ | |
346 | found = 1; | |
347 | ||
348 | /* The properties have the same value on both lists. | |
349 | Continue to the next property. */ | |
734c51b2 | 350 | if (EQ (val1, Fcar (this_cdr))) |
d418ef42 JA |
351 | break; |
352 | ||
d4b530ad RS |
353 | /* Record this change in the buffer, for undo purposes. */ |
354 | if (XTYPE (object) == Lisp_Buffer) | |
355 | { | |
04a759c8 JB |
356 | modify_region (XBUFFER (object), |
357 | make_number (i->position), | |
d4b530ad | 358 | make_number (i->position + LENGTH (i))); |
f7a9275a RS |
359 | record_property_change (i->position, LENGTH (i), |
360 | sym1, Fcar (this_cdr), object); | |
d4b530ad RS |
361 | } |
362 | ||
d418ef42 JA |
363 | /* I's property has a different value -- change it */ |
364 | Fsetcar (this_cdr, val1); | |
365 | changed++; | |
366 | break; | |
367 | } | |
368 | ||
369 | if (! found) | |
370 | { | |
d4b530ad RS |
371 | /* Record this change in the buffer, for undo purposes. */ |
372 | if (XTYPE (object) == Lisp_Buffer) | |
373 | { | |
04a759c8 JB |
374 | modify_region (XBUFFER (object), |
375 | make_number (i->position), | |
d4b530ad | 376 | make_number (i->position + LENGTH (i))); |
f7a9275a RS |
377 | record_property_change (i->position, LENGTH (i), |
378 | sym1, Qnil, object); | |
d4b530ad | 379 | } |
d418ef42 JA |
380 | i->plist = Fcons (sym1, Fcons (val1, i->plist)); |
381 | changed++; | |
382 | } | |
383 | } | |
384 | ||
385 | return changed; | |
386 | } | |
387 | ||
388 | /* For any members of PLIST which are properties of I, remove them | |
d4b530ad RS |
389 | from I's plist. |
390 | OBJECT is the string or buffer containing I. */ | |
d418ef42 | 391 | |
d4b530ad RS |
392 | static int |
393 | remove_properties (plist, i, object) | |
d418ef42 JA |
394 | Lisp_Object plist; |
395 | INTERVAL i; | |
d4b530ad | 396 | Lisp_Object object; |
d418ef42 JA |
397 | { |
398 | register Lisp_Object tail1, tail2, sym; | |
399 | register Lisp_Object current_plist = i->plist; | |
400 | register int changed = 0; | |
401 | ||
402 | /* Go through each element of plist. */ | |
403 | for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
404 | { | |
405 | sym = Fcar (tail1); | |
406 | ||
407 | /* First, remove the symbol if its at the head of the list */ | |
408 | while (! NILP (current_plist) && EQ (sym, Fcar (current_plist))) | |
409 | { | |
d4b530ad RS |
410 | if (XTYPE (object) == Lisp_Buffer) |
411 | { | |
04a759c8 JB |
412 | modify_region (XBUFFER (object), |
413 | make_number (i->position), | |
d4b530ad | 414 | make_number (i->position + LENGTH (i))); |
f7a9275a RS |
415 | record_property_change (i->position, LENGTH (i), |
416 | sym, Fcar (Fcdr (current_plist)), | |
417 | object); | |
d4b530ad RS |
418 | } |
419 | ||
d418ef42 JA |
420 | current_plist = Fcdr (Fcdr (current_plist)); |
421 | changed++; | |
422 | } | |
423 | ||
424 | /* Go through i's plist, looking for sym */ | |
425 | tail2 = current_plist; | |
426 | while (! NILP (tail2)) | |
427 | { | |
428 | register Lisp_Object this = Fcdr (Fcdr (tail2)); | |
429 | if (EQ (sym, Fcar (this))) | |
430 | { | |
d4b530ad RS |
431 | if (XTYPE (object) == Lisp_Buffer) |
432 | { | |
04a759c8 JB |
433 | modify_region (XBUFFER (object), |
434 | make_number (i->position), | |
d4b530ad | 435 | make_number (i->position + LENGTH (i))); |
f7a9275a RS |
436 | record_property_change (i->position, LENGTH (i), |
437 | sym, Fcar (Fcdr (this)), object); | |
d4b530ad RS |
438 | } |
439 | ||
d418ef42 JA |
440 | Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this))); |
441 | changed++; | |
442 | } | |
443 | tail2 = this; | |
444 | } | |
445 | } | |
446 | ||
447 | if (changed) | |
448 | i->plist = current_plist; | |
449 | return changed; | |
450 | } | |
451 | ||
d4b530ad | 452 | #if 0 |
d418ef42 JA |
453 | /* Remove all properties from interval I. Return non-zero |
454 | if this changes the interval. */ | |
455 | ||
456 | static INLINE int | |
457 | erase_properties (i) | |
458 | INTERVAL i; | |
459 | { | |
460 | if (NILP (i->plist)) | |
461 | return 0; | |
462 | ||
463 | i->plist = Qnil; | |
464 | return 1; | |
465 | } | |
d4b530ad | 466 | #endif |
d418ef42 | 467 | \f |
d418ef42 JA |
468 | DEFUN ("text-properties-at", Ftext_properties_at, |
469 | Stext_properties_at, 1, 2, 0, | |
470 | "Return the list of properties held by the character at POSITION\n\ | |
471 | in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\ | |
d4b530ad RS |
472 | defaults to the current buffer.\n\ |
473 | If POSITION is at the end of OBJECT, the value is nil.") | |
d418ef42 JA |
474 | (pos, object) |
475 | Lisp_Object pos, object; | |
476 | { | |
477 | register INTERVAL i; | |
d418ef42 JA |
478 | |
479 | if (NILP (object)) | |
480 | XSET (object, Lisp_Buffer, current_buffer); | |
481 | ||
482 | i = validate_interval_range (object, &pos, &pos, soft); | |
483 | if (NULL_INTERVAL_P (i)) | |
484 | return Qnil; | |
d4b530ad RS |
485 | /* If POS is at the end of the interval, |
486 | it means it's the end of OBJECT. | |
487 | There are no properties at the very end, | |
488 | since no character follows. */ | |
489 | if (XINT (pos) == LENGTH (i) + i->position) | |
490 | return Qnil; | |
d418ef42 JA |
491 | |
492 | return i->plist; | |
493 | } | |
494 | ||
5fbe2a44 | 495 | DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0, |
0df58c91 | 496 | "Return the value of position POS's property PROP, in OBJECT.\n\ |
d4b530ad RS |
497 | OBJECT is optional and defaults to the current buffer.\n\ |
498 | If POSITION is at the end of OBJECT, the value is nil.") | |
5fbe2a44 | 499 | (pos, prop, object) |
0df58c91 | 500 | Lisp_Object pos, object; |
5fbe2a44 RS |
501 | register Lisp_Object prop; |
502 | { | |
503 | register INTERVAL i; | |
504 | register Lisp_Object tail; | |
505 | ||
506 | if (NILP (object)) | |
507 | XSET (object, Lisp_Buffer, current_buffer); | |
5fbe2a44 RS |
508 | i = validate_interval_range (object, &pos, &pos, soft); |
509 | if (NULL_INTERVAL_P (i)) | |
510 | return Qnil; | |
511 | ||
d4b530ad RS |
512 | /* If POS is at the end of the interval, |
513 | it means it's the end of OBJECT. | |
514 | There are no properties at the very end, | |
515 | since no character follows. */ | |
516 | if (XINT (pos) == LENGTH (i) + i->position) | |
517 | return Qnil; | |
518 | ||
dc70cea7 | 519 | return textget (i->plist, prop); |
5fbe2a44 RS |
520 | } |
521 | ||
d418ef42 | 522 | DEFUN ("next-property-change", Fnext_property_change, |
111b637d | 523 | Snext_property_change, 1, 3, 0, |
5fbe2a44 RS |
524 | "Return the position of next property change.\n\ |
525 | Scans characters forward from POS in OBJECT till it finds\n\ | |
526 | a change in some text property, then returns the position of the change.\n\ | |
527 | The optional second argument OBJECT is the string or buffer to scan.\n\ | |
528 | Return nil if the property is constant all the way to the end of OBJECT.\n\ | |
111b637d RS |
529 | If the value is non-nil, it is a position greater than POS, never equal.\n\n\ |
530 | If the optional third argument LIMIT is non-nil, don't search\n\ | |
531 | past position LIMIT; return LIMIT if nothing is found before LIMIT.") | |
532 | (pos, object, limit) | |
533 | Lisp_Object pos, object, limit; | |
d418ef42 JA |
534 | { |
535 | register INTERVAL i, next; | |
536 | ||
5fbe2a44 RS |
537 | if (NILP (object)) |
538 | XSET (object, Lisp_Buffer, current_buffer); | |
539 | ||
d418ef42 JA |
540 | i = validate_interval_range (object, &pos, &pos, soft); |
541 | if (NULL_INTERVAL_P (i)) | |
111b637d | 542 | return limit; |
d418ef42 JA |
543 | |
544 | next = next_interval (i); | |
111b637d RS |
545 | while (! NULL_INTERVAL_P (next) && intervals_equal (i, next) |
546 | && (NILP (limit) || next->position < XFASTINT (limit))) | |
d418ef42 JA |
547 | next = next_interval (next); |
548 | ||
549 | if (NULL_INTERVAL_P (next)) | |
111b637d RS |
550 | return limit; |
551 | if (! NILP (limit) && !(next->position < XFASTINT (limit))) | |
552 | return limit; | |
d418ef42 | 553 | |
d4b530ad | 554 | return next->position - (XTYPE (object) == Lisp_String); |
19e1c426 RS |
555 | } |
556 | ||
557 | /* Return 1 if there's a change in some property between BEG and END. */ | |
558 | ||
559 | int | |
560 | property_change_between_p (beg, end) | |
561 | int beg, end; | |
562 | { | |
563 | register INTERVAL i, next; | |
564 | Lisp_Object object, pos; | |
565 | ||
566 | XSET (object, Lisp_Buffer, current_buffer); | |
567 | XFASTINT (pos) = beg; | |
568 | ||
569 | i = validate_interval_range (object, &pos, &pos, soft); | |
570 | if (NULL_INTERVAL_P (i)) | |
571 | return 0; | |
572 | ||
573 | next = next_interval (i); | |
574 | while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)) | |
575 | { | |
576 | next = next_interval (next); | |
e050ef74 RS |
577 | if (NULL_INTERVAL_P (next)) |
578 | return 0; | |
19e1c426 RS |
579 | if (next->position >= end) |
580 | return 0; | |
581 | } | |
582 | ||
583 | if (NULL_INTERVAL_P (next)) | |
584 | return 0; | |
585 | ||
586 | return 1; | |
d418ef42 JA |
587 | } |
588 | ||
9c79dd1b | 589 | DEFUN ("next-single-property-change", Fnext_single_property_change, |
111b637d | 590 | Snext_single_property_change, 2, 4, 0, |
5fbe2a44 RS |
591 | "Return the position of next property change for a specific property.\n\ |
592 | Scans characters forward from POS till it finds\n\ | |
593 | a change in the PROP property, then returns the position of the change.\n\ | |
594 | The optional third argument OBJECT is the string or buffer to scan.\n\ | |
da625a3c | 595 | The property values are compared with `eq'.\n\ |
5fbe2a44 | 596 | Return nil if the property is constant all the way to the end of OBJECT.\n\ |
111b637d RS |
597 | If the value is non-nil, it is a position greater than POS, never equal.\n\n\ |
598 | If the optional fourth argument LIMIT is non-nil, don't search\n\ | |
599 | past position LIMIT; fail if nothing is found before LIMIT.") | |
600 | (pos, prop, object, limit) | |
601 | Lisp_Object pos, prop, object, limit; | |
9c79dd1b JA |
602 | { |
603 | register INTERVAL i, next; | |
604 | register Lisp_Object here_val; | |
605 | ||
5fbe2a44 RS |
606 | if (NILP (object)) |
607 | XSET (object, Lisp_Buffer, current_buffer); | |
608 | ||
9c79dd1b JA |
609 | i = validate_interval_range (object, &pos, &pos, soft); |
610 | if (NULL_INTERVAL_P (i)) | |
111b637d | 611 | return limit; |
9c79dd1b | 612 | |
6a0486dd | 613 | here_val = textget (i->plist, prop); |
9c79dd1b | 614 | next = next_interval (i); |
6a0486dd | 615 | while (! NULL_INTERVAL_P (next) |
111b637d RS |
616 | && EQ (here_val, textget (next->plist, prop)) |
617 | && (NILP (limit) || next->position < XFASTINT (limit))) | |
9c79dd1b JA |
618 | next = next_interval (next); |
619 | ||
620 | if (NULL_INTERVAL_P (next)) | |
111b637d RS |
621 | return limit; |
622 | if (! NILP (limit) && !(next->position < XFASTINT (limit))) | |
623 | return limit; | |
9c79dd1b | 624 | |
d4b530ad | 625 | return next->position - (XTYPE (object) == Lisp_String); |
9c79dd1b JA |
626 | } |
627 | ||
d418ef42 | 628 | DEFUN ("previous-property-change", Fprevious_property_change, |
111b637d | 629 | Sprevious_property_change, 1, 3, 0, |
5fbe2a44 RS |
630 | "Return the position of previous property change.\n\ |
631 | Scans characters backwards from POS in OBJECT till it finds\n\ | |
632 | a change in some text property, then returns the position of the change.\n\ | |
633 | The optional second argument OBJECT is the string or buffer to scan.\n\ | |
634 | Return nil if the property is constant all the way to the start of OBJECT.\n\ | |
111b637d RS |
635 | If the value is non-nil, it is a position less than POS, never equal.\n\n\ |
636 | If the optional third argument LIMIT is non-nil, don't search\n\ | |
637 | back past position LIMIT; fail if nothing is found before LIMIT.") | |
638 | (pos, object, limit) | |
639 | Lisp_Object pos, object, limit; | |
d418ef42 JA |
640 | { |
641 | register INTERVAL i, previous; | |
642 | ||
5fbe2a44 RS |
643 | if (NILP (object)) |
644 | XSET (object, Lisp_Buffer, current_buffer); | |
645 | ||
d418ef42 JA |
646 | i = validate_interval_range (object, &pos, &pos, soft); |
647 | if (NULL_INTERVAL_P (i)) | |
111b637d | 648 | return limit; |
d418ef42 JA |
649 | |
650 | previous = previous_interval (i); | |
111b637d RS |
651 | while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i) |
652 | && (NILP (limit) | |
653 | || previous->position + LENGTH (previous) > XFASTINT (limit))) | |
d418ef42 JA |
654 | previous = previous_interval (previous); |
655 | if (NULL_INTERVAL_P (previous)) | |
111b637d RS |
656 | return limit; |
657 | if (!NILP (limit) | |
658 | && !(previous->position + LENGTH (previous) > XFASTINT (limit))) | |
659 | return limit; | |
d418ef42 | 660 | |
111b637d | 661 | return (previous->position + LENGTH (previous) |
d4b530ad | 662 | - (XTYPE (object) == Lisp_String)); |
d418ef42 JA |
663 | } |
664 | ||
9c79dd1b | 665 | DEFUN ("previous-single-property-change", Fprevious_single_property_change, |
111b637d | 666 | Sprevious_single_property_change, 2, 4, 0, |
5fbe2a44 RS |
667 | "Return the position of previous property change for a specific property.\n\ |
668 | Scans characters backward from POS till it finds\n\ | |
669 | a change in the PROP property, then returns the position of the change.\n\ | |
670 | The optional third argument OBJECT is the string or buffer to scan.\n\ | |
93fda178 | 671 | The property values are compared with `eq'.\n\ |
5fbe2a44 | 672 | Return nil if the property is constant all the way to the start of OBJECT.\n\ |
111b637d RS |
673 | If the value is non-nil, it is a position less than POS, never equal.\n\n\ |
674 | If the optional fourth argument LIMIT is non-nil, don't search\n\ | |
675 | back past position LIMIT; fail if nothing is found before LIMIT.") | |
676 | (pos, prop, object, limit) | |
677 | Lisp_Object pos, prop, object, limit; | |
9c79dd1b JA |
678 | { |
679 | register INTERVAL i, previous; | |
680 | register Lisp_Object here_val; | |
681 | ||
5fbe2a44 RS |
682 | if (NILP (object)) |
683 | XSET (object, Lisp_Buffer, current_buffer); | |
684 | ||
9c79dd1b JA |
685 | i = validate_interval_range (object, &pos, &pos, soft); |
686 | if (NULL_INTERVAL_P (i)) | |
111b637d | 687 | return limit; |
9c79dd1b | 688 | |
6a0486dd | 689 | here_val = textget (i->plist, prop); |
9c79dd1b JA |
690 | previous = previous_interval (i); |
691 | while (! NULL_INTERVAL_P (previous) | |
111b637d RS |
692 | && EQ (here_val, textget (previous->plist, prop)) |
693 | && (NILP (limit) | |
694 | || previous->position + LENGTH (previous) > XFASTINT (limit))) | |
9c79dd1b JA |
695 | previous = previous_interval (previous); |
696 | if (NULL_INTERVAL_P (previous)) | |
111b637d RS |
697 | return limit; |
698 | if (!NILP (limit) | |
699 | && !(previous->position + LENGTH (previous) > XFASTINT (limit))) | |
700 | return limit; | |
9c79dd1b | 701 | |
111b637d | 702 | return (previous->position + LENGTH (previous) |
d4b530ad | 703 | - (XTYPE (object) == Lisp_String)); |
9c79dd1b JA |
704 | } |
705 | ||
d418ef42 | 706 | DEFUN ("add-text-properties", Fadd_text_properties, |
5fbe2a44 RS |
707 | Sadd_text_properties, 3, 4, 0, |
708 | "Add properties to the text from START to END.\n\ | |
709 | The third argument PROPS is a property list\n\ | |
710 | specifying the property values to add.\n\ | |
711 | The optional fourth argument, OBJECT,\n\ | |
712 | is the string or buffer containing the text.\n\ | |
713 | Return t if any property value actually changed, nil otherwise.") | |
714 | (start, end, properties, object) | |
715 | Lisp_Object start, end, properties, object; | |
d418ef42 JA |
716 | { |
717 | register INTERVAL i, unchanged; | |
caa31568 | 718 | register int s, len, modified = 0; |
d418ef42 JA |
719 | |
720 | properties = validate_plist (properties); | |
721 | if (NILP (properties)) | |
722 | return Qnil; | |
723 | ||
5fbe2a44 RS |
724 | if (NILP (object)) |
725 | XSET (object, Lisp_Buffer, current_buffer); | |
726 | ||
d418ef42 JA |
727 | i = validate_interval_range (object, &start, &end, hard); |
728 | if (NULL_INTERVAL_P (i)) | |
729 | return Qnil; | |
730 | ||
731 | s = XINT (start); | |
732 | len = XINT (end) - s; | |
733 | ||
734 | /* If we're not starting on an interval boundary, we have to | |
735 | split this interval. */ | |
736 | if (i->position != s) | |
737 | { | |
738 | /* If this interval already has the properties, we can | |
739 | skip it. */ | |
740 | if (interval_has_all_properties (properties, i)) | |
741 | { | |
742 | int got = (LENGTH (i) - (s - i->position)); | |
743 | if (got >= len) | |
744 | return Qnil; | |
745 | len -= got; | |
05d5b93e | 746 | i = next_interval (i); |
d418ef42 JA |
747 | } |
748 | else | |
749 | { | |
750 | unchanged = i; | |
ad9c1940 | 751 | i = split_interval_right (unchanged, s - unchanged->position); |
d418ef42 | 752 | copy_properties (unchanged, i); |
d418ef42 JA |
753 | } |
754 | } | |
755 | ||
daa5e28f | 756 | /* We are at the beginning of interval I, with LEN chars to scan. */ |
caa31568 | 757 | for (;;) |
d418ef42 | 758 | { |
d4b530ad RS |
759 | if (i == 0) |
760 | abort (); | |
761 | ||
d418ef42 JA |
762 | if (LENGTH (i) >= len) |
763 | { | |
764 | if (interval_has_all_properties (properties, i)) | |
765 | return modified ? Qt : Qnil; | |
766 | ||
767 | if (LENGTH (i) == len) | |
768 | { | |
d4b530ad | 769 | add_properties (properties, i, object); |
d418ef42 JA |
770 | return Qt; |
771 | } | |
772 | ||
773 | /* i doesn't have the properties, and goes past the change limit */ | |
774 | unchanged = i; | |
ad9c1940 | 775 | i = split_interval_left (unchanged, len); |
d418ef42 | 776 | copy_properties (unchanged, i); |
d4b530ad | 777 | add_properties (properties, i, object); |
d418ef42 JA |
778 | return Qt; |
779 | } | |
780 | ||
781 | len -= LENGTH (i); | |
d4b530ad | 782 | modified += add_properties (properties, i, object); |
d418ef42 JA |
783 | i = next_interval (i); |
784 | } | |
785 | } | |
786 | ||
d4b530ad RS |
787 | DEFUN ("put-text-property", Fput_text_property, |
788 | Sput_text_property, 4, 5, 0, | |
789 | "Set one property of the text from START to END.\n\ | |
790 | The third and fourth arguments PROP and VALUE\n\ | |
791 | specify the property to add.\n\ | |
792 | The optional fifth argument, OBJECT,\n\ | |
793 | is the string or buffer containing the text.") | |
794 | (start, end, prop, value, object) | |
795 | Lisp_Object start, end, prop, value, object; | |
796 | { | |
797 | Fadd_text_properties (start, end, | |
798 | Fcons (prop, Fcons (value, Qnil)), | |
799 | object); | |
800 | return Qnil; | |
801 | } | |
802 | ||
d418ef42 | 803 | DEFUN ("set-text-properties", Fset_text_properties, |
5fbe2a44 RS |
804 | Sset_text_properties, 3, 4, 0, |
805 | "Completely replace properties of text from START to END.\n\ | |
806 | The third argument PROPS is the new property list.\n\ | |
807 | The optional fourth argument, OBJECT,\n\ | |
808 | is the string or buffer containing the text.") | |
809 | (start, end, props, object) | |
810 | Lisp_Object start, end, props, object; | |
d418ef42 JA |
811 | { |
812 | register INTERVAL i, unchanged; | |
9c79dd1b | 813 | register INTERVAL prev_changed = NULL_INTERVAL; |
d418ef42 JA |
814 | register int s, len; |
815 | ||
5fbe2a44 | 816 | props = validate_plist (props); |
d418ef42 | 817 | |
5fbe2a44 RS |
818 | if (NILP (object)) |
819 | XSET (object, Lisp_Buffer, current_buffer); | |
820 | ||
d418ef42 JA |
821 | i = validate_interval_range (object, &start, &end, hard); |
822 | if (NULL_INTERVAL_P (i)) | |
823 | return Qnil; | |
824 | ||
825 | s = XINT (start); | |
826 | len = XINT (end) - s; | |
827 | ||
828 | if (i->position != s) | |
829 | { | |
830 | unchanged = i; | |
ad9c1940 | 831 | i = split_interval_right (unchanged, s - unchanged->position); |
7855e674 | 832 | |
d418ef42 JA |
833 | if (LENGTH (i) > len) |
834 | { | |
9c79dd1b | 835 | copy_properties (unchanged, i); |
ad9c1940 | 836 | i = split_interval_left (i, len); |
daa5e28f | 837 | set_properties (props, i, object); |
d418ef42 JA |
838 | return Qt; |
839 | } | |
840 | ||
daa5e28f RS |
841 | set_properties (props, i, object); |
842 | ||
9c79dd1b JA |
843 | if (LENGTH (i) == len) |
844 | return Qt; | |
845 | ||
846 | prev_changed = i; | |
d418ef42 JA |
847 | len -= LENGTH (i); |
848 | i = next_interval (i); | |
849 | } | |
850 | ||
cd7d971d | 851 | /* We are starting at the beginning of an interval, I */ |
7855e674 | 852 | while (len > 0) |
d418ef42 | 853 | { |
d4b530ad RS |
854 | if (i == 0) |
855 | abort (); | |
856 | ||
d418ef42 JA |
857 | if (LENGTH (i) >= len) |
858 | { | |
cd7d971d | 859 | if (LENGTH (i) > len) |
ad9c1940 | 860 | i = split_interval_left (i, len); |
d418ef42 | 861 | |
9c79dd1b | 862 | if (NULL_INTERVAL_P (prev_changed)) |
d4b530ad | 863 | set_properties (props, i, object); |
9c79dd1b JA |
864 | else |
865 | merge_interval_left (i); | |
d418ef42 JA |
866 | return Qt; |
867 | } | |
868 | ||
869 | len -= LENGTH (i); | |
9c79dd1b JA |
870 | if (NULL_INTERVAL_P (prev_changed)) |
871 | { | |
d4b530ad | 872 | set_properties (props, i, object); |
9c79dd1b JA |
873 | prev_changed = i; |
874 | } | |
875 | else | |
876 | prev_changed = i = merge_interval_left (i); | |
877 | ||
d418ef42 JA |
878 | i = next_interval (i); |
879 | } | |
880 | ||
881 | return Qt; | |
882 | } | |
883 | ||
884 | DEFUN ("remove-text-properties", Fremove_text_properties, | |
5fbe2a44 RS |
885 | Sremove_text_properties, 3, 4, 0, |
886 | "Remove some properties from text from START to END.\n\ | |
887 | The third argument PROPS is a property list\n\ | |
888 | whose property names specify the properties to remove.\n\ | |
889 | \(The values stored in PROPS are ignored.)\n\ | |
890 | The optional fourth argument, OBJECT,\n\ | |
891 | is the string or buffer containing the text.\n\ | |
892 | Return t if any property was actually removed, nil otherwise.") | |
893 | (start, end, props, object) | |
894 | Lisp_Object start, end, props, object; | |
d418ef42 JA |
895 | { |
896 | register INTERVAL i, unchanged; | |
caa31568 | 897 | register int s, len, modified = 0; |
d418ef42 | 898 | |
5fbe2a44 RS |
899 | if (NILP (object)) |
900 | XSET (object, Lisp_Buffer, current_buffer); | |
901 | ||
d418ef42 JA |
902 | i = validate_interval_range (object, &start, &end, soft); |
903 | if (NULL_INTERVAL_P (i)) | |
904 | return Qnil; | |
905 | ||
906 | s = XINT (start); | |
907 | len = XINT (end) - s; | |
9c79dd1b | 908 | |
d418ef42 JA |
909 | if (i->position != s) |
910 | { | |
911 | /* No properties on this first interval -- return if | |
912 | it covers the entire region. */ | |
5fbe2a44 | 913 | if (! interval_has_some_properties (props, i)) |
d418ef42 JA |
914 | { |
915 | int got = (LENGTH (i) - (s - i->position)); | |
916 | if (got >= len) | |
917 | return Qnil; | |
918 | len -= got; | |
05d5b93e | 919 | i = next_interval (i); |
d418ef42 | 920 | } |
daa5e28f RS |
921 | /* Split away the beginning of this interval; what we don't |
922 | want to modify. */ | |
d418ef42 JA |
923 | else |
924 | { | |
925 | unchanged = i; | |
ad9c1940 | 926 | i = split_interval_right (unchanged, s - unchanged->position); |
d418ef42 | 927 | copy_properties (unchanged, i); |
d418ef42 JA |
928 | } |
929 | } | |
930 | ||
931 | /* We are at the beginning of an interval, with len to scan */ | |
caa31568 | 932 | for (;;) |
d418ef42 | 933 | { |
d4b530ad RS |
934 | if (i == 0) |
935 | abort (); | |
936 | ||
d418ef42 JA |
937 | if (LENGTH (i) >= len) |
938 | { | |
5fbe2a44 | 939 | if (! interval_has_some_properties (props, i)) |
d418ef42 JA |
940 | return modified ? Qt : Qnil; |
941 | ||
942 | if (LENGTH (i) == len) | |
943 | { | |
d4b530ad | 944 | remove_properties (props, i, object); |
d418ef42 JA |
945 | return Qt; |
946 | } | |
947 | ||
948 | /* i has the properties, and goes past the change limit */ | |
daa5e28f | 949 | unchanged = i; |
ad9c1940 | 950 | i = split_interval_left (i, len); |
d418ef42 | 951 | copy_properties (unchanged, i); |
d4b530ad | 952 | remove_properties (props, i, object); |
d418ef42 JA |
953 | return Qt; |
954 | } | |
955 | ||
956 | len -= LENGTH (i); | |
d4b530ad | 957 | modified += remove_properties (props, i, object); |
d418ef42 JA |
958 | i = next_interval (i); |
959 | } | |
960 | } | |
961 | ||
ad9c1940 JB |
962 | DEFUN ("text-property-any", Ftext_property_any, |
963 | Stext_property_any, 4, 5, 0, | |
964 | "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\ | |
965 | If so, return the position of the first character whose PROP is `eq'\n\ | |
966 | to VALUE. Otherwise return nil.\n\ | |
967 | The optional fifth argument, OBJECT, is the string or buffer\n\ | |
968 | containing the text.") | |
969 | (start, end, prop, value, object) | |
970 | Lisp_Object start, end, prop, value, object; | |
971 | { | |
972 | register INTERVAL i; | |
973 | register int e, pos; | |
974 | ||
975 | if (NILP (object)) | |
976 | XSET (object, Lisp_Buffer, current_buffer); | |
977 | i = validate_interval_range (object, &start, &end, soft); | |
978 | e = XINT (end); | |
979 | ||
980 | while (! NULL_INTERVAL_P (i)) | |
981 | { | |
982 | if (i->position >= e) | |
983 | break; | |
984 | if (EQ (textget (i->plist, prop), value)) | |
985 | { | |
986 | pos = i->position; | |
987 | if (pos < XINT (start)) | |
988 | pos = XINT (start); | |
989 | return make_number (pos - (XTYPE (object) == Lisp_String)); | |
990 | } | |
991 | i = next_interval (i); | |
992 | } | |
993 | return Qnil; | |
994 | } | |
995 | ||
996 | DEFUN ("text-property-not-all", Ftext_property_not_all, | |
997 | Stext_property_not_all, 4, 5, 0, | |
998 | "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\ | |
999 | If so, return the position of the first character whose PROP is not\n\ | |
1000 | `eq' to VALUE. Otherwise, return nil.\n\ | |
1001 | The optional fifth argument, OBJECT, is the string or buffer\n\ | |
1002 | containing the text.") | |
1003 | (start, end, prop, value, object) | |
1004 | Lisp_Object start, end, prop, value, object; | |
1005 | { | |
1006 | register INTERVAL i; | |
1007 | register int s, e; | |
1008 | ||
1009 | if (NILP (object)) | |
1010 | XSET (object, Lisp_Buffer, current_buffer); | |
1011 | i = validate_interval_range (object, &start, &end, soft); | |
1012 | if (NULL_INTERVAL_P (i)) | |
916a3119 | 1013 | return (NILP (value) || EQ (start, end)) ? Qnil : start; |
ad9c1940 JB |
1014 | s = XINT (start); |
1015 | e = XINT (end); | |
1016 | ||
1017 | while (! NULL_INTERVAL_P (i)) | |
1018 | { | |
1019 | if (i->position >= e) | |
1020 | break; | |
1021 | if (! EQ (textget (i->plist, prop), value)) | |
1022 | { | |
1023 | if (i->position > s) | |
1024 | s = i->position; | |
1025 | return make_number (s - (XTYPE (object) == Lisp_String)); | |
1026 | } | |
1027 | i = next_interval (i); | |
1028 | } | |
1029 | return Qnil; | |
1030 | } | |
1031 | ||
5fbe2a44 RS |
1032 | #if 0 /* You can use set-text-properties for this. */ |
1033 | ||
d418ef42 | 1034 | DEFUN ("erase-text-properties", Ferase_text_properties, |
5fbe2a44 RS |
1035 | Serase_text_properties, 2, 3, 0, |
1036 | "Remove all properties from the text from START to END.\n\ | |
1037 | The optional third argument, OBJECT,\n\ | |
1038 | is the string or buffer containing the text.") | |
1039 | (start, end, object) | |
1040 | Lisp_Object start, end, object; | |
d418ef42 | 1041 | { |
cd7d971d | 1042 | register INTERVAL i; |
03ad6beb | 1043 | register INTERVAL prev_changed = NULL_INTERVAL; |
d418ef42 JA |
1044 | register int s, len, modified; |
1045 | ||
5fbe2a44 RS |
1046 | if (NILP (object)) |
1047 | XSET (object, Lisp_Buffer, current_buffer); | |
1048 | ||
d418ef42 JA |
1049 | i = validate_interval_range (object, &start, &end, soft); |
1050 | if (NULL_INTERVAL_P (i)) | |
1051 | return Qnil; | |
1052 | ||
1053 | s = XINT (start); | |
1054 | len = XINT (end) - s; | |
7855e674 | 1055 | |
d418ef42 JA |
1056 | if (i->position != s) |
1057 | { | |
7855e674 | 1058 | register int got; |
cd7d971d | 1059 | register INTERVAL unchanged = i; |
d418ef42 | 1060 | |
7855e674 | 1061 | /* If there are properties here, then this text will be modified. */ |
cd7d971d | 1062 | if (! NILP (i->plist)) |
d418ef42 | 1063 | { |
ad9c1940 | 1064 | i = split_interval_right (unchanged, s - unchanged->position); |
7855e674 | 1065 | i->plist = Qnil; |
d418ef42 | 1066 | modified++; |
7855e674 JA |
1067 | |
1068 | if (LENGTH (i) > len) | |
1069 | { | |
ad9c1940 | 1070 | i = split_interval_right (i, len); |
7855e674 JA |
1071 | copy_properties (unchanged, i); |
1072 | return Qt; | |
1073 | } | |
1074 | ||
1075 | if (LENGTH (i) == len) | |
1076 | return Qt; | |
1077 | ||
1078 | got = LENGTH (i); | |
d418ef42 | 1079 | } |
cd7d971d JA |
1080 | /* If the text of I is without any properties, and contains |
1081 | LEN or more characters, then we may return without changing | |
1082 | anything.*/ | |
7855e674 JA |
1083 | else if (LENGTH (i) - (s - i->position) <= len) |
1084 | return Qnil; | |
cd7d971d JA |
1085 | /* The amount of text to change extends past I, so just note |
1086 | how much we've gotten. */ | |
7855e674 JA |
1087 | else |
1088 | got = LENGTH (i) - (s - i->position); | |
d418ef42 JA |
1089 | |
1090 | len -= got; | |
7855e674 | 1091 | prev_changed = i; |
d418ef42 JA |
1092 | i = next_interval (i); |
1093 | } | |
1094 | ||
7855e674 | 1095 | /* We are starting at the beginning of an interval, I. */ |
d418ef42 JA |
1096 | while (len > 0) |
1097 | { | |
7855e674 | 1098 | if (LENGTH (i) >= len) |
d418ef42 | 1099 | { |
cd7d971d JA |
1100 | /* If I has no properties, simply merge it if possible. */ |
1101 | if (NILP (i->plist)) | |
7855e674 JA |
1102 | { |
1103 | if (! NULL_INTERVAL_P (prev_changed)) | |
1104 | merge_interval_left (i); | |
d418ef42 | 1105 | |
7855e674 JA |
1106 | return modified ? Qt : Qnil; |
1107 | } | |
1108 | ||
cd7d971d | 1109 | if (LENGTH (i) > len) |
ad9c1940 | 1110 | i = split_interval_left (i, len); |
7855e674 JA |
1111 | if (! NULL_INTERVAL_P (prev_changed)) |
1112 | merge_interval_left (i); | |
cd7d971d JA |
1113 | else |
1114 | i->plist = Qnil; | |
7855e674 | 1115 | |
cd7d971d | 1116 | return Qt; |
d418ef42 JA |
1117 | } |
1118 | ||
cd7d971d | 1119 | /* Here if we still need to erase past the end of I */ |
d418ef42 | 1120 | len -= LENGTH (i); |
7855e674 JA |
1121 | if (NULL_INTERVAL_P (prev_changed)) |
1122 | { | |
1123 | modified += erase_properties (i); | |
1124 | prev_changed = i; | |
1125 | } | |
1126 | else | |
1127 | { | |
cd7d971d JA |
1128 | modified += ! NILP (i->plist); |
1129 | /* Merging I will give it the properties of PREV_CHANGED. */ | |
7855e674 JA |
1130 | prev_changed = i = merge_interval_left (i); |
1131 | } | |
1132 | ||
d418ef42 JA |
1133 | i = next_interval (i); |
1134 | } | |
1135 | ||
1136 | return modified ? Qt : Qnil; | |
1137 | } | |
5fbe2a44 | 1138 | #endif /* 0 */ |
d418ef42 | 1139 | |
15e4954b JB |
1140 | /* I don't think this is the right interface to export; how often do you |
1141 | want to do something like this, other than when you're copying objects | |
1142 | around? | |
1143 | ||
1144 | I think it would be better to have a pair of functions, one which | |
1145 | returns the text properties of a region as a list of ranges and | |
1146 | plists, and another which applies such a list to another object. */ | |
1147 | ||
1148 | /* DEFUN ("copy-text-properties", Fcopy_text_properties, | |
1149 | Scopy_text_properties, 5, 6, 0, | |
1150 | "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\ | |
1151 | SRC and DEST may each refer to strings or buffers.\n\ | |
1152 | Optional sixth argument PROP causes only that property to be copied.\n\ | |
1153 | Properties are copied to DEST as if by `add-text-properties'.\n\ | |
1154 | Return t if any property value actually changed, nil otherwise.") */ | |
1155 | ||
1156 | Lisp_Object | |
1157 | copy_text_properties (start, end, src, pos, dest, prop) | |
1158 | Lisp_Object start, end, src, pos, dest, prop; | |
1159 | { | |
1160 | INTERVAL i; | |
1161 | Lisp_Object res; | |
1162 | Lisp_Object stuff; | |
1163 | Lisp_Object plist; | |
1164 | int s, e, e2, p, len, modified = 0; | |
1165 | ||
1166 | i = validate_interval_range (src, &start, &end, soft); | |
1167 | if (NULL_INTERVAL_P (i)) | |
1168 | return Qnil; | |
1169 | ||
1170 | CHECK_NUMBER_COERCE_MARKER (pos, 0); | |
1171 | { | |
1172 | Lisp_Object dest_start, dest_end; | |
1173 | ||
1174 | dest_start = pos; | |
1175 | XFASTINT (dest_end) = XINT (dest_start) + (XINT (end) - XINT (start)); | |
1176 | /* Apply this to a copy of pos; it will try to increment its arguments, | |
1177 | which we don't want. */ | |
1178 | validate_interval_range (dest, &dest_start, &dest_end, soft); | |
1179 | } | |
1180 | ||
1181 | s = XINT (start); | |
1182 | e = XINT (end); | |
1183 | p = XINT (pos); | |
1184 | ||
1185 | stuff = Qnil; | |
1186 | ||
1187 | while (s < e) | |
1188 | { | |
1189 | e2 = i->position + LENGTH (i); | |
1190 | if (e2 > e) | |
1191 | e2 = e; | |
1192 | len = e2 - s; | |
1193 | ||
1194 | plist = i->plist; | |
1195 | if (! NILP (prop)) | |
1196 | while (! NILP (plist)) | |
1197 | { | |
1198 | if (EQ (Fcar (plist), prop)) | |
1199 | { | |
1200 | plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); | |
1201 | break; | |
1202 | } | |
1203 | plist = Fcdr (Fcdr (plist)); | |
1204 | } | |
1205 | if (! NILP (plist)) | |
1206 | { | |
1207 | /* Must defer modifications to the interval tree in case src | |
1208 | and dest refer to the same string or buffer. */ | |
1209 | stuff = Fcons (Fcons (make_number (p), | |
1210 | Fcons (make_number (p + len), | |
1211 | Fcons (plist, Qnil))), | |
1212 | stuff); | |
1213 | } | |
1214 | ||
1215 | i = next_interval (i); | |
1216 | if (NULL_INTERVAL_P (i)) | |
1217 | break; | |
1218 | ||
1219 | p += len; | |
1220 | s = i->position; | |
1221 | } | |
1222 | ||
1223 | while (! NILP (stuff)) | |
1224 | { | |
1225 | res = Fcar (stuff); | |
1226 | res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)), | |
1227 | Fcar (Fcdr (Fcdr (res))), dest); | |
1228 | if (! NILP (res)) | |
1229 | modified++; | |
1230 | stuff = Fcdr (stuff); | |
1231 | } | |
1232 | ||
1233 | return modified ? Qt : Qnil; | |
1234 | } | |
1235 | ||
d418ef42 JA |
1236 | void |
1237 | syms_of_textprop () | |
1238 | { | |
1239 | DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold, | |
c2e42adb | 1240 | "Threshold for rebalancing interval trees, expressed as the\n\ |
d418ef42 JA |
1241 | percentage by which the left interval tree should not differ from the right."); |
1242 | interval_balance_threshold = 8; | |
1243 | ||
688a5a0f RS |
1244 | DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks, |
1245 | "If nonnil, don't call the text property values of\n\ | |
1246 | `point-left' and `point-entered'."); | |
1247 | Vinhibit_point_motion_hooks = Qnil; | |
1248 | ||
d418ef42 JA |
1249 | /* Common attributes one might give text */ |
1250 | ||
1251 | staticpro (&Qforeground); | |
1252 | Qforeground = intern ("foreground"); | |
1253 | staticpro (&Qbackground); | |
1254 | Qbackground = intern ("background"); | |
1255 | staticpro (&Qfont); | |
1256 | Qfont = intern ("font"); | |
1257 | staticpro (&Qstipple); | |
1258 | Qstipple = intern ("stipple"); | |
1259 | staticpro (&Qunderline); | |
1260 | Qunderline = intern ("underline"); | |
1261 | staticpro (&Qread_only); | |
1262 | Qread_only = intern ("read-only"); | |
1263 | staticpro (&Qinvisible); | |
1264 | Qinvisible = intern ("invisible"); | |
19e1c426 RS |
1265 | staticpro (&Qhidden); |
1266 | Qhidden = intern ("hidden"); | |
dc70cea7 RS |
1267 | staticpro (&Qcategory); |
1268 | Qcategory = intern ("category"); | |
1269 | staticpro (&Qlocal_map); | |
1270 | Qlocal_map = intern ("local-map"); | |
19e1c426 RS |
1271 | staticpro (&Qfront_sticky); |
1272 | Qfront_sticky = intern ("front-sticky"); | |
1273 | staticpro (&Qrear_nonsticky); | |
1274 | Qrear_nonsticky = intern ("rear-nonsticky"); | |
d418ef42 JA |
1275 | |
1276 | /* Properties that text might use to specify certain actions */ | |
1277 | ||
1278 | staticpro (&Qmouse_left); | |
1279 | Qmouse_left = intern ("mouse-left"); | |
1280 | staticpro (&Qmouse_entered); | |
1281 | Qmouse_entered = intern ("mouse-entered"); | |
1282 | staticpro (&Qpoint_left); | |
1283 | Qpoint_left = intern ("point-left"); | |
1284 | staticpro (&Qpoint_entered); | |
1285 | Qpoint_entered = intern ("point-entered"); | |
d418ef42 JA |
1286 | |
1287 | defsubr (&Stext_properties_at); | |
5fbe2a44 | 1288 | defsubr (&Sget_text_property); |
d418ef42 | 1289 | defsubr (&Snext_property_change); |
9c79dd1b | 1290 | defsubr (&Snext_single_property_change); |
d418ef42 | 1291 | defsubr (&Sprevious_property_change); |
9c79dd1b | 1292 | defsubr (&Sprevious_single_property_change); |
d418ef42 | 1293 | defsubr (&Sadd_text_properties); |
d4b530ad | 1294 | defsubr (&Sput_text_property); |
d418ef42 JA |
1295 | defsubr (&Sset_text_properties); |
1296 | defsubr (&Sremove_text_properties); | |
ad9c1940 JB |
1297 | defsubr (&Stext_property_any); |
1298 | defsubr (&Stext_property_not_all); | |
5fbe2a44 | 1299 | /* defsubr (&Serase_text_properties); */ |
15e4954b | 1300 | /* defsubr (&Scopy_text_properties); */ |
d418ef42 | 1301 | } |
25013c26 JA |
1302 | |
1303 | #else | |
1304 | ||
1305 | lose -- this shouldn't be compiled if USE_TEXT_PROPERTIES isn't defined | |
1306 | ||
1307 | #endif /* USE_TEXT_PROPERTIES */ |