Mercurial > emacs
annotate src/textprop.c @ 1283:6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
author | Joseph Arceneaux <jla@gnu.org> |
---|---|
date | Thu, 01 Oct 1992 00:56:11 +0000 |
parents | bfd04f61eb16 |
children | 538cc0cd6d83 |
rev | line source |
---|---|
1029 | 1 /* Interface code for dealing with text properties. |
2 Copyright (C) 1992 Free Software Foundation, Inc. | |
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 | |
8 the Free Software Foundation; either version 1, or (at your option) | |
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 | |
20 #include "config.h" | |
21 #include "lisp.h" | |
22 #include "intervals.h" | |
23 #include "buffer.h" | |
24 | |
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 | |
1211 | 30 set_properties needs to deal with the interval property cache. |
31 | |
1029 | 32 It is assumed that for any interval plist, a property appears |
33 only once on the list. Although some code i.e., remove_properties (), | |
34 handles the more general case, the uniqueness of properties is | |
35 neccessary for the system to remain consistent. This requirement | |
36 is enforced by the subrs installing properties onto the intervals. */ | |
37 | |
38 | |
39 /* Types of hooks. */ | |
40 Lisp_Object Qmouse_left; | |
41 Lisp_Object Qmouse_entered; | |
42 Lisp_Object Qpoint_left; | |
43 Lisp_Object Qpoint_entered; | |
44 Lisp_Object Qmodification; | |
45 | |
46 /* Visual properties text (including strings) may have. */ | |
47 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple; | |
48 Lisp_Object Qinvisible, Qread_only; | |
49 | |
1055 | 50 /* Extract the interval at the position pointed to by BEGIN from |
51 OBJECT, a string or buffer. Additionally, check that the positions | |
52 pointed to by BEGIN and END are within the bounds of OBJECT, and | |
53 reverse them if *BEGIN is greater than *END. The objects pointed | |
54 to by BEGIN and END may be integers or markers; if the latter, they | |
55 are coerced to integers. | |
1029 | 56 |
57 Note that buffer points don't correspond to interval indices. | |
58 For example, point-max is 1 greater than the index of the last | |
59 character. This difference is handled in the caller, which uses | |
60 the validated points to determine a length, and operates on that. | |
61 Exceptions are Ftext_properties_at, Fnext_property_change, and | |
62 Fprevious_property_change which call this function with BEGIN == END. | |
63 Handle this case specially. | |
64 | |
65 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise, | |
1055 | 66 create an interval tree for OBJECT if one doesn't exist, provided |
67 the object actually contains text. In the current design, if there | |
68 is no text, there can be no text properties. */ | |
1029 | 69 |
70 #define soft 0 | |
71 #define hard 1 | |
72 | |
73 static INTERVAL | |
74 validate_interval_range (object, begin, end, force) | |
75 Lisp_Object object, *begin, *end; | |
76 int force; | |
77 { | |
78 register INTERVAL i; | |
79 CHECK_STRING_OR_BUFFER (object, 0); | |
80 CHECK_NUMBER_COERCE_MARKER (*begin, 0); | |
81 CHECK_NUMBER_COERCE_MARKER (*end, 0); | |
82 | |
83 /* If we are asked for a point, but from a subr which operates | |
84 on a range, then return nothing. */ | |
85 if (*begin == *end && begin != end) | |
86 return NULL_INTERVAL; | |
87 | |
88 if (XINT (*begin) > XINT (*end)) | |
89 { | |
90 register int n; | |
91 n = XFASTINT (*begin); /* This is legit even if *begin is < 0 */ | |
92 *begin = *end; | |
93 XFASTINT (*end) = n; /* because this is all we do with n. */ | |
94 } | |
95 | |
96 if (XTYPE (object) == Lisp_Buffer) | |
97 { | |
98 register struct buffer *b = XBUFFER (object); | |
99 | |
100 /* If there's no text, there are no properties. */ | |
101 if (BUF_BEGV (b) == BUF_ZV (b)) | |
102 return NULL_INTERVAL; | |
103 | |
104 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end) | |
105 && XINT (*end) <= BUF_ZV (b))) | |
106 args_out_of_range (*begin, *end); | |
107 i = b->intervals; | |
108 | |
109 /* Special case for point-max: return the interval for the | |
110 last character. */ | |
111 if (*begin == *end && *begin == BUF_Z (b)) | |
112 *begin -= 1; | |
113 } | |
114 else | |
115 { | |
116 register struct Lisp_String *s = XSTRING (object); | |
117 | |
118 if (! (1 <= XINT (*begin) && XINT (*begin) <= XINT (*end) | |
119 && XINT (*end) <= s->size)) | |
120 args_out_of_range (*begin, *end); | |
121 i = s->intervals; | |
122 } | |
123 | |
124 if (NULL_INTERVAL_P (i)) | |
125 return (force ? create_root_interval (object) : i); | |
126 | |
127 return find_interval (i, XINT (*begin)); | |
128 } | |
129 | |
130 /* Validate LIST as a property list. If LIST is not a list, then | |
131 make one consisting of (LIST nil). Otherwise, verify that LIST | |
132 is even numbered and thus suitable as a plist. */ | |
133 | |
134 static Lisp_Object | |
135 validate_plist (list) | |
136 { | |
137 if (NILP (list)) | |
138 return Qnil; | |
139 | |
140 if (CONSP (list)) | |
141 { | |
142 register int i; | |
143 register Lisp_Object tail; | |
144 for (i = 0, tail = list; !NILP (tail); i++) | |
145 tail = Fcdr (tail); | |
146 if (i & 1) | |
147 error ("Odd length text property list"); | |
148 return list; | |
149 } | |
150 | |
151 return Fcons (list, Fcons (Qnil, Qnil)); | |
152 } | |
153 | |
154 #define set_properties(list,i) (i->plist = Fcopy_sequence (list)) | |
155 | |
156 /* Return nonzero if interval I has all the properties, | |
157 with the same values, of list PLIST. */ | |
158 | |
159 static int | |
160 interval_has_all_properties (plist, i) | |
161 Lisp_Object plist; | |
162 INTERVAL i; | |
163 { | |
164 register Lisp_Object tail1, tail2, sym1, sym2; | |
165 register int found; | |
166 | |
167 /* Go through each element of PLIST. */ | |
168 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
169 { | |
170 sym1 = Fcar (tail1); | |
171 found = 0; | |
172 | |
173 /* Go through I's plist, looking for sym1 */ | |
174 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
175 if (EQ (sym1, Fcar (tail2))) | |
176 { | |
177 /* Found the same property on both lists. If the | |
178 values are unequal, return zero. */ | |
179 if (! EQ (Fequal (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))), | |
180 Qt)) | |
181 return 0; | |
182 | |
183 /* Property has same value on both lists; go to next one. */ | |
184 found = 1; | |
185 break; | |
186 } | |
187 | |
188 if (! found) | |
189 return 0; | |
190 } | |
191 | |
192 return 1; | |
193 } | |
194 | |
195 /* Return nonzero if the plist of interval I has any of the | |
196 properties of PLIST, regardless of their values. */ | |
197 | |
198 static INLINE int | |
199 interval_has_some_properties (plist, i) | |
200 Lisp_Object plist; | |
201 INTERVAL i; | |
202 { | |
203 register Lisp_Object tail1, tail2, sym; | |
204 | |
205 /* Go through each element of PLIST. */ | |
206 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
207 { | |
208 sym = Fcar (tail1); | |
209 | |
210 /* Go through i's plist, looking for tail1 */ | |
211 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
212 if (EQ (sym, Fcar (tail2))) | |
213 return 1; | |
214 } | |
215 | |
216 return 0; | |
217 } | |
218 | |
219 /* Add the properties of PLIST to the interval I, or set | |
220 the value of I's property to the value of the property on PLIST | |
221 if they are different. | |
222 | |
223 Return nonzero if this changes I (i.e., if any members of PLIST | |
224 are actually added to I's plist) */ | |
225 | |
226 static INLINE int | |
227 add_properties (plist, i) | |
228 Lisp_Object plist; | |
229 INTERVAL i; | |
230 { | |
231 register Lisp_Object tail1, tail2, sym1, val1; | |
232 register int changed = 0; | |
233 register int found; | |
234 | |
235 /* Go through each element of PLIST. */ | |
236 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
237 { | |
238 sym1 = Fcar (tail1); | |
239 val1 = Fcar (Fcdr (tail1)); | |
240 found = 0; | |
241 | |
242 /* Go through I's plist, looking for sym1 */ | |
243 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) | |
244 if (EQ (sym1, Fcar (tail2))) | |
245 { | |
246 register Lisp_Object this_cdr = Fcdr (tail2); | |
247 | |
248 /* Found the property. Now check its value. */ | |
249 found = 1; | |
250 | |
251 /* The properties have the same value on both lists. | |
252 Continue to the next property. */ | |
253 if (Fequal (val1, Fcar (this_cdr))) | |
254 break; | |
255 | |
256 /* I's property has a different value -- change it */ | |
257 Fsetcar (this_cdr, val1); | |
258 changed++; | |
259 break; | |
260 } | |
261 | |
262 if (! found) | |
263 { | |
264 i->plist = Fcons (sym1, Fcons (val1, i->plist)); | |
265 changed++; | |
266 } | |
267 } | |
268 | |
269 return changed; | |
270 } | |
271 | |
272 /* For any members of PLIST which are properties of I, remove them | |
273 from I's plist. */ | |
274 | |
275 static INLINE int | |
276 remove_properties (plist, i) | |
277 Lisp_Object plist; | |
278 INTERVAL i; | |
279 { | |
280 register Lisp_Object tail1, tail2, sym; | |
281 register Lisp_Object current_plist = i->plist; | |
282 register int changed = 0; | |
283 | |
284 /* Go through each element of plist. */ | |
285 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) | |
286 { | |
287 sym = Fcar (tail1); | |
288 | |
289 /* First, remove the symbol if its at the head of the list */ | |
290 while (! NILP (current_plist) && EQ (sym, Fcar (current_plist))) | |
291 { | |
292 current_plist = Fcdr (Fcdr (current_plist)); | |
293 changed++; | |
294 } | |
295 | |
296 /* Go through i's plist, looking for sym */ | |
297 tail2 = current_plist; | |
298 while (! NILP (tail2)) | |
299 { | |
300 register Lisp_Object this = Fcdr (Fcdr (tail2)); | |
301 if (EQ (sym, Fcar (this))) | |
302 { | |
303 Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this))); | |
304 changed++; | |
305 } | |
306 tail2 = this; | |
307 } | |
308 } | |
309 | |
310 if (changed) | |
311 i->plist = current_plist; | |
312 return changed; | |
313 } | |
314 | |
315 /* Remove all properties from interval I. Return non-zero | |
316 if this changes the interval. */ | |
317 | |
318 static INLINE int | |
319 erase_properties (i) | |
320 INTERVAL i; | |
321 { | |
322 if (NILP (i->plist)) | |
323 return 0; | |
324 | |
325 i->plist = Qnil; | |
326 return 1; | |
327 } | |
328 | |
329 DEFUN ("text-properties-at", Ftext_properties_at, | |
330 Stext_properties_at, 1, 2, 0, | |
331 "Return the list of properties held by the character at POSITION\n\ | |
332 in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\ | |
333 defaults to the current buffer.") | |
334 (pos, object) | |
335 Lisp_Object pos, object; | |
336 { | |
337 register INTERVAL i; | |
338 register int p; | |
339 | |
340 if (NILP (object)) | |
341 XSET (object, Lisp_Buffer, current_buffer); | |
342 | |
343 i = validate_interval_range (object, &pos, &pos, soft); | |
344 if (NULL_INTERVAL_P (i)) | |
345 return Qnil; | |
346 | |
347 return i->plist; | |
348 } | |
349 | |
350 DEFUN ("next-property-change", Fnext_property_change, | |
351 Snext_property_change, 2, 2, 0, | |
352 "Return the position after POSITION in OBJECT which has properties\n\ | |
353 different from those at POSITION. OBJECT may be a string or buffer.\n\ | |
354 Returns nil if unsuccessful.") | |
355 (pos, object) | |
356 Lisp_Object pos, object; | |
357 { | |
358 register INTERVAL i, next; | |
359 | |
360 i = validate_interval_range (object, &pos, &pos, soft); | |
361 if (NULL_INTERVAL_P (i)) | |
362 return Qnil; | |
363 | |
364 next = next_interval (i); | |
365 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)) | |
366 next = next_interval (next); | |
367 | |
368 if (NULL_INTERVAL_P (next)) | |
369 return Qnil; | |
370 | |
371 return next->position; | |
372 } | |
373 | |
1211 | 374 DEFUN ("next-single-property-change", Fnext_single_property_change, |
375 Snext_single_property_change, 3, 3, 0, | |
376 "Return the position after POSITION in OBJECT which has a different\n\ | |
377 value for PROPERTY than the text at POSITION. OBJECT may be a string or\n\ | |
378 buffer. Returns nil if unsuccessful.") | |
379 (pos, object, prop) | |
380 { | |
381 register INTERVAL i, next; | |
382 register Lisp_Object here_val; | |
383 | |
384 i = validate_interval_range (object, &pos, &pos, soft); | |
385 if (NULL_INTERVAL_P (i)) | |
386 return Qnil; | |
387 | |
388 here_val = Fget (prop, i->plist); | |
389 next = next_interval (i); | |
390 while (! NULL_INTERVAL_P (next) && EQ (here_val, Fget (prop, next->plist))) | |
391 next = next_interval (next); | |
392 | |
393 if (NULL_INTERVAL_P (next)) | |
394 return Qnil; | |
395 | |
396 return next->position; | |
397 } | |
398 | |
1029 | 399 DEFUN ("previous-property-change", Fprevious_property_change, |
400 Sprevious_property_change, 2, 2, 0, | |
1211 | 401 "Return the position preceding POSITION in OBJECT which has properties\n\ |
1029 | 402 different from those at POSITION. OBJECT may be a string or buffer.\n\ |
403 Returns nil if unsuccessful.") | |
404 (pos, object) | |
405 Lisp_Object pos, object; | |
406 { | |
407 register INTERVAL i, previous; | |
408 | |
409 i = validate_interval_range (object, &pos, &pos, soft); | |
410 if (NULL_INTERVAL_P (i)) | |
411 return Qnil; | |
412 | |
413 previous = previous_interval (i); | |
414 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i)) | |
415 previous = previous_interval (previous); | |
416 if (NULL_INTERVAL_P (previous)) | |
417 return Qnil; | |
418 | |
419 return previous->position + LENGTH (previous) - 1; | |
420 } | |
421 | |
1211 | 422 DEFUN ("previous-single-property-change", Fprevious_single_property_change, |
423 Sprevious_single_property_change, 3, 3, 0, | |
424 "Return the position preceding POSITION in OBJECT which has a\n\ | |
425 different value for PROPERTY than the text at POSITION. OBJECT may be | |
426 a string or buffer. Returns nil if unsuccessful.") | |
427 (pos, object, prop) | |
428 { | |
429 register INTERVAL i, previous; | |
430 register Lisp_Object here_val; | |
431 | |
432 i = validate_interval_range (object, &pos, &pos, soft); | |
433 if (NULL_INTERVAL_P (i)) | |
434 return Qnil; | |
435 | |
436 here_val = Fget (prop, i->plist); | |
437 previous = previous_interval (i); | |
438 while (! NULL_INTERVAL_P (previous) | |
439 && EQ (here_val, Fget (prop, previous->plist))) | |
440 previous = previous_interval (previous); | |
441 if (NULL_INTERVAL_P (previous)) | |
442 return Qnil; | |
443 | |
444 return previous->position + LENGTH (previous) - 1; | |
445 } | |
446 | |
1029 | 447 DEFUN ("add-text-properties", Fadd_text_properties, |
448 Sadd_text_properties, 4, 4, 0, | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
449 "Add the PROPERTIES, a property list, to the text of OBJECT,\n\ |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
450 a string or buffer, in the range START to END. Returns t if any change\n\ |
1029 | 451 was made, nil otherwise.") |
452 (object, start, end, properties) | |
453 Lisp_Object object, start, end, properties; | |
454 { | |
455 register INTERVAL i, unchanged; | |
456 register int s, len, modified; | |
457 | |
458 properties = validate_plist (properties); | |
459 if (NILP (properties)) | |
460 return Qnil; | |
461 | |
462 i = validate_interval_range (object, &start, &end, hard); | |
463 if (NULL_INTERVAL_P (i)) | |
464 return Qnil; | |
465 | |
466 s = XINT (start); | |
467 len = XINT (end) - s; | |
468 | |
469 /* If we're not starting on an interval boundary, we have to | |
470 split this interval. */ | |
471 if (i->position != s) | |
472 { | |
473 /* If this interval already has the properties, we can | |
474 skip it. */ | |
475 if (interval_has_all_properties (properties, i)) | |
476 { | |
477 int got = (LENGTH (i) - (s - i->position)); | |
478 if (got >= len) | |
479 return Qnil; | |
480 len -= got; | |
481 } | |
482 else | |
483 { | |
484 unchanged = i; | |
485 i = split_interval_right (unchanged, s - unchanged->position + 1); | |
486 copy_properties (unchanged, i); | |
487 if (LENGTH (i) > len) | |
488 { | |
489 i = split_interval_left (i, len + 1); | |
490 copy_properties (unchanged, i); | |
491 add_properties (properties, i); | |
492 return Qt; | |
493 } | |
494 | |
495 add_properties (properties, i); | |
496 modified = 1; | |
497 len -= LENGTH (i); | |
498 i = next_interval (i); | |
499 } | |
500 } | |
501 | |
502 /* We are at the beginning of an interval, with len to scan */ | |
503 while (1) | |
504 { | |
505 if (LENGTH (i) >= len) | |
506 { | |
507 if (interval_has_all_properties (properties, i)) | |
508 return modified ? Qt : Qnil; | |
509 | |
510 if (LENGTH (i) == len) | |
511 { | |
512 add_properties (properties, i); | |
513 return Qt; | |
514 } | |
515 | |
516 /* i doesn't have the properties, and goes past the change limit */ | |
517 unchanged = i; | |
518 i = split_interval_left (unchanged, len + 1); | |
519 copy_properties (unchanged, i); | |
520 add_properties (properties, i); | |
521 return Qt; | |
522 } | |
523 | |
524 len -= LENGTH (i); | |
525 modified += add_properties (properties, i); | |
526 i = next_interval (i); | |
527 } | |
528 } | |
529 | |
530 DEFUN ("set-text-properties", Fset_text_properties, | |
531 Sset_text_properties, 4, 4, 0, | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
532 "Make the text of OBJECT, a string or buffer, have precisely\n\ |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
533 PROPERTIES, a list of properties, in the range START to END.\n\ |
1029 | 534 \n\ |
535 If called with a valid property list, return t (text was changed).\n\ | |
536 Otherwise return nil.") | |
537 (object, start, end, properties) | |
538 Lisp_Object object, start, end, properties; | |
539 { | |
540 register INTERVAL i, unchanged; | |
1211 | 541 register INTERVAL prev_changed = NULL_INTERVAL; |
1029 | 542 register int s, len; |
543 | |
544 properties = validate_plist (properties); | |
545 if (NILP (properties)) | |
546 return Qnil; | |
547 | |
548 i = validate_interval_range (object, &start, &end, hard); | |
549 if (NULL_INTERVAL_P (i)) | |
550 return Qnil; | |
551 | |
552 s = XINT (start); | |
553 len = XINT (end) - s; | |
554 | |
555 if (i->position != s) | |
556 { | |
557 unchanged = i; | |
558 i = split_interval_right (unchanged, s - unchanged->position + 1); | |
1211 | 559 set_properties (properties, i); |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
560 |
1029 | 561 if (LENGTH (i) > len) |
562 { | |
1211 | 563 i = split_interval_right (i, len); |
564 copy_properties (unchanged, i); | |
1029 | 565 return Qt; |
566 } | |
567 | |
1211 | 568 if (LENGTH (i) == len) |
569 return Qt; | |
570 | |
571 prev_changed = i; | |
1029 | 572 len -= LENGTH (i); |
573 i = next_interval (i); | |
574 } | |
575 | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
576 /* We are starting at the beginning of an interval, I */ |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
577 while (len > 0) |
1029 | 578 { |
579 if (LENGTH (i) >= len) | |
580 { | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
581 if (LENGTH (i) > len) |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
582 i = split_interval_left (i, len + 1); |
1029 | 583 |
1211 | 584 if (NULL_INTERVAL_P (prev_changed)) |
585 set_properties (properties, i); | |
586 else | |
587 merge_interval_left (i); | |
1029 | 588 return Qt; |
589 } | |
590 | |
591 len -= LENGTH (i); | |
1211 | 592 if (NULL_INTERVAL_P (prev_changed)) |
593 { | |
594 set_properties (properties, i); | |
595 prev_changed = i; | |
596 } | |
597 else | |
598 prev_changed = i = merge_interval_left (i); | |
599 | |
1029 | 600 i = next_interval (i); |
601 } | |
602 | |
603 return Qt; | |
604 } | |
605 | |
606 DEFUN ("remove-text-properties", Fremove_text_properties, | |
607 Sremove_text_properties, 4, 4, 0, | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
608 "Remove the PROPERTIES, a property list, from the text of OBJECT,\n\ |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
609 a string or buffer, in the range START to END. Returns t if any change\n\ |
1029 | 610 was made, nil otherwise.") |
611 (object, start, end, properties) | |
612 Lisp_Object object, start, end, properties; | |
613 { | |
614 register INTERVAL i, unchanged; | |
615 register int s, len, modified; | |
616 | |
617 i = validate_interval_range (object, &start, &end, soft); | |
618 if (NULL_INTERVAL_P (i)) | |
619 return Qnil; | |
620 | |
621 s = XINT (start); | |
622 len = XINT (end) - s; | |
1211 | 623 |
1029 | 624 if (i->position != s) |
625 { | |
626 /* No properties on this first interval -- return if | |
627 it covers the entire region. */ | |
628 if (! interval_has_some_properties (properties, i)) | |
629 { | |
630 int got = (LENGTH (i) - (s - i->position)); | |
631 if (got >= len) | |
632 return Qnil; | |
633 len -= got; | |
634 } | |
635 /* Remove the properties from this interval. If it's short | |
636 enough, return, splitting it if it's too short. */ | |
637 else | |
638 { | |
639 unchanged = i; | |
640 i = split_interval_right (unchanged, s - unchanged->position + 1); | |
641 copy_properties (unchanged, i); | |
642 if (LENGTH (i) > len) | |
643 { | |
644 i = split_interval_left (i, len + 1); | |
645 copy_properties (unchanged, i); | |
646 remove_properties (properties, i); | |
647 return Qt; | |
648 } | |
649 | |
650 remove_properties (properties, i); | |
651 modified = 1; | |
652 len -= LENGTH (i); | |
653 i = next_interval (i); | |
654 } | |
655 } | |
656 | |
657 /* We are at the beginning of an interval, with len to scan */ | |
658 while (1) | |
659 { | |
660 if (LENGTH (i) >= len) | |
661 { | |
662 if (! interval_has_some_properties (properties, i)) | |
663 return modified ? Qt : Qnil; | |
664 | |
665 if (LENGTH (i) == len) | |
666 { | |
667 remove_properties (properties, i); | |
668 return Qt; | |
669 } | |
670 | |
671 /* i has the properties, and goes past the change limit */ | |
672 unchanged = split_interval_right (i, len + 1); | |
673 copy_properties (unchanged, i); | |
674 remove_properties (properties, i); | |
675 return Qt; | |
676 } | |
677 | |
678 len -= LENGTH (i); | |
679 modified += remove_properties (properties, i); | |
680 i = next_interval (i); | |
681 } | |
682 } | |
683 | |
684 DEFUN ("erase-text-properties", Ferase_text_properties, | |
685 Serase_text_properties, 3, 3, 0, | |
686 "Remove all text properties from OBJECT (a string or buffer), in the\n\ | |
687 range START to END. Returns t if any change was made, nil otherwise.") | |
688 (object, start, end) | |
689 Lisp_Object object, start, end; | |
690 { | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
691 register INTERVAL i; |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
692 register prev_changed = NULL_INTERVAL; |
1029 | 693 register int s, len, modified; |
694 | |
695 i = validate_interval_range (object, &start, &end, soft); | |
696 if (NULL_INTERVAL_P (i)) | |
697 return Qnil; | |
698 | |
699 s = XINT (start); | |
700 len = XINT (end) - s; | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
701 |
1029 | 702 if (i->position != s) |
703 { | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
704 register int got; |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
705 register INTERVAL unchanged = i; |
1029 | 706 |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
707 /* If there are properties here, then this text will be modified. */ |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
708 if (! NILP (i->plist)) |
1029 | 709 { |
710 i = split_interval_right (unchanged, s - unchanged->position + 1); | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
711 i->plist = Qnil; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
712 modified++; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
713 |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
714 if (LENGTH (i) > len) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
715 { |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
716 i = split_interval_right (i, len + 1); |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
717 copy_properties (unchanged, i); |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
718 return Qt; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
719 } |
1029 | 720 |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
721 if (LENGTH (i) == len) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
722 return Qt; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
723 |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
724 got = LENGTH (i); |
1029 | 725 } |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
726 /* If the text of I is without any properties, and contains |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
727 LEN or more characters, then we may return without changing |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
728 anything.*/ |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
729 else if (LENGTH (i) - (s - i->position) <= len) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
730 return Qnil; |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
731 /* The amount of text to change extends past I, so just note |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
732 how much we've gotten. */ |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
733 else |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
734 got = LENGTH (i) - (s - i->position); |
1029 | 735 |
736 len -= got; | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
737 prev_changed = i; |
1029 | 738 i = next_interval (i); |
739 } | |
740 | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
741 /* We are starting at the beginning of an interval, I. */ |
1029 | 742 while (len > 0) |
743 { | |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
744 if (LENGTH (i) >= len) |
1029 | 745 { |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
746 /* If I has no properties, simply merge it if possible. */ |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
747 if (NILP (i->plist)) |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
748 { |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
749 if (! NULL_INTERVAL_P (prev_changed)) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
750 merge_interval_left (i); |
1029 | 751 |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
752 return modified ? Qt : Qnil; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
753 } |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
754 |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
755 if (LENGTH (i) > len) |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
756 i = split_interval_left (i, len + 1); |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
757 if (! NULL_INTERVAL_P (prev_changed)) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
758 merge_interval_left (i); |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
759 else |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
760 i->plist = Qnil; |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
761 |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
762 return Qt; |
1029 | 763 } |
764 | |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
765 /* Here if we still need to erase past the end of I */ |
1029 | 766 len -= LENGTH (i); |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
767 if (NULL_INTERVAL_P (prev_changed)) |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
768 { |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
769 modified += erase_properties (i); |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
770 prev_changed = i; |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
771 } |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
772 else |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
773 { |
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
774 modified += ! NILP (i->plist); |
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
parents:
1272
diff
changeset
|
775 /* Merging I will give it the properties of PREV_CHANGED. */ |
1272
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
776 prev_changed = i = merge_interval_left (i); |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
777 } |
bfd04f61eb16
Mods to Ferase_text_properties
Joseph Arceneaux <jla@gnu.org>
parents:
1211
diff
changeset
|
778 |
1029 | 779 i = next_interval (i); |
780 } | |
781 | |
782 return modified ? Qt : Qnil; | |
783 } | |
784 | |
785 void | |
786 syms_of_textprop () | |
787 { | |
788 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold, | |
789 "Threshold for rebalancing interval trees, expressed as the | |
790 percentage by which the left interval tree should not differ from the right."); | |
791 interval_balance_threshold = 8; | |
792 | |
793 /* Common attributes one might give text */ | |
794 | |
795 staticpro (&Qforeground); | |
796 Qforeground = intern ("foreground"); | |
797 staticpro (&Qbackground); | |
798 Qbackground = intern ("background"); | |
799 staticpro (&Qfont); | |
800 Qfont = intern ("font"); | |
801 staticpro (&Qstipple); | |
802 Qstipple = intern ("stipple"); | |
803 staticpro (&Qunderline); | |
804 Qunderline = intern ("underline"); | |
805 staticpro (&Qread_only); | |
806 Qread_only = intern ("read-only"); | |
807 staticpro (&Qinvisible); | |
808 Qinvisible = intern ("invisible"); | |
809 | |
810 /* Properties that text might use to specify certain actions */ | |
811 | |
812 staticpro (&Qmouse_left); | |
813 Qmouse_left = intern ("mouse-left"); | |
814 staticpro (&Qmouse_entered); | |
815 Qmouse_entered = intern ("mouse-entered"); | |
816 staticpro (&Qpoint_left); | |
817 Qpoint_left = intern ("point-left"); | |
818 staticpro (&Qpoint_entered); | |
819 Qpoint_entered = intern ("point-entered"); | |
820 staticpro (&Qmodification); | |
821 Qmodification = intern ("modification"); | |
822 | |
823 defsubr (&Stext_properties_at); | |
824 defsubr (&Snext_property_change); | |
1211 | 825 defsubr (&Snext_single_property_change); |
1029 | 826 defsubr (&Sprevious_property_change); |
1211 | 827 defsubr (&Sprevious_single_property_change); |
1029 | 828 defsubr (&Sadd_text_properties); |
829 defsubr (&Sset_text_properties); | |
830 defsubr (&Sremove_text_properties); | |
831 defsubr (&Serase_text_properties); | |
832 } |