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