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