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