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,
|
|
449 "Add the PROPERTIES (a property list) to the text of OBJECT\n\
|
|
450 (a string or buffer) in the range START to END. Returns t if any change\n\
|
|
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,
|
|
532 "Make the text of OBJECT (a string or buffer) have precisely\n\
|
|
533 PROPERTIES (a list of properties) in the range START to END.\n\
|
|
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);
|
1029
|
560 if (LENGTH (i) > len)
|
|
561 {
|
1211
|
562 i = split_interval_right (i, len);
|
|
563 copy_properties (unchanged, i);
|
1029
|
564 return Qt;
|
|
565 }
|
|
566
|
1211
|
567 if (LENGTH (i) == len)
|
|
568 return Qt;
|
|
569
|
|
570 prev_changed = i;
|
1029
|
571 len -= LENGTH (i);
|
|
572 i = next_interval (i);
|
|
573 }
|
|
574
|
|
575 while (1)
|
|
576 {
|
|
577 if (LENGTH (i) >= len)
|
|
578 {
|
|
579 if (LENGTH (i) == len)
|
|
580 {
|
1211
|
581 if (NULL_INTERVAL_P (prev_changed))
|
|
582 set_properties (properties, i);
|
|
583 else
|
|
584 merge_interval_left (i);
|
1029
|
585 return Qt;
|
|
586 }
|
|
587
|
|
588 i = split_interval_left (i, len + 1);
|
1211
|
589 if (NULL_INTERVAL_P (prev_changed))
|
|
590 set_properties (properties, i);
|
|
591 else
|
|
592 merge_interval_left (i);
|
1029
|
593 return Qt;
|
|
594 }
|
|
595
|
|
596 len -= LENGTH (i);
|
1211
|
597 if (NULL_INTERVAL_P (prev_changed))
|
|
598 {
|
|
599 set_properties (properties, i);
|
|
600 prev_changed = i;
|
|
601 }
|
|
602 else
|
|
603 prev_changed = i = merge_interval_left (i);
|
|
604
|
1029
|
605 i = next_interval (i);
|
|
606 }
|
|
607
|
|
608 return Qt;
|
|
609 }
|
|
610
|
|
611 DEFUN ("remove-text-properties", Fremove_text_properties,
|
|
612 Sremove_text_properties, 4, 4, 0,
|
|
613 "Remove the PROPERTIES (a property list) from the text of OBJECT\n\
|
|
614 (a string or buffer) in the range START to END. Returns t if any change\n\
|
|
615 was made, nil otherwise.")
|
|
616 (object, start, end, properties)
|
|
617 Lisp_Object object, start, end, properties;
|
|
618 {
|
|
619 register INTERVAL i, unchanged;
|
|
620 register int s, len, modified;
|
|
621
|
|
622 i = validate_interval_range (object, &start, &end, soft);
|
|
623 if (NULL_INTERVAL_P (i))
|
|
624 return Qnil;
|
|
625
|
|
626 s = XINT (start);
|
|
627 len = XINT (end) - s;
|
1211
|
628
|
1029
|
629 if (i->position != s)
|
|
630 {
|
|
631 /* No properties on this first interval -- return if
|
|
632 it covers the entire region. */
|
|
633 if (! interval_has_some_properties (properties, i))
|
|
634 {
|
|
635 int got = (LENGTH (i) - (s - i->position));
|
|
636 if (got >= len)
|
|
637 return Qnil;
|
|
638 len -= got;
|
|
639 }
|
|
640 /* Remove the properties from this interval. If it's short
|
|
641 enough, return, splitting it if it's too short. */
|
|
642 else
|
|
643 {
|
|
644 unchanged = i;
|
|
645 i = split_interval_right (unchanged, s - unchanged->position + 1);
|
|
646 copy_properties (unchanged, i);
|
|
647 if (LENGTH (i) > len)
|
|
648 {
|
|
649 i = split_interval_left (i, len + 1);
|
|
650 copy_properties (unchanged, i);
|
|
651 remove_properties (properties, i);
|
|
652 return Qt;
|
|
653 }
|
|
654
|
|
655 remove_properties (properties, i);
|
|
656 modified = 1;
|
|
657 len -= LENGTH (i);
|
|
658 i = next_interval (i);
|
|
659 }
|
|
660 }
|
|
661
|
|
662 /* We are at the beginning of an interval, with len to scan */
|
|
663 while (1)
|
|
664 {
|
|
665 if (LENGTH (i) >= len)
|
|
666 {
|
|
667 if (! interval_has_some_properties (properties, i))
|
|
668 return modified ? Qt : Qnil;
|
|
669
|
|
670 if (LENGTH (i) == len)
|
|
671 {
|
|
672 remove_properties (properties, i);
|
|
673 return Qt;
|
|
674 }
|
|
675
|
|
676 /* i has the properties, and goes past the change limit */
|
|
677 unchanged = split_interval_right (i, len + 1);
|
|
678 copy_properties (unchanged, i);
|
|
679 remove_properties (properties, i);
|
|
680 return Qt;
|
|
681 }
|
|
682
|
|
683 len -= LENGTH (i);
|
|
684 modified += remove_properties (properties, i);
|
|
685 i = next_interval (i);
|
|
686 }
|
|
687 }
|
|
688
|
|
689 DEFUN ("erase-text-properties", Ferase_text_properties,
|
|
690 Serase_text_properties, 3, 3, 0,
|
|
691 "Remove all text properties from OBJECT (a string or buffer), in the\n\
|
|
692 range START to END. Returns t if any change was made, nil otherwise.")
|
|
693 (object, start, end)
|
|
694 Lisp_Object object, start, end;
|
|
695 {
|
|
696 register INTERVAL i, unchanged;
|
|
697 register int s, len, modified;
|
|
698
|
|
699 i = validate_interval_range (object, &start, &end, soft);
|
|
700 if (NULL_INTERVAL_P (i))
|
|
701 return Qnil;
|
|
702
|
|
703 s = XINT (start);
|
|
704 len = XINT (end) - s;
|
|
705 if (i->position != s)
|
|
706 {
|
|
707 int got = LENGTH (i) - (s - i->position);
|
|
708
|
|
709 if (got > len)
|
|
710 {
|
|
711 if (NILP (i->plist))
|
|
712 return Qnil;
|
|
713
|
|
714 unchanged = i;
|
|
715 i = split_interval_right (unchanged, s - unchanged->position + 1);
|
|
716 i = split_interval_right (i, len + 1);
|
|
717 copy_properties (unchanged, i);
|
|
718 return Qt;
|
|
719 }
|
|
720
|
|
721 if (! NILP (i->plist))
|
|
722 {
|
|
723 i = split_interval_right (i, s - i->position + 1);
|
|
724 modified++;
|
|
725 }
|
|
726
|
|
727 len -= got;
|
|
728 i = next_interval (i);
|
|
729 }
|
|
730
|
|
731 /* We are starting at the beginning of an interval */
|
|
732 while (len > 0)
|
|
733 {
|
|
734 if (LENGTH (i) > len)
|
|
735 {
|
|
736 if (NILP (i->plist))
|
|
737 return modified ? Qt : Qnil;
|
|
738
|
|
739 i = split_interval_left (i, len + 1);
|
|
740 return Qt;
|
|
741 }
|
|
742
|
|
743 len -= LENGTH (i);
|
|
744 modified += erase_properties (i);
|
|
745 i = next_interval (i);
|
|
746 }
|
|
747
|
|
748 return modified ? Qt : Qnil;
|
|
749 }
|
|
750
|
|
751 void
|
|
752 syms_of_textprop ()
|
|
753 {
|
|
754 DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold,
|
|
755 "Threshold for rebalancing interval trees, expressed as the
|
|
756 percentage by which the left interval tree should not differ from the right.");
|
|
757 interval_balance_threshold = 8;
|
|
758
|
|
759 /* Common attributes one might give text */
|
|
760
|
|
761 staticpro (&Qforeground);
|
|
762 Qforeground = intern ("foreground");
|
|
763 staticpro (&Qbackground);
|
|
764 Qbackground = intern ("background");
|
|
765 staticpro (&Qfont);
|
|
766 Qfont = intern ("font");
|
|
767 staticpro (&Qstipple);
|
|
768 Qstipple = intern ("stipple");
|
|
769 staticpro (&Qunderline);
|
|
770 Qunderline = intern ("underline");
|
|
771 staticpro (&Qread_only);
|
|
772 Qread_only = intern ("read-only");
|
|
773 staticpro (&Qinvisible);
|
|
774 Qinvisible = intern ("invisible");
|
|
775
|
|
776 /* Properties that text might use to specify certain actions */
|
|
777
|
|
778 staticpro (&Qmouse_left);
|
|
779 Qmouse_left = intern ("mouse-left");
|
|
780 staticpro (&Qmouse_entered);
|
|
781 Qmouse_entered = intern ("mouse-entered");
|
|
782 staticpro (&Qpoint_left);
|
|
783 Qpoint_left = intern ("point-left");
|
|
784 staticpro (&Qpoint_entered);
|
|
785 Qpoint_entered = intern ("point-entered");
|
|
786 staticpro (&Qmodification);
|
|
787 Qmodification = intern ("modification");
|
|
788
|
|
789 defsubr (&Stext_properties_at);
|
|
790 defsubr (&Snext_property_change);
|
1211
|
791 defsubr (&Snext_single_property_change);
|
1029
|
792 defsubr (&Sprevious_property_change);
|
1211
|
793 defsubr (&Sprevious_single_property_change);
|
1029
|
794 defsubr (&Sadd_text_properties);
|
|
795 defsubr (&Sset_text_properties);
|
|
796 defsubr (&Sremove_text_properties);
|
|
797 defsubr (&Serase_text_properties);
|
|
798 }
|