1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2013 Free Software Foundation,
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
10 (at 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/>. */
24 #include "character.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. */
41 extern int count_markers (struct buffer
*) EXTERNALLY_VISIBLE
;
42 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos
) EXTERNALLY_VISIBLE
;
45 byte_char_debug_check (struct buffer
*b
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
49 if (NILP (BVAR (b
, enable_multibyte_characters
)))
52 if (bytepos
> BUF_GPT_BYTE (b
))
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
));
59 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
60 bytepos
- BUF_BEG_BYTE (b
));
62 if (charpos
- 1 != nchars
)
66 #else /* not MARKER_DEBUG */
68 #define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
70 #endif /* MARKER_DEBUG */
73 clear_charpos_cache (struct buffer
*b
)
75 if (cached_buffer
== b
)
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 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
88 /* This macro is a subroutine of charpos_to_bytepos.
89 Note that it is desirable that BYTEPOS is not evaluated
90 except when we really want its value. */
92 #define CONSIDER(CHARPOS, BYTEPOS) \
94 ptrdiff_t this_charpos = (CHARPOS); \
97 if (this_charpos == charpos) \
99 ptrdiff_t value = (BYTEPOS); \
101 byte_char_debug_check (b, charpos, value); \
104 else if (this_charpos > charpos) \
106 if (this_charpos < best_above) \
108 best_above = this_charpos; \
109 best_above_byte = (BYTEPOS); \
113 else if (this_charpos > best_below) \
115 best_below = this_charpos; \
116 best_below_byte = (BYTEPOS); \
122 if (best_above - best_below == best_above_byte - best_below_byte) \
124 ptrdiff_t value = best_below_byte + (charpos - best_below); \
126 byte_char_debug_check (b, charpos, value); \
133 charpos_to_bytepos (ptrdiff_t charpos
)
135 return buf_charpos_to_bytepos (current_buffer
, charpos
);
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 if (charpos
< BUF_BEG (b
) || charpos
> BUF_Z (b
))
148 best_above
= BUF_Z (b
);
149 best_above_byte
= BUF_Z_BYTE (b
);
151 /* If this buffer has as many characters as bytes,
152 each character must be one byte.
153 This takes care of the case where enable-multibyte-characters is nil. */
154 if (best_above
== best_above_byte
)
158 best_below_byte
= BEG_BYTE
;
160 /* We find in best_above and best_above_byte
161 the closest known point above CHARPOS,
162 and in best_below and best_below_byte
163 the closest known point below CHARPOS,
165 If at any point we can tell that the space between those
166 two best approximations is all single-byte,
167 we interpolate the result immediately. */
169 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
170 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
171 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
172 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
174 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
175 CONSIDER (cached_charpos
, cached_bytepos
);
177 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
179 CONSIDER (tail
->charpos
, tail
->bytepos
);
181 /* If we are down to a range of 50 chars,
182 don't bother checking any other markers;
183 scan the intervening chars directly now. */
184 if (best_above
- best_below
< 50)
188 /* We get here if we did not exactly hit one of the known places.
189 We have one known above and one known below.
190 Scan, counting characters, from whichever one is closer. */
192 if (charpos
- best_below
< best_above
- charpos
)
194 bool record
= charpos
- best_below
> 5000;
196 while (best_below
!= charpos
)
199 BUF_INC_POS (b
, best_below_byte
);
202 /* If this position is quite far from the nearest known position,
203 cache the correspondence by creating a marker here.
204 It will last until the next GC. */
206 build_marker (b
, best_below
, best_below_byte
);
208 byte_char_debug_check (b
, best_below
, best_below_byte
);
211 cached_modiff
= BUF_MODIFF (b
);
212 cached_charpos
= best_below
;
213 cached_bytepos
= best_below_byte
;
215 return best_below_byte
;
219 bool record
= best_above
- charpos
> 5000;
221 while (best_above
!= charpos
)
224 BUF_DEC_POS (b
, best_above_byte
);
227 /* If this position is quite far from the nearest known position,
228 cache the correspondence by creating a marker here.
229 It will last until the next GC. */
231 build_marker (b
, best_above
, best_above_byte
);
233 byte_char_debug_check (b
, best_above
, best_above_byte
);
236 cached_modiff
= BUF_MODIFF (b
);
237 cached_charpos
= best_above
;
238 cached_bytepos
= best_above_byte
;
240 return best_above_byte
;
246 /* buf_bytepos_to_charpos returns the char position corresponding to
249 /* This macro is a subroutine of buf_bytepos_to_charpos.
250 It is used when BYTEPOS is actually the byte position. */
252 #define CONSIDER(BYTEPOS, CHARPOS) \
254 ptrdiff_t this_bytepos = (BYTEPOS); \
257 if (this_bytepos == bytepos) \
259 ptrdiff_t value = (CHARPOS); \
261 byte_char_debug_check (b, value, bytepos); \
264 else if (this_bytepos > bytepos) \
266 if (this_bytepos < best_above_byte) \
268 best_above = (CHARPOS); \
269 best_above_byte = this_bytepos; \
273 else if (this_bytepos > best_below_byte) \
275 best_below = (CHARPOS); \
276 best_below_byte = this_bytepos; \
282 if (best_above - best_below == best_above_byte - best_below_byte) \
284 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
286 byte_char_debug_check (b, value, bytepos); \
293 buf_bytepos_to_charpos (struct buffer
*b
, ptrdiff_t bytepos
)
295 struct Lisp_Marker
*tail
;
296 ptrdiff_t best_above
, best_above_byte
;
297 ptrdiff_t best_below
, best_below_byte
;
299 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
302 best_above
= BUF_Z (b
);
303 best_above_byte
= BUF_Z_BYTE (b
);
305 /* If this buffer has as many characters as bytes,
306 each character must be one byte.
307 This takes care of the case where enable-multibyte-characters is nil. */
308 if (best_above
== best_above_byte
)
312 best_below_byte
= BEG_BYTE
;
314 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
315 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
316 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
317 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
319 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
320 CONSIDER (cached_bytepos
, cached_charpos
);
322 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
324 CONSIDER (tail
->bytepos
, tail
->charpos
);
326 /* If we are down to a range of 50 chars,
327 don't bother checking any other markers;
328 scan the intervening chars directly now. */
329 if (best_above
- best_below
< 50)
333 /* We get here if we did not exactly hit one of the known places.
334 We have one known above and one known below.
335 Scan, counting characters, from whichever one is closer. */
337 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
339 bool record
= bytepos
- best_below_byte
> 5000;
341 while (best_below_byte
< bytepos
)
344 BUF_INC_POS (b
, best_below_byte
);
347 /* If this position is quite far from the nearest known position,
348 cache the correspondence by creating a marker here.
349 It will last until the next GC.
350 But don't do it if BUF_MARKERS is nil;
351 that is a signal from Fset_buffer_multibyte. */
352 if (record
&& BUF_MARKERS (b
))
353 build_marker (b
, best_below
, best_below_byte
);
355 byte_char_debug_check (b
, best_below
, best_below_byte
);
358 cached_modiff
= BUF_MODIFF (b
);
359 cached_charpos
= best_below
;
360 cached_bytepos
= best_below_byte
;
366 bool record
= best_above_byte
- bytepos
> 5000;
368 while (best_above_byte
> bytepos
)
371 BUF_DEC_POS (b
, best_above_byte
);
374 /* If this position is quite far from the nearest known position,
375 cache the correspondence by creating a marker here.
376 It will last until the next GC.
377 But don't do it if BUF_MARKERS is nil;
378 that is a signal from Fset_buffer_multibyte. */
379 if (record
&& BUF_MARKERS (b
))
380 build_marker (b
, best_above
, best_above_byte
);
382 byte_char_debug_check (b
, best_above
, best_above_byte
);
385 cached_modiff
= BUF_MODIFF (b
);
386 cached_charpos
= best_above
;
387 cached_bytepos
= best_above_byte
;
395 /* Operations on markers. */
397 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
398 doc
: /* Return the buffer that MARKER points into, or nil if none.
399 Returns nil if MARKER points into a dead buffer. */)
400 (register Lisp_Object marker
)
402 register Lisp_Object buf
;
403 CHECK_MARKER (marker
);
404 if (XMARKER (marker
)->buffer
)
406 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
407 /* If the buffer is dead, we're in trouble: the buffer pointer here
408 does not preserve the buffer from being GC'd (it's weak), so
409 markers have to be unlinked from their buffer as soon as the buffer
411 eassert (BUFFER_LIVE_P (XBUFFER (buf
)));
417 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
418 doc
: /* Return the position MARKER points at, as a character number.
419 Returns nil if MARKER points nowhere. */)
422 CHECK_MARKER (marker
);
423 if (XMARKER (marker
)->buffer
)
424 return make_number (XMARKER (marker
)->charpos
);
429 /* Change M so it points to B at CHARPOS and BYTEPOS. */
432 attach_marker (struct Lisp_Marker
*m
, struct buffer
*b
,
433 ptrdiff_t charpos
, ptrdiff_t bytepos
)
435 /* In a single-byte buffer, two positions must be equal.
436 Otherwise, every character is at least one byte. */
437 if (BUF_Z (b
) == BUF_Z_BYTE (b
))
438 eassert (charpos
== bytepos
);
440 eassert (charpos
<= bytepos
);
442 m
->charpos
= charpos
;
443 m
->bytepos
= bytepos
;
449 m
->next
= BUF_MARKERS (b
);
454 /* If BUFFER is nil, return current buffer pointer. Next, check
455 whether BUFFER is a buffer object and return buffer pointer
456 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
458 static struct buffer
*
459 live_buffer (Lisp_Object buffer
)
466 eassert (BUFFER_LIVE_P (b
));
470 CHECK_BUFFER (buffer
);
471 b
= XBUFFER (buffer
);
472 if (!BUFFER_LIVE_P (b
))
478 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
479 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
482 set_marker_internal (Lisp_Object marker
, Lisp_Object position
,
483 Lisp_Object buffer
, bool restricted
)
485 struct Lisp_Marker
*m
;
486 struct buffer
*b
= live_buffer (buffer
);
488 CHECK_MARKER (marker
);
489 m
= XMARKER (marker
);
491 /* Set MARKER to point nowhere if BUFFER is dead, or
492 POSITION is nil or a marker points to nowhere. */
494 || (MARKERP (position
) && !XMARKER (position
)->buffer
)
498 /* Optimize the special case where we are copying the position of
499 an existing marker, and MARKER is already in the same buffer. */
500 else if (MARKERP (position
) && b
== XMARKER (position
)->buffer
503 m
->bytepos
= XMARKER (position
)->bytepos
;
504 m
->charpos
= XMARKER (position
)->charpos
;
509 register ptrdiff_t charpos
, bytepos
;
511 CHECK_NUMBER_COERCE_MARKER (position
);
512 charpos
= clip_to_bounds (restricted
? BUF_BEGV (b
) : BUF_BEG (b
),
514 restricted
? BUF_ZV (b
) : BUF_Z (b
));
515 bytepos
= buf_charpos_to_bytepos (b
, charpos
);
516 attach_marker (m
, b
, charpos
, bytepos
);
521 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
522 doc
: /* Position MARKER before character number POSITION in BUFFER,
523 which defaults to the current buffer. If POSITION is nil,
524 makes marker point nowhere so it no longer slows down
525 editing in any buffer. Returns MARKER. */)
526 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
528 return set_marker_internal (marker
, position
, buffer
, 0);
531 /* Like the above, but won't let the position be outside the visible part. */
534 set_marker_restricted (Lisp_Object marker
, Lisp_Object position
,
537 return set_marker_internal (marker
, position
, buffer
, 1);
540 /* Set the position of MARKER, specifying both the
541 character position and the corresponding byte position. */
544 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
,
545 ptrdiff_t charpos
, ptrdiff_t bytepos
)
547 register struct Lisp_Marker
*m
;
548 register struct buffer
*b
= live_buffer (buffer
);
550 CHECK_MARKER (marker
);
551 m
= XMARKER (marker
);
554 attach_marker (m
, b
, charpos
, bytepos
);
560 /* Like the above, but won't let the position be outside the visible part. */
563 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
,
564 ptrdiff_t charpos
, ptrdiff_t bytepos
)
566 register struct Lisp_Marker
*m
;
567 register struct buffer
*b
= live_buffer (buffer
);
569 CHECK_MARKER (marker
);
570 m
= XMARKER (marker
);
576 clip_to_bounds (BUF_BEGV (b
), charpos
, BUF_ZV (b
)),
577 clip_to_bounds (BUF_BEGV_BYTE (b
), bytepos
, BUF_ZV_BYTE (b
)));
584 /* Remove MARKER from the chain of whatever buffer it is in,
585 leaving it points to nowhere. This is called during garbage
586 collection, so we must be careful to ignore and preserve
587 mark bits, including those in chain fields of markers. */
590 unchain_marker (register struct Lisp_Marker
*marker
)
592 register struct buffer
*b
= marker
->buffer
;
596 register struct Lisp_Marker
*tail
, **prev
;
598 /* No dead buffers here. */
599 eassert (BUFFER_LIVE_P (b
));
601 marker
->buffer
= NULL
;
602 prev
= &BUF_MARKERS (b
);
604 for (tail
= BUF_MARKERS (b
); tail
; prev
= &tail
->next
, tail
= *prev
)
607 if (*prev
== BUF_MARKERS (b
))
609 /* Deleting first marker from the buffer's chain. Crash
610 if new first marker in chain does not say it belongs
611 to the same buffer, or at least that they have the same
613 if (tail
->next
&& b
->text
!= tail
->next
->buffer
->text
)
617 /* We have removed the marker from the chain;
618 no need to scan the rest of the chain. */
622 /* Error if marker was not in it's chain. */
623 eassert (tail
!= NULL
);
627 /* Return the char position of marker MARKER, as a C integer. */
630 marker_position (Lisp_Object marker
)
632 register struct Lisp_Marker
*m
= XMARKER (marker
);
633 register struct buffer
*buf
= m
->buffer
;
636 error ("Marker does not point anywhere");
638 eassert (BUF_BEG (buf
) <= m
->charpos
&& m
->charpos
<= BUF_Z (buf
));
643 /* Return the byte position of marker MARKER, as a C integer. */
646 marker_byte_position (Lisp_Object marker
)
648 register struct Lisp_Marker
*m
= XMARKER (marker
);
649 register struct buffer
*buf
= m
->buffer
;
652 error ("Marker does not point anywhere");
654 eassert (BUF_BEG_BYTE (buf
) <= m
->bytepos
&& m
->bytepos
<= BUF_Z_BYTE (buf
));
659 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
660 doc
: /* Return a new marker pointing at the same place as MARKER.
661 If argument is a number, makes a new marker pointing
662 at that position in the current buffer.
663 If MARKER is not specified, the new marker does not point anywhere.
664 The optional argument TYPE specifies the insertion type of the new marker;
665 see `marker-insertion-type'. */)
666 (register Lisp_Object marker
, Lisp_Object type
)
668 register Lisp_Object
new;
671 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
673 new = Fmake_marker ();
674 Fset_marker (new, marker
,
675 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
676 XMARKER (new)->insertion_type
= !NILP (type
);
680 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
681 Smarker_insertion_type
, 1, 1, 0,
682 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
683 The value nil means the marker stays before text inserted there. */)
684 (register Lisp_Object marker
)
686 CHECK_MARKER (marker
);
687 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
690 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
691 Sset_marker_insertion_type
, 2, 2, 0,
692 doc
: /* Set the insertion-type of MARKER to TYPE.
693 If TYPE is t, it means the marker advances when you insert text at it.
694 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
695 (Lisp_Object marker
, Lisp_Object type
)
697 CHECK_MARKER (marker
);
699 XMARKER (marker
)->insertion_type
= ! NILP (type
);
703 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
705 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
706 (Lisp_Object position
)
708 register struct Lisp_Marker
*tail
;
709 register ptrdiff_t charpos
;
711 charpos
= clip_to_bounds (BEG
, XINT (position
), Z
);
713 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
714 if (tail
->charpos
== charpos
)
722 /* For debugging -- count the markers in buffer BUF. */
725 count_markers (struct buffer
*buf
)
728 struct Lisp_Marker
*tail
;
730 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
736 /* For debugging -- recompute the bytepos corresponding
737 to CHARPOS in the simplest, most reliable way. */
740 verify_bytepos (ptrdiff_t charpos
)
743 ptrdiff_t below_byte
= 1;
745 while (below
!= charpos
)
748 BUF_INC_POS (current_buffer
, below_byte
);
754 #endif /* MARKER_DEBUG */
757 syms_of_marker (void)
759 defsubr (&Smarker_position
);
760 defsubr (&Smarker_buffer
);
761 defsubr (&Sset_marker
);
762 defsubr (&Scopy_marker
);
763 defsubr (&Smarker_insertion_type
);
764 defsubr (&Sset_marker_insertion_type
);
765 defsubr (&Sbuffer_has_markers_at
);