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 CONSIDER (XMARKER (tail
)->charpos
, XMARKER (tail
)->bytepos
);
132 /* If we are down to a range of 50 chars,
133 don't bother checking any other markers;
134 scan the intervening chars directly now. */
135 if (best_above
- best_below
< 50)
138 tail
= XMARKER (tail
)->chain
;
141 /* We get here if we did not exactly hit one of the known places.
142 We have one known above and one known below.
143 Scan, counting characters, from whichever one is closer. */
145 if (charpos
- best_below
< best_above
- charpos
)
147 int record
= charpos
- best_below
> 5000;
149 while (best_below
!= charpos
)
152 BUF_INC_POS (b
, best_below_byte
);
155 /* If this position is quite far from the nearest known position,
156 cache the correspondence by creating a marker here.
157 It will last until the next GC. */
161 marker
= Fmake_marker ();
162 set_marker_both (marker
, Qnil
, best_below
, best_below_byte
);
166 cached_modiff
= BUF_MODIFF (b
);
167 cached_charpos
= best_below
;
168 cached_bytepos
= best_below_byte
;
170 return best_below_byte
;
174 int record
= best_above
- charpos
> 5000;
176 while (best_above
!= charpos
)
179 BUF_DEC_POS (b
, best_above_byte
);
182 /* If this position is quite far from the nearest known position,
183 cache the correspondence by creating a marker here.
184 It will last until the next GC. */
188 marker
= Fmake_marker ();
189 set_marker_both (marker
, Qnil
, best_above
, best_above_byte
);
193 cached_modiff
= BUF_MODIFF (b
);
194 cached_charpos
= best_above
;
195 cached_bytepos
= best_above_byte
;
197 return best_above_byte
;
203 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
205 /* This macro is a subroutine of bytepos_to_charpos.
206 It is used when BYTEPOS is actually the byte position. */
208 #define CONSIDER(BYTEPOS, CHARPOS) \
210 int this_bytepos = (BYTEPOS); \
213 if (this_bytepos == bytepos) \
215 else if (this_bytepos > bytepos) \
217 if (this_bytepos < best_above_byte) \
219 best_above = (CHARPOS); \
220 best_above_byte = this_bytepos; \
224 else if (this_bytepos > best_below_byte) \
226 best_below = (CHARPOS); \
227 best_below_byte = this_bytepos; \
233 if (best_above - best_below == best_above_byte - best_below_byte) \
234 return best_below + (bytepos - best_below_byte); \
239 bytepos_to_charpos (bytepos
)
242 return buf_bytepos_to_charpos (current_buffer
, bytepos
);
246 buf_bytepos_to_charpos (b
, bytepos
)
251 int best_above
, best_above_byte
;
252 int best_below
, best_below_byte
;
254 if (bytepos
< BUF_BEG_BYTE (b
) || bytepos
> BUF_Z_BYTE (b
))
257 best_above
= BUF_Z (b
);
258 best_above_byte
= BUF_Z_BYTE (b
);
260 /* If this buffer has as many characters as bytes,
261 each character must be one byte.
262 This takes care of the case where enable-multibyte-characters is nil. */
263 if (best_above
== best_above_byte
)
269 CONSIDER (BUF_PT_BYTE (b
), BUF_PT (b
));
270 CONSIDER (BUF_GPT_BYTE (b
), BUF_GPT (b
));
271 CONSIDER (BUF_BEGV_BYTE (b
), BUF_BEGV (b
));
272 CONSIDER (BUF_ZV_BYTE (b
), BUF_ZV (b
));
274 if (b
== cached_buffer
&& BUF_MODIFF (b
) == cached_modiff
)
275 CONSIDER (cached_bytepos
, cached_charpos
);
277 tail
= BUF_MARKERS (b
);
278 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
280 CONSIDER (XMARKER (tail
)->bytepos
, XMARKER (tail
)->charpos
);
282 /* If we are down to a range of 50 chars,
283 don't bother checking any other markers;
284 scan the intervening chars directly now. */
285 if (best_above
- best_below
< 50)
288 tail
= XMARKER (tail
)->chain
;
291 /* We get here if we did not exactly hit one of the known places.
292 We have one known above and one known below.
293 Scan, counting characters, from whichever one is closer. */
295 if (bytepos
- best_below_byte
< best_above_byte
- bytepos
)
297 int record
= best_above_byte
- bytepos
> 5000;
299 while (best_below_byte
< bytepos
)
302 BUF_INC_POS (b
, best_below_byte
);
305 /* If this position is quite far from the nearest known position,
306 cache the correspondence by creating a marker here.
307 It will last until the next GC. */
311 marker
= Fmake_marker ();
312 set_marker_both (marker
, Qnil
, best_below
, best_below_byte
);
316 cached_modiff
= BUF_MODIFF (b
);
317 cached_charpos
= best_below
;
318 cached_bytepos
= best_below_byte
;
324 int record
= best_above_byte
- bytepos
> 5000;
326 while (best_above_byte
> bytepos
)
329 BUF_DEC_POS (b
, best_above_byte
);
332 /* If this position is quite far from the nearest known position,
333 cache the correspondence by creating a marker here.
334 It will last until the next GC. */
338 marker
= Fmake_marker ();
339 set_marker_both (marker
, Qnil
, best_above
, best_above_byte
);
343 cached_modiff
= BUF_MODIFF (b
);
344 cached_charpos
= best_above
;
345 cached_bytepos
= best_above_byte
;
353 /* Operations on markers. */
355 DEFUN ("marker-buffer", Fmarker_buffer
, Smarker_buffer
, 1, 1, 0,
356 "Return the buffer that MARKER points into, or nil if none.\n\
357 Returns nil if MARKER points into a dead buffer.")
359 register Lisp_Object marker
;
361 register Lisp_Object buf
;
362 CHECK_MARKER (marker
, 0);
363 if (XMARKER (marker
)->buffer
)
365 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
366 /* Return marker's buffer only if it is not dead. */
367 if (!NILP (XBUFFER (buf
)->name
))
373 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
374 "Return the position MARKER points at, as a character number.")
378 register Lisp_Object pos
;
380 register struct buffer
*buf
;
382 CHECK_MARKER (marker
, 0);
383 if (XMARKER (marker
)->buffer
)
384 return make_number (XMARKER (marker
)->charpos
);
389 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
390 "Position MARKER before character number POSITION in BUFFER.\n\
391 BUFFER defaults to the current buffer.\n\
392 If POSITION is nil, makes marker point nowhere.\n\
393 Then it no longer slows down editing in any buffer.\n\
395 (marker
, position
, buffer
)
396 Lisp_Object marker
, position
, buffer
;
398 register int charno
, bytepos
;
399 register struct buffer
*b
;
400 register struct Lisp_Marker
*m
;
402 CHECK_MARKER (marker
, 0);
403 /* If position is nil or a marker that points nowhere,
404 make this marker point nowhere. */
406 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
408 unchain_marker (marker
);
416 CHECK_BUFFER (buffer
, 1);
417 b
= XBUFFER (buffer
);
418 /* If buffer is dead, set marker to point nowhere. */
419 if (EQ (b
->name
, Qnil
))
421 unchain_marker (marker
);
426 m
= XMARKER (marker
);
428 /* Optimize the special case where we are copying the position
429 of an existing marker, and MARKER is already in the same buffer. */
430 if (MARKERP (position
) && b
== XMARKER (position
)->buffer
433 m
->bytepos
= XMARKER (position
)->bytepos
;
434 m
->charpos
= XMARKER (position
)->charpos
;
438 CHECK_NUMBER_COERCE_MARKER (position
, 1);
440 charno
= XINT (position
);
442 if (charno
< BUF_BEG (b
))
443 charno
= BUF_BEG (b
);
444 if (charno
> BUF_Z (b
))
447 bytepos
= buf_charpos_to_bytepos (b
, charno
);
449 /* Every character is at least one byte. */
450 if (charno
> bytepos
)
453 m
->bytepos
= bytepos
;
458 unchain_marker (marker
);
460 m
->chain
= BUF_MARKERS (b
);
461 BUF_MARKERS (b
) = marker
;
467 /* This version of Fset_marker won't let the position
468 be outside the visible part. */
471 set_marker_restricted (marker
, pos
, buffer
)
472 Lisp_Object marker
, pos
, buffer
;
474 register int charno
, bytepos
;
475 register struct buffer
*b
;
476 register struct Lisp_Marker
*m
;
478 CHECK_MARKER (marker
, 0);
479 /* If position is nil or a marker that points nowhere,
480 make this marker point nowhere. */
482 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
484 unchain_marker (marker
);
492 CHECK_BUFFER (buffer
, 1);
493 b
= XBUFFER (buffer
);
494 /* If buffer is dead, set marker to point nowhere. */
495 if (EQ (b
->name
, Qnil
))
497 unchain_marker (marker
);
502 m
= XMARKER (marker
);
504 /* Optimize the special case where we are copying the position
505 of an existing marker, and MARKER is already in the same buffer. */
506 if (MARKERP (pos
) && b
== XMARKER (pos
)->buffer
509 m
->bytepos
= XMARKER (pos
)->bytepos
;
510 m
->charpos
= XMARKER (pos
)->charpos
;
514 CHECK_NUMBER_COERCE_MARKER (pos
, 1);
518 if (charno
< BUF_BEGV (b
))
519 charno
= BUF_BEGV (b
);
520 if (charno
> BUF_ZV (b
))
523 bytepos
= buf_charpos_to_bytepos (b
, charno
);
525 /* Every character is at least one byte. */
526 if (charno
> bytepos
)
529 m
->bytepos
= bytepos
;
534 unchain_marker (marker
);
536 m
->chain
= BUF_MARKERS (b
);
537 BUF_MARKERS (b
) = marker
;
543 /* Set the position of MARKER, specifying both the
544 character position and the corresponding byte position. */
547 set_marker_both (marker
, buffer
, charpos
, bytepos
)
548 Lisp_Object marker
, buffer
;
549 int charpos
, bytepos
;
551 register struct buffer
*b
;
552 register struct Lisp_Marker
*m
;
554 CHECK_MARKER (marker
, 0);
555 /* If position is nil or a marker that points nowhere,
556 make this marker point nowhere. */
558 || (MARKERP (charpos
) && !XMARKER (charpos
)->buffer
))
560 unchain_marker (marker
);
564 CHECK_NUMBER_COERCE_MARKER (charpos
, 1);
569 CHECK_BUFFER (buffer
, 1);
570 b
= XBUFFER (buffer
);
571 /* If buffer is dead, set marker to point nowhere. */
572 if (EQ (b
->name
, Qnil
))
574 unchain_marker (marker
);
579 m
= XMARKER (marker
);
581 /* In a single-byte buffer, the two positions must be equal. */
582 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
583 && charpos
!= bytepos
)
585 /* Every character is at least one byte. */
586 if (charpos
> bytepos
)
589 m
->bytepos
= bytepos
;
590 m
->charpos
= charpos
;
594 unchain_marker (marker
);
596 m
->chain
= BUF_MARKERS (b
);
597 BUF_MARKERS (b
) = marker
;
603 /* This version of set_marker_both won't let the position
604 be outside the visible part. */
607 set_marker_restricted_both (marker
, buffer
, charpos
, bytepos
)
608 Lisp_Object marker
, buffer
;
609 int charpos
, bytepos
;
611 register struct buffer
*b
;
612 register struct Lisp_Marker
*m
;
614 CHECK_MARKER (marker
, 0);
620 CHECK_BUFFER (buffer
, 1);
621 b
= XBUFFER (buffer
);
622 /* If buffer is dead, set marker to point nowhere. */
623 if (EQ (b
->name
, Qnil
))
625 unchain_marker (marker
);
630 m
= XMARKER (marker
);
632 if (charpos
< BUF_BEGV (b
))
633 charpos
= BUF_BEGV (b
);
634 if (charpos
> BUF_ZV (b
))
635 charpos
= BUF_ZV (b
);
636 if (bytepos
< BUF_BEGV_BYTE (b
))
637 bytepos
= BUF_BEGV_BYTE (b
);
638 if (bytepos
> BUF_ZV_BYTE (b
))
639 bytepos
= BUF_ZV_BYTE (b
);
641 /* In a single-byte buffer, the two positions must be equal. */
642 if (BUF_Z (b
) == BUF_Z_BYTE (b
)
643 && charpos
!= bytepos
)
645 /* Every character is at least one byte. */
646 if (charpos
> bytepos
)
649 m
->bytepos
= bytepos
;
650 m
->charpos
= charpos
;
654 unchain_marker (marker
);
656 m
->chain
= BUF_MARKERS (b
);
657 BUF_MARKERS (b
) = marker
;
663 /* This is called during garbage collection,
664 so we must be careful to ignore and preserve mark bits,
665 including those in chain fields of markers. */
668 unchain_marker (marker
)
669 register Lisp_Object marker
;
671 register Lisp_Object tail
, prev
, next
;
672 register EMACS_INT omark
;
673 register struct buffer
*b
;
675 b
= XMARKER (marker
)->buffer
;
679 if (EQ (b
->name
, Qnil
))
682 tail
= BUF_MARKERS (b
);
684 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
686 next
= XMARKER (tail
)->chain
;
689 if (XMARKER (marker
) == XMARKER (tail
))
693 BUF_MARKERS (b
) = next
;
694 /* Deleting first marker from the buffer's chain. Crash
695 if new first marker in chain does not say it belongs
696 to the same buffer, or at least that they have the same
698 if (!NILP (next
) && b
->text
!= XMARKER (next
)->buffer
->text
)
703 omark
= XMARKBIT (XMARKER (prev
)->chain
);
704 XMARKER (prev
)->chain
= next
;
705 XSETMARKBIT (XMARKER (prev
)->chain
, omark
);
713 XMARKER (marker
)->buffer
= 0;
716 /* Return the char position of marker MARKER, as a C integer. */
719 marker_position (marker
)
722 register struct Lisp_Marker
*m
= XMARKER (marker
);
723 register struct buffer
*buf
= m
->buffer
;
726 error ("Marker does not point anywhere");
731 /* Return the byte position of marker MARKER, as a C integer. */
734 marker_byte_position (marker
)
737 register struct Lisp_Marker
*m
= XMARKER (marker
);
738 register struct buffer
*buf
= m
->buffer
;
739 register int i
= m
->bytepos
;
742 error ("Marker does not point anywhere");
744 if (i
< BUF_BEG_BYTE (buf
) || i
> BUF_Z_BYTE (buf
))
750 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 1, 2, 0,
751 "Return a new marker pointing at the same place as MARKER.\n\
752 If argument is a number, makes a new marker pointing\n\
753 at that position in the current buffer.\n\
754 The optional argument TYPE specifies the insertion type of the new marker;\n\
755 see `marker-insertion-type'.")
757 register Lisp_Object marker
, type
;
759 register Lisp_Object
new;
761 if (INTEGERP (marker
) || MARKERP (marker
))
763 new = Fmake_marker ();
764 Fset_marker (new, marker
,
765 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
766 XMARKER (new)->insertion_type
= !NILP (type
);
770 marker
= wrong_type_argument (Qinteger_or_marker_p
, marker
);
773 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
774 Smarker_insertion_type
, 1, 1, 0,
775 "Return insertion type of MARKER: t if it stays after inserted text.\n\
776 nil means the marker stays before text inserted there.")
778 register Lisp_Object marker
;
780 register Lisp_Object buf
;
781 CHECK_MARKER (marker
, 0);
782 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
785 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
786 Sset_marker_insertion_type
, 2, 2, 0,
787 "Set the insertion-type of MARKER to TYPE.\n\
788 If TYPE is t, it means the marker advances when you insert text at it.\n\
789 If TYPE is nil, it means the marker stays behind when you insert text at it.")
791 Lisp_Object marker
, type
;
793 CHECK_MARKER (marker
, 0);
795 XMARKER (marker
)->insertion_type
= ! NILP (type
);
799 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
801 "Return t if there are markers pointing at POSITION in the current buffer.")
803 Lisp_Object position
;
805 register Lisp_Object tail
;
808 charno
= XINT (position
);
815 for (tail
= BUF_MARKERS (current_buffer
);
816 XSYMBOL (tail
) != XSYMBOL (Qnil
);
817 tail
= XMARKER (tail
)->chain
)
818 if (XMARKER (tail
)->charpos
== charno
)
827 defsubr (&Smarker_position
);
828 defsubr (&Smarker_buffer
);
829 defsubr (&Sset_marker
);
830 defsubr (&Scopy_marker
);
831 defsubr (&Smarker_insertion_type
);
832 defsubr (&Sset_marker_insertion_type
);
833 defsubr (&Sbuffer_has_markers_at
);