1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006,
3 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
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/>. */
25 #include "character.h"
27 /* Record one cached position found recently by
28 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
30 static int cached_charpos
;
31 static int cached_bytepos
;
32 static struct buffer
*cached_buffer
;
33 static int cached_modiff
;
35 static void byte_char_debug_check (struct buffer
*, int, int);
37 /* Nonzero means enable debugging checks on byte/char correspondences. */
39 static int byte_debug_flag
;
42 clear_charpos_cache (struct buffer
*b
)
44 if (cached_buffer
== b
)
48 /* Converting between character positions and byte positions. */
50 /* There are several places in the buffer where we know
51 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
52 and everywhere there is a marker. So we find the one of these places
53 that is closest to the specified position, and scan from there. */
55 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
57 /* This macro is a subroutine of charpos_to_bytepos.
58 Note that it is desirable that BYTEPOS is not evaluated
59 except when we really want its value. */
61 #define CONSIDER(CHARPOS, BYTEPOS) \
63 int this_charpos = (CHARPOS); \
66 if (this_charpos == charpos) \
68 int value = (BYTEPOS); \
69 if (byte_debug_flag) \
70 byte_char_debug_check (b, charpos, value); \
73 else if (this_charpos > charpos) \
75 if (this_charpos < best_above) \
77 best_above = this_charpos; \
78 best_above_byte = (BYTEPOS); \
82 else if (this_charpos > best_below) \
84 best_below = this_charpos; \
85 best_below_byte = (BYTEPOS); \
91 if (best_above - best_below == best_above_byte - best_below_byte) \
93 int value = best_below_byte + (charpos - best_below); \
94 if (byte_debug_flag) \
95 byte_char_debug_check (b, charpos, value); \
102 byte_char_debug_check (struct buffer
*b
, int charpos
, int bytepos
)
106 if (bytepos
> BUF_GPT_BYTE (b
))
108 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
109 BUF_GPT_BYTE (b
) - BUF_BEG_BYTE (b
));
110 nchars
+= multibyte_chars_in_text (BUF_GAP_END_ADDR (b
),
111 bytepos
- BUF_GPT_BYTE (b
));
114 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
115 bytepos
- BUF_BEG_BYTE (b
));
117 if (charpos
- 1 != nchars
)
122 charpos_to_bytepos (int charpos
)
124 return buf_charpos_to_bytepos (current_buffer
, charpos
);
128 buf_charpos_to_bytepos (struct buffer
*b
, int charpos
)
130 struct Lisp_Marker
*tail
;
131 int best_above
, best_above_byte
;
132 int best_below
, best_below_byte
;
134 if (charpos
< BUF_BEG (b
) || charpos
> BUF_Z (b
))
137 best_above
= BUF_Z (b
);
138 best_above_byte
= BUF_Z_BYTE (b
);
140 /* If this buffer has as many characters as bytes,
141 each character must be one byte.
142 This takes care of the case where enable-multibyte-characters is nil. */
143 if (best_above
== best_above_byte
)
147 best_below_byte
= BEG_BYTE
;
149 /* We find in best_above and best_above_byte
150 the closest known point above CHARPOS,
151 and in best_below and best_below_byte
152 the closest known point below CHARPOS,
154 If at any point we can tell that the space between those
155 two best approximations is all single-byte,
156 we interpolate the result immediately. */
158 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
159 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
160 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
161 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
163 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
164 CONSIDER (cached_charpos
, cached_bytepos
);
166 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
168 CONSIDER (tail
->charpos
, tail
->bytepos
);
170 /* If we are down to a range of 50 chars,
171 don't bother checking any other markers;
172 scan the intervening chars directly now. */
173 if (best_above
- best_below
< 50)
177 /* We get here if we did not exactly hit one of the known places.
178 We have one known above and one known below.
179 Scan, counting characters, from whichever one is closer. */
181 if (charpos
- best_below
< best_above
- charpos
)
183 int record
= charpos
- best_below
> 5000;
185 while (best_below
!= charpos
)
188 BUF_INC_POS (b
, best_below_byte
);
191 /* If this position is quite far from the nearest known position,
192 cache the correspondence by creating a marker here.
193 It will last until the next GC. */
196 Lisp_Object marker
, buffer
;
197 marker
= Fmake_marker ();
198 XSETBUFFER (buffer
, b
);
199 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
203 byte_char_debug_check (b
, charpos
, best_below_byte
);
206 cached_modiff
= BUF_MODIFF (b
);
207 cached_charpos
= best_below
;
208 cached_bytepos
= best_below_byte
;
210 return best_below_byte
;
214 int record
= best_above
- charpos
> 5000;
216 while (best_above
!= charpos
)
219 BUF_DEC_POS (b
, best_above_byte
);
222 /* If this position is quite far from the nearest known position,
223 cache the correspondence by creating a marker here.
224 It will last until the next GC. */
227 Lisp_Object marker
, buffer
;
228 marker
= Fmake_marker ();
229 XSETBUFFER (buffer
, b
);
230 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
234 byte_char_debug_check (b
, charpos
, best_above_byte
);
237 cached_modiff
= BUF_MODIFF (b
);
238 cached_charpos
= best_above
;
239 cached_bytepos
= best_above_byte
;
241 return best_above_byte
;
247 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
248 in the simplest, most reliable way. */
251 verify_bytepos (int charpos
)
256 while (below
!= charpos
)
259 BUF_INC_POS (current_buffer
, below_byte
);
265 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
267 /* This macro is a subroutine of bytepos_to_charpos.
268 It is used when BYTEPOS is actually the byte position. */
270 #define CONSIDER(BYTEPOS, CHARPOS) \
272 int this_bytepos = (BYTEPOS); \
275 if (this_bytepos == bytepos) \
277 int value = (CHARPOS); \
278 if (byte_debug_flag) \
279 byte_char_debug_check (b, value, bytepos); \
282 else if (this_bytepos > bytepos) \
284 if (this_bytepos < best_above_byte) \
286 best_above = (CHARPOS); \
287 best_above_byte = this_bytepos; \
291 else if (this_bytepos > best_below_byte) \
293 best_below = (CHARPOS); \
294 best_below_byte = this_bytepos; \
300 if (best_above - best_below == best_above_byte - best_below_byte) \
302 int value = best_below + (bytepos - best_below_byte); \
303 if (byte_debug_flag) \
304 byte_char_debug_check (b, value, bytepos); \
311 bytepos_to_charpos (int bytepos
)
313 return buf_bytepos_to_charpos (current_buffer
, bytepos
);
317 buf_bytepos_to_charpos (struct buffer
*b
, int bytepos
)
319 struct Lisp_Marker
*tail
;
320 int best_above
, best_above_byte
;
321 int best_below
, best_below_byte
;
323 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
326 best_above
= BUF_Z (b
);
327 best_above_byte
= BUF_Z_BYTE (b
);
329 /* If this buffer has as many characters as bytes,
330 each character must be one byte.
331 This takes care of the case where enable-multibyte-characters is nil. */
332 if (best_above
== best_above_byte
)
336 best_below_byte
= BEG_BYTE
;
338 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
339 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
340 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
341 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
343 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
344 CONSIDER (cached_bytepos
, cached_charpos
);
346 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
348 CONSIDER (tail
->bytepos
, tail
->charpos
);
350 /* If we are down to a range of 50 chars,
351 don't bother checking any other markers;
352 scan the intervening chars directly now. */
353 if (best_above
- best_below
< 50)
357 /* We get here if we did not exactly hit one of the known places.
358 We have one known above and one known below.
359 Scan, counting characters, from whichever one is closer. */
361 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
363 int record
= bytepos
- best_below_byte
> 5000;
365 while (best_below_byte
< bytepos
)
368 BUF_INC_POS (b
, best_below_byte
);
371 /* If this position is quite far from the nearest known position,
372 cache the correspondence by creating a marker here.
373 It will last until the next GC.
374 But don't do it if BUF_MARKERS is nil;
375 that is a signal from Fset_buffer_multibyte. */
376 if (record
&& BUF_MARKERS (b
))
378 Lisp_Object marker
, buffer
;
379 marker
= Fmake_marker ();
380 XSETBUFFER (buffer
, b
);
381 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
385 byte_char_debug_check (b
, best_below
, bytepos
);
388 cached_modiff
= BUF_MODIFF (b
);
389 cached_charpos
= best_below
;
390 cached_bytepos
= best_below_byte
;
396 int record
= best_above_byte
- bytepos
> 5000;
398 while (best_above_byte
> bytepos
)
401 BUF_DEC_POS (b
, best_above_byte
);
404 /* If this position is quite far from the nearest known position,
405 cache the correspondence by creating a marker here.
406 It will last until the next GC.
407 But don't do it if BUF_MARKERS is nil;
408 that is a signal from Fset_buffer_multibyte. */
409 if (record
&& BUF_MARKERS (b
))
411 Lisp_Object marker
, buffer
;
412 marker
= Fmake_marker ();
413 XSETBUFFER (buffer
, b
);
414 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
418 byte_char_debug_check (b
, best_above
, bytepos
);
421 cached_modiff
= BUF_MODIFF (b
);
422 cached_charpos
= best_above
;
423 cached_bytepos
= best_above_byte
;
431 /* Operations on markers. */
433 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
434 doc
: /* Return the buffer that MARKER points into, or nil if none.
435 Returns nil if MARKER points into a dead buffer. */)
437 register Lisp_Object marker
;
439 register Lisp_Object buf
;
440 CHECK_MARKER (marker
);
441 if (XMARKER (marker
)->buffer
)
443 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
444 /* If the buffer is dead, we're in trouble: the buffer pointer here
445 does not preserve the buffer from being GC'd (it's weak), so
446 markers have to be unlinked from their buffer as soon as the buffer
448 eassert (!NILP (XBUFFER (buf
)->name
));
454 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
455 doc
: /* Return the position MARKER points at, as a character number.
456 Returns nil if MARKER points nowhere. */)
460 CHECK_MARKER (marker
);
461 if (XMARKER (marker
)->buffer
)
462 return make_number (XMARKER (marker
)->charpos
);
467 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
468 doc
: /* Position MARKER before character number POSITION in BUFFER.
469 BUFFER defaults to the current buffer.
470 If POSITION is nil, makes marker point nowhere.
471 Then it no longer slows down editing in any buffer.
473 (marker
, position
, buffer
)
474 Lisp_Object marker
, position
, buffer
;
476 register int charno
, bytepos
;
477 register struct buffer
*b
;
478 register struct Lisp_Marker
*m
;
480 CHECK_MARKER (marker
);
481 m
= XMARKER (marker
);
483 /* If position is nil or a marker that points nowhere,
484 make this marker point nowhere. */
486 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
496 CHECK_BUFFER (buffer
);
497 b
= XBUFFER (buffer
);
498 /* If buffer is dead, set marker to point nowhere. */
499 if (EQ (b
->name
, Qnil
))
506 /* Optimize the special case where we are copying the position
507 of an existing marker, and MARKER is already in the same buffer. */
508 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
511 m
->bytepos
= XMARKER (position
)->bytepos
;
512 m
->charpos
= XMARKER (position
)->charpos
;
516 CHECK_NUMBER_COERCE_MARKER (position
);
518 charno
= XINT (position
);
520 if (charno
< BUF_BEG (b
))
521 charno
= BUF_BEG (b
);
522 if (charno
> BUF_Z (b
))
525 bytepos
= buf_charpos_to_bytepos (b
, charno
);
527 /* Every character is at least one byte. */
528 if (charno
> bytepos
)
531 m
->bytepos
= bytepos
;
538 m
->next
= BUF_MARKERS (b
);
545 /* This version of Fset_marker won't let the position
546 be outside the visible part. */
549 set_marker_restricted (Lisp_Object marker
, Lisp_Object pos
, Lisp_Object buffer
)
551 register int charno
, bytepos
;
552 register struct buffer
*b
;
553 register struct Lisp_Marker
*m
;
555 CHECK_MARKER (marker
);
556 m
= XMARKER (marker
);
558 /* If position is nil or a marker that points nowhere,
559 make this marker point nowhere. */
561 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
571 CHECK_BUFFER (buffer
);
572 b
= XBUFFER (buffer
);
573 /* If buffer is dead, set marker to point nowhere. */
574 if (EQ (b
->name
, Qnil
))
581 /* Optimize the special case where we are copying the position
582 of an existing marker, and MARKER is already in the same buffer. */
583 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
586 m
->bytepos
= XMARKER (pos
)->bytepos
;
587 m
->charpos
= XMARKER (pos
)->charpos
;
591 CHECK_NUMBER_COERCE_MARKER (pos
);
595 if (charno
< BUF_BEGV (b
))
596 charno
= BUF_BEGV (b
);
597 if (charno
> BUF_ZV (b
))
600 bytepos
= buf_charpos_to_bytepos (b
, charno
);
602 /* Every character is at least one byte. */
603 if (charno
> bytepos
)
606 m
->bytepos
= bytepos
;
613 m
->next
= BUF_MARKERS (b
);
620 /* Set the position of MARKER, specifying both the
621 character position and the corresponding byte position. */
624 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
, int charpos
, int bytepos
)
626 register struct buffer
*b
;
627 register struct Lisp_Marker
*m
;
629 CHECK_MARKER (marker
);
630 m
= XMARKER (marker
);
636 CHECK_BUFFER (buffer
);
637 b
= XBUFFER (buffer
);
638 /* If buffer is dead, set marker to point nowhere. */
639 if (EQ (b
->name
, Qnil
))
646 /* In a single-byte buffer, the two positions must be equal. */
647 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
648 && charpos
!= bytepos
)
650 /* Every character is at least one byte. */
651 if (charpos
> bytepos
)
654 m
->bytepos
= bytepos
;
655 m
->charpos
= charpos
;
661 m
->next
= BUF_MARKERS (b
);
668 /* This version of set_marker_both won't let the position
669 be outside the visible part. */
672 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
, int charpos
, int bytepos
)
674 register struct buffer
*b
;
675 register struct Lisp_Marker
*m
;
677 CHECK_MARKER (marker
);
678 m
= XMARKER (marker
);
684 CHECK_BUFFER (buffer
);
685 b
= XBUFFER (buffer
);
686 /* If buffer is dead, set marker to point nowhere. */
687 if (EQ (b
->name
, Qnil
))
694 if (charpos
< BUF_BEGV (b
))
695 charpos
= BUF_BEGV (b
);
696 if (charpos
> BUF_ZV (b
))
697 charpos
= BUF_ZV (b
);
698 if (bytepos
< BUF_BEGV_BYTE (b
))
699 bytepos
= BUF_BEGV_BYTE (b
);
700 if (bytepos
> BUF_ZV_BYTE (b
))
701 bytepos
= BUF_ZV_BYTE (b
);
703 /* In a single-byte buffer, the two positions must be equal. */
704 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
705 && charpos
!= bytepos
)
707 /* Every character is at least one byte. */
708 if (charpos
> bytepos
)
711 m
->bytepos
= bytepos
;
712 m
->charpos
= charpos
;
718 m
->next
= BUF_MARKERS (b
);
725 /* Remove MARKER from the chain of whatever buffer it is in.
726 Leave it "in no buffer".
728 This is called during garbage collection,
729 so we must be careful to ignore and preserve mark bits,
730 including those in chain fields of markers. */
733 unchain_marker (register struct Lisp_Marker
*marker
)
735 register struct Lisp_Marker
*tail
, *prev
, *next
;
736 register struct buffer
*b
;
742 if (EQ (b
->name
, Qnil
))
747 tail
= BUF_MARKERS (b
);
757 BUF_MARKERS (b
) = next
;
758 /* Deleting first marker from the buffer's chain. Crash
759 if new first marker in chain does not say it belongs
760 to the same buffer, or at least that they have the same
762 if (next
&& b
->text
!= next
->buffer
->text
)
767 /* We have removed the marker from the chain;
768 no need to scan the rest of the chain. */
776 /* Marker was not in its chain. */
780 /* Return the char position of marker MARKER, as a C integer. */
783 marker_position (Lisp_Object marker
)
785 register struct Lisp_Marker
*m
= XMARKER (marker
);
786 register struct buffer
*buf
= m
->buffer
;
789 error ("Marker does not point anywhere");
794 /* Return the byte position of marker MARKER, as a C integer. */
797 marker_byte_position (Lisp_Object marker
)
799 register struct Lisp_Marker
*m
= XMARKER (marker
);
800 register struct buffer
*buf
= m
->buffer
;
801 register int i
= m
->bytepos
;
804 error ("Marker does not point anywhere");
806 if (i
< BUF_BEG_BYTE (buf
) || i
> BUF_Z_BYTE (buf
))
812 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 1, 2, 0,
813 doc
: /* Return a new marker pointing at the same place as MARKER.
814 If argument is a number, makes a new marker pointing
815 at that position in the current buffer.
816 The optional argument TYPE specifies the insertion type of the new marker;
817 see `marker-insertion-type'. */)
819 register Lisp_Object marker
, type
;
821 register Lisp_Object
new;
823 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
825 new = Fmake_marker ();
826 Fset_marker (new, marker
,
827 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
828 XMARKER (new)->insertion_type
= !NILP (type
);
832 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
833 Smarker_insertion_type
, 1, 1, 0,
834 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
835 The value nil means the marker stays before text inserted there. */)
837 register Lisp_Object marker
;
839 CHECK_MARKER (marker
);
840 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
843 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
844 Sset_marker_insertion_type
, 2, 2, 0,
845 doc
: /* Set the insertion-type of MARKER to TYPE.
846 If TYPE is t, it means the marker advances when you insert text at it.
847 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
849 Lisp_Object marker
, type
;
851 CHECK_MARKER (marker
);
853 XMARKER (marker
)->insertion_type
= ! NILP (type
);
857 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
859 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
861 Lisp_Object position
;
863 register struct Lisp_Marker
*tail
;
866 charno
= XINT (position
);
873 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
874 if (tail
->charpos
== charno
)
880 /* For debugging -- count the markers in buffer BUF. */
883 count_markers (struct buffer
*buf
)
886 struct Lisp_Marker
*tail
;
888 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
895 syms_of_marker (void)
897 defsubr (&Smarker_position
);
898 defsubr (&Smarker_buffer
);
899 defsubr (&Sset_marker
);
900 defsubr (&Scopy_marker
);
901 defsubr (&Smarker_insertion_type
);
902 defsubr (&Sset_marker_insertion_type
);
903 defsubr (&Sbuffer_has_markers_at
);
905 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag
,
906 doc
: /* Non-nil enables debugging checks in byte/char position conversions. */);
910 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
911 (do not change this comment) */