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