1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include "character.h"
26 /* Record one cached position found recently by
27 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
29 static ptrdiff_t cached_charpos
;
30 static ptrdiff_t cached_bytepos
;
31 static struct buffer
*cached_buffer
;
32 static int cached_modiff
;
34 static void byte_char_debug_check (struct buffer
*, ptrdiff_t, ptrdiff_t);
37 clear_charpos_cache (struct buffer
*b
)
39 if (cached_buffer
== b
)
43 /* Converting between character positions and byte positions. */
45 /* There are several places in the buffer where we know
46 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
47 and everywhere there is a marker. So we find the one of these places
48 that is closest to the specified position, and scan from there. */
50 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
52 /* This macro is a subroutine of charpos_to_bytepos.
53 Note that it is desirable that BYTEPOS is not evaluated
54 except when we really want its value. */
56 #define CONSIDER(CHARPOS, BYTEPOS) \
58 ptrdiff_t this_charpos = (CHARPOS); \
61 if (this_charpos == charpos) \
63 ptrdiff_t value = (BYTEPOS); \
64 if (byte_debug_flag) \
65 byte_char_debug_check (b, charpos, value); \
68 else if (this_charpos > charpos) \
70 if (this_charpos < best_above) \
72 best_above = this_charpos; \
73 best_above_byte = (BYTEPOS); \
77 else if (this_charpos > best_below) \
79 best_below = this_charpos; \
80 best_below_byte = (BYTEPOS); \
86 if (best_above - best_below == best_above_byte - best_below_byte) \
88 ptrdiff_t value = best_below_byte + (charpos - best_below); \
89 if (byte_debug_flag) \
90 byte_char_debug_check (b, charpos, value); \
97 byte_char_debug_check (struct buffer
*b
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
101 if (bytepos
> BUF_GPT_BYTE (b
))
103 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
104 BUF_GPT_BYTE (b
) - BUF_BEG_BYTE (b
));
105 nchars
+= multibyte_chars_in_text (BUF_GAP_END_ADDR (b
),
106 bytepos
- BUF_GPT_BYTE (b
));
109 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
110 bytepos
- BUF_BEG_BYTE (b
));
112 if (charpos
- 1 != nchars
)
117 charpos_to_bytepos (ptrdiff_t charpos
)
119 return buf_charpos_to_bytepos (current_buffer
, charpos
);
123 buf_charpos_to_bytepos (struct buffer
*b
, ptrdiff_t charpos
)
125 struct Lisp_Marker
*tail
;
126 ptrdiff_t best_above
, best_above_byte
;
127 ptrdiff_t best_below
, best_below_byte
;
129 if (charpos
< BUF_BEG (b
) || charpos
> BUF_Z (b
))
132 best_above
= BUF_Z (b
);
133 best_above_byte
= BUF_Z_BYTE (b
);
135 /* If this buffer has as many characters as bytes,
136 each character must be one byte.
137 This takes care of the case where enable-multibyte-characters is nil. */
138 if (best_above
== best_above_byte
)
142 best_below_byte
= BEG_BYTE
;
144 /* We find in best_above and best_above_byte
145 the closest known point above CHARPOS,
146 and in best_below and best_below_byte
147 the closest known point below CHARPOS,
149 If at any point we can tell that the space between those
150 two best approximations is all single-byte,
151 we interpolate the result immediately. */
153 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
154 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
155 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
156 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
158 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
159 CONSIDER (cached_charpos
, cached_bytepos
);
161 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
163 CONSIDER (tail
->charpos
, tail
->bytepos
);
165 /* If we are down to a range of 50 chars,
166 don't bother checking any other markers;
167 scan the intervening chars directly now. */
168 if (best_above
- best_below
< 50)
172 /* We get here if we did not exactly hit one of the known places.
173 We have one known above and one known below.
174 Scan, counting characters, from whichever one is closer. */
176 if (charpos
- best_below
< best_above
- charpos
)
178 int record
= charpos
- best_below
> 5000;
180 while (best_below
!= charpos
)
183 BUF_INC_POS (b
, best_below_byte
);
186 /* If this position is quite far from the nearest known position,
187 cache the correspondence by creating a marker here.
188 It will last until the next GC. */
191 Lisp_Object marker
, buffer
;
192 marker
= Fmake_marker ();
193 XSETBUFFER (buffer
, b
);
194 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
198 byte_char_debug_check (b
, charpos
, best_below_byte
);
201 cached_modiff
= BUF_MODIFF (b
);
202 cached_charpos
= best_below
;
203 cached_bytepos
= best_below_byte
;
205 return best_below_byte
;
209 int record
= best_above
- charpos
> 5000;
211 while (best_above
!= charpos
)
214 BUF_DEC_POS (b
, best_above_byte
);
217 /* If this position is quite far from the nearest known position,
218 cache the correspondence by creating a marker here.
219 It will last until the next GC. */
222 Lisp_Object marker
, buffer
;
223 marker
= Fmake_marker ();
224 XSETBUFFER (buffer
, b
);
225 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
229 byte_char_debug_check (b
, charpos
, best_above_byte
);
232 cached_modiff
= BUF_MODIFF (b
);
233 cached_charpos
= best_above
;
234 cached_bytepos
= best_above_byte
;
236 return best_above_byte
;
242 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
243 in the simplest, most reliable way. */
245 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos
) EXTERNALLY_VISIBLE
;
247 verify_bytepos (ptrdiff_t charpos
)
250 ptrdiff_t below_byte
= 1;
252 while (below
!= charpos
)
255 BUF_INC_POS (current_buffer
, below_byte
);
261 /* buf_bytepos_to_charpos returns the char position corresponding to
264 /* This macro is a subroutine of buf_bytepos_to_charpos.
265 It is used when BYTEPOS is actually the byte position. */
267 #define CONSIDER(BYTEPOS, CHARPOS) \
269 ptrdiff_t this_bytepos = (BYTEPOS); \
272 if (this_bytepos == bytepos) \
274 ptrdiff_t value = (CHARPOS); \
275 if (byte_debug_flag) \
276 byte_char_debug_check (b, value, bytepos); \
279 else if (this_bytepos > bytepos) \
281 if (this_bytepos < best_above_byte) \
283 best_above = (CHARPOS); \
284 best_above_byte = this_bytepos; \
288 else if (this_bytepos > best_below_byte) \
290 best_below = (CHARPOS); \
291 best_below_byte = this_bytepos; \
297 if (best_above - best_below == best_above_byte - best_below_byte) \
299 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
300 if (byte_debug_flag) \
301 byte_char_debug_check (b, value, bytepos); \
308 buf_bytepos_to_charpos (struct buffer
*b
, ptrdiff_t bytepos
)
310 struct Lisp_Marker
*tail
;
311 ptrdiff_t best_above
, best_above_byte
;
312 ptrdiff_t best_below
, best_below_byte
;
314 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
317 best_above
= BUF_Z (b
);
318 best_above_byte
= BUF_Z_BYTE (b
);
320 /* If this buffer has as many characters as bytes,
321 each character must be one byte.
322 This takes care of the case where enable-multibyte-characters is nil. */
323 if (best_above
== best_above_byte
)
327 best_below_byte
= BEG_BYTE
;
329 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
330 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
331 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
332 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
334 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
335 CONSIDER (cached_bytepos
, cached_charpos
);
337 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
339 CONSIDER (tail
->bytepos
, tail
->charpos
);
341 /* If we are down to a range of 50 chars,
342 don't bother checking any other markers;
343 scan the intervening chars directly now. */
344 if (best_above
- best_below
< 50)
348 /* We get here if we did not exactly hit one of the known places.
349 We have one known above and one known below.
350 Scan, counting characters, from whichever one is closer. */
352 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
354 int record
= bytepos
- best_below_byte
> 5000;
356 while (best_below_byte
< bytepos
)
359 BUF_INC_POS (b
, best_below_byte
);
362 /* If this position is quite far from the nearest known position,
363 cache the correspondence by creating a marker here.
364 It will last until the next GC.
365 But don't do it if BUF_MARKERS is nil;
366 that is a signal from Fset_buffer_multibyte. */
367 if (record
&& BUF_MARKERS (b
))
369 Lisp_Object marker
, buffer
;
370 marker
= Fmake_marker ();
371 XSETBUFFER (buffer
, b
);
372 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
376 byte_char_debug_check (b
, best_below
, bytepos
);
379 cached_modiff
= BUF_MODIFF (b
);
380 cached_charpos
= best_below
;
381 cached_bytepos
= best_below_byte
;
387 int record
= best_above_byte
- bytepos
> 5000;
389 while (best_above_byte
> bytepos
)
392 BUF_DEC_POS (b
, best_above_byte
);
395 /* If this position is quite far from the nearest known position,
396 cache the correspondence by creating a marker here.
397 It will last until the next GC.
398 But don't do it if BUF_MARKERS is nil;
399 that is a signal from Fset_buffer_multibyte. */
400 if (record
&& BUF_MARKERS (b
))
402 Lisp_Object marker
, buffer
;
403 marker
= Fmake_marker ();
404 XSETBUFFER (buffer
, b
);
405 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
409 byte_char_debug_check (b
, best_above
, bytepos
);
412 cached_modiff
= BUF_MODIFF (b
);
413 cached_charpos
= best_above
;
414 cached_bytepos
= best_above_byte
;
422 /* Operations on markers. */
424 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
425 doc
: /* Return the buffer that MARKER points into, or nil if none.
426 Returns nil if MARKER points into a dead buffer. */)
427 (register Lisp_Object marker
)
429 register Lisp_Object buf
;
430 CHECK_MARKER (marker
);
431 if (XMARKER (marker
)->buffer
)
433 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
434 /* If the buffer is dead, we're in trouble: the buffer pointer here
435 does not preserve the buffer from being GC'd (it's weak), so
436 markers have to be unlinked from their buffer as soon as the buffer
438 eassert (!NILP (BVAR (XBUFFER (buf
), name
)));
444 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
445 doc
: /* Return the position MARKER points at, as a character number.
446 Returns nil if MARKER points nowhere. */)
449 CHECK_MARKER (marker
);
450 if (XMARKER (marker
)->buffer
)
451 return make_number (XMARKER (marker
)->charpos
);
456 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
457 doc
: /* Position MARKER before character number POSITION in BUFFER.
458 BUFFER defaults to the current buffer.
459 If POSITION is nil, makes marker point nowhere.
460 Then it no longer slows down editing in any buffer.
462 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
464 register ptrdiff_t charno
;
465 register ptrdiff_t bytepos
;
466 register struct buffer
*b
;
467 register struct Lisp_Marker
*m
;
469 CHECK_MARKER (marker
);
470 m
= XMARKER (marker
);
472 /* If position is nil or a marker that points nowhere,
473 make this marker point nowhere. */
475 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
485 CHECK_BUFFER (buffer
);
486 b
= XBUFFER (buffer
);
487 /* If buffer is dead, set marker to point nowhere. */
488 if (EQ (BVAR (b
, name
), Qnil
))
495 /* Optimize the special case where we are copying the position
496 of an existing marker, and MARKER is already in the same buffer. */
497 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
500 m
->bytepos
= XMARKER (position
)->bytepos
;
501 m
->charpos
= XMARKER (position
)->charpos
;
505 CHECK_NUMBER_COERCE_MARKER (position
);
506 charno
= clip_to_bounds (BUF_BEG (b
), XINT (position
), BUF_Z (b
));
507 bytepos
= buf_charpos_to_bytepos (b
, charno
);
509 /* Every character is at least one byte. */
510 if (charno
> bytepos
)
513 m
->bytepos
= bytepos
;
520 m
->next
= BUF_MARKERS (b
);
527 /* This version of Fset_marker won't let the position
528 be outside the visible part. */
531 set_marker_restricted (Lisp_Object marker
, Lisp_Object pos
, Lisp_Object buffer
)
533 register ptrdiff_t charno
;
534 register ptrdiff_t bytepos
;
535 register struct buffer
*b
;
536 register struct Lisp_Marker
*m
;
538 CHECK_MARKER (marker
);
539 m
= XMARKER (marker
);
541 /* If position is nil or a marker that points nowhere,
542 make this marker point nowhere. */
544 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
554 CHECK_BUFFER (buffer
);
555 b
= XBUFFER (buffer
);
556 /* If buffer is dead, set marker to point nowhere. */
557 if (EQ (BVAR (b
, name
), Qnil
))
564 /* Optimize the special case where we are copying the position
565 of an existing marker, and MARKER is already in the same buffer. */
566 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
569 m
->bytepos
= XMARKER (pos
)->bytepos
;
570 m
->charpos
= XMARKER (pos
)->charpos
;
574 CHECK_NUMBER_COERCE_MARKER (pos
);
575 charno
= clip_to_bounds (BUF_BEGV (b
), XINT (pos
), BUF_ZV (b
));
576 bytepos
= buf_charpos_to_bytepos (b
, charno
);
578 /* Every character is at least one byte. */
579 if (charno
> bytepos
)
582 m
->bytepos
= bytepos
;
589 m
->next
= BUF_MARKERS (b
);
596 /* Set the position of MARKER, specifying both the
597 character position and the corresponding byte position. */
600 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
602 register struct buffer
*b
;
603 register struct Lisp_Marker
*m
;
605 CHECK_MARKER (marker
);
606 m
= XMARKER (marker
);
612 CHECK_BUFFER (buffer
);
613 b
= XBUFFER (buffer
);
614 /* If buffer is dead, set marker to point nowhere. */
615 if (EQ (BVAR (b
, name
), Qnil
))
622 /* In a single-byte buffer, the two positions must be equal. */
623 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
624 && charpos
!= bytepos
)
626 /* Every character is at least one byte. */
627 if (charpos
> bytepos
)
630 m
->bytepos
= bytepos
;
631 m
->charpos
= charpos
;
637 m
->next
= BUF_MARKERS (b
);
644 /* This version of set_marker_both won't let the position
645 be outside the visible part. */
648 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
650 register struct buffer
*b
;
651 register struct Lisp_Marker
*m
;
653 CHECK_MARKER (marker
);
654 m
= XMARKER (marker
);
660 CHECK_BUFFER (buffer
);
661 b
= XBUFFER (buffer
);
662 /* If buffer is dead, set marker to point nowhere. */
663 if (EQ (BVAR (b
, name
), Qnil
))
670 charpos
= clip_to_bounds (BUF_BEGV (b
), charpos
, BUF_ZV (b
));
671 bytepos
= clip_to_bounds (BUF_BEGV_BYTE (b
), bytepos
, BUF_ZV_BYTE (b
));
673 /* In a single-byte buffer, the two positions must be equal. */
674 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
675 && charpos
!= bytepos
)
677 /* Every character is at least one byte. */
678 if (charpos
> bytepos
)
681 m
->bytepos
= bytepos
;
682 m
->charpos
= charpos
;
688 m
->next
= BUF_MARKERS (b
);
695 /* Remove MARKER from the chain of whatever buffer it is in.
696 Leave it "in no buffer".
698 This is called during garbage collection,
699 so we must be careful to ignore and preserve mark bits,
700 including those in chain fields of markers. */
703 unchain_marker (register struct Lisp_Marker
*marker
)
705 register struct Lisp_Marker
*tail
, *prev
, *next
;
706 register struct buffer
*b
;
712 if (EQ (BVAR (b
, name
), Qnil
))
717 tail
= BUF_MARKERS (b
);
727 BUF_MARKERS (b
) = next
;
728 /* Deleting first marker from the buffer's chain. Crash
729 if new first marker in chain does not say it belongs
730 to the same buffer, or at least that they have the same
732 if (next
&& b
->text
!= next
->buffer
->text
)
737 /* We have removed the marker from the chain;
738 no need to scan the rest of the chain. */
746 /* Marker was not in its chain. */
750 /* Return the char position of marker MARKER, as a C integer. */
753 marker_position (Lisp_Object marker
)
755 register struct Lisp_Marker
*m
= XMARKER (marker
);
756 register struct buffer
*buf
= m
->buffer
;
759 error ("Marker does not point anywhere");
764 /* Return the byte position of marker MARKER, as a C integer. */
767 marker_byte_position (Lisp_Object marker
)
769 register struct Lisp_Marker
*m
= XMARKER (marker
);
770 register struct buffer
*buf
= m
->buffer
;
771 register ptrdiff_t i
= m
->bytepos
;
774 error ("Marker does not point anywhere");
776 if (i
< BUF_BEG_BYTE (buf
) || i
> BUF_Z_BYTE (buf
))
782 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
783 doc
: /* Return a new marker pointing at the same place as MARKER.
784 If argument is a number, makes a new marker pointing
785 at that position in the current buffer.
786 If MARKER is not specified, the new marker does not point anywhere.
787 The optional argument TYPE specifies the insertion type of the new marker;
788 see `marker-insertion-type'. */)
789 (register Lisp_Object marker
, Lisp_Object type
)
791 register Lisp_Object
new;
794 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
796 new = Fmake_marker ();
797 Fset_marker (new, marker
,
798 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
799 XMARKER (new)->insertion_type
= !NILP (type
);
803 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
804 Smarker_insertion_type
, 1, 1, 0,
805 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
806 The value nil means the marker stays before text inserted there. */)
807 (register Lisp_Object marker
)
809 CHECK_MARKER (marker
);
810 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
813 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
814 Sset_marker_insertion_type
, 2, 2, 0,
815 doc
: /* Set the insertion-type of MARKER to TYPE.
816 If TYPE is t, it means the marker advances when you insert text at it.
817 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
818 (Lisp_Object marker
, Lisp_Object type
)
820 CHECK_MARKER (marker
);
822 XMARKER (marker
)->insertion_type
= ! NILP (type
);
826 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
828 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
829 (Lisp_Object position
)
831 register struct Lisp_Marker
*tail
;
832 register ptrdiff_t charno
;
834 charno
= clip_to_bounds (BEG
, XINT (position
), Z
);
836 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
837 if (tail
->charpos
== charno
)
843 /* For debugging -- count the markers in buffer BUF. */
845 extern int count_markers (struct buffer
*) EXTERNALLY_VISIBLE
;
847 count_markers (struct buffer
*buf
)
850 struct Lisp_Marker
*tail
;
852 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
859 syms_of_marker (void)
861 defsubr (&Smarker_position
);
862 defsubr (&Smarker_buffer
);
863 defsubr (&Sset_marker
);
864 defsubr (&Scopy_marker
);
865 defsubr (&Smarker_insertion_type
);
866 defsubr (&Sset_marker_insertion_type
);
867 defsubr (&Sbuffer_has_markers_at
);
869 DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag
,
870 doc
: /* Non-nil enables debugging checks in byte/char position conversions. */);