1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2011 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/>. */
24 #include "character.h"
26 /* Record one cached position found recently by
27 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
29 static EMACS_INT cached_charpos
;
30 static EMACS_INT cached_bytepos
;
31 static struct buffer
*cached_buffer
;
32 static int cached_modiff
;
34 static void byte_char_debug_check (struct buffer
*, EMACS_INT
, EMACS_INT
);
37 clear_charpos_cache (struct buffer
*b
)
39 if (cached_buffer
== b
)
43 /* Converting between character positions and byte positions. */
45 /* There are several places in the buffer where we know
46 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
47 and everywhere there is a marker. So we find the one of these places
48 that is closest to the specified position, and scan from there. */
50 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
52 /* This macro is a subroutine of charpos_to_bytepos.
53 Note that it is desirable that BYTEPOS is not evaluated
54 except when we really want its value. */
56 #define CONSIDER(CHARPOS, BYTEPOS) \
58 EMACS_INT this_charpos = (CHARPOS); \
61 if (this_charpos == charpos) \
63 EMACS_INT value = (BYTEPOS); \
64 if (byte_debug_flag) \
65 byte_char_debug_check (b, charpos, value); \
68 else if (this_charpos > charpos) \
70 if (this_charpos < best_above) \
72 best_above = this_charpos; \
73 best_above_byte = (BYTEPOS); \
77 else if (this_charpos > best_below) \
79 best_below = this_charpos; \
80 best_below_byte = (BYTEPOS); \
86 if (best_above - best_below == best_above_byte - best_below_byte) \
88 EMACS_INT value = best_below_byte + (charpos - best_below); \
89 if (byte_debug_flag) \
90 byte_char_debug_check (b, charpos, value); \
97 byte_char_debug_check (struct buffer
*b
, EMACS_INT charpos
, EMACS_INT bytepos
)
101 if (bytepos
> BUF_GPT_BYTE (b
))
103 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
104 BUF_GPT_BYTE (b
) - BUF_BEG_BYTE (b
));
105 nchars
+= multibyte_chars_in_text (BUF_GAP_END_ADDR (b
),
106 bytepos
- BUF_GPT_BYTE (b
));
109 nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b
),
110 bytepos
- BUF_BEG_BYTE (b
));
112 if (charpos
- 1 != nchars
)
117 charpos_to_bytepos (EMACS_INT charpos
)
119 return buf_charpos_to_bytepos (current_buffer
, charpos
);
123 buf_charpos_to_bytepos (struct buffer
*b
, EMACS_INT charpos
)
125 struct Lisp_Marker
*tail
;
126 EMACS_INT best_above
, best_above_byte
;
127 EMACS_INT best_below
, best_below_byte
;
129 if (charpos
< BUF_BEG (b
) || charpos
> BUF_Z (b
))
132 best_above
= BUF_Z (b
);
133 best_above_byte
= BUF_Z_BYTE (b
);
135 /* If this buffer has as many characters as bytes,
136 each character must be one byte.
137 This takes care of the case where enable-multibyte-characters is nil. */
138 if (best_above
== best_above_byte
)
142 best_below_byte
= BEG_BYTE
;
144 /* We find in best_above and best_above_byte
145 the closest known point above CHARPOS,
146 and in best_below and best_below_byte
147 the closest known point below CHARPOS,
149 If at any point we can tell that the space between those
150 two best approximations is all single-byte,
151 we interpolate the result immediately. */
153 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
154 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
155 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
156 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
158 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
159 CONSIDER (cached_charpos
, cached_bytepos
);
161 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
163 CONSIDER (tail
->charpos
, tail
->bytepos
);
165 /* If we are down to a range of 50 chars,
166 don't bother checking any other markers;
167 scan the intervening chars directly now. */
168 if (best_above
- best_below
< 50)
172 /* We get here if we did not exactly hit one of the known places.
173 We have one known above and one known below.
174 Scan, counting characters, from whichever one is closer. */
176 if (charpos
- best_below
< best_above
- charpos
)
178 int record
= charpos
- best_below
> 5000;
180 while (best_below
!= charpos
)
183 BUF_INC_POS (b
, best_below_byte
);
186 /* If this position is quite far from the nearest known position,
187 cache the correspondence by creating a marker here.
188 It will last until the next GC. */
191 Lisp_Object marker
, buffer
;
192 marker
= Fmake_marker ();
193 XSETBUFFER (buffer
, b
);
194 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
198 byte_char_debug_check (b
, charpos
, best_below_byte
);
201 cached_modiff
= BUF_MODIFF (b
);
202 cached_charpos
= best_below
;
203 cached_bytepos
= best_below_byte
;
205 return best_below_byte
;
209 int record
= best_above
- charpos
> 5000;
211 while (best_above
!= charpos
)
214 BUF_DEC_POS (b
, best_above_byte
);
217 /* If this position is quite far from the nearest known position,
218 cache the correspondence by creating a marker here.
219 It will last until the next GC. */
222 Lisp_Object marker
, buffer
;
223 marker
= Fmake_marker ();
224 XSETBUFFER (buffer
, b
);
225 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
229 byte_char_debug_check (b
, charpos
, best_above_byte
);
232 cached_modiff
= BUF_MODIFF (b
);
233 cached_charpos
= best_above
;
234 cached_bytepos
= best_above_byte
;
236 return best_above_byte
;
242 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
243 in the simplest, most reliable way. */
246 verify_bytepos (EMACS_INT charpos
)
249 EMACS_INT below_byte
= 1;
251 while (below
!= charpos
)
254 BUF_INC_POS (current_buffer
, below_byte
);
260 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
262 /* This macro is a subroutine of bytepos_to_charpos.
263 It is used when BYTEPOS is actually the byte position. */
265 #define CONSIDER(BYTEPOS, CHARPOS) \
267 EMACS_INT this_bytepos = (BYTEPOS); \
270 if (this_bytepos == bytepos) \
272 EMACS_INT value = (CHARPOS); \
273 if (byte_debug_flag) \
274 byte_char_debug_check (b, value, bytepos); \
277 else if (this_bytepos > bytepos) \
279 if (this_bytepos < best_above_byte) \
281 best_above = (CHARPOS); \
282 best_above_byte = this_bytepos; \
286 else if (this_bytepos > best_below_byte) \
288 best_below = (CHARPOS); \
289 best_below_byte = this_bytepos; \
295 if (best_above - best_below == best_above_byte - best_below_byte) \
297 EMACS_INT value = best_below + (bytepos - best_below_byte); \
298 if (byte_debug_flag) \
299 byte_char_debug_check (b, value, bytepos); \
306 bytepos_to_charpos (EMACS_INT bytepos
)
308 return buf_bytepos_to_charpos (current_buffer
, bytepos
);
312 buf_bytepos_to_charpos (struct buffer
*b
, EMACS_INT bytepos
)
314 struct Lisp_Marker
*tail
;
315 EMACS_INT best_above
, best_above_byte
;
316 EMACS_INT best_below
, best_below_byte
;
318 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
321 best_above
= BUF_Z (b
);
322 best_above_byte
= BUF_Z_BYTE (b
);
324 /* If this buffer has as many characters as bytes,
325 each character must be one byte.
326 This takes care of the case where enable-multibyte-characters is nil. */
327 if (best_above
== best_above_byte
)
331 best_below_byte
= BEG_BYTE
;
333 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
334 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
335 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
336 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
338 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
339 CONSIDER (cached_bytepos
, cached_charpos
);
341 for (tail
= BUF_MARKERS (b
); tail
; tail
= tail
->next
)
343 CONSIDER (tail
->bytepos
, tail
->charpos
);
345 /* If we are down to a range of 50 chars,
346 don't bother checking any other markers;
347 scan the intervening chars directly now. */
348 if (best_above
- best_below
< 50)
352 /* We get here if we did not exactly hit one of the known places.
353 We have one known above and one known below.
354 Scan, counting characters, from whichever one is closer. */
356 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
358 int record
= bytepos
- best_below_byte
> 5000;
360 while (best_below_byte
< bytepos
)
363 BUF_INC_POS (b
, best_below_byte
);
366 /* If this position is quite far from the nearest known position,
367 cache the correspondence by creating a marker here.
368 It will last until the next GC.
369 But don't do it if BUF_MARKERS is nil;
370 that is a signal from Fset_buffer_multibyte. */
371 if (record
&& BUF_MARKERS (b
))
373 Lisp_Object marker
, buffer
;
374 marker
= Fmake_marker ();
375 XSETBUFFER (buffer
, b
);
376 set_marker_both (marker
, buffer
, best_below
, best_below_byte
);
380 byte_char_debug_check (b
, best_below
, bytepos
);
383 cached_modiff
= BUF_MODIFF (b
);
384 cached_charpos
= best_below
;
385 cached_bytepos
= best_below_byte
;
391 int record
= best_above_byte
- bytepos
> 5000;
393 while (best_above_byte
> bytepos
)
396 BUF_DEC_POS (b
, best_above_byte
);
399 /* If this position is quite far from the nearest known position,
400 cache the correspondence by creating a marker here.
401 It will last until the next GC.
402 But don't do it if BUF_MARKERS is nil;
403 that is a signal from Fset_buffer_multibyte. */
404 if (record
&& BUF_MARKERS (b
))
406 Lisp_Object marker
, buffer
;
407 marker
= Fmake_marker ();
408 XSETBUFFER (buffer
, b
);
409 set_marker_both (marker
, buffer
, best_above
, best_above_byte
);
413 byte_char_debug_check (b
, best_above
, bytepos
);
416 cached_modiff
= BUF_MODIFF (b
);
417 cached_charpos
= best_above
;
418 cached_bytepos
= best_above_byte
;
426 /* Operations on markers. */
428 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
429 doc
: /* Return the buffer that MARKER points into, or nil if none.
430 Returns nil if MARKER points into a dead buffer. */)
431 (register Lisp_Object marker
)
433 register Lisp_Object buf
;
434 CHECK_MARKER (marker
);
435 if (XMARKER (marker
)->buffer
)
437 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
438 /* If the buffer is dead, we're in trouble: the buffer pointer here
439 does not preserve the buffer from being GC'd (it's weak), so
440 markers have to be unlinked from their buffer as soon as the buffer
442 eassert (!NILP (BVAR (XBUFFER (buf
), name
)));
448 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
449 doc
: /* Return the position MARKER points at, as a character number.
450 Returns nil if MARKER points nowhere. */)
453 CHECK_MARKER (marker
);
454 if (XMARKER (marker
)->buffer
)
455 return make_number (XMARKER (marker
)->charpos
);
460 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
461 doc
: /* Position MARKER before character number POSITION in BUFFER.
462 BUFFER defaults to the current buffer.
463 If POSITION is nil, makes marker point nowhere.
464 Then it no longer slows down editing in any buffer.
466 (Lisp_Object marker
, Lisp_Object position
, Lisp_Object buffer
)
468 register EMACS_INT charno
, bytepos
;
469 register struct buffer
*b
;
470 register struct Lisp_Marker
*m
;
472 CHECK_MARKER (marker
);
473 m
= XMARKER (marker
);
475 /* If position is nil or a marker that points nowhere,
476 make this marker point nowhere. */
478 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
488 CHECK_BUFFER (buffer
);
489 b
= XBUFFER (buffer
);
490 /* If buffer is dead, set marker to point nowhere. */
491 if (EQ (BVAR (b
, name
), Qnil
))
498 /* Optimize the special case where we are copying the position
499 of an existing marker, and MARKER is already in the same buffer. */
500 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
503 m
->bytepos
= XMARKER (position
)->bytepos
;
504 m
->charpos
= XMARKER (position
)->charpos
;
508 CHECK_NUMBER_COERCE_MARKER (position
);
510 charno
= XINT (position
);
512 if (charno
< BUF_BEG (b
))
513 charno
= BUF_BEG (b
);
514 if (charno
> BUF_Z (b
))
517 bytepos
= buf_charpos_to_bytepos (b
, charno
);
519 /* Every character is at least one byte. */
520 if (charno
> bytepos
)
523 m
->bytepos
= bytepos
;
530 m
->next
= BUF_MARKERS (b
);
537 /* This version of Fset_marker won't let the position
538 be outside the visible part. */
541 set_marker_restricted (Lisp_Object marker
, Lisp_Object pos
, Lisp_Object buffer
)
543 register EMACS_INT charno
, bytepos
;
544 register struct buffer
*b
;
545 register struct Lisp_Marker
*m
;
547 CHECK_MARKER (marker
);
548 m
= XMARKER (marker
);
550 /* If position is nil or a marker that points nowhere,
551 make this marker point nowhere. */
553 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
563 CHECK_BUFFER (buffer
);
564 b
= XBUFFER (buffer
);
565 /* If buffer is dead, set marker to point nowhere. */
566 if (EQ (BVAR (b
, name
), Qnil
))
573 /* Optimize the special case where we are copying the position
574 of an existing marker, and MARKER is already in the same buffer. */
575 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
578 m
->bytepos
= XMARKER (pos
)->bytepos
;
579 m
->charpos
= XMARKER (pos
)->charpos
;
583 CHECK_NUMBER_COERCE_MARKER (pos
);
587 if (charno
< BUF_BEGV (b
))
588 charno
= BUF_BEGV (b
);
589 if (charno
> BUF_ZV (b
))
592 bytepos
= buf_charpos_to_bytepos (b
, charno
);
594 /* Every character is at least one byte. */
595 if (charno
> bytepos
)
598 m
->bytepos
= bytepos
;
605 m
->next
= BUF_MARKERS (b
);
612 /* Set the position of MARKER, specifying both the
613 character position and the corresponding byte position. */
616 set_marker_both (Lisp_Object marker
, Lisp_Object buffer
, EMACS_INT charpos
, EMACS_INT bytepos
)
618 register struct buffer
*b
;
619 register struct Lisp_Marker
*m
;
621 CHECK_MARKER (marker
);
622 m
= XMARKER (marker
);
628 CHECK_BUFFER (buffer
);
629 b
= XBUFFER (buffer
);
630 /* If buffer is dead, set marker to point nowhere. */
631 if (EQ (BVAR (b
, name
), Qnil
))
638 /* In a single-byte buffer, the two positions must be equal. */
639 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
640 && charpos
!= bytepos
)
642 /* Every character is at least one byte. */
643 if (charpos
> bytepos
)
646 m
->bytepos
= bytepos
;
647 m
->charpos
= charpos
;
653 m
->next
= BUF_MARKERS (b
);
660 /* This version of set_marker_both won't let the position
661 be outside the visible part. */
664 set_marker_restricted_both (Lisp_Object marker
, Lisp_Object buffer
, EMACS_INT charpos
, EMACS_INT bytepos
)
666 register struct buffer
*b
;
667 register struct Lisp_Marker
*m
;
669 CHECK_MARKER (marker
);
670 m
= XMARKER (marker
);
676 CHECK_BUFFER (buffer
);
677 b
= XBUFFER (buffer
);
678 /* If buffer is dead, set marker to point nowhere. */
679 if (EQ (BVAR (b
, name
), Qnil
))
686 if (charpos
< BUF_BEGV (b
))
687 charpos
= BUF_BEGV (b
);
688 if (charpos
> BUF_ZV (b
))
689 charpos
= BUF_ZV (b
);
690 if (bytepos
< BUF_BEGV_BYTE (b
))
691 bytepos
= BUF_BEGV_BYTE (b
);
692 if (bytepos
> BUF_ZV_BYTE (b
))
693 bytepos
= BUF_ZV_BYTE (b
);
695 /* In a single-byte buffer, the two positions must be equal. */
696 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
697 && charpos
!= bytepos
)
699 /* Every character is at least one byte. */
700 if (charpos
> bytepos
)
703 m
->bytepos
= bytepos
;
704 m
->charpos
= charpos
;
710 m
->next
= BUF_MARKERS (b
);
717 /* Remove MARKER from the chain of whatever buffer it is in.
718 Leave it "in no buffer".
720 This is called during garbage collection,
721 so we must be careful to ignore and preserve mark bits,
722 including those in chain fields of markers. */
725 unchain_marker (register struct Lisp_Marker
*marker
)
727 register struct Lisp_Marker
*tail
, *prev
, *next
;
728 register struct buffer
*b
;
734 if (EQ (BVAR (b
, name
), Qnil
))
739 tail
= BUF_MARKERS (b
);
749 BUF_MARKERS (b
) = next
;
750 /* Deleting first marker from the buffer's chain. Crash
751 if new first marker in chain does not say it belongs
752 to the same buffer, or at least that they have the same
754 if (next
&& b
->text
!= next
->buffer
->text
)
759 /* We have removed the marker from the chain;
760 no need to scan the rest of the chain. */
768 /* Marker was not in its chain. */
772 /* Return the char position of marker MARKER, as a C integer. */
775 marker_position (Lisp_Object marker
)
777 register struct Lisp_Marker
*m
= XMARKER (marker
);
778 register struct buffer
*buf
= m
->buffer
;
781 error ("Marker does not point anywhere");
786 /* Return the byte position of marker MARKER, as a C integer. */
789 marker_byte_position (Lisp_Object marker
)
791 register struct Lisp_Marker
*m
= XMARKER (marker
);
792 register struct buffer
*buf
= m
->buffer
;
793 register EMACS_INT i
= m
->bytepos
;
796 error ("Marker does not point anywhere");
798 if (i
< BUF_BEG_BYTE (buf
) || i
> BUF_Z_BYTE (buf
))
804 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 0, 2, 0,
805 doc
: /* Return a new marker pointing at the same place as MARKER.
806 If argument is a number, makes a new marker pointing
807 at that position in the current buffer.
808 If MARKER is not specified, the new marker does not point anywhere.
809 The optional argument TYPE specifies the insertion type of the new marker;
810 see `marker-insertion-type'. */)
811 (register Lisp_Object marker
, Lisp_Object type
)
813 register Lisp_Object
new;
816 CHECK_TYPE (INTEGERP (marker
) || MARKERP (marker
), Qinteger_or_marker_p
, marker
);
818 new = Fmake_marker ();
819 Fset_marker (new, marker
,
820 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
821 XMARKER (new)->insertion_type
= !NILP (type
);
825 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
826 Smarker_insertion_type
, 1, 1, 0,
827 doc
: /* Return insertion type of MARKER: t if it stays after inserted text.
828 The value nil means the marker stays before text inserted there. */)
829 (register Lisp_Object marker
)
831 CHECK_MARKER (marker
);
832 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
835 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
836 Sset_marker_insertion_type
, 2, 2, 0,
837 doc
: /* Set the insertion-type of MARKER to TYPE.
838 If TYPE is t, it means the marker advances when you insert text at it.
839 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
840 (Lisp_Object marker
, Lisp_Object type
)
842 CHECK_MARKER (marker
);
844 XMARKER (marker
)->insertion_type
= ! NILP (type
);
848 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
850 doc
: /* Return t if there are markers pointing at POSITION in the current buffer. */)
851 (Lisp_Object position
)
853 register struct Lisp_Marker
*tail
;
854 register EMACS_INT charno
;
856 charno
= XINT (position
);
863 for (tail
= BUF_MARKERS (current_buffer
); tail
; tail
= tail
->next
)
864 if (tail
->charpos
== charno
)
870 /* For debugging -- count the markers in buffer BUF. */
873 count_markers (struct buffer
*buf
)
876 struct Lisp_Marker
*tail
;
878 for (tail
= BUF_MARKERS (buf
); tail
; tail
= tail
->next
)
885 syms_of_marker (void)
887 defsubr (&Smarker_position
);
888 defsubr (&Smarker_buffer
);
889 defsubr (&Sset_marker
);
890 defsubr (&Scopy_marker
);
891 defsubr (&Smarker_insertion_type
);
892 defsubr (&Sset_marker_insertion_type
);
893 defsubr (&Sbuffer_has_markers_at
);
895 DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag
,
896 doc
: /* Non-nil enables debugging checks in byte/char position conversions. */);