* buffer.c (struct sortstr.size, record_overlay_string): Don't truncate size to int.
[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
e3b27b31 245extern EMACS_INT verify_bytepos (EMACS_INT charpos) EXTERNALLY_VISIBLE;
da43f021
EZ
246EMACS_INT
247verify_bytepos (EMACS_INT charpos)
55a91ea3 248{
da43f021
EZ
249 EMACS_INT below = 1;
250 EMACS_INT below_byte = 1;
55a91ea3
RS
251
252 while (below != charpos)
253 {
254 below++;
255 BUF_INC_POS (current_buffer, below_byte);
256 }
257
258 return below_byte;
259}
1389ad71 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{ \
0350982f 269 EMACS_INT this_bytepos = (BYTEPOS); \
1389ad71
RS
270 int changed = 0; \
271 \
272 if (this_bytepos == bytepos) \
6e57421b 273 { \
0350982f 274 EMACS_INT 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 { \
0350982f 299 EMACS_INT 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
0350982f
LMI
307EMACS_INT
308buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
1389ad71 309{
5e097e00 310 struct Lisp_Marker *tail;
0350982f
LMI
311 EMACS_INT best_above, best_above_byte;
312 EMACS_INT 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{
0350982f 464 register EMACS_INT charno, bytepos;
dcfdbac7
JB
465 register struct buffer *b;
466 register struct Lisp_Marker *m;
467
b7826503 468 CHECK_MARKER (marker);
5e097e00
SM
469 m = XMARKER (marker);
470
dcfdbac7
JB
471 /* If position is nil or a marker that points nowhere,
472 make this marker point nowhere. */
9be191c9
EN
473 if (NILP (position)
474 || (MARKERP (position) && !XMARKER (position)->buffer))
dcfdbac7 475 {
5e097e00 476 unchain_marker (m);
dcfdbac7
JB
477 return marker;
478 }
479
d427b66a 480 if (NILP (buffer))
dcfdbac7
JB
481 b = current_buffer;
482 else
483 {
b7826503 484 CHECK_BUFFER (buffer);
dcfdbac7
JB
485 b = XBUFFER (buffer);
486 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 487 if (EQ (BVAR (b, name), Qnil))
dcfdbac7 488 {
5e097e00 489 unchain_marker (m);
dcfdbac7
JB
490 return marker;
491 }
492 }
493
1389ad71
RS
494 /* Optimize the special case where we are copying the position
495 of an existing marker, and MARKER is already in the same buffer. */
496 if (MARKERP (position) && b == XMARKER (position)->buffer
497 && b == m->buffer)
498 {
1f03507f 499 m->bytepos = XMARKER (position)->bytepos;
1389ad71
RS
500 m->charpos = XMARKER (position)->charpos;
501 return marker;
502 }
503
b7826503 504 CHECK_NUMBER_COERCE_MARKER (position);
1389ad71
RS
505
506 charno = XINT (position);
507
dcfdbac7
JB
508 if (charno < BUF_BEG (b))
509 charno = BUF_BEG (b);
510 if (charno > BUF_Z (b))
511 charno = BUF_Z (b);
1389ad71
RS
512
513 bytepos = buf_charpos_to_bytepos (b, charno);
514
515 /* Every character is at least one byte. */
516 if (charno > bytepos)
517 abort ();
518
1f03507f 519 m->bytepos = bytepos;
1389ad71 520 m->charpos = charno;
dcfdbac7
JB
521
522 if (m->buffer != b)
523 {
5e097e00 524 unchain_marker (m);
dcfdbac7 525 m->buffer = b;
5e097e00
SM
526 m->next = BUF_MARKERS (b);
527 BUF_MARKERS (b) = m;
dcfdbac7 528 }
177c0ea7 529
dcfdbac7
JB
530 return marker;
531}
532
533/* This version of Fset_marker won't let the position
534 be outside the visible part. */
535
177c0ea7 536Lisp_Object
971de7fb 537set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
dcfdbac7 538{
0350982f 539 register EMACS_INT charno, bytepos;
dcfdbac7
JB
540 register struct buffer *b;
541 register struct Lisp_Marker *m;
542
b7826503 543 CHECK_MARKER (marker);
5e097e00
SM
544 m = XMARKER (marker);
545
dcfdbac7
JB
546 /* If position is nil or a marker that points nowhere,
547 make this marker point nowhere. */
1389ad71
RS
548 if (NILP (pos)
549 || (MARKERP (pos) && !XMARKER (pos)->buffer))
dcfdbac7 550 {
5e097e00 551 unchain_marker (m);
dcfdbac7
JB
552 return marker;
553 }
554
d427b66a 555 if (NILP (buffer))
dcfdbac7
JB
556 b = current_buffer;
557 else
558 {
b7826503 559 CHECK_BUFFER (buffer);
dcfdbac7
JB
560 b = XBUFFER (buffer);
561 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 562 if (EQ (BVAR (b, name), Qnil))
dcfdbac7 563 {
5e097e00 564 unchain_marker (m);
dcfdbac7
JB
565 return marker;
566 }
567 }
568
1389ad71
RS
569 /* Optimize the special case where we are copying the position
570 of an existing marker, and MARKER is already in the same buffer. */
571 if (MARKERP (pos) && b == XMARKER (pos)->buffer
572 && b == m->buffer)
573 {
1f03507f 574 m->bytepos = XMARKER (pos)->bytepos;
1389ad71
RS
575 m->charpos = XMARKER (pos)->charpos;
576 return marker;
577 }
578
b7826503 579 CHECK_NUMBER_COERCE_MARKER (pos);
1389ad71
RS
580
581 charno = XINT (pos);
582
dcfdbac7
JB
583 if (charno < BUF_BEGV (b))
584 charno = BUF_BEGV (b);
585 if (charno > BUF_ZV (b))
586 charno = BUF_ZV (b);
1389ad71
RS
587
588 bytepos = buf_charpos_to_bytepos (b, charno);
589
590 /* Every character is at least one byte. */
591 if (charno > bytepos)
592 abort ();
593
1f03507f 594 m->bytepos = bytepos;
1389ad71 595 m->charpos = charno;
dcfdbac7
JB
596
597 if (m->buffer != b)
598 {
5e097e00 599 unchain_marker (m);
dcfdbac7 600 m->buffer = b;
5e097e00
SM
601 m->next = BUF_MARKERS (b);
602 BUF_MARKERS (b) = m;
dcfdbac7 603 }
177c0ea7 604
dcfdbac7
JB
605 return marker;
606}
1389ad71
RS
607\f
608/* Set the position of MARKER, specifying both the
609 character position and the corresponding byte position. */
dcfdbac7 610
177c0ea7 611Lisp_Object
0350982f 612set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
1389ad71
RS
613{
614 register struct buffer *b;
615 register struct Lisp_Marker *m;
616
b7826503 617 CHECK_MARKER (marker);
5e097e00 618 m = XMARKER (marker);
1389ad71 619
1389ad71
RS
620 if (NILP (buffer))
621 b = current_buffer;
622 else
623 {
b7826503 624 CHECK_BUFFER (buffer);
1389ad71
RS
625 b = XBUFFER (buffer);
626 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 627 if (EQ (BVAR (b, name), Qnil))
1389ad71 628 {
5e097e00 629 unchain_marker (m);
1389ad71
RS
630 return marker;
631 }
632 }
633
1389ad71
RS
634 /* In a single-byte buffer, the two positions must be equal. */
635 if (BUF_Z (b) == BUF_Z_BYTE (b)
636 && charpos != bytepos)
637 abort ();
638 /* Every character is at least one byte. */
639 if (charpos > bytepos)
640 abort ();
641
1f03507f 642 m->bytepos = bytepos;
1389ad71
RS
643 m->charpos = charpos;
644
645 if (m->buffer != b)
646 {
5e097e00 647 unchain_marker (m);
1389ad71 648 m->buffer = b;
5e097e00
SM
649 m->next = BUF_MARKERS (b);
650 BUF_MARKERS (b) = m;
1389ad71 651 }
177c0ea7 652
1389ad71
RS
653 return marker;
654}
655
656/* This version of set_marker_both won't let the position
657 be outside the visible part. */
658
177c0ea7 659Lisp_Object
0350982f 660set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
1389ad71
RS
661{
662 register struct buffer *b;
663 register struct Lisp_Marker *m;
664
b7826503 665 CHECK_MARKER (marker);
5e097e00 666 m = XMARKER (marker);
1389ad71
RS
667
668 if (NILP (buffer))
669 b = current_buffer;
670 else
671 {
b7826503 672 CHECK_BUFFER (buffer);
1389ad71
RS
673 b = XBUFFER (buffer);
674 /* If buffer is dead, set marker to point nowhere. */
4b4deea2 675 if (EQ (BVAR (b, name), Qnil))
1389ad71 676 {
5e097e00 677 unchain_marker (m);
1389ad71
RS
678 return marker;
679 }
680 }
681
1389ad71
RS
682 if (charpos < BUF_BEGV (b))
683 charpos = BUF_BEGV (b);
684 if (charpos > BUF_ZV (b))
685 charpos = BUF_ZV (b);
686 if (bytepos < BUF_BEGV_BYTE (b))
687 bytepos = BUF_BEGV_BYTE (b);
688 if (bytepos > BUF_ZV_BYTE (b))
689 bytepos = BUF_ZV_BYTE (b);
690
691 /* In a single-byte buffer, the two positions must be equal. */
692 if (BUF_Z (b) == BUF_Z_BYTE (b)
693 && charpos != bytepos)
694 abort ();
695 /* Every character is at least one byte. */
696 if (charpos > bytepos)
697 abort ();
698
1f03507f 699 m->bytepos = bytepos;
1389ad71
RS
700 m->charpos = charpos;
701
702 if (m->buffer != b)
703 {
5e097e00 704 unchain_marker (m);
1389ad71 705 m->buffer = b;
5e097e00
SM
706 m->next = BUF_MARKERS (b);
707 BUF_MARKERS (b) = m;
1389ad71 708 }
177c0ea7 709
1389ad71
RS
710 return marker;
711}
712\f
b5a4bb22
RS
713/* Remove MARKER from the chain of whatever buffer it is in.
714 Leave it "in no buffer".
715
716 This is called during garbage collection,
dcfdbac7
JB
717 so we must be careful to ignore and preserve mark bits,
718 including those in chain fields of markers. */
719
c0323249 720void
971de7fb 721unchain_marker (register struct Lisp_Marker *marker)
dcfdbac7 722{
5e097e00 723 register struct Lisp_Marker *tail, *prev, *next;
dcfdbac7
JB
724 register struct buffer *b;
725
5e097e00 726 b = marker->buffer;
dcfdbac7
JB
727 if (b == 0)
728 return;
729
4b4deea2 730 if (EQ (BVAR (b, name), Qnil))
dcfdbac7
JB
731 abort ();
732
5e097e00 733 marker->buffer = 0;
7693a579 734
d281a86a 735 tail = BUF_MARKERS (b);
5e097e00
SM
736 prev = NULL;
737 while (tail)
dcfdbac7 738 {
5e097e00 739 next = tail->next;
dcfdbac7 740
5e097e00 741 if (marker == tail)
dcfdbac7 742 {
5e097e00 743 if (!prev)
dcfdbac7 744 {
d281a86a
RS
745 BUF_MARKERS (b) = next;
746 /* Deleting first marker from the buffer's chain. Crash
747 if new first marker in chain does not say it belongs
3686a8de
RS
748 to the same buffer, or at least that they have the same
749 base buffer. */
5e097e00 750 if (next && b->text != next->buffer->text)
dcfdbac7
JB
751 abort ();
752 }
753 else
5e097e00 754 prev->next = next;
7693a579
RS
755 /* We have removed the marker from the chain;
756 no need to scan the rest of the chain. */
757 return;
dcfdbac7
JB
758 }
759 else
760 prev = tail;
761 tail = next;
762 }
7693a579
RS
763
764 /* Marker was not in its chain. */
765 abort ();
dcfdbac7
JB
766}
767
1389ad71 768/* Return the char position of marker MARKER, as a C integer. */
d281a86a 769
0350982f 770EMACS_INT
971de7fb 771marker_position (Lisp_Object marker)
dcfdbac7
JB
772{
773 register struct Lisp_Marker *m = XMARKER (marker);
774 register struct buffer *buf = m->buffer;
1389ad71
RS
775
776 if (!buf)
777 error ("Marker does not point anywhere");
778
779 return m->charpos;
780}
781
782/* Return the byte position of marker MARKER, as a C integer. */
783
0350982f 784EMACS_INT
971de7fb 785marker_byte_position (Lisp_Object marker)
1389ad71
RS
786{
787 register struct Lisp_Marker *m = XMARKER (marker);
788 register struct buffer *buf = m->buffer;
0350982f 789 register EMACS_INT i = m->bytepos;
dcfdbac7
JB
790
791 if (!buf)
792 error ("Marker does not point anywhere");
793
1389ad71 794 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
dcfdbac7
JB
795 abort ();
796
797 return i;
798}
fc299663 799\f
a7ca3326 800DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
2e1280f8
PJ
801 doc: /* Return a new marker pointing at the same place as MARKER.
802If argument is a number, makes a new marker pointing
803at that position in the current buffer.
cd196f12 804If MARKER is not specified, the new marker does not point anywhere.
2e1280f8
PJ
805The optional argument TYPE specifies the insertion type of the new marker;
806see `marker-insertion-type'. */)
5842a27b 807 (register Lisp_Object marker, Lisp_Object type)
dcfdbac7
JB
808{
809 register Lisp_Object new;
810
cd196f12 811 if (!NILP (marker))
0b4331b7 812 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
0469366f
KH
813
814 new = Fmake_marker ();
815 Fset_marker (new, marker,
816 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
817 XMARKER (new)->insertion_type = !NILP (type);
818 return new;
fc299663
RS
819}
820
821DEFUN ("marker-insertion-type", Fmarker_insertion_type,
822 Smarker_insertion_type, 1, 1, 0,
2e1280f8 823 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
1961ac0f 824The value nil means the marker stays before text inserted there. */)
5842a27b 825 (register Lisp_Object marker)
fc299663 826{
b7826503 827 CHECK_MARKER (marker);
fc299663
RS
828 return XMARKER (marker)->insertion_type ? Qt : Qnil;
829}
830
831DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
832 Sset_marker_insertion_type, 2, 2, 0,
2e1280f8
PJ
833 doc: /* Set the insertion-type of MARKER to TYPE.
834If TYPE is t, it means the marker advances when you insert text at it.
835If TYPE is nil, it means the marker stays behind when you insert text at it. */)
5842a27b 836 (Lisp_Object marker, Lisp_Object type)
fc299663 837{
b7826503 838 CHECK_MARKER (marker);
fc299663
RS
839
840 XMARKER (marker)->insertion_type = ! NILP (type);
841 return type;
dcfdbac7 842}
9e5896c6
RS
843
844DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
2e1280f8
PJ
845 1, 1, 0,
846 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
5842a27b 847 (Lisp_Object position)
9e5896c6 848{
5e097e00 849 register struct Lisp_Marker *tail;
0350982f 850 register EMACS_INT charno;
9e5896c6
RS
851
852 charno = XINT (position);
853
854 if (charno < BEG)
855 charno = BEG;
856 if (charno > Z)
857 charno = Z;
9e5896c6 858
5e097e00
SM
859 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
860 if (tail->charpos == charno)
9e5896c6
RS
861 return Qt;
862
863 return Qnil;
864}
59d36066
RS
865
866/* For debugging -- count the markers in buffer BUF. */
867
e3b27b31 868extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
59d36066 869int
971de7fb 870count_markers (struct buffer *buf)
59d36066
RS
871{
872 int total = 0;
5e097e00 873 struct Lisp_Marker *tail;
59d36066 874
5e097e00 875 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
59d36066
RS
876 total++;
877
878 return total;
879}
dcfdbac7 880\f
c0323249 881void
971de7fb 882syms_of_marker (void)
dcfdbac7
JB
883{
884 defsubr (&Smarker_position);
885 defsubr (&Smarker_buffer);
886 defsubr (&Sset_marker);
887 defsubr (&Scopy_marker);
fc299663
RS
888 defsubr (&Smarker_insertion_type);
889 defsubr (&Sset_marker_insertion_type);
9e5896c6 890 defsubr (&Sbuffer_has_markers_at);
6e57421b 891
29208e82 892 DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag,
2e1280f8 893 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
6e57421b 894 byte_debug_flag = 0;
dcfdbac7 895}