1029
|
1 /* Interface code for dealing with text properties.
|
17467
|
2 Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
|
1029
|
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
|
3698
|
8 the Free Software Foundation; either version 2, or (at your option)
|
1029
|
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
|
14186
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
19 Boston, MA 02111-1307, USA. */
|
1029
|
20
|
4696
|
21 #include <config.h>
|
1029
|
22 #include "lisp.h"
|
|
23 #include "intervals.h"
|
|
24 #include "buffer.h"
|
6063
|
25 #include "window.h"
|
8962
|
26
|
|
27 #ifndef NULL
|
|
28 #define NULL (void *)0
|
|
29 #endif
|
13027
|
30
|
|
31 /* Test for membership, allowing for t (actually any non-cons) to mean the
|
|
32 universal set. */
|
|
33
|
|
34 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
|
1029
|
35
|
|
36
|
|
37 /* NOTES: previous- and next- property change will have to skip
|
|
38 zero-length intervals if they are implemented. This could be done
|
|
39 inside next_interval and previous_interval.
|
|
40
|
1211
|
41 set_properties needs to deal with the interval property cache.
|
|
42
|
1029
|
43 It is assumed that for any interval plist, a property appears
|
1965
|
44 only once on the list. Although some code i.e., remove_properties,
|
1029
|
45 handles the more general case, the uniqueness of properties is
|
3591
|
46 necessary for the system to remain consistent. This requirement
|
17467
|
47 is enforced by the subrs installing properties onto the intervals. */
|
1029
|
48
|
|
49
|
17467
|
50 /* Types of hooks. */
|
1029
|
51 Lisp_Object Qmouse_left;
|
|
52 Lisp_Object Qmouse_entered;
|
|
53 Lisp_Object Qpoint_left;
|
|
54 Lisp_Object Qpoint_entered;
|
2058
|
55 Lisp_Object Qcategory;
|
|
56 Lisp_Object Qlocal_map;
|
1029
|
57
|
17467
|
58 /* Visual properties text (including strings) may have. */
|
1029
|
59 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
|
23729
|
60 Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
|
4381
|
61
|
|
62 /* Sticky properties */
|
|
63 Lisp_Object Qfront_sticky, Qrear_nonsticky;
|
3960
|
64
|
|
65 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
|
|
66 the o1's cdr. Otherwise, return zero. This is handy for
|
|
67 traversing plists. */
|
25645
|
68 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
|
3960
|
69
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
70 Lisp_Object Vinhibit_point_motion_hooks;
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
71 Lisp_Object Vdefault_text_properties;
|
26872
|
72 Lisp_Object Vtext_property_default_nonsticky;
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
73
|
13027
|
74 /* verify_interval_modification saves insertion hooks here
|
|
75 to be run later by report_interval_modification. */
|
|
76 Lisp_Object interval_insert_behind_hooks;
|
|
77 Lisp_Object interval_insert_in_front_hooks;
|
1029
|
78
|
1055
|
79 /* Extract the interval at the position pointed to by BEGIN from
|
|
80 OBJECT, a string or buffer. Additionally, check that the positions
|
|
81 pointed to by BEGIN and END are within the bounds of OBJECT, and
|
|
82 reverse them if *BEGIN is greater than *END. The objects pointed
|
|
83 to by BEGIN and END may be integers or markers; if the latter, they
|
|
84 are coerced to integers.
|
1029
|
85
|
1965
|
86 When OBJECT is a string, we increment *BEGIN and *END
|
|
87 to make them origin-one.
|
|
88
|
1029
|
89 Note that buffer points don't correspond to interval indices.
|
|
90 For example, point-max is 1 greater than the index of the last
|
|
91 character. This difference is handled in the caller, which uses
|
|
92 the validated points to determine a length, and operates on that.
|
|
93 Exceptions are Ftext_properties_at, Fnext_property_change, and
|
|
94 Fprevious_property_change which call this function with BEGIN == END.
|
|
95 Handle this case specially.
|
|
96
|
|
97 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
|
1055
|
98 create an interval tree for OBJECT if one doesn't exist, provided
|
|
99 the object actually contains text. In the current design, if there
|
1965
|
100 is no text, there can be no text properties. */
|
1029
|
101
|
|
102 #define soft 0
|
|
103 #define hard 1
|
|
104
|
25000
|
105 INTERVAL
|
1029
|
106 validate_interval_range (object, begin, end, force)
|
|
107 Lisp_Object object, *begin, *end;
|
|
108 int force;
|
|
109 {
|
|
110 register INTERVAL i;
|
1965
|
111 int searchpos;
|
|
112
|
1029
|
113 CHECK_STRING_OR_BUFFER (object, 0);
|
|
114 CHECK_NUMBER_COERCE_MARKER (*begin, 0);
|
|
115 CHECK_NUMBER_COERCE_MARKER (*end, 0);
|
|
116
|
|
117 /* If we are asked for a point, but from a subr which operates
|
17467
|
118 on a range, then return nothing. */
|
8907
|
119 if (EQ (*begin, *end) && begin != end)
|
1029
|
120 return NULL_INTERVAL;
|
|
121
|
|
122 if (XINT (*begin) > XINT (*end))
|
|
123 {
|
1965
|
124 Lisp_Object n;
|
|
125 n = *begin;
|
1029
|
126 *begin = *end;
|
1965
|
127 *end = n;
|
1029
|
128 }
|
|
129
|
9109
|
130 if (BUFFERP (object))
|
1029
|
131 {
|
|
132 register struct buffer *b = XBUFFER (object);
|
|
133
|
|
134 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
|
|
135 && XINT (*end) <= BUF_ZV (b)))
|
|
136 args_out_of_range (*begin, *end);
|
10312
|
137 i = BUF_INTERVALS (b);
|
1029
|
138
|
17467
|
139 /* If there's no text, there are no properties. */
|
1965
|
140 if (BUF_BEGV (b) == BUF_ZV (b))
|
|
141 return NULL_INTERVAL;
|
|
142
|
|
143 searchpos = XINT (*begin);
|
1029
|
144 }
|
|
145 else
|
|
146 {
|
|
147 register struct Lisp_String *s = XSTRING (object);
|
|
148
|
1965
|
149 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
|
1029
|
150 && XINT (*end) <= s->size))
|
|
151 args_out_of_range (*begin, *end);
|
22344
|
152 XSETFASTINT (*begin, XFASTINT (*begin));
|
3996
|
153 if (begin != end)
|
22344
|
154 XSETFASTINT (*end, XFASTINT (*end));
|
1029
|
155 i = s->intervals;
|
1965
|
156
|
|
157 if (s->size == 0)
|
|
158 return NULL_INTERVAL;
|
|
159
|
|
160 searchpos = XINT (*begin);
|
1029
|
161 }
|
|
162
|
|
163 if (NULL_INTERVAL_P (i))
|
|
164 return (force ? create_root_interval (object) : i);
|
|
165
|
1965
|
166 return find_interval (i, searchpos);
|
1029
|
167 }
|
|
168
|
|
169 /* Validate LIST as a property list. If LIST is not a list, then
|
|
170 make one consisting of (LIST nil). Otherwise, verify that LIST
|
17467
|
171 is even numbered and thus suitable as a plist. */
|
1029
|
172
|
|
173 static Lisp_Object
|
|
174 validate_plist (list)
|
4797
|
175 Lisp_Object list;
|
1029
|
176 {
|
|
177 if (NILP (list))
|
|
178 return Qnil;
|
|
179
|
|
180 if (CONSP (list))
|
|
181 {
|
|
182 register int i;
|
|
183 register Lisp_Object tail;
|
|
184 for (i = 0, tail = list; !NILP (tail); i++)
|
3996
|
185 {
|
|
186 tail = Fcdr (tail);
|
|
187 QUIT;
|
|
188 }
|
1029
|
189 if (i & 1)
|
|
190 error ("Odd length text property list");
|
|
191 return list;
|
|
192 }
|
|
193
|
|
194 return Fcons (list, Fcons (Qnil, Qnil));
|
|
195 }
|
|
196
|
|
197 /* Return nonzero if interval I has all the properties,
|
17467
|
198 with the same values, of list PLIST. */
|
1029
|
199
|
|
200 static int
|
|
201 interval_has_all_properties (plist, i)
|
|
202 Lisp_Object plist;
|
|
203 INTERVAL i;
|
|
204 {
|
25772
|
205 register Lisp_Object tail1, tail2, sym1;
|
1029
|
206 register int found;
|
|
207
|
17467
|
208 /* Go through each element of PLIST. */
|
1029
|
209 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
210 {
|
|
211 sym1 = Fcar (tail1);
|
|
212 found = 0;
|
|
213
|
|
214 /* Go through I's plist, looking for sym1 */
|
|
215 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
216 if (EQ (sym1, Fcar (tail2)))
|
|
217 {
|
|
218 /* Found the same property on both lists. If the
|
17467
|
219 values are unequal, return zero. */
|
3998
|
220 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
|
1029
|
221 return 0;
|
|
222
|
17467
|
223 /* Property has same value on both lists; go to next one. */
|
1029
|
224 found = 1;
|
|
225 break;
|
|
226 }
|
|
227
|
|
228 if (! found)
|
|
229 return 0;
|
|
230 }
|
|
231
|
|
232 return 1;
|
|
233 }
|
|
234
|
|
235 /* Return nonzero if the plist of interval I has any of the
|
17467
|
236 properties of PLIST, regardless of their values. */
|
1029
|
237
|
|
238 static INLINE int
|
|
239 interval_has_some_properties (plist, i)
|
|
240 Lisp_Object plist;
|
|
241 INTERVAL i;
|
|
242 {
|
|
243 register Lisp_Object tail1, tail2, sym;
|
|
244
|
17467
|
245 /* Go through each element of PLIST. */
|
1029
|
246 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
247 {
|
|
248 sym = Fcar (tail1);
|
|
249
|
|
250 /* Go through i's plist, looking for tail1 */
|
|
251 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
252 if (EQ (sym, Fcar (tail2)))
|
|
253 return 1;
|
|
254 }
|
|
255
|
|
256 return 0;
|
|
257 }
|
1965
|
258
|
3960
|
259 /* Changing the plists of individual intervals. */
|
|
260
|
|
261 /* Return the value of PROP in property-list PLIST, or Qunbound if it
|
|
262 has none. */
|
8907
|
263 static Lisp_Object
|
3960
|
264 property_value (plist, prop)
|
8856
|
265 Lisp_Object plist, prop;
|
3960
|
266 {
|
|
267 Lisp_Object value;
|
|
268
|
|
269 while (PLIST_ELT_P (plist, value))
|
25645
|
270 if (EQ (XCAR (plist), prop))
|
|
271 return XCAR (value);
|
3960
|
272 else
|
25645
|
273 plist = XCDR (value);
|
3960
|
274
|
|
275 return Qunbound;
|
|
276 }
|
|
277
|
1965
|
278 /* Set the properties of INTERVAL to PROPERTIES,
|
|
279 and record undo info for the previous values.
|
|
280 OBJECT is the string or buffer that INTERVAL belongs to. */
|
|
281
|
|
282 static void
|
|
283 set_properties (properties, interval, object)
|
|
284 Lisp_Object properties, object;
|
|
285 INTERVAL interval;
|
|
286 {
|
3960
|
287 Lisp_Object sym, value;
|
1965
|
288
|
3960
|
289 if (BUFFERP (object))
|
1965
|
290 {
|
3960
|
291 /* For each property in the old plist which is missing from PROPERTIES,
|
|
292 or has a different value in PROPERTIES, make an undo record. */
|
|
293 for (sym = interval->plist;
|
|
294 PLIST_ELT_P (sym, value);
|
25645
|
295 sym = XCDR (value))
|
|
296 if (! EQ (property_value (properties, XCAR (sym)),
|
|
297 XCAR (value)))
|
4076
|
298 {
|
|
299 record_property_change (interval->position, LENGTH (interval),
|
25645
|
300 XCAR (sym), XCAR (value),
|
4076
|
301 object);
|
|
302 }
|
3960
|
303
|
|
304 /* For each new property that has no value at all in the old plist,
|
|
305 make an undo record binding it to nil, so it will be removed. */
|
|
306 for (sym = properties;
|
|
307 PLIST_ELT_P (sym, value);
|
25645
|
308 sym = XCDR (value))
|
|
309 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
|
4076
|
310 {
|
|
311 record_property_change (interval->position, LENGTH (interval),
|
25645
|
312 XCAR (sym), Qnil,
|
4076
|
313 object);
|
|
314 }
|
1965
|
315 }
|
|
316
|
|
317 /* Store new properties. */
|
|
318 interval->plist = Fcopy_sequence (properties);
|
|
319 }
|
1029
|
320
|
|
321 /* Add the properties of PLIST to the interval I, or set
|
|
322 the value of I's property to the value of the property on PLIST
|
|
323 if they are different.
|
|
324
|
1965
|
325 OBJECT should be the string or buffer the interval is in.
|
|
326
|
1029
|
327 Return nonzero if this changes I (i.e., if any members of PLIST
|
|
328 are actually added to I's plist) */
|
|
329
|
1965
|
330 static int
|
|
331 add_properties (plist, i, object)
|
1029
|
332 Lisp_Object plist;
|
|
333 INTERVAL i;
|
1965
|
334 Lisp_Object object;
|
1029
|
335 {
|
10159
|
336 Lisp_Object tail1, tail2, sym1, val1;
|
1029
|
337 register int changed = 0;
|
|
338 register int found;
|
10159
|
339 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
340
|
|
341 tail1 = plist;
|
|
342 sym1 = Qnil;
|
|
343 val1 = Qnil;
|
|
344 /* No need to protect OBJECT, because we can GC only in the case
|
|
345 where it is a buffer, and live buffers are always protected.
|
|
346 I and its plist are also protected, via OBJECT. */
|
|
347 GCPRO3 (tail1, sym1, val1);
|
1029
|
348
|
17467
|
349 /* Go through each element of PLIST. */
|
1029
|
350 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
351 {
|
|
352 sym1 = Fcar (tail1);
|
|
353 val1 = Fcar (Fcdr (tail1));
|
|
354 found = 0;
|
|
355
|
|
356 /* Go through I's plist, looking for sym1 */
|
|
357 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
358 if (EQ (sym1, Fcar (tail2)))
|
|
359 {
|
10159
|
360 /* No need to gcpro, because tail2 protects this
|
|
361 and it must be a cons cell (we get an error otherwise). */
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
362 register Lisp_Object this_cdr;
|
1029
|
363
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
364 this_cdr = Fcdr (tail2);
|
17467
|
365 /* Found the property. Now check its value. */
|
1029
|
366 found = 1;
|
|
367
|
|
368 /* The properties have the same value on both lists.
|
17467
|
369 Continue to the next property. */
|
3998
|
370 if (EQ (val1, Fcar (this_cdr)))
|
1029
|
371 break;
|
|
372
|
1965
|
373 /* Record this change in the buffer, for undo purposes. */
|
9109
|
374 if (BUFFERP (object))
|
1965
|
375 {
|
4076
|
376 record_property_change (i->position, LENGTH (i),
|
|
377 sym1, Fcar (this_cdr), object);
|
1965
|
378 }
|
|
379
|
1029
|
380 /* I's property has a different value -- change it */
|
|
381 Fsetcar (this_cdr, val1);
|
|
382 changed++;
|
|
383 break;
|
|
384 }
|
|
385
|
|
386 if (! found)
|
|
387 {
|
1965
|
388 /* Record this change in the buffer, for undo purposes. */
|
9109
|
389 if (BUFFERP (object))
|
1965
|
390 {
|
4076
|
391 record_property_change (i->position, LENGTH (i),
|
|
392 sym1, Qnil, object);
|
1965
|
393 }
|
1029
|
394 i->plist = Fcons (sym1, Fcons (val1, i->plist));
|
|
395 changed++;
|
|
396 }
|
|
397 }
|
|
398
|
10159
|
399 UNGCPRO;
|
|
400
|
1029
|
401 return changed;
|
|
402 }
|
|
403
|
|
404 /* For any members of PLIST which are properties of I, remove them
|
1965
|
405 from I's plist.
|
|
406 OBJECT is the string or buffer containing I. */
|
1029
|
407
|
1965
|
408 static int
|
|
409 remove_properties (plist, i, object)
|
1029
|
410 Lisp_Object plist;
|
|
411 INTERVAL i;
|
1965
|
412 Lisp_Object object;
|
1029
|
413 {
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
414 register Lisp_Object tail1, tail2, sym, current_plist;
|
1029
|
415 register int changed = 0;
|
|
416
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
417 current_plist = i->plist;
|
17467
|
418 /* Go through each element of plist. */
|
1029
|
419 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
420 {
|
|
421 sym = Fcar (tail1);
|
|
422
|
|
423 /* First, remove the symbol if its at the head of the list */
|
|
424 while (! NILP (current_plist) && EQ (sym, Fcar (current_plist)))
|
|
425 {
|
9109
|
426 if (BUFFERP (object))
|
1965
|
427 {
|
|
428 record_property_change (i->position, LENGTH (i),
|
|
429 sym, Fcar (Fcdr (current_plist)),
|
|
430 object);
|
|
431 }
|
|
432
|
1029
|
433 current_plist = Fcdr (Fcdr (current_plist));
|
|
434 changed++;
|
|
435 }
|
|
436
|
|
437 /* Go through i's plist, looking for sym */
|
|
438 tail2 = current_plist;
|
|
439 while (! NILP (tail2))
|
|
440 {
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
441 register Lisp_Object this;
|
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
442 this = Fcdr (Fcdr (tail2));
|
1029
|
443 if (EQ (sym, Fcar (this)))
|
|
444 {
|
9109
|
445 if (BUFFERP (object))
|
1965
|
446 {
|
4076
|
447 record_property_change (i->position, LENGTH (i),
|
|
448 sym, Fcar (Fcdr (this)), object);
|
1965
|
449 }
|
|
450
|
1029
|
451 Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this)));
|
|
452 changed++;
|
|
453 }
|
|
454 tail2 = this;
|
|
455 }
|
|
456 }
|
|
457
|
|
458 if (changed)
|
|
459 i->plist = current_plist;
|
|
460 return changed;
|
|
461 }
|
|
462
|
1965
|
463 #if 0
|
1029
|
464 /* Remove all properties from interval I. Return non-zero
|
17467
|
465 if this changes the interval. */
|
1029
|
466
|
|
467 static INLINE int
|
|
468 erase_properties (i)
|
|
469 INTERVAL i;
|
|
470 {
|
|
471 if (NILP (i->plist))
|
|
472 return 0;
|
|
473
|
|
474 i->plist = Qnil;
|
|
475 return 1;
|
|
476 }
|
1965
|
477 #endif
|
1029
|
478
|
22344
|
479 /* Returns the interval of POSITION in OBJECT.
|
17467
|
480 POSITION is BEG-based. */
|
|
481
|
|
482 INTERVAL
|
|
483 interval_of (position, object)
|
|
484 int position;
|
|
485 Lisp_Object object;
|
|
486 {
|
|
487 register INTERVAL i;
|
|
488 int beg, end;
|
|
489
|
|
490 if (NILP (object))
|
|
491 XSETBUFFER (object, current_buffer);
|
20955
|
492 else if (EQ (object, Qt))
|
|
493 return NULL_INTERVAL;
|
17467
|
494
|
|
495 CHECK_STRING_OR_BUFFER (object, 0);
|
|
496
|
|
497 if (BUFFERP (object))
|
|
498 {
|
|
499 register struct buffer *b = XBUFFER (object);
|
|
500
|
|
501 beg = BUF_BEGV (b);
|
|
502 end = BUF_ZV (b);
|
|
503 i = BUF_INTERVALS (b);
|
|
504 }
|
|
505 else
|
|
506 {
|
|
507 register struct Lisp_String *s = XSTRING (object);
|
|
508
|
22344
|
509 beg = 0;
|
|
510 end = s->size;
|
17467
|
511 i = s->intervals;
|
|
512 }
|
|
513
|
|
514 if (!(beg <= position && position <= end))
|
18736
e5e6647d4883
(interval_of): Convert args_out_of_range arguments to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
515 args_out_of_range (make_number (position), make_number (position));
|
17467
|
516 if (beg == end || NULL_INTERVAL_P (i))
|
|
517 return NULL_INTERVAL;
|
|
518
|
|
519 return find_interval (i, position);
|
|
520 }
|
|
521
|
1029
|
522 DEFUN ("text-properties-at", Ftext_properties_at,
|
|
523 Stext_properties_at, 1, 2, 0,
|
20522
|
524 "Return the list of properties of the character at POSITION in OBJECT.\n\
|
|
525 OBJECT is the string or buffer to look for the properties in;\n\
|
|
526 nil means the current buffer.\n\
|
1965
|
527 If POSITION is at the end of OBJECT, the value is nil.")
|
14088
|
528 (position, object)
|
|
529 Lisp_Object position, object;
|
1029
|
530 {
|
|
531 register INTERVAL i;
|
|
532
|
|
533 if (NILP (object))
|
9280
|
534 XSETBUFFER (object, current_buffer);
|
1029
|
535
|
14088
|
536 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
537 if (NULL_INTERVAL_P (i))
|
|
538 return Qnil;
|
14088
|
539 /* If POSITION is at the end of the interval,
|
1965
|
540 it means it's the end of OBJECT.
|
|
541 There are no properties at the very end,
|
|
542 since no character follows. */
|
14088
|
543 if (XINT (position) == LENGTH (i) + i->position)
|
1965
|
544 return Qnil;
|
1029
|
545
|
|
546 return i->plist;
|
|
547 }
|
|
548
|
1857
|
549 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
|
14088
|
550 "Return the value of POSITION's property PROP, in OBJECT.\n\
|
1965
|
551 OBJECT is optional and defaults to the current buffer.\n\
|
|
552 If POSITION is at the end of OBJECT, the value is nil.")
|
14088
|
553 (position, prop, object)
|
|
554 Lisp_Object position, object;
|
8271
|
555 Lisp_Object prop;
|
1857
|
556 {
|
14088
|
557 return textget (Ftext_properties_at (position, object), prop);
|
1857
|
558 }
|
|
559
|
6063
|
560 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
|
14088
|
561 "Return the value of POSITION's property PROP, in OBJECT.\n\
|
6063
|
562 OBJECT is optional and defaults to the current buffer.\n\
|
14088
|
563 If POSITION is at the end of OBJECT, the value is nil.\n\
|
6063
|
564 If OBJECT is a buffer, then overlay properties are considered as well as\n\
|
6064
|
565 text properties.\n\
|
|
566 If OBJECT is a window, then that window's buffer is used, but window-specific\n\
|
6063
|
567 overlays are considered only if they are associated with OBJECT.")
|
14088
|
568 (position, prop, object)
|
|
569 Lisp_Object position, object;
|
6063
|
570 register Lisp_Object prop;
|
|
571 {
|
|
572 struct window *w = 0;
|
|
573
|
14088
|
574 CHECK_NUMBER_COERCE_MARKER (position, 0);
|
6063
|
575
|
|
576 if (NILP (object))
|
9280
|
577 XSETBUFFER (object, current_buffer);
|
6063
|
578
|
|
579 if (WINDOWP (object))
|
|
580 {
|
|
581 w = XWINDOW (object);
|
8907
|
582 object = w->buffer;
|
6063
|
583 }
|
|
584 if (BUFFERP (object))
|
|
585 {
|
14088
|
586 int posn = XINT (position);
|
6063
|
587 int noverlays;
|
|
588 Lisp_Object *overlay_vec, tem;
|
|
589 int next_overlay;
|
|
590 int len;
|
12641
|
591 struct buffer *obuf = current_buffer;
|
|
592
|
|
593 set_buffer_temp (XBUFFER (object));
|
6063
|
594
|
|
595 /* First try with room for 40 overlays. */
|
|
596 len = 40;
|
|
597 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
|
|
598
|
8962
|
599 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
|
|
600 &next_overlay, NULL);
|
6063
|
601
|
|
602 /* If there are more than 40,
|
|
603 make enough space for all, and try again. */
|
|
604 if (noverlays > len)
|
|
605 {
|
|
606 len = noverlays;
|
|
607 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
|
8962
|
608 noverlays = overlays_at (posn, 0, &overlay_vec, &len,
|
|
609 &next_overlay, NULL);
|
6063
|
610 }
|
|
611 noverlays = sort_overlays (overlay_vec, noverlays, w);
|
|
612
|
12641
|
613 set_buffer_temp (obuf);
|
|
614
|
6063
|
615 /* Now check the overlays in order of decreasing priority. */
|
|
616 while (--noverlays >= 0)
|
|
617 {
|
|
618 tem = Foverlay_get (overlay_vec[noverlays], prop);
|
|
619 if (!NILP (tem))
|
|
620 return (tem);
|
|
621 }
|
|
622 }
|
|
623 /* Not a buffer, or no appropriate overlay, so fall through to the
|
|
624 simpler case. */
|
14088
|
625 return (Fget_text_property (position, prop, object));
|
6063
|
626 }
|
16679
|
627
|
|
628 DEFUN ("next-char-property-change", Fnext_char_property_change,
|
|
629 Snext_char_property_change, 1, 2, 0,
|
|
630 "Return the position of next text property or overlay change.\n\
|
|
631 This scans characters forward from POSITION in OBJECT till it finds\n\
|
|
632 a change in some text property, or the beginning or end of an overlay,\n\
|
|
633 and returns the position of that.\n\
|
|
634 If none is found, the function returns (point-max).\n\
|
|
635 \n\
|
|
636 If the optional third argument LIMIT is non-nil, don't search\n\
|
|
637 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
|
|
638 (position, limit)
|
|
639 Lisp_Object position, limit;
|
|
640 {
|
|
641 Lisp_Object temp;
|
6063
|
642
|
16679
|
643 temp = Fnext_overlay_change (position);
|
|
644 if (! NILP (limit))
|
|
645 {
|
|
646 CHECK_NUMBER (limit, 2);
|
|
647 if (XINT (limit) < XINT (temp))
|
|
648 temp = limit;
|
|
649 }
|
|
650 return Fnext_property_change (position, Qnil, temp);
|
|
651 }
|
|
652
|
|
653 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
|
|
654 Sprevious_char_property_change, 1, 2, 0,
|
|
655 "Return the position of previous text property or overlay change.\n\
|
|
656 Scans characters backward from POSITION in OBJECT till it finds\n\
|
|
657 a change in some text property, or the beginning or end of an overlay,\n\
|
|
658 and returns the position of that.\n\
|
|
659 If none is found, the function returns (point-max).\n\
|
|
660 \n\
|
|
661 If the optional third argument LIMIT is non-nil, don't search\n\
|
|
662 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
|
|
663 (position, limit)
|
|
664 Lisp_Object position, limit;
|
|
665 {
|
|
666 Lisp_Object temp;
|
|
667
|
|
668 temp = Fprevious_overlay_change (position);
|
|
669 if (! NILP (limit))
|
|
670 {
|
|
671 CHECK_NUMBER (limit, 2);
|
|
672 if (XINT (limit) > XINT (temp))
|
|
673 temp = limit;
|
|
674 }
|
|
675 return Fprevious_property_change (position, Qnil, temp);
|
|
676 }
|
25819
|
677
|
|
678
|
|
679 /* Value is the position in OBJECT after POS where the value of
|
|
680 property PROP changes. OBJECT must be a string or buffer. If
|
|
681 OBJECT is nil, use the current buffer. LIMIT if not nil limits the
|
|
682 search. */
|
|
683
|
|
684 Lisp_Object
|
|
685 next_single_char_property_change (pos, prop, object, limit)
|
|
686 Lisp_Object prop, pos, object, limit;
|
|
687 {
|
|
688 if (STRINGP (object))
|
|
689 {
|
|
690 pos = Fnext_single_property_change (pos, prop, object, limit);
|
|
691 if (NILP (pos))
|
|
692 {
|
|
693 if (NILP (limit))
|
|
694 pos = make_number (XSTRING (object)->size);
|
|
695 else
|
|
696 pos = limit;
|
|
697 }
|
|
698 }
|
|
699 else
|
|
700 {
|
|
701 Lisp_Object initial_value, value;
|
|
702 struct buffer *old_current_buffer = NULL;
|
|
703 int count = specpdl_ptr - specpdl;
|
|
704
|
|
705 if (!NILP (object))
|
|
706 CHECK_BUFFER (object, 0);
|
|
707
|
|
708 if (BUFFERP (object) && current_buffer != XBUFFER (object))
|
|
709 {
|
|
710 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
|
|
711 Fset_buffer (object);
|
|
712 }
|
|
713
|
|
714 initial_value = Fget_char_property (pos, prop, object);
|
|
715
|
|
716 while (XFASTINT (pos) < XFASTINT (limit))
|
|
717 {
|
|
718 pos = Fnext_char_property_change (pos, limit);
|
|
719 value = Fget_char_property (pos, prop, object);
|
|
720 if (!EQ (value, initial_value))
|
|
721 break;
|
|
722 }
|
|
723
|
|
724 unbind_to (count, Qnil);
|
|
725 }
|
|
726
|
|
727 return pos;
|
|
728 }
|
|
729
|
|
730
|
16679
|
731
|
1029
|
732 DEFUN ("next-property-change", Fnext_property_change,
|
5086
|
733 Snext_property_change, 1, 3, 0,
|
1857
|
734 "Return the position of next property change.\n\
|
14088
|
735 Scans characters forward from POSITION in OBJECT till it finds\n\
|
1857
|
736 a change in some text property, then returns the position of the change.\n\
|
|
737 The optional second argument OBJECT is the string or buffer to scan.\n\
|
|
738 Return nil if the property is constant all the way to the end of OBJECT.\n\
|
14088
|
739 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
|
5086
|
740 If the optional third argument LIMIT is non-nil, don't search\n\
|
|
741 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
|
14088
|
742 (position, object, limit)
|
|
743 Lisp_Object position, object, limit;
|
1029
|
744 {
|
|
745 register INTERVAL i, next;
|
|
746
|
1857
|
747 if (NILP (object))
|
9280
|
748 XSETBUFFER (object, current_buffer);
|
1857
|
749
|
10962
|
750 if (! NILP (limit) && ! EQ (limit, Qt))
|
7092
|
751 CHECK_NUMBER_COERCE_MARKER (limit, 0);
|
|
752
|
14088
|
753 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
754
|
10962
|
755 /* If LIMIT is t, return start of next interval--don't
|
|
756 bother checking further intervals. */
|
|
757 if (EQ (limit, Qt))
|
|
758 {
|
13265
|
759 if (NULL_INTERVAL_P (i))
|
|
760 next = i;
|
|
761 else
|
|
762 next = next_interval (i);
|
|
763
|
11116
|
764 if (NULL_INTERVAL_P (next))
|
14088
|
765 XSETFASTINT (position, (STRINGP (object)
|
|
766 ? XSTRING (object)->size
|
|
767 : BUF_ZV (XBUFFER (object))));
|
11116
|
768 else
|
22344
|
769 XSETFASTINT (position, next->position);
|
14088
|
770 return position;
|
10962
|
771 }
|
|
772
|
13265
|
773 if (NULL_INTERVAL_P (i))
|
|
774 return limit;
|
|
775
|
|
776 next = next_interval (i);
|
|
777
|
5086
|
778 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
|
22344
|
779 && (NILP (limit) || next->position < XFASTINT (limit)))
|
1029
|
780 next = next_interval (next);
|
|
781
|
|
782 if (NULL_INTERVAL_P (next))
|
5086
|
783 return limit;
|
22344
|
784 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
|
5086
|
785 return limit;
|
1029
|
786
|
22344
|
787 XSETFASTINT (position, next->position);
|
14088
|
788 return position;
|
4381
|
789 }
|
|
790
|
|
791 /* Return 1 if there's a change in some property between BEG and END. */
|
|
792
|
|
793 int
|
|
794 property_change_between_p (beg, end)
|
|
795 int beg, end;
|
|
796 {
|
|
797 register INTERVAL i, next;
|
|
798 Lisp_Object object, pos;
|
|
799
|
9280
|
800 XSETBUFFER (object, current_buffer);
|
9321
|
801 XSETFASTINT (pos, beg);
|
4381
|
802
|
|
803 i = validate_interval_range (object, &pos, &pos, soft);
|
|
804 if (NULL_INTERVAL_P (i))
|
|
805 return 0;
|
|
806
|
|
807 next = next_interval (i);
|
|
808 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
|
|
809 {
|
|
810 next = next_interval (next);
|
4614
|
811 if (NULL_INTERVAL_P (next))
|
|
812 return 0;
|
22344
|
813 if (next->position >= end)
|
4381
|
814 return 0;
|
|
815 }
|
|
816
|
|
817 if (NULL_INTERVAL_P (next))
|
|
818 return 0;
|
|
819
|
|
820 return 1;
|
1029
|
821 }
|
|
822
|
1211
|
823 DEFUN ("next-single-property-change", Fnext_single_property_change,
|
5086
|
824 Snext_single_property_change, 2, 4, 0,
|
1857
|
825 "Return the position of next property change for a specific property.\n\
|
14088
|
826 Scans characters forward from POSITION till it finds\n\
|
1857
|
827 a change in the PROP property, then returns the position of the change.\n\
|
|
828 The optional third argument OBJECT is the string or buffer to scan.\n\
|
5020
|
829 The property values are compared with `eq'.\n\
|
1857
|
830 Return nil if the property is constant all the way to the end of OBJECT.\n\
|
14088
|
831 If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
|
5086
|
832 If the optional fourth argument LIMIT is non-nil, don't search\n\
|
5645
|
833 past position LIMIT; return LIMIT if nothing is found before LIMIT.")
|
14088
|
834 (position, prop, object, limit)
|
|
835 Lisp_Object position, prop, object, limit;
|
1211
|
836 {
|
|
837 register INTERVAL i, next;
|
|
838 register Lisp_Object here_val;
|
|
839
|
1857
|
840 if (NILP (object))
|
9280
|
841 XSETBUFFER (object, current_buffer);
|
1857
|
842
|
7092
|
843 if (!NILP (limit))
|
|
844 CHECK_NUMBER_COERCE_MARKER (limit, 0);
|
|
845
|
14088
|
846 i = validate_interval_range (object, &position, &position, soft);
|
1211
|
847 if (NULL_INTERVAL_P (i))
|
5086
|
848 return limit;
|
1211
|
849
|
2762
|
850 here_val = textget (i->plist, prop);
|
1211
|
851 next = next_interval (i);
|
2762
|
852 while (! NULL_INTERVAL_P (next)
|
5086
|
853 && EQ (here_val, textget (next->plist, prop))
|
22344
|
854 && (NILP (limit) || next->position < XFASTINT (limit)))
|
1211
|
855 next = next_interval (next);
|
|
856
|
|
857 if (NULL_INTERVAL_P (next))
|
5086
|
858 return limit;
|
22344
|
859 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
|
5086
|
860 return limit;
|
1211
|
861
|
22344
|
862 return make_number (next->position);
|
1211
|
863 }
|
|
864
|
1029
|
865 DEFUN ("previous-property-change", Fprevious_property_change,
|
5086
|
866 Sprevious_property_change, 1, 3, 0,
|
1857
|
867 "Return the position of previous property change.\n\
|
14088
|
868 Scans characters backwards from POSITION in OBJECT till it finds\n\
|
1857
|
869 a change in some text property, then returns the position of the change.\n\
|
|
870 The optional second argument OBJECT is the string or buffer to scan.\n\
|
|
871 Return nil if the property is constant all the way to the start of OBJECT.\n\
|
14088
|
872 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
|
5086
|
873 If the optional third argument LIMIT is non-nil, don't search\n\
|
5645
|
874 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
|
14088
|
875 (position, object, limit)
|
|
876 Lisp_Object position, object, limit;
|
1029
|
877 {
|
|
878 register INTERVAL i, previous;
|
|
879
|
1857
|
880 if (NILP (object))
|
9280
|
881 XSETBUFFER (object, current_buffer);
|
1857
|
882
|
7092
|
883 if (!NILP (limit))
|
|
884 CHECK_NUMBER_COERCE_MARKER (limit, 0);
|
|
885
|
14088
|
886 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
887 if (NULL_INTERVAL_P (i))
|
5086
|
888 return limit;
|
1029
|
889
|
5644
|
890 /* Start with the interval containing the char before point. */
|
14088
|
891 if (i->position == XFASTINT (position))
|
5644
|
892 i = previous_interval (i);
|
|
893
|
1029
|
894 previous = previous_interval (i);
|
5086
|
895 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
|
|
896 && (NILP (limit)
|
22344
|
897 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
|
1029
|
898 previous = previous_interval (previous);
|
|
899 if (NULL_INTERVAL_P (previous))
|
5086
|
900 return limit;
|
|
901 if (!NILP (limit)
|
22344
|
902 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
|
5086
|
903 return limit;
|
1029
|
904
|
22344
|
905 return make_number (previous->position + LENGTH (previous));
|
1029
|
906 }
|
|
907
|
1211
|
908 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
|
5086
|
909 Sprevious_single_property_change, 2, 4, 0,
|
1857
|
910 "Return the position of previous property change for a specific property.\n\
|
14088
|
911 Scans characters backward from POSITION till it finds\n\
|
1857
|
912 a change in the PROP property, then returns the position of the change.\n\
|
|
913 The optional third argument OBJECT is the string or buffer to scan.\n\
|
4986
|
914 The property values are compared with `eq'.\n\
|
1857
|
915 Return nil if the property is constant all the way to the start of OBJECT.\n\
|
14088
|
916 If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
|
5086
|
917 If the optional fourth argument LIMIT is non-nil, don't search\n\
|
5645
|
918 back past position LIMIT; return LIMIT if nothing is found until LIMIT.")
|
14088
|
919 (position, prop, object, limit)
|
|
920 Lisp_Object position, prop, object, limit;
|
1211
|
921 {
|
|
922 register INTERVAL i, previous;
|
|
923 register Lisp_Object here_val;
|
|
924
|
1857
|
925 if (NILP (object))
|
9280
|
926 XSETBUFFER (object, current_buffer);
|
1857
|
927
|
7092
|
928 if (!NILP (limit))
|
|
929 CHECK_NUMBER_COERCE_MARKER (limit, 0);
|
|
930
|
14088
|
931 i = validate_interval_range (object, &position, &position, soft);
|
7773
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
932
|
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
933 /* Start with the interval containing the char before point. */
|
14088
|
934 if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (position))
|
7773
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
935 i = previous_interval (i);
|
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
936
|
1211
|
937 if (NULL_INTERVAL_P (i))
|
5086
|
938 return limit;
|
1211
|
939
|
2762
|
940 here_val = textget (i->plist, prop);
|
1211
|
941 previous = previous_interval (i);
|
|
942 while (! NULL_INTERVAL_P (previous)
|
5086
|
943 && EQ (here_val, textget (previous->plist, prop))
|
|
944 && (NILP (limit)
|
22344
|
945 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
|
1211
|
946 previous = previous_interval (previous);
|
|
947 if (NULL_INTERVAL_P (previous))
|
5086
|
948 return limit;
|
|
949 if (!NILP (limit)
|
22344
|
950 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
|
5086
|
951 return limit;
|
1211
|
952
|
22344
|
953 return make_number (previous->position + LENGTH (previous));
|
1211
|
954 }
|
16679
|
955
|
10159
|
956 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
|
|
957
|
1029
|
958 DEFUN ("add-text-properties", Fadd_text_properties,
|
1857
|
959 Sadd_text_properties, 3, 4, 0,
|
|
960 "Add properties to the text from START to END.\n\
|
14088
|
961 The third argument PROPERTIES is a property list\n\
|
1857
|
962 specifying the property values to add.\n\
|
|
963 The optional fourth argument, OBJECT,\n\
|
|
964 is the string or buffer containing the text.\n\
|
|
965 Return t if any property value actually changed, nil otherwise.")
|
|
966 (start, end, properties, object)
|
|
967 Lisp_Object start, end, properties, object;
|
1029
|
968 {
|
|
969 register INTERVAL i, unchanged;
|
2124
|
970 register int s, len, modified = 0;
|
10159
|
971 struct gcpro gcpro1;
|
1029
|
972
|
|
973 properties = validate_plist (properties);
|
|
974 if (NILP (properties))
|
|
975 return Qnil;
|
|
976
|
1857
|
977 if (NILP (object))
|
9280
|
978 XSETBUFFER (object, current_buffer);
|
1857
|
979
|
1029
|
980 i = validate_interval_range (object, &start, &end, hard);
|
|
981 if (NULL_INTERVAL_P (i))
|
|
982 return Qnil;
|
|
983
|
|
984 s = XINT (start);
|
|
985 len = XINT (end) - s;
|
|
986
|
10159
|
987 /* No need to protect OBJECT, because we GC only if it's a buffer,
|
|
988 and live buffers are always protected. */
|
|
989 GCPRO1 (properties);
|
|
990
|
1029
|
991 /* If we're not starting on an interval boundary, we have to
|
17467
|
992 split this interval. */
|
1029
|
993 if (i->position != s)
|
|
994 {
|
|
995 /* If this interval already has the properties, we can
|
17467
|
996 skip it. */
|
1029
|
997 if (interval_has_all_properties (properties, i))
|
|
998 {
|
|
999 int got = (LENGTH (i) - (s - i->position));
|
|
1000 if (got >= len)
|
14538
|
1001 RETURN_UNGCPRO (Qnil);
|
1029
|
1002 len -= got;
|
3858
|
1003 i = next_interval (i);
|
1029
|
1004 }
|
|
1005 else
|
|
1006 {
|
|
1007 unchanged = i;
|
4144
|
1008 i = split_interval_right (unchanged, s - unchanged->position);
|
1029
|
1009 copy_properties (unchanged, i);
|
|
1010 }
|
|
1011 }
|
|
1012
|
16339
|
1013 if (BUFFERP (object))
|
|
1014 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
16331
|
1015
|
3553
|
1016 /* We are at the beginning of interval I, with LEN chars to scan. */
|
2124
|
1017 for (;;)
|
1029
|
1018 {
|
1965
|
1019 if (i == 0)
|
|
1020 abort ();
|
|
1021
|
1029
|
1022 if (LENGTH (i) >= len)
|
|
1023 {
|
10159
|
1024 /* We can UNGCPRO safely here, because there will be just
|
|
1025 one more chance to gc, in the next call to add_properties,
|
|
1026 and after that we will not need PROPERTIES or OBJECT again. */
|
|
1027 UNGCPRO;
|
|
1028
|
1029
|
1029 if (interval_has_all_properties (properties, i))
|
16331
|
1030 {
|
16339
|
1031 if (BUFFERP (object))
|
|
1032 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1033 XINT (end) - XINT (start));
|
16331
|
1034
|
|
1035 return modified ? Qt : Qnil;
|
|
1036 }
|
1029
|
1037
|
|
1038 if (LENGTH (i) == len)
|
|
1039 {
|
1965
|
1040 add_properties (properties, i, object);
|
16339
|
1041 if (BUFFERP (object))
|
|
1042 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1043 XINT (end) - XINT (start));
|
1029
|
1044 return Qt;
|
|
1045 }
|
|
1046
|
|
1047 /* i doesn't have the properties, and goes past the change limit */
|
|
1048 unchanged = i;
|
4144
|
1049 i = split_interval_left (unchanged, len);
|
1029
|
1050 copy_properties (unchanged, i);
|
1965
|
1051 add_properties (properties, i, object);
|
16339
|
1052 if (BUFFERP (object))
|
|
1053 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1054 XINT (end) - XINT (start));
|
1029
|
1055 return Qt;
|
|
1056 }
|
|
1057
|
|
1058 len -= LENGTH (i);
|
1965
|
1059 modified += add_properties (properties, i, object);
|
1029
|
1060 i = next_interval (i);
|
|
1061 }
|
|
1062 }
|
|
1063
|
10159
|
1064 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
|
|
1065
|
1965
|
1066 DEFUN ("put-text-property", Fput_text_property,
|
|
1067 Sput_text_property, 4, 5, 0,
|
|
1068 "Set one property of the text from START to END.\n\
|
14088
|
1069 The third and fourth arguments PROPERTY and VALUE\n\
|
1965
|
1070 specify the property to add.\n\
|
|
1071 The optional fifth argument, OBJECT,\n\
|
|
1072 is the string or buffer containing the text.")
|
14088
|
1073 (start, end, property, value, object)
|
|
1074 Lisp_Object start, end, property, value, object;
|
1965
|
1075 {
|
|
1076 Fadd_text_properties (start, end,
|
14088
|
1077 Fcons (property, Fcons (value, Qnil)),
|
1965
|
1078 object);
|
|
1079 return Qnil;
|
|
1080 }
|
|
1081
|
1029
|
1082 DEFUN ("set-text-properties", Fset_text_properties,
|
1857
|
1083 Sset_text_properties, 3, 4, 0,
|
|
1084 "Completely replace properties of text from START to END.\n\
|
14088
|
1085 The third argument PROPERTIES is the new property list.\n\
|
1857
|
1086 The optional fourth argument, OBJECT,\n\
|
|
1087 is the string or buffer containing the text.")
|
14088
|
1088 (start, end, properties, object)
|
|
1089 Lisp_Object start, end, properties, object;
|
1029
|
1090 {
|
26605
|
1091 return set_text_properties (start, end, properties, object, Qt);
|
|
1092 }
|
|
1093
|
|
1094
|
|
1095 /* Replace properties of text from START to END with new list of
|
|
1096 properties PROPERTIES. OBJECT is the buffer or string containing
|
|
1097 the text. OBJECT nil means use the current buffer.
|
|
1098 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
|
|
1099 is non-nil if properties were replaced; it is nil if there weren't
|
|
1100 any properties to replace. */
|
|
1101
|
|
1102 Lisp_Object
|
|
1103 set_text_properties (start, end, properties, object, signal_after_change_p)
|
|
1104 Lisp_Object start, end, properties, object, signal_after_change_p;
|
|
1105 {
|
1029
|
1106 register INTERVAL i, unchanged;
|
1211
|
1107 register INTERVAL prev_changed = NULL_INTERVAL;
|
1029
|
1108 register int s, len;
|
9071
|
1109 Lisp_Object ostart, oend;
|
|
1110
|
|
1111 ostart = start;
|
|
1112 oend = end;
|
1029
|
1113
|
14088
|
1114 properties = validate_plist (properties);
|
1029
|
1115
|
1857
|
1116 if (NILP (object))
|
9280
|
1117 XSETBUFFER (object, current_buffer);
|
1857
|
1118
|
9541
|
1119 /* If we want no properties for a whole string,
|
|
1120 get rid of its intervals. */
|
14088
|
1121 if (NILP (properties) && STRINGP (object)
|
9541
|
1122 && XFASTINT (start) == 0
|
|
1123 && XFASTINT (end) == XSTRING (object)->size)
|
|
1124 {
|
16331
|
1125 if (! XSTRING (object)->intervals)
|
|
1126 return Qt;
|
|
1127
|
9541
|
1128 XSTRING (object)->intervals = 0;
|
|
1129 return Qt;
|
|
1130 }
|
|
1131
|
8686
|
1132 i = validate_interval_range (object, &start, &end, soft);
|
9541
|
1133
|
1029
|
1134 if (NULL_INTERVAL_P (i))
|
8686
|
1135 {
|
14088
|
1136 /* If buffer has no properties, and we want none, return now. */
|
|
1137 if (NILP (properties))
|
8686
|
1138 return Qnil;
|
|
1139
|
9071
|
1140 /* Restore the original START and END values
|
|
1141 because validate_interval_range increments them for strings. */
|
|
1142 start = ostart;
|
|
1143 end = oend;
|
|
1144
|
8686
|
1145 i = validate_interval_range (object, &start, &end, hard);
|
|
1146 /* This can return if start == end. */
|
|
1147 if (NULL_INTERVAL_P (i))
|
|
1148 return Qnil;
|
|
1149 }
|
1029
|
1150
|
|
1151 s = XINT (start);
|
|
1152 len = XINT (end) - s;
|
|
1153
|
16339
|
1154 if (BUFFERP (object))
|
|
1155 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
16331
|
1156
|
1029
|
1157 if (i->position != s)
|
|
1158 {
|
|
1159 unchanged = i;
|
4144
|
1160 i = split_interval_right (unchanged, s - unchanged->position);
|
1272
|
1161
|
1029
|
1162 if (LENGTH (i) > len)
|
|
1163 {
|
1211
|
1164 copy_properties (unchanged, i);
|
4144
|
1165 i = split_interval_left (i, len);
|
14088
|
1166 set_properties (properties, i, object);
|
26605
|
1167 if (BUFFERP (object) && !NILP (signal_after_change_p))
|
16339
|
1168 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1169 XINT (end) - XINT (start));
|
16331
|
1170
|
1029
|
1171 return Qt;
|
|
1172 }
|
|
1173
|
14088
|
1174 set_properties (properties, i, object);
|
3553
|
1175
|
1211
|
1176 if (LENGTH (i) == len)
|
16331
|
1177 {
|
26605
|
1178 if (BUFFERP (object) && !NILP (signal_after_change_p))
|
16339
|
1179 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1180 XINT (end) - XINT (start));
|
16331
|
1181
|
|
1182 return Qt;
|
|
1183 }
|
1211
|
1184
|
|
1185 prev_changed = i;
|
1029
|
1186 len -= LENGTH (i);
|
|
1187 i = next_interval (i);
|
|
1188 }
|
|
1189
|
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
diff
changeset
|
1190 /* We are starting at the beginning of an interval, I */
|
1272
|
1191 while (len > 0)
|
1029
|
1192 {
|
1965
|
1193 if (i == 0)
|
|
1194 abort ();
|
|
1195
|
1029
|
1196 if (LENGTH (i) >= len)
|
|
1197 {
|
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
diff
changeset
|
1198 if (LENGTH (i) > len)
|
4144
|
1199 i = split_interval_left (i, len);
|
1029
|
1200
|
13585
|
1201 /* We have to call set_properties even if we are going to
|
|
1202 merge the intervals, so as to make the undo records
|
|
1203 and cause redisplay to happen. */
|
14088
|
1204 set_properties (properties, i, object);
|
13585
|
1205 if (!NULL_INTERVAL_P (prev_changed))
|
1211
|
1206 merge_interval_left (i);
|
26605
|
1207 if (BUFFERP (object) && !NILP (signal_after_change_p))
|
16339
|
1208 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1209 XINT (end) - XINT (start));
|
1029
|
1210 return Qt;
|
|
1211 }
|
|
1212
|
|
1213 len -= LENGTH (i);
|
13585
|
1214
|
|
1215 /* We have to call set_properties even if we are going to
|
|
1216 merge the intervals, so as to make the undo records
|
|
1217 and cause redisplay to happen. */
|
14088
|
1218 set_properties (properties, i, object);
|
1211
|
1219 if (NULL_INTERVAL_P (prev_changed))
|
13585
|
1220 prev_changed = i;
|
1211
|
1221 else
|
|
1222 prev_changed = i = merge_interval_left (i);
|
|
1223
|
1029
|
1224 i = next_interval (i);
|
|
1225 }
|
|
1226
|
26605
|
1227 if (BUFFERP (object) && !NILP (signal_after_change_p))
|
16339
|
1228 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1229 XINT (end) - XINT (start));
|
1029
|
1230 return Qt;
|
|
1231 }
|
|
1232
|
|
1233 DEFUN ("remove-text-properties", Fremove_text_properties,
|
1857
|
1234 Sremove_text_properties, 3, 4, 0,
|
|
1235 "Remove some properties from text from START to END.\n\
|
14088
|
1236 The third argument PROPERTIES is a property list\n\
|
1857
|
1237 whose property names specify the properties to remove.\n\
|
14088
|
1238 \(The values stored in PROPERTIES are ignored.)\n\
|
1857
|
1239 The optional fourth argument, OBJECT,\n\
|
|
1240 is the string or buffer containing the text.\n\
|
|
1241 Return t if any property was actually removed, nil otherwise.")
|
14088
|
1242 (start, end, properties, object)
|
|
1243 Lisp_Object start, end, properties, object;
|
1029
|
1244 {
|
|
1245 register INTERVAL i, unchanged;
|
2124
|
1246 register int s, len, modified = 0;
|
1029
|
1247
|
1857
|
1248 if (NILP (object))
|
9280
|
1249 XSETBUFFER (object, current_buffer);
|
1857
|
1250
|
1029
|
1251 i = validate_interval_range (object, &start, &end, soft);
|
|
1252 if (NULL_INTERVAL_P (i))
|
|
1253 return Qnil;
|
|
1254
|
|
1255 s = XINT (start);
|
|
1256 len = XINT (end) - s;
|
1211
|
1257
|
1029
|
1258 if (i->position != s)
|
|
1259 {
|
|
1260 /* No properties on this first interval -- return if
|
17467
|
1261 it covers the entire region. */
|
14088
|
1262 if (! interval_has_some_properties (properties, i))
|
1029
|
1263 {
|
|
1264 int got = (LENGTH (i) - (s - i->position));
|
|
1265 if (got >= len)
|
|
1266 return Qnil;
|
|
1267 len -= got;
|
3858
|
1268 i = next_interval (i);
|
1029
|
1269 }
|
3553
|
1270 /* Split away the beginning of this interval; what we don't
|
|
1271 want to modify. */
|
1029
|
1272 else
|
|
1273 {
|
|
1274 unchanged = i;
|
4144
|
1275 i = split_interval_right (unchanged, s - unchanged->position);
|
1029
|
1276 copy_properties (unchanged, i);
|
|
1277 }
|
|
1278 }
|
|
1279
|
16339
|
1280 if (BUFFERP (object))
|
|
1281 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
16331
|
1282
|
1029
|
1283 /* We are at the beginning of an interval, with len to scan */
|
2124
|
1284 for (;;)
|
1029
|
1285 {
|
1965
|
1286 if (i == 0)
|
|
1287 abort ();
|
|
1288
|
1029
|
1289 if (LENGTH (i) >= len)
|
|
1290 {
|
14088
|
1291 if (! interval_has_some_properties (properties, i))
|
1029
|
1292 return modified ? Qt : Qnil;
|
|
1293
|
|
1294 if (LENGTH (i) == len)
|
|
1295 {
|
14088
|
1296 remove_properties (properties, i, object);
|
16339
|
1297 if (BUFFERP (object))
|
|
1298 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1299 XINT (end) - XINT (start));
|
1029
|
1300 return Qt;
|
|
1301 }
|
|
1302
|
|
1303 /* i has the properties, and goes past the change limit */
|
3553
|
1304 unchanged = i;
|
4144
|
1305 i = split_interval_left (i, len);
|
1029
|
1306 copy_properties (unchanged, i);
|
14088
|
1307 remove_properties (properties, i, object);
|
16339
|
1308 if (BUFFERP (object))
|
|
1309 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1310 XINT (end) - XINT (start));
|
1029
|
1311 return Qt;
|
|
1312 }
|
|
1313
|
|
1314 len -= LENGTH (i);
|
14088
|
1315 modified += remove_properties (properties, i, object);
|
1029
|
1316 i = next_interval (i);
|
|
1317 }
|
|
1318 }
|
16679
|
1319
|
4144
|
1320 DEFUN ("text-property-any", Ftext_property_any,
|
|
1321 Stext_property_any, 4, 5, 0,
|
14088
|
1322 "Check text from START to END for property PROPERTY equalling VALUE.\n\
|
|
1323 If so, return the position of the first character whose property PROPERTY\n\
|
|
1324 is `eq' to VALUE. Otherwise return nil.\n\
|
4144
|
1325 The optional fifth argument, OBJECT, is the string or buffer\n\
|
|
1326 containing the text.")
|
14088
|
1327 (start, end, property, value, object)
|
|
1328 Lisp_Object start, end, property, value, object;
|
4144
|
1329 {
|
|
1330 register INTERVAL i;
|
|
1331 register int e, pos;
|
|
1332
|
|
1333 if (NILP (object))
|
9280
|
1334 XSETBUFFER (object, current_buffer);
|
4144
|
1335 i = validate_interval_range (object, &start, &end, soft);
|
10488
|
1336 if (NULL_INTERVAL_P (i))
|
|
1337 return (!NILP (value) || EQ (start, end) ? Qnil : start);
|
4144
|
1338 e = XINT (end);
|
|
1339
|
|
1340 while (! NULL_INTERVAL_P (i))
|
|
1341 {
|
|
1342 if (i->position >= e)
|
|
1343 break;
|
14088
|
1344 if (EQ (textget (i->plist, property), value))
|
4144
|
1345 {
|
|
1346 pos = i->position;
|
|
1347 if (pos < XINT (start))
|
|
1348 pos = XINT (start);
|
22344
|
1349 return make_number (pos);
|
4144
|
1350 }
|
|
1351 i = next_interval (i);
|
|
1352 }
|
|
1353 return Qnil;
|
|
1354 }
|
|
1355
|
|
1356 DEFUN ("text-property-not-all", Ftext_property_not_all,
|
|
1357 Stext_property_not_all, 4, 5, 0,
|
14088
|
1358 "Check text from START to END for property PROPERTY not equalling VALUE.\n\
|
|
1359 If so, return the position of the first character whose property PROPERTY\n\
|
|
1360 is not `eq' to VALUE. Otherwise, return nil.\n\
|
4144
|
1361 The optional fifth argument, OBJECT, is the string or buffer\n\
|
|
1362 containing the text.")
|
14088
|
1363 (start, end, property, value, object)
|
|
1364 Lisp_Object start, end, property, value, object;
|
4144
|
1365 {
|
|
1366 register INTERVAL i;
|
|
1367 register int s, e;
|
|
1368
|
|
1369 if (NILP (object))
|
9280
|
1370 XSETBUFFER (object, current_buffer);
|
4144
|
1371 i = validate_interval_range (object, &start, &end, soft);
|
|
1372 if (NULL_INTERVAL_P (i))
|
5114
b37f62d72049
(Ftext_property_not_all): For trivial yes, return start, not Qt.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1373 return (NILP (value) || EQ (start, end)) ? Qnil : start;
|
4144
|
1374 s = XINT (start);
|
|
1375 e = XINT (end);
|
|
1376
|
|
1377 while (! NULL_INTERVAL_P (i))
|
|
1378 {
|
|
1379 if (i->position >= e)
|
|
1380 break;
|
14088
|
1381 if (! EQ (textget (i->plist, property), value))
|
4144
|
1382 {
|
|
1383 if (i->position > s)
|
|
1384 s = i->position;
|
22344
|
1385 return make_number (s);
|
4144
|
1386 }
|
|
1387 i = next_interval (i);
|
|
1388 }
|
|
1389 return Qnil;
|
|
1390 }
|
16679
|
1391
|
4007
|
1392 /* I don't think this is the right interface to export; how often do you
|
|
1393 want to do something like this, other than when you're copying objects
|
|
1394 around?
|
|
1395
|
|
1396 I think it would be better to have a pair of functions, one which
|
|
1397 returns the text properties of a region as a list of ranges and
|
|
1398 plists, and another which applies such a list to another object. */
|
|
1399
|
10159
|
1400 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
|
|
1401 SRC and DEST may each refer to strings or buffers.
|
|
1402 Optional sixth argument PROP causes only that property to be copied.
|
|
1403 Properties are copied to DEST as if by `add-text-properties'.
|
|
1404 Return t if any property value actually changed, nil otherwise. */
|
|
1405
|
|
1406 /* Note this can GC when DEST is a buffer. */
|
22344
|
1407
|
4007
|
1408 Lisp_Object
|
|
1409 copy_text_properties (start, end, src, pos, dest, prop)
|
|
1410 Lisp_Object start, end, src, pos, dest, prop;
|
|
1411 {
|
|
1412 INTERVAL i;
|
|
1413 Lisp_Object res;
|
|
1414 Lisp_Object stuff;
|
|
1415 Lisp_Object plist;
|
|
1416 int s, e, e2, p, len, modified = 0;
|
10159
|
1417 struct gcpro gcpro1, gcpro2;
|
4007
|
1418
|
|
1419 i = validate_interval_range (src, &start, &end, soft);
|
|
1420 if (NULL_INTERVAL_P (i))
|
|
1421 return Qnil;
|
|
1422
|
|
1423 CHECK_NUMBER_COERCE_MARKER (pos, 0);
|
|
1424 {
|
|
1425 Lisp_Object dest_start, dest_end;
|
|
1426
|
|
1427 dest_start = pos;
|
9321
|
1428 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
|
4007
|
1429 /* Apply this to a copy of pos; it will try to increment its arguments,
|
|
1430 which we don't want. */
|
|
1431 validate_interval_range (dest, &dest_start, &dest_end, soft);
|
|
1432 }
|
|
1433
|
|
1434 s = XINT (start);
|
|
1435 e = XINT (end);
|
|
1436 p = XINT (pos);
|
|
1437
|
|
1438 stuff = Qnil;
|
|
1439
|
|
1440 while (s < e)
|
|
1441 {
|
|
1442 e2 = i->position + LENGTH (i);
|
|
1443 if (e2 > e)
|
|
1444 e2 = e;
|
|
1445 len = e2 - s;
|
|
1446
|
|
1447 plist = i->plist;
|
|
1448 if (! NILP (prop))
|
|
1449 while (! NILP (plist))
|
|
1450 {
|
|
1451 if (EQ (Fcar (plist), prop))
|
|
1452 {
|
|
1453 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
|
|
1454 break;
|
|
1455 }
|
|
1456 plist = Fcdr (Fcdr (plist));
|
|
1457 }
|
|
1458 if (! NILP (plist))
|
|
1459 {
|
|
1460 /* Must defer modifications to the interval tree in case src
|
17467
|
1461 and dest refer to the same string or buffer. */
|
4007
|
1462 stuff = Fcons (Fcons (make_number (p),
|
|
1463 Fcons (make_number (p + len),
|
|
1464 Fcons (plist, Qnil))),
|
|
1465 stuff);
|
|
1466 }
|
|
1467
|
|
1468 i = next_interval (i);
|
|
1469 if (NULL_INTERVAL_P (i))
|
|
1470 break;
|
|
1471
|
|
1472 p += len;
|
|
1473 s = i->position;
|
|
1474 }
|
|
1475
|
10159
|
1476 GCPRO2 (stuff, dest);
|
|
1477
|
4007
|
1478 while (! NILP (stuff))
|
|
1479 {
|
|
1480 res = Fcar (stuff);
|
|
1481 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
|
|
1482 Fcar (Fcdr (Fcdr (res))), dest);
|
|
1483 if (! NILP (res))
|
|
1484 modified++;
|
|
1485 stuff = Fcdr (stuff);
|
|
1486 }
|
|
1487
|
10159
|
1488 UNGCPRO;
|
|
1489
|
4007
|
1490 return modified ? Qt : Qnil;
|
|
1491 }
|
25000
|
1492
|
|
1493
|
|
1494 /* Return a list representing the text properties of OBJECT between
|
|
1495 START and END. if PROP is non-nil, report only on that property.
|
|
1496 Each result list element has the form (S E PLIST), where S and E
|
|
1497 are positions in OBJECT and PLIST is a property list containing the
|
|
1498 text properties of OBJECT between S and E. Value is nil if OBJECT
|
|
1499 doesn't contain text properties between START and END. */
|
|
1500
|
|
1501 Lisp_Object
|
|
1502 text_property_list (object, start, end, prop)
|
|
1503 Lisp_Object object, start, end, prop;
|
|
1504 {
|
|
1505 struct interval *i;
|
|
1506 Lisp_Object result;
|
|
1507
|
|
1508 result = Qnil;
|
|
1509
|
|
1510 i = validate_interval_range (object, &start, &end, soft);
|
|
1511 if (!NULL_INTERVAL_P (i))
|
|
1512 {
|
|
1513 int s = XINT (start);
|
|
1514 int e = XINT (end);
|
|
1515
|
|
1516 while (s < e)
|
|
1517 {
|
|
1518 int interval_end, len;
|
|
1519 Lisp_Object plist;
|
|
1520
|
|
1521 interval_end = i->position + LENGTH (i);
|
|
1522 if (interval_end > e)
|
|
1523 interval_end = e;
|
|
1524 len = interval_end - s;
|
|
1525
|
|
1526 plist = i->plist;
|
|
1527
|
|
1528 if (!NILP (prop))
|
|
1529 for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
|
|
1530 if (EQ (Fcar (plist), prop))
|
|
1531 {
|
|
1532 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
|
|
1533 break;
|
|
1534 }
|
|
1535
|
|
1536 if (!NILP (plist))
|
|
1537 result = Fcons (Fcons (make_number (s),
|
|
1538 Fcons (make_number (s + len),
|
|
1539 Fcons (plist, Qnil))),
|
|
1540 result);
|
|
1541
|
|
1542 i = next_interval (i);
|
|
1543 if (NULL_INTERVAL_P (i))
|
|
1544 break;
|
|
1545 s = i->position;
|
|
1546 }
|
|
1547 }
|
|
1548
|
|
1549 return result;
|
|
1550 }
|
|
1551
|
|
1552
|
|
1553 /* Add text properties to OBJECT from LIST. LIST is a list of triples
|
|
1554 (START END PLIST), where START and END are positions and PLIST is a
|
|
1555 property list containing the text properties to add. Adjust START
|
|
1556 and END positions by DELTA before adding properties. Value is
|
|
1557 non-zero if OBJECT was modified. */
|
|
1558
|
|
1559 int
|
|
1560 add_text_properties_from_list (object, list, delta)
|
|
1561 Lisp_Object object, list, delta;
|
|
1562 {
|
|
1563 struct gcpro gcpro1, gcpro2;
|
|
1564 int modified_p = 0;
|
|
1565
|
|
1566 GCPRO2 (list, object);
|
|
1567
|
|
1568 for (; CONSP (list); list = XCDR (list))
|
|
1569 {
|
|
1570 Lisp_Object item, start, end, plist, tem;
|
|
1571
|
|
1572 item = XCAR (list);
|
|
1573 start = make_number (XINT (XCAR (item)) + XINT (delta));
|
|
1574 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
|
|
1575 plist = XCAR (XCDR (XCDR (item)));
|
|
1576
|
|
1577 tem = Fadd_text_properties (start, end, plist, object);
|
|
1578 if (!NILP (tem))
|
|
1579 modified_p = 1;
|
|
1580 }
|
|
1581
|
|
1582 UNGCPRO;
|
|
1583 return modified_p;
|
|
1584 }
|
|
1585
|
|
1586
|
|
1587
|
|
1588 /* Modify end-points of ranges in LIST destructively. LIST is a list
|
|
1589 as returned from text_property_list. Change end-points equal to
|
|
1590 OLD_END to NEW_END. */
|
|
1591
|
|
1592 void
|
|
1593 extend_property_ranges (list, old_end, new_end)
|
|
1594 Lisp_Object list, old_end, new_end;
|
|
1595 {
|
|
1596 for (; CONSP (list); list = XCDR (list))
|
|
1597 {
|
|
1598 Lisp_Object item, end;
|
|
1599
|
|
1600 item = XCAR (list);
|
|
1601 end = XCAR (XCDR (item));
|
|
1602
|
|
1603 if (EQ (end, old_end))
|
25645
|
1604 XCAR (XCDR (item)) = new_end;
|
25000
|
1605 }
|
|
1606 }
|
|
1607
|
|
1608
|
13027
|
1609
|
|
1610 /* Call the modification hook functions in LIST, each with START and END. */
|
4007
|
1611
|
13027
|
1612 static void
|
|
1613 call_mod_hooks (list, start, end)
|
|
1614 Lisp_Object list, start, end;
|
|
1615 {
|
|
1616 struct gcpro gcpro1;
|
|
1617 GCPRO1 (list);
|
|
1618 while (!NILP (list))
|
|
1619 {
|
|
1620 call2 (Fcar (list), start, end);
|
|
1621 list = Fcdr (list);
|
|
1622 }
|
|
1623 UNGCPRO;
|
|
1624 }
|
|
1625
|
20522
|
1626 /* Check for read-only intervals between character positions START ... END,
|
|
1627 in BUF, and signal an error if we find one.
|
|
1628
|
|
1629 Then check for any modification hooks in the range.
|
|
1630 Create a list of all these hooks in lexicographic order,
|
|
1631 eliminating consecutive extra copies of the same hook. Then call
|
|
1632 those hooks in order, with START and END - 1 as arguments. */
|
13027
|
1633
|
|
1634 void
|
|
1635 verify_interval_modification (buf, start, end)
|
|
1636 struct buffer *buf;
|
|
1637 int start, end;
|
|
1638 {
|
|
1639 register INTERVAL intervals = BUF_INTERVALS (buf);
|
25772
|
1640 register INTERVAL i;
|
13027
|
1641 Lisp_Object hooks;
|
|
1642 register Lisp_Object prev_mod_hooks;
|
|
1643 Lisp_Object mod_hooks;
|
|
1644 struct gcpro gcpro1;
|
|
1645
|
|
1646 hooks = Qnil;
|
|
1647 prev_mod_hooks = Qnil;
|
|
1648 mod_hooks = Qnil;
|
|
1649
|
|
1650 interval_insert_behind_hooks = Qnil;
|
|
1651 interval_insert_in_front_hooks = Qnil;
|
|
1652
|
|
1653 if (NULL_INTERVAL_P (intervals))
|
|
1654 return;
|
|
1655
|
|
1656 if (start > end)
|
|
1657 {
|
|
1658 int temp = start;
|
|
1659 start = end;
|
|
1660 end = temp;
|
|
1661 }
|
|
1662
|
|
1663 /* For an insert operation, check the two chars around the position. */
|
|
1664 if (start == end)
|
|
1665 {
|
|
1666 INTERVAL prev;
|
|
1667 Lisp_Object before, after;
|
|
1668
|
|
1669 /* Set I to the interval containing the char after START,
|
|
1670 and PREV to the interval containing the char before START.
|
|
1671 Either one may be null. They may be equal. */
|
|
1672 i = find_interval (intervals, start);
|
|
1673
|
|
1674 if (start == BUF_BEGV (buf))
|
|
1675 prev = 0;
|
|
1676 else if (i->position == start)
|
|
1677 prev = previous_interval (i);
|
|
1678 else if (i->position < start)
|
|
1679 prev = i;
|
|
1680 if (start == BUF_ZV (buf))
|
|
1681 i = 0;
|
|
1682
|
|
1683 /* If Vinhibit_read_only is set and is not a list, we can
|
|
1684 skip the read_only checks. */
|
|
1685 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
|
|
1686 {
|
|
1687 /* If I and PREV differ we need to check for the read-only
|
17467
|
1688 property together with its stickiness. If either I or
|
13027
|
1689 PREV are 0, this check is all we need.
|
|
1690 We have to take special care, since read-only may be
|
|
1691 indirectly defined via the category property. */
|
|
1692 if (i != prev)
|
|
1693 {
|
|
1694 if (! NULL_INTERVAL_P (i))
|
|
1695 {
|
|
1696 after = textget (i->plist, Qread_only);
|
|
1697
|
|
1698 /* If interval I is read-only and read-only is
|
|
1699 front-sticky, inhibit insertion.
|
|
1700 Check for read-only as well as category. */
|
|
1701 if (! NILP (after)
|
|
1702 && NILP (Fmemq (after, Vinhibit_read_only)))
|
|
1703 {
|
|
1704 Lisp_Object tem;
|
|
1705
|
|
1706 tem = textget (i->plist, Qfront_sticky);
|
|
1707 if (TMEM (Qread_only, tem)
|
|
1708 || (NILP (Fplist_get (i->plist, Qread_only))
|
|
1709 && TMEM (Qcategory, tem)))
|
26276
|
1710 Fsignal (Qtext_read_only, Qnil);
|
13027
|
1711 }
|
|
1712 }
|
|
1713
|
|
1714 if (! NULL_INTERVAL_P (prev))
|
|
1715 {
|
|
1716 before = textget (prev->plist, Qread_only);
|
|
1717
|
|
1718 /* If interval PREV is read-only and read-only isn't
|
|
1719 rear-nonsticky, inhibit insertion.
|
|
1720 Check for read-only as well as category. */
|
|
1721 if (! NILP (before)
|
|
1722 && NILP (Fmemq (before, Vinhibit_read_only)))
|
|
1723 {
|
|
1724 Lisp_Object tem;
|
|
1725
|
|
1726 tem = textget (prev->plist, Qrear_nonsticky);
|
|
1727 if (! TMEM (Qread_only, tem)
|
|
1728 && (! NILP (Fplist_get (prev->plist,Qread_only))
|
|
1729 || ! TMEM (Qcategory, tem)))
|
26276
|
1730 Fsignal (Qtext_read_only, Qnil);
|
13027
|
1731 }
|
|
1732 }
|
|
1733 }
|
|
1734 else if (! NULL_INTERVAL_P (i))
|
|
1735 {
|
|
1736 after = textget (i->plist, Qread_only);
|
|
1737
|
|
1738 /* If interval I is read-only and read-only is
|
|
1739 front-sticky, inhibit insertion.
|
|
1740 Check for read-only as well as category. */
|
|
1741 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
|
|
1742 {
|
|
1743 Lisp_Object tem;
|
|
1744
|
|
1745 tem = textget (i->plist, Qfront_sticky);
|
|
1746 if (TMEM (Qread_only, tem)
|
|
1747 || (NILP (Fplist_get (i->plist, Qread_only))
|
|
1748 && TMEM (Qcategory, tem)))
|
26276
|
1749 Fsignal (Qtext_read_only, Qnil);
|
13027
|
1750
|
|
1751 tem = textget (prev->plist, Qrear_nonsticky);
|
|
1752 if (! TMEM (Qread_only, tem)
|
|
1753 && (! NILP (Fplist_get (prev->plist, Qread_only))
|
|
1754 || ! TMEM (Qcategory, tem)))
|
26276
|
1755 Fsignal (Qtext_read_only, Qnil);
|
13027
|
1756 }
|
|
1757 }
|
|
1758 }
|
|
1759
|
|
1760 /* Run both insert hooks (just once if they're the same). */
|
|
1761 if (!NULL_INTERVAL_P (prev))
|
|
1762 interval_insert_behind_hooks
|
|
1763 = textget (prev->plist, Qinsert_behind_hooks);
|
|
1764 if (!NULL_INTERVAL_P (i))
|
|
1765 interval_insert_in_front_hooks
|
|
1766 = textget (i->plist, Qinsert_in_front_hooks);
|
|
1767 }
|
|
1768 else
|
|
1769 {
|
|
1770 /* Loop over intervals on or next to START...END,
|
|
1771 collecting their hooks. */
|
|
1772
|
|
1773 i = find_interval (intervals, start);
|
|
1774 do
|
|
1775 {
|
|
1776 if (! INTERVAL_WRITABLE_P (i))
|
26276
|
1777 Fsignal (Qtext_read_only, Qnil);
|
13027
|
1778
|
|
1779 mod_hooks = textget (i->plist, Qmodification_hooks);
|
|
1780 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
|
|
1781 {
|
|
1782 hooks = Fcons (mod_hooks, hooks);
|
|
1783 prev_mod_hooks = mod_hooks;
|
|
1784 }
|
|
1785
|
|
1786 i = next_interval (i);
|
|
1787 }
|
|
1788 /* Keep going thru the interval containing the char before END. */
|
|
1789 while (! NULL_INTERVAL_P (i) && i->position < end);
|
|
1790
|
|
1791 GCPRO1 (hooks);
|
|
1792 hooks = Fnreverse (hooks);
|
|
1793 while (! EQ (hooks, Qnil))
|
|
1794 {
|
|
1795 call_mod_hooks (Fcar (hooks), make_number (start),
|
|
1796 make_number (end));
|
|
1797 hooks = Fcdr (hooks);
|
|
1798 }
|
|
1799 UNGCPRO;
|
|
1800 }
|
|
1801 }
|
|
1802
|
20522
|
1803 /* Run the interval hooks for an insertion on character range START ... END.
|
13027
|
1804 verify_interval_modification chose which hooks to run;
|
|
1805 this function is called after the insertion happens
|
|
1806 so it can indicate the range of inserted text. */
|
|
1807
|
|
1808 void
|
|
1809 report_interval_modification (start, end)
|
|
1810 Lisp_Object start, end;
|
|
1811 {
|
|
1812 if (! NILP (interval_insert_behind_hooks))
|
18613
|
1813 call_mod_hooks (interval_insert_behind_hooks, start, end);
|
13027
|
1814 if (! NILP (interval_insert_in_front_hooks)
|
|
1815 && ! EQ (interval_insert_in_front_hooks,
|
|
1816 interval_insert_behind_hooks))
|
18613
|
1817 call_mod_hooks (interval_insert_in_front_hooks, start, end);
|
13027
|
1818 }
|
|
1819
|
1029
|
1820 void
|
|
1821 syms_of_textprop ()
|
|
1822 {
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
1823 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
|
10925
|
1824 "Property-list used as default values.\n\
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
1825 The value of a property in this list is seen as the value for every\n\
|
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
1826 character that does not have its own value for that property.");
|
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
1827 Vdefault_text_properties = Qnil;
|
10925
|
1828
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1829 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
|
9071
|
1830 "If non-nil, don't run `point-left' and `point-entered' text properties.\n\
|
|
1831 This also inhibits the use of the `intangible' text property.");
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1832 Vinhibit_point_motion_hooks = Qnil;
|
13027
|
1833
|
26872
|
1834 DEFVAR_LISP ("text-property-default-nonsticky",
|
|
1835 &Vtext_property_default_nonsticky,
|
|
1836 "Alist of properties vs the corresponding non-stickinesses.\n\
|
|
1837 Each element has the form (PROPERTY . NONSTICKINESS).\n\
|
|
1838 \n\
|
|
1839 If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
|
|
1840 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
|
|
1841 inherits it if NONSTICKINESS is nil. The front-sticky and\n\
|
|
1842 rear-nonsticky properties of the character overrides NONSTICKINESS.");
|
|
1843 Vtext_property_default_nonsticky = Qnil;
|
|
1844
|
13027
|
1845 staticpro (&interval_insert_behind_hooks);
|
|
1846 staticpro (&interval_insert_in_front_hooks);
|
|
1847 interval_insert_behind_hooks = Qnil;
|
|
1848 interval_insert_in_front_hooks = Qnil;
|
|
1849
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1850
|
1029
|
1851 /* Common attributes one might give text */
|
|
1852
|
|
1853 staticpro (&Qforeground);
|
|
1854 Qforeground = intern ("foreground");
|
|
1855 staticpro (&Qbackground);
|
|
1856 Qbackground = intern ("background");
|
|
1857 staticpro (&Qfont);
|
|
1858 Qfont = intern ("font");
|
|
1859 staticpro (&Qstipple);
|
|
1860 Qstipple = intern ("stipple");
|
|
1861 staticpro (&Qunderline);
|
|
1862 Qunderline = intern ("underline");
|
|
1863 staticpro (&Qread_only);
|
|
1864 Qread_only = intern ("read-only");
|
|
1865 staticpro (&Qinvisible);
|
|
1866 Qinvisible = intern ("invisible");
|
6755
|
1867 staticpro (&Qintangible);
|
|
1868 Qintangible = intern ("intangible");
|
2058
|
1869 staticpro (&Qcategory);
|
|
1870 Qcategory = intern ("category");
|
|
1871 staticpro (&Qlocal_map);
|
|
1872 Qlocal_map = intern ("local-map");
|
4381
|
1873 staticpro (&Qfront_sticky);
|
|
1874 Qfront_sticky = intern ("front-sticky");
|
|
1875 staticpro (&Qrear_nonsticky);
|
|
1876 Qrear_nonsticky = intern ("rear-nonsticky");
|
23729
|
1877 staticpro (&Qmouse_face);
|
|
1878 Qmouse_face = intern ("mouse-face");
|
1029
|
1879
|
|
1880 /* Properties that text might use to specify certain actions */
|
|
1881
|
|
1882 staticpro (&Qmouse_left);
|
|
1883 Qmouse_left = intern ("mouse-left");
|
|
1884 staticpro (&Qmouse_entered);
|
|
1885 Qmouse_entered = intern ("mouse-entered");
|
|
1886 staticpro (&Qpoint_left);
|
|
1887 Qpoint_left = intern ("point-left");
|
|
1888 staticpro (&Qpoint_entered);
|
|
1889 Qpoint_entered = intern ("point-entered");
|
|
1890
|
|
1891 defsubr (&Stext_properties_at);
|
1857
|
1892 defsubr (&Sget_text_property);
|
7582
|
1893 defsubr (&Sget_char_property);
|
16679
|
1894 defsubr (&Snext_char_property_change);
|
|
1895 defsubr (&Sprevious_char_property_change);
|
1029
|
1896 defsubr (&Snext_property_change);
|
1211
|
1897 defsubr (&Snext_single_property_change);
|
1029
|
1898 defsubr (&Sprevious_property_change);
|
1211
|
1899 defsubr (&Sprevious_single_property_change);
|
1029
|
1900 defsubr (&Sadd_text_properties);
|
1965
|
1901 defsubr (&Sput_text_property);
|
1029
|
1902 defsubr (&Sset_text_properties);
|
|
1903 defsubr (&Sremove_text_properties);
|
4144
|
1904 defsubr (&Stext_property_any);
|
|
1905 defsubr (&Stext_property_not_all);
|
1857
|
1906 /* defsubr (&Serase_text_properties); */
|
4007
|
1907 /* defsubr (&Scopy_text_properties); */
|
1029
|
1908 }
|
1302
|
1909
|