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