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