#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "charset.h"
static int cached_charpos;
static int cached_bytepos;
static struct buffer *cached_buffer;
static int cached_modiff;
static void byte_char_debug_check P_ ((struct buffer *, int, int));
static int byte_debug_flag;
void
clear_charpos_cache (b)
struct buffer *b;
{
if (cached_buffer == b)
cached_buffer = 0;
}
#define CONSIDER(CHARPOS, BYTEPOS) \
{ \
int this_charpos = (CHARPOS); \
int changed = 0; \
\
if (this_charpos == charpos) \
{ \
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) \
{ \
best_above = this_charpos; \
best_above_byte = (BYTEPOS); \
changed = 1; \
} \
} \
else if (this_charpos > best_below) \
{ \
best_below = this_charpos; \
best_below_byte = (BYTEPOS); \
changed = 1; \
} \
\
if (changed) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
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;
{
return buf_charpos_to_bytepos (current_buffer, charpos);
}
int
buf_charpos_to_bytepos (b, charpos)
struct buffer *b;
int charpos;
{
struct Lisp_Marker *tail;
int best_above, best_above_byte;
int best_below, best_below_byte;
if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
if (best_above == best_above_byte)
return charpos;
best_below = BEG;
best_below_byte = BEG_BYTE;
CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
CONSIDER (cached_charpos, cached_bytepos);
for (tail = BUF_MARKERS (b); tail; tail = tail->next)
{
CONSIDER (tail->charpos, tail->bytepos);
if (best_above - best_below < 50)
break;
}
if (charpos - best_below < best_above - charpos)
{
int record = charpos - best_below > 5000;
while (best_below != charpos)
{
best_below++;
BUF_INC_POS (b, best_below_byte);
}
if (record)
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
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;
cached_bytepos = best_below_byte;
return best_below_byte;
}
else
{
int record = best_above - charpos > 5000;
while (best_above != charpos)
{
best_above--;
BUF_DEC_POS (b, best_above_byte);
}
if (record)
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
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;
cached_bytepos = best_above_byte;
return best_above_byte;
}
}
#undef CONSIDER
int
verify_bytepos (charpos)
int charpos;
{
int below = 1;
int below_byte = 1;
while (below != charpos)
{
below++;
BUF_INC_POS (current_buffer, below_byte);
}
return below_byte;
}
#define CONSIDER(BYTEPOS, CHARPOS) \
{ \
int this_bytepos = (BYTEPOS); \
int changed = 0; \
\
if (this_bytepos == bytepos) \
{ \
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) \
{ \
best_above = (CHARPOS); \
best_above_byte = this_bytepos; \
changed = 1; \
} \
} \
else if (this_bytepos > best_below_byte) \
{ \
best_below = (CHARPOS); \
best_below_byte = this_bytepos; \
changed = 1; \
} \
\
if (changed) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
int value = best_below + (bytepos - best_below_byte); \
if (byte_debug_flag) \
byte_char_debug_check (b, value, bytepos); \
return value; \
} \
} \
}
int
bytepos_to_charpos (bytepos)
int bytepos;
{
return buf_bytepos_to_charpos (current_buffer, bytepos);
}
int
buf_bytepos_to_charpos (b, bytepos)
struct buffer *b;
int bytepos;
{
struct Lisp_Marker *tail;
int best_above, best_above_byte;
int best_below, best_below_byte;
if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
if (best_above == best_above_byte)
return bytepos;
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 (BUF_BEGV_BYTE (b), BUF_BEGV (b));
CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
CONSIDER (cached_bytepos, cached_charpos);
for (tail = BUF_MARKERS (b); tail; tail = tail->next)
{
CONSIDER (tail->bytepos, tail->charpos);
if (best_above - best_below < 50)
break;
}
if (bytepos - best_below_byte < best_above_byte - bytepos)
{
int record = bytepos - best_below_byte > 5000;
while (best_below_byte < bytepos)
{
best_below++;
BUF_INC_POS (b, best_below_byte);
}
if (record && BUF_MARKERS (b))
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
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;
cached_bytepos = best_below_byte;
return best_below;
}
else
{
int record = best_above_byte - bytepos > 5000;
while (best_above_byte > bytepos)
{
best_above--;
BUF_DEC_POS (b, best_above_byte);
}
if (record && BUF_MARKERS (b))
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
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;
cached_bytepos = best_above_byte;
return best_above;
}
}
#undef CONSIDER
DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
doc: )
(marker)
register Lisp_Object marker;
{
register Lisp_Object buf;
CHECK_MARKER (marker);
if (XMARKER (marker)->buffer)
{
XSETBUFFER (buf, XMARKER (marker)->buffer);
if (!NILP (XBUFFER (buf)->name))
return buf;
}
return Qnil;
}
DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
doc: )
(marker)
Lisp_Object marker;
{
CHECK_MARKER (marker);
if (XMARKER (marker)->buffer)
return make_number (XMARKER (marker)->charpos);
return Qnil;
}
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
doc: )
(marker, position, buffer)
Lisp_Object marker, position, buffer;
{
register int charno, bytepos;
register struct buffer *b;
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
m = XMARKER (marker);
if (NILP (position)
|| (MARKERP (position) && !XMARKER (position)->buffer))
{
unchain_marker (m);
return marker;
}
if (NILP (buffer))
b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
if (EQ (b->name, Qnil))
{
unchain_marker (m);
return marker;
}
}
if (MARKERP (position) && b == XMARKER (position)->buffer
&& b == m->buffer)
{
m->bytepos = XMARKER (position)->bytepos;
m->charpos = XMARKER (position)->charpos;
return marker;
}
CHECK_NUMBER_COERCE_MARKER (position);
charno = XINT (position);
if (charno < BUF_BEG (b))
charno = BUF_BEG (b);
if (charno > BUF_Z (b))
charno = BUF_Z (b);
bytepos = buf_charpos_to_bytepos (b, charno);
if (charno > bytepos)
abort ();
m->bytepos = bytepos;
m->charpos = charno;
if (m->buffer != b)
{
unchain_marker (m);
m->buffer = b;
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
return marker;
}
Lisp_Object
set_marker_restricted (marker, pos, buffer)
Lisp_Object marker, pos, buffer;
{
register int charno, bytepos;
register struct buffer *b;
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
m = XMARKER (marker);
if (NILP (pos)
|| (MARKERP (pos) && !XMARKER (pos)->buffer))
{
unchain_marker (m);
return marker;
}
if (NILP (buffer))
b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
if (EQ (b->name, Qnil))
{
unchain_marker (m);
return marker;
}
}
if (MARKERP (pos) && b == XMARKER (pos)->buffer
&& b == m->buffer)
{
m->bytepos = XMARKER (pos)->bytepos;
m->charpos = XMARKER (pos)->charpos;
return marker;
}
CHECK_NUMBER_COERCE_MARKER (pos);
charno = XINT (pos);
if (charno < BUF_BEGV (b))
charno = BUF_BEGV (b);
if (charno > BUF_ZV (b))
charno = BUF_ZV (b);
bytepos = buf_charpos_to_bytepos (b, charno);
if (charno > bytepos)
abort ();
m->bytepos = bytepos;
m->charpos = charno;
if (m->buffer != b)
{
unchain_marker (m);
m->buffer = b;
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
return marker;
}
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);
m = XMARKER (marker);
if (NILP (buffer))
b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
if (EQ (b->name, Qnil))
{
unchain_marker (m);
return marker;
}
}
if (BUF_Z (b) == BUF_Z_BYTE (b)
&& charpos != bytepos)
abort ();
if (charpos > bytepos)
abort ();
m->bytepos = bytepos;
m->charpos = charpos;
if (m->buffer != b)
{
unchain_marker (m);
m->buffer = b;
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
return marker;
}
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);
m = XMARKER (marker);
if (NILP (buffer))
b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
if (EQ (b->name, Qnil))
{
unchain_marker (m);
return marker;
}
}
if (charpos < BUF_BEGV (b))
charpos = BUF_BEGV (b);
if (charpos > BUF_ZV (b))
charpos = BUF_ZV (b);
if (bytepos < BUF_BEGV_BYTE (b))
bytepos = BUF_BEGV_BYTE (b);
if (bytepos > BUF_ZV_BYTE (b))
bytepos = BUF_ZV_BYTE (b);
if (BUF_Z (b) == BUF_Z_BYTE (b)
&& charpos != bytepos)
abort ();
if (charpos > bytepos)
abort ();
m->bytepos = bytepos;
m->charpos = charpos;
if (m->buffer != b)
{
unchain_marker (m);
m->buffer = b;
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
return marker;
}
void
unchain_marker (marker)
register struct Lisp_Marker *marker;
{
register struct Lisp_Marker *tail, *prev, *next;
register struct buffer *b;
b = marker->buffer;
if (b == 0)
return;
if (EQ (b->name, Qnil))
abort ();
marker->buffer = 0;
tail = BUF_MARKERS (b);
prev = NULL;
while (tail)
{
next = tail->next;
if (marker == tail)
{
if (!prev)
{
BUF_MARKERS (b) = next;
if (next && b->text != next->buffer->text)
abort ();
}
else
prev->next = next;
return;
}
else
prev = tail;
tail = next;
}
abort ();
}
int
marker_position (marker)
Lisp_Object marker;
{
register struct Lisp_Marker *m = XMARKER (marker);
register struct buffer *buf = m->buffer;
if (!buf)
error ("Marker does not point anywhere");
return m->charpos;
}
int
marker_byte_position (marker)
Lisp_Object marker;
{
register struct Lisp_Marker *m = XMARKER (marker);
register struct buffer *buf = m->buffer;
register int i = m->bytepos;
if (!buf)
error ("Marker does not point anywhere");
if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
abort ();
return i;
}
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
doc: )
(marker, type)
register Lisp_Object marker, type;
{
register Lisp_Object new;
CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), 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,
doc: )
(marker)
register Lisp_Object marker;
{
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,
doc: )
(marker, type)
Lisp_Object marker, type;
{
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,
doc: )
(position)
Lisp_Object position;
{
register struct Lisp_Marker *tail;
register int charno;
charno = XINT (position);
if (charno < BEG)
charno = BEG;
if (charno > Z)
charno = Z;
for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
if (tail->charpos == charno)
return Qt;
return Qnil;
}
int
count_markers (buf)
struct buffer *buf;
{
int total = 0;
struct Lisp_Marker *tail;
for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
total++;
return total;
}
void
syms_of_marker ()
{
defsubr (&Smarker_position);
defsubr (&Smarker_buffer);
defsubr (&Sset_marker);
defsubr (&Scopy_marker);
defsubr (&Smarker_insertion_type);
defsubr (&Sset_marker_insertion_type);
defsubr (&Sbuffer_has_markers_at);
DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
doc: );
byte_debug_flag = 0;
}