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 /* Initialize just allocated Lisp_Marker. */
431 init_marker (struct Lisp_Marker
*m
, struct buffer
*b
,
432 ptrdiff_t charpos
, ptrdiff_t bytepos
, int type
)
435 m
->charpos
= charpos
;
436 m
->bytepos
= bytepos
;
437 m
->insertion_type
= type
;
440 m
->next
= BUF_MARKERS (b
);
447 /* Change M so it points to B at CHARPOS and BYTEPOS. */
450 attach_marker (struct Lisp_Marker
*m
, struct buffer
*b
,
451 ptrdiff_t charpos
, ptrdiff_t bytepos
)
453 /* In a single-byte buffer, two positions must be equal.
454 Otherwise, every character is at least one byte. */
455 if (BUF_Z (b
) == BUF_Z_BYTE (b
))
456 eassert (charpos
== bytepos
);
458 eassert (charpos
<= bytepos
);
460 m
->charpos
= charpos
;
461 m
->bytepos
= bytepos
;
467 m
->next
= BUF_MARKERS (b
);
472 /* If BUFFER is nil, return current buffer pointer. Next, check
473 whether BUFFER is a buffer object and return buffer pointer
474 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
476 static inline struct buffer
*
477 live_buffer (Lisp_Object buffer
)
484 eassert (!NILP (BVAR (b
, name
)));
488 CHECK_BUFFER (buffer
);
489 b
= XBUFFER (buffer
);
490 if (NILP (BVAR (b
, name
)))
496 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
497 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
499 static inline Lisp_Object
500 set_marker_internal (Lisp_Object marker
, Lisp_Object position
,
501 Lisp_Object buffer
, int restricted
)
503 register struct Lisp_Marker
*m
;
504 register struct buffer
*b
= live_buffer (buffer
);
506 CHECK_MARKER (marker
);
507 m
= XMARKER (marker
);
509 /* Set MARKER to point nowhere if BUFFER is dead, or
510 POSITION is nil or a marker points to nowhere. */
512 || (MARKERP (position
) && !XMARKER (position
)->buffer
)
516 /* Optimize the special case where we are copying the position of
517 an existing marker, and MARKER is already in the same buffer. */
518 else if (MARKERP (position
) && b
== XMARKER (position
)->buffer
521 m
->bytepos
= XMARKER (position
)->bytepos
;
522 m
->charpos
= XMARKER (position
)->charpos
;
527 register ptrdiff_t charpos
, bytepos
;
529 CHECK_NUMBER_COERCE_MARKER (position
);
530 charpos
= clip_to_bounds (restricted
? BUF_BEGV (b
) : BUF_BEG (b
),
532 restricted
? BUF_ZV (b
) : BUF_Z (b
));
533 bytepos
= buf_charpos_to_bytepos (b
, charpos
);
534 attach_marker (m
, b
, charpos
, bytepos
);
539 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
540 doc
: /* Position MARKER before character number POSITION in BUFFER,
541 which defaults to the current buffer. If POSITION is nil,
542 makes marker point nowhere so it no longer slows down
543 editing in any buffer. Returns MARKER. */)
544 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
546 return set_marker_internal (marker
, position
, buffer
, 0);
549 /* Like the above, but won't let the position be outside the visible part. */
552 set_marker_restricted (Lisp_Object marker
, Lisp_Object position
,
555 return set_marker_internal (marker
, position
, buffer
, 1);
558 /* Set the position of MARKER, specifying both the
559 character position and the corresponding byte position. */
562 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
,
563 ptrdiff_t charpos
, ptrdiff_t bytepos
)
565 register struct Lisp_Marker
*m
;
566 register struct buffer
*b
= live_buffer (buffer
);
568 CHECK_MARKER (marker
);
569 m
= XMARKER (marker
);
572 attach_marker (m
, b
, charpos
, bytepos
);
578 /* Like the above, but won't let the position be outside the visible part. */
581 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
,
582 ptrdiff_t charpos
, ptrdiff_t bytepos
)
584 register struct Lisp_Marker
*m
;
585 register struct buffer
*b
= live_buffer (buffer
);
587 CHECK_MARKER (marker
);
588 m
= XMARKER (marker
);
594 clip_to_bounds (BUF_BEGV (b
), charpos
, BUF_ZV (b
)),
595 clip_to_bounds (BUF_BEGV_BYTE (b
), bytepos
, BUF_ZV_BYTE (b
)));
602 /* Remove MARKER from the chain of whatever buffer it is in,
603 leaving it points to nowhere. This is called during garbage
604 collection, so we must be careful to ignore and preserve
605 mark bits, including those in chain fields of markers. */
608 unchain_marker (register struct Lisp_Marker
*marker
)
610 register struct buffer
*b
= marker
->buffer
;
614 register struct Lisp_Marker
*tail
, **prev
;
616 /* No dead buffers here. */
617 eassert (!NILP (BVAR (b
, name
)));
619 marker
->buffer
= NULL
;
620 prev
= &BUF_MARKERS (b
);
622 for (tail
= BUF_MARKERS (b
); tail
; prev
= &tail
->next
, tail
= *prev
)
625 if (*prev
== BUF_MARKERS (b
))
627 /* Deleting first marker from the buffer's chain. Crash
628 if new first marker in chain does not say it belongs
629 to the same buffer, or at least that they have the same
631 if (tail
->next
&& b
->text
!= tail
->next
->buffer
->text
)
635 /* We have removed the marker from the chain;
636 no need to scan the rest of the chain. */
640 /* Error if marker was not in it's chain. */
641 eassert (tail
!= NULL
);
645 /* Return the char position of marker MARKER, as a C integer. */
648 marker_position (Lisp_Object marker
)
650 register struct Lisp_Marker
*m
= XMARKER (marker
);
651 register struct buffer
*buf
= m
->buffer
;
654 error ("Marker does not point anywhere");
656 eassert (BUF_BEG (buf
) <= m
->charpos
&& m
->charpos
<= BUF_Z (buf
));
661 /* Return the byte position of marker MARKER, as a C integer. */
664 marker_byte_position (Lisp_Object marker
)
666 register struct Lisp_Marker
*m
= XMARKER (marker
);
667 register struct buffer
*buf
= m
->buffer
;
670 error ("Marker does not point anywhere");
672 eassert (BUF_BEG_BYTE (buf
) <= m
->bytepos
&& m
->bytepos
<= BUF_Z_BYTE (buf
));
677 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
678 doc
: /* Return a new marker pointing at the same place as MARKER.
679 If argument is a number, makes a new marker pointing
680 at that position in the current buffer.
681 If MARKER is not specified, the new marker does not point anywhere.
682 The optional argument TYPE specifies the insertion type of the new marker;
683 see `marker-insertion-type'. */)
684 (register Lisp_Object marker
, Lisp_Object type
)
686 register Lisp_Object
new;
689 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
691 new = Fmake_marker ();
692 Fset_marker (new, marker
,
693 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
694 XMARKER (new)->insertion_type
= !NILP (type
);
698 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
699 Smarker_insertion_type
, 1, 1, 0,
700 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
701 The value nil means the marker stays before text inserted there. */)
702 (register Lisp_Object marker
)
704 CHECK_MARKER (marker
);
705 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
708 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
709 Sset_marker_insertion_type
, 2, 2, 0,
710 doc
: /* Set the insertion-type of MARKER to TYPE.
711 If TYPE is t, it means the marker advances when you insert text at it.
712 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
713 (Lisp_Object marker
, Lisp_Object type
)
715 CHECK_MARKER (marker
);
717 XMARKER (marker
)->insertion_type
= ! NILP (type
);
721 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
723 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
724 (Lisp_Object position
)
726 register struct Lisp_Marker
*tail
;
727 register ptrdiff_t charpos
;
729 charpos
= clip_to_bounds (BEG
, XINT (position
), Z
);
731 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
732 if (tail
->charpos
== charpos
)
740 /* For debugging -- count the markers in buffer BUF. */
743 count_markers (struct buffer
*buf
)
746 struct Lisp_Marker
*tail
;
748 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
754 /* For debugging -- recompute the bytepos corresponding
755 to CHARPOS in the simplest, most reliable way. */
758 verify_bytepos (ptrdiff_t charpos
)
761 ptrdiff_t below_byte
= 1;
763 while (below
!= charpos
)
766 BUF_INC_POS (current_buffer
, below_byte
);
772 #endif /* MARKER_DEBUG */
775 syms_of_marker (void)
777 defsubr (&Smarker_position
);
778 defsubr (&Smarker_buffer
);
779 defsubr (&Sset_marker
);
780 defsubr (&Scopy_marker
);
781 defsubr (&Smarker_insertion_type
);
782 defsubr (&Sset_marker_insertion_type
);
783 defsubr (&Sbuffer_has_markers_at
);