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