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