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