20537
|
1 /* Markers: examining, setting and deleting.
|
94963
|
2 Copyright (C) 1985, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006,
|
100951
|
3 2007, 2008, 2009 Free Software Foundation, Inc.
|
118
|
4
|
|
5 This file is part of GNU Emacs.
|
|
6
|
94963
|
7 GNU Emacs is free software: you can redistribute it and/or modify
|
118
|
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.
|
118
|
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/>. */
|
118
|
19
|
|
20
|
4696
|
21 #include <config.h>
|
118
|
22 #include "lisp.h"
|
|
23 #include "buffer.h"
|
88351
|
24 #include "character.h"
|
118
|
25
|
20537
|
26 /* Record one cached position found recently by
|
|
27 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
|
|
28
|
|
29 static int cached_charpos;
|
|
30 static int cached_bytepos;
|
|
31 static struct buffer *cached_buffer;
|
|
32 static int cached_modiff;
|
20678
|
33
|
31830
|
34 static void byte_char_debug_check P_ ((struct buffer *, int, int));
|
|
35
|
20872
|
36 /* Nonzero means enable debugging checks on byte/char correspondences. */
|
|
37
|
|
38 static int byte_debug_flag;
|
|
39
|
21514
|
40 void
|
20678
|
41 clear_charpos_cache (b)
|
|
42 struct buffer *b;
|
|
43 {
|
|
44 if (cached_buffer == b)
|
|
45 cached_buffer = 0;
|
|
46 }
|
20537
|
47
|
|
48 /* Converting between character positions and byte positions. */
|
|
49
|
|
50 /* There are several places in the buffer where we know
|
44651
|
51 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
|
20537
|
52 and everywhere there is a marker. So we find the one of these places
|
|
53 that is closest to the specified position, and scan from there. */
|
|
54
|
|
55 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
|
|
56
|
|
57 /* This macro is a subroutine of charpos_to_bytepos.
|
|
58 Note that it is desirable that BYTEPOS is not evaluated
|
|
59 except when we really want its value. */
|
|
60
|
|
61 #define CONSIDER(CHARPOS, BYTEPOS) \
|
|
62 { \
|
|
63 int this_charpos = (CHARPOS); \
|
|
64 int changed = 0; \
|
|
65 \
|
|
66 if (this_charpos == charpos) \
|
20872
|
67 { \
|
|
68 int value = (BYTEPOS); \
|
|
69 if (byte_debug_flag) \
|
|
70 byte_char_debug_check (b, charpos, value); \
|
|
71 return value; \
|
|
72 } \
|
20537
|
73 else if (this_charpos > charpos) \
|
|
74 { \
|
|
75 if (this_charpos < best_above) \
|
|
76 { \
|
|
77 best_above = this_charpos; \
|
|
78 best_above_byte = (BYTEPOS); \
|
|
79 changed = 1; \
|
|
80 } \
|
|
81 } \
|
|
82 else if (this_charpos > best_below) \
|
|
83 { \
|
|
84 best_below = this_charpos; \
|
|
85 best_below_byte = (BYTEPOS); \
|
|
86 changed = 1; \
|
|
87 } \
|
|
88 \
|
|
89 if (changed) \
|
|
90 { \
|
|
91 if (best_above - best_below == best_above_byte - best_below_byte) \
|
20872
|
92 { \
|
|
93 int value = best_below_byte + (charpos - best_below); \
|
|
94 if (byte_debug_flag) \
|
|
95 byte_char_debug_check (b, charpos, value); \
|
|
96 return value; \
|
|
97 } \
|
20537
|
98 } \
|
|
99 }
|
|
100
|
31830
|
101 static void
|
20872
|
102 byte_char_debug_check (b, charpos, bytepos)
|
|
103 struct buffer *b;
|
|
104 int charpos, bytepos;
|
|
105 {
|
|
106 int nchars = 0;
|
|
107
|
|
108 if (bytepos > BUF_GPT_BYTE (b))
|
|
109 {
|
21219
|
110 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
|
|
111 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
|
|
112 nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
|
|
113 bytepos - BUF_GPT_BYTE (b));
|
20872
|
114 }
|
|
115 else
|
21219
|
116 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
|
|
117 bytepos - BUF_BEG_BYTE (b));
|
20872
|
118
|
|
119 if (charpos - 1 != nchars)
|
|
120 abort ();
|
|
121 }
|
|
122
|
|
123 int
|
20537
|
124 charpos_to_bytepos (charpos)
|
|
125 int charpos;
|
|
126 {
|
|
127 return buf_charpos_to_bytepos (current_buffer, charpos);
|
|
128 }
|
|
129
|
|
130 int
|
|
131 buf_charpos_to_bytepos (b, charpos)
|
|
132 struct buffer *b;
|
|
133 int charpos;
|
|
134 {
|
51672
|
135 struct Lisp_Marker *tail;
|
20537
|
136 int best_above, best_above_byte;
|
|
137 int best_below, best_below_byte;
|
|
138
|
|
139 if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
|
|
140 abort ();
|
|
141
|
|
142 best_above = BUF_Z (b);
|
|
143 best_above_byte = BUF_Z_BYTE (b);
|
|
144
|
|
145 /* If this buffer has as many characters as bytes,
|
|
146 each character must be one byte.
|
|
147 This takes care of the case where enable-multibyte-characters is nil. */
|
|
148 if (best_above == best_above_byte)
|
|
149 return charpos;
|
|
150
|
44328
ed296e71aa64
(buf_charpos_to_bytepos, buf_bytepos_to_charpos): Use BEG and BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
151 best_below = BEG;
|
ed296e71aa64
(buf_charpos_to_bytepos, buf_bytepos_to_charpos): Use BEG and BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
152 best_below_byte = BEG_BYTE;
|
20537
|
153
|
|
154 /* We find in best_above and best_above_byte
|
|
155 the closest known point above CHARPOS,
|
|
156 and in best_below and best_below_byte
|
|
157 the closest known point below CHARPOS,
|
|
158
|
|
159 If at any point we can tell that the space between those
|
|
160 two best approximations is all single-byte,
|
|
161 we interpolate the result immediately. */
|
|
162
|
|
163 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
|
|
164 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
|
|
165 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
|
|
166 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
|
|
167
|
|
168 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
|
|
169 CONSIDER (cached_charpos, cached_bytepos);
|
|
170
|
51672
|
171 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
|
20537
|
172 {
|
51672
|
173 CONSIDER (tail->charpos, tail->bytepos);
|
20537
|
174
|
|
175 /* If we are down to a range of 50 chars,
|
|
176 don't bother checking any other markers;
|
|
177 scan the intervening chars directly now. */
|
|
178 if (best_above - best_below < 50)
|
|
179 break;
|
|
180 }
|
|
181
|
|
182 /* We get here if we did not exactly hit one of the known places.
|
|
183 We have one known above and one known below.
|
|
184 Scan, counting characters, from whichever one is closer. */
|
|
185
|
|
186 if (charpos - best_below < best_above - charpos)
|
|
187 {
|
|
188 int record = charpos - best_below > 5000;
|
|
189
|
|
190 while (best_below != charpos)
|
|
191 {
|
|
192 best_below++;
|
|
193 BUF_INC_POS (b, best_below_byte);
|
|
194 }
|
|
195
|
|
196 /* If this position is quite far from the nearest known position,
|
|
197 cache the correspondence by creating a marker here.
|
|
198 It will last until the next GC. */
|
|
199 if (record)
|
|
200 {
|
21497
|
201 Lisp_Object marker, buffer;
|
20537
|
202 marker = Fmake_marker ();
|
21497
|
203 XSETBUFFER (buffer, b);
|
|
204 set_marker_both (marker, buffer, best_below, best_below_byte);
|
20537
|
205 }
|
|
206
|
20872
|
207 if (byte_debug_flag)
|
|
208 byte_char_debug_check (b, charpos, best_below_byte);
|
|
209
|
20537
|
210 cached_buffer = b;
|
|
211 cached_modiff = BUF_MODIFF (b);
|
|
212 cached_charpos = best_below;
|
|
213 cached_bytepos = best_below_byte;
|
|
214
|
|
215 return best_below_byte;
|
|
216 }
|
|
217 else
|
|
218 {
|
|
219 int record = best_above - charpos > 5000;
|
|
220
|
|
221 while (best_above != charpos)
|
|
222 {
|
|
223 best_above--;
|
|
224 BUF_DEC_POS (b, best_above_byte);
|
|
225 }
|
|
226
|
|
227 /* If this position is quite far from the nearest known position,
|
|
228 cache the correspondence by creating a marker here.
|
|
229 It will last until the next GC. */
|
|
230 if (record)
|
|
231 {
|
21497
|
232 Lisp_Object marker, buffer;
|
20537
|
233 marker = Fmake_marker ();
|
21497
|
234 XSETBUFFER (buffer, b);
|
|
235 set_marker_both (marker, buffer, best_above, best_above_byte);
|
20537
|
236 }
|
|
237
|
20872
|
238 if (byte_debug_flag)
|
|
239 byte_char_debug_check (b, charpos, best_above_byte);
|
|
240
|
20537
|
241 cached_buffer = b;
|
|
242 cached_modiff = BUF_MODIFF (b);
|
|
243 cached_charpos = best_above;
|
|
244 cached_bytepos = best_above_byte;
|
|
245
|
|
246 return best_above_byte;
|
|
247 }
|
|
248 }
|
|
249
|
|
250 #undef CONSIDER
|
50472
|
251
|
|
252 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
|
|
253 in the simplest, most reliable way. */
|
|
254
|
|
255 int
|
|
256 verify_bytepos (charpos)
|
65713
|
257 int charpos;
|
50472
|
258 {
|
|
259 int below = 1;
|
|
260 int below_byte = 1;
|
|
261
|
|
262 while (below != charpos)
|
|
263 {
|
|
264 below++;
|
|
265 BUF_INC_POS (current_buffer, below_byte);
|
|
266 }
|
|
267
|
|
268 return below_byte;
|
|
269 }
|
20537
|
270
|
|
271 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
|
|
272
|
|
273 /* This macro is a subroutine of bytepos_to_charpos.
|
|
274 It is used when BYTEPOS is actually the byte position. */
|
|
275
|
|
276 #define CONSIDER(BYTEPOS, CHARPOS) \
|
|
277 { \
|
|
278 int this_bytepos = (BYTEPOS); \
|
|
279 int changed = 0; \
|
|
280 \
|
|
281 if (this_bytepos == bytepos) \
|
20872
|
282 { \
|
|
283 int value = (CHARPOS); \
|
|
284 if (byte_debug_flag) \
|
|
285 byte_char_debug_check (b, value, bytepos); \
|
|
286 return value; \
|
|
287 } \
|
20537
|
288 else if (this_bytepos > bytepos) \
|
|
289 { \
|
|
290 if (this_bytepos < best_above_byte) \
|
|
291 { \
|
|
292 best_above = (CHARPOS); \
|
|
293 best_above_byte = this_bytepos; \
|
|
294 changed = 1; \
|
|
295 } \
|
|
296 } \
|
|
297 else if (this_bytepos > best_below_byte) \
|
|
298 { \
|
|
299 best_below = (CHARPOS); \
|
|
300 best_below_byte = this_bytepos; \
|
|
301 changed = 1; \
|
|
302 } \
|
|
303 \
|
|
304 if (changed) \
|
|
305 { \
|
|
306 if (best_above - best_below == best_above_byte - best_below_byte) \
|
20872
|
307 { \
|
|
308 int value = best_below + (bytepos - best_below_byte); \
|
|
309 if (byte_debug_flag) \
|
|
310 byte_char_debug_check (b, value, bytepos); \
|
|
311 return value; \
|
|
312 } \
|
20537
|
313 } \
|
|
314 }
|
|
315
|
|
316 int
|
|
317 bytepos_to_charpos (bytepos)
|
|
318 int bytepos;
|
|
319 {
|
|
320 return buf_bytepos_to_charpos (current_buffer, bytepos);
|
|
321 }
|
|
322
|
|
323 int
|
|
324 buf_bytepos_to_charpos (b, bytepos)
|
|
325 struct buffer *b;
|
|
326 int bytepos;
|
|
327 {
|
51672
|
328 struct Lisp_Marker *tail;
|
20537
|
329 int best_above, best_above_byte;
|
|
330 int best_below, best_below_byte;
|
|
331
|
|
332 if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
|
|
333 abort ();
|
|
334
|
|
335 best_above = BUF_Z (b);
|
|
336 best_above_byte = BUF_Z_BYTE (b);
|
|
337
|
|
338 /* If this buffer has as many characters as bytes,
|
|
339 each character must be one byte.
|
|
340 This takes care of the case where enable-multibyte-characters is nil. */
|
|
341 if (best_above == best_above_byte)
|
|
342 return bytepos;
|
|
343
|
44328
ed296e71aa64
(buf_charpos_to_bytepos, buf_bytepos_to_charpos): Use BEG and BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
344 best_below = BEG;
|
ed296e71aa64
(buf_charpos_to_bytepos, buf_bytepos_to_charpos): Use BEG and BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
345 best_below_byte = BEG_BYTE;
|
20537
|
346
|
|
347 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
|
|
348 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
|
|
349 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
|
|
350 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
|
|
351
|
|
352 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
|
|
353 CONSIDER (cached_bytepos, cached_charpos);
|
|
354
|
51672
|
355 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
|
20537
|
356 {
|
51672
|
357 CONSIDER (tail->bytepos, tail->charpos);
|
20537
|
358
|
|
359 /* If we are down to a range of 50 chars,
|
|
360 don't bother checking any other markers;
|
|
361 scan the intervening chars directly now. */
|
|
362 if (best_above - best_below < 50)
|
|
363 break;
|
|
364 }
|
|
365
|
|
366 /* We get here if we did not exactly hit one of the known places.
|
|
367 We have one known above and one known below.
|
|
368 Scan, counting characters, from whichever one is closer. */
|
|
369
|
|
370 if (bytepos - best_below_byte < best_above_byte - bytepos)
|
|
371 {
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
372 int record = bytepos - best_below_byte > 5000;
|
20537
|
373
|
|
374 while (best_below_byte < bytepos)
|
|
375 {
|
|
376 best_below++;
|
|
377 BUF_INC_POS (b, best_below_byte);
|
|
378 }
|
|
379
|
|
380 /* If this position is quite far from the nearest known position,
|
|
381 cache the correspondence by creating a marker here.
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
382 It will last until the next GC.
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
383 But don't do it if BUF_MARKERS is nil;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
384 that is a signal from Fset_buffer_multibyte. */
|
51672
|
385 if (record && BUF_MARKERS (b))
|
20537
|
386 {
|
21497
|
387 Lisp_Object marker, buffer;
|
20537
|
388 marker = Fmake_marker ();
|
21497
|
389 XSETBUFFER (buffer, b);
|
|
390 set_marker_both (marker, buffer, best_below, best_below_byte);
|
20537
|
391 }
|
|
392
|
20872
|
393 if (byte_debug_flag)
|
|
394 byte_char_debug_check (b, best_below, bytepos);
|
|
395
|
20537
|
396 cached_buffer = b;
|
|
397 cached_modiff = BUF_MODIFF (b);
|
|
398 cached_charpos = best_below;
|
|
399 cached_bytepos = best_below_byte;
|
|
400
|
|
401 return best_below;
|
|
402 }
|
|
403 else
|
|
404 {
|
|
405 int record = best_above_byte - bytepos > 5000;
|
|
406
|
|
407 while (best_above_byte > bytepos)
|
|
408 {
|
|
409 best_above--;
|
|
410 BUF_DEC_POS (b, best_above_byte);
|
|
411 }
|
|
412
|
|
413 /* If this position is quite far from the nearest known position,
|
|
414 cache the correspondence by creating a marker here.
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
415 It will last until the next GC.
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
416 But don't do it if BUF_MARKERS is nil;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
417 that is a signal from Fset_buffer_multibyte. */
|
51672
|
418 if (record && BUF_MARKERS (b))
|
20537
|
419 {
|
21497
|
420 Lisp_Object marker, buffer;
|
20537
|
421 marker = Fmake_marker ();
|
21497
|
422 XSETBUFFER (buffer, b);
|
|
423 set_marker_both (marker, buffer, best_above, best_above_byte);
|
20537
|
424 }
|
|
425
|
20872
|
426 if (byte_debug_flag)
|
|
427 byte_char_debug_check (b, best_above, bytepos);
|
|
428
|
20537
|
429 cached_buffer = b;
|
|
430 cached_modiff = BUF_MODIFF (b);
|
|
431 cached_charpos = best_above;
|
|
432 cached_bytepos = best_above_byte;
|
|
433
|
|
434 return best_above;
|
|
435 }
|
|
436 }
|
|
437
|
|
438 #undef CONSIDER
|
|
439
|
118
|
440 /* Operations on markers. */
|
|
441
|
|
442 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
|
40553
|
443 doc: /* Return the buffer that MARKER points into, or nil if none.
|
|
444 Returns nil if MARKER points into a dead buffer. */)
|
|
445 (marker)
|
118
|
446 register Lisp_Object marker;
|
|
447 {
|
|
448 register Lisp_Object buf;
|
40656
|
449 CHECK_MARKER (marker);
|
118
|
450 if (XMARKER (marker)->buffer)
|
|
451 {
|
9275
bb50d17f7441
(Fmarker_buffer): Use new accessor macros instead of calling XSET directly.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
452 XSETBUFFER (buf, XMARKER (marker)->buffer);
|
85014
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
453 /* If the buffer is dead, we're in trouble: the buffer pointer here
|
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
454 does not preserve the buffer from being GC'd (it's weak), so
|
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
455 markers have to be unlinked from their buffer as soon as the buffer
|
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
456 is killed. */
|
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
457 eassert (!NILP (XBUFFER (buf)->name));
|
ad5045db16f7
(Fmarker_buffer): Make test for odd case into a failure.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
458 return buf;
|
118
|
459 }
|
|
460 return Qnil;
|
|
461 }
|
|
462
|
|
463 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
|
72625
|
464 doc: /* Return the position MARKER points at, as a character number.
|
|
465 Returns nil if MARKER points nowhere. */)
|
40553
|
466 (marker)
|
118
|
467 Lisp_Object marker;
|
|
468 {
|
40656
|
469 CHECK_MARKER (marker);
|
118
|
470 if (XMARKER (marker)->buffer)
|
20537
|
471 return make_number (XMARKER (marker)->charpos);
|
118
|
472
|
|
473 return Qnil;
|
|
474 }
|
12999
|
475
|
118
|
476 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
|
40553
|
477 doc: /* Position MARKER before character number POSITION in BUFFER.
|
|
478 BUFFER defaults to the current buffer.
|
|
479 If POSITION is nil, makes marker point nowhere.
|
|
480 Then it no longer slows down editing in any buffer.
|
|
481 Returns MARKER. */)
|
|
482 (marker, position, buffer)
|
14082
|
483 Lisp_Object marker, position, buffer;
|
118
|
484 {
|
20537
|
485 register int charno, bytepos;
|
118
|
486 register struct buffer *b;
|
|
487 register struct Lisp_Marker *m;
|
|
488
|
40656
|
489 CHECK_MARKER (marker);
|
51672
|
490 m = XMARKER (marker);
|
|
491
|
118
|
492 /* If position is nil or a marker that points nowhere,
|
|
493 make this marker point nowhere. */
|
14082
|
494 if (NILP (position)
|
|
495 || (MARKERP (position) && !XMARKER (position)->buffer))
|
118
|
496 {
|
51672
|
497 unchain_marker (m);
|
118
|
498 return marker;
|
|
499 }
|
|
500
|
484
|
501 if (NILP (buffer))
|
118
|
502 b = current_buffer;
|
|
503 else
|
|
504 {
|
40656
|
505 CHECK_BUFFER (buffer);
|
118
|
506 b = XBUFFER (buffer);
|
|
507 /* If buffer is dead, set marker to point nowhere. */
|
|
508 if (EQ (b->name, Qnil))
|
|
509 {
|
51672
|
510 unchain_marker (m);
|
118
|
511 return marker;
|
|
512 }
|
|
513 }
|
|
514
|
20537
|
515 /* Optimize the special case where we are copying the position
|
|
516 of an existing marker, and MARKER is already in the same buffer. */
|
|
517 if (MARKERP (position) && b == XMARKER (position)->buffer
|
|
518 && b == m->buffer)
|
|
519 {
|
20563
|
520 m->bytepos = XMARKER (position)->bytepos;
|
20537
|
521 m->charpos = XMARKER (position)->charpos;
|
|
522 return marker;
|
|
523 }
|
|
524
|
40656
|
525 CHECK_NUMBER_COERCE_MARKER (position);
|
20537
|
526
|
14082
|
527 charno = XINT (position);
|
118
|
528
|
|
529 if (charno < BUF_BEG (b))
|
|
530 charno = BUF_BEG (b);
|
|
531 if (charno > BUF_Z (b))
|
|
532 charno = BUF_Z (b);
|
20537
|
533
|
|
534 bytepos = buf_charpos_to_bytepos (b, charno);
|
|
535
|
|
536 /* Every character is at least one byte. */
|
|
537 if (charno > bytepos)
|
|
538 abort ();
|
|
539
|
20563
|
540 m->bytepos = bytepos;
|
20537
|
541 m->charpos = charno;
|
118
|
542
|
|
543 if (m->buffer != b)
|
|
544 {
|
51672
|
545 unchain_marker (m);
|
118
|
546 m->buffer = b;
|
51672
|
547 m->next = BUF_MARKERS (b);
|
|
548 BUF_MARKERS (b) = m;
|
118
|
549 }
|
49600
|
550
|
118
|
551 return marker;
|
|
552 }
|
|
553
|
|
554 /* This version of Fset_marker won't let the position
|
|
555 be outside the visible part. */
|
|
556
|
49600
|
557 Lisp_Object
|
118
|
558 set_marker_restricted (marker, pos, buffer)
|
|
559 Lisp_Object marker, pos, buffer;
|
|
560 {
|
20537
|
561 register int charno, bytepos;
|
118
|
562 register struct buffer *b;
|
|
563 register struct Lisp_Marker *m;
|
|
564
|
40656
|
565 CHECK_MARKER (marker);
|
51672
|
566 m = XMARKER (marker);
|
|
567
|
118
|
568 /* If position is nil or a marker that points nowhere,
|
|
569 make this marker point nowhere. */
|
20537
|
570 if (NILP (pos)
|
|
571 || (MARKERP (pos) && !XMARKER (pos)->buffer))
|
118
|
572 {
|
51672
|
573 unchain_marker (m);
|
118
|
574 return marker;
|
|
575 }
|
|
576
|
484
|
577 if (NILP (buffer))
|
118
|
578 b = current_buffer;
|
|
579 else
|
|
580 {
|
40656
|
581 CHECK_BUFFER (buffer);
|
118
|
582 b = XBUFFER (buffer);
|
|
583 /* If buffer is dead, set marker to point nowhere. */
|
|
584 if (EQ (b->name, Qnil))
|
|
585 {
|
51672
|
586 unchain_marker (m);
|
118
|
587 return marker;
|
|
588 }
|
|
589 }
|
|
590
|
20537
|
591 /* Optimize the special case where we are copying the position
|
|
592 of an existing marker, and MARKER is already in the same buffer. */
|
|
593 if (MARKERP (pos) && b == XMARKER (pos)->buffer
|
|
594 && b == m->buffer)
|
|
595 {
|
20563
|
596 m->bytepos = XMARKER (pos)->bytepos;
|
20537
|
597 m->charpos = XMARKER (pos)->charpos;
|
|
598 return marker;
|
|
599 }
|
|
600
|
40656
|
601 CHECK_NUMBER_COERCE_MARKER (pos);
|
20537
|
602
|
118
|
603 charno = XINT (pos);
|
|
604
|
|
605 if (charno < BUF_BEGV (b))
|
|
606 charno = BUF_BEGV (b);
|
|
607 if (charno > BUF_ZV (b))
|
|
608 charno = BUF_ZV (b);
|
20537
|
609
|
|
610 bytepos = buf_charpos_to_bytepos (b, charno);
|
|
611
|
|
612 /* Every character is at least one byte. */
|
|
613 if (charno > bytepos)
|
|
614 abort ();
|
|
615
|
20563
|
616 m->bytepos = bytepos;
|
20537
|
617 m->charpos = charno;
|
|
618
|
|
619 if (m->buffer != b)
|
|
620 {
|
51672
|
621 unchain_marker (m);
|
20537
|
622 m->buffer = b;
|
51672
|
623 m->next = BUF_MARKERS (b);
|
|
624 BUF_MARKERS (b) = m;
|
20537
|
625 }
|
49600
|
626
|
20537
|
627 return marker;
|
|
628 }
|
|
629
|
|
630 /* Set the position of MARKER, specifying both the
|
|
631 character position and the corresponding byte position. */
|
|
632
|
49600
|
633 Lisp_Object
|
20537
|
634 set_marker_both (marker, buffer, charpos, bytepos)
|
|
635 Lisp_Object marker, buffer;
|
|
636 int charpos, bytepos;
|
|
637 {
|
|
638 register struct buffer *b;
|
|
639 register struct Lisp_Marker *m;
|
|
640
|
40656
|
641 CHECK_MARKER (marker);
|
51672
|
642 m = XMARKER (marker);
|
20537
|
643
|
|
644 if (NILP (buffer))
|
|
645 b = current_buffer;
|
|
646 else
|
|
647 {
|
40656
|
648 CHECK_BUFFER (buffer);
|
20537
|
649 b = XBUFFER (buffer);
|
|
650 /* If buffer is dead, set marker to point nowhere. */
|
|
651 if (EQ (b->name, Qnil))
|
|
652 {
|
51672
|
653 unchain_marker (m);
|
20537
|
654 return marker;
|
|
655 }
|
|
656 }
|
|
657
|
|
658 /* In a single-byte buffer, the two positions must be equal. */
|
|
659 if (BUF_Z (b) == BUF_Z_BYTE (b)
|
|
660 && charpos != bytepos)
|
|
661 abort ();
|
|
662 /* Every character is at least one byte. */
|
|
663 if (charpos > bytepos)
|
|
664 abort ();
|
|
665
|
20563
|
666 m->bytepos = bytepos;
|
20537
|
667 m->charpos = charpos;
|
118
|
668
|
|
669 if (m->buffer != b)
|
|
670 {
|
51672
|
671 unchain_marker (m);
|
118
|
672 m->buffer = b;
|
51672
|
673 m->next = BUF_MARKERS (b);
|
|
674 BUF_MARKERS (b) = m;
|
118
|
675 }
|
49600
|
676
|
118
|
677 return marker;
|
|
678 }
|
|
679
|
20537
|
680 /* This version of set_marker_both won't let the position
|
|
681 be outside the visible part. */
|
|
682
|
49600
|
683 Lisp_Object
|
20537
|
684 set_marker_restricted_both (marker, buffer, charpos, bytepos)
|
|
685 Lisp_Object marker, buffer;
|
|
686 int charpos, bytepos;
|
|
687 {
|
|
688 register struct buffer *b;
|
|
689 register struct Lisp_Marker *m;
|
|
690
|
40656
|
691 CHECK_MARKER (marker);
|
51672
|
692 m = XMARKER (marker);
|
20537
|
693
|
|
694 if (NILP (buffer))
|
|
695 b = current_buffer;
|
|
696 else
|
|
697 {
|
40656
|
698 CHECK_BUFFER (buffer);
|
20537
|
699 b = XBUFFER (buffer);
|
|
700 /* If buffer is dead, set marker to point nowhere. */
|
|
701 if (EQ (b->name, Qnil))
|
|
702 {
|
51672
|
703 unchain_marker (m);
|
20537
|
704 return marker;
|
|
705 }
|
|
706 }
|
|
707
|
|
708 if (charpos < BUF_BEGV (b))
|
|
709 charpos = BUF_BEGV (b);
|
|
710 if (charpos > BUF_ZV (b))
|
|
711 charpos = BUF_ZV (b);
|
|
712 if (bytepos < BUF_BEGV_BYTE (b))
|
|
713 bytepos = BUF_BEGV_BYTE (b);
|
|
714 if (bytepos > BUF_ZV_BYTE (b))
|
|
715 bytepos = BUF_ZV_BYTE (b);
|
|
716
|
|
717 /* In a single-byte buffer, the two positions must be equal. */
|
|
718 if (BUF_Z (b) == BUF_Z_BYTE (b)
|
|
719 && charpos != bytepos)
|
|
720 abort ();
|
|
721 /* Every character is at least one byte. */
|
|
722 if (charpos > bytepos)
|
|
723 abort ();
|
|
724
|
20563
|
725 m->bytepos = bytepos;
|
20537
|
726 m->charpos = charpos;
|
|
727
|
|
728 if (m->buffer != b)
|
|
729 {
|
51672
|
730 unchain_marker (m);
|
20537
|
731 m->buffer = b;
|
51672
|
732 m->next = BUF_MARKERS (b);
|
|
733 BUF_MARKERS (b) = m;
|
20537
|
734 }
|
49600
|
735
|
20537
|
736 return marker;
|
|
737 }
|
|
738
|
41235
|
739 /* Remove MARKER from the chain of whatever buffer it is in.
|
|
740 Leave it "in no buffer".
|
|
741
|
|
742 This is called during garbage collection,
|
118
|
743 so we must be careful to ignore and preserve mark bits,
|
|
744 including those in chain fields of markers. */
|
|
745
|
20301
|
746 void
|
118
|
747 unchain_marker (marker)
|
51672
|
748 register struct Lisp_Marker *marker;
|
118
|
749 {
|
51672
|
750 register struct Lisp_Marker *tail, *prev, *next;
|
118
|
751 register struct buffer *b;
|
|
752
|
51672
|
753 b = marker->buffer;
|
118
|
754 if (b == 0)
|
|
755 return;
|
|
756
|
|
757 if (EQ (b->name, Qnil))
|
|
758 abort ();
|
|
759
|
51672
|
760 marker->buffer = 0;
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
761
|
10315
|
762 tail = BUF_MARKERS (b);
|
51672
|
763 prev = NULL;
|
|
764 while (tail)
|
118
|
765 {
|
51672
|
766 next = tail->next;
|
118
|
767
|
51672
|
768 if (marker == tail)
|
118
|
769 {
|
51672
|
770 if (!prev)
|
118
|
771 {
|
10315
|
772 BUF_MARKERS (b) = next;
|
|
773 /* Deleting first marker from the buffer's chain. Crash
|
|
774 if new first marker in chain does not say it belongs
|
10999
|
775 to the same buffer, or at least that they have the same
|
|
776 base buffer. */
|
51672
|
777 if (next && b->text != next->buffer->text)
|
118
|
778 abort ();
|
|
779 }
|
|
780 else
|
51672
|
781 prev->next = next;
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
782 /* We have removed the marker from the chain;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
783 no need to scan the rest of the chain. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
784 return;
|
118
|
785 }
|
|
786 else
|
|
787 prev = tail;
|
|
788 tail = next;
|
|
789 }
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
790
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
791 /* Marker was not in its chain. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
792 abort ();
|
118
|
793 }
|
|
794
|
20537
|
795 /* Return the char position of marker MARKER, as a C integer. */
|
10315
|
796
|
|
797 int
|
118
|
798 marker_position (marker)
|
|
799 Lisp_Object marker;
|
|
800 {
|
|
801 register struct Lisp_Marker *m = XMARKER (marker);
|
|
802 register struct buffer *buf = m->buffer;
|
20537
|
803
|
|
804 if (!buf)
|
|
805 error ("Marker does not point anywhere");
|
|
806
|
|
807 return m->charpos;
|
|
808 }
|
|
809
|
|
810 /* Return the byte position of marker MARKER, as a C integer. */
|
|
811
|
|
812 int
|
|
813 marker_byte_position (marker)
|
|
814 Lisp_Object marker;
|
|
815 {
|
|
816 register struct Lisp_Marker *m = XMARKER (marker);
|
|
817 register struct buffer *buf = m->buffer;
|
20563
|
818 register int i = m->bytepos;
|
118
|
819
|
|
820 if (!buf)
|
|
821 error ("Marker does not point anywhere");
|
|
822
|
20537
|
823 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
|
118
|
824 abort ();
|
|
825
|
|
826 return i;
|
|
827 }
|
12999
|
828
|
|
829 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
|
40553
|
830 doc: /* Return a new marker pointing at the same place as MARKER.
|
|
831 If argument is a number, makes a new marker pointing
|
|
832 at that position in the current buffer.
|
|
833 The optional argument TYPE specifies the insertion type of the new marker;
|
|
834 see `marker-insertion-type'. */)
|
|
835 (marker, type)
|
12999
|
836 register Lisp_Object marker, type;
|
118
|
837 {
|
|
838 register Lisp_Object new;
|
|
839
|
71840
|
840 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
|
22744
|
841
|
|
842 new = Fmake_marker ();
|
|
843 Fset_marker (new, marker,
|
|
844 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
|
|
845 XMARKER (new)->insertion_type = !NILP (type);
|
|
846 return new;
|
12999
|
847 }
|
|
848
|
|
849 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
|
|
850 Smarker_insertion_type, 1, 1, 0,
|
40553
|
851 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
|
74568
|
852 The value nil means the marker stays before text inserted there. */)
|
40553
|
853 (marker)
|
12999
|
854 register Lisp_Object marker;
|
|
855 {
|
40656
|
856 CHECK_MARKER (marker);
|
12999
|
857 return XMARKER (marker)->insertion_type ? Qt : Qnil;
|
|
858 }
|
|
859
|
|
860 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
|
|
861 Sset_marker_insertion_type, 2, 2, 0,
|
40553
|
862 doc: /* Set the insertion-type of MARKER to TYPE.
|
|
863 If TYPE is t, it means the marker advances when you insert text at it.
|
|
864 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
|
|
865 (marker, type)
|
12999
|
866 Lisp_Object marker, type;
|
|
867 {
|
40656
|
868 CHECK_MARKER (marker);
|
12999
|
869
|
|
870 XMARKER (marker)->insertion_type = ! NILP (type);
|
|
871 return type;
|
118
|
872 }
|
16418
|
873
|
|
874 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
|
40553
|
875 1, 1, 0,
|
|
876 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
|
|
877 (position)
|
|
878 Lisp_Object position;
|
16418
|
879 {
|
51672
|
880 register struct Lisp_Marker *tail;
|
16418
|
881 register int charno;
|
|
882
|
|
883 charno = XINT (position);
|
|
884
|
|
885 if (charno < BEG)
|
|
886 charno = BEG;
|
|
887 if (charno > Z)
|
|
888 charno = Z;
|
|
889
|
51672
|
890 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
|
|
891 if (tail->charpos == charno)
|
16418
|
892 return Qt;
|
|
893
|
|
894 return Qnil;
|
|
895 }
|
44560
|
896
|
|
897 /* For debugging -- count the markers in buffer BUF. */
|
|
898
|
|
899 int
|
|
900 count_markers (buf)
|
|
901 struct buffer *buf;
|
|
902 {
|
|
903 int total = 0;
|
51672
|
904 struct Lisp_Marker *tail;
|
44560
|
905
|
51672
|
906 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
|
44560
|
907 total++;
|
|
908
|
|
909 return total;
|
|
910 }
|
118
|
911
|
20301
|
912 void
|
118
|
913 syms_of_marker ()
|
|
914 {
|
|
915 defsubr (&Smarker_position);
|
|
916 defsubr (&Smarker_buffer);
|
|
917 defsubr (&Sset_marker);
|
|
918 defsubr (&Scopy_marker);
|
12999
|
919 defsubr (&Smarker_insertion_type);
|
|
920 defsubr (&Sset_marker_insertion_type);
|
16418
|
921 defsubr (&Sbuffer_has_markers_at);
|
20872
|
922
|
|
923 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
|
40553
|
924 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
|
20872
|
925 byte_debug_flag = 0;
|
118
|
926 }
|
52401
|
927
|
|
928 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
|
|
929 (do not change this comment) */
|