* lisp/emacs-lisp/find-func.el (find-function-C-source): Only set
[emacs.git] / src / marker.c
blob675bbc5ad7364f577c585f9ec9c2770b5db9738f
1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <setjmp.h>
22 #include "lisp.h"
23 #include "buffer.h"
24 #include "character.h"
26 /* Record one cached position found recently by
27 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
29 static EMACS_INT cached_charpos;
30 static EMACS_INT cached_bytepos;
31 static struct buffer *cached_buffer;
32 static int cached_modiff;
34 static void byte_char_debug_check (struct buffer *, EMACS_INT, EMACS_INT);
36 void
37 clear_charpos_cache (struct buffer *b)
39 if (cached_buffer == b)
40 cached_buffer = 0;
43 /* Converting between character positions and byte positions. */
45 /* There are several places in the buffer where we know
46 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
47 and everywhere there is a marker. So we find the one of these places
48 that is closest to the specified position, and scan from there. */
50 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
52 /* This macro is a subroutine of charpos_to_bytepos.
53 Note that it is desirable that BYTEPOS is not evaluated
54 except when we really want its value. */
56 #define CONSIDER(CHARPOS, BYTEPOS) \
57 { \
58 EMACS_INT this_charpos = (CHARPOS); \
59 int changed = 0; \
61 if (this_charpos == charpos) \
62 { \
63 EMACS_INT value = (BYTEPOS); \
64 if (byte_debug_flag) \
65 byte_char_debug_check (b, charpos, value); \
66 return value; \
67 } \
68 else if (this_charpos > charpos) \
69 { \
70 if (this_charpos < best_above) \
71 { \
72 best_above = this_charpos; \
73 best_above_byte = (BYTEPOS); \
74 changed = 1; \
75 } \
76 } \
77 else if (this_charpos > best_below) \
78 { \
79 best_below = this_charpos; \
80 best_below_byte = (BYTEPOS); \
81 changed = 1; \
82 } \
84 if (changed) \
85 { \
86 if (best_above - best_below == best_above_byte - best_below_byte) \
87 { \
88 EMACS_INT value = best_below_byte + (charpos - best_below); \
89 if (byte_debug_flag) \
90 byte_char_debug_check (b, charpos, value); \
91 return value; \
92 } \
93 } \
96 static void
97 byte_char_debug_check (struct buffer *b, EMACS_INT charpos, EMACS_INT bytepos)
99 EMACS_INT nchars = 0;
101 if (bytepos > BUF_GPT_BYTE (b))
103 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
104 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
105 nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
106 bytepos - BUF_GPT_BYTE (b));
108 else
109 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
110 bytepos - BUF_BEG_BYTE (b));
112 if (charpos - 1 != nchars)
113 abort ();
116 EMACS_INT
117 charpos_to_bytepos (EMACS_INT charpos)
119 return buf_charpos_to_bytepos (current_buffer, charpos);
122 EMACS_INT
123 buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
125 struct Lisp_Marker *tail;
126 EMACS_INT best_above, best_above_byte;
127 EMACS_INT best_below, best_below_byte;
129 if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
130 abort ();
132 best_above = BUF_Z (b);
133 best_above_byte = BUF_Z_BYTE (b);
135 /* If this buffer has as many characters as bytes,
136 each character must be one byte.
137 This takes care of the case where enable-multibyte-characters is nil. */
138 if (best_above == best_above_byte)
139 return charpos;
141 best_below = BEG;
142 best_below_byte = BEG_BYTE;
144 /* We find in best_above and best_above_byte
145 the closest known point above CHARPOS,
146 and in best_below and best_below_byte
147 the closest known point below CHARPOS,
149 If at any point we can tell that the space between those
150 two best approximations is all single-byte,
151 we interpolate the result immediately. */
153 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
154 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
155 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
156 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
158 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
159 CONSIDER (cached_charpos, cached_bytepos);
161 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
163 CONSIDER (tail->charpos, tail->bytepos);
165 /* If we are down to a range of 50 chars,
166 don't bother checking any other markers;
167 scan the intervening chars directly now. */
168 if (best_above - best_below < 50)
169 break;
172 /* We get here if we did not exactly hit one of the known places.
173 We have one known above and one known below.
174 Scan, counting characters, from whichever one is closer. */
176 if (charpos - best_below < best_above - charpos)
178 int record = charpos - best_below > 5000;
180 while (best_below != charpos)
182 best_below++;
183 BUF_INC_POS (b, best_below_byte);
186 /* If this position is quite far from the nearest known position,
187 cache the correspondence by creating a marker here.
188 It will last until the next GC. */
189 if (record)
191 Lisp_Object marker, buffer;
192 marker = Fmake_marker ();
193 XSETBUFFER (buffer, b);
194 set_marker_both (marker, buffer, best_below, best_below_byte);
197 if (byte_debug_flag)
198 byte_char_debug_check (b, charpos, best_below_byte);
200 cached_buffer = b;
201 cached_modiff = BUF_MODIFF (b);
202 cached_charpos = best_below;
203 cached_bytepos = best_below_byte;
205 return best_below_byte;
207 else
209 int record = best_above - charpos > 5000;
211 while (best_above != charpos)
213 best_above--;
214 BUF_DEC_POS (b, best_above_byte);
217 /* If this position is quite far from the nearest known position,
218 cache the correspondence by creating a marker here.
219 It will last until the next GC. */
220 if (record)
222 Lisp_Object marker, buffer;
223 marker = Fmake_marker ();
224 XSETBUFFER (buffer, b);
225 set_marker_both (marker, buffer, best_above, best_above_byte);
228 if (byte_debug_flag)
229 byte_char_debug_check (b, charpos, best_above_byte);
231 cached_buffer = b;
232 cached_modiff = BUF_MODIFF (b);
233 cached_charpos = best_above;
234 cached_bytepos = best_above_byte;
236 return best_above_byte;
240 #undef CONSIDER
242 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
243 in the simplest, most reliable way. */
245 extern EMACS_INT verify_bytepos (EMACS_INT charpos) EXTERNALLY_VISIBLE;
246 EMACS_INT
247 verify_bytepos (EMACS_INT charpos)
249 EMACS_INT below = 1;
250 EMACS_INT below_byte = 1;
252 while (below != charpos)
254 below++;
255 BUF_INC_POS (current_buffer, below_byte);
258 return below_byte;
261 /* buf_bytepos_to_charpos returns the char position corresponding to
262 BYTEPOS. */
264 /* This macro is a subroutine of buf_bytepos_to_charpos.
265 It is used when BYTEPOS is actually the byte position. */
267 #define CONSIDER(BYTEPOS, CHARPOS) \
269 EMACS_INT this_bytepos = (BYTEPOS); \
270 int changed = 0; \
272 if (this_bytepos == bytepos) \
274 EMACS_INT value = (CHARPOS); \
275 if (byte_debug_flag) \
276 byte_char_debug_check (b, value, bytepos); \
277 return value; \
279 else if (this_bytepos > bytepos) \
281 if (this_bytepos < best_above_byte) \
283 best_above = (CHARPOS); \
284 best_above_byte = this_bytepos; \
285 changed = 1; \
288 else if (this_bytepos > best_below_byte) \
290 best_below = (CHARPOS); \
291 best_below_byte = this_bytepos; \
292 changed = 1; \
295 if (changed) \
297 if (best_above - best_below == best_above_byte - best_below_byte) \
299 EMACS_INT value = best_below + (bytepos - best_below_byte); \
300 if (byte_debug_flag) \
301 byte_char_debug_check (b, value, bytepos); \
302 return value; \
307 EMACS_INT
308 buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
310 struct Lisp_Marker *tail;
311 EMACS_INT best_above, best_above_byte;
312 EMACS_INT best_below, best_below_byte;
314 if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
315 abort ();
317 best_above = BUF_Z (b);
318 best_above_byte = BUF_Z_BYTE (b);
320 /* If this buffer has as many characters as bytes,
321 each character must be one byte.
322 This takes care of the case where enable-multibyte-characters is nil. */
323 if (best_above == best_above_byte)
324 return bytepos;
326 best_below = BEG;
327 best_below_byte = BEG_BYTE;
329 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
330 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
331 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
332 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
334 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
335 CONSIDER (cached_bytepos, cached_charpos);
337 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
339 CONSIDER (tail->bytepos, tail->charpos);
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;
348 /* We get here if we did not exactly hit one of the known places.
349 We have one known above and one known below.
350 Scan, counting characters, from whichever one is closer. */
352 if (bytepos - best_below_byte < best_above_byte - bytepos)
354 int record = bytepos - best_below_byte > 5000;
356 while (best_below_byte < bytepos)
358 best_below++;
359 BUF_INC_POS (b, best_below_byte);
362 /* If this position is quite far from the nearest known position,
363 cache the correspondence by creating a marker here.
364 It will last until the next GC.
365 But don't do it if BUF_MARKERS is nil;
366 that is a signal from Fset_buffer_multibyte. */
367 if (record && BUF_MARKERS (b))
369 Lisp_Object marker, buffer;
370 marker = Fmake_marker ();
371 XSETBUFFER (buffer, b);
372 set_marker_both (marker, buffer, best_below, best_below_byte);
375 if (byte_debug_flag)
376 byte_char_debug_check (b, best_below, bytepos);
378 cached_buffer = b;
379 cached_modiff = BUF_MODIFF (b);
380 cached_charpos = best_below;
381 cached_bytepos = best_below_byte;
383 return best_below;
385 else
387 int record = best_above_byte - bytepos > 5000;
389 while (best_above_byte > bytepos)
391 best_above--;
392 BUF_DEC_POS (b, best_above_byte);
395 /* If this position is quite far from the nearest known position,
396 cache the correspondence by creating a marker here.
397 It will last until the next GC.
398 But don't do it if BUF_MARKERS is nil;
399 that is a signal from Fset_buffer_multibyte. */
400 if (record && BUF_MARKERS (b))
402 Lisp_Object marker, buffer;
403 marker = Fmake_marker ();
404 XSETBUFFER (buffer, b);
405 set_marker_both (marker, buffer, best_above, best_above_byte);
408 if (byte_debug_flag)
409 byte_char_debug_check (b, best_above, bytepos);
411 cached_buffer = b;
412 cached_modiff = BUF_MODIFF (b);
413 cached_charpos = best_above;
414 cached_bytepos = best_above_byte;
416 return best_above;
420 #undef CONSIDER
422 /* Operations on markers. */
424 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
425 doc: /* Return the buffer that MARKER points into, or nil if none.
426 Returns nil if MARKER points into a dead buffer. */)
427 (register Lisp_Object marker)
429 register Lisp_Object buf;
430 CHECK_MARKER (marker);
431 if (XMARKER (marker)->buffer)
433 XSETBUFFER (buf, XMARKER (marker)->buffer);
434 /* If the buffer is dead, we're in trouble: the buffer pointer here
435 does not preserve the buffer from being GC'd (it's weak), so
436 markers have to be unlinked from their buffer as soon as the buffer
437 is killed. */
438 eassert (!NILP (BVAR (XBUFFER (buf), name)));
439 return buf;
441 return Qnil;
444 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
445 doc: /* Return the position MARKER points at, as a character number.
446 Returns nil if MARKER points nowhere. */)
447 (Lisp_Object marker)
449 CHECK_MARKER (marker);
450 if (XMARKER (marker)->buffer)
451 return make_number (XMARKER (marker)->charpos);
453 return Qnil;
456 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
457 doc: /* Position MARKER before character number POSITION in BUFFER.
458 BUFFER defaults to the current buffer.
459 If POSITION is nil, makes marker point nowhere.
460 Then it no longer slows down editing in any buffer.
461 Returns MARKER. */)
462 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
464 register EMACS_INT charno, bytepos;
465 register struct buffer *b;
466 register struct Lisp_Marker *m;
468 CHECK_MARKER (marker);
469 m = XMARKER (marker);
471 /* If position is nil or a marker that points nowhere,
472 make this marker point nowhere. */
473 if (NILP (position)
474 || (MARKERP (position) && !XMARKER (position)->buffer))
476 unchain_marker (m);
477 return marker;
480 if (NILP (buffer))
481 b = current_buffer;
482 else
484 CHECK_BUFFER (buffer);
485 b = XBUFFER (buffer);
486 /* If buffer is dead, set marker to point nowhere. */
487 if (EQ (BVAR (b, name), Qnil))
489 unchain_marker (m);
490 return marker;
494 /* Optimize the special case where we are copying the position
495 of an existing marker, and MARKER is already in the same buffer. */
496 if (MARKERP (position) && b == XMARKER (position)->buffer
497 && b == m->buffer)
499 m->bytepos = XMARKER (position)->bytepos;
500 m->charpos = XMARKER (position)->charpos;
501 return marker;
504 CHECK_NUMBER_COERCE_MARKER (position);
506 charno = XINT (position);
508 if (charno < BUF_BEG (b))
509 charno = BUF_BEG (b);
510 if (charno > BUF_Z (b))
511 charno = BUF_Z (b);
513 bytepos = buf_charpos_to_bytepos (b, charno);
515 /* Every character is at least one byte. */
516 if (charno > bytepos)
517 abort ();
519 m->bytepos = bytepos;
520 m->charpos = charno;
522 if (m->buffer != b)
524 unchain_marker (m);
525 m->buffer = b;
526 m->next = BUF_MARKERS (b);
527 BUF_MARKERS (b) = m;
530 return marker;
533 /* This version of Fset_marker won't let the position
534 be outside the visible part. */
536 Lisp_Object
537 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
539 register EMACS_INT charno, bytepos;
540 register struct buffer *b;
541 register struct Lisp_Marker *m;
543 CHECK_MARKER (marker);
544 m = XMARKER (marker);
546 /* If position is nil or a marker that points nowhere,
547 make this marker point nowhere. */
548 if (NILP (pos)
549 || (MARKERP (pos) && !XMARKER (pos)->buffer))
551 unchain_marker (m);
552 return marker;
555 if (NILP (buffer))
556 b = current_buffer;
557 else
559 CHECK_BUFFER (buffer);
560 b = XBUFFER (buffer);
561 /* If buffer is dead, set marker to point nowhere. */
562 if (EQ (BVAR (b, name), Qnil))
564 unchain_marker (m);
565 return marker;
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)
574 m->bytepos = XMARKER (pos)->bytepos;
575 m->charpos = XMARKER (pos)->charpos;
576 return marker;
579 CHECK_NUMBER_COERCE_MARKER (pos);
581 charno = XINT (pos);
583 if (charno < BUF_BEGV (b))
584 charno = BUF_BEGV (b);
585 if (charno > BUF_ZV (b))
586 charno = BUF_ZV (b);
588 bytepos = buf_charpos_to_bytepos (b, charno);
590 /* Every character is at least one byte. */
591 if (charno > bytepos)
592 abort ();
594 m->bytepos = bytepos;
595 m->charpos = charno;
597 if (m->buffer != b)
599 unchain_marker (m);
600 m->buffer = b;
601 m->next = BUF_MARKERS (b);
602 BUF_MARKERS (b) = m;
605 return marker;
608 /* Set the position of MARKER, specifying both the
609 character position and the corresponding byte position. */
611 Lisp_Object
612 set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
614 register struct buffer *b;
615 register struct Lisp_Marker *m;
617 CHECK_MARKER (marker);
618 m = XMARKER (marker);
620 if (NILP (buffer))
621 b = current_buffer;
622 else
624 CHECK_BUFFER (buffer);
625 b = XBUFFER (buffer);
626 /* If buffer is dead, set marker to point nowhere. */
627 if (EQ (BVAR (b, name), Qnil))
629 unchain_marker (m);
630 return marker;
634 /* In a single-byte buffer, the two positions must be equal. */
635 if (BUF_Z (b) == BUF_Z_BYTE (b)
636 && charpos != bytepos)
637 abort ();
638 /* Every character is at least one byte. */
639 if (charpos > bytepos)
640 abort ();
642 m->bytepos = bytepos;
643 m->charpos = charpos;
645 if (m->buffer != b)
647 unchain_marker (m);
648 m->buffer = b;
649 m->next = BUF_MARKERS (b);
650 BUF_MARKERS (b) = m;
653 return marker;
656 /* This version of set_marker_both won't let the position
657 be outside the visible part. */
659 Lisp_Object
660 set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
662 register struct buffer *b;
663 register struct Lisp_Marker *m;
665 CHECK_MARKER (marker);
666 m = XMARKER (marker);
668 if (NILP (buffer))
669 b = current_buffer;
670 else
672 CHECK_BUFFER (buffer);
673 b = XBUFFER (buffer);
674 /* If buffer is dead, set marker to point nowhere. */
675 if (EQ (BVAR (b, name), Qnil))
677 unchain_marker (m);
678 return marker;
682 if (charpos < BUF_BEGV (b))
683 charpos = BUF_BEGV (b);
684 if (charpos > BUF_ZV (b))
685 charpos = BUF_ZV (b);
686 if (bytepos < BUF_BEGV_BYTE (b))
687 bytepos = BUF_BEGV_BYTE (b);
688 if (bytepos > BUF_ZV_BYTE (b))
689 bytepos = BUF_ZV_BYTE (b);
691 /* In a single-byte buffer, the two positions must be equal. */
692 if (BUF_Z (b) == BUF_Z_BYTE (b)
693 && charpos != bytepos)
694 abort ();
695 /* Every character is at least one byte. */
696 if (charpos > bytepos)
697 abort ();
699 m->bytepos = bytepos;
700 m->charpos = charpos;
702 if (m->buffer != b)
704 unchain_marker (m);
705 m->buffer = b;
706 m->next = BUF_MARKERS (b);
707 BUF_MARKERS (b) = m;
710 return marker;
713 /* Remove MARKER from the chain of whatever buffer it is in.
714 Leave it "in no buffer".
716 This is called during garbage collection,
717 so we must be careful to ignore and preserve mark bits,
718 including those in chain fields of markers. */
720 void
721 unchain_marker (register struct Lisp_Marker *marker)
723 register struct Lisp_Marker *tail, *prev, *next;
724 register struct buffer *b;
726 b = marker->buffer;
727 if (b == 0)
728 return;
730 if (EQ (BVAR (b, name), Qnil))
731 abort ();
733 marker->buffer = 0;
735 tail = BUF_MARKERS (b);
736 prev = NULL;
737 while (tail)
739 next = tail->next;
741 if (marker == tail)
743 if (!prev)
745 BUF_MARKERS (b) = next;
746 /* Deleting first marker from the buffer's chain. Crash
747 if new first marker in chain does not say it belongs
748 to the same buffer, or at least that they have the same
749 base buffer. */
750 if (next && b->text != next->buffer->text)
751 abort ();
753 else
754 prev->next = next;
755 /* We have removed the marker from the chain;
756 no need to scan the rest of the chain. */
757 return;
759 else
760 prev = tail;
761 tail = next;
764 /* Marker was not in its chain. */
765 abort ();
768 /* Return the char position of marker MARKER, as a C integer. */
770 EMACS_INT
771 marker_position (Lisp_Object marker)
773 register struct Lisp_Marker *m = XMARKER (marker);
774 register struct buffer *buf = m->buffer;
776 if (!buf)
777 error ("Marker does not point anywhere");
779 return m->charpos;
782 /* Return the byte position of marker MARKER, as a C integer. */
784 EMACS_INT
785 marker_byte_position (Lisp_Object marker)
787 register struct Lisp_Marker *m = XMARKER (marker);
788 register struct buffer *buf = m->buffer;
789 register EMACS_INT i = m->bytepos;
791 if (!buf)
792 error ("Marker does not point anywhere");
794 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
795 abort ();
797 return i;
800 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
801 doc: /* Return a new marker pointing at the same place as MARKER.
802 If argument is a number, makes a new marker pointing
803 at that position in the current buffer.
804 If MARKER is not specified, the new marker does not point anywhere.
805 The optional argument TYPE specifies the insertion type of the new marker;
806 see `marker-insertion-type'. */)
807 (register Lisp_Object marker, Lisp_Object type)
809 register Lisp_Object new;
811 if (!NILP (marker))
812 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
814 new = Fmake_marker ();
815 Fset_marker (new, marker,
816 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
817 XMARKER (new)->insertion_type = !NILP (type);
818 return new;
821 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
822 Smarker_insertion_type, 1, 1, 0,
823 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
824 The value nil means the marker stays before text inserted there. */)
825 (register Lisp_Object marker)
827 CHECK_MARKER (marker);
828 return XMARKER (marker)->insertion_type ? Qt : Qnil;
831 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
832 Sset_marker_insertion_type, 2, 2, 0,
833 doc: /* Set the insertion-type of MARKER to TYPE.
834 If TYPE is t, it means the marker advances when you insert text at it.
835 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
836 (Lisp_Object marker, Lisp_Object type)
838 CHECK_MARKER (marker);
840 XMARKER (marker)->insertion_type = ! NILP (type);
841 return type;
844 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
845 1, 1, 0,
846 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
847 (Lisp_Object position)
849 register struct Lisp_Marker *tail;
850 register EMACS_INT charno;
852 charno = XINT (position);
854 if (charno < BEG)
855 charno = BEG;
856 if (charno > Z)
857 charno = Z;
859 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
860 if (tail->charpos == charno)
861 return Qt;
863 return Qnil;
866 /* For debugging -- count the markers in buffer BUF. */
868 extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
870 count_markers (struct buffer *buf)
872 int total = 0;
873 struct Lisp_Marker *tail;
875 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
876 total++;
878 return total;
881 void
882 syms_of_marker (void)
884 defsubr (&Smarker_position);
885 defsubr (&Smarker_buffer);
886 defsubr (&Sset_marker);
887 defsubr (&Scopy_marker);
888 defsubr (&Smarker_insertion_type);
889 defsubr (&Sset_marker_insertion_type);
890 defsubr (&Sbuffer_has_markers_at);
892 DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag,
893 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
894 byte_debug_flag = 0;