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