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