(CHECK_FRAME, CHECK_LIVE_FRAME): Remove unused argument `i' in macros.
[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
52 the corrspondence: BEG, BEGV, PT, GPT, ZV and Z,
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
152 best_below = 1;
153 best_below_byte = 1;
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
329 best_below = 1;
330 best_below_byte = 1;
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;
437 CHECK_MARKER (marker, 0);
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{
dcfdbac7
JB
453 CHECK_MARKER (marker, 0);
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
473 CHECK_MARKER (marker, 0);
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 {
487 CHECK_BUFFER (buffer, 1);
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
509 CHECK_NUMBER_COERCE_MARKER (position, 1);
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
JB
533 }
534
535 return marker;
536}
537
538/* This version of Fset_marker won't let the position
539 be outside the visible part. */
540
541Lisp_Object
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
549 CHECK_MARKER (marker, 0);
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 {
563 CHECK_BUFFER (buffer, 1);
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
585 CHECK_NUMBER_COERCE_MARKER (pos, 1);
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
JB
609 }
610
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
1389ad71
RS
617Lisp_Object
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
625 CHECK_MARKER (marker, 0);
1389ad71 626
1389ad71
RS
627 if (NILP (buffer))
628 b = current_buffer;
629 else
630 {
631 CHECK_BUFFER (buffer, 1);
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 }
661
662 return marker;
663}
664
665/* This version of set_marker_both won't let the position
666 be outside the visible part. */
667
668Lisp_Object
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
676 CHECK_MARKER (marker, 0);
677
678 if (NILP (buffer))
679 b = current_buffer;
680 else
681 {
682 CHECK_BUFFER (buffer, 1);
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 }
721
722 return marker;
723}
724\f
dcfdbac7
JB
725/* This is called during garbage collection,
726 so we must be careful to ignore and preserve mark bits,
727 including those in chain fields of markers. */
728
c0323249 729void
dcfdbac7
JB
730unchain_marker (marker)
731 register Lisp_Object marker;
732{
733 register Lisp_Object tail, prev, next;
609b3978 734 register EMACS_INT omark;
dcfdbac7
JB
735 register struct buffer *b;
736
737 b = XMARKER (marker)->buffer;
738 if (b == 0)
739 return;
740
741 if (EQ (b->name, Qnil))
742 abort ();
743
7693a579
RS
744 XMARKER (marker)->buffer = 0;
745
d281a86a 746 tail = BUF_MARKERS (b);
dcfdbac7 747 prev = Qnil;
8801a864 748 while (! GC_NILP (tail))
dcfdbac7
JB
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 }
7693a579
RS
771 /* We have removed the marker from the chain;
772 no need to scan the rest of the chain. */
773 return;
dcfdbac7
JB
774 }
775 else
776 prev = tail;
777 tail = next;
778 }
7693a579
RS
779
780 /* Marker was not in its chain. */
781 abort ();
dcfdbac7
JB
782}
783
1389ad71 784/* Return the char position of marker MARKER, as a C integer. */
d281a86a
RS
785
786int
dcfdbac7
JB
787marker_position (marker)
788 Lisp_Object marker;
789{
790 register struct Lisp_Marker *m = XMARKER (marker);
791 register struct buffer *buf = m->buffer;
1389ad71
RS
792
793 if (!buf)
794 error ("Marker does not point anywhere");
795
796 return m->charpos;
797}
798
799/* Return the byte position of marker MARKER, as a C integer. */
800
801int
802marker_byte_position (marker)
803 Lisp_Object marker;
804{
805 register struct Lisp_Marker *m = XMARKER (marker);
806 register struct buffer *buf = m->buffer;
1f03507f 807 register int i = m->bytepos;
dcfdbac7
JB
808
809 if (!buf)
810 error ("Marker does not point anywhere");
811
1389ad71 812 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
dcfdbac7
JB
813 abort ();
814
815 return i;
816}
fc299663
RS
817\f
818DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
2e1280f8
PJ
819 doc: /* Return a new marker pointing at the same place as MARKER.
820If argument is a number, makes a new marker pointing
821at that position in the current buffer.
822The optional argument TYPE specifies the insertion type of the new marker;
823see `marker-insertion-type'. */)
824 (marker, type)
fc299663 825 register Lisp_Object marker, type;
dcfdbac7
JB
826{
827 register Lisp_Object new;
828
0469366f 829 if (! (INTEGERP (marker) || MARKERP (marker)))
fc299663 830 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
0469366f
KH
831
832 new = Fmake_marker ();
833 Fset_marker (new, marker,
834 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
835 XMARKER (new)->insertion_type = !NILP (type);
836 return new;
fc299663
RS
837}
838
839DEFUN ("marker-insertion-type", Fmarker_insertion_type,
840 Smarker_insertion_type, 1, 1, 0,
2e1280f8
PJ
841 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
842nil means the marker stays before text inserted there. */)
843 (marker)
fc299663
RS
844 register Lisp_Object marker;
845{
fc299663
RS
846 CHECK_MARKER (marker, 0);
847 return XMARKER (marker)->insertion_type ? Qt : Qnil;
848}
849
850DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
851 Sset_marker_insertion_type, 2, 2, 0,
2e1280f8
PJ
852 doc: /* Set the insertion-type of MARKER to TYPE.
853If TYPE is t, it means the marker advances when you insert text at it.
854If TYPE is nil, it means the marker stays behind when you insert text at it. */)
855 (marker, type)
fc299663
RS
856 Lisp_Object marker, type;
857{
858 CHECK_MARKER (marker, 0);
859
860 XMARKER (marker)->insertion_type = ! NILP (type);
861 return type;
dcfdbac7 862}
9e5896c6
RS
863
864DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
2e1280f8
PJ
865 1, 1, 0,
866 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
867 (position)
868 Lisp_Object position;
9e5896c6
RS
869{
870 register Lisp_Object tail;
871 register int charno;
872
873 charno = XINT (position);
874
875 if (charno < BEG)
876 charno = BEG;
877 if (charno > Z)
878 charno = Z;
9e5896c6
RS
879
880 for (tail = BUF_MARKERS (current_buffer);
34e4751f 881 !NILP (tail);
9e5896c6 882 tail = XMARKER (tail)->chain)
1389ad71 883 if (XMARKER (tail)->charpos == charno)
9e5896c6
RS
884 return Qt;
885
886 return Qnil;
887}
dcfdbac7 888\f
c0323249 889void
dcfdbac7
JB
890syms_of_marker ()
891{
892 defsubr (&Smarker_position);
893 defsubr (&Smarker_buffer);
894 defsubr (&Sset_marker);
895 defsubr (&Scopy_marker);
fc299663
RS
896 defsubr (&Smarker_insertion_type);
897 defsubr (&Sset_marker_insertion_type);
9e5896c6 898 defsubr (&Sbuffer_has_markers_at);
6e57421b
RS
899
900 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
2e1280f8 901 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
6e57421b 902 byte_debug_flag = 0;
dcfdbac7 903}