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 /* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
35 bootstrap time when byte_char_debug_check is enabled; so this
36 is never turned on by --enable-checking configure option. */
40 extern int count_markers (struct buffer
*) EXTERNALLY_VISIBLE
;
41 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos
) EXTERNALLY_VISIBLE
;
44 byte_char_debug_check (struct buffer
*b
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
48 if (NILP (BVAR (b
, enable_multibyte_characters
)))
51 if (bytepos
> BUF_GPT_BYTE (b
))
53 = multibyte_chars_in_text (BUF_BEG_ADDR (b
),
54 BUF_GPT_BYTE (b
) - BUF_BEG_BYTE (b
))
55 + multibyte_chars_in_text (BUF_GAP_END_ADDR (b
),
56 bytepos
- BUF_GPT_BYTE (b
));
58 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
59 bytepos
- BUF_BEG_BYTE (b
));
61 if (charpos
- 1 != nchars
)
65 #else /* not MARKER_DEBUG */
67 #define byte_char_debug_check(b,charpos,bytepos) do { } while (0)
69 #endif /* MARKER_DEBUG */
72 clear_charpos_cache (struct buffer
*b
)
74 if (cached_buffer
== b
)
78 /* Converting between character positions and byte positions. */
80 /* There are several places in the buffer where we know
81 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
82 and everywhere there is a marker. So we find the one of these places
83 that is closest to the specified position, and scan from there. */
85 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
87 /* This macro is a subroutine of charpos_to_bytepos.
88 Note that it is desirable that BYTEPOS is not evaluated
89 except when we really want its value. */
91 #define CONSIDER(CHARPOS, BYTEPOS) \
93 ptrdiff_t this_charpos = (CHARPOS); \
96 if (this_charpos == charpos) \
98 ptrdiff_t value = (BYTEPOS); \
100 byte_char_debug_check (b, charpos, value); \
103 else if (this_charpos > charpos) \
105 if (this_charpos < best_above) \
107 best_above = this_charpos; \
108 best_above_byte = (BYTEPOS); \
112 else if (this_charpos > best_below) \
114 best_below = this_charpos; \
115 best_below_byte = (BYTEPOS); \
121 if (best_above - best_below == best_above_byte - best_below_byte) \
123 ptrdiff_t value = best_below_byte + (charpos - best_below); \
125 byte_char_debug_check (b, charpos, value); \
132 charpos_to_bytepos (ptrdiff_t charpos
)
134 return buf_charpos_to_bytepos (current_buffer
, charpos
);
138 buf_charpos_to_bytepos (struct buffer
*b
, ptrdiff_t charpos
)
140 struct Lisp_Marker
*tail
;
141 ptrdiff_t best_above
, best_above_byte
;
142 ptrdiff_t best_below
, best_below_byte
;
144 if (charpos
< BUF_BEG (b
) || 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
)
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)
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 int record
= charpos
- best_below
> 5000;
195 while (best_below
!= charpos
)
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. */
205 build_marker (b
, best_below
, best_below_byte
);
207 byte_char_debug_check (b
, best_below
, best_below_byte
);
210 cached_modiff
= BUF_MODIFF (b
);
211 cached_charpos
= best_below
;
212 cached_bytepos
= best_below_byte
;
214 return best_below_byte
;
218 int record
= best_above
- charpos
> 5000;
220 while (best_above
!= charpos
)
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. */
230 build_marker (b
, best_above
, best_above_byte
);
232 byte_char_debug_check (b
, best_above
, best_above_byte
);
235 cached_modiff
= BUF_MODIFF (b
);
236 cached_charpos
= best_above
;
237 cached_bytepos
= best_above_byte
;
239 return best_above_byte
;
245 /* buf_bytepos_to_charpos returns the char position corresponding to
248 /* This macro is a subroutine of buf_bytepos_to_charpos.
249 It is used when BYTEPOS is actually the byte position. */
251 #define CONSIDER(BYTEPOS, CHARPOS) \
253 ptrdiff_t this_bytepos = (BYTEPOS); \
256 if (this_bytepos == bytepos) \
258 ptrdiff_t value = (CHARPOS); \
260 byte_char_debug_check (b, value, bytepos); \
263 else if (this_bytepos > bytepos) \
265 if (this_bytepos < best_above_byte) \
267 best_above = (CHARPOS); \
268 best_above_byte = this_bytepos; \
272 else if (this_bytepos > best_below_byte) \
274 best_below = (CHARPOS); \
275 best_below_byte = this_bytepos; \
281 if (best_above - best_below == best_above_byte - best_below_byte) \
283 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
285 byte_char_debug_check (b, value, bytepos); \
292 buf_bytepos_to_charpos (struct buffer
*b
, ptrdiff_t bytepos
)
294 struct Lisp_Marker
*tail
;
295 ptrdiff_t best_above
, best_above_byte
;
296 ptrdiff_t best_below
, best_below_byte
;
298 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
301 best_above
= BUF_Z (b
);
302 best_above_byte
= BUF_Z_BYTE (b
);
304 /* If this buffer has as many characters as bytes,
305 each character must be one byte.
306 This takes care of the case where enable-multibyte-characters is nil. */
307 if (best_above
== best_above_byte
)
311 best_below_byte
= BEG_BYTE
;
313 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
314 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
315 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
316 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
318 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
319 CONSIDER (cached_bytepos
, cached_charpos
);
321 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
323 CONSIDER (tail
->bytepos
, tail
->charpos
);
325 /* If we are down to a range of 50 chars,
326 don't bother checking any other markers;
327 scan the intervening chars directly now. */
328 if (best_above
- best_below
< 50)
332 /* We get here if we did not exactly hit one of the known places.
333 We have one known above and one known below.
334 Scan, counting characters, from whichever one is closer. */
336 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
338 int record
= bytepos
- best_below_byte
> 5000;
340 while (best_below_byte
< bytepos
)
343 BUF_INC_POS (b
, best_below_byte
);
346 /* If this position is quite far from the nearest known position,
347 cache the correspondence by creating a marker here.
348 It will last until the next GC.
349 But don't do it if BUF_MARKERS is nil;
350 that is a signal from Fset_buffer_multibyte. */
351 if (record
&& BUF_MARKERS (b
))
352 build_marker (b
, best_below
, best_below_byte
);
354 byte_char_debug_check (b
, best_below
, best_below_byte
);
357 cached_modiff
= BUF_MODIFF (b
);
358 cached_charpos
= best_below
;
359 cached_bytepos
= best_below_byte
;
365 int record
= best_above_byte
- bytepos
> 5000;
367 while (best_above_byte
> bytepos
)
370 BUF_DEC_POS (b
, best_above_byte
);
373 /* If this position is quite far from the nearest known position,
374 cache the correspondence by creating a marker here.
375 It will last until the next GC.
376 But don't do it if BUF_MARKERS is nil;
377 that is a signal from Fset_buffer_multibyte. */
378 if (record
&& BUF_MARKERS (b
))
379 build_marker (b
, best_above
, best_above_byte
);
381 byte_char_debug_check (b
, best_above
, best_above_byte
);
384 cached_modiff
= BUF_MODIFF (b
);
385 cached_charpos
= best_above
;
386 cached_bytepos
= best_above_byte
;
394 /* Operations on markers. */
396 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
397 doc
: /* Return the buffer that MARKER points into, or nil if none.
398 Returns nil if MARKER points into a dead buffer. */)
399 (register Lisp_Object marker
)
401 register Lisp_Object buf
;
402 CHECK_MARKER (marker
);
403 if (XMARKER (marker
)->buffer
)
405 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
406 /* If the buffer is dead, we're in trouble: the buffer pointer here
407 does not preserve the buffer from being GC'd (it's weak), so
408 markers have to be unlinked from their buffer as soon as the buffer
410 eassert (!NILP (BVAR (XBUFFER (buf
), name
)));
416 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
417 doc
: /* Return the position MARKER points at, as a character number.
418 Returns nil if MARKER points nowhere. */)
421 CHECK_MARKER (marker
);
422 if (XMARKER (marker
)->buffer
)
423 return make_number (XMARKER (marker
)->charpos
);
428 /* Change M so it points to B at CHARPOS and BYTEPOS. */
431 attach_marker (struct Lisp_Marker
*m
, struct buffer
*b
,
432 ptrdiff_t charpos
, ptrdiff_t bytepos
)
434 /* Every character is at least one byte. */
435 eassert (charpos
<= bytepos
);
437 m
->charpos
= charpos
;
438 m
->bytepos
= bytepos
;
444 m
->next
= BUF_MARKERS (b
);
449 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
450 doc
: /* Position MARKER before character number POSITION in BUFFER.
451 BUFFER defaults to the current buffer.
452 If POSITION is nil, makes marker point nowhere.
453 Then it no longer slows down editing in any buffer.
455 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
457 register ptrdiff_t charpos
;
458 register ptrdiff_t bytepos
;
459 register struct buffer
*b
;
460 register struct Lisp_Marker
*m
;
462 CHECK_MARKER (marker
);
463 m
= XMARKER (marker
);
465 /* If position is nil or a marker that points nowhere,
466 make this marker point nowhere. */
468 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
478 CHECK_BUFFER (buffer
);
479 b
= XBUFFER (buffer
);
480 /* If buffer is dead, set marker to point nowhere. */
481 if (EQ (BVAR (b
, name
), Qnil
))
488 /* Optimize the special case where we are copying the position
489 of an existing marker, and MARKER is already in the same buffer. */
490 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
493 m
->bytepos
= XMARKER (position
)->bytepos
;
494 m
->charpos
= XMARKER (position
)->charpos
;
498 CHECK_NUMBER_COERCE_MARKER (position
);
499 charpos
= clip_to_bounds (BUF_BEG (b
), XINT (position
), BUF_Z (b
));
500 bytepos
= buf_charpos_to_bytepos (b
, charpos
);
502 attach_marker (m
, b
, charpos
, bytepos
);
506 /* This version of Fset_marker won't let the position
507 be outside the visible part. */
510 set_marker_restricted (Lisp_Object marker
, Lisp_Object pos
, Lisp_Object buffer
)
512 register ptrdiff_t charpos
;
513 register ptrdiff_t bytepos
;
514 register struct buffer
*b
;
515 register struct Lisp_Marker
*m
;
517 CHECK_MARKER (marker
);
518 m
= XMARKER (marker
);
520 /* If position is nil or a marker that points nowhere,
521 make this marker point nowhere. */
523 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
533 CHECK_BUFFER (buffer
);
534 b
= XBUFFER (buffer
);
535 /* If buffer is dead, set marker to point nowhere. */
536 if (EQ (BVAR (b
, name
), Qnil
))
543 /* Optimize the special case where we are copying the position
544 of an existing marker, and MARKER is already in the same buffer. */
545 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
548 m
->bytepos
= XMARKER (pos
)->bytepos
;
549 m
->charpos
= XMARKER (pos
)->charpos
;
553 CHECK_NUMBER_COERCE_MARKER (pos
);
554 charpos
= clip_to_bounds (BUF_BEGV (b
), XINT (pos
), BUF_ZV (b
));
555 bytepos
= buf_charpos_to_bytepos (b
, charpos
);
557 attach_marker (m
, b
, charpos
, bytepos
);
561 /* Set the position of MARKER, specifying both the
562 character position and the corresponding byte position. */
565 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
567 register struct buffer
*b
;
568 register struct Lisp_Marker
*m
;
570 CHECK_MARKER (marker
);
571 m
= XMARKER (marker
);
577 CHECK_BUFFER (buffer
);
578 b
= XBUFFER (buffer
);
579 /* If buffer is dead, set marker to point nowhere. */
580 if (EQ (BVAR (b
, name
), Qnil
))
587 /* In a single-byte buffer, the two positions must be equal. */
588 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
589 && charpos
!= bytepos
)
592 attach_marker (m
, b
, charpos
, bytepos
);
596 /* This version of set_marker_both won't let the position
597 be outside the visible part. */
600 set_marker_restricted_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 charpos
= clip_to_bounds (BUF_BEGV (b
), charpos
, BUF_ZV (b
));
623 bytepos
= clip_to_bounds (BUF_BEGV_BYTE (b
), bytepos
, BUF_ZV_BYTE (b
));
625 /* In a single-byte buffer, the two positions must be equal. */
626 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
627 && charpos
!= bytepos
)
630 attach_marker (m
, b
, charpos
, bytepos
);
634 /* Remove MARKER from the chain of whatever buffer it is in,
635 leaving it points to nowhere. This is called during garbage
636 collection, so we must be careful to ignore and preserve
637 mark bits, including those in chain fields of markers. */
640 unchain_marker (register struct Lisp_Marker
*marker
)
642 register struct buffer
*b
= marker
->buffer
;
646 register struct Lisp_Marker
*tail
, **prev
;
648 /* No dead buffers here. */
649 eassert (!NILP (BVAR (b
, name
)));
651 marker
->buffer
= NULL
;
652 prev
= &BUF_MARKERS (b
);
654 for (tail
= BUF_MARKERS (b
); tail
; prev
= &tail
->next
, tail
= *prev
)
657 if (*prev
== BUF_MARKERS (b
))
659 /* Deleting first marker from the buffer's chain. Crash
660 if new first marker in chain does not say it belongs
661 to the same buffer, or at least that they have the same
663 if (tail
->next
&& b
->text
!= tail
->next
->buffer
->text
)
667 /* We have removed the marker from the chain;
668 no need to scan the rest of the chain. */
672 /* Error if marker was not in it's chain. */
673 eassert (tail
!= NULL
);
677 /* Return the char position of marker MARKER, as a C integer. */
680 marker_position (Lisp_Object marker
)
682 register struct Lisp_Marker
*m
= XMARKER (marker
);
683 register struct buffer
*buf
= m
->buffer
;
686 error ("Marker does not point anywhere");
688 eassert (BUF_BEG (buf
) <= m
->charpos
&& m
->charpos
<= BUF_Z (buf
));
693 /* Return the byte position of marker MARKER, as a C integer. */
696 marker_byte_position (Lisp_Object marker
)
698 register struct Lisp_Marker
*m
= XMARKER (marker
);
699 register struct buffer
*buf
= m
->buffer
;
702 error ("Marker does not point anywhere");
704 eassert (BUF_BEG_BYTE (buf
) <= m
->bytepos
&& m
->bytepos
<= BUF_Z_BYTE (buf
));
709 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
710 doc
: /* Return a new marker pointing at the same place as MARKER.
711 If argument is a number, makes a new marker pointing
712 at that position in the current buffer.
713 If MARKER is not specified, the new marker does not point anywhere.
714 The optional argument TYPE specifies the insertion type of the new marker;
715 see `marker-insertion-type'. */)
716 (register Lisp_Object marker
, Lisp_Object type
)
718 register Lisp_Object
new;
721 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
723 new = Fmake_marker ();
724 Fset_marker (new, marker
,
725 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
726 XMARKER (new)->insertion_type
= !NILP (type
);
730 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
731 Smarker_insertion_type
, 1, 1, 0,
732 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
733 The value nil means the marker stays before text inserted there. */)
734 (register Lisp_Object marker
)
736 CHECK_MARKER (marker
);
737 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
740 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
741 Sset_marker_insertion_type
, 2, 2, 0,
742 doc
: /* Set the insertion-type of MARKER to TYPE.
743 If TYPE is t, it means the marker advances when you insert text at it.
744 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
745 (Lisp_Object marker
, Lisp_Object type
)
747 CHECK_MARKER (marker
);
749 XMARKER (marker
)->insertion_type
= ! NILP (type
);
753 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
755 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
756 (Lisp_Object position
)
758 register struct Lisp_Marker
*tail
;
759 register ptrdiff_t charpos
;
761 charpos
= clip_to_bounds (BEG
, XINT (position
), Z
);
763 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
764 if (tail
->charpos
== charpos
)
772 /* For debugging -- count the markers in buffer BUF. */
775 count_markers (struct buffer
*buf
)
778 struct Lisp_Marker
*tail
;
780 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
786 /* For debugging -- recompute the bytepos corresponding
787 to CHARPOS in the simplest, most reliable way. */
790 verify_bytepos (ptrdiff_t charpos
)
793 ptrdiff_t below_byte
= 1;
795 while (below
!= charpos
)
798 BUF_INC_POS (current_buffer
, below_byte
);
804 #endif /* MARKER_DEBUG */
807 syms_of_marker (void)
809 defsubr (&Smarker_position
);
810 defsubr (&Smarker_buffer
);
811 defsubr (&Sset_marker
);
812 defsubr (&Scopy_marker
);
813 defsubr (&Smarker_insertion_type
);
814 defsubr (&Sset_marker_insertion_type
);
815 defsubr (&Sbuffer_has_markers_at
);