/* Markers: examining, setting and deleting.
- Copyright (C) 1985, 1997 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1997, 1998 Free Software Foundation, Inc.
This file is part of GNU Emacs.
static int cached_bytepos;
static struct buffer *cached_buffer;
static int cached_modiff;
+
+static void byte_char_debug_check P_ ((struct buffer *, int, int));
+
+/* Nonzero means enable debugging checks on byte/char correspondences. */
+
+static int byte_debug_flag;
+
+void
+clear_charpos_cache (b)
+ struct buffer *b;
+{
+ if (cached_buffer == b)
+ cached_buffer = 0;
+}
\f
/* Converting between character positions and byte positions. */
/* There are several places in the buffer where we know
- the corrspondence: BEG, BEGV, PT, GPT, ZV and Z,
+ the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
and everywhere there is a marker. So we find the one of these places
that is closest to the specified position, and scan from there. */
int changed = 0; \
\
if (this_charpos == charpos) \
- return (BYTEPOS); \
+ { \
+ int value = (BYTEPOS); \
+ if (byte_debug_flag) \
+ byte_char_debug_check (b, charpos, value); \
+ return value; \
+ } \
else if (this_charpos > charpos) \
{ \
if (this_charpos < best_above) \
if (changed) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
- return best_below_byte + (charpos - best_below); \
+ { \
+ int value = best_below_byte + (charpos - best_below); \
+ if (byte_debug_flag) \
+ byte_char_debug_check (b, charpos, value); \
+ return value; \
+ } \
} \
}
+static void
+byte_char_debug_check (b, charpos, bytepos)
+ struct buffer *b;
+ int charpos, bytepos;
+{
+ int nchars = 0;
+
+ if (bytepos > BUF_GPT_BYTE (b))
+ {
+ nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
+ nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
+ bytepos - BUF_GPT_BYTE (b));
+ }
+ else
+ nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ bytepos - BUF_BEG_BYTE (b));
+
+ if (charpos - 1 != nchars)
+ abort ();
+}
+
int
charpos_to_bytepos (charpos)
int charpos;
int charpos;
{
Lisp_Object tail;
- int gapend_byte = BUF_GPT_BYTE (b) + BUF_GAP_SIZE (b);
int best_above, best_above_byte;
int best_below, best_below_byte;
if (best_above == best_above_byte)
return charpos;
- best_below = 1;
- best_below_byte = 1;
+ best_below = BEG;
+ best_below_byte = BEG_BYTE;
/* We find in best_above and best_above_byte
the closest known point above CHARPOS,
CONSIDER (cached_charpos, cached_bytepos);
tail = BUF_MARKERS (b);
- while (XSYMBOL (tail) != XSYMBOL (Qnil))
+ while (! NILP (tail))
{
- int i = XMARKER (tail)->bufpos;
- CONSIDER (XMARKER (tail)->charpos,
- (i > gapend_byte ? i - BUF_GAP_SIZE (b)
- : i > BUF_GPT_BYTE (b) ? BUF_GPT_BYTE (b)
- : i));
+ CONSIDER (XMARKER (tail)->charpos, XMARKER (tail)->bytepos);
/* If we are down to a range of 50 chars,
don't bother checking any other markers;
It will last until the next GC. */
if (record)
{
- Lisp_Object marker;
+ Lisp_Object marker, buffer;
marker = Fmake_marker ();
- set_marker_both (marker, Qnil, best_below, best_below_byte);
+ XSETBUFFER (buffer, b);
+ set_marker_both (marker, buffer, best_below, best_below_byte);
}
+ if (byte_debug_flag)
+ byte_char_debug_check (b, charpos, best_below_byte);
+
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
cached_charpos = best_below;
It will last until the next GC. */
if (record)
{
- Lisp_Object marker;
+ Lisp_Object marker, buffer;
marker = Fmake_marker ();
- set_marker_both (marker, Qnil, best_above, best_above_byte);
+ XSETBUFFER (buffer, b);
+ set_marker_both (marker, buffer, best_above, best_above_byte);
}
+ if (byte_debug_flag)
+ byte_char_debug_check (b, charpos, best_above_byte);
+
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
cached_charpos = best_above;
}
#undef CONSIDER
+
+/* Used for debugging: recompute the bytepos corresponding to CHARPOS
+ in the simplest, most reliable way. */
+
+int
+verify_bytepos (charpos)
+{
+ int below = 1;
+ int below_byte = 1;
+
+ while (below != charpos)
+ {
+ below++;
+ BUF_INC_POS (current_buffer, below_byte);
+ }
+
+ return below_byte;
+}
\f
/* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
int changed = 0; \
\
if (this_bytepos == bytepos) \
- return (CHARPOS); \
+ { \
+ int value = (CHARPOS); \
+ if (byte_debug_flag) \
+ byte_char_debug_check (b, value, bytepos); \
+ return value; \
+ } \
else if (this_bytepos > bytepos) \
{ \
if (this_bytepos < best_above_byte) \
if (changed) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
- return best_below + (bytepos - best_below_byte); \
+ { \
+ int value = best_below + (bytepos - best_below_byte); \
+ if (byte_debug_flag) \
+ byte_char_debug_check (b, value, bytepos); \
+ return value; \
+ } \
} \
}
if (best_above == best_above_byte)
return bytepos;
- best_below = 1;
- best_below_byte = 1;
+ best_below = BEG;
+ best_below_byte = BEG_BYTE;
CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
CONSIDER (cached_bytepos, cached_charpos);
tail = BUF_MARKERS (b);
- while (XSYMBOL (tail) != XSYMBOL (Qnil))
+ while (! NILP (tail))
{
- int marker_bytepos = XMARKER (tail)->bufpos;
-
- if (marker_bytepos > BUF_GPT_BYTE (b) + BUF_GAP_SIZE (b))
- marker_bytepos -= BUF_GAP_SIZE (b);
- else if (marker_bytepos > BUF_GPT_BYTE (b))
- marker_bytepos = BUF_GPT_BYTE (b);
-
- CONSIDER (marker_bytepos, XMARKER (tail)->charpos);
+ CONSIDER (XMARKER (tail)->bytepos, XMARKER (tail)->charpos);
/* If we are down to a range of 50 chars,
don't bother checking any other markers;
if (bytepos - best_below_byte < best_above_byte - bytepos)
{
- int record = best_above_byte - bytepos > 5000;
+ int record = bytepos - best_below_byte > 5000;
while (best_below_byte < bytepos)
{
/* If this position is quite far from the nearest known position,
cache the correspondence by creating a marker here.
- It will last until the next GC. */
- if (record)
+ It will last until the next GC.
+ But don't do it if BUF_MARKERS is nil;
+ that is a signal from Fset_buffer_multibyte. */
+ if (record && ! NILP (BUF_MARKERS (b)))
{
- Lisp_Object marker;
+ Lisp_Object marker, buffer;
marker = Fmake_marker ();
- set_marker_both (marker, Qnil, best_below, best_below_byte);
+ XSETBUFFER (buffer, b);
+ set_marker_both (marker, buffer, best_below, best_below_byte);
}
+ if (byte_debug_flag)
+ byte_char_debug_check (b, best_below, bytepos);
+
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
cached_charpos = best_below;
/* If this position is quite far from the nearest known position,
cache the correspondence by creating a marker here.
- It will last until the next GC. */
- if (record)
+ It will last until the next GC.
+ But don't do it if BUF_MARKERS is nil;
+ that is a signal from Fset_buffer_multibyte. */
+ if (record && ! NILP (BUF_MARKERS (b)))
{
- Lisp_Object marker;
+ Lisp_Object marker, buffer;
marker = Fmake_marker ();
- set_marker_both (marker, Qnil, best_above, best_above_byte);
+ XSETBUFFER (buffer, b);
+ set_marker_both (marker, buffer, best_above, best_above_byte);
}
+ if (byte_debug_flag)
+ byte_char_debug_check (b, best_above, bytepos);
+
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
cached_charpos = best_above;
/* Operations on markers. */
DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
- "Return the buffer that MARKER points into, or nil if none.\n\
-Returns nil if MARKER points into a dead buffer.")
- (marker)
+ doc: /* Return the buffer that MARKER points into, or nil if none.
+Returns nil if MARKER points into a dead buffer. */)
+ (marker)
register Lisp_Object marker;
{
register Lisp_Object buf;
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
if (XMARKER (marker)->buffer)
{
XSETBUFFER (buf, XMARKER (marker)->buffer);
}
DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
- "Return the position MARKER points at, as a character number.")
- (marker)
+ doc: /* Return the position MARKER points at, as a character number. */)
+ (marker)
Lisp_Object marker;
{
- register Lisp_Object pos;
- register int i;
- register struct buffer *buf;
-
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
if (XMARKER (marker)->buffer)
return make_number (XMARKER (marker)->charpos);
}
\f
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
- "Position MARKER before character number POSITION in BUFFER.\n\
-BUFFER defaults to the current buffer.\n\
-If POSITION is nil, makes marker point nowhere.\n\
-Then it no longer slows down editing in any buffer.\n\
-Returns MARKER.")
- (marker, position, buffer)
+ doc: /* Position MARKER before character number POSITION in BUFFER.
+BUFFER defaults to the current buffer.
+If POSITION is nil, makes marker point nowhere.
+Then it no longer slows down editing in any buffer.
+Returns MARKER. */)
+ (marker, position, buffer)
Lisp_Object marker, position, buffer;
{
register int charno, bytepos;
register struct buffer *b;
register struct Lisp_Marker *m;
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
if (NILP (position)
b = current_buffer;
else
{
- CHECK_BUFFER (buffer, 1);
+ CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
if (MARKERP (position) && b == XMARKER (position)->buffer
&& b == m->buffer)
{
- m->bufpos = XMARKER (position)->bufpos;
+ m->bytepos = XMARKER (position)->bytepos;
m->charpos = XMARKER (position)->charpos;
return marker;
}
- CHECK_NUMBER_COERCE_MARKER (position, 1);
+ CHECK_NUMBER_COERCE_MARKER (position);
charno = XINT (position);
if (charno > bytepos)
abort ();
- if (bytepos > BUF_GPT_BYTE (b))
- bytepos += BUF_GAP_SIZE (b);
-
- m->bufpos = bytepos;
+ m->bytepos = bytepos;
m->charpos = charno;
if (m->buffer != b)
m->chain = BUF_MARKERS (b);
BUF_MARKERS (b) = marker;
}
-
+
return marker;
}
/* This version of Fset_marker won't let the position
be outside the visible part. */
-Lisp_Object
+Lisp_Object
set_marker_restricted (marker, pos, buffer)
Lisp_Object marker, pos, buffer;
{
register struct buffer *b;
register struct Lisp_Marker *m;
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
if (NILP (pos)
b = current_buffer;
else
{
- CHECK_BUFFER (buffer, 1);
+ CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
if (MARKERP (pos) && b == XMARKER (pos)->buffer
&& b == m->buffer)
{
- m->bufpos = XMARKER (pos)->bufpos;
+ m->bytepos = XMARKER (pos)->bytepos;
m->charpos = XMARKER (pos)->charpos;
return marker;
}
- CHECK_NUMBER_COERCE_MARKER (pos, 1);
+ CHECK_NUMBER_COERCE_MARKER (pos);
charno = XINT (pos);
if (charno > bytepos)
abort ();
- if (bytepos > BUF_GPT_BYTE (b))
- bytepos += BUF_GAP_SIZE (b);
-
- m->bufpos = bytepos;
+ m->bytepos = bytepos;
m->charpos = charno;
if (m->buffer != b)
m->chain = BUF_MARKERS (b);
BUF_MARKERS (b) = marker;
}
-
+
return marker;
}
\f
/* Set the position of MARKER, specifying both the
character position and the corresponding byte position. */
-Lisp_Object
+Lisp_Object
set_marker_both (marker, buffer, charpos, bytepos)
Lisp_Object marker, buffer;
int charpos, bytepos;
register struct buffer *b;
register struct Lisp_Marker *m;
- CHECK_MARKER (marker, 0);
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (charpos)
- || (MARKERP (charpos) && !XMARKER (charpos)->buffer))
- {
- unchain_marker (marker);
- return marker;
- }
+ CHECK_MARKER (marker);
- CHECK_NUMBER_COERCE_MARKER (charpos, 1);
if (NILP (buffer))
b = current_buffer;
else
{
- CHECK_BUFFER (buffer, 1);
+ CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
if (charpos > bytepos)
abort ();
- if (bytepos > BUF_GPT_BYTE (b))
- bytepos += BUF_GAP_SIZE (b);
-
- m->bufpos = bytepos;
+ m->bytepos = bytepos;
m->charpos = charpos;
if (m->buffer != b)
m->chain = BUF_MARKERS (b);
BUF_MARKERS (b) = marker;
}
-
+
return marker;
}
/* This version of set_marker_both won't let the position
be outside the visible part. */
-Lisp_Object
+Lisp_Object
set_marker_restricted_both (marker, buffer, charpos, bytepos)
Lisp_Object marker, buffer;
int charpos, bytepos;
register struct buffer *b;
register struct Lisp_Marker *m;
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
if (NILP (buffer))
b = current_buffer;
else
{
- CHECK_BUFFER (buffer, 1);
+ CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
if (charpos > bytepos)
abort ();
- if (bytepos > BUF_GPT_BYTE (b))
- bytepos += BUF_GAP_SIZE (b);
-
- m->bufpos = bytepos;
+ m->bytepos = bytepos;
m->charpos = charpos;
if (m->buffer != b)
m->chain = BUF_MARKERS (b);
BUF_MARKERS (b) = marker;
}
-
+
return marker;
}
\f
-/* This is called during garbage collection,
+/* Remove MARKER from the chain of whatever buffer it is in.
+ Leave it "in no buffer".
+
+ This is called during garbage collection,
so we must be careful to ignore and preserve mark bits,
including those in chain fields of markers. */
if (EQ (b->name, Qnil))
abort ();
+ XMARKER (marker)->buffer = 0;
+
tail = BUF_MARKERS (b);
prev = Qnil;
- while (XSYMBOL (tail) != XSYMBOL (Qnil))
+ while (! GC_NILP (tail))
{
next = XMARKER (tail)->chain;
XUNMARK (next);
XMARKER (prev)->chain = next;
XSETMARKBIT (XMARKER (prev)->chain, omark);
}
- break;
+ /* We have removed the marker from the chain;
+ no need to scan the rest of the chain. */
+ return;
}
else
prev = tail;
tail = next;
}
- XMARKER (marker)->buffer = 0;
+
+ /* Marker was not in its chain. */
+ abort ();
}
/* Return the char position of marker MARKER, as a C integer. */
{
register struct Lisp_Marker *m = XMARKER (marker);
register struct buffer *buf = m->buffer;
- register int i = m->bufpos;
+ register int i = m->bytepos;
if (!buf)
error ("Marker does not point anywhere");
- if (i > BUF_GPT_BYTE (buf) + BUF_GAP_SIZE (buf))
- i -= BUF_GAP_SIZE (buf);
- else if (i > BUF_GPT_BYTE (buf))
- i = BUF_GPT_BYTE (buf);
-
if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
abort ();
}
\f
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
- "Return a new marker pointing at the same place as MARKER.\n\
-If argument is a number, makes a new marker pointing\n\
-at that position in the current buffer.\n\
-The optional argument TYPE specifies the insertion type of the new marker;\n\
-see `marker-insertion-type'.")
- (marker, type)
+ doc: /* Return a new marker pointing at the same place as MARKER.
+If argument is a number, makes a new marker pointing
+at that position in the current buffer.
+The optional argument TYPE specifies the insertion type of the new marker;
+see `marker-insertion-type'. */)
+ (marker, type)
register Lisp_Object marker, type;
{
register Lisp_Object new;
- if (INTEGERP (marker) || MARKERP (marker))
- {
- new = Fmake_marker ();
- Fset_marker (new, marker,
- (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
- XMARKER (new)->insertion_type = !NILP (type);
- return new;
- }
- else
+ if (! (INTEGERP (marker) || MARKERP (marker)))
marker = wrong_type_argument (Qinteger_or_marker_p, marker);
+
+ new = Fmake_marker ();
+ Fset_marker (new, marker,
+ (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
+ XMARKER (new)->insertion_type = !NILP (type);
+ return new;
}
DEFUN ("marker-insertion-type", Fmarker_insertion_type,
Smarker_insertion_type, 1, 1, 0,
- "Return insertion type of MARKER: t if it stays after inserted text.\n\
-nil means the marker stays before text inserted there.")
- (marker)
+ doc: /* Return insertion type of MARKER: t if it stays after inserted text.
+nil means the marker stays before text inserted there. */)
+ (marker)
register Lisp_Object marker;
{
- register Lisp_Object buf;
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
return XMARKER (marker)->insertion_type ? Qt : Qnil;
}
DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
Sset_marker_insertion_type, 2, 2, 0,
- "Set the insertion-type of MARKER to TYPE.\n\
-If TYPE is t, it means the marker advances when you insert text at it.\n\
-If TYPE is nil, it means the marker stays behind when you insert text at it.")
- (marker, type)
+ doc: /* Set the insertion-type of MARKER to TYPE.
+If TYPE is t, it means the marker advances when you insert text at it.
+If TYPE is nil, it means the marker stays behind when you insert text at it. */)
+ (marker, type)
Lisp_Object marker, type;
{
- CHECK_MARKER (marker, 0);
+ CHECK_MARKER (marker);
XMARKER (marker)->insertion_type = ! NILP (type);
return type;
}
DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
- 1, 1, 0,
- "Return t if there are markers pointing at POSITION in the current buffer.")
- (position)
- Lisp_Object position;
+ 1, 1, 0,
+ doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
+ (position)
+ Lisp_Object position;
{
register Lisp_Object tail;
register int charno;
charno = Z;
for (tail = BUF_MARKERS (current_buffer);
- XSYMBOL (tail) != XSYMBOL (Qnil);
+ !NILP (tail);
tail = XMARKER (tail)->chain)
if (XMARKER (tail)->charpos == charno)
return Qt;
return Qnil;
}
+
+/* For debugging -- count the markers in buffer BUF. */
+
+int
+count_markers (buf)
+ struct buffer *buf;
+{
+ int total = 0;
+ Lisp_Object tail;
+
+ for (tail = BUF_MARKERS (buf);
+ !NILP (tail);
+ tail = XMARKER (tail)->chain)
+ total++;
+
+ return total;
+}
\f
void
syms_of_marker ()
defsubr (&Smarker_insertion_type);
defsubr (&Sset_marker_insertion_type);
defsubr (&Sbuffer_has_markers_at);
+
+ DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
+ doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
+ byte_debug_flag = 0;
}