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 EMACS_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 /* This macro is a subroutine of buf_charpos_to_bytepos.
86 Note that it is desirable that BYTEPOS is not evaluated
87 except when we really want its value. */
89 #define CONSIDER(CHARPOS, BYTEPOS) \
91 ptrdiff_t this_charpos = (CHARPOS); \
94 if (this_charpos == charpos) \
96 ptrdiff_t value = (BYTEPOS); \
98 byte_char_debug_check (b, charpos, value); \
101 else if (this_charpos > charpos) \
103 if (this_charpos < best_above) \
105 best_above = this_charpos; \
106 best_above_byte = (BYTEPOS); \
110 else if (this_charpos > best_below) \
112 best_below = this_charpos; \
113 best_below_byte = (BYTEPOS); \
119 if (best_above - best_below == best_above_byte - best_below_byte) \
121 ptrdiff_t value = best_below_byte + (charpos - best_below); \
123 byte_char_debug_check (b, charpos, value); \
129 /* Return the byte position corresponding to CHARPOS in B. */
132 buf_charpos_to_bytepos (struct buffer
*b
, ptrdiff_t charpos
)
134 struct Lisp_Marker
*tail
;
135 ptrdiff_t best_above
, best_above_byte
;
136 ptrdiff_t best_below
, best_below_byte
;
138 eassert (BUF_BEG (b
) <= charpos
&& charpos
<= BUF_Z (b
));
140 best_above
= BUF_Z (b
);
141 best_above_byte
= BUF_Z_BYTE (b
);
143 /* If this buffer has as many characters as bytes,
144 each character must be one byte.
145 This takes care of the case where enable-multibyte-characters is nil. */
146 if (best_above
== best_above_byte
)
150 best_below_byte
= BEG_BYTE
;
152 /* We find in best_above and best_above_byte
153 the closest known point above CHARPOS,
154 and in best_below and best_below_byte
155 the closest known point below CHARPOS,
157 If at any point we can tell that the space between those
158 two best approximations is all single-byte,
159 we interpolate the result immediately. */
161 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
162 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
163 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
164 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
166 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
167 CONSIDER (cached_charpos
, cached_bytepos
);
169 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
171 CONSIDER (tail
->charpos
, tail
->bytepos
);
173 /* If we are down to a range of 50 chars,
174 don't bother checking any other markers;
175 scan the intervening chars directly now. */
176 if (best_above
- best_below
< 50)
180 /* We get here if we did not exactly hit one of the known places.
181 We have one known above and one known below.
182 Scan, counting characters, from whichever one is closer. */
184 if (charpos
- best_below
< best_above
- charpos
)
186 bool record
= charpos
- best_below
> 5000;
188 while (best_below
!= charpos
)
191 BUF_INC_POS (b
, best_below_byte
);
194 /* If this position is quite far from the nearest known position,
195 cache the correspondence by creating a marker here.
196 It will last until the next GC. */
198 build_marker (b
, best_below
, best_below_byte
);
200 byte_char_debug_check (b
, best_below
, best_below_byte
);
203 cached_modiff
= BUF_MODIFF (b
);
204 cached_charpos
= best_below
;
205 cached_bytepos
= best_below_byte
;
207 return best_below_byte
;
211 bool record
= best_above
- charpos
> 5000;
213 while (best_above
!= charpos
)
216 BUF_DEC_POS (b
, best_above_byte
);
219 /* If this position is quite far from the nearest known position,
220 cache the correspondence by creating a marker here.
221 It will last until the next GC. */
223 build_marker (b
, best_above
, best_above_byte
);
225 byte_char_debug_check (b
, best_above
, best_above_byte
);
228 cached_modiff
= BUF_MODIFF (b
);
229 cached_charpos
= best_above
;
230 cached_bytepos
= best_above_byte
;
232 return best_above_byte
;
238 /* This macro is a subroutine of buf_bytepos_to_charpos.
239 It is used when BYTEPOS is actually the byte position. */
241 #define CONSIDER(BYTEPOS, CHARPOS) \
243 ptrdiff_t this_bytepos = (BYTEPOS); \
246 if (this_bytepos == bytepos) \
248 ptrdiff_t value = (CHARPOS); \
250 byte_char_debug_check (b, value, bytepos); \
253 else if (this_bytepos > bytepos) \
255 if (this_bytepos < best_above_byte) \
257 best_above = (CHARPOS); \
258 best_above_byte = this_bytepos; \
262 else if (this_bytepos > best_below_byte) \
264 best_below = (CHARPOS); \
265 best_below_byte = this_bytepos; \
271 if (best_above - best_below == best_above_byte - best_below_byte) \
273 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
275 byte_char_debug_check (b, value, bytepos); \
281 /* Return the character position corresponding to BYTEPOS in B. */
284 buf_bytepos_to_charpos (struct buffer
*b
, ptrdiff_t bytepos
)
286 struct Lisp_Marker
*tail
;
287 ptrdiff_t best_above
, best_above_byte
;
288 ptrdiff_t best_below
, best_below_byte
;
290 eassert (BUF_BEG_BYTE (b
) <= bytepos
&& bytepos
<= BUF_Z_BYTE (b
));
292 best_above
= BUF_Z (b
);
293 best_above_byte
= BUF_Z_BYTE (b
);
295 /* If this buffer has as many characters as bytes,
296 each character must be one byte.
297 This takes care of the case where enable-multibyte-characters is nil. */
298 if (best_above
== best_above_byte
)
302 best_below_byte
= BEG_BYTE
;
304 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
305 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
306 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
307 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
309 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
310 CONSIDER (cached_bytepos
, cached_charpos
);
312 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
314 CONSIDER (tail
->bytepos
, tail
->charpos
);
316 /* If we are down to a range of 50 chars,
317 don't bother checking any other markers;
318 scan the intervening chars directly now. */
319 if (best_above
- best_below
< 50)
323 /* We get here if we did not exactly hit one of the known places.
324 We have one known above and one known below.
325 Scan, counting characters, from whichever one is closer. */
327 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
329 bool record
= bytepos
- best_below_byte
> 5000;
331 while (best_below_byte
< bytepos
)
334 BUF_INC_POS (b
, best_below_byte
);
337 /* If this position is quite far from the nearest known position,
338 cache the correspondence by creating a marker here.
339 It will last until the next GC.
340 But don't do it if BUF_MARKERS is nil;
341 that is a signal from Fset_buffer_multibyte. */
342 if (record
&& BUF_MARKERS (b
))
343 build_marker (b
, best_below
, best_below_byte
);
345 byte_char_debug_check (b
, best_below
, best_below_byte
);
348 cached_modiff
= BUF_MODIFF (b
);
349 cached_charpos
= best_below
;
350 cached_bytepos
= best_below_byte
;
356 bool record
= best_above_byte
- bytepos
> 5000;
358 while (best_above_byte
> bytepos
)
361 BUF_DEC_POS (b
, best_above_byte
);
364 /* If this position is quite far from the nearest known position,
365 cache the correspondence by creating a marker here.
366 It will last until the next GC.
367 But don't do it if BUF_MARKERS is nil;
368 that is a signal from Fset_buffer_multibyte. */
369 if (record
&& BUF_MARKERS (b
))
370 build_marker (b
, best_above
, best_above_byte
);
372 byte_char_debug_check (b
, best_above
, best_above_byte
);
375 cached_modiff
= BUF_MODIFF (b
);
376 cached_charpos
= best_above
;
377 cached_bytepos
= best_above_byte
;
385 /* Operations on markers. */
387 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
388 doc
: /* Return the buffer that MARKER points into, or nil if none.
389 Returns nil if MARKER points into a dead buffer. */)
390 (register Lisp_Object marker
)
392 register Lisp_Object buf
;
393 CHECK_MARKER (marker
);
394 if (XMARKER (marker
)->buffer
)
396 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
397 /* If the buffer is dead, we're in trouble: the buffer pointer here
398 does not preserve the buffer from being GC'd (it's weak), so
399 markers have to be unlinked from their buffer as soon as the buffer
401 eassert (BUFFER_LIVE_P (XBUFFER (buf
)));
407 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
408 doc
: /* Return the position MARKER points at, as a character number.
409 Returns nil if MARKER points nowhere. */)
412 CHECK_MARKER (marker
);
413 if (XMARKER (marker
)->buffer
)
414 return make_number (XMARKER (marker
)->charpos
);
419 /* Change M so it points to B at CHARPOS and BYTEPOS. */
422 attach_marker (struct Lisp_Marker
*m
, struct buffer
*b
,
423 ptrdiff_t charpos
, ptrdiff_t bytepos
)
425 /* In a single-byte buffer, two positions must be equal.
426 Otherwise, every character is at least one byte. */
427 if (BUF_Z (b
) == BUF_Z_BYTE (b
))
428 eassert (charpos
== bytepos
);
430 eassert (charpos
<= bytepos
);
432 m
->charpos
= charpos
;
433 m
->bytepos
= bytepos
;
439 m
->next
= BUF_MARKERS (b
);
444 /* If BUFFER is nil, return current buffer pointer. Next, check
445 whether BUFFER is a buffer object and return buffer pointer
446 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
448 static struct buffer
*
449 live_buffer (Lisp_Object buffer
)
456 eassert (BUFFER_LIVE_P (b
));
460 CHECK_BUFFER (buffer
);
461 b
= XBUFFER (buffer
);
462 if (!BUFFER_LIVE_P (b
))
468 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
469 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
472 set_marker_internal (Lisp_Object marker
, Lisp_Object position
,
473 Lisp_Object buffer
, bool restricted
)
475 struct Lisp_Marker
*m
;
476 struct buffer
*b
= live_buffer (buffer
);
478 CHECK_MARKER (marker
);
479 m
= XMARKER (marker
);
481 /* Set MARKER to point nowhere if BUFFER is dead, or
482 POSITION is nil or a marker points to nowhere. */
484 || (MARKERP (position
) && !XMARKER (position
)->buffer
)
488 /* Optimize the special case where we are copying the position of
489 an existing marker, and MARKER is already in the same buffer. */
490 else if (MARKERP (position
) && b
== XMARKER (position
)->buffer
493 m
->bytepos
= XMARKER (position
)->bytepos
;
494 m
->charpos
= XMARKER (position
)->charpos
;
499 register ptrdiff_t charpos
, bytepos
;
501 CHECK_NUMBER_COERCE_MARKER (position
);
502 charpos
= clip_to_bounds (restricted
? BUF_BEGV (b
) : BUF_BEG (b
),
504 restricted
? BUF_ZV (b
) : BUF_Z (b
));
505 bytepos
= buf_charpos_to_bytepos (b
, charpos
);
506 attach_marker (m
, b
, charpos
, bytepos
);
511 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
512 doc
: /* Position MARKER before character number POSITION in BUFFER,
513 which defaults to the current buffer. If POSITION is nil,
514 makes marker point nowhere so it no longer slows down
515 editing in any buffer. Returns MARKER. */)
516 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
518 return set_marker_internal (marker
, position
, buffer
, 0);
521 /* Like the above, but won't let the position be outside the visible part. */
524 set_marker_restricted (Lisp_Object marker
, Lisp_Object position
,
527 return set_marker_internal (marker
, position
, buffer
, 1);
530 /* Set the position of MARKER, specifying both the
531 character position and the corresponding byte position. */
534 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
,
535 ptrdiff_t charpos
, ptrdiff_t bytepos
)
537 register struct Lisp_Marker
*m
;
538 register struct buffer
*b
= live_buffer (buffer
);
540 CHECK_MARKER (marker
);
541 m
= XMARKER (marker
);
544 attach_marker (m
, b
, charpos
, bytepos
);
550 /* Like the above, but won't let the position be outside the visible part. */
553 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
,
554 ptrdiff_t charpos
, ptrdiff_t bytepos
)
556 register struct Lisp_Marker
*m
;
557 register struct buffer
*b
= live_buffer (buffer
);
559 CHECK_MARKER (marker
);
560 m
= XMARKER (marker
);
566 clip_to_bounds (BUF_BEGV (b
), charpos
, BUF_ZV (b
)),
567 clip_to_bounds (BUF_BEGV_BYTE (b
), bytepos
, BUF_ZV_BYTE (b
)));
574 /* Remove MARKER from the chain of whatever buffer it is in,
575 leaving it points to nowhere. This is called during garbage
576 collection, so we must be careful to ignore and preserve
577 mark bits, including those in chain fields of markers. */
580 unchain_marker (register struct Lisp_Marker
*marker
)
582 register struct buffer
*b
= marker
->buffer
;
586 register struct Lisp_Marker
*tail
, **prev
;
588 /* No dead buffers here. */
589 eassert (BUFFER_LIVE_P (b
));
591 marker
->buffer
= NULL
;
592 prev
= &BUF_MARKERS (b
);
594 for (tail
= BUF_MARKERS (b
); tail
; prev
= &tail
->next
, tail
= *prev
)
597 if (*prev
== BUF_MARKERS (b
))
599 /* Deleting first marker from the buffer's chain. Crash
600 if new first marker in chain does not say it belongs
601 to the same buffer, or at least that they have the same
603 if (tail
->next
&& b
->text
!= tail
->next
->buffer
->text
)
607 /* We have removed the marker from the chain;
608 no need to scan the rest of the chain. */
612 /* Error if marker was not in it's chain. */
613 eassert (tail
!= NULL
);
617 /* Return the char position of marker MARKER, as a C integer. */
620 marker_position (Lisp_Object marker
)
622 register struct Lisp_Marker
*m
= XMARKER (marker
);
623 register struct buffer
*buf
= m
->buffer
;
626 error ("Marker does not point anywhere");
628 eassert (BUF_BEG (buf
) <= m
->charpos
&& m
->charpos
<= BUF_Z (buf
));
633 /* Return the byte position of marker MARKER, as a C integer. */
636 marker_byte_position (Lisp_Object marker
)
638 register struct Lisp_Marker
*m
= XMARKER (marker
);
639 register struct buffer
*buf
= m
->buffer
;
642 error ("Marker does not point anywhere");
644 eassert (BUF_BEG_BYTE (buf
) <= m
->bytepos
&& m
->bytepos
<= BUF_Z_BYTE (buf
));
649 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
650 doc
: /* Return a new marker pointing at the same place as MARKER.
651 If argument is a number, makes a new marker pointing
652 at that position in the current buffer.
653 If MARKER is not specified, the new marker does not point anywhere.
654 The optional argument TYPE specifies the insertion type of the new marker;
655 see `marker-insertion-type'. */)
656 (register Lisp_Object marker
, Lisp_Object type
)
658 register Lisp_Object
new;
661 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
663 new = Fmake_marker ();
664 Fset_marker (new, marker
,
665 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
666 XMARKER (new)->insertion_type
= !NILP (type
);
670 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
671 Smarker_insertion_type
, 1, 1, 0,
672 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
673 The value nil means the marker stays before text inserted there. */)
674 (register Lisp_Object marker
)
676 CHECK_MARKER (marker
);
677 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
680 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
681 Sset_marker_insertion_type
, 2, 2, 0,
682 doc
: /* Set the insertion-type of MARKER to TYPE.
683 If TYPE is t, it means the marker advances when you insert text at it.
684 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
685 (Lisp_Object marker
, Lisp_Object type
)
687 CHECK_MARKER (marker
);
689 XMARKER (marker
)->insertion_type
= ! NILP (type
);
693 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
695 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
696 (Lisp_Object position
)
698 register struct Lisp_Marker
*tail
;
699 register ptrdiff_t charpos
;
701 charpos
= clip_to_bounds (BEG
, XINT (position
), Z
);
703 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
704 if (tail
->charpos
== charpos
)
712 /* For debugging -- count the markers in buffer BUF. */
715 count_markers (struct buffer
*buf
)
718 struct Lisp_Marker
*tail
;
720 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
726 /* For debugging -- recompute the bytepos corresponding
727 to CHARPOS in the simplest, most reliable way. */
730 verify_bytepos (ptrdiff_t charpos
)
733 ptrdiff_t below_byte
= 1;
735 while (below
!= charpos
)
738 BUF_INC_POS (current_buffer
, below_byte
);
744 #endif /* MARKER_DEBUG */
747 syms_of_marker (void)
749 defsubr (&Smarker_position
);
750 defsubr (&Smarker_buffer
);
751 defsubr (&Sset_marker
);
752 defsubr (&Scopy_marker
);
753 defsubr (&Smarker_insertion_type
);
754 defsubr (&Sset_marker_insertion_type
);
755 defsubr (&Sbuffer_has_markers_at
);