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