]> code.delx.au - gnu-emacs/blob - src/marker.c
Merge from emacs-23
[gnu-emacs] / 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, 2011 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 EMACS_INT cached_charpos;
31 static EMACS_INT cached_bytepos;
32 static struct buffer *cached_buffer;
33 static int cached_modiff;
34
35 static void byte_char_debug_check (struct buffer *, EMACS_INT, EMACS_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 EMACS_INT this_charpos = (CHARPOS); \
64 int changed = 0; \
65 \
66 if (this_charpos == charpos) \
67 { \
68 EMACS_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 EMACS_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, EMACS_INT charpos, EMACS_INT bytepos)
103 {
104 EMACS_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 EMACS_INT
122 charpos_to_bytepos (EMACS_INT charpos)
123 {
124 return buf_charpos_to_bytepos (current_buffer, charpos);
125 }
126
127 EMACS_INT
128 buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
129 {
130 struct Lisp_Marker *tail;
131 EMACS_INT best_above, best_above_byte;
132 EMACS_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 EMACS_INT
251 verify_bytepos (EMACS_INT charpos)
252 {
253 EMACS_INT below = 1;
254 EMACS_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 EMACS_INT this_bytepos = (BYTEPOS); \
273 int changed = 0; \
274 \
275 if (this_bytepos == bytepos) \
276 { \
277 EMACS_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 EMACS_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 EMACS_INT
311 bytepos_to_charpos (EMACS_INT bytepos)
312 {
313 return buf_bytepos_to_charpos (current_buffer, bytepos);
314 }
315
316 EMACS_INT
317 buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
318 {
319 struct Lisp_Marker *tail;
320 EMACS_INT best_above, best_above_byte;
321 EMACS_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 (register Lisp_Object marker)
437 {
438 register Lisp_Object buf;
439 CHECK_MARKER (marker);
440 if (XMARKER (marker)->buffer)
441 {
442 XSETBUFFER (buf, XMARKER (marker)->buffer);
443 /* If the buffer is dead, we're in trouble: the buffer pointer here
444 does not preserve the buffer from being GC'd (it's weak), so
445 markers have to be unlinked from their buffer as soon as the buffer
446 is killed. */
447 eassert (!NILP (XBUFFER (buf)->name));
448 return buf;
449 }
450 return Qnil;
451 }
452
453 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
454 doc: /* Return the position MARKER points at, as a character number.
455 Returns nil if MARKER points nowhere. */)
456 (Lisp_Object marker)
457 {
458 CHECK_MARKER (marker);
459 if (XMARKER (marker)->buffer)
460 return make_number (XMARKER (marker)->charpos);
461
462 return Qnil;
463 }
464 \f
465 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
466 doc: /* Position MARKER before character number POSITION in BUFFER.
467 BUFFER defaults to the current buffer.
468 If POSITION is nil, makes marker point nowhere.
469 Then it no longer slows down editing in any buffer.
470 Returns MARKER. */)
471 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
472 {
473 register EMACS_INT charno, bytepos;
474 register struct buffer *b;
475 register struct Lisp_Marker *m;
476
477 CHECK_MARKER (marker);
478 m = XMARKER (marker);
479
480 /* If position is nil or a marker that points nowhere,
481 make this marker point nowhere. */
482 if (NILP (position)
483 || (MARKERP (position) && !XMARKER (position)->buffer))
484 {
485 unchain_marker (m);
486 return marker;
487 }
488
489 if (NILP (buffer))
490 b = current_buffer;
491 else
492 {
493 CHECK_BUFFER (buffer);
494 b = XBUFFER (buffer);
495 /* If buffer is dead, set marker to point nowhere. */
496 if (EQ (b->name, Qnil))
497 {
498 unchain_marker (m);
499 return marker;
500 }
501 }
502
503 /* Optimize the special case where we are copying the position
504 of an existing marker, and MARKER is already in the same buffer. */
505 if (MARKERP (position) && b == XMARKER (position)->buffer
506 && b == m->buffer)
507 {
508 m->bytepos = XMARKER (position)->bytepos;
509 m->charpos = XMARKER (position)->charpos;
510 return marker;
511 }
512
513 CHECK_NUMBER_COERCE_MARKER (position);
514
515 charno = XINT (position);
516
517 if (charno < BUF_BEG (b))
518 charno = BUF_BEG (b);
519 if (charno > BUF_Z (b))
520 charno = BUF_Z (b);
521
522 bytepos = buf_charpos_to_bytepos (b, charno);
523
524 /* Every character is at least one byte. */
525 if (charno > bytepos)
526 abort ();
527
528 m->bytepos = bytepos;
529 m->charpos = charno;
530
531 if (m->buffer != b)
532 {
533 unchain_marker (m);
534 m->buffer = b;
535 m->next = BUF_MARKERS (b);
536 BUF_MARKERS (b) = m;
537 }
538
539 return marker;
540 }
541
542 /* This version of Fset_marker won't let the position
543 be outside the visible part. */
544
545 Lisp_Object
546 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
547 {
548 register EMACS_INT charno, bytepos;
549 register struct buffer *b;
550 register struct Lisp_Marker *m;
551
552 CHECK_MARKER (marker);
553 m = XMARKER (marker);
554
555 /* If position is nil or a marker that points nowhere,
556 make this marker point nowhere. */
557 if (NILP (pos)
558 || (MARKERP (pos) && !XMARKER (pos)->buffer))
559 {
560 unchain_marker (m);
561 return marker;
562 }
563
564 if (NILP (buffer))
565 b = current_buffer;
566 else
567 {
568 CHECK_BUFFER (buffer);
569 b = XBUFFER (buffer);
570 /* If buffer is dead, set marker to point nowhere. */
571 if (EQ (b->name, Qnil))
572 {
573 unchain_marker (m);
574 return marker;
575 }
576 }
577
578 /* Optimize the special case where we are copying the position
579 of an existing marker, and MARKER is already in the same buffer. */
580 if (MARKERP (pos) && b == XMARKER (pos)->buffer
581 && b == m->buffer)
582 {
583 m->bytepos = XMARKER (pos)->bytepos;
584 m->charpos = XMARKER (pos)->charpos;
585 return marker;
586 }
587
588 CHECK_NUMBER_COERCE_MARKER (pos);
589
590 charno = XINT (pos);
591
592 if (charno < BUF_BEGV (b))
593 charno = BUF_BEGV (b);
594 if (charno > BUF_ZV (b))
595 charno = BUF_ZV (b);
596
597 bytepos = buf_charpos_to_bytepos (b, charno);
598
599 /* Every character is at least one byte. */
600 if (charno > bytepos)
601 abort ();
602
603 m->bytepos = bytepos;
604 m->charpos = charno;
605
606 if (m->buffer != b)
607 {
608 unchain_marker (m);
609 m->buffer = b;
610 m->next = BUF_MARKERS (b);
611 BUF_MARKERS (b) = m;
612 }
613
614 return marker;
615 }
616 \f
617 /* Set the position of MARKER, specifying both the
618 character position and the corresponding byte position. */
619
620 Lisp_Object
621 set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
622 {
623 register struct buffer *b;
624 register struct Lisp_Marker *m;
625
626 CHECK_MARKER (marker);
627 m = XMARKER (marker);
628
629 if (NILP (buffer))
630 b = current_buffer;
631 else
632 {
633 CHECK_BUFFER (buffer);
634 b = XBUFFER (buffer);
635 /* If buffer is dead, set marker to point nowhere. */
636 if (EQ (b->name, Qnil))
637 {
638 unchain_marker (m);
639 return marker;
640 }
641 }
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 (m);
657 m->buffer = b;
658 m->next = BUF_MARKERS (b);
659 BUF_MARKERS (b) = m;
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 (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
670 {
671 register struct buffer *b;
672 register struct Lisp_Marker *m;
673
674 CHECK_MARKER (marker);
675 m = XMARKER (marker);
676
677 if (NILP (buffer))
678 b = current_buffer;
679 else
680 {
681 CHECK_BUFFER (buffer);
682 b = XBUFFER (buffer);
683 /* If buffer is dead, set marker to point nowhere. */
684 if (EQ (b->name, Qnil))
685 {
686 unchain_marker (m);
687 return marker;
688 }
689 }
690
691 if (charpos < BUF_BEGV (b))
692 charpos = BUF_BEGV (b);
693 if (charpos > BUF_ZV (b))
694 charpos = BUF_ZV (b);
695 if (bytepos < BUF_BEGV_BYTE (b))
696 bytepos = BUF_BEGV_BYTE (b);
697 if (bytepos > BUF_ZV_BYTE (b))
698 bytepos = BUF_ZV_BYTE (b);
699
700 /* In a single-byte buffer, the two positions must be equal. */
701 if (BUF_Z (b) == BUF_Z_BYTE (b)
702 && charpos != bytepos)
703 abort ();
704 /* Every character is at least one byte. */
705 if (charpos > bytepos)
706 abort ();
707
708 m->bytepos = bytepos;
709 m->charpos = charpos;
710
711 if (m->buffer != b)
712 {
713 unchain_marker (m);
714 m->buffer = b;
715 m->next = BUF_MARKERS (b);
716 BUF_MARKERS (b) = m;
717 }
718
719 return marker;
720 }
721 \f
722 /* Remove MARKER from the chain of whatever buffer it is in.
723 Leave it "in no buffer".
724
725 This is called during garbage collection,
726 so we must be careful to ignore and preserve mark bits,
727 including those in chain fields of markers. */
728
729 void
730 unchain_marker (register struct Lisp_Marker *marker)
731 {
732 register struct Lisp_Marker *tail, *prev, *next;
733 register struct buffer *b;
734
735 b = marker->buffer;
736 if (b == 0)
737 return;
738
739 if (EQ (b->name, Qnil))
740 abort ();
741
742 marker->buffer = 0;
743
744 tail = BUF_MARKERS (b);
745 prev = NULL;
746 while (tail)
747 {
748 next = tail->next;
749
750 if (marker == tail)
751 {
752 if (!prev)
753 {
754 BUF_MARKERS (b) = next;
755 /* Deleting first marker from the buffer's chain. Crash
756 if new first marker in chain does not say it belongs
757 to the same buffer, or at least that they have the same
758 base buffer. */
759 if (next && b->text != next->buffer->text)
760 abort ();
761 }
762 else
763 prev->next = next;
764 /* We have removed the marker from the chain;
765 no need to scan the rest of the chain. */
766 return;
767 }
768 else
769 prev = tail;
770 tail = next;
771 }
772
773 /* Marker was not in its chain. */
774 abort ();
775 }
776
777 /* Return the char position of marker MARKER, as a C integer. */
778
779 EMACS_INT
780 marker_position (Lisp_Object marker)
781 {
782 register struct Lisp_Marker *m = XMARKER (marker);
783 register struct buffer *buf = m->buffer;
784
785 if (!buf)
786 error ("Marker does not point anywhere");
787
788 return m->charpos;
789 }
790
791 /* Return the byte position of marker MARKER, as a C integer. */
792
793 EMACS_INT
794 marker_byte_position (Lisp_Object marker)
795 {
796 register struct Lisp_Marker *m = XMARKER (marker);
797 register struct buffer *buf = m->buffer;
798 register EMACS_INT i = m->bytepos;
799
800 if (!buf)
801 error ("Marker does not point anywhere");
802
803 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
804 abort ();
805
806 return i;
807 }
808 \f
809 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
810 doc: /* Return a new marker pointing at the same place as MARKER.
811 If argument is a number, makes a new marker pointing
812 at that position in the current buffer.
813 If MARKER is not specified, the new marker does not point anywhere.
814 The optional argument TYPE specifies the insertion type of the new marker;
815 see `marker-insertion-type'. */)
816 (register Lisp_Object marker, Lisp_Object type)
817 {
818 register Lisp_Object new;
819
820 if (!NILP (marker))
821 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
822
823 new = Fmake_marker ();
824 Fset_marker (new, marker,
825 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
826 XMARKER (new)->insertion_type = !NILP (type);
827 return new;
828 }
829
830 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
831 Smarker_insertion_type, 1, 1, 0,
832 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
833 The value nil means the marker stays before text inserted there. */)
834 (register Lisp_Object marker)
835 {
836 CHECK_MARKER (marker);
837 return XMARKER (marker)->insertion_type ? Qt : Qnil;
838 }
839
840 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
841 Sset_marker_insertion_type, 2, 2, 0,
842 doc: /* Set the insertion-type of MARKER to TYPE.
843 If TYPE is t, it means the marker advances when you insert text at it.
844 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
845 (Lisp_Object marker, Lisp_Object type)
846 {
847 CHECK_MARKER (marker);
848
849 XMARKER (marker)->insertion_type = ! NILP (type);
850 return type;
851 }
852
853 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
854 1, 1, 0,
855 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
856 (Lisp_Object position)
857 {
858 register struct Lisp_Marker *tail;
859 register EMACS_INT charno;
860
861 charno = XINT (position);
862
863 if (charno < BEG)
864 charno = BEG;
865 if (charno > Z)
866 charno = Z;
867
868 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
869 if (tail->charpos == charno)
870 return Qt;
871
872 return Qnil;
873 }
874
875 /* For debugging -- count the markers in buffer BUF. */
876
877 int
878 count_markers (struct buffer *buf)
879 {
880 int total = 0;
881 struct Lisp_Marker *tail;
882
883 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
884 total++;
885
886 return total;
887 }
888 \f
889 void
890 syms_of_marker (void)
891 {
892 defsubr (&Smarker_position);
893 defsubr (&Smarker_buffer);
894 defsubr (&Sset_marker);
895 defsubr (&Scopy_marker);
896 defsubr (&Smarker_insertion_type);
897 defsubr (&Sset_marker_insertion_type);
898 defsubr (&Sbuffer_has_markers_at);
899
900 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
901 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
902 byte_debug_flag = 0;
903 }
904
905 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
906 (do not change this comment) */