Tweak Emacs manual info menu ordering.
[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)
190 {
b8f477cb 191 Lisp_Object marker, buffer;
1389ad71 192 marker = Fmake_marker ();
b8f477cb
KH
193 XSETBUFFER (buffer, b);
194 set_marker_both (marker, buffer, best_below, best_below_byte);
1389ad71
RS
195 }
196
6e57421b
RS
197 if (byte_debug_flag)
198 byte_char_debug_check (b, charpos, best_below_byte);
199
1389ad71
RS
200 cached_buffer = b;
201 cached_modiff = BUF_MODIFF (b);
202 cached_charpos = best_below;
203 cached_bytepos = best_below_byte;
204
205 return best_below_byte;
206 }
207 else
208 {
209 int record = best_above - charpos > 5000;
210
211 while (best_above != charpos)
212 {
213 best_above--;
214 BUF_DEC_POS (b, best_above_byte);
215 }
216
217 /* If this position is quite far from the nearest known position,
218 cache the correspondence by creating a marker here.
219 It will last until the next GC. */
220 if (record)
221 {
b8f477cb 222 Lisp_Object marker, buffer;
1389ad71 223 marker = Fmake_marker ();
b8f477cb
KH
224 XSETBUFFER (buffer, b);
225 set_marker_both (marker, buffer, best_above, best_above_byte);
1389ad71
RS
226 }
227
6e57421b
RS
228 if (byte_debug_flag)
229 byte_char_debug_check (b, charpos, best_above_byte);
230
1389ad71
RS
231 cached_buffer = b;
232 cached_modiff = BUF_MODIFF (b);
233 cached_charpos = best_above;
234 cached_bytepos = best_above_byte;
235
236 return best_above_byte;
237 }
238}
239
240#undef CONSIDER
55a91ea3
RS
241
242/* Used for debugging: recompute the bytepos corresponding to CHARPOS
243 in the simplest, most reliable way. */
244
d311d28c
PE
245extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
246ptrdiff_t
247verify_bytepos (ptrdiff_t charpos)
55a91ea3 248{
d311d28c
PE
249 ptrdiff_t below = 1;
250 ptrdiff_t 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 260\f
b4c3046a
PE
261/* buf_bytepos_to_charpos returns the char position corresponding to
262 BYTEPOS. */
1389ad71 263
b4c3046a 264/* This macro is a subroutine of buf_bytepos_to_charpos.
1389ad71
RS
265 It is used when BYTEPOS is actually the byte position. */
266
267#define CONSIDER(BYTEPOS, CHARPOS) \
268{ \
d311d28c 269 ptrdiff_t this_bytepos = (BYTEPOS); \
1389ad71
RS
270 int changed = 0; \
271 \
272 if (this_bytepos == bytepos) \
6e57421b 273 { \
d311d28c 274 ptrdiff_t value = (CHARPOS); \
6e57421b
RS
275 if (byte_debug_flag) \
276 byte_char_debug_check (b, value, bytepos); \
277 return value; \
278 } \
1389ad71
RS
279 else if (this_bytepos > bytepos) \
280 { \
281 if (this_bytepos < best_above_byte) \
282 { \
283 best_above = (CHARPOS); \
284 best_above_byte = this_bytepos; \
285 changed = 1; \
286 } \
287 } \
288 else if (this_bytepos > best_below_byte) \
289 { \
290 best_below = (CHARPOS); \
291 best_below_byte = this_bytepos; \
292 changed = 1; \
293 } \
294 \
295 if (changed) \
296 { \
297 if (best_above - best_below == best_above_byte - best_below_byte) \
6e57421b 298 { \
d311d28c 299 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
6e57421b
RS
300 if (byte_debug_flag) \
301 byte_char_debug_check (b, value, bytepos); \
302 return value; \
303 } \
1389ad71
RS
304 } \
305}
306
d311d28c
PE
307ptrdiff_t
308buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
1389ad71 309{
5e097e00 310 struct Lisp_Marker *tail;
d311d28c
PE
311 ptrdiff_t best_above, best_above_byte;
312 ptrdiff_t best_below, best_below_byte;
1389ad71
RS
313
314 if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
315 abort ();
316
317 best_above = BUF_Z (b);
318 best_above_byte = BUF_Z_BYTE (b);
319
320 /* If this buffer has as many characters as bytes,
321 each character must be one byte.
322 This takes care of the case where enable-multibyte-characters is nil. */
323 if (best_above == best_above_byte)
324 return bytepos;
325
3ab364ce
SM
326 best_below = BEG;
327 best_below_byte = BEG_BYTE;
1389ad71
RS
328
329 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
330 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
331 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
332 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
333
334 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
335 CONSIDER (cached_bytepos, cached_charpos);
336
5e097e00 337 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
1389ad71 338 {
5e097e00 339 CONSIDER (tail->bytepos, tail->charpos);
1389ad71
RS
340
341 /* If we are down to a range of 50 chars,
342 don't bother checking any other markers;
343 scan the intervening chars directly now. */
344 if (best_above - best_below < 50)
345 break;
1389ad71
RS
346 }
347
348 /* We get here if we did not exactly hit one of the known places.
349 We have one known above and one known below.
350 Scan, counting characters, from whichever one is closer. */
351
352 if (bytepos - best_below_byte < best_above_byte - bytepos)
353 {
7693a579 354 int record = bytepos - best_below_byte > 5000;
1389ad71
RS
355
356 while (best_below_byte < bytepos)
357 {
358 best_below++;
359 BUF_INC_POS (b, best_below_byte);
360 }
361
362 /* If this position is quite far from the nearest known position,
363 cache the correspondence by creating a marker here.
7693a579
RS
364 It will last until the next GC.
365 But don't do it if BUF_MARKERS is nil;
366 that is a signal from Fset_buffer_multibyte. */
5e097e00 367 if (record && BUF_MARKERS (b))
1389ad71 368 {
b8f477cb 369 Lisp_Object marker, buffer;
1389ad71 370 marker = Fmake_marker ();
b8f477cb
KH
371 XSETBUFFER (buffer, b);
372 set_marker_both (marker, buffer, best_below, best_below_byte);
1389ad71
RS
373 }
374
6e57421b
RS
375 if (byte_debug_flag)
376 byte_char_debug_check (b, best_below, bytepos);
377
1389ad71
RS
378 cached_buffer = b;
379 cached_modiff = BUF_MODIFF (b);
380 cached_charpos = best_below;
381 cached_bytepos = best_below_byte;
382
383 return best_below;
384 }
385 else
386 {
387 int record = best_above_byte - bytepos > 5000;
388
389 while (best_above_byte > bytepos)
390 {
391 best_above--;
392 BUF_DEC_POS (b, best_above_byte);
393 }
394
395 /* If this position is quite far from the nearest known position,
396 cache the correspondence by creating a marker here.
7693a579
RS
397 It will last until the next GC.
398 But don't do it if BUF_MARKERS is nil;
399 that is a signal from Fset_buffer_multibyte. */
5e097e00 400 if (record && BUF_MARKERS (b))
1389ad71 401 {
b8f477cb 402 Lisp_Object marker, buffer;
1389ad71 403 marker = Fmake_marker ();
b8f477cb
KH
404 XSETBUFFER (buffer, b);
405 set_marker_both (marker, buffer, best_above, best_above_byte);
1389ad71
RS
406 }
407
6e57421b
RS
408 if (byte_debug_flag)
409 byte_char_debug_check (b, best_above, bytepos);
410
1389ad71
RS
411 cached_buffer = b;
412 cached_modiff = BUF_MODIFF (b);
413 cached_charpos = best_above;
414 cached_bytepos = best_above_byte;
415
416 return best_above;
417 }
418}
419
420#undef CONSIDER
421\f
dcfdbac7
JB
422/* Operations on markers. */
423
a7ca3326 424DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
2e1280f8
PJ
425 doc: /* Return the buffer that MARKER points into, or nil if none.
426Returns nil if MARKER points into a dead buffer. */)
5842a27b 427 (register Lisp_Object marker)
dcfdbac7
JB
428{
429 register Lisp_Object buf;
b7826503 430 CHECK_MARKER (marker);
dcfdbac7
JB
431 if (XMARKER (marker)->buffer)
432 {
0e11d869 433 XSETBUFFER (buf, XMARKER (marker)->buffer);
0754c46a
SM
434 /* If the buffer is dead, we're in trouble: the buffer pointer here
435 does not preserve the buffer from being GC'd (it's weak), so
436 markers have to be unlinked from their buffer as soon as the buffer
437 is killed. */
4b4deea2 438 eassert (!NILP (BVAR (XBUFFER (buf), name)));
0754c46a 439 return buf;
dcfdbac7
JB
440 }
441 return Qnil;
442}
443
a7ca3326 444DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
243d70e5
JL
445 doc: /* Return the position MARKER points at, as a character number.
446Returns nil if MARKER points nowhere. */)
5842a27b 447 (Lisp_Object marker)
dcfdbac7 448{
b7826503 449 CHECK_MARKER (marker);
dcfdbac7 450 if (XMARKER (marker)->buffer)
1389ad71 451 return make_number (XMARKER (marker)->charpos);
dcfdbac7 452
dcfdbac7
JB
453 return Qnil;
454}
fc299663 455\f
a7ca3326 456DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
2e1280f8
PJ
457 doc: /* Position MARKER before character number POSITION in BUFFER.
458BUFFER defaults to the current buffer.
459If POSITION is nil, makes marker point nowhere.
460Then it no longer slows down editing in any buffer.
461Returns MARKER. */)
5842a27b 462 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
dcfdbac7 463{
d311d28c
PE
464 register ptrdiff_t charno;
465 register ptrdiff_t bytepos;
dcfdbac7
JB
466 register struct buffer *b;
467 register struct Lisp_Marker *m;
468
b7826503 469 CHECK_MARKER (marker);
5e097e00
SM
470 m = XMARKER (marker);
471
dcfdbac7
JB
472 /* If position is nil or a marker that points nowhere,
473 make this marker point nowhere. */
9be191c9
EN
474 if (NILP (position)
475 || (MARKERP (position) && !XMARKER (position)->buffer))
dcfdbac7 476 {
5e097e00 477 unchain_marker (m);
dcfdbac7
JB
478 return marker;
479 }
480
d427b66a 481 if (NILP (buffer))
dcfdbac7
JB
482 b = current_buffer;
483 else
484 {
b7826503 485 CHECK_BUFFER (buffer);
dcfdbac7
JB
486 b = XBUFFER (buffer);
487 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 488 if (EQ (BVAR (b, name), Qnil))
dcfdbac7 489 {
5e097e00 490 unchain_marker (m);
dcfdbac7
JB
491 return marker;
492 }
493 }
494
1389ad71
RS
495 /* Optimize the special case where we are copying the position
496 of an existing marker, and MARKER is already in the same buffer. */
497 if (MARKERP (position) && b == XMARKER (position)->buffer
498 && b == m->buffer)
499 {
1f03507f 500 m->bytepos = XMARKER (position)->bytepos;
1389ad71
RS
501 m->charpos = XMARKER (position)->charpos;
502 return marker;
503 }
504
b7826503 505 CHECK_NUMBER_COERCE_MARKER (position);
d311d28c 506 charno = clip_to_bounds (BUF_BEG (b), XINT (position), BUF_Z (b));
1389ad71
RS
507 bytepos = buf_charpos_to_bytepos (b, charno);
508
509 /* Every character is at least one byte. */
510 if (charno > bytepos)
511 abort ();
512
1f03507f 513 m->bytepos = bytepos;
1389ad71 514 m->charpos = charno;
dcfdbac7
JB
515
516 if (m->buffer != b)
517 {
5e097e00 518 unchain_marker (m);
dcfdbac7 519 m->buffer = b;
5e097e00
SM
520 m->next = BUF_MARKERS (b);
521 BUF_MARKERS (b) = m;
dcfdbac7 522 }
177c0ea7 523
dcfdbac7
JB
524 return marker;
525}
526
527/* This version of Fset_marker won't let the position
528 be outside the visible part. */
529
177c0ea7 530Lisp_Object
971de7fb 531set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
dcfdbac7 532{
d311d28c
PE
533 register ptrdiff_t charno;
534 register ptrdiff_t bytepos;
dcfdbac7
JB
535 register struct buffer *b;
536 register struct Lisp_Marker *m;
537
b7826503 538 CHECK_MARKER (marker);
5e097e00
SM
539 m = XMARKER (marker);
540
dcfdbac7
JB
541 /* If position is nil or a marker that points nowhere,
542 make this marker point nowhere. */
1389ad71
RS
543 if (NILP (pos)
544 || (MARKERP (pos) && !XMARKER (pos)->buffer))
dcfdbac7 545 {
5e097e00 546 unchain_marker (m);
dcfdbac7
JB
547 return marker;
548 }
549
d427b66a 550 if (NILP (buffer))
dcfdbac7
JB
551 b = current_buffer;
552 else
553 {
b7826503 554 CHECK_BUFFER (buffer);
dcfdbac7
JB
555 b = XBUFFER (buffer);
556 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 557 if (EQ (BVAR (b, name), Qnil))
dcfdbac7 558 {
5e097e00 559 unchain_marker (m);
dcfdbac7
JB
560 return marker;
561 }
562 }
563
1389ad71
RS
564 /* Optimize the special case where we are copying the position
565 of an existing marker, and MARKER is already in the same buffer. */
566 if (MARKERP (pos) && b == XMARKER (pos)->buffer
567 && b == m->buffer)
568 {
1f03507f 569 m->bytepos = XMARKER (pos)->bytepos;
1389ad71
RS
570 m->charpos = XMARKER (pos)->charpos;
571 return marker;
572 }
573
b7826503 574 CHECK_NUMBER_COERCE_MARKER (pos);
d311d28c 575 charno = clip_to_bounds (BUF_BEGV (b), XINT (pos), BUF_ZV (b));
1389ad71
RS
576 bytepos = buf_charpos_to_bytepos (b, charno);
577
578 /* Every character is at least one byte. */
579 if (charno > bytepos)
580 abort ();
581
1f03507f 582 m->bytepos = bytepos;
1389ad71 583 m->charpos = charno;
dcfdbac7
JB
584
585 if (m->buffer != b)
586 {
5e097e00 587 unchain_marker (m);
dcfdbac7 588 m->buffer = b;
5e097e00
SM
589 m->next = BUF_MARKERS (b);
590 BUF_MARKERS (b) = m;
dcfdbac7 591 }
177c0ea7 592
dcfdbac7
JB
593 return marker;
594}
1389ad71
RS
595\f
596/* Set the position of MARKER, specifying both the
597 character position and the corresponding byte position. */
dcfdbac7 598
177c0ea7 599Lisp_Object
d311d28c 600set_marker_both (Lisp_Object marker, Lisp_Object buffer, ptrdiff_t charpos, ptrdiff_t bytepos)
1389ad71
RS
601{
602 register struct buffer *b;
603 register struct Lisp_Marker *m;
604
b7826503 605 CHECK_MARKER (marker);
5e097e00 606 m = XMARKER (marker);
1389ad71 607
1389ad71
RS
608 if (NILP (buffer))
609 b = current_buffer;
610 else
611 {
b7826503 612 CHECK_BUFFER (buffer);
1389ad71
RS
613 b = XBUFFER (buffer);
614 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 615 if (EQ (BVAR (b, name), Qnil))
1389ad71 616 {
5e097e00 617 unchain_marker (m);
1389ad71
RS
618 return marker;
619 }
620 }
621
1389ad71
RS
622 /* In a single-byte buffer, the two positions must be equal. */
623 if (BUF_Z (b) == BUF_Z_BYTE (b)
624 && charpos != bytepos)
625 abort ();
626 /* Every character is at least one byte. */
627 if (charpos > bytepos)
628 abort ();
629
1f03507f 630 m->bytepos = bytepos;
1389ad71
RS
631 m->charpos = charpos;
632
633 if (m->buffer != b)
634 {
5e097e00 635 unchain_marker (m);
1389ad71 636 m->buffer = b;
5e097e00
SM
637 m->next = BUF_MARKERS (b);
638 BUF_MARKERS (b) = m;
1389ad71 639 }
177c0ea7 640
1389ad71
RS
641 return marker;
642}
643
644/* This version of set_marker_both won't let the position
645 be outside the visible part. */
646
177c0ea7 647Lisp_Object
d311d28c 648set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, ptrdiff_t charpos, ptrdiff_t bytepos)
1389ad71
RS
649{
650 register struct buffer *b;
651 register struct Lisp_Marker *m;
652
b7826503 653 CHECK_MARKER (marker);
5e097e00 654 m = XMARKER (marker);
1389ad71
RS
655
656 if (NILP (buffer))
657 b = current_buffer;
658 else
659 {
b7826503 660 CHECK_BUFFER (buffer);
1389ad71
RS
661 b = XBUFFER (buffer);
662 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 663 if (EQ (BVAR (b, name), Qnil))
1389ad71 664 {
5e097e00 665 unchain_marker (m);
1389ad71
RS
666 return marker;
667 }
668 }
669
6b312f0f
DA
670 charpos = clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b));
671 bytepos = clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b));
1389ad71
RS
672
673 /* In a single-byte buffer, the two positions must be equal. */
674 if (BUF_Z (b) == BUF_Z_BYTE (b)
675 && charpos != bytepos)
676 abort ();
677 /* Every character is at least one byte. */
678 if (charpos > bytepos)
679 abort ();
680
1f03507f 681 m->bytepos = bytepos;
1389ad71
RS
682 m->charpos = charpos;
683
684 if (m->buffer != b)
685 {
5e097e00 686 unchain_marker (m);
1389ad71 687 m->buffer = b;
5e097e00
SM
688 m->next = BUF_MARKERS (b);
689 BUF_MARKERS (b) = m;
1389ad71 690 }
177c0ea7 691
1389ad71
RS
692 return marker;
693}
694\f
b5a4bb22
RS
695/* Remove MARKER from the chain of whatever buffer it is in.
696 Leave it "in no buffer".
697
698 This is called during garbage collection,
dcfdbac7
JB
699 so we must be careful to ignore and preserve mark bits,
700 including those in chain fields of markers. */
701
c0323249 702void
971de7fb 703unchain_marker (register struct Lisp_Marker *marker)
dcfdbac7 704{
5e097e00 705 register struct Lisp_Marker *tail, *prev, *next;
dcfdbac7
JB
706 register struct buffer *b;
707
5e097e00 708 b = marker->buffer;
dcfdbac7
JB
709 if (b == 0)
710 return;
711
4b4deea2 712 if (EQ (BVAR (b, name), Qnil))
dcfdbac7
JB
713 abort ();
714
5e097e00 715 marker->buffer = 0;
7693a579 716
d281a86a 717 tail = BUF_MARKERS (b);
5e097e00
SM
718 prev = NULL;
719 while (tail)
dcfdbac7 720 {
5e097e00 721 next = tail->next;
dcfdbac7 722
5e097e00 723 if (marker == tail)
dcfdbac7 724 {
5e097e00 725 if (!prev)
dcfdbac7 726 {
d281a86a
RS
727 BUF_MARKERS (b) = next;
728 /* Deleting first marker from the buffer's chain. Crash
729 if new first marker in chain does not say it belongs
3686a8de
RS
730 to the same buffer, or at least that they have the same
731 base buffer. */
5e097e00 732 if (next && b->text != next->buffer->text)
dcfdbac7
JB
733 abort ();
734 }
735 else
5e097e00 736 prev->next = next;
7693a579
RS
737 /* We have removed the marker from the chain;
738 no need to scan the rest of the chain. */
739 return;
dcfdbac7
JB
740 }
741 else
742 prev = tail;
743 tail = next;
744 }
7693a579
RS
745
746 /* Marker was not in its chain. */
747 abort ();
dcfdbac7
JB
748}
749
1389ad71 750/* Return the char position of marker MARKER, as a C integer. */
d281a86a 751
d311d28c 752ptrdiff_t
971de7fb 753marker_position (Lisp_Object marker)
dcfdbac7
JB
754{
755 register struct Lisp_Marker *m = XMARKER (marker);
756 register struct buffer *buf = m->buffer;
1389ad71
RS
757
758 if (!buf)
759 error ("Marker does not point anywhere");
760
761 return m->charpos;
762}
763
764/* Return the byte position of marker MARKER, as a C integer. */
765
d311d28c 766ptrdiff_t
971de7fb 767marker_byte_position (Lisp_Object marker)
1389ad71
RS
768{
769 register struct Lisp_Marker *m = XMARKER (marker);
770 register struct buffer *buf = m->buffer;
d311d28c 771 register ptrdiff_t i = m->bytepos;
dcfdbac7
JB
772
773 if (!buf)
774 error ("Marker does not point anywhere");
775
1389ad71 776 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
dcfdbac7
JB
777 abort ();
778
779 return i;
780}
fc299663 781\f
a7ca3326 782DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
2e1280f8
PJ
783 doc: /* Return a new marker pointing at the same place as MARKER.
784If argument is a number, makes a new marker pointing
785at that position in the current buffer.
cd196f12 786If MARKER is not specified, the new marker does not point anywhere.
2e1280f8
PJ
787The optional argument TYPE specifies the insertion type of the new marker;
788see `marker-insertion-type'. */)
5842a27b 789 (register Lisp_Object marker, Lisp_Object type)
dcfdbac7
JB
790{
791 register Lisp_Object new;
792
cd196f12 793 if (!NILP (marker))
0b4331b7 794 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
0469366f
KH
795
796 new = Fmake_marker ();
797 Fset_marker (new, marker,
798 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
799 XMARKER (new)->insertion_type = !NILP (type);
800 return new;
fc299663
RS
801}
802
803DEFUN ("marker-insertion-type", Fmarker_insertion_type,
804 Smarker_insertion_type, 1, 1, 0,
2e1280f8 805 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
1961ac0f 806The value nil means the marker stays before text inserted there. */)
5842a27b 807 (register Lisp_Object marker)
fc299663 808{
b7826503 809 CHECK_MARKER (marker);
fc299663
RS
810 return XMARKER (marker)->insertion_type ? Qt : Qnil;
811}
812
813DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
814 Sset_marker_insertion_type, 2, 2, 0,
2e1280f8
PJ
815 doc: /* Set the insertion-type of MARKER to TYPE.
816If TYPE is t, it means the marker advances when you insert text at it.
817If TYPE is nil, it means the marker stays behind when you insert text at it. */)
5842a27b 818 (Lisp_Object marker, Lisp_Object type)
fc299663 819{
b7826503 820 CHECK_MARKER (marker);
fc299663
RS
821
822 XMARKER (marker)->insertion_type = ! NILP (type);
823 return type;
dcfdbac7 824}
9e5896c6
RS
825
826DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
2e1280f8
PJ
827 1, 1, 0,
828 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
5842a27b 829 (Lisp_Object position)
9e5896c6 830{
5e097e00 831 register struct Lisp_Marker *tail;
d311d28c 832 register ptrdiff_t charno;
9e5896c6 833
d311d28c 834 charno = clip_to_bounds (BEG, XINT (position), Z);
9e5896c6 835
5e097e00
SM
836 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
837 if (tail->charpos == charno)
9e5896c6
RS
838 return Qt;
839
840 return Qnil;
841}
59d36066
RS
842
843/* For debugging -- count the markers in buffer BUF. */
844
e3b27b31 845extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
59d36066 846int
971de7fb 847count_markers (struct buffer *buf)
59d36066
RS
848{
849 int total = 0;
5e097e00 850 struct Lisp_Marker *tail;
59d36066 851
5e097e00 852 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
59d36066
RS
853 total++;
854
855 return total;
856}
dcfdbac7 857\f
c0323249 858void
971de7fb 859syms_of_marker (void)
dcfdbac7
JB
860{
861 defsubr (&Smarker_position);
862 defsubr (&Smarker_buffer);
863 defsubr (&Sset_marker);
864 defsubr (&Scopy_marker);
fc299663
RS
865 defsubr (&Smarker_insertion_type);
866 defsubr (&Sset_marker_insertion_type);
9e5896c6 867 defsubr (&Sbuffer_has_markers_at);
6e57421b 868
29208e82 869 DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag,
2e1280f8 870 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
6e57421b 871 byte_debug_flag = 0;
dcfdbac7 872}