1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2023 Free Software Foundation,
3 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 (at
10 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 <https://www.gnu.org/licenses/>. */
19
20
21 #include <config.h>
22
23 #include "lisp.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "window.h"
27
28 /* Record one cached position found recently by
29 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
30
31 static ptrdiff_t cached_charpos;
32 static ptrdiff_t cached_bytepos;
33 static struct buffer *cached_buffer;
34 static modiff_count cached_modiff;
35
36 /* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
37 bootstrap time when byte_char_debug_check is enabled; so this
38 is never turned on by --enable-checking configure option. */
39
40 #ifdef MARKER_DEBUG
41
42 extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
43 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
44
45 static void
46 byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
47 {
48 ptrdiff_t nchars;
49
50 if (NILP (BVAR (b, enable_multibyte_characters)))
51 return;
52
53 if (bytepos > BUF_GPT_BYTE (b))
54 nchars
55 = multibyte_chars_in_text (BUF_BEG_ADDR (b),
56 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
57 + multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
58 bytepos - BUF_GPT_BYTE (b));
59 else
60 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
61 bytepos - BUF_BEG_BYTE (b));
62
63 if (charpos - 1 != nchars)
64 emacs_abort ();
65 }
66
67 #else /* not MARKER_DEBUG */
68
69 #define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
70
71 #endif /* MARKER_DEBUG */
72
73 void
74 clear_charpos_cache (struct buffer *b)
75 {
76 if (cached_buffer == b)
77 cached_buffer = 0;
78 }
79
80 /* Converting between character positions and byte positions. */
81
82 /* There are several places in the buffer where we know
83 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
84 and everywhere there is a marker. So we find the one of these places
85 that is closest to the specified position, and scan from there. */
86
87 /* This macro is a subroutine of buf_charpos_to_bytepos.
88 Note that it is desirable that BYTEPOS is not evaluated
89 except when we really want its value. */
90
91 #define CONSIDER(CHARPOS, BYTEPOS) \
92 { \
93 ptrdiff_t this_charpos = (CHARPOS); \
94 bool changed = false; \
95 \
96 if (this_charpos == charpos) \
97 { \
98 ptrdiff_t value = (BYTEPOS); \
99 \
100 byte_char_debug_check (b, charpos, value); \
101 return value; \
102 } \
103 else if (this_charpos > charpos) \
104 { \
105 if (this_charpos < best_above) \
106 { \
107 best_above = this_charpos; \
108 best_above_byte = (BYTEPOS); \
109 changed = true; \
110 } \
111 } \
112 else if (this_charpos > best_below) \
113 { \
114 best_below = this_charpos; \
115 best_below_byte = (BYTEPOS); \
116 changed = true; \
117 } \
118 \
119 if (changed) \
120 { \
121 if (best_above - best_below == best_above_byte - best_below_byte) \
122 { \
123 ptrdiff_t value = best_below_byte + (charpos - best_below); \
124 \
125 byte_char_debug_check (b, charpos, value); \
126 return value; \
127 } \
128 } \
129 }
130
131 static void
132 CHECK_MARKER (Lisp_Object x)
133 {
134 CHECK_TYPE (MARKERP (x), Qmarkerp, x);
135 }
136
137 /* When converting bytes from/to chars, we look through the list of
138 markers to try and find a good starting point (since markers keep
139 track of both bytepos and charpos at the same time).
140 But if there are many markers, it can take too much time to find a "good"
141 marker from which to start. Worse yet: if it takes a long time and we end
142 up finding a nearby markers, we won't add a new marker to cache this
143 result, so next time around we'll have to go through this same long list
144 to (re)find this best marker. So the further down the list of
145 markers we go, the less demanding we are w.r.t what is a good marker.
146
147 The previous code used INITIAL=50 and INCREMENT=0 and this lead to
148 really poor performance when there are many markers.
149 I haven't tried to tweak INITIAL, but experiments on my trusty Thinkpad
150 T61 using various artificial test cases seem to suggest that INCREMENT=50
151 might be "the best compromise": it significantly improved the
152 worst case and it was rarely slower and never by much.
153
154 The asymptotic behavior is still poor, tho, so in largish buffers with many
155 overlays (e.g. 300KB and 30K overlays), it can still be a bottleneck. */
156 #define BYTECHAR_DISTANCE_INITIAL 50
157 #define BYTECHAR_DISTANCE_INCREMENT 50
158
159 /* Return the byte position corresponding to CHARPOS in B. */
160
161 ptrdiff_t
162 buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
163 {
164 struct Lisp_Marker *tail;
165 ptrdiff_t best_above, best_above_byte;
166 ptrdiff_t best_below, best_below_byte;
167 ptrdiff_t distance = BYTECHAR_DISTANCE_INITIAL;
168
169 eassert (BUF_BEG (b) <= charpos && charpos <= BUF_Z (b));
170
171 best_above = BUF_Z (b);
172 best_above_byte = BUF_Z_BYTE (b);
173
174 /* If this buffer has as many characters as bytes,
175 each character must be one byte.
176 This takes care of the case where enable-multibyte-characters is nil. */
177 if (best_above == best_above_byte)
178 return charpos;
179
180 best_below = BEG;
181 best_below_byte = BEG_BYTE;
182
183 /* We find in best_above and best_above_byte
184 the closest known point above CHARPOS,
185 and in best_below and best_below_byte
186 the closest known point below CHARPOS,
187
188 If at any point we can tell that the space between those
189 two best approximations is all single-byte,
190 we interpolate the result immediately. */
191
192 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
193 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
194 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
195 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
196
197 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
198 CONSIDER (cached_charpos, cached_bytepos);
199
200 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
201 {
202 CONSIDER (tail->charpos, tail->bytepos);
203
204 /* If we are down to a range of 50 chars,
205 don't bother checking any other markers;
206 scan the intervening chars directly now. */
207 if (best_above - charpos < distance
208 || charpos - best_below < distance)
209 break;
210 else
211 distance += BYTECHAR_DISTANCE_INCREMENT;
212 }
213
214 /* We get here if we did not exactly hit one of the known places.
215 We have one known above and one known below.
216 Scan, counting characters, from whichever one is closer. */
217
218 eassert (best_below <= charpos && charpos <= best_above);
219 if (charpos - best_below < best_above - charpos)
220 {
221 bool record = charpos - best_below > 5000;
222
223 while (best_below < charpos)
224 {
225 best_below++;
226 best_below_byte += buf_next_char_len (b, best_below_byte);
227 }
228
229 /* If this position is quite far from the nearest known position,
230 cache the correspondence by creating a marker here.
231 It will last until the next GC. */
232 if (record)
233 build_marker (b, best_below, best_below_byte);
234
235 byte_char_debug_check (b, best_below, best_below_byte);
236
237 cached_buffer = b;
238 cached_modiff = BUF_MODIFF (b);
239 cached_charpos = best_below;
240 cached_bytepos = best_below_byte;
241
242 return best_below_byte;
243 }
244 else
245 {
246 bool record = best_above - charpos > 5000;
247
248 while (best_above > charpos)
249 {
250 best_above--;
251 best_above_byte -= buf_prev_char_len (b, best_above_byte);
252 }
253
254 /* If this position is quite far from the nearest known position,
255 cache the correspondence by creating a marker here.
256 It will last until the next GC. */
257 if (record)
258 build_marker (b, best_above, best_above_byte);
259
260 byte_char_debug_check (b, best_above, best_above_byte);
261
262 cached_buffer = b;
263 cached_modiff = BUF_MODIFF (b);
264 cached_charpos = best_above;
265 cached_bytepos = best_above_byte;
266
267 return best_above_byte;
268 }
269 }
270
271 #undef CONSIDER
272
273 /* This macro is a subroutine of buf_bytepos_to_charpos.
274 It is used when BYTEPOS is actually the byte position. */
275
276 #define CONSIDER(BYTEPOS, CHARPOS) \
277 { \
278 ptrdiff_t this_bytepos = (BYTEPOS); \
279 int changed = false; \
280 \
281 if (this_bytepos == bytepos) \
282 { \
283 ptrdiff_t value = (CHARPOS); \
284 \
285 byte_char_debug_check (b, value, bytepos); \
286 return value; \
287 } \
288 else if (this_bytepos > bytepos) \
289 { \
290 if (this_bytepos < best_above_byte) \
291 { \
292 best_above = (CHARPOS); \
293 best_above_byte = this_bytepos; \
294 changed = true; \
295 } \
296 } \
297 else if (this_bytepos > best_below_byte) \
298 { \
299 best_below = (CHARPOS); \
300 best_below_byte = this_bytepos; \
301 changed = true; \
302 } \
303 \
304 if (changed) \
305 { \
306 if (best_above - best_below == best_above_byte - best_below_byte) \
307 { \
308 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
309 \
310 byte_char_debug_check (b, value, bytepos); \
311 return value; \
312 } \
313 } \
314 }
315
316 /* Return the character position corresponding to BYTEPOS in B. */
317
318 ptrdiff_t
319 buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
320 {
321 struct Lisp_Marker *tail;
322 ptrdiff_t best_above, best_above_byte;
323 ptrdiff_t best_below, best_below_byte;
324 ptrdiff_t distance = BYTECHAR_DISTANCE_INITIAL;
325
326 eassert (BUF_BEG_BYTE (b) <= bytepos && bytepos <= BUF_Z_BYTE (b));
327
328 best_above = BUF_Z (b);
329 best_above_byte = BUF_Z_BYTE (b);
330
331 /* If this buffer has as many characters as bytes,
332 each character must be one byte.
333 This takes care of the case where enable-multibyte-characters is nil. */
334 if (best_above == best_above_byte)
335 return bytepos;
336
337 /* Check bytepos is not in the middle of a character. */
338 eassert (bytepos >= BUF_Z_BYTE (b)
339 || CHAR_HEAD_P (BUF_FETCH_BYTE (b, bytepos)));
340
341 best_below = BEG;
342 best_below_byte = BEG_BYTE;
343
344 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
345 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
346 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
347 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
348
349 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
350 CONSIDER (cached_bytepos, cached_charpos);
351
352 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
353 {
354 CONSIDER (tail->bytepos, tail->charpos);
355
356 /* If we are down to a range of 50 chars,
357 don't bother checking any other markers;
358 scan the intervening chars directly now. */
359 if (best_above - bytepos < distance
360 || bytepos - best_below < distance)
361 break;
362 else
363 distance += BYTECHAR_DISTANCE_INCREMENT;
364 }
365
366 /* We get here if we did not exactly hit one of the known places.
367 We have one known above and one known below.
368 Scan, counting characters, from whichever one is closer. */
369
370 if (bytepos - best_below_byte < best_above_byte - bytepos)
371 {
372 bool record = bytepos - best_below_byte > 5000;
373
374 while (best_below_byte < bytepos)
375 {
376 best_below++;
377 best_below_byte += buf_next_char_len (b, best_below_byte);
378 }
379
380 /* If this position is quite far from the nearest known position,
381 cache the correspondence by creating a marker here.
382 It will last until the next GC.
383 But don't do it if BUF_MARKERS is nil;
384 that is a signal from Fset_buffer_multibyte. */
385 if (record && BUF_MARKERS (b))
386 build_marker (b, best_below, best_below_byte);
387
388 byte_char_debug_check (b, best_below, best_below_byte);
389
390 cached_buffer = b;
391 cached_modiff = BUF_MODIFF (b);
392 cached_charpos = best_below;
393 cached_bytepos = best_below_byte;
394
395 return best_below;
396 }
397 else
398 {
399 bool record = best_above_byte - bytepos > 5000;
400
401 while (best_above_byte > bytepos)
402 {
403 best_above--;
404 best_above_byte -= buf_prev_char_len (b, best_above_byte);
405 }
406
407 /* If this position is quite far from the nearest known position,
408 cache the correspondence by creating a marker here.
409 It will last until the next GC.
410 But don't do it if BUF_MARKERS is nil;
411 that is a signal from Fset_buffer_multibyte. */
412 if (record && BUF_MARKERS (b))
413 build_marker (b, best_above, best_above_byte);
414
415 byte_char_debug_check (b, best_above, best_above_byte);
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
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 (register Lisp_Object marker)
434 {
435 register Lisp_Object buf;
436 CHECK_MARKER (marker);
437 if (XMARKER (marker)->buffer)
438 {
439 XSETBUFFER (buf, XMARKER (marker)->buffer);
440 /* If the buffer is dead, we're in trouble: the buffer pointer here
441 does not preserve the buffer from being GC'd (it's weak), so
442 markers have to be unlinked from their buffer as soon as the buffer
443 is killed. */
444 eassert (BUFFER_LIVE_P (XBUFFER (buf)));
445 return buf;
446 }
447 return Qnil;
448 }
449
450 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
451 doc: /* Return the position of MARKER, or nil if it points nowhere. */)
452 (Lisp_Object marker)
453 {
454 CHECK_MARKER (marker);
455 if (XMARKER (marker)->buffer)
456 return make_fixnum (XMARKER (marker)->charpos);
457
458 return Qnil;
459 }
460
461 /* Change M so it points to B at CHARPOS and BYTEPOS. */
462
463 static void
464 attach_marker (struct Lisp_Marker *m, struct buffer *b,
465 ptrdiff_t charpos, ptrdiff_t bytepos)
466 {
467 /* In a single-byte buffer, two positions must be equal.
468 Otherwise, every character is at least one byte. */
469 if (BUF_Z (b) == BUF_Z_BYTE (b))
470 eassert (charpos == bytepos);
471 else
472 eassert (charpos <= bytepos);
473
474 m->charpos = charpos;
475 m->bytepos = bytepos;
476
477 if (m->buffer != b)
478 {
479 unchain_marker (m);
480 m->buffer = b;
481 m->next = BUF_MARKERS (b);
482 BUF_MARKERS (b) = m;
483 }
484 }
485
486 /* If BUFFER is nil, return current buffer pointer. Next, check
487 whether BUFFER is a buffer object and return buffer pointer
488 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
489
490 static struct buffer *
491 live_buffer (Lisp_Object buffer)
492 {
493 struct buffer *b = decode_buffer (buffer);
494 return BUFFER_LIVE_P (b) ? b : NULL;
495 }
496
497 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
498 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
499
500 static Lisp_Object
501 set_marker_internal (Lisp_Object marker, Lisp_Object position,
502 Lisp_Object buffer, bool restricted)
503 {
504 struct Lisp_Marker *m;
505 struct buffer *b = live_buffer (buffer);
506
507 CHECK_MARKER (marker);
508 m = XMARKER (marker);
509
510 /* Set MARKER to point nowhere if BUFFER is dead, or
511 POSITION is nil or a marker points to nowhere. */
512 if (NILP (position)
513 || (MARKERP (position) && !XMARKER (position)->buffer)
514 || !b)
515 unchain_marker (m);
516
517 /* Optimize the special case where we are copying the position of
518 an existing marker, and MARKER is already in the same buffer. */
519 else 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 }
525
526 else
527 {
528 register ptrdiff_t charpos, bytepos;
529
530 /* Do not use CHECK_FIXNUM_COERCE_MARKER because we
531 don't want to call buf_charpos_to_bytepos if POSITION
532 is a marker and so we know the bytepos already. */
533 if (FIXNUMP (position))
534 {
535 #if EMACS_INT_MAX > PTRDIFF_MAX
536 /* A --with-wide-int build. */
537 EMACS_INT cpos = XFIXNUM (position);
538 if (cpos > PTRDIFF_MAX)
539 cpos = PTRDIFF_MAX;
540 charpos = cpos;
541 bytepos = -1;
542 #else
543 charpos = XFIXNUM (position), bytepos = -1;
544 #endif
545 }
546 else if (MARKERP (position))
547 {
548 charpos = XMARKER (position)->charpos;
549 bytepos = XMARKER (position)->bytepos;
550 }
551 else
552 wrong_type_argument (Qinteger_or_marker_p, position);
553
554 charpos = clip_to_bounds
555 (restricted ? BUF_BEGV (b) : BUF_BEG (b), charpos,
556 restricted ? BUF_ZV (b) : BUF_Z (b));
557 /* Don't believe BYTEPOS if it comes from a different buffer,
558 since that buffer might have a very different correspondence
559 between character and byte positions. */
560 if (bytepos == -1
561 || !(MARKERP (position) && XMARKER (position)->buffer == b))
562 bytepos = buf_charpos_to_bytepos (b, charpos);
563 else
564 bytepos = clip_to_bounds
565 (restricted ? BUF_BEGV_BYTE (b) : BUF_BEG_BYTE (b),
566 bytepos, restricted ? BUF_ZV_BYTE (b) : BUF_Z_BYTE (b));
567
568 attach_marker (m, b, charpos, bytepos);
569 }
570
571 #ifdef HAVE_TEXT_CONVERSION
572
573 /* If B is the buffer's mark and there is a window displaying B, and
574 text conversion is enabled while the mark is active, redisplay
575 the buffer.
576
577 propagate_window_redisplay will propagate this redisplay to the
578 window, which will eventually reach
579 mark_window_display_accurate_1. At that point,
580 report_point_change will be told to update the mark as seen by
581 the input method.
582
583 This is done all the way in (the seemingly irrelevant) redisplay
584 because the selection reported to the input method is actually what
585 is visible on screen, namely w->last_point. */
586
587 if (m->buffer
588 && EQ (marker, BVAR (m->buffer, mark))
589 && !NILP (BVAR (m->buffer, mark_active))
590 && buffer_window_count (m->buffer))
591 bset_redisplay (m->buffer);
592
593 #endif
594
595 return marker;
596 }
597
598 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
599 doc: /* Position MARKER before character number POSITION in BUFFER.
600 If BUFFER is omitted or nil, it defaults to the current buffer. If
601 POSITION is nil, makes marker point nowhere so it no longer slows down
602 editing in any buffer. Returns MARKER. */)
603 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
604 {
605 return set_marker_internal (marker, position, buffer, false);
606 }
607
608 /* Like the above, but won't let the position be outside the visible part. */
609
610 Lisp_Object
611 set_marker_restricted (Lisp_Object marker, Lisp_Object position,
612 Lisp_Object buffer)
613 {
614 return set_marker_internal (marker, position, buffer, true);
615 }
616
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,
622 ptrdiff_t charpos, ptrdiff_t bytepos)
623 {
624 register struct Lisp_Marker *m;
625 register struct buffer *b = live_buffer (buffer);
626
627 CHECK_MARKER (marker);
628 m = XMARKER (marker);
629
630 if (b)
631 attach_marker (m, b, charpos, bytepos);
632 else
633 unchain_marker (m);
634 return marker;
635 }
636
637 /* Like the above, but won't let the position be outside the visible part. */
638
639 Lisp_Object
640 set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
641 ptrdiff_t charpos, ptrdiff_t bytepos)
642 {
643 register struct Lisp_Marker *m;
644 register struct buffer *b = live_buffer (buffer);
645
646 CHECK_MARKER (marker);
647 m = XMARKER (marker);
648
649 if (b)
650 {
651 attach_marker
652 (m, b,
653 clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
654 clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
655 }
656 else
657 unchain_marker (m);
658 return marker;
659 }
660
661 /* Detach a marker so that it no longer points anywhere and no longer
662 slows down editing. Do not free the marker, though, as a change
663 function could have inserted it into an undo list (Bug#30931). */
664
665 void
666 detach_marker (Lisp_Object marker)
667 {
668 Fset_marker (marker, Qnil, Qnil);
669 }
670
671 /* Remove MARKER from the chain of whatever buffer it is in. Set its
672 buffer NULL. */
673
674 void
675 unchain_marker (register struct Lisp_Marker *marker)
676 {
677 register struct buffer *b = marker->buffer;
678
679 if (b)
680 {
681 register struct Lisp_Marker *tail, **prev;
682
683 /* No dead buffers here. */
684 eassert (BUFFER_LIVE_P (b));
685
686 marker->buffer = NULL;
687 prev = &BUF_MARKERS (b);
688
689 for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
690 if (marker == tail)
691 {
692 if (*prev == BUF_MARKERS (b))
693 {
694 /* Deleting first marker from the buffer's chain. Crash
695 if new first marker in chain does not say it belongs
696 to the same buffer, or at least that they have the same
697 base buffer. */
698 if (tail->next && b->text != tail->next->buffer->text)
699 emacs_abort ();
700 }
701 *prev = tail->next;
702 /* We have removed the marker from the chain;
703 no need to scan the rest of the chain. */
704 break;
705 }
706
707 /* Error if marker was not in it's chain. */
708 eassert (tail != NULL);
709 }
710 }
711
712 /* Return the char position of marker MARKER, as a C integer. */
713
714 ptrdiff_t
715 marker_position (Lisp_Object marker)
716 {
717 register struct Lisp_Marker *m = XMARKER (marker);
718 register struct buffer *buf = m->buffer;
719
720 if (!buf)
721 error ("Marker does not point anywhere");
722
723 eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
724
725 return m->charpos;
726 }
727
728 /* Return the byte position of marker MARKER, as a C integer. */
729
730 ptrdiff_t
731 marker_byte_position (Lisp_Object marker)
732 {
733 register struct Lisp_Marker *m = XMARKER (marker);
734 register struct buffer *buf = m->buffer;
735
736 if (!buf)
737 error ("Marker does not point anywhere");
738
739 eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
740
741 return m->bytepos;
742 }
743
744 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
745 doc: /* Return a new marker pointing at the same place as MARKER.
746 If argument is a number, makes a new marker pointing
747 at that position in the current buffer.
748 If MARKER is not specified, the new marker does not point anywhere.
749 The optional argument TYPE specifies the insertion type of the new marker;
750 see `marker-insertion-type'. */)
751 (register Lisp_Object marker, Lisp_Object type)
752 {
753 register Lisp_Object new;
754
755 if (!NILP (marker))
756 CHECK_TYPE (FIXNUMP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
757
758 new = Fmake_marker ();
759 Fset_marker (new, marker,
760 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
761 XMARKER (new)->insertion_type = !NILP (type);
762 return new;
763 }
764
765 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
766 Smarker_insertion_type, 1, 1, 0,
767 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
768 The value nil means the marker stays before text inserted there. */)
769 (register Lisp_Object marker)
770 {
771 CHECK_MARKER (marker);
772 return XMARKER (marker)->insertion_type ? Qt : Qnil;
773 }
774
775 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
776 Sset_marker_insertion_type, 2, 2, 0,
777 doc: /* Set the insertion-type of MARKER to TYPE.
778 If TYPE is t, it means the marker advances when you insert text at it.
779 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
780 (Lisp_Object marker, Lisp_Object type)
781 {
782 CHECK_MARKER (marker);
783
784 XMARKER (marker)->insertion_type = ! NILP (type);
785 return type;
786 }
787
788 #ifdef MARKER_DEBUG
789
790 /* For debugging -- count the markers in buffer BUF. */
791
792 int
793 count_markers (struct buffer *buf)
794 {
795 int total = 0;
796 struct Lisp_Marker *tail;
797
798 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
799 total++;
800
801 return total;
802 }
803
804 /* For debugging -- recompute the bytepos corresponding
805 to CHARPOS in the simplest, most reliable way. */
806
807 ptrdiff_t
808 verify_bytepos (ptrdiff_t charpos)
809 {
810 ptrdiff_t below = BEG;
811 ptrdiff_t below_byte = BEG_BYTE;
812
813 while (below != charpos)
814 {
815 below++;
816 below_byte += buf_next_char_len (current_buffer, below_byte);
817 }
818
819 return below_byte;
820 }
821
822 #endif /* MARKER_DEBUG */
823
824 void
825 syms_of_marker (void)
826 {
827 defsubr (&Smarker_position);
828 defsubr (&Smarker_buffer);
829 defsubr (&Sset_marker);
830 defsubr (&Scopy_marker);
831 defsubr (&Smarker_insertion_type);
832 defsubr (&Sset_marker_insertion_type);
833 }