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