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