1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997 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 2, or (at your option)
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; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
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 /* Converting between character positions and byte positions. */
37 /* There are several places in the buffer where we know
38 the corrspondence: BEG, BEGV, PT, GPT, ZV and Z,
39 and everywhere there is a marker. So we find the one of these places
40 that is closest to the specified position, and scan from there. */
42 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
44 /* This macro is a subroutine of charpos_to_bytepos.
45 Note that it is desirable that BYTEPOS is not evaluated
46 except when we really want its value. */
48 #define CONSIDER(CHARPOS, BYTEPOS) \
50 int this_charpos = (CHARPOS); \
53 if (this_charpos == charpos) \
55 else if (this_charpos > charpos) \
57 if (this_charpos < best_above) \
59 best_above = this_charpos; \
60 best_above_byte = (BYTEPOS); \
64 else if (this_charpos > best_below) \
66 best_below = this_charpos; \
67 best_below_byte = (BYTEPOS); \
73 if (best_above - best_below == best_above_byte - best_below_byte) \
74 return best_below_byte + (charpos - best_below); \
79 charpos_to_bytepos (charpos
)
82 return buf_charpos_to_bytepos (current_buffer
, charpos
);
86 buf_charpos_to_bytepos (b
, charpos
)
91 int gapend_byte
= BUF_GPT_BYTE (b
) + BUF_GAP_SIZE (b
);
92 int best_above
, best_above_byte
;
93 int best_below
, best_below_byte
;
95 if (charpos
< BUF_BEG (b
) || charpos
> BUF_Z (b
))
98 best_above
= BUF_Z (b
);
99 best_above_byte
= BUF_Z_BYTE (b
);
101 /* If this buffer has as many characters as bytes,
102 each character must be one byte.
103 This takes care of the case where enable-multibyte-characters is nil. */
104 if (best_above
== best_above_byte
)
110 /* We find in best_above and best_above_byte
111 the closest known point above CHARPOS,
112 and in best_below and best_below_byte
113 the closest known point below CHARPOS,
115 If at any point we can tell that the space between those
116 two best approximations is all single-byte,
117 we interpolate the result immediately. */
119 CONSIDER (BUF_PT (b
), BUF_PT_BYTE (b
));
120 CONSIDER (BUF_GPT (b
), BUF_GPT_BYTE (b
));
121 CONSIDER (BUF_BEGV (b
), BUF_BEGV_BYTE (b
));
122 CONSIDER (BUF_ZV (b
), BUF_ZV_BYTE (b
));
124 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
125 CONSIDER (cached_charpos
, cached_bytepos
);
127 tail
= BUF_MARKERS (b
);
128 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
130 int i
= XMARKER (tail
)->bufpos
;
131 CONSIDER (XMARKER (tail
)->charpos
,
132 (i
> gapend_byte
? i
- BUF_GAP_SIZE (b
)
133 : i
> BUF_GPT_BYTE (b
) ? BUF_GPT_BYTE (b
)
136 /* If we are down to a range of 50 chars,
137 don't bother checking any other markers;
138 scan the intervening chars directly now. */
139 if (best_above
- best_below
< 50)
142 tail
= XMARKER (tail
)->chain
;
145 /* We get here if we did not exactly hit one of the known places.
146 We have one known above and one known below.
147 Scan, counting characters, from whichever one is closer. */
149 if (charpos
- best_below
< best_above
- charpos
)
151 int record
= charpos
- best_below
> 5000;
153 while (best_below
!= charpos
)
156 BUF_INC_POS (b
, best_below_byte
);
159 /* If this position is quite far from the nearest known position,
160 cache the correspondence by creating a marker here.
161 It will last until the next GC. */
165 marker
= Fmake_marker ();
166 set_marker_both (marker
, Qnil
, best_below
, best_below_byte
);
170 cached_modiff
= BUF_MODIFF (b
);
171 cached_charpos
= best_below
;
172 cached_bytepos
= best_below_byte
;
174 return best_below_byte
;
178 int record
= best_above
- charpos
> 5000;
180 while (best_above
!= charpos
)
183 BUF_DEC_POS (b
, best_above_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. */
192 marker
= Fmake_marker ();
193 set_marker_both (marker
, Qnil
, best_above
, best_above_byte
);
197 cached_modiff
= BUF_MODIFF (b
);
198 cached_charpos
= best_above
;
199 cached_bytepos
= best_above_byte
;
201 return best_above_byte
;
207 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
209 /* This macro is a subroutine of bytepos_to_charpos.
210 It is used when BYTEPOS is actually the byte position. */
212 #define CONSIDER(BYTEPOS, CHARPOS) \
214 int this_bytepos = (BYTEPOS); \
217 if (this_bytepos == bytepos) \
219 else if (this_bytepos > bytepos) \
221 if (this_bytepos < best_above_byte) \
223 best_above = (CHARPOS); \
224 best_above_byte = this_bytepos; \
228 else if (this_bytepos > best_below_byte) \
230 best_below = (CHARPOS); \
231 best_below_byte = this_bytepos; \
237 if (best_above - best_below == best_above_byte - best_below_byte) \
238 return best_below + (bytepos - best_below_byte); \
243 bytepos_to_charpos (bytepos
)
246 return buf_bytepos_to_charpos (current_buffer
, bytepos
);
250 buf_bytepos_to_charpos (b
, bytepos
)
255 int best_above
, best_above_byte
;
256 int best_below
, best_below_byte
;
258 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
261 best_above
= BUF_Z (b
);
262 best_above_byte
= BUF_Z_BYTE (b
);
264 /* If this buffer has as many characters as bytes,
265 each character must be one byte.
266 This takes care of the case where enable-multibyte-characters is nil. */
267 if (best_above
== best_above_byte
)
273 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
274 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
275 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
276 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
278 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
279 CONSIDER (cached_bytepos
, cached_charpos
);
281 tail
= BUF_MARKERS (b
);
282 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
284 int marker_bytepos
= XMARKER (tail
)->bufpos
;
286 if (marker_bytepos
> BUF_GPT_BYTE (b
) + BUF_GAP_SIZE (b
))
287 marker_bytepos
-= BUF_GAP_SIZE (b
);
288 else if (marker_bytepos
> BUF_GPT_BYTE (b
))
289 marker_bytepos
= BUF_GPT_BYTE (b
);
291 CONSIDER (marker_bytepos
, XMARKER (tail
)->charpos
);
293 /* If we are down to a range of 50 chars,
294 don't bother checking any other markers;
295 scan the intervening chars directly now. */
296 if (best_above
- best_below
< 50)
299 tail
= XMARKER (tail
)->chain
;
302 /* We get here if we did not exactly hit one of the known places.
303 We have one known above and one known below.
304 Scan, counting characters, from whichever one is closer. */
306 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
308 int record
= best_above_byte
- bytepos
> 5000;
310 while (best_below_byte
< bytepos
)
313 BUF_INC_POS (b
, best_below_byte
);
316 /* If this position is quite far from the nearest known position,
317 cache the correspondence by creating a marker here.
318 It will last until the next GC. */
322 marker
= Fmake_marker ();
323 set_marker_both (marker
, Qnil
, best_below
, best_below_byte
);
327 cached_modiff
= BUF_MODIFF (b
);
328 cached_charpos
= best_below
;
329 cached_bytepos
= best_below_byte
;
335 int record
= best_above_byte
- bytepos
> 5000;
337 while (best_above_byte
> bytepos
)
340 BUF_DEC_POS (b
, best_above_byte
);
343 /* If this position is quite far from the nearest known position,
344 cache the correspondence by creating a marker here.
345 It will last until the next GC. */
349 marker
= Fmake_marker ();
350 set_marker_both (marker
, Qnil
, best_above
, best_above_byte
);
354 cached_modiff
= BUF_MODIFF (b
);
355 cached_charpos
= best_above
;
356 cached_bytepos
= best_above_byte
;
364 /* Operations on markers. */
366 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
367 "Return the buffer that MARKER points into, or nil if none.\n\
368 Returns nil if MARKER points into a dead buffer.")
370 register Lisp_Object marker
;
372 register Lisp_Object buf
;
373 CHECK_MARKER (marker
, 0);
374 if (XMARKER (marker
)->buffer
)
376 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
377 /* Return marker's buffer only if it is not dead. */
378 if (!NILP (XBUFFER (buf
)->name
))
384 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
385 "Return the position MARKER points at, as a character number.")
389 register Lisp_Object pos
;
391 register struct buffer
*buf
;
393 CHECK_MARKER (marker
, 0);
394 if (XMARKER (marker
)->buffer
)
395 return make_number (XMARKER (marker
)->charpos
);
400 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
401 "Position MARKER before character number POSITION in BUFFER.\n\
402 BUFFER defaults to the current buffer.\n\
403 If POSITION is nil, makes marker point nowhere.\n\
404 Then it no longer slows down editing in any buffer.\n\
406 (marker
, position
, buffer
)
407 Lisp_Object marker
, position
, buffer
;
409 register int charno
, bytepos
;
410 register struct buffer
*b
;
411 register struct Lisp_Marker
*m
;
413 CHECK_MARKER (marker
, 0);
414 /* If position is nil or a marker that points nowhere,
415 make this marker point nowhere. */
417 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
419 unchain_marker (marker
);
427 CHECK_BUFFER (buffer
, 1);
428 b
= XBUFFER (buffer
);
429 /* If buffer is dead, set marker to point nowhere. */
430 if (EQ (b
->name
, Qnil
))
432 unchain_marker (marker
);
437 m
= XMARKER (marker
);
439 /* Optimize the special case where we are copying the position
440 of an existing marker, and MARKER is already in the same buffer. */
441 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
444 m
->bufpos
= XMARKER (position
)->bufpos
;
445 m
->charpos
= XMARKER (position
)->charpos
;
449 CHECK_NUMBER_COERCE_MARKER (position
, 1);
451 charno
= XINT (position
);
453 if (charno
< BUF_BEG (b
))
454 charno
= BUF_BEG (b
);
455 if (charno
> BUF_Z (b
))
458 bytepos
= buf_charpos_to_bytepos (b
, charno
);
460 /* Every character is at least one byte. */
461 if (charno
> bytepos
)
464 if (bytepos
> BUF_GPT_BYTE (b
))
465 bytepos
+= BUF_GAP_SIZE (b
);
472 unchain_marker (marker
);
474 m
->chain
= BUF_MARKERS (b
);
475 BUF_MARKERS (b
) = marker
;
481 /* This version of Fset_marker won't let the position
482 be outside the visible part. */
485 set_marker_restricted (marker
, pos
, buffer
)
486 Lisp_Object marker
, pos
, buffer
;
488 register int charno
, bytepos
;
489 register struct buffer
*b
;
490 register struct Lisp_Marker
*m
;
492 CHECK_MARKER (marker
, 0);
493 /* If position is nil or a marker that points nowhere,
494 make this marker point nowhere. */
496 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
498 unchain_marker (marker
);
506 CHECK_BUFFER (buffer
, 1);
507 b
= XBUFFER (buffer
);
508 /* If buffer is dead, set marker to point nowhere. */
509 if (EQ (b
->name
, Qnil
))
511 unchain_marker (marker
);
516 m
= XMARKER (marker
);
518 /* Optimize the special case where we are copying the position
519 of an existing marker, and MARKER is already in the same buffer. */
520 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
523 m
->bufpos
= XMARKER (pos
)->bufpos
;
524 m
->charpos
= XMARKER (pos
)->charpos
;
528 CHECK_NUMBER_COERCE_MARKER (pos
, 1);
532 if (charno
< BUF_BEGV (b
))
533 charno
= BUF_BEGV (b
);
534 if (charno
> BUF_ZV (b
))
537 bytepos
= buf_charpos_to_bytepos (b
, charno
);
539 /* Every character is at least one byte. */
540 if (charno
> bytepos
)
543 if (bytepos
> BUF_GPT_BYTE (b
))
544 bytepos
+= BUF_GAP_SIZE (b
);
551 unchain_marker (marker
);
553 m
->chain
= BUF_MARKERS (b
);
554 BUF_MARKERS (b
) = marker
;
560 /* Set the position of MARKER, specifying both the
561 character position and the corresponding byte position. */
564 set_marker_both (marker
, buffer
, charpos
, bytepos
)
565 Lisp_Object marker
, buffer
;
566 int charpos
, bytepos
;
568 register struct buffer
*b
;
569 register struct Lisp_Marker
*m
;
571 CHECK_MARKER (marker
, 0);
572 /* If position is nil or a marker that points nowhere,
573 make this marker point nowhere. */
575 || (MARKERP (charpos
) && !XMARKER (charpos
)->buffer
))
577 unchain_marker (marker
);
581 CHECK_NUMBER_COERCE_MARKER (charpos
, 1);
586 CHECK_BUFFER (buffer
, 1);
587 b
= XBUFFER (buffer
);
588 /* If buffer is dead, set marker to point nowhere. */
589 if (EQ (b
->name
, Qnil
))
591 unchain_marker (marker
);
596 m
= XMARKER (marker
);
598 /* In a single-byte buffer, the two positions must be equal. */
599 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
600 && charpos
!= bytepos
)
602 /* Every character is at least one byte. */
603 if (charpos
> bytepos
)
606 if (bytepos
> BUF_GPT_BYTE (b
))
607 bytepos
+= BUF_GAP_SIZE (b
);
610 m
->charpos
= charpos
;
614 unchain_marker (marker
);
616 m
->chain
= BUF_MARKERS (b
);
617 BUF_MARKERS (b
) = marker
;
623 /* This version of set_marker_both won't let the position
624 be outside the visible part. */
627 set_marker_restricted_both (marker
, buffer
, charpos
, bytepos
)
628 Lisp_Object marker
, buffer
;
629 int charpos
, bytepos
;
631 register struct buffer
*b
;
632 register struct Lisp_Marker
*m
;
634 CHECK_MARKER (marker
, 0);
640 CHECK_BUFFER (buffer
, 1);
641 b
= XBUFFER (buffer
);
642 /* If buffer is dead, set marker to point nowhere. */
643 if (EQ (b
->name
, Qnil
))
645 unchain_marker (marker
);
650 m
= XMARKER (marker
);
652 if (charpos
< BUF_BEGV (b
))
653 charpos
= BUF_BEGV (b
);
654 if (charpos
> BUF_ZV (b
))
655 charpos
= BUF_ZV (b
);
656 if (bytepos
< BUF_BEGV_BYTE (b
))
657 bytepos
= BUF_BEGV_BYTE (b
);
658 if (bytepos
> BUF_ZV_BYTE (b
))
659 bytepos
= BUF_ZV_BYTE (b
);
661 /* In a single-byte buffer, the two positions must be equal. */
662 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
663 && charpos
!= bytepos
)
665 /* Every character is at least one byte. */
666 if (charpos
> bytepos
)
669 if (bytepos
> BUF_GPT_BYTE (b
))
670 bytepos
+= BUF_GAP_SIZE (b
);
673 m
->charpos
= charpos
;
677 unchain_marker (marker
);
679 m
->chain
= BUF_MARKERS (b
);
680 BUF_MARKERS (b
) = marker
;
686 /* This is called during garbage collection,
687 so we must be careful to ignore and preserve mark bits,
688 including those in chain fields of markers. */
691 unchain_marker (marker
)
692 register Lisp_Object marker
;
694 register Lisp_Object tail
, prev
, next
;
695 register EMACS_INT omark
;
696 register struct buffer
*b
;
698 b
= XMARKER (marker
)->buffer
;
702 if (EQ (b
->name
, Qnil
))
705 tail
= BUF_MARKERS (b
);
707 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
709 next
= XMARKER (tail
)->chain
;
712 if (XMARKER (marker
) == XMARKER (tail
))
716 BUF_MARKERS (b
) = next
;
717 /* Deleting first marker from the buffer's chain. Crash
718 if new first marker in chain does not say it belongs
719 to the same buffer, or at least that they have the same
721 if (!NILP (next
) && b
->text
!= XMARKER (next
)->buffer
->text
)
726 omark
= XMARKBIT (XMARKER (prev
)->chain
);
727 XMARKER (prev
)->chain
= next
;
728 XSETMARKBIT (XMARKER (prev
)->chain
, omark
);
736 XMARKER (marker
)->buffer
= 0;
739 /* Return the char position of marker MARKER, as a C integer. */
742 marker_position (marker
)
745 register struct Lisp_Marker
*m
= XMARKER (marker
);
746 register struct buffer
*buf
= m
->buffer
;
749 error ("Marker does not point anywhere");
754 /* Return the byte position of marker MARKER, as a C integer. */
757 marker_byte_position (marker
)
760 register struct Lisp_Marker
*m
= XMARKER (marker
);
761 register struct buffer
*buf
= m
->buffer
;
762 register int i
= m
->bufpos
;
765 error ("Marker does not point anywhere");
767 if (i
> BUF_GPT_BYTE (buf
) + BUF_GAP_SIZE (buf
))
768 i
-= BUF_GAP_SIZE (buf
);
769 else if (i
> BUF_GPT_BYTE (buf
))
770 i
= BUF_GPT_BYTE (buf
);
772 if (i
< BUF_BEG_BYTE (buf
) || i
> BUF_Z_BYTE (buf
))
778 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 1, 2, 0,
779 "Return a new marker pointing at the same place as MARKER.\n\
780 If argument is a number, makes a new marker pointing\n\
781 at that position in the current buffer.\n\
782 The optional argument TYPE specifies the insertion type of the new marker;\n\
783 see `marker-insertion-type'.")
785 register Lisp_Object marker
, type
;
787 register Lisp_Object
new;
789 if (INTEGERP (marker
) || MARKERP (marker
))
791 new = Fmake_marker ();
792 Fset_marker (new, marker
,
793 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
794 XMARKER (new)->insertion_type
= !NILP (type
);
798 marker
= wrong_type_argument (Qinteger_or_marker_p
, marker
);
801 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
802 Smarker_insertion_type
, 1, 1, 0,
803 "Return insertion type of MARKER: t if it stays after inserted text.\n\
804 nil means the marker stays before text inserted there.")
806 register Lisp_Object marker
;
808 register Lisp_Object buf
;
809 CHECK_MARKER (marker
, 0);
810 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
813 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
814 Sset_marker_insertion_type
, 2, 2, 0,
815 "Set the insertion-type of MARKER to TYPE.\n\
816 If TYPE is t, it means the marker advances when you insert text at it.\n\
817 If TYPE is nil, it means the marker stays behind when you insert text at it.")
819 Lisp_Object marker
, type
;
821 CHECK_MARKER (marker
, 0);
823 XMARKER (marker
)->insertion_type
= ! NILP (type
);
827 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
829 "Return t if there are markers pointing at POSITION in the current buffer.")
831 Lisp_Object position
;
833 register Lisp_Object tail
;
836 charno
= XINT (position
);
843 for (tail
= BUF_MARKERS (current_buffer
);
844 XSYMBOL (tail
) != XSYMBOL (Qnil
);
845 tail
= XMARKER (tail
)->chain
)
846 if (XMARKER (tail
)->charpos
== charno
)
855 defsubr (&Smarker_position
);
856 defsubr (&Smarker_buffer
);
857 defsubr (&Sset_marker
);
858 defsubr (&Scopy_marker
);
859 defsubr (&Smarker_insertion_type
);
860 defsubr (&Sset_marker_insertion_type
);
861 defsubr (&Sbuffer_has_markers_at
);