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