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