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