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