Compile marker debugging code only if ENABLE_CHECKING is defined.
[bpt/emacs.git] / src / marker.c
1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2012 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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.
10
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.
15
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/>. */
18
19
20 #include <config.h>
21 #include <setjmp.h>
22 #include "lisp.h"
23 #include "character.h"
24 #include "buffer.h"
25
26 /* Record one cached position found recently by
27 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
28
29 static ptrdiff_t cached_charpos;
30 static ptrdiff_t cached_bytepos;
31 static struct buffer *cached_buffer;
32 static int cached_modiff;
33
34 #ifdef ENABLE_CHECKING
35
36 extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
37
38 static void
39 byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
40 {
41 ptrdiff_t nchars = 0;
42
43 if (bytepos > BUF_GPT_BYTE (b))
44 {
45 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
46 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
47 nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
48 bytepos - BUF_GPT_BYTE (b));
49 }
50 else
51 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
52 bytepos - BUF_BEG_BYTE (b));
53
54 if (charpos - 1 != nchars)
55 abort ();
56 }
57
58 #else /* not ENABLE_CHECKING */
59
60 #define byte_char_debug_check(b,charpos,bytepos) do { } while (0)
61
62 #endif /* ENABLE_CHECKING */
63
64 void
65 clear_charpos_cache (struct buffer *b)
66 {
67 if (cached_buffer == b)
68 cached_buffer = 0;
69 }
70 \f
71 /* Converting between character positions and byte positions. */
72
73 /* There are several places in the buffer where we know
74 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
75 and everywhere there is a marker. So we find the one of these places
76 that is closest to the specified position, and scan from there. */
77
78 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
79
80 /* This macro is a subroutine of charpos_to_bytepos.
81 Note that it is desirable that BYTEPOS is not evaluated
82 except when we really want its value. */
83
84 #define CONSIDER(CHARPOS, BYTEPOS) \
85 { \
86 ptrdiff_t this_charpos = (CHARPOS); \
87 int changed = 0; \
88 \
89 if (this_charpos == charpos) \
90 { \
91 ptrdiff_t value = (BYTEPOS); \
92 \
93 byte_char_debug_check (b, charpos, value); \
94 return value; \
95 } \
96 else if (this_charpos > charpos) \
97 { \
98 if (this_charpos < best_above) \
99 { \
100 best_above = this_charpos; \
101 best_above_byte = (BYTEPOS); \
102 changed = 1; \
103 } \
104 } \
105 else if (this_charpos > best_below) \
106 { \
107 best_below = this_charpos; \
108 best_below_byte = (BYTEPOS); \
109 changed = 1; \
110 } \
111 \
112 if (changed) \
113 { \
114 if (best_above - best_below == best_above_byte - best_below_byte) \
115 { \
116 ptrdiff_t value = best_below_byte + (charpos - best_below); \
117 \
118 byte_char_debug_check (b, charpos, value); \
119 return value; \
120 } \
121 } \
122 }
123
124 ptrdiff_t
125 charpos_to_bytepos (ptrdiff_t charpos)
126 {
127 return buf_charpos_to_bytepos (current_buffer, charpos);
128 }
129
130 ptrdiff_t
131 buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
132 {
133 struct Lisp_Marker *tail;
134 ptrdiff_t best_above, best_above_byte;
135 ptrdiff_t best_below, best_below_byte;
136
137 if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
138 abort ();
139
140 best_above = BUF_Z (b);
141 best_above_byte = BUF_Z_BYTE (b);
142
143 /* If this buffer has as many characters as bytes,
144 each character must be one byte.
145 This takes care of the case where enable-multibyte-characters is nil. */
146 if (best_above == best_above_byte)
147 return charpos;
148
149 best_below = BEG;
150 best_below_byte = BEG_BYTE;
151
152 /* We find in best_above and best_above_byte
153 the closest known point above CHARPOS,
154 and in best_below and best_below_byte
155 the closest known point below CHARPOS,
156
157 If at any point we can tell that the space between those
158 two best approximations is all single-byte,
159 we interpolate the result immediately. */
160
161 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
162 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
163 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
164 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
165
166 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
167 CONSIDER (cached_charpos, cached_bytepos);
168
169 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
170 {
171 CONSIDER (tail->charpos, tail->bytepos);
172
173 /* If we are down to a range of 50 chars,
174 don't bother checking any other markers;
175 scan the intervening chars directly now. */
176 if (best_above - best_below < 50)
177 break;
178 }
179
180 /* We get here if we did not exactly hit one of the known places.
181 We have one known above and one known below.
182 Scan, counting characters, from whichever one is closer. */
183
184 if (charpos - best_below < best_above - charpos)
185 {
186 int record = charpos - best_below > 5000;
187
188 while (best_below != charpos)
189 {
190 best_below++;
191 BUF_INC_POS (b, best_below_byte);
192 }
193
194 /* If this position is quite far from the nearest known position,
195 cache the correspondence by creating a marker here.
196 It will last until the next GC. */
197 if (record)
198 build_marker (b, best_below, best_below_byte);
199
200 byte_char_debug_check (b, charpos, best_below_byte);
201
202 cached_buffer = b;
203 cached_modiff = BUF_MODIFF (b);
204 cached_charpos = best_below;
205 cached_bytepos = best_below_byte;
206
207 return best_below_byte;
208 }
209 else
210 {
211 int record = best_above - charpos > 5000;
212
213 while (best_above != charpos)
214 {
215 best_above--;
216 BUF_DEC_POS (b, best_above_byte);
217 }
218
219 /* If this position is quite far from the nearest known position,
220 cache the correspondence by creating a marker here.
221 It will last until the next GC. */
222 if (record)
223 build_marker (b, best_above, best_above_byte);
224
225 byte_char_debug_check (b, charpos, best_above_byte);
226
227 cached_buffer = b;
228 cached_modiff = BUF_MODIFF (b);
229 cached_charpos = best_above;
230 cached_bytepos = best_above_byte;
231
232 return best_above_byte;
233 }
234 }
235
236 #undef CONSIDER
237
238 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
239 in the simplest, most reliable way. */
240
241 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
242 ptrdiff_t
243 verify_bytepos (ptrdiff_t charpos)
244 {
245 ptrdiff_t below = 1;
246 ptrdiff_t below_byte = 1;
247
248 while (below != charpos)
249 {
250 below++;
251 BUF_INC_POS (current_buffer, below_byte);
252 }
253
254 return below_byte;
255 }
256 \f
257 /* buf_bytepos_to_charpos returns the char position corresponding to
258 BYTEPOS. */
259
260 /* This macro is a subroutine of buf_bytepos_to_charpos.
261 It is used when BYTEPOS is actually the byte position. */
262
263 #define CONSIDER(BYTEPOS, CHARPOS) \
264 { \
265 ptrdiff_t this_bytepos = (BYTEPOS); \
266 int changed = 0; \
267 \
268 if (this_bytepos == bytepos) \
269 { \
270 ptrdiff_t value = (CHARPOS); \
271 \
272 byte_char_debug_check (b, value, bytepos); \
273 return value; \
274 } \
275 else if (this_bytepos > bytepos) \
276 { \
277 if (this_bytepos < best_above_byte) \
278 { \
279 best_above = (CHARPOS); \
280 best_above_byte = this_bytepos; \
281 changed = 1; \
282 } \
283 } \
284 else if (this_bytepos > best_below_byte) \
285 { \
286 best_below = (CHARPOS); \
287 best_below_byte = this_bytepos; \
288 changed = 1; \
289 } \
290 \
291 if (changed) \
292 { \
293 if (best_above - best_below == best_above_byte - best_below_byte) \
294 { \
295 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
296 \
297 byte_char_debug_check (b, value, bytepos); \
298 return value; \
299 } \
300 } \
301 }
302
303 ptrdiff_t
304 buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
305 {
306 struct Lisp_Marker *tail;
307 ptrdiff_t best_above, best_above_byte;
308 ptrdiff_t best_below, best_below_byte;
309
310 if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
311 abort ();
312
313 best_above = BUF_Z (b);
314 best_above_byte = BUF_Z_BYTE (b);
315
316 /* If this buffer has as many characters as bytes,
317 each character must be one byte.
318 This takes care of the case where enable-multibyte-characters is nil. */
319 if (best_above == best_above_byte)
320 return bytepos;
321
322 best_below = BEG;
323 best_below_byte = BEG_BYTE;
324
325 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
326 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
327 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
328 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
329
330 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
331 CONSIDER (cached_bytepos, cached_charpos);
332
333 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
334 {
335 CONSIDER (tail->bytepos, tail->charpos);
336
337 /* If we are down to a range of 50 chars,
338 don't bother checking any other markers;
339 scan the intervening chars directly now. */
340 if (best_above - best_below < 50)
341 break;
342 }
343
344 /* We get here if we did not exactly hit one of the known places.
345 We have one known above and one known below.
346 Scan, counting characters, from whichever one is closer. */
347
348 if (bytepos - best_below_byte < best_above_byte - bytepos)
349 {
350 int record = bytepos - best_below_byte > 5000;
351
352 while (best_below_byte < bytepos)
353 {
354 best_below++;
355 BUF_INC_POS (b, best_below_byte);
356 }
357
358 /* If this position is quite far from the nearest known position,
359 cache the correspondence by creating a marker here.
360 It will last until the next GC.
361 But don't do it if BUF_MARKERS is nil;
362 that is a signal from Fset_buffer_multibyte. */
363 if (record && BUF_MARKERS (b))
364 build_marker (b, best_below, best_below_byte);
365
366 byte_char_debug_check (b, best_below, bytepos);
367
368 cached_buffer = b;
369 cached_modiff = BUF_MODIFF (b);
370 cached_charpos = best_below;
371 cached_bytepos = best_below_byte;
372
373 return best_below;
374 }
375 else
376 {
377 int record = best_above_byte - bytepos > 5000;
378
379 while (best_above_byte > bytepos)
380 {
381 best_above--;
382 BUF_DEC_POS (b, best_above_byte);
383 }
384
385 /* If this position is quite far from the nearest known position,
386 cache the correspondence by creating a marker here.
387 It will last until the next GC.
388 But don't do it if BUF_MARKERS is nil;
389 that is a signal from Fset_buffer_multibyte. */
390 if (record && BUF_MARKERS (b))
391 build_marker (b, best_above, best_above_byte);
392
393 byte_char_debug_check (b, best_above, bytepos);
394
395 cached_buffer = b;
396 cached_modiff = BUF_MODIFF (b);
397 cached_charpos = best_above;
398 cached_bytepos = best_above_byte;
399
400 return best_above;
401 }
402 }
403
404 #undef CONSIDER
405 \f
406 /* Operations on markers. */
407
408 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
409 doc: /* Return the buffer that MARKER points into, or nil if none.
410 Returns nil if MARKER points into a dead buffer. */)
411 (register Lisp_Object marker)
412 {
413 register Lisp_Object buf;
414 CHECK_MARKER (marker);
415 if (XMARKER (marker)->buffer)
416 {
417 XSETBUFFER (buf, XMARKER (marker)->buffer);
418 /* If the buffer is dead, we're in trouble: the buffer pointer here
419 does not preserve the buffer from being GC'd (it's weak), so
420 markers have to be unlinked from their buffer as soon as the buffer
421 is killed. */
422 eassert (!NILP (BVAR (XBUFFER (buf), name)));
423 return buf;
424 }
425 return Qnil;
426 }
427
428 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
429 doc: /* Return the position MARKER points at, as a character number.
430 Returns nil if MARKER points nowhere. */)
431 (Lisp_Object marker)
432 {
433 CHECK_MARKER (marker);
434 if (XMARKER (marker)->buffer)
435 return make_number (XMARKER (marker)->charpos);
436
437 return Qnil;
438 }
439
440 /* Change M so it points to B at CHARPOS and BYTEPOS. */
441
442 static inline void
443 attach_marker (struct Lisp_Marker *m, struct buffer *b,
444 ptrdiff_t charpos, ptrdiff_t bytepos)
445 {
446 /* Every character is at least one byte. */
447 eassert (charpos <= bytepos);
448
449 m->charpos = charpos;
450 m->bytepos = bytepos;
451
452 if (m->buffer != b)
453 {
454 unchain_marker (m);
455 m->buffer = b;
456 m->next = BUF_MARKERS (b);
457 BUF_MARKERS (b) = m;
458 }
459 }
460
461 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
462 doc: /* Position MARKER before character number POSITION in BUFFER.
463 BUFFER defaults to the current buffer.
464 If POSITION is nil, makes marker point nowhere.
465 Then it no longer slows down editing in any buffer.
466 Returns MARKER. */)
467 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
468 {
469 register ptrdiff_t charpos;
470 register ptrdiff_t bytepos;
471 register struct buffer *b;
472 register struct Lisp_Marker *m;
473
474 CHECK_MARKER (marker);
475 m = XMARKER (marker);
476
477 /* If position is nil or a marker that points nowhere,
478 make this marker point nowhere. */
479 if (NILP (position)
480 || (MARKERP (position) && !XMARKER (position)->buffer))
481 {
482 unchain_marker (m);
483 return marker;
484 }
485
486 if (NILP (buffer))
487 b = current_buffer;
488 else
489 {
490 CHECK_BUFFER (buffer);
491 b = XBUFFER (buffer);
492 /* If buffer is dead, set marker to point nowhere. */
493 if (EQ (BVAR (b, name), Qnil))
494 {
495 unchain_marker (m);
496 return marker;
497 }
498 }
499
500 /* Optimize the special case where we are copying the position
501 of an existing marker, and MARKER is already in the same buffer. */
502 if (MARKERP (position) && b == XMARKER (position)->buffer
503 && b == m->buffer)
504 {
505 m->bytepos = XMARKER (position)->bytepos;
506 m->charpos = XMARKER (position)->charpos;
507 return marker;
508 }
509
510 CHECK_NUMBER_COERCE_MARKER (position);
511 charpos = clip_to_bounds (BUF_BEG (b), XINT (position), BUF_Z (b));
512 bytepos = buf_charpos_to_bytepos (b, charpos);
513
514 attach_marker (m, b, charpos, bytepos);
515 return marker;
516 }
517
518 /* This version of Fset_marker won't let the position
519 be outside the visible part. */
520
521 Lisp_Object
522 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
523 {
524 register ptrdiff_t charpos;
525 register ptrdiff_t bytepos;
526 register struct buffer *b;
527 register struct Lisp_Marker *m;
528
529 CHECK_MARKER (marker);
530 m = XMARKER (marker);
531
532 /* If position is nil or a marker that points nowhere,
533 make this marker point nowhere. */
534 if (NILP (pos)
535 || (MARKERP (pos) && !XMARKER (pos)->buffer))
536 {
537 unchain_marker (m);
538 return marker;
539 }
540
541 if (NILP (buffer))
542 b = current_buffer;
543 else
544 {
545 CHECK_BUFFER (buffer);
546 b = XBUFFER (buffer);
547 /* If buffer is dead, set marker to point nowhere. */
548 if (EQ (BVAR (b, name), Qnil))
549 {
550 unchain_marker (m);
551 return marker;
552 }
553 }
554
555 /* Optimize the special case where we are copying the position
556 of an existing marker, and MARKER is already in the same buffer. */
557 if (MARKERP (pos) && b == XMARKER (pos)->buffer
558 && b == m->buffer)
559 {
560 m->bytepos = XMARKER (pos)->bytepos;
561 m->charpos = XMARKER (pos)->charpos;
562 return marker;
563 }
564
565 CHECK_NUMBER_COERCE_MARKER (pos);
566 charpos = clip_to_bounds (BUF_BEGV (b), XINT (pos), BUF_ZV (b));
567 bytepos = buf_charpos_to_bytepos (b, charpos);
568
569 attach_marker (m, b, charpos, bytepos);
570 return marker;
571 }
572 \f
573 /* Set the position of MARKER, specifying both the
574 character position and the corresponding byte position. */
575
576 Lisp_Object
577 set_marker_both (Lisp_Object marker, Lisp_Object buffer, ptrdiff_t charpos, ptrdiff_t bytepos)
578 {
579 register struct buffer *b;
580 register struct Lisp_Marker *m;
581
582 CHECK_MARKER (marker);
583 m = XMARKER (marker);
584
585 if (NILP (buffer))
586 b = current_buffer;
587 else
588 {
589 CHECK_BUFFER (buffer);
590 b = XBUFFER (buffer);
591 /* If buffer is dead, set marker to point nowhere. */
592 if (EQ (BVAR (b, name), Qnil))
593 {
594 unchain_marker (m);
595 return marker;
596 }
597 }
598
599 /* In a single-byte buffer, the two positions must be equal. */
600 if (BUF_Z (b) == BUF_Z_BYTE (b)
601 && charpos != bytepos)
602 abort ();
603
604 attach_marker (m, b, charpos, bytepos);
605 return marker;
606 }
607
608 /* This version of set_marker_both won't let the position
609 be outside the visible part. */
610
611 Lisp_Object
612 set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, ptrdiff_t charpos, ptrdiff_t bytepos)
613 {
614 register struct buffer *b;
615 register struct Lisp_Marker *m;
616
617 CHECK_MARKER (marker);
618 m = XMARKER (marker);
619
620 if (NILP (buffer))
621 b = current_buffer;
622 else
623 {
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))
628 {
629 unchain_marker (m);
630 return marker;
631 }
632 }
633
634 charpos = clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b));
635 bytepos = clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b));
636
637 /* In a single-byte buffer, the two positions must be equal. */
638 if (BUF_Z (b) == BUF_Z_BYTE (b)
639 && charpos != bytepos)
640 abort ();
641
642 attach_marker (m, b, charpos, bytepos);
643 return marker;
644 }
645 \f
646 /* Remove MARKER from the chain of whatever buffer it is in,
647 leaving it points to nowhere. This is called during garbage
648 collection, so we must be careful to ignore and preserve
649 mark bits, including those in chain fields of markers. */
650
651 void
652 unchain_marker (register struct Lisp_Marker *marker)
653 {
654 register struct buffer *b = marker->buffer;
655
656 if (b)
657 {
658 register struct Lisp_Marker *tail, **prev;
659
660 /* No dead buffers here. */
661 eassert (!NILP (BVAR (b, name)));
662
663 marker->buffer = NULL;
664 prev = &BUF_MARKERS (b);
665
666 for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
667 if (marker == tail)
668 {
669 if (*prev == BUF_MARKERS (b))
670 {
671 /* Deleting first marker from the buffer's chain. Crash
672 if new first marker in chain does not say it belongs
673 to the same buffer, or at least that they have the same
674 base buffer. */
675 if (tail->next && b->text != tail->next->buffer->text)
676 abort ();
677 }
678 *prev = tail->next;
679 /* We have removed the marker from the chain;
680 no need to scan the rest of the chain. */
681 break;
682 }
683
684 /* Error if marker was not in it's chain. */
685 eassert (tail != NULL);
686 }
687 }
688
689 /* Return the char position of marker MARKER, as a C integer. */
690
691 ptrdiff_t
692 marker_position (Lisp_Object marker)
693 {
694 register struct Lisp_Marker *m = XMARKER (marker);
695 register struct buffer *buf = m->buffer;
696
697 if (!buf)
698 error ("Marker does not point anywhere");
699
700 eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
701
702 return m->charpos;
703 }
704
705 /* Return the byte position of marker MARKER, as a C integer. */
706
707 ptrdiff_t
708 marker_byte_position (Lisp_Object marker)
709 {
710 register struct Lisp_Marker *m = XMARKER (marker);
711 register struct buffer *buf = m->buffer;
712
713 if (!buf)
714 error ("Marker does not point anywhere");
715
716 eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
717
718 return m->bytepos;
719 }
720 \f
721 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
722 doc: /* Return a new marker pointing at the same place as MARKER.
723 If argument is a number, makes a new marker pointing
724 at that position in the current buffer.
725 If MARKER is not specified, the new marker does not point anywhere.
726 The optional argument TYPE specifies the insertion type of the new marker;
727 see `marker-insertion-type'. */)
728 (register Lisp_Object marker, Lisp_Object type)
729 {
730 register Lisp_Object new;
731
732 if (!NILP (marker))
733 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
734
735 new = Fmake_marker ();
736 Fset_marker (new, marker,
737 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
738 XMARKER (new)->insertion_type = !NILP (type);
739 return new;
740 }
741
742 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
743 Smarker_insertion_type, 1, 1, 0,
744 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
745 The value nil means the marker stays before text inserted there. */)
746 (register Lisp_Object marker)
747 {
748 CHECK_MARKER (marker);
749 return XMARKER (marker)->insertion_type ? Qt : Qnil;
750 }
751
752 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
753 Sset_marker_insertion_type, 2, 2, 0,
754 doc: /* Set the insertion-type of MARKER to TYPE.
755 If TYPE is t, it means the marker advances when you insert text at it.
756 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
757 (Lisp_Object marker, Lisp_Object type)
758 {
759 CHECK_MARKER (marker);
760
761 XMARKER (marker)->insertion_type = ! NILP (type);
762 return type;
763 }
764
765 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
766 1, 1, 0,
767 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
768 (Lisp_Object position)
769 {
770 register struct Lisp_Marker *tail;
771 register ptrdiff_t charpos;
772
773 charpos = clip_to_bounds (BEG, XINT (position), Z);
774
775 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
776 if (tail->charpos == charpos)
777 return Qt;
778
779 return Qnil;
780 }
781
782 #ifdef ENABLE_CHECKING
783
784 /* For debugging -- count the markers in buffer BUF. */
785
786 int
787 count_markers (struct buffer *buf)
788 {
789 int total = 0;
790 struct Lisp_Marker *tail;
791
792 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
793 total++;
794
795 return total;
796 }
797
798 #endif /* ENABLE_CHECKING */
799 \f
800 void
801 syms_of_marker (void)
802 {
803 defsubr (&Smarker_position);
804 defsubr (&Smarker_buffer);
805 defsubr (&Sset_marker);
806 defsubr (&Scopy_marker);
807 defsubr (&Smarker_insertion_type);
808 defsubr (&Sset_marker_insertion_type);
809 defsubr (&Sbuffer_has_markers_at);
810 }