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