Fix description of 'C-z' in User manual
[emacs.git] / src / marker.c
blobfebdb17689a5d9af8d32b37e97972c5a97f64389
1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2016 Free Software Foundation,
3 Inc.
5 This file is part of GNU Emacs.
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.
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.
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/>. */
21 #include <config.h>
23 #include "lisp.h"
24 #include "character.h"
25 #include "buffer.h"
27 /* Record one cached position found recently by
28 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
30 static ptrdiff_t cached_charpos;
31 static ptrdiff_t cached_bytepos;
32 static struct buffer *cached_buffer;
33 static EMACS_INT cached_modiff;
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. */
39 #ifdef MARKER_DEBUG
41 extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
42 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
44 static void
45 byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
47 ptrdiff_t nchars;
49 if (NILP (BVAR (b, enable_multibyte_characters)))
50 return;
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));
62 if (charpos - 1 != nchars)
63 emacs_abort ();
66 #else /* not MARKER_DEBUG */
68 #define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
70 #endif /* MARKER_DEBUG */
72 void
73 clear_charpos_cache (struct buffer *b)
75 if (cached_buffer == b)
76 cached_buffer = 0;
79 /* Converting between character positions and byte positions. */
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. */
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. */
90 #define CONSIDER(CHARPOS, BYTEPOS) \
91 { \
92 ptrdiff_t this_charpos = (CHARPOS); \
93 bool changed = 0; \
95 if (this_charpos == charpos) \
96 { \
97 ptrdiff_t value = (BYTEPOS); \
99 byte_char_debug_check (b, charpos, value); \
100 return value; \
102 else if (this_charpos > charpos) \
104 if (this_charpos < best_above) \
106 best_above = this_charpos; \
107 best_above_byte = (BYTEPOS); \
108 changed = 1; \
111 else if (this_charpos > best_below) \
113 best_below = this_charpos; \
114 best_below_byte = (BYTEPOS); \
115 changed = 1; \
118 if (changed) \
120 if (best_above - best_below == best_above_byte - best_below_byte) \
122 ptrdiff_t value = best_below_byte + (charpos - best_below); \
124 byte_char_debug_check (b, charpos, value); \
125 return value; \
130 static void
131 CHECK_MARKER (Lisp_Object x)
133 CHECK_TYPE (MARKERP (x), Qmarkerp, x);
136 /* Return the byte position corresponding to CHARPOS in B. */
138 ptrdiff_t
139 buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
141 struct Lisp_Marker *tail;
142 ptrdiff_t best_above, best_above_byte;
143 ptrdiff_t best_below, best_below_byte;
145 eassert (BUF_BEG (b) <= charpos && charpos <= BUF_Z (b));
147 best_above = BUF_Z (b);
148 best_above_byte = BUF_Z_BYTE (b);
150 /* If this buffer has as many characters as bytes,
151 each character must be one byte.
152 This takes care of the case where enable-multibyte-characters is nil. */
153 if (best_above == best_above_byte)
154 return charpos;
156 best_below = BEG;
157 best_below_byte = BEG_BYTE;
159 /* We find in best_above and best_above_byte
160 the closest known point above CHARPOS,
161 and in best_below and best_below_byte
162 the closest known point below CHARPOS,
164 If at any point we can tell that the space between those
165 two best approximations is all single-byte,
166 we interpolate the result immediately. */
168 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
169 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
170 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
171 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
173 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
174 CONSIDER (cached_charpos, cached_bytepos);
176 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
178 CONSIDER (tail->charpos, tail->bytepos);
180 /* If we are down to a range of 50 chars,
181 don't bother checking any other markers;
182 scan the intervening chars directly now. */
183 if (best_above - best_below < 50)
184 break;
187 /* We get here if we did not exactly hit one of the known places.
188 We have one known above and one known below.
189 Scan, counting characters, from whichever one is closer. */
191 if (charpos - best_below < best_above - charpos)
193 bool record = charpos - best_below > 5000;
195 while (best_below != charpos)
197 best_below++;
198 BUF_INC_POS (b, best_below_byte);
201 /* If this position is quite far from the nearest known position,
202 cache the correspondence by creating a marker here.
203 It will last until the next GC. */
204 if (record)
205 build_marker (b, best_below, best_below_byte);
207 byte_char_debug_check (b, best_below, best_below_byte);
209 cached_buffer = b;
210 cached_modiff = BUF_MODIFF (b);
211 cached_charpos = best_below;
212 cached_bytepos = best_below_byte;
214 return best_below_byte;
216 else
218 bool record = best_above - charpos > 5000;
220 while (best_above != charpos)
222 best_above--;
223 BUF_DEC_POS (b, best_above_byte);
226 /* If this position is quite far from the nearest known position,
227 cache the correspondence by creating a marker here.
228 It will last until the next GC. */
229 if (record)
230 build_marker (b, best_above, best_above_byte);
232 byte_char_debug_check (b, best_above, best_above_byte);
234 cached_buffer = b;
235 cached_modiff = BUF_MODIFF (b);
236 cached_charpos = best_above;
237 cached_bytepos = best_above_byte;
239 return best_above_byte;
243 #undef CONSIDER
245 /* This macro is a subroutine of buf_bytepos_to_charpos.
246 It is used when BYTEPOS is actually the byte position. */
248 #define CONSIDER(BYTEPOS, CHARPOS) \
250 ptrdiff_t this_bytepos = (BYTEPOS); \
251 int changed = 0; \
253 if (this_bytepos == bytepos) \
255 ptrdiff_t value = (CHARPOS); \
257 byte_char_debug_check (b, value, bytepos); \
258 return value; \
260 else if (this_bytepos > bytepos) \
262 if (this_bytepos < best_above_byte) \
264 best_above = (CHARPOS); \
265 best_above_byte = this_bytepos; \
266 changed = 1; \
269 else if (this_bytepos > best_below_byte) \
271 best_below = (CHARPOS); \
272 best_below_byte = this_bytepos; \
273 changed = 1; \
276 if (changed) \
278 if (best_above - best_below == best_above_byte - best_below_byte) \
280 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
282 byte_char_debug_check (b, value, bytepos); \
283 return value; \
288 /* Return the character position corresponding to BYTEPOS in B. */
290 ptrdiff_t
291 buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
293 struct Lisp_Marker *tail;
294 ptrdiff_t best_above, best_above_byte;
295 ptrdiff_t best_below, best_below_byte;
297 eassert (BUF_BEG_BYTE (b) <= bytepos && bytepos <= BUF_Z_BYTE (b));
299 best_above = BUF_Z (b);
300 best_above_byte = BUF_Z_BYTE (b);
302 /* If this buffer has as many characters as bytes,
303 each character must be one byte.
304 This takes care of the case where enable-multibyte-characters is nil. */
305 if (best_above == best_above_byte)
306 return bytepos;
308 best_below = BEG;
309 best_below_byte = BEG_BYTE;
311 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
312 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
313 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
314 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
316 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
317 CONSIDER (cached_bytepos, cached_charpos);
319 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
321 CONSIDER (tail->bytepos, tail->charpos);
323 /* If we are down to a range of 50 chars,
324 don't bother checking any other markers;
325 scan the intervening chars directly now. */
326 if (best_above - best_below < 50)
327 break;
330 /* We get here if we did not exactly hit one of the known places.
331 We have one known above and one known below.
332 Scan, counting characters, from whichever one is closer. */
334 if (bytepos - best_below_byte < best_above_byte - bytepos)
336 bool record = bytepos - best_below_byte > 5000;
338 while (best_below_byte < bytepos)
340 best_below++;
341 BUF_INC_POS (b, best_below_byte);
344 /* If this position is quite far from the nearest known position,
345 cache the correspondence by creating a marker here.
346 It will last until the next GC.
347 But don't do it if BUF_MARKERS is nil;
348 that is a signal from Fset_buffer_multibyte. */
349 if (record && BUF_MARKERS (b))
350 build_marker (b, best_below, best_below_byte);
352 byte_char_debug_check (b, best_below, best_below_byte);
354 cached_buffer = b;
355 cached_modiff = BUF_MODIFF (b);
356 cached_charpos = best_below;
357 cached_bytepos = best_below_byte;
359 return best_below;
361 else
363 bool record = best_above_byte - bytepos > 5000;
365 while (best_above_byte > bytepos)
367 best_above--;
368 BUF_DEC_POS (b, best_above_byte);
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 build_marker (b, best_above, best_above_byte);
379 byte_char_debug_check (b, best_above, best_above_byte);
381 cached_buffer = b;
382 cached_modiff = BUF_MODIFF (b);
383 cached_charpos = best_above;
384 cached_bytepos = best_above_byte;
386 return best_above;
390 #undef CONSIDER
392 /* Operations on markers. */
394 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
395 doc: /* Return the buffer that MARKER points into, or nil if none.
396 Returns nil if MARKER points into a dead buffer. */)
397 (register Lisp_Object marker)
399 register Lisp_Object buf;
400 CHECK_MARKER (marker);
401 if (XMARKER (marker)->buffer)
403 XSETBUFFER (buf, XMARKER (marker)->buffer);
404 /* If the buffer is dead, we're in trouble: the buffer pointer here
405 does not preserve the buffer from being GC'd (it's weak), so
406 markers have to be unlinked from their buffer as soon as the buffer
407 is killed. */
408 eassert (BUFFER_LIVE_P (XBUFFER (buf)));
409 return buf;
411 return Qnil;
414 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
415 doc: /* Return the position of MARKER, or nil if it points nowhere. */)
416 (Lisp_Object marker)
418 CHECK_MARKER (marker);
419 if (XMARKER (marker)->buffer)
420 return make_number (XMARKER (marker)->charpos);
422 return Qnil;
425 /* Change M so it points to B at CHARPOS and BYTEPOS. */
427 static void
428 attach_marker (struct Lisp_Marker *m, struct buffer *b,
429 ptrdiff_t charpos, ptrdiff_t bytepos)
431 /* In a single-byte buffer, two positions must be equal.
432 Otherwise, every character is at least one byte. */
433 if (BUF_Z (b) == BUF_Z_BYTE (b))
434 eassert (charpos == bytepos);
435 else
436 eassert (charpos <= bytepos);
438 m->charpos = charpos;
439 m->bytepos = bytepos;
441 if (m->buffer != b)
443 unchain_marker (m);
444 m->buffer = b;
445 m->next = BUF_MARKERS (b);
446 BUF_MARKERS (b) = m;
450 /* If BUFFER is nil, return current buffer pointer. Next, check
451 whether BUFFER is a buffer object and return buffer pointer
452 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
454 static struct buffer *
455 live_buffer (Lisp_Object buffer)
457 struct buffer *b = decode_buffer (buffer);
458 return BUFFER_LIVE_P (b) ? b : NULL;
461 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
462 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
464 static Lisp_Object
465 set_marker_internal (Lisp_Object marker, Lisp_Object position,
466 Lisp_Object buffer, bool restricted)
468 struct Lisp_Marker *m;
469 struct buffer *b = live_buffer (buffer);
471 CHECK_MARKER (marker);
472 m = XMARKER (marker);
474 /* Set MARKER to point nowhere if BUFFER is dead, or
475 POSITION is nil or a marker points to nowhere. */
476 if (NILP (position)
477 || (MARKERP (position) && !XMARKER (position)->buffer)
478 || !b)
479 unchain_marker (m);
481 /* Optimize the special case where we are copying the position of
482 an existing marker, and MARKER is already in the same buffer. */
483 else if (MARKERP (position) && b == XMARKER (position)->buffer
484 && b == m->buffer)
486 m->bytepos = XMARKER (position)->bytepos;
487 m->charpos = XMARKER (position)->charpos;
490 else
492 register ptrdiff_t charpos, bytepos;
494 /* Do not use CHECK_NUMBER_COERCE_MARKER because we
495 don't want to call buf_charpos_to_bytepos if POSITION
496 is a marker and so we know the bytepos already. */
497 if (INTEGERP (position))
498 charpos = XINT (position), bytepos = -1;
499 else if (MARKERP (position))
501 charpos = XMARKER (position)->charpos;
502 bytepos = XMARKER (position)->bytepos;
504 else
505 wrong_type_argument (Qinteger_or_marker_p, position);
507 charpos = clip_to_bounds
508 (restricted ? BUF_BEGV (b) : BUF_BEG (b), charpos,
509 restricted ? BUF_ZV (b) : BUF_Z (b));
510 if (bytepos == -1)
511 bytepos = buf_charpos_to_bytepos (b, charpos);
512 else
513 bytepos = clip_to_bounds
514 (restricted ? BUF_BEGV_BYTE (b) : BUF_BEG_BYTE (b),
515 bytepos, restricted ? BUF_ZV_BYTE (b) : BUF_Z_BYTE (b));
517 attach_marker (m, b, charpos, bytepos);
519 return marker;
522 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
523 doc: /* Position MARKER before character number POSITION in BUFFER.
524 If BUFFER is omitted or nil, it defaults to the current buffer. If
525 POSITION is nil, makes marker point nowhere so it no longer slows down
526 editing in any buffer. Returns MARKER. */)
527 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
529 return set_marker_internal (marker, position, buffer, 0);
532 /* Like the above, but won't let the position be outside the visible part. */
534 Lisp_Object
535 set_marker_restricted (Lisp_Object marker, Lisp_Object position,
536 Lisp_Object buffer)
538 return set_marker_internal (marker, position, buffer, 1);
541 /* Set the position of MARKER, specifying both the
542 character position and the corresponding byte position. */
544 Lisp_Object
545 set_marker_both (Lisp_Object marker, Lisp_Object buffer,
546 ptrdiff_t charpos, ptrdiff_t bytepos)
548 register struct Lisp_Marker *m;
549 register struct buffer *b = live_buffer (buffer);
551 CHECK_MARKER (marker);
552 m = XMARKER (marker);
554 if (b)
555 attach_marker (m, b, charpos, bytepos);
556 else
557 unchain_marker (m);
558 return marker;
561 /* Like the above, but won't let the position be outside the visible part. */
563 Lisp_Object
564 set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
565 ptrdiff_t charpos, ptrdiff_t bytepos)
567 register struct Lisp_Marker *m;
568 register struct buffer *b = live_buffer (buffer);
570 CHECK_MARKER (marker);
571 m = XMARKER (marker);
573 if (b)
575 attach_marker
576 (m, b,
577 clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
578 clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
580 else
581 unchain_marker (m);
582 return marker;
585 /* Remove MARKER from the chain of whatever buffer it is in,
586 leaving it points to nowhere. This is called during garbage
587 collection, so we must be careful to ignore and preserve
588 mark bits, including those in chain fields of markers. */
590 void
591 unchain_marker (register struct Lisp_Marker *marker)
593 register struct buffer *b = marker->buffer;
595 if (b)
597 register struct Lisp_Marker *tail, **prev;
599 /* No dead buffers here. */
600 eassert (BUFFER_LIVE_P (b));
602 marker->buffer = NULL;
603 prev = &BUF_MARKERS (b);
605 for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
606 if (marker == tail)
608 if (*prev == BUF_MARKERS (b))
610 /* Deleting first marker from the buffer's chain. Crash
611 if new first marker in chain does not say it belongs
612 to the same buffer, or at least that they have the same
613 base buffer. */
614 if (tail->next && b->text != tail->next->buffer->text)
615 emacs_abort ();
617 *prev = tail->next;
618 /* We have removed the marker from the chain;
619 no need to scan the rest of the chain. */
620 break;
623 /* Error if marker was not in it's chain. */
624 eassert (tail != NULL);
628 /* Return the char position of marker MARKER, as a C integer. */
630 ptrdiff_t
631 marker_position (Lisp_Object marker)
633 register struct Lisp_Marker *m = XMARKER (marker);
634 register struct buffer *buf = m->buffer;
636 if (!buf)
637 error ("Marker does not point anywhere");
639 eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
641 return m->charpos;
644 /* Return the byte position of marker MARKER, as a C integer. */
646 ptrdiff_t
647 marker_byte_position (Lisp_Object marker)
649 register struct Lisp_Marker *m = XMARKER (marker);
650 register struct buffer *buf = m->buffer;
652 if (!buf)
653 error ("Marker does not point anywhere");
655 eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
657 return m->bytepos;
660 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
661 doc: /* Return a new marker pointing at the same place as MARKER.
662 If argument is a number, makes a new marker pointing
663 at that position in the current buffer.
664 If MARKER is not specified, the new marker does not point anywhere.
665 The optional argument TYPE specifies the insertion type of the new marker;
666 see `marker-insertion-type'. */)
667 (register Lisp_Object marker, Lisp_Object type)
669 register Lisp_Object new;
671 if (!NILP (marker))
672 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
674 new = Fmake_marker ();
675 Fset_marker (new, marker,
676 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
677 XMARKER (new)->insertion_type = !NILP (type);
678 return new;
681 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
682 Smarker_insertion_type, 1, 1, 0,
683 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
684 The value nil means the marker stays before text inserted there. */)
685 (register Lisp_Object marker)
687 CHECK_MARKER (marker);
688 return XMARKER (marker)->insertion_type ? Qt : Qnil;
691 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
692 Sset_marker_insertion_type, 2, 2, 0,
693 doc: /* Set the insertion-type of MARKER to TYPE.
694 If TYPE is t, it means the marker advances when you insert text at it.
695 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
696 (Lisp_Object marker, Lisp_Object type)
698 CHECK_MARKER (marker);
700 XMARKER (marker)->insertion_type = ! NILP (type);
701 return type;
704 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
705 1, 1, 0,
706 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
707 (Lisp_Object position)
709 register struct Lisp_Marker *tail;
710 register ptrdiff_t charpos;
712 charpos = clip_to_bounds (BEG, XINT (position), Z);
714 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
715 if (tail->charpos == charpos)
716 return Qt;
718 return Qnil;
721 #ifdef MARKER_DEBUG
723 /* For debugging -- count the markers in buffer BUF. */
726 count_markers (struct buffer *buf)
728 int total = 0;
729 struct Lisp_Marker *tail;
731 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
732 total++;
734 return total;
737 /* For debugging -- recompute the bytepos corresponding
738 to CHARPOS in the simplest, most reliable way. */
740 ptrdiff_t
741 verify_bytepos (ptrdiff_t charpos)
743 ptrdiff_t below = 1;
744 ptrdiff_t below_byte = 1;
746 while (below != charpos)
748 below++;
749 BUF_INC_POS (current_buffer, below_byte);
752 return below_byte;
755 #endif /* MARKER_DEBUG */
757 void
758 syms_of_marker (void)
760 defsubr (&Smarker_position);
761 defsubr (&Smarker_buffer);
762 defsubr (&Sset_marker);
763 defsubr (&Scopy_marker);
764 defsubr (&Smarker_insertion_type);
765 defsubr (&Sset_marker_insertion_type);
766 defsubr (&Sbuffer_has_markers_at);