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