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