1029
|
1 /* Interface code for dealing with text properties.
|
64770
|
2 Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
|
68651
|
3 2004, 2005, 2006 Free Software Foundation, Inc.
|
1029
|
4
|
|
5 This file is part of GNU Emacs.
|
|
6
|
|
7 GNU Emacs is free software; you can redistribute it and/or modify
|
|
8 it under the terms of the GNU General Public License as published by
|
3698
|
9 the Free Software Foundation; either version 2, or (at your option)
|
1029
|
10 any later version.
|
|
11
|
|
12 GNU Emacs is distributed in the hope that it will be useful,
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
15 GNU General Public License for more details.
|
|
16
|
|
17 You should have received a copy of the GNU General Public License
|
|
18 along with GNU Emacs; see the file COPYING. If not, write to
|
64084
|
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
20 Boston, MA 02110-1301, USA. */
|
1029
|
21
|
4696
|
22 #include <config.h>
|
1029
|
23 #include "lisp.h"
|
|
24 #include "intervals.h"
|
|
25 #include "buffer.h"
|
6063
|
26 #include "window.h"
|
8962
|
27
|
|
28 #ifndef NULL
|
|
29 #define NULL (void *)0
|
|
30 #endif
|
13027
|
31
|
|
32 /* Test for membership, allowing for t (actually any non-cons) to mean the
|
|
33 universal set. */
|
|
34
|
|
35 #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
|
1029
|
36
|
|
37
|
|
38 /* NOTES: previous- and next- property change will have to skip
|
|
39 zero-length intervals if they are implemented. This could be done
|
|
40 inside next_interval and previous_interval.
|
|
41
|
1211
|
42 set_properties needs to deal with the interval property cache.
|
|
43
|
1029
|
44 It is assumed that for any interval plist, a property appears
|
1965
|
45 only once on the list. Although some code i.e., remove_properties,
|
1029
|
46 handles the more general case, the uniqueness of properties is
|
3591
|
47 necessary for the system to remain consistent. This requirement
|
17467
|
48 is enforced by the subrs installing properties onto the intervals. */
|
1029
|
49
|
|
50
|
17467
|
51 /* Types of hooks. */
|
1029
|
52 Lisp_Object Qmouse_left;
|
|
53 Lisp_Object Qmouse_entered;
|
|
54 Lisp_Object Qpoint_left;
|
|
55 Lisp_Object Qpoint_entered;
|
2058
|
56 Lisp_Object Qcategory;
|
|
57 Lisp_Object Qlocal_map;
|
1029
|
58
|
17467
|
59 /* Visual properties text (including strings) may have. */
|
1029
|
60 Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple;
|
23729
|
61 Lisp_Object Qinvisible, Qread_only, Qintangible, Qmouse_face;
|
4381
|
62
|
|
63 /* Sticky properties */
|
|
64 Lisp_Object Qfront_sticky, Qrear_nonsticky;
|
3960
|
65
|
|
66 /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
|
|
67 the o1's cdr. Otherwise, return zero. This is handy for
|
|
68 traversing plists. */
|
25645
|
69 #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCDR (o1), CONSP (o2)))
|
3960
|
70
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
71 Lisp_Object Vinhibit_point_motion_hooks;
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
72 Lisp_Object Vdefault_text_properties;
|
45680
|
73 Lisp_Object Vchar_property_alias_alist;
|
26872
|
74 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
|
75
|
13027
|
76 /* verify_interval_modification saves insertion hooks here
|
|
77 to be run later by report_interval_modification. */
|
|
78 Lisp_Object interval_insert_behind_hooks;
|
|
79 Lisp_Object interval_insert_in_front_hooks;
|
33952
|
80
|
|
81
|
|
82 /* Signal a `text-read-only' error. This function makes it easier
|
|
83 to capture that error in GDB by putting a breakpoint on it. */
|
|
84
|
|
85 static void
|
48840
|
86 text_read_only (propval)
|
|
87 Lisp_Object propval;
|
33952
|
88 {
|
48840
|
89 Fsignal (Qtext_read_only, STRINGP (propval) ? Fcons (propval, Qnil) : Qnil);
|
33952
|
90 }
|
|
91
|
|
92
|
1029
|
93
|
1055
|
94 /* Extract the interval at the position pointed to by BEGIN from
|
|
95 OBJECT, a string or buffer. Additionally, check that the positions
|
|
96 pointed to by BEGIN and END are within the bounds of OBJECT, and
|
|
97 reverse them if *BEGIN is greater than *END. The objects pointed
|
|
98 to by BEGIN and END may be integers or markers; if the latter, they
|
|
99 are coerced to integers.
|
1029
|
100
|
1965
|
101 When OBJECT is a string, we increment *BEGIN and *END
|
|
102 to make them origin-one.
|
|
103
|
1029
|
104 Note that buffer points don't correspond to interval indices.
|
|
105 For example, point-max is 1 greater than the index of the last
|
|
106 character. This difference is handled in the caller, which uses
|
|
107 the validated points to determine a length, and operates on that.
|
|
108 Exceptions are Ftext_properties_at, Fnext_property_change, and
|
|
109 Fprevious_property_change which call this function with BEGIN == END.
|
|
110 Handle this case specially.
|
|
111
|
|
112 If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
|
1055
|
113 create an interval tree for OBJECT if one doesn't exist, provided
|
|
114 the object actually contains text. In the current design, if there
|
1965
|
115 is no text, there can be no text properties. */
|
1029
|
116
|
|
117 #define soft 0
|
|
118 #define hard 1
|
|
119
|
25000
|
120 INTERVAL
|
1029
|
121 validate_interval_range (object, begin, end, force)
|
|
122 Lisp_Object object, *begin, *end;
|
|
123 int force;
|
|
124 {
|
|
125 register INTERVAL i;
|
1965
|
126 int searchpos;
|
|
127
|
40656
|
128 CHECK_STRING_OR_BUFFER (object);
|
|
129 CHECK_NUMBER_COERCE_MARKER (*begin);
|
|
130 CHECK_NUMBER_COERCE_MARKER (*end);
|
1029
|
131
|
|
132 /* If we are asked for a point, but from a subr which operates
|
17467
|
133 on a range, then return nothing. */
|
8907
|
134 if (EQ (*begin, *end) && begin != end)
|
1029
|
135 return NULL_INTERVAL;
|
|
136
|
|
137 if (XINT (*begin) > XINT (*end))
|
|
138 {
|
1965
|
139 Lisp_Object n;
|
|
140 n = *begin;
|
1029
|
141 *begin = *end;
|
1965
|
142 *end = n;
|
1029
|
143 }
|
|
144
|
9109
|
145 if (BUFFERP (object))
|
1029
|
146 {
|
|
147 register struct buffer *b = XBUFFER (object);
|
|
148
|
|
149 if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
|
|
150 && XINT (*end) <= BUF_ZV (b)))
|
|
151 args_out_of_range (*begin, *end);
|
10312
|
152 i = BUF_INTERVALS (b);
|
1029
|
153
|
17467
|
154 /* If there's no text, there are no properties. */
|
1965
|
155 if (BUF_BEGV (b) == BUF_ZV (b))
|
|
156 return NULL_INTERVAL;
|
|
157
|
|
158 searchpos = XINT (*begin);
|
1029
|
159 }
|
|
160 else
|
|
161 {
|
46448
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
162 int len = SCHARS (object);
|
1029
|
163
|
1965
|
164 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
|
46448
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
165 && XINT (*end) <= len))
|
1029
|
166 args_out_of_range (*begin, *end);
|
22344
|
167 XSETFASTINT (*begin, XFASTINT (*begin));
|
3996
|
168 if (begin != end)
|
22344
|
169 XSETFASTINT (*end, XFASTINT (*end));
|
46448
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
170 i = STRING_INTERVALS (object);
|
1965
|
171
|
46448
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
172 if (len == 0)
|
1965
|
173 return NULL_INTERVAL;
|
|
174
|
|
175 searchpos = XINT (*begin);
|
1029
|
176 }
|
|
177
|
|
178 if (NULL_INTERVAL_P (i))
|
|
179 return (force ? create_root_interval (object) : i);
|
49247
|
180
|
1965
|
181 return find_interval (i, searchpos);
|
1029
|
182 }
|
|
183
|
|
184 /* Validate LIST as a property list. If LIST is not a list, then
|
|
185 make one consisting of (LIST nil). Otherwise, verify that LIST
|
17467
|
186 is even numbered and thus suitable as a plist. */
|
1029
|
187
|
|
188 static Lisp_Object
|
|
189 validate_plist (list)
|
4797
|
190 Lisp_Object list;
|
1029
|
191 {
|
|
192 if (NILP (list))
|
|
193 return Qnil;
|
|
194
|
|
195 if (CONSP (list))
|
|
196 {
|
|
197 register int i;
|
|
198 register Lisp_Object tail;
|
|
199 for (i = 0, tail = list; !NILP (tail); i++)
|
3996
|
200 {
|
|
201 tail = Fcdr (tail);
|
|
202 QUIT;
|
|
203 }
|
1029
|
204 if (i & 1)
|
|
205 error ("Odd length text property list");
|
|
206 return list;
|
|
207 }
|
|
208
|
|
209 return Fcons (list, Fcons (Qnil, Qnil));
|
|
210 }
|
|
211
|
|
212 /* Return nonzero if interval I has all the properties,
|
17467
|
213 with the same values, of list PLIST. */
|
1029
|
214
|
|
215 static int
|
|
216 interval_has_all_properties (plist, i)
|
|
217 Lisp_Object plist;
|
|
218 INTERVAL i;
|
|
219 {
|
25772
|
220 register Lisp_Object tail1, tail2, sym1;
|
1029
|
221 register int found;
|
|
222
|
17467
|
223 /* Go through each element of PLIST. */
|
1029
|
224 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
225 {
|
|
226 sym1 = Fcar (tail1);
|
|
227 found = 0;
|
|
228
|
|
229 /* Go through I's plist, looking for sym1 */
|
|
230 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
231 if (EQ (sym1, Fcar (tail2)))
|
|
232 {
|
|
233 /* Found the same property on both lists. If the
|
17467
|
234 values are unequal, return zero. */
|
3998
|
235 if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
|
1029
|
236 return 0;
|
|
237
|
17467
|
238 /* Property has same value on both lists; go to next one. */
|
1029
|
239 found = 1;
|
|
240 break;
|
|
241 }
|
|
242
|
|
243 if (! found)
|
|
244 return 0;
|
|
245 }
|
|
246
|
|
247 return 1;
|
|
248 }
|
|
249
|
|
250 /* Return nonzero if the plist of interval I has any of the
|
17467
|
251 properties of PLIST, regardless of their values. */
|
1029
|
252
|
|
253 static INLINE int
|
|
254 interval_has_some_properties (plist, i)
|
|
255 Lisp_Object plist;
|
|
256 INTERVAL i;
|
|
257 {
|
|
258 register Lisp_Object tail1, tail2, sym;
|
|
259
|
17467
|
260 /* Go through each element of PLIST. */
|
1029
|
261 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
262 {
|
|
263 sym = Fcar (tail1);
|
|
264
|
|
265 /* Go through i's plist, looking for tail1 */
|
|
266 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
267 if (EQ (sym, Fcar (tail2)))
|
|
268 return 1;
|
|
269 }
|
|
270
|
|
271 return 0;
|
|
272 }
|
44673
|
273
|
|
274 /* Return nonzero if the plist of interval I has any of the
|
|
275 property names in LIST, regardless of their values. */
|
|
276
|
|
277 static INLINE int
|
|
278 interval_has_some_properties_list (list, i)
|
|
279 Lisp_Object list;
|
|
280 INTERVAL i;
|
|
281 {
|
|
282 register Lisp_Object tail1, tail2, sym;
|
|
283
|
|
284 /* Go through each element of LIST. */
|
|
285 for (tail1 = list; ! NILP (tail1); tail1 = XCDR (tail1))
|
|
286 {
|
|
287 sym = Fcar (tail1);
|
|
288
|
|
289 /* Go through i's plist, looking for tail1 */
|
|
290 for (tail2 = i->plist; ! NILP (tail2); tail2 = XCDR (XCDR (tail2)))
|
|
291 if (EQ (sym, XCAR (tail2)))
|
|
292 return 1;
|
|
293 }
|
|
294
|
|
295 return 0;
|
|
296 }
|
1965
|
297
|
3960
|
298 /* Changing the plists of individual intervals. */
|
|
299
|
|
300 /* Return the value of PROP in property-list PLIST, or Qunbound if it
|
|
301 has none. */
|
8907
|
302 static Lisp_Object
|
3960
|
303 property_value (plist, prop)
|
8856
|
304 Lisp_Object plist, prop;
|
3960
|
305 {
|
|
306 Lisp_Object value;
|
|
307
|
|
308 while (PLIST_ELT_P (plist, value))
|
25645
|
309 if (EQ (XCAR (plist), prop))
|
|
310 return XCAR (value);
|
3960
|
311 else
|
25645
|
312 plist = XCDR (value);
|
3960
|
313
|
|
314 return Qunbound;
|
|
315 }
|
|
316
|
1965
|
317 /* Set the properties of INTERVAL to PROPERTIES,
|
|
318 and record undo info for the previous values.
|
|
319 OBJECT is the string or buffer that INTERVAL belongs to. */
|
|
320
|
|
321 static void
|
|
322 set_properties (properties, interval, object)
|
|
323 Lisp_Object properties, object;
|
|
324 INTERVAL interval;
|
|
325 {
|
3960
|
326 Lisp_Object sym, value;
|
1965
|
327
|
3960
|
328 if (BUFFERP (object))
|
1965
|
329 {
|
3960
|
330 /* For each property in the old plist which is missing from PROPERTIES,
|
|
331 or has a different value in PROPERTIES, make an undo record. */
|
|
332 for (sym = interval->plist;
|
|
333 PLIST_ELT_P (sym, value);
|
25645
|
334 sym = XCDR (value))
|
|
335 if (! EQ (property_value (properties, XCAR (sym)),
|
|
336 XCAR (value)))
|
4076
|
337 {
|
|
338 record_property_change (interval->position, LENGTH (interval),
|
25645
|
339 XCAR (sym), XCAR (value),
|
4076
|
340 object);
|
|
341 }
|
3960
|
342
|
|
343 /* For each new property that has no value at all in the old plist,
|
|
344 make an undo record binding it to nil, so it will be removed. */
|
|
345 for (sym = properties;
|
|
346 PLIST_ELT_P (sym, value);
|
25645
|
347 sym = XCDR (value))
|
|
348 if (EQ (property_value (interval->plist, XCAR (sym)), Qunbound))
|
4076
|
349 {
|
|
350 record_property_change (interval->position, LENGTH (interval),
|
25645
|
351 XCAR (sym), Qnil,
|
4076
|
352 object);
|
|
353 }
|
1965
|
354 }
|
|
355
|
|
356 /* Store new properties. */
|
|
357 interval->plist = Fcopy_sequence (properties);
|
|
358 }
|
1029
|
359
|
|
360 /* Add the properties of PLIST to the interval I, or set
|
|
361 the value of I's property to the value of the property on PLIST
|
|
362 if they are different.
|
|
363
|
1965
|
364 OBJECT should be the string or buffer the interval is in.
|
|
365
|
1029
|
366 Return nonzero if this changes I (i.e., if any members of PLIST
|
|
367 are actually added to I's plist) */
|
|
368
|
1965
|
369 static int
|
|
370 add_properties (plist, i, object)
|
1029
|
371 Lisp_Object plist;
|
|
372 INTERVAL i;
|
1965
|
373 Lisp_Object object;
|
1029
|
374 {
|
10159
|
375 Lisp_Object tail1, tail2, sym1, val1;
|
1029
|
376 register int changed = 0;
|
|
377 register int found;
|
10159
|
378 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
379
|
|
380 tail1 = plist;
|
|
381 sym1 = Qnil;
|
|
382 val1 = Qnil;
|
|
383 /* No need to protect OBJECT, because we can GC only in the case
|
|
384 where it is a buffer, and live buffers are always protected.
|
|
385 I and its plist are also protected, via OBJECT. */
|
|
386 GCPRO3 (tail1, sym1, val1);
|
1029
|
387
|
17467
|
388 /* Go through each element of PLIST. */
|
1029
|
389 for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
|
|
390 {
|
|
391 sym1 = Fcar (tail1);
|
|
392 val1 = Fcar (Fcdr (tail1));
|
|
393 found = 0;
|
|
394
|
|
395 /* Go through I's plist, looking for sym1 */
|
|
396 for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
|
|
397 if (EQ (sym1, Fcar (tail2)))
|
|
398 {
|
10159
|
399 /* No need to gcpro, because tail2 protects this
|
|
400 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
|
401 register Lisp_Object this_cdr;
|
1029
|
402
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
403 this_cdr = Fcdr (tail2);
|
17467
|
404 /* Found the property. Now check its value. */
|
1029
|
405 found = 1;
|
|
406
|
|
407 /* The properties have the same value on both lists.
|
17467
|
408 Continue to the next property. */
|
3998
|
409 if (EQ (val1, Fcar (this_cdr)))
|
1029
|
410 break;
|
|
411
|
1965
|
412 /* Record this change in the buffer, for undo purposes. */
|
9109
|
413 if (BUFFERP (object))
|
1965
|
414 {
|
4076
|
415 record_property_change (i->position, LENGTH (i),
|
|
416 sym1, Fcar (this_cdr), object);
|
1965
|
417 }
|
|
418
|
1029
|
419 /* I's property has a different value -- change it */
|
|
420 Fsetcar (this_cdr, val1);
|
|
421 changed++;
|
|
422 break;
|
|
423 }
|
|
424
|
|
425 if (! found)
|
|
426 {
|
1965
|
427 /* Record this change in the buffer, for undo purposes. */
|
9109
|
428 if (BUFFERP (object))
|
1965
|
429 {
|
4076
|
430 record_property_change (i->position, LENGTH (i),
|
|
431 sym1, Qnil, object);
|
1965
|
432 }
|
1029
|
433 i->plist = Fcons (sym1, Fcons (val1, i->plist));
|
|
434 changed++;
|
|
435 }
|
|
436 }
|
|
437
|
10159
|
438 UNGCPRO;
|
|
439
|
1029
|
440 return changed;
|
|
441 }
|
|
442
|
44673
|
443 /* For any members of PLIST, or LIST,
|
|
444 which are properties of I, remove them from I's plist.
|
|
445 (If PLIST is non-nil, use that, otherwise use LIST.)
|
1965
|
446 OBJECT is the string or buffer containing I. */
|
1029
|
447
|
1965
|
448 static int
|
44673
|
449 remove_properties (plist, list, i, object)
|
|
450 Lisp_Object plist, list;
|
1029
|
451 INTERVAL i;
|
1965
|
452 Lisp_Object object;
|
1029
|
453 {
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
454 register Lisp_Object tail1, tail2, sym, current_plist;
|
1029
|
455 register int changed = 0;
|
|
456
|
44748
|
457 /* Nonzero means tail1 is a plist, otherwise it is a list. */
|
|
458 int use_plist;
|
44673
|
459
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
460 current_plist = i->plist;
|
44673
|
461
|
|
462 if (! NILP (plist))
|
44748
|
463 tail1 = plist, use_plist = 1;
|
44673
|
464 else
|
44748
|
465 tail1 = list, use_plist = 0;
|
44673
|
466
|
|
467 /* Go through each element of LIST or PLIST. */
|
44976
|
468 while (CONSP (tail1))
|
1029
|
469 {
|
44673
|
470 sym = XCAR (tail1);
|
1029
|
471
|
44673
|
472 /* First, remove the symbol if it's at the head of the list */
|
44976
|
473 while (CONSP (current_plist) && EQ (sym, XCAR (current_plist)))
|
1029
|
474 {
|
9109
|
475 if (BUFFERP (object))
|
44673
|
476 record_property_change (i->position, LENGTH (i),
|
|
477 sym, XCAR (XCDR (current_plist)),
|
|
478 object);
|
1965
|
479
|
44673
|
480 current_plist = XCDR (XCDR (current_plist));
|
1029
|
481 changed++;
|
|
482 }
|
|
483
|
44673
|
484 /* Go through I's plist, looking for SYM. */
|
1029
|
485 tail2 = current_plist;
|
|
486 while (! NILP (tail2))
|
|
487 {
|
6516
8278049ee7a7
(add_properties, remove_properties): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
488 register Lisp_Object this;
|
44673
|
489 this = XCDR (XCDR (tail2));
|
44976
|
490 if (CONSP (this) && EQ (sym, XCAR (this)))
|
1029
|
491 {
|
9109
|
492 if (BUFFERP (object))
|
44673
|
493 record_property_change (i->position, LENGTH (i),
|
|
494 sym, XCAR (XCDR (this)), object);
|
1965
|
495
|
44673
|
496 Fsetcdr (XCDR (tail2), XCDR (XCDR (this)));
|
1029
|
497 changed++;
|
|
498 }
|
|
499 tail2 = this;
|
|
500 }
|
44673
|
501
|
|
502 /* Advance thru TAIL1 one way or the other. */
|
44748
|
503 tail1 = XCDR (tail1);
|
|
504 if (use_plist && CONSP (tail1))
|
44673
|
505 tail1 = XCDR (tail1);
|
1029
|
506 }
|
|
507
|
|
508 if (changed)
|
|
509 i->plist = current_plist;
|
|
510 return changed;
|
|
511 }
|
|
512
|
1965
|
513 #if 0
|
1029
|
514 /* Remove all properties from interval I. Return non-zero
|
17467
|
515 if this changes the interval. */
|
1029
|
516
|
|
517 static INLINE int
|
|
518 erase_properties (i)
|
|
519 INTERVAL i;
|
|
520 {
|
|
521 if (NILP (i->plist))
|
|
522 return 0;
|
|
523
|
|
524 i->plist = Qnil;
|
|
525 return 1;
|
|
526 }
|
1965
|
527 #endif
|
1029
|
528
|
49247
|
529 /* Returns the interval of POSITION in OBJECT.
|
17467
|
530 POSITION is BEG-based. */
|
|
531
|
|
532 INTERVAL
|
|
533 interval_of (position, object)
|
|
534 int position;
|
|
535 Lisp_Object object;
|
|
536 {
|
|
537 register INTERVAL i;
|
|
538 int beg, end;
|
|
539
|
|
540 if (NILP (object))
|
|
541 XSETBUFFER (object, current_buffer);
|
20955
|
542 else if (EQ (object, Qt))
|
|
543 return NULL_INTERVAL;
|
17467
|
544
|
40656
|
545 CHECK_STRING_OR_BUFFER (object);
|
17467
|
546
|
|
547 if (BUFFERP (object))
|
|
548 {
|
|
549 register struct buffer *b = XBUFFER (object);
|
|
550
|
|
551 beg = BUF_BEGV (b);
|
|
552 end = BUF_ZV (b);
|
|
553 i = BUF_INTERVALS (b);
|
|
554 }
|
|
555 else
|
|
556 {
|
22344
|
557 beg = 0;
|
46448
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
558 end = SCHARS (object);
|
218b99308569
(validate_interval_range, interval_of): Use string macros instead of
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
559 i = STRING_INTERVALS (object);
|
17467
|
560 }
|
|
561
|
|
562 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
|
563 args_out_of_range (make_number (position), make_number (position));
|
17467
|
564 if (beg == end || NULL_INTERVAL_P (i))
|
|
565 return NULL_INTERVAL;
|
49247
|
566
|
17467
|
567 return find_interval (i, position);
|
|
568 }
|
|
569
|
1029
|
570 DEFUN ("text-properties-at", Ftext_properties_at,
|
|
571 Stext_properties_at, 1, 2, 0,
|
40123
|
572 doc: /* Return the list of properties of the character at POSITION in OBJECT.
|
49247
|
573 If the optional second argument OBJECT is a buffer (or nil, which means
|
|
574 the current buffer), POSITION is a buffer position (integer or marker).
|
|
575 If OBJECT is a string, POSITION is a 0-based index into it.
|
40123
|
576 If POSITION is at the end of OBJECT, the value is nil. */)
|
|
577 (position, object)
|
14088
|
578 Lisp_Object position, object;
|
1029
|
579 {
|
|
580 register INTERVAL i;
|
|
581
|
|
582 if (NILP (object))
|
9280
|
583 XSETBUFFER (object, current_buffer);
|
1029
|
584
|
14088
|
585 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
586 if (NULL_INTERVAL_P (i))
|
|
587 return Qnil;
|
14088
|
588 /* If POSITION is at the end of the interval,
|
1965
|
589 it means it's the end of OBJECT.
|
|
590 There are no properties at the very end,
|
|
591 since no character follows. */
|
14088
|
592 if (XINT (position) == LENGTH (i) + i->position)
|
1965
|
593 return Qnil;
|
1029
|
594
|
|
595 return i->plist;
|
|
596 }
|
|
597
|
1857
|
598 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
|
40123
|
599 doc: /* Return the value of POSITION's property PROP, in OBJECT.
|
|
600 OBJECT is optional and defaults to the current buffer.
|
|
601 If POSITION is at the end of OBJECT, the value is nil. */)
|
|
602 (position, prop, object)
|
14088
|
603 Lisp_Object position, object;
|
8271
|
604 Lisp_Object prop;
|
1857
|
605 {
|
14088
|
606 return textget (Ftext_properties_at (position, object), prop);
|
1857
|
607 }
|
|
608
|
48840
|
609 /* Return the value of char's property PROP, in OBJECT at POSITION.
|
32849
|
610 OBJECT is optional and defaults to the current buffer.
|
|
611 If OVERLAY is non-0, then in the case that the returned property is from
|
|
612 an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
|
|
613 returned in *OVERLAY.
|
|
614 If POSITION is at the end of OBJECT, the value is nil.
|
|
615 If OBJECT is a buffer, then overlay properties are considered as well as
|
|
616 text properties.
|
|
617 If OBJECT is a window, then that window's buffer is used, but
|
|
618 window-specific overlays are considered only if they are associated
|
|
619 with OBJECT. */
|
|
620 Lisp_Object
|
|
621 get_char_property_and_overlay (position, prop, object, overlay)
|
14088
|
622 Lisp_Object position, object;
|
6063
|
623 register Lisp_Object prop;
|
32849
|
624 Lisp_Object *overlay;
|
6063
|
625 {
|
|
626 struct window *w = 0;
|
|
627
|
40656
|
628 CHECK_NUMBER_COERCE_MARKER (position);
|
6063
|
629
|
|
630 if (NILP (object))
|
9280
|
631 XSETBUFFER (object, current_buffer);
|
6063
|
632
|
|
633 if (WINDOWP (object))
|
|
634 {
|
|
635 w = XWINDOW (object);
|
8907
|
636 object = w->buffer;
|
6063
|
637 }
|
|
638 if (BUFFERP (object))
|
|
639 {
|
|
640 int noverlays;
|
55652
|
641 Lisp_Object *overlay_vec;
|
12641
|
642 struct buffer *obuf = current_buffer;
|
|
643
|
|
644 set_buffer_temp (XBUFFER (object));
|
6063
|
645
|
55652
|
646 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
|
6063
|
647 noverlays = sort_overlays (overlay_vec, noverlays, w);
|
|
648
|
12641
|
649 set_buffer_temp (obuf);
|
|
650
|
6063
|
651 /* Now check the overlays in order of decreasing priority. */
|
|
652 while (--noverlays >= 0)
|
|
653 {
|
55652
|
654 Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
|
6063
|
655 if (!NILP (tem))
|
32849
|
656 {
|
|
657 if (overlay)
|
|
658 /* Return the overlay we got the property from. */
|
|
659 *overlay = overlay_vec[noverlays];
|
|
660 return tem;
|
|
661 }
|
6063
|
662 }
|
|
663 }
|
32849
|
664
|
|
665 if (overlay)
|
|
666 /* Indicate that the return value is not from an overlay. */
|
|
667 *overlay = Qnil;
|
|
668
|
6063
|
669 /* Not a buffer, or no appropriate overlay, so fall through to the
|
|
670 simpler case. */
|
32849
|
671 return Fget_text_property (position, prop, object);
|
|
672 }
|
|
673
|
|
674 DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
|
40123
|
675 doc: /* Return the value of POSITION's property PROP, in OBJECT.
|
40647
|
676 Both overlay properties and text properties are checked.
|
40123
|
677 OBJECT is optional and defaults to the current buffer.
|
|
678 If POSITION is at the end of OBJECT, the value is nil.
|
|
679 If OBJECT is a buffer, then overlay properties are considered as well as
|
|
680 text properties.
|
|
681 If OBJECT is a window, then that window's buffer is used, but window-specific
|
|
682 overlays are considered only if they are associated with OBJECT. */)
|
|
683 (position, prop, object)
|
32849
|
684 Lisp_Object position, object;
|
|
685 register Lisp_Object prop;
|
|
686 {
|
|
687 return get_char_property_and_overlay (position, prop, object, 0);
|
6063
|
688 }
|
53201
|
689
|
|
690 DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay,
|
|
691 Sget_char_property_and_overlay, 2, 3, 0,
|
|
692 doc: /* Like `get-char-property', but with extra overlay information.
|
|
693 Return a cons whose car is the return value of `get-char-property'
|
|
694 with the same arguments, that is, the value of POSITION's property
|
|
695 PROP in OBJECT, and whose cdr is the overlay in which the property was
|
|
696 found, or nil, if it was found as a text property or not found at all.
|
|
697 OBJECT is optional and defaults to the current buffer. OBJECT may be
|
|
698 a string, a buffer or a window. For strings, the cdr of the return
|
|
699 value is always nil, since strings do not have overlays. If OBJECT is
|
|
700 a window, then that window's buffer is used, but window-specific
|
|
701 overlays are considered only if they are associated with OBJECT. If
|
|
702 POSITION is at the end of OBJECT, both car and cdr are nil. */)
|
|
703 (position, prop, object)
|
|
704 Lisp_Object position, object;
|
|
705 register Lisp_Object prop;
|
|
706 {
|
|
707 Lisp_Object overlay;
|
|
708 Lisp_Object val
|
|
709 = get_char_property_and_overlay (position, prop, object, &overlay);
|
|
710 return Fcons(val, overlay);
|
|
711 }
|
|
712
|
16679
|
713
|
|
714 DEFUN ("next-char-property-change", Fnext_char_property_change,
|
|
715 Snext_char_property_change, 1, 2, 0,
|
40123
|
716 doc: /* Return the position of next text property or overlay change.
|
49247
|
717 This scans characters forward in the current buffer from POSITION till
|
|
718 it finds a change in some text property, or the beginning or end of an
|
|
719 overlay, and returns the position of that.
|
70656
|
720 If none is found up to (point-max), the function returns (point-max).
|
40123
|
721
|
64576
7a1c6e86c825
(Fnext_char_property_change, Fprevious_char_property_change): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
722 If the optional second argument LIMIT is non-nil, don't search
|
70656
|
723 past position LIMIT; return LIMIT if nothing is found before LIMIT.
|
|
724 LIMIT is a no-op if it is greater than (point-max). */)
|
40123
|
725 (position, limit)
|
16679
|
726 Lisp_Object position, limit;
|
|
727 {
|
|
728 Lisp_Object temp;
|
6063
|
729
|
16679
|
730 temp = Fnext_overlay_change (position);
|
|
731 if (! NILP (limit))
|
|
732 {
|
60815
|
733 CHECK_NUMBER_COERCE_MARKER (limit);
|
16679
|
734 if (XINT (limit) < XINT (temp))
|
|
735 temp = limit;
|
|
736 }
|
|
737 return Fnext_property_change (position, Qnil, temp);
|
|
738 }
|
|
739
|
|
740 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
|
|
741 Sprevious_char_property_change, 1, 2, 0,
|
40123
|
742 doc: /* Return the position of previous text property or overlay change.
|
49247
|
743 Scans characters backward in the current buffer from POSITION till it
|
|
744 finds a change in some text property, or the beginning or end of an
|
|
745 overlay, and returns the position of that.
|
70656
|
746 If none is found since (point-min), the function returns (point-min).
|
40123
|
747
|
64576
7a1c6e86c825
(Fnext_char_property_change, Fprevious_char_property_change): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
748 If the optional second argument LIMIT is non-nil, don't search
|
70656
|
749 past position LIMIT; return LIMIT if nothing is found before LIMIT.
|
|
750 LIMIT is a no-op if it is less than (point-min). */)
|
40123
|
751 (position, limit)
|
16679
|
752 Lisp_Object position, limit;
|
|
753 {
|
|
754 Lisp_Object temp;
|
|
755
|
|
756 temp = Fprevious_overlay_change (position);
|
|
757 if (! NILP (limit))
|
|
758 {
|
60815
|
759 CHECK_NUMBER_COERCE_MARKER (limit);
|
16679
|
760 if (XINT (limit) > XINT (temp))
|
|
761 temp = limit;
|
|
762 }
|
|
763 return Fprevious_property_change (position, Qnil, temp);
|
|
764 }
|
25819
|
765
|
|
766
|
30242
|
767 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
|
|
768 Snext_single_char_property_change, 2, 4, 0,
|
40123
|
769 doc: /* Return the position of next text property or overlay change for a specific property.
|
|
770 Scans characters forward from POSITION till it finds
|
|
771 a change in the PROP property, then returns the position of the change.
|
49247
|
772 If the optional third argument OBJECT is a buffer (or nil, which means
|
|
773 the current buffer), POSITION is a buffer position (integer or marker).
|
|
774 If OBJECT is a string, POSITION is a 0-based index into it.
|
|
775
|
70656
|
776 In a string, scan runs to the end of the string.
|
|
777 In a buffer, it runs to (point-max), and the value cannot exceed that.
|
|
778
|
40123
|
779 The property values are compared with `eq'.
|
|
780 If the property is constant all the way to the end of OBJECT, return the
|
|
781 last valid position in OBJECT.
|
|
782 If the optional fourth argument LIMIT is non-nil, don't search
|
|
783 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
|
|
784 (position, prop, object, limit)
|
30242
|
785 Lisp_Object prop, position, object, limit;
|
25819
|
786 {
|
|
787 if (STRINGP (object))
|
|
788 {
|
30242
|
789 position = Fnext_single_property_change (position, prop, object, limit);
|
|
790 if (NILP (position))
|
25819
|
791 {
|
|
792 if (NILP (limit))
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
793 position = make_number (SCHARS (object));
|
25819
|
794 else
|
60815
|
795 {
|
|
796 CHECK_NUMBER (limit);
|
|
797 position = limit;
|
|
798 }
|
25819
|
799 }
|
|
800 }
|
|
801 else
|
|
802 {
|
|
803 Lisp_Object initial_value, value;
|
46293
|
804 int count = SPECPDL_INDEX ();
|
25819
|
805
|
30242
|
806 if (! NILP (object))
|
40656
|
807 CHECK_BUFFER (object);
|
49247
|
808
|
25819
|
809 if (BUFFERP (object) && current_buffer != XBUFFER (object))
|
|
810 {
|
|
811 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
|
|
812 Fset_buffer (object);
|
|
813 }
|
|
814
|
60815
|
815 CHECK_NUMBER_COERCE_MARKER (position);
|
|
816
|
30242
|
817 initial_value = Fget_char_property (position, prop, object);
|
49247
|
818
|
30242
|
819 if (NILP (limit))
|
70656
|
820 XSETFASTINT (limit, ZV);
|
30242
|
821 else
|
40656
|
822 CHECK_NUMBER_COERCE_MARKER (limit);
|
30242
|
823
|
70656
|
824 if (XFASTINT (position) >= XFASTINT (limit))
|
25819
|
825 {
|
70656
|
826 position = limit;
|
|
827 if (XFASTINT (position) > ZV)
|
|
828 XSETFASTINT (position, ZV);
|
|
829 }
|
|
830 else
|
|
831 while (1)
|
|
832 {
|
|
833 position = Fnext_char_property_change (position, limit);
|
|
834 if (XFASTINT (position) >= XFASTINT (limit))
|
|
835 {
|
|
836 position = limit;
|
|
837 break;
|
|
838 }
|
|
839
|
|
840 value = Fget_char_property (position, prop, object);
|
|
841 if (!EQ (value, initial_value))
|
|
842 break;
|
30242
|
843 }
|
|
844
|
25819
|
845 unbind_to (count, Qnil);
|
|
846 }
|
|
847
|
30242
|
848 return position;
|
25819
|
849 }
|
|
850
|
30242
|
851 DEFUN ("previous-single-char-property-change",
|
|
852 Fprevious_single_char_property_change,
|
|
853 Sprevious_single_char_property_change, 2, 4, 0,
|
40123
|
854 doc: /* Return the position of previous text property or overlay change for a specific property.
|
|
855 Scans characters backward from POSITION till it finds
|
|
856 a change in the PROP property, then returns the position of the change.
|
49247
|
857 If the optional third argument OBJECT is a buffer (or nil, which means
|
|
858 the current buffer), POSITION is a buffer position (integer or marker).
|
|
859 If OBJECT is a string, POSITION is a 0-based index into it.
|
|
860
|
70656
|
861 In a string, scan runs to the start of the string.
|
|
862 In a buffer, it runs to (point-min), and the value cannot be less than that.
|
|
863
|
40123
|
864 The property values are compared with `eq'.
|
|
865 If the property is constant all the way to the start of OBJECT, return the
|
|
866 first valid position in OBJECT.
|
|
867 If the optional fourth argument LIMIT is non-nil, don't search
|
|
868 back past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
|
|
869 (position, prop, object, limit)
|
30242
|
870 Lisp_Object prop, position, object, limit;
|
|
871 {
|
|
872 if (STRINGP (object))
|
|
873 {
|
|
874 position = Fprevious_single_property_change (position, prop, object, limit);
|
|
875 if (NILP (position))
|
|
876 {
|
|
877 if (NILP (limit))
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
878 position = make_number (SCHARS (object));
|
30242
|
879 else
|
60815
|
880 {
|
|
881 CHECK_NUMBER (limit);
|
|
882 position = limit;
|
|
883 }
|
30242
|
884 }
|
|
885 }
|
|
886 else
|
|
887 {
|
46293
|
888 int count = SPECPDL_INDEX ();
|
25819
|
889
|
30242
|
890 if (! NILP (object))
|
40656
|
891 CHECK_BUFFER (object);
|
49247
|
892
|
30242
|
893 if (BUFFERP (object) && current_buffer != XBUFFER (object))
|
|
894 {
|
|
895 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
|
|
896 Fset_buffer (object);
|
|
897 }
|
49247
|
898
|
60815
|
899 CHECK_NUMBER_COERCE_MARKER (position);
|
|
900
|
30242
|
901 if (NILP (limit))
|
70656
|
902 XSETFASTINT (limit, BEGV);
|
30242
|
903 else
|
40656
|
904 CHECK_NUMBER_COERCE_MARKER (limit);
|
30242
|
905
|
30379
|
906 if (XFASTINT (position) <= XFASTINT (limit))
|
70656
|
907 {
|
|
908 position = limit;
|
|
909 if (XFASTINT (position) < BEGV)
|
|
910 XSETFASTINT (position, BEGV);
|
|
911 }
|
30379
|
912 else
|
30242
|
913 {
|
70656
|
914 Lisp_Object initial_value
|
|
915 = Fget_char_property (make_number (XFASTINT (position) - 1),
|
|
916 prop, object);
|
49247
|
917
|
70656
|
918 while (1)
|
30379
|
919 {
|
|
920 position = Fprevious_char_property_change (position, limit);
|
30242
|
921
|
30379
|
922 if (XFASTINT (position) <= XFASTINT (limit))
|
|
923 {
|
|
924 position = limit;
|
|
925 break;
|
|
926 }
|
|
927 else
|
|
928 {
|
70656
|
929 Lisp_Object value
|
|
930 = Fget_char_property (make_number (XFASTINT (position) - 1),
|
|
931 prop, object);
|
30379
|
932
|
|
933 if (!EQ (value, initial_value))
|
|
934 break;
|
|
935 }
|
|
936 }
|
30242
|
937 }
|
|
938
|
|
939 unbind_to (count, Qnil);
|
|
940 }
|
|
941
|
|
942 return position;
|
|
943 }
|
16679
|
944
|
1029
|
945 DEFUN ("next-property-change", Fnext_property_change,
|
5086
|
946 Snext_property_change, 1, 3, 0,
|
40123
|
947 doc: /* Return the position of next property change.
|
|
948 Scans characters forward from POSITION in OBJECT till it finds
|
|
949 a change in some text property, then returns the position of the change.
|
49247
|
950 If the optional second argument OBJECT is a buffer (or nil, which means
|
|
951 the current buffer), POSITION is a buffer position (integer or marker).
|
|
952 If OBJECT is a string, POSITION is a 0-based index into it.
|
40123
|
953 Return nil if the property is constant all the way to the end of OBJECT.
|
|
954 If the value is non-nil, it is a position greater than POSITION, never equal.
|
|
955
|
|
956 If the optional third argument LIMIT is non-nil, don't search
|
|
957 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
|
|
958 (position, object, limit)
|
14088
|
959 Lisp_Object position, object, limit;
|
1029
|
960 {
|
|
961 register INTERVAL i, next;
|
|
962
|
1857
|
963 if (NILP (object))
|
9280
|
964 XSETBUFFER (object, current_buffer);
|
1857
|
965
|
42967
|
966 if (!NILP (limit) && !EQ (limit, Qt))
|
40656
|
967 CHECK_NUMBER_COERCE_MARKER (limit);
|
7092
|
968
|
14088
|
969 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
970
|
10962
|
971 /* If LIMIT is t, return start of next interval--don't
|
|
972 bother checking further intervals. */
|
|
973 if (EQ (limit, Qt))
|
|
974 {
|
13265
|
975 if (NULL_INTERVAL_P (i))
|
|
976 next = i;
|
|
977 else
|
|
978 next = next_interval (i);
|
49247
|
979
|
11116
|
980 if (NULL_INTERVAL_P (next))
|
14088
|
981 XSETFASTINT (position, (STRINGP (object)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
982 ? SCHARS (object)
|
14088
|
983 : BUF_ZV (XBUFFER (object))));
|
11116
|
984 else
|
22344
|
985 XSETFASTINT (position, next->position);
|
14088
|
986 return position;
|
10962
|
987 }
|
|
988
|
13265
|
989 if (NULL_INTERVAL_P (i))
|
|
990 return limit;
|
|
991
|
|
992 next = next_interval (i);
|
|
993
|
42967
|
994 while (!NULL_INTERVAL_P (next) && intervals_equal (i, next)
|
22344
|
995 && (NILP (limit) || next->position < XFASTINT (limit)))
|
1029
|
996 next = next_interval (next);
|
|
997
|
|
998 if (NULL_INTERVAL_P (next))
|
5086
|
999 return limit;
|
42967
|
1000 if (NILP (limit))
|
|
1001 XSETFASTINT (limit, (STRINGP (object)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1002 ? SCHARS (object)
|
42967
|
1003 : BUF_ZV (XBUFFER (object))));
|
|
1004 if (!(next->position < XFASTINT (limit)))
|
5086
|
1005 return limit;
|
1029
|
1006
|
22344
|
1007 XSETFASTINT (position, next->position);
|
14088
|
1008 return position;
|
4381
|
1009 }
|
|
1010
|
|
1011 /* Return 1 if there's a change in some property between BEG and END. */
|
|
1012
|
|
1013 int
|
|
1014 property_change_between_p (beg, end)
|
|
1015 int beg, end;
|
|
1016 {
|
|
1017 register INTERVAL i, next;
|
|
1018 Lisp_Object object, pos;
|
|
1019
|
9280
|
1020 XSETBUFFER (object, current_buffer);
|
9321
|
1021 XSETFASTINT (pos, beg);
|
4381
|
1022
|
|
1023 i = validate_interval_range (object, &pos, &pos, soft);
|
|
1024 if (NULL_INTERVAL_P (i))
|
|
1025 return 0;
|
|
1026
|
|
1027 next = next_interval (i);
|
|
1028 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
|
|
1029 {
|
|
1030 next = next_interval (next);
|
4614
|
1031 if (NULL_INTERVAL_P (next))
|
|
1032 return 0;
|
22344
|
1033 if (next->position >= end)
|
4381
|
1034 return 0;
|
|
1035 }
|
|
1036
|
|
1037 if (NULL_INTERVAL_P (next))
|
|
1038 return 0;
|
|
1039
|
|
1040 return 1;
|
1029
|
1041 }
|
|
1042
|
1211
|
1043 DEFUN ("next-single-property-change", Fnext_single_property_change,
|
5086
|
1044 Snext_single_property_change, 2, 4, 0,
|
40123
|
1045 doc: /* Return the position of next property change for a specific property.
|
|
1046 Scans characters forward from POSITION till it finds
|
|
1047 a change in the PROP property, then returns the position of the change.
|
49247
|
1048 If the optional third argument OBJECT is a buffer (or nil, which means
|
|
1049 the current buffer), POSITION is a buffer position (integer or marker).
|
|
1050 If OBJECT is a string, POSITION is a 0-based index into it.
|
40123
|
1051 The property values are compared with `eq'.
|
|
1052 Return nil if the property is constant all the way to the end of OBJECT.
|
|
1053 If the value is non-nil, it is a position greater than POSITION, never equal.
|
|
1054
|
|
1055 If the optional fourth argument LIMIT is non-nil, don't search
|
|
1056 past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
|
|
1057 (position, prop, object, limit)
|
14088
|
1058 Lisp_Object position, prop, object, limit;
|
1211
|
1059 {
|
|
1060 register INTERVAL i, next;
|
|
1061 register Lisp_Object here_val;
|
|
1062
|
1857
|
1063 if (NILP (object))
|
9280
|
1064 XSETBUFFER (object, current_buffer);
|
1857
|
1065
|
7092
|
1066 if (!NILP (limit))
|
40656
|
1067 CHECK_NUMBER_COERCE_MARKER (limit);
|
7092
|
1068
|
14088
|
1069 i = validate_interval_range (object, &position, &position, soft);
|
1211
|
1070 if (NULL_INTERVAL_P (i))
|
5086
|
1071 return limit;
|
1211
|
1072
|
2762
|
1073 here_val = textget (i->plist, prop);
|
1211
|
1074 next = next_interval (i);
|
49247
|
1075 while (! NULL_INTERVAL_P (next)
|
5086
|
1076 && EQ (here_val, textget (next->plist, prop))
|
22344
|
1077 && (NILP (limit) || next->position < XFASTINT (limit)))
|
1211
|
1078 next = next_interval (next);
|
|
1079
|
|
1080 if (NULL_INTERVAL_P (next))
|
5086
|
1081 return limit;
|
42967
|
1082 if (NILP (limit))
|
|
1083 XSETFASTINT (limit, (STRINGP (object)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1084 ? SCHARS (object)
|
42967
|
1085 : BUF_ZV (XBUFFER (object))));
|
|
1086 if (!(next->position < XFASTINT (limit)))
|
5086
|
1087 return limit;
|
1211
|
1088
|
22344
|
1089 return make_number (next->position);
|
1211
|
1090 }
|
|
1091
|
1029
|
1092 DEFUN ("previous-property-change", Fprevious_property_change,
|
5086
|
1093 Sprevious_property_change, 1, 3, 0,
|
40123
|
1094 doc: /* Return the position of previous property change.
|
|
1095 Scans characters backwards from POSITION in OBJECT till it finds
|
|
1096 a change in some text property, then returns the position of the change.
|
49247
|
1097 If the optional second argument OBJECT is a buffer (or nil, which means
|
|
1098 the current buffer), POSITION is a buffer position (integer or marker).
|
|
1099 If OBJECT is a string, POSITION is a 0-based index into it.
|
40123
|
1100 Return nil if the property is constant all the way to the start of OBJECT.
|
|
1101 If the value is non-nil, it is a position less than POSITION, never equal.
|
|
1102
|
|
1103 If the optional third argument LIMIT is non-nil, don't search
|
|
1104 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
|
|
1105 (position, object, limit)
|
14088
|
1106 Lisp_Object position, object, limit;
|
1029
|
1107 {
|
|
1108 register INTERVAL i, previous;
|
|
1109
|
1857
|
1110 if (NILP (object))
|
9280
|
1111 XSETBUFFER (object, current_buffer);
|
1857
|
1112
|
7092
|
1113 if (!NILP (limit))
|
40656
|
1114 CHECK_NUMBER_COERCE_MARKER (limit);
|
7092
|
1115
|
14088
|
1116 i = validate_interval_range (object, &position, &position, soft);
|
1029
|
1117 if (NULL_INTERVAL_P (i))
|
5086
|
1118 return limit;
|
1029
|
1119
|
5644
|
1120 /* Start with the interval containing the char before point. */
|
14088
|
1121 if (i->position == XFASTINT (position))
|
5644
|
1122 i = previous_interval (i);
|
|
1123
|
1029
|
1124 previous = previous_interval (i);
|
42967
|
1125 while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
|
5086
|
1126 && (NILP (limit)
|
22344
|
1127 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
|
1029
|
1128 previous = previous_interval (previous);
|
|
1129 if (NULL_INTERVAL_P (previous))
|
5086
|
1130 return limit;
|
42967
|
1131 if (NILP (limit))
|
|
1132 XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
|
|
1133 if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
|
5086
|
1134 return limit;
|
1029
|
1135
|
22344
|
1136 return make_number (previous->position + LENGTH (previous));
|
1029
|
1137 }
|
|
1138
|
1211
|
1139 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
|
5086
|
1140 Sprevious_single_property_change, 2, 4, 0,
|
40123
|
1141 doc: /* Return the position of previous property change for a specific property.
|
|
1142 Scans characters backward from POSITION till it finds
|
|
1143 a change in the PROP property, then returns the position of the change.
|
49247
|
1144 If the optional third argument OBJECT is a buffer (or nil, which means
|
|
1145 the current buffer), POSITION is a buffer position (integer or marker).
|
|
1146 If OBJECT is a string, POSITION is a 0-based index into it.
|
40123
|
1147 The property values are compared with `eq'.
|
|
1148 Return nil if the property is constant all the way to the start of OBJECT.
|
|
1149 If the value is non-nil, it is a position less than POSITION, never equal.
|
|
1150
|
|
1151 If the optional fourth argument LIMIT is non-nil, don't search
|
|
1152 back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
|
14088
|
1153 (position, prop, object, limit)
|
|
1154 Lisp_Object position, prop, object, limit;
|
1211
|
1155 {
|
|
1156 register INTERVAL i, previous;
|
|
1157 register Lisp_Object here_val;
|
|
1158
|
1857
|
1159 if (NILP (object))
|
9280
|
1160 XSETBUFFER (object, current_buffer);
|
1857
|
1161
|
7092
|
1162 if (!NILP (limit))
|
40656
|
1163 CHECK_NUMBER_COERCE_MARKER (limit);
|
7092
|
1164
|
14088
|
1165 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
|
1166
|
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1167 /* Start with the interval containing the char before point. */
|
42967
|
1168 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
|
1169 i = previous_interval (i);
|
2226c7efb3da
(Fprevious_single_property_change): Check for null interval after correcting
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1170
|
1211
|
1171 if (NULL_INTERVAL_P (i))
|
5086
|
1172 return limit;
|
1211
|
1173
|
2762
|
1174 here_val = textget (i->plist, prop);
|
1211
|
1175 previous = previous_interval (i);
|
42967
|
1176 while (!NULL_INTERVAL_P (previous)
|
5086
|
1177 && EQ (here_val, textget (previous->plist, prop))
|
|
1178 && (NILP (limit)
|
22344
|
1179 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
|
1211
|
1180 previous = previous_interval (previous);
|
|
1181 if (NULL_INTERVAL_P (previous))
|
5086
|
1182 return limit;
|
42967
|
1183 if (NILP (limit))
|
|
1184 XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
|
|
1185 if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
|
5086
|
1186 return limit;
|
1211
|
1187
|
22344
|
1188 return make_number (previous->position + LENGTH (previous));
|
1211
|
1189 }
|
16679
|
1190
|
10159
|
1191 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
|
|
1192
|
1029
|
1193 DEFUN ("add-text-properties", Fadd_text_properties,
|
1857
|
1194 Sadd_text_properties, 3, 4, 0,
|
40123
|
1195 doc: /* Add properties to the text from START to END.
|
|
1196 The third argument PROPERTIES is a property list
|
49247
|
1197 specifying the property values to add. If the optional fourth argument
|
|
1198 OBJECT is a buffer (or nil, which means the current buffer),
|
|
1199 START and END are buffer positions (integers or markers).
|
|
1200 If OBJECT is a string, START and END are 0-based indices into it.
|
40123
|
1201 Return t if any property value actually changed, nil otherwise. */)
|
|
1202 (start, end, properties, object)
|
1857
|
1203 Lisp_Object start, end, properties, object;
|
1029
|
1204 {
|
|
1205 register INTERVAL i, unchanged;
|
2124
|
1206 register int s, len, modified = 0;
|
10159
|
1207 struct gcpro gcpro1;
|
1029
|
1208
|
|
1209 properties = validate_plist (properties);
|
|
1210 if (NILP (properties))
|
|
1211 return Qnil;
|
|
1212
|
1857
|
1213 if (NILP (object))
|
9280
|
1214 XSETBUFFER (object, current_buffer);
|
1857
|
1215
|
1029
|
1216 i = validate_interval_range (object, &start, &end, hard);
|
|
1217 if (NULL_INTERVAL_P (i))
|
|
1218 return Qnil;
|
|
1219
|
|
1220 s = XINT (start);
|
|
1221 len = XINT (end) - s;
|
|
1222
|
10159
|
1223 /* No need to protect OBJECT, because we GC only if it's a buffer,
|
|
1224 and live buffers are always protected. */
|
|
1225 GCPRO1 (properties);
|
|
1226
|
1029
|
1227 /* If we're not starting on an interval boundary, we have to
|
17467
|
1228 split this interval. */
|
1029
|
1229 if (i->position != s)
|
|
1230 {
|
|
1231 /* If this interval already has the properties, we can
|
17467
|
1232 skip it. */
|
1029
|
1233 if (interval_has_all_properties (properties, i))
|
|
1234 {
|
|
1235 int got = (LENGTH (i) - (s - i->position));
|
|
1236 if (got >= len)
|
14538
|
1237 RETURN_UNGCPRO (Qnil);
|
1029
|
1238 len -= got;
|
3858
|
1239 i = next_interval (i);
|
1029
|
1240 }
|
|
1241 else
|
|
1242 {
|
|
1243 unchanged = i;
|
4144
|
1244 i = split_interval_right (unchanged, s - unchanged->position);
|
1029
|
1245 copy_properties (unchanged, i);
|
|
1246 }
|
|
1247 }
|
|
1248
|
16339
|
1249 if (BUFFERP (object))
|
|
1250 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
16331
|
1251
|
3553
|
1252 /* We are at the beginning of interval I, with LEN chars to scan. */
|
2124
|
1253 for (;;)
|
1029
|
1254 {
|
1965
|
1255 if (i == 0)
|
|
1256 abort ();
|
|
1257
|
1029
|
1258 if (LENGTH (i) >= len)
|
|
1259 {
|
10159
|
1260 /* We can UNGCPRO safely here, because there will be just
|
|
1261 one more chance to gc, in the next call to add_properties,
|
|
1262 and after that we will not need PROPERTIES or OBJECT again. */
|
|
1263 UNGCPRO;
|
|
1264
|
1029
|
1265 if (interval_has_all_properties (properties, i))
|
16331
|
1266 {
|
16339
|
1267 if (BUFFERP (object))
|
|
1268 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1269 XINT (end) - XINT (start));
|
16331
|
1270
|
|
1271 return modified ? Qt : Qnil;
|
|
1272 }
|
1029
|
1273
|
|
1274 if (LENGTH (i) == len)
|
|
1275 {
|
1965
|
1276 add_properties (properties, i, object);
|
16339
|
1277 if (BUFFERP (object))
|
|
1278 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1279 XINT (end) - XINT (start));
|
1029
|
1280 return Qt;
|
|
1281 }
|
|
1282
|
|
1283 /* i doesn't have the properties, and goes past the change limit */
|
|
1284 unchanged = i;
|
4144
|
1285 i = split_interval_left (unchanged, len);
|
1029
|
1286 copy_properties (unchanged, i);
|
1965
|
1287 add_properties (properties, i, object);
|
16339
|
1288 if (BUFFERP (object))
|
|
1289 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1290 XINT (end) - XINT (start));
|
1029
|
1291 return Qt;
|
|
1292 }
|
|
1293
|
|
1294 len -= LENGTH (i);
|
1965
|
1295 modified += add_properties (properties, i, object);
|
1029
|
1296 i = next_interval (i);
|
|
1297 }
|
|
1298 }
|
|
1299
|
10159
|
1300 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
|
|
1301
|
1965
|
1302 DEFUN ("put-text-property", Fput_text_property,
|
|
1303 Sput_text_property, 4, 5, 0,
|
40123
|
1304 doc: /* Set one property of the text from START to END.
|
|
1305 The third and fourth arguments PROPERTY and VALUE
|
|
1306 specify the property to add.
|
49247
|
1307 If the optional fifth argument OBJECT is a buffer (or nil, which means
|
|
1308 the current buffer), START and END are buffer positions (integers or
|
|
1309 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
|
40123
|
1310 (start, end, property, value, object)
|
14088
|
1311 Lisp_Object start, end, property, value, object;
|
1965
|
1312 {
|
|
1313 Fadd_text_properties (start, end,
|
14088
|
1314 Fcons (property, Fcons (value, Qnil)),
|
1965
|
1315 object);
|
|
1316 return Qnil;
|
|
1317 }
|
|
1318
|
1029
|
1319 DEFUN ("set-text-properties", Fset_text_properties,
|
1857
|
1320 Sset_text_properties, 3, 4, 0,
|
40123
|
1321 doc: /* Completely replace properties of text from START to END.
|
|
1322 The third argument PROPERTIES is the new property list.
|
49247
|
1323 If the optional fourth argument OBJECT is a buffer (or nil, which means
|
|
1324 the current buffer), START and END are buffer positions (integers or
|
|
1325 markers). If OBJECT is a string, START and END are 0-based indices into it.
|
40123
|
1326 If PROPERTIES is nil, the effect is to remove all properties from
|
|
1327 the designated part of OBJECT. */)
|
|
1328 (start, end, properties, object)
|
14088
|
1329 Lisp_Object start, end, properties, object;
|
1029
|
1330 {
|
26605
|
1331 return set_text_properties (start, end, properties, object, Qt);
|
|
1332 }
|
|
1333
|
|
1334
|
|
1335 /* Replace properties of text from START to END with new list of
|
|
1336 properties PROPERTIES. OBJECT is the buffer or string containing
|
|
1337 the text. OBJECT nil means use the current buffer.
|
|
1338 SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value
|
67947
|
1339 is nil if the function _detected_ that it did not replace any
|
|
1340 properties, non-nil otherwise. */
|
26605
|
1341
|
|
1342 Lisp_Object
|
|
1343 set_text_properties (start, end, properties, object, signal_after_change_p)
|
|
1344 Lisp_Object start, end, properties, object, signal_after_change_p;
|
|
1345 {
|
41391
|
1346 register INTERVAL i;
|
9071
|
1347 Lisp_Object ostart, oend;
|
|
1348
|
|
1349 ostart = start;
|
|
1350 oend = end;
|
1029
|
1351
|
14088
|
1352 properties = validate_plist (properties);
|
1029
|
1353
|
1857
|
1354 if (NILP (object))
|
9280
|
1355 XSETBUFFER (object, current_buffer);
|
1857
|
1356
|
9541
|
1357 /* If we want no properties for a whole string,
|
|
1358 get rid of its intervals. */
|
14088
|
1359 if (NILP (properties) && STRINGP (object)
|
9541
|
1360 && XFASTINT (start) == 0
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1361 && XFASTINT (end) == SCHARS (object))
|
9541
|
1362 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1363 if (! STRING_INTERVALS (object))
|
67947
|
1364 return Qnil;
|
16331
|
1365
|
46381
|
1366 STRING_SET_INTERVALS (object, NULL_INTERVAL);
|
9541
|
1367 return Qt;
|
|
1368 }
|
|
1369
|
8686
|
1370 i = validate_interval_range (object, &start, &end, soft);
|
9541
|
1371
|
1029
|
1372 if (NULL_INTERVAL_P (i))
|
8686
|
1373 {
|
14088
|
1374 /* If buffer has no properties, and we want none, return now. */
|
|
1375 if (NILP (properties))
|
8686
|
1376 return Qnil;
|
|
1377
|
9071
|
1378 /* Restore the original START and END values
|
|
1379 because validate_interval_range increments them for strings. */
|
|
1380 start = ostart;
|
|
1381 end = oend;
|
|
1382
|
8686
|
1383 i = validate_interval_range (object, &start, &end, hard);
|
|
1384 /* This can return if start == end. */
|
|
1385 if (NULL_INTERVAL_P (i))
|
|
1386 return Qnil;
|
|
1387 }
|
1029
|
1388
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1389 if (BUFFERP (object))
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1390 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1391
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1392 set_text_properties_1 (start, end, properties, object, i);
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1393
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1394 if (BUFFERP (object) && !NILP (signal_after_change_p))
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1395 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1396 XINT (end) - XINT (start));
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1397 return Qt;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1398 }
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1399
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1400 /* Replace properties of text from START to END with new list of
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1401 properties PROPERTIES. BUFFER is the buffer containing
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1402 the text. This does not obey any hooks.
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1403 You can provide the interval that START is located in as I,
|
41532
afe70a164d3b
(set_text_properties_1): Clearly mark that the interval should not be empty.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1404 or pass NULL for I and this function will find it.
|
41589
|
1405 START and END can be in any order. */
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1406
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1407 void
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1408 set_text_properties_1 (start, end, properties, buffer, i)
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1409 Lisp_Object start, end, properties, buffer;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1410 INTERVAL i;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1411 {
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1412 register INTERVAL prev_changed = NULL_INTERVAL;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1413 register int s, len;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1414 INTERVAL unchanged;
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1415
|
1029
|
1416 s = XINT (start);
|
|
1417 len = XINT (end) - s;
|
41589
|
1418 if (len == 0)
|
|
1419 return;
|
|
1420 if (len < 0)
|
|
1421 {
|
|
1422 s = s + len;
|
|
1423 len = - len;
|
|
1424 }
|
|
1425
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1426 if (i == 0)
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1427 i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
|
16331
|
1428
|
1029
|
1429 if (i->position != s)
|
|
1430 {
|
|
1431 unchanged = i;
|
4144
|
1432 i = split_interval_right (unchanged, s - unchanged->position);
|
1272
|
1433
|
1029
|
1434 if (LENGTH (i) > len)
|
|
1435 {
|
1211
|
1436 copy_properties (unchanged, i);
|
4144
|
1437 i = split_interval_left (i, len);
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1438 set_properties (properties, i, buffer);
|
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1439 return;
|
1029
|
1440 }
|
|
1441
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1442 set_properties (properties, i, buffer);
|
3553
|
1443
|
1211
|
1444 if (LENGTH (i) == len)
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1445 return;
|
1211
|
1446
|
|
1447 prev_changed = i;
|
1029
|
1448 len -= LENGTH (i);
|
|
1449 i = next_interval (i);
|
|
1450 }
|
|
1451
|
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
diff
changeset
|
1452 /* We are starting at the beginning of an interval, I */
|
1272
|
1453 while (len > 0)
|
1029
|
1454 {
|
1965
|
1455 if (i == 0)
|
|
1456 abort ();
|
|
1457
|
1029
|
1458 if (LENGTH (i) >= len)
|
|
1459 {
|
1283
6f4cbcc62eba
Minor optimizations of Fset_text_properties and Ferase_text_properties.
Joseph Arceneaux <jla@gnu.org>
diff
changeset
|
1460 if (LENGTH (i) > len)
|
4144
|
1461 i = split_interval_left (i, len);
|
1029
|
1462
|
13585
|
1463 /* We have to call set_properties even if we are going to
|
|
1464 merge the intervals, so as to make the undo records
|
|
1465 and cause redisplay to happen. */
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1466 set_properties (properties, i, buffer);
|
13585
|
1467 if (!NULL_INTERVAL_P (prev_changed))
|
1211
|
1468 merge_interval_left (i);
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1469 return;
|
1029
|
1470 }
|
|
1471
|
|
1472 len -= LENGTH (i);
|
13585
|
1473
|
|
1474 /* We have to call set_properties even if we are going to
|
|
1475 merge the intervals, so as to make the undo records
|
|
1476 and cause redisplay to happen. */
|
40921
95756d215716
(set_text_properties_1): New subroutine, broken out of set_text_properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1477 set_properties (properties, i, buffer);
|
1211
|
1478 if (NULL_INTERVAL_P (prev_changed))
|
13585
|
1479 prev_changed = i;
|
1211
|
1480 else
|
|
1481 prev_changed = i = merge_interval_left (i);
|
|
1482
|
1029
|
1483 i = next_interval (i);
|
|
1484 }
|
|
1485 }
|
|
1486
|
|
1487 DEFUN ("remove-text-properties", Fremove_text_properties,
|
1857
|
1488 Sremove_text_properties, 3, 4, 0,
|
40123
|
1489 doc: /* Remove some properties from text from START to END.
|
|
1490 The third argument PROPERTIES is a property list
|
|
1491 whose property names specify the properties to remove.
|
|
1492 \(The values stored in PROPERTIES are ignored.)
|
49247
|
1493 If the optional fourth argument OBJECT is a buffer (or nil, which means
|
|
1494 the current buffer), START and END are buffer positions (integers or
|
|
1495 markers). If OBJECT is a string, START and END are 0-based indices into it.
|
|
1496 Return t if any property was actually removed, nil otherwise.
|
|
1497
|
|
1498 Use set-text-properties if you want to remove all text properties. */)
|
40123
|
1499 (start, end, properties, object)
|
14088
|
1500 Lisp_Object start, end, properties, object;
|
1029
|
1501 {
|
|
1502 register INTERVAL i, unchanged;
|
2124
|
1503 register int s, len, modified = 0;
|
1029
|
1504
|
1857
|
1505 if (NILP (object))
|
9280
|
1506 XSETBUFFER (object, current_buffer);
|
1857
|
1507
|
1029
|
1508 i = validate_interval_range (object, &start, &end, soft);
|
|
1509 if (NULL_INTERVAL_P (i))
|
|
1510 return Qnil;
|
|
1511
|
|
1512 s = XINT (start);
|
|
1513 len = XINT (end) - s;
|
1211
|
1514
|
1029
|
1515 if (i->position != s)
|
|
1516 {
|
|
1517 /* No properties on this first interval -- return if
|
17467
|
1518 it covers the entire region. */
|
14088
|
1519 if (! interval_has_some_properties (properties, i))
|
1029
|
1520 {
|
|
1521 int got = (LENGTH (i) - (s - i->position));
|
|
1522 if (got >= len)
|
|
1523 return Qnil;
|
|
1524 len -= got;
|
3858
|
1525 i = next_interval (i);
|
1029
|
1526 }
|
3553
|
1527 /* Split away the beginning of this interval; what we don't
|
|
1528 want to modify. */
|
1029
|
1529 else
|
|
1530 {
|
|
1531 unchanged = i;
|
4144
|
1532 i = split_interval_right (unchanged, s - unchanged->position);
|
1029
|
1533 copy_properties (unchanged, i);
|
|
1534 }
|
|
1535 }
|
|
1536
|
16339
|
1537 if (BUFFERP (object))
|
|
1538 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
16331
|
1539
|
1029
|
1540 /* We are at the beginning of an interval, with len to scan */
|
2124
|
1541 for (;;)
|
1029
|
1542 {
|
1965
|
1543 if (i == 0)
|
|
1544 abort ();
|
|
1545
|
1029
|
1546 if (LENGTH (i) >= len)
|
|
1547 {
|
14088
|
1548 if (! interval_has_some_properties (properties, i))
|
1029
|
1549 return modified ? Qt : Qnil;
|
|
1550
|
|
1551 if (LENGTH (i) == len)
|
|
1552 {
|
44673
|
1553 remove_properties (properties, Qnil, i, object);
|
16339
|
1554 if (BUFFERP (object))
|
|
1555 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1556 XINT (end) - XINT (start));
|
1029
|
1557 return Qt;
|
|
1558 }
|
|
1559
|
|
1560 /* i has the properties, and goes past the change limit */
|
3553
|
1561 unchanged = i;
|
4144
|
1562 i = split_interval_left (i, len);
|
1029
|
1563 copy_properties (unchanged, i);
|
44673
|
1564 remove_properties (properties, Qnil, i, object);
|
16339
|
1565 if (BUFFERP (object))
|
|
1566 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1567 XINT (end) - XINT (start));
|
1029
|
1568 return Qt;
|
|
1569 }
|
|
1570
|
|
1571 len -= LENGTH (i);
|
44673
|
1572 modified += remove_properties (properties, Qnil, i, object);
|
|
1573 i = next_interval (i);
|
|
1574 }
|
|
1575 }
|
|
1576
|
|
1577 DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
|
|
1578 Sremove_list_of_text_properties, 3, 4, 0,
|
|
1579 doc: /* Remove some properties from text from START to END.
|
|
1580 The third argument LIST-OF-PROPERTIES is a list of property names to remove.
|
49247
|
1581 If the optional fourth argument OBJECT is a buffer (or nil, which means
|
|
1582 the current buffer), START and END are buffer positions (integers or
|
|
1583 markers). If OBJECT is a string, START and END are 0-based indices into it.
|
44673
|
1584 Return t if any property was actually removed, nil otherwise. */)
|
|
1585 (start, end, list_of_properties, object)
|
|
1586 Lisp_Object start, end, list_of_properties, object;
|
|
1587 {
|
|
1588 register INTERVAL i, unchanged;
|
|
1589 register int s, len, modified = 0;
|
|
1590 Lisp_Object properties;
|
|
1591 properties = list_of_properties;
|
|
1592
|
|
1593 if (NILP (object))
|
|
1594 XSETBUFFER (object, current_buffer);
|
|
1595
|
|
1596 i = validate_interval_range (object, &start, &end, soft);
|
|
1597 if (NULL_INTERVAL_P (i))
|
|
1598 return Qnil;
|
|
1599
|
|
1600 s = XINT (start);
|
|
1601 len = XINT (end) - s;
|
|
1602
|
|
1603 if (i->position != s)
|
|
1604 {
|
|
1605 /* No properties on this first interval -- return if
|
|
1606 it covers the entire region. */
|
|
1607 if (! interval_has_some_properties_list (properties, i))
|
|
1608 {
|
|
1609 int got = (LENGTH (i) - (s - i->position));
|
|
1610 if (got >= len)
|
|
1611 return Qnil;
|
|
1612 len -= got;
|
|
1613 i = next_interval (i);
|
|
1614 }
|
|
1615 /* Split away the beginning of this interval; what we don't
|
|
1616 want to modify. */
|
|
1617 else
|
|
1618 {
|
|
1619 unchanged = i;
|
|
1620 i = split_interval_right (unchanged, s - unchanged->position);
|
|
1621 copy_properties (unchanged, i);
|
|
1622 }
|
|
1623 }
|
|
1624
|
70129
|
1625 /* We are at the beginning of an interval, with len to scan.
|
|
1626 The flag `modified' records if changes have been made.
|
|
1627 When object is a buffer, we must call modify_region before changes are
|
|
1628 made and signal_after_change when we are done.
|
|
1629 We call modify_region before calling remove_properties iff modified == 0,
|
|
1630 and we call signal_after_change before returning iff modified != 0. */
|
44673
|
1631 for (;;)
|
|
1632 {
|
|
1633 if (i == 0)
|
|
1634 abort ();
|
|
1635
|
|
1636 if (LENGTH (i) >= len)
|
|
1637 {
|
|
1638 if (! interval_has_some_properties_list (properties, i))
|
70129
|
1639 if (modified)
|
|
1640 {
|
|
1641 if (BUFFERP (object))
|
|
1642 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1643 XINT (end) - XINT (start));
|
|
1644 return Qt;
|
|
1645 }
|
|
1646 else
|
|
1647 return Qnil;
|
44673
|
1648
|
|
1649 if (LENGTH (i) == len)
|
|
1650 {
|
70129
|
1651 if (!modified && BUFFERP (object))
|
|
1652 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
44673
|
1653 remove_properties (Qnil, properties, i, object);
|
|
1654 if (BUFFERP (object))
|
|
1655 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1656 XINT (end) - XINT (start));
|
|
1657 return Qt;
|
|
1658 }
|
|
1659
|
|
1660 /* i has the properties, and goes past the change limit */
|
|
1661 unchanged = i;
|
|
1662 i = split_interval_left (i, len);
|
|
1663 copy_properties (unchanged, i);
|
70129
|
1664 if (!modified && BUFFERP (object))
|
|
1665 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
44673
|
1666 remove_properties (Qnil, properties, i, object);
|
|
1667 if (BUFFERP (object))
|
|
1668 signal_after_change (XINT (start), XINT (end) - XINT (start),
|
|
1669 XINT (end) - XINT (start));
|
|
1670 return Qt;
|
|
1671 }
|
|
1672
|
70129
|
1673 if (interval_has_some_properties_list (properties, i))
|
|
1674 {
|
|
1675 if (!modified && BUFFERP (object))
|
|
1676 modify_region (XBUFFER (object), XINT (start), XINT (end));
|
|
1677 remove_properties (Qnil, properties, i, object);
|
|
1678 modified = 1;
|
|
1679 }
|
44673
|
1680 len -= LENGTH (i);
|
1029
|
1681 i = next_interval (i);
|
|
1682 }
|
|
1683 }
|
16679
|
1684
|
4144
|
1685 DEFUN ("text-property-any", Ftext_property_any,
|
|
1686 Stext_property_any, 4, 5, 0,
|
40123
|
1687 doc: /* Check text from START to END for property PROPERTY equalling VALUE.
|
|
1688 If so, return the position of the first character whose property PROPERTY
|
|
1689 is `eq' to VALUE. Otherwise return nil.
|
49247
|
1690 If the optional fifth argument OBJECT is a buffer (or nil, which means
|
|
1691 the current buffer), START and END are buffer positions (integers or
|
|
1692 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
|
40123
|
1693 (start, end, property, value, object)
|
|
1694 Lisp_Object start, end, property, value, object;
|
4144
|
1695 {
|
|
1696 register INTERVAL i;
|
|
1697 register int e, pos;
|
|
1698
|
|
1699 if (NILP (object))
|
9280
|
1700 XSETBUFFER (object, current_buffer);
|
4144
|
1701 i = validate_interval_range (object, &start, &end, soft);
|
10488
|
1702 if (NULL_INTERVAL_P (i))
|
|
1703 return (!NILP (value) || EQ (start, end) ? Qnil : start);
|
4144
|
1704 e = XINT (end);
|
|
1705
|
|
1706 while (! NULL_INTERVAL_P (i))
|
|
1707 {
|
|
1708 if (i->position >= e)
|
|
1709 break;
|
14088
|
1710 if (EQ (textget (i->plist, property), value))
|
4144
|
1711 {
|
|
1712 pos = i->position;
|
|
1713 if (pos < XINT (start))
|
|
1714 pos = XINT (start);
|
22344
|
1715 return make_number (pos);
|
4144
|
1716 }
|
|
1717 i = next_interval (i);
|
|
1718 }
|
|
1719 return Qnil;
|
|
1720 }
|
|
1721
|
|
1722 DEFUN ("text-property-not-all", Ftext_property_not_all,
|
|
1723 Stext_property_not_all, 4, 5, 0,
|
40123
|
1724 doc: /* Check text from START to END for property PROPERTY not equalling VALUE.
|
|
1725 If so, return the position of the first character whose property PROPERTY
|
|
1726 is not `eq' to VALUE. Otherwise, return nil.
|
49247
|
1727 If the optional fifth argument OBJECT is a buffer (or nil, which means
|
|
1728 the current buffer), START and END are buffer positions (integers or
|
|
1729 markers). If OBJECT is a string, START and END are 0-based indices into it. */)
|
40123
|
1730 (start, end, property, value, object)
|
|
1731 Lisp_Object start, end, property, value, object;
|
4144
|
1732 {
|
|
1733 register INTERVAL i;
|
|
1734 register int s, e;
|
|
1735
|
|
1736 if (NILP (object))
|
9280
|
1737 XSETBUFFER (object, current_buffer);
|
4144
|
1738 i = validate_interval_range (object, &start, &end, soft);
|
|
1739 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
|
1740 return (NILP (value) || EQ (start, end)) ? Qnil : start;
|
4144
|
1741 s = XINT (start);
|
|
1742 e = XINT (end);
|
|
1743
|
|
1744 while (! NULL_INTERVAL_P (i))
|
|
1745 {
|
|
1746 if (i->position >= e)
|
|
1747 break;
|
14088
|
1748 if (! EQ (textget (i->plist, property), value))
|
4144
|
1749 {
|
|
1750 if (i->position > s)
|
|
1751 s = i->position;
|
22344
|
1752 return make_number (s);
|
4144
|
1753 }
|
|
1754 i = next_interval (i);
|
|
1755 }
|
|
1756 return Qnil;
|
|
1757 }
|
43896
|
1758
|
|
1759
|
|
1760 /* Return the direction from which the text-property PROP would be
|
|
1761 inherited by any new text inserted at POS: 1 if it would be
|
|
1762 inherited from the char after POS, -1 if it would be inherited from
|
51041
|
1763 the char before POS, and 0 if from neither.
|
|
1764 BUFFER can be either a buffer or nil (meaning current buffer). */
|
43896
|
1765
|
|
1766 int
|
51041
|
1767 text_property_stickiness (prop, pos, buffer)
|
|
1768 Lisp_Object prop, pos, buffer;
|
43896
|
1769 {
|
|
1770 Lisp_Object prev_pos, front_sticky;
|
|
1771 int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
|
|
1772
|
51041
|
1773 if (NILP (buffer))
|
|
1774 XSETBUFFER (buffer, current_buffer);
|
|
1775
|
|
1776 if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
|
43896
|
1777 /* Consider previous character. */
|
|
1778 {
|
|
1779 Lisp_Object rear_non_sticky;
|
|
1780
|
|
1781 prev_pos = make_number (XINT (pos) - 1);
|
51041
|
1782 rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
|
43896
|
1783
|
|
1784 if (!NILP (CONSP (rear_non_sticky)
|
|
1785 ? Fmemq (prop, rear_non_sticky)
|
|
1786 : rear_non_sticky))
|
|
1787 /* PROP is rear-non-sticky. */
|
|
1788 is_rear_sticky = 0;
|
|
1789 }
|
|
1790
|
|
1791 /* Consider following character. */
|
51041
|
1792 front_sticky = Fget_text_property (pos, Qfront_sticky, buffer);
|
43896
|
1793
|
|
1794 if (EQ (front_sticky, Qt)
|
|
1795 || (CONSP (front_sticky)
|
|
1796 && !NILP (Fmemq (prop, front_sticky))))
|
|
1797 /* PROP is inherited from after. */
|
|
1798 is_front_sticky = 1;
|
|
1799
|
|
1800 /* Simple cases, where the properties are consistent. */
|
|
1801 if (is_rear_sticky && !is_front_sticky)
|
|
1802 return -1;
|
|
1803 else if (!is_rear_sticky && is_front_sticky)
|
|
1804 return 1;
|
|
1805 else if (!is_rear_sticky && !is_front_sticky)
|
|
1806 return 0;
|
|
1807
|
|
1808 /* The stickiness properties are inconsistent, so we have to
|
|
1809 disambiguate. Basically, rear-sticky wins, _except_ if the
|
|
1810 property that would be inherited has a value of nil, in which case
|
|
1811 front-sticky wins. */
|
51041
|
1812 if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
|
|
1813 || NILP (Fget_text_property (prev_pos, prop, buffer)))
|
43896
|
1814 return 1;
|
|
1815 else
|
|
1816 return -1;
|
|
1817 }
|
|
1818
|
16679
|
1819
|
4007
|
1820 /* I don't think this is the right interface to export; how often do you
|
|
1821 want to do something like this, other than when you're copying objects
|
|
1822 around?
|
|
1823
|
|
1824 I think it would be better to have a pair of functions, one which
|
|
1825 returns the text properties of a region as a list of ranges and
|
|
1826 plists, and another which applies such a list to another object. */
|
|
1827
|
10159
|
1828 /* Add properties from SRC to SRC of SRC, starting at POS in DEST.
|
|
1829 SRC and DEST may each refer to strings or buffers.
|
|
1830 Optional sixth argument PROP causes only that property to be copied.
|
|
1831 Properties are copied to DEST as if by `add-text-properties'.
|
|
1832 Return t if any property value actually changed, nil otherwise. */
|
|
1833
|
|
1834 /* Note this can GC when DEST is a buffer. */
|
22344
|
1835
|
4007
|
1836 Lisp_Object
|
|
1837 copy_text_properties (start, end, src, pos, dest, prop)
|
|
1838 Lisp_Object start, end, src, pos, dest, prop;
|
|
1839 {
|
|
1840 INTERVAL i;
|
|
1841 Lisp_Object res;
|
|
1842 Lisp_Object stuff;
|
|
1843 Lisp_Object plist;
|
|
1844 int s, e, e2, p, len, modified = 0;
|
10159
|
1845 struct gcpro gcpro1, gcpro2;
|
4007
|
1846
|
|
1847 i = validate_interval_range (src, &start, &end, soft);
|
|
1848 if (NULL_INTERVAL_P (i))
|
|
1849 return Qnil;
|
|
1850
|
40656
|
1851 CHECK_NUMBER_COERCE_MARKER (pos);
|
4007
|
1852 {
|
|
1853 Lisp_Object dest_start, dest_end;
|
|
1854
|
|
1855 dest_start = pos;
|
9321
|
1856 XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
|
4007
|
1857 /* Apply this to a copy of pos; it will try to increment its arguments,
|
|
1858 which we don't want. */
|
|
1859 validate_interval_range (dest, &dest_start, &dest_end, soft);
|
|
1860 }
|
|
1861
|
|
1862 s = XINT (start);
|
|
1863 e = XINT (end);
|
|
1864 p = XINT (pos);
|
|
1865
|
|
1866 stuff = Qnil;
|
|
1867
|
|
1868 while (s < e)
|
|
1869 {
|
|
1870 e2 = i->position + LENGTH (i);
|
|
1871 if (e2 > e)
|
|
1872 e2 = e;
|
|
1873 len = e2 - s;
|
|
1874
|
|
1875 plist = i->plist;
|
|
1876 if (! NILP (prop))
|
|
1877 while (! NILP (plist))
|
|
1878 {
|
|
1879 if (EQ (Fcar (plist), prop))
|
|
1880 {
|
|
1881 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
|
|
1882 break;
|
|
1883 }
|
|
1884 plist = Fcdr (Fcdr (plist));
|
|
1885 }
|
|
1886 if (! NILP (plist))
|
|
1887 {
|
|
1888 /* Must defer modifications to the interval tree in case src
|
17467
|
1889 and dest refer to the same string or buffer. */
|
4007
|
1890 stuff = Fcons (Fcons (make_number (p),
|
|
1891 Fcons (make_number (p + len),
|
|
1892 Fcons (plist, Qnil))),
|
|
1893 stuff);
|
|
1894 }
|
|
1895
|
|
1896 i = next_interval (i);
|
|
1897 if (NULL_INTERVAL_P (i))
|
|
1898 break;
|
|
1899
|
|
1900 p += len;
|
|
1901 s = i->position;
|
|
1902 }
|
|
1903
|
10159
|
1904 GCPRO2 (stuff, dest);
|
|
1905
|
4007
|
1906 while (! NILP (stuff))
|
|
1907 {
|
|
1908 res = Fcar (stuff);
|
|
1909 res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
|
|
1910 Fcar (Fcdr (Fcdr (res))), dest);
|
|
1911 if (! NILP (res))
|
|
1912 modified++;
|
|
1913 stuff = Fcdr (stuff);
|
|
1914 }
|
|
1915
|
10159
|
1916 UNGCPRO;
|
|
1917
|
4007
|
1918 return modified ? Qt : Qnil;
|
|
1919 }
|
25000
|
1920
|
|
1921
|
|
1922 /* Return a list representing the text properties of OBJECT between
|
|
1923 START and END. if PROP is non-nil, report only on that property.
|
|
1924 Each result list element has the form (S E PLIST), where S and E
|
|
1925 are positions in OBJECT and PLIST is a property list containing the
|
|
1926 text properties of OBJECT between S and E. Value is nil if OBJECT
|
|
1927 doesn't contain text properties between START and END. */
|
|
1928
|
|
1929 Lisp_Object
|
|
1930 text_property_list (object, start, end, prop)
|
|
1931 Lisp_Object object, start, end, prop;
|
|
1932 {
|
|
1933 struct interval *i;
|
|
1934 Lisp_Object result;
|
|
1935
|
|
1936 result = Qnil;
|
49247
|
1937
|
25000
|
1938 i = validate_interval_range (object, &start, &end, soft);
|
|
1939 if (!NULL_INTERVAL_P (i))
|
|
1940 {
|
|
1941 int s = XINT (start);
|
|
1942 int e = XINT (end);
|
49247
|
1943
|
25000
|
1944 while (s < e)
|
|
1945 {
|
|
1946 int interval_end, len;
|
|
1947 Lisp_Object plist;
|
49247
|
1948
|
25000
|
1949 interval_end = i->position + LENGTH (i);
|
|
1950 if (interval_end > e)
|
|
1951 interval_end = e;
|
|
1952 len = interval_end - s;
|
49247
|
1953
|
25000
|
1954 plist = i->plist;
|
|
1955
|
|
1956 if (!NILP (prop))
|
|
1957 for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
|
|
1958 if (EQ (Fcar (plist), prop))
|
|
1959 {
|
|
1960 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
|
|
1961 break;
|
|
1962 }
|
|
1963
|
|
1964 if (!NILP (plist))
|
|
1965 result = Fcons (Fcons (make_number (s),
|
|
1966 Fcons (make_number (s + len),
|
|
1967 Fcons (plist, Qnil))),
|
|
1968 result);
|
49247
|
1969
|
25000
|
1970 i = next_interval (i);
|
|
1971 if (NULL_INTERVAL_P (i))
|
|
1972 break;
|
|
1973 s = i->position;
|
|
1974 }
|
|
1975 }
|
49247
|
1976
|
25000
|
1977 return result;
|
|
1978 }
|
|
1979
|
|
1980
|
|
1981 /* Add text properties to OBJECT from LIST. LIST is a list of triples
|
|
1982 (START END PLIST), where START and END are positions and PLIST is a
|
|
1983 property list containing the text properties to add. Adjust START
|
|
1984 and END positions by DELTA before adding properties. Value is
|
|
1985 non-zero if OBJECT was modified. */
|
|
1986
|
|
1987 int
|
|
1988 add_text_properties_from_list (object, list, delta)
|
|
1989 Lisp_Object object, list, delta;
|
|
1990 {
|
|
1991 struct gcpro gcpro1, gcpro2;
|
|
1992 int modified_p = 0;
|
49247
|
1993
|
25000
|
1994 GCPRO2 (list, object);
|
49247
|
1995
|
25000
|
1996 for (; CONSP (list); list = XCDR (list))
|
|
1997 {
|
|
1998 Lisp_Object item, start, end, plist, tem;
|
49247
|
1999
|
25000
|
2000 item = XCAR (list);
|
|
2001 start = make_number (XINT (XCAR (item)) + XINT (delta));
|
|
2002 end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
|
|
2003 plist = XCAR (XCDR (XCDR (item)));
|
49247
|
2004
|
25000
|
2005 tem = Fadd_text_properties (start, end, plist, object);
|
|
2006 if (!NILP (tem))
|
|
2007 modified_p = 1;
|
|
2008 }
|
|
2009
|
|
2010 UNGCPRO;
|
|
2011 return modified_p;
|
|
2012 }
|
|
2013
|
|
2014
|
|
2015
|
|
2016 /* Modify end-points of ranges in LIST destructively. LIST is a list
|
|
2017 as returned from text_property_list. Change end-points equal to
|
|
2018 OLD_END to NEW_END. */
|
|
2019
|
|
2020 void
|
|
2021 extend_property_ranges (list, old_end, new_end)
|
|
2022 Lisp_Object list, old_end, new_end;
|
|
2023 {
|
|
2024 for (; CONSP (list); list = XCDR (list))
|
|
2025 {
|
|
2026 Lisp_Object item, end;
|
49247
|
2027
|
25000
|
2028 item = XCAR (list);
|
|
2029 end = XCAR (XCDR (item));
|
|
2030
|
|
2031 if (EQ (end, old_end))
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2032 XSETCAR (XCDR (item), new_end);
|
25000
|
2033 }
|
|
2034 }
|
|
2035
|
|
2036
|
13027
|
2037
|
|
2038 /* Call the modification hook functions in LIST, each with START and END. */
|
4007
|
2039
|
13027
|
2040 static void
|
|
2041 call_mod_hooks (list, start, end)
|
|
2042 Lisp_Object list, start, end;
|
|
2043 {
|
|
2044 struct gcpro gcpro1;
|
|
2045 GCPRO1 (list);
|
|
2046 while (!NILP (list))
|
|
2047 {
|
|
2048 call2 (Fcar (list), start, end);
|
|
2049 list = Fcdr (list);
|
|
2050 }
|
|
2051 UNGCPRO;
|
|
2052 }
|
|
2053
|
20522
|
2054 /* Check for read-only intervals between character positions START ... END,
|
|
2055 in BUF, and signal an error if we find one.
|
|
2056
|
|
2057 Then check for any modification hooks in the range.
|
|
2058 Create a list of all these hooks in lexicographic order,
|
|
2059 eliminating consecutive extra copies of the same hook. Then call
|
|
2060 those hooks in order, with START and END - 1 as arguments. */
|
13027
|
2061
|
|
2062 void
|
|
2063 verify_interval_modification (buf, start, end)
|
|
2064 struct buffer *buf;
|
|
2065 int start, end;
|
|
2066 {
|
|
2067 register INTERVAL intervals = BUF_INTERVALS (buf);
|
25772
|
2068 register INTERVAL i;
|
13027
|
2069 Lisp_Object hooks;
|
|
2070 register Lisp_Object prev_mod_hooks;
|
|
2071 Lisp_Object mod_hooks;
|
|
2072 struct gcpro gcpro1;
|
|
2073
|
|
2074 hooks = Qnil;
|
|
2075 prev_mod_hooks = Qnil;
|
|
2076 mod_hooks = Qnil;
|
|
2077
|
|
2078 interval_insert_behind_hooks = Qnil;
|
|
2079 interval_insert_in_front_hooks = Qnil;
|
|
2080
|
|
2081 if (NULL_INTERVAL_P (intervals))
|
|
2082 return;
|
|
2083
|
|
2084 if (start > end)
|
|
2085 {
|
|
2086 int temp = start;
|
|
2087 start = end;
|
|
2088 end = temp;
|
|
2089 }
|
|
2090
|
|
2091 /* For an insert operation, check the two chars around the position. */
|
|
2092 if (start == end)
|
|
2093 {
|
33952
|
2094 INTERVAL prev = NULL;
|
13027
|
2095 Lisp_Object before, after;
|
|
2096
|
|
2097 /* Set I to the interval containing the char after START,
|
|
2098 and PREV to the interval containing the char before START.
|
|
2099 Either one may be null. They may be equal. */
|
|
2100 i = find_interval (intervals, start);
|
|
2101
|
|
2102 if (start == BUF_BEGV (buf))
|
|
2103 prev = 0;
|
|
2104 else if (i->position == start)
|
|
2105 prev = previous_interval (i);
|
|
2106 else if (i->position < start)
|
|
2107 prev = i;
|
|
2108 if (start == BUF_ZV (buf))
|
|
2109 i = 0;
|
|
2110
|
|
2111 /* If Vinhibit_read_only is set and is not a list, we can
|
|
2112 skip the read_only checks. */
|
|
2113 if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
|
|
2114 {
|
|
2115 /* If I and PREV differ we need to check for the read-only
|
17467
|
2116 property together with its stickiness. If either I or
|
13027
|
2117 PREV are 0, this check is all we need.
|
|
2118 We have to take special care, since read-only may be
|
|
2119 indirectly defined via the category property. */
|
|
2120 if (i != prev)
|
|
2121 {
|
|
2122 if (! NULL_INTERVAL_P (i))
|
|
2123 {
|
|
2124 after = textget (i->plist, Qread_only);
|
49247
|
2125
|
13027
|
2126 /* If interval I is read-only and read-only is
|
|
2127 front-sticky, inhibit insertion.
|
|
2128 Check for read-only as well as category. */
|
|
2129 if (! NILP (after)
|
|
2130 && NILP (Fmemq (after, Vinhibit_read_only)))
|
|
2131 {
|
|
2132 Lisp_Object tem;
|
|
2133
|
|
2134 tem = textget (i->plist, Qfront_sticky);
|
|
2135 if (TMEM (Qread_only, tem)
|
|
2136 || (NILP (Fplist_get (i->plist, Qread_only))
|
|
2137 && TMEM (Qcategory, tem)))
|
48840
|
2138 text_read_only (after);
|
13027
|
2139 }
|
|
2140 }
|
|
2141
|
|
2142 if (! NULL_INTERVAL_P (prev))
|
|
2143 {
|
|
2144 before = textget (prev->plist, Qread_only);
|
49247
|
2145
|
13027
|
2146 /* If interval PREV is read-only and read-only isn't
|
|
2147 rear-nonsticky, inhibit insertion.
|
|
2148 Check for read-only as well as category. */
|
|
2149 if (! NILP (before)
|
|
2150 && NILP (Fmemq (before, Vinhibit_read_only)))
|
|
2151 {
|
|
2152 Lisp_Object tem;
|
|
2153
|
|
2154 tem = textget (prev->plist, Qrear_nonsticky);
|
|
2155 if (! TMEM (Qread_only, tem)
|
|
2156 && (! NILP (Fplist_get (prev->plist,Qread_only))
|
|
2157 || ! TMEM (Qcategory, tem)))
|
48840
|
2158 text_read_only (before);
|
13027
|
2159 }
|
|
2160 }
|
|
2161 }
|
|
2162 else if (! NULL_INTERVAL_P (i))
|
|
2163 {
|
|
2164 after = textget (i->plist, Qread_only);
|
49247
|
2165
|
13027
|
2166 /* If interval I is read-only and read-only is
|
|
2167 front-sticky, inhibit insertion.
|
|
2168 Check for read-only as well as category. */
|
|
2169 if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
|
|
2170 {
|
|
2171 Lisp_Object tem;
|
|
2172
|
|
2173 tem = textget (i->plist, Qfront_sticky);
|
|
2174 if (TMEM (Qread_only, tem)
|
|
2175 || (NILP (Fplist_get (i->plist, Qread_only))
|
|
2176 && TMEM (Qcategory, tem)))
|
48840
|
2177 text_read_only (after);
|
13027
|
2178
|
|
2179 tem = textget (prev->plist, Qrear_nonsticky);
|
|
2180 if (! TMEM (Qread_only, tem)
|
|
2181 && (! NILP (Fplist_get (prev->plist, Qread_only))
|
|
2182 || ! TMEM (Qcategory, tem)))
|
48840
|
2183 text_read_only (after);
|
13027
|
2184 }
|
|
2185 }
|
|
2186 }
|
|
2187
|
|
2188 /* Run both insert hooks (just once if they're the same). */
|
|
2189 if (!NULL_INTERVAL_P (prev))
|
|
2190 interval_insert_behind_hooks
|
|
2191 = textget (prev->plist, Qinsert_behind_hooks);
|
|
2192 if (!NULL_INTERVAL_P (i))
|
|
2193 interval_insert_in_front_hooks
|
|
2194 = textget (i->plist, Qinsert_in_front_hooks);
|
|
2195 }
|
39247
|
2196 else
|
13027
|
2197 {
|
|
2198 /* Loop over intervals on or next to START...END,
|
|
2199 collecting their hooks. */
|
|
2200
|
|
2201 i = find_interval (intervals, start);
|
|
2202 do
|
|
2203 {
|
|
2204 if (! INTERVAL_WRITABLE_P (i))
|
48840
|
2205 text_read_only (textget (i->plist, Qread_only));
|
13027
|
2206
|
39247
|
2207 if (!inhibit_modification_hooks)
|
13027
|
2208 {
|
39247
|
2209 mod_hooks = textget (i->plist, Qmodification_hooks);
|
|
2210 if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
|
|
2211 {
|
|
2212 hooks = Fcons (mod_hooks, hooks);
|
|
2213 prev_mod_hooks = mod_hooks;
|
|
2214 }
|
13027
|
2215 }
|
|
2216
|
|
2217 i = next_interval (i);
|
|
2218 }
|
|
2219 /* Keep going thru the interval containing the char before END. */
|
|
2220 while (! NULL_INTERVAL_P (i) && i->position < end);
|
|
2221
|
39247
|
2222 if (!inhibit_modification_hooks)
|
13027
|
2223 {
|
39247
|
2224 GCPRO1 (hooks);
|
|
2225 hooks = Fnreverse (hooks);
|
|
2226 while (! EQ (hooks, Qnil))
|
|
2227 {
|
|
2228 call_mod_hooks (Fcar (hooks), make_number (start),
|
|
2229 make_number (end));
|
|
2230 hooks = Fcdr (hooks);
|
|
2231 }
|
|
2232 UNGCPRO;
|
13027
|
2233 }
|
|
2234 }
|
|
2235 }
|
|
2236
|
20522
|
2237 /* Run the interval hooks for an insertion on character range START ... END.
|
13027
|
2238 verify_interval_modification chose which hooks to run;
|
|
2239 this function is called after the insertion happens
|
|
2240 so it can indicate the range of inserted text. */
|
|
2241
|
|
2242 void
|
|
2243 report_interval_modification (start, end)
|
|
2244 Lisp_Object start, end;
|
|
2245 {
|
|
2246 if (! NILP (interval_insert_behind_hooks))
|
18613
|
2247 call_mod_hooks (interval_insert_behind_hooks, start, end);
|
13027
|
2248 if (! NILP (interval_insert_in_front_hooks)
|
|
2249 && ! EQ (interval_insert_in_front_hooks,
|
|
2250 interval_insert_behind_hooks))
|
18613
|
2251 call_mod_hooks (interval_insert_in_front_hooks, start, end);
|
13027
|
2252 }
|
|
2253
|
1029
|
2254 void
|
|
2255 syms_of_textprop ()
|
|
2256 {
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
2257 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties,
|
40123
|
2258 doc: /* Property-list used as default values.
|
|
2259 The value of a property in this list is seen as the value for every
|
|
2260 character that does not have its own value for that property. */);
|
11131
5db8a01b22cb
(Vdefault_text_properties): name changed from Vdefault_properties.
Boris Goldowsky <boris@gnu.org>
diff
changeset
|
2261 Vdefault_text_properties = Qnil;
|
10925
|
2262
|
45680
|
2263 DEFVAR_LISP ("char-property-alias-alist", &Vchar_property_alias_alist,
|
|
2264 doc: /* Alist of alternative properties for properties without a value.
|
|
2265 Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...).
|
|
2266 If a piece of text has no direct value for a particular property, then
|
|
2267 this alist is consulted. If that property appears in the alist, then
|
|
2268 the first non-nil value from the associated alternative properties is
|
|
2269 returned. */);
|
|
2270 Vchar_property_alias_alist = Qnil;
|
|
2271
|
4242
49007dbbec4c
(syms_of_textprop): Set up Lisp var Vinhibit_point_motion_hooks.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2272 DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
|
40123
|
2273 doc: /* If non-nil, don't run `point-left' and `point-entered' text properties.
|
|
2274 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
|
2275 Vinhibit_point_motion_hooks = Qnil;
|
13027
|
2276
|
26872
|
2277 DEFVAR_LISP ("text-property-default-nonsticky",
|
|
2278 &Vtext_property_default_nonsticky,
|
40123
|
2279 doc: /* Alist of properties vs the corresponding non-stickinesses.
|
|
2280 Each element has the form (PROPERTY . NONSTICKINESS).
|
|
2281
|
|
2282 If a character in a buffer has PROPERTY, new text inserted adjacent to
|
|
2283 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
|
|
2284 inherits it if NONSTICKINESS is nil. The front-sticky and
|
|
2285 rear-nonsticky properties of the character overrides NONSTICKINESS. */);
|
57477
c4f6faab46b0
(syms_of_textprop): Add `syntax-table' to the nonsticky props.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2286 /* Text property `syntax-table' should be nonsticky by default. */
|
c4f6faab46b0
(syms_of_textprop): Add `syntax-table' to the nonsticky props.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2287 Vtext_property_default_nonsticky
|
c4f6faab46b0
(syms_of_textprop): Add `syntax-table' to the nonsticky props.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2288 = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil);
|
26872
|
2289
|
13027
|
2290 staticpro (&interval_insert_behind_hooks);
|
|
2291 staticpro (&interval_insert_in_front_hooks);
|
|
2292 interval_insert_behind_hooks = Qnil;
|
|
2293 interval_insert_in_front_hooks = Qnil;
|
|
2294
|
49247
|
2295
|
1029
|
2296 /* Common attributes one might give text */
|
|
2297
|
|
2298 staticpro (&Qforeground);
|
|
2299 Qforeground = intern ("foreground");
|
|
2300 staticpro (&Qbackground);
|
|
2301 Qbackground = intern ("background");
|
|
2302 staticpro (&Qfont);
|
|
2303 Qfont = intern ("font");
|
|
2304 staticpro (&Qstipple);
|
|
2305 Qstipple = intern ("stipple");
|
|
2306 staticpro (&Qunderline);
|
|
2307 Qunderline = intern ("underline");
|
|
2308 staticpro (&Qread_only);
|
|
2309 Qread_only = intern ("read-only");
|
|
2310 staticpro (&Qinvisible);
|
|
2311 Qinvisible = intern ("invisible");
|
6755
|
2312 staticpro (&Qintangible);
|
|
2313 Qintangible = intern ("intangible");
|
2058
|
2314 staticpro (&Qcategory);
|
|
2315 Qcategory = intern ("category");
|
|
2316 staticpro (&Qlocal_map);
|
|
2317 Qlocal_map = intern ("local-map");
|
4381
|
2318 staticpro (&Qfront_sticky);
|
|
2319 Qfront_sticky = intern ("front-sticky");
|
|
2320 staticpro (&Qrear_nonsticky);
|
|
2321 Qrear_nonsticky = intern ("rear-nonsticky");
|
23729
|
2322 staticpro (&Qmouse_face);
|
|
2323 Qmouse_face = intern ("mouse-face");
|
1029
|
2324
|
|
2325 /* Properties that text might use to specify certain actions */
|
|
2326
|
|
2327 staticpro (&Qmouse_left);
|
|
2328 Qmouse_left = intern ("mouse-left");
|
|
2329 staticpro (&Qmouse_entered);
|
|
2330 Qmouse_entered = intern ("mouse-entered");
|
|
2331 staticpro (&Qpoint_left);
|
|
2332 Qpoint_left = intern ("point-left");
|
|
2333 staticpro (&Qpoint_entered);
|
|
2334 Qpoint_entered = intern ("point-entered");
|
|
2335
|
|
2336 defsubr (&Stext_properties_at);
|
1857
|
2337 defsubr (&Sget_text_property);
|
7582
|
2338 defsubr (&Sget_char_property);
|
53201
|
2339 defsubr (&Sget_char_property_and_overlay);
|
16679
|
2340 defsubr (&Snext_char_property_change);
|
|
2341 defsubr (&Sprevious_char_property_change);
|
30242
|
2342 defsubr (&Snext_single_char_property_change);
|
|
2343 defsubr (&Sprevious_single_char_property_change);
|
1029
|
2344 defsubr (&Snext_property_change);
|
1211
|
2345 defsubr (&Snext_single_property_change);
|
1029
|
2346 defsubr (&Sprevious_property_change);
|
1211
|
2347 defsubr (&Sprevious_single_property_change);
|
1029
|
2348 defsubr (&Sadd_text_properties);
|
1965
|
2349 defsubr (&Sput_text_property);
|
1029
|
2350 defsubr (&Sset_text_properties);
|
|
2351 defsubr (&Sremove_text_properties);
|
44673
|
2352 defsubr (&Sremove_list_of_text_properties);
|
4144
|
2353 defsubr (&Stext_property_any);
|
|
2354 defsubr (&Stext_property_not_all);
|
1857
|
2355 /* defsubr (&Serase_text_properties); */
|
4007
|
2356 /* defsubr (&Scopy_text_properties); */
|
1029
|
2357 }
|
52401
|
2358
|
|
2359 /* arch-tag: 454cdde8-5f86-4faa-a078-101e3625d479
|
|
2360 (do not change this comment) */
|