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