#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "commands.h"
Lisp_Object last_undo_buffer;
Lisp_Object Qinhibit_read_only;
Lisp_Object pending_boundary;
void
record_insert (beg, length)
int beg, length;
{
Lisp_Object lbeg, lend;
if (EQ (current_buffer->undo_list, Qt))
return;
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
if (!BUFFERP (last_undo_buffer)
|| current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
XSETBUFFER (last_undo_buffer, current_buffer);
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
if (CONSP (current_buffer->undo_list))
{
Lisp_Object elt;
elt = XCAR (current_buffer->undo_list);
if (CONSP (elt)
&& INTEGERP (XCAR (elt))
&& INTEGERP (XCDR (elt))
&& XINT (XCDR (elt)) == beg)
{
XSETINT (XCDR (elt), beg + length);
return;
}
}
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
current_buffer->undo_list);
}
void
record_delete (beg, string)
int beg;
Lisp_Object string;
{
Lisp_Object sbeg;
int at_boundary;
if (EQ (current_buffer->undo_list, Qt))
return;
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
if (BUFFERP (last_undo_buffer)
&& current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
XSETBUFFER (last_undo_buffer, current_buffer);
if (CONSP (current_buffer->undo_list))
{
Lisp_Object tail = current_buffer->undo_list, elt;
while (1)
{
if (NILP (tail))
elt = Qnil;
else
elt = XCAR (tail);
if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
break;
tail = XCDR (tail);
}
at_boundary = NILP (elt);
}
else
at_boundary = 0;
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
if (PT == beg + XSTRING (string)->size)
XSETINT (sbeg, -beg);
else
XSETFASTINT (sbeg, beg);
if (at_boundary
&& last_point_position != XFASTINT (sbeg)
&& BUFFERP (last_point_position_buffer)
&& current_buffer == XBUFFER (last_point_position_buffer))
current_buffer->undo_list
= Fcons (make_number (last_point_position), current_buffer->undo_list);
current_buffer->undo_list
= Fcons (Fcons (string, sbeg), current_buffer->undo_list);
}
void
record_marker_adjustment (marker, adjustment)
Lisp_Object marker;
int adjustment;
{
if (EQ (current_buffer->undo_list, Qt))
return;
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
if (!BUFFERP (last_undo_buffer)
|| current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
XSETBUFFER (last_undo_buffer, current_buffer);
current_buffer->undo_list
= Fcons (Fcons (marker, make_number (adjustment)),
current_buffer->undo_list);
}
void
record_change (beg, length)
int beg, length;
{
record_delete (beg, make_buffer_string (beg, beg + length, 1));
record_insert (beg, length);
}
void
record_first_change ()
{
Lisp_Object high, low;
struct buffer *base_buffer = current_buffer;
if (EQ (current_buffer->undo_list, Qt))
return;
if (!BUFFERP (last_undo_buffer)
|| current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
XSETBUFFER (last_undo_buffer, current_buffer);
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
XSETFASTINT (low, base_buffer->modtime & 0xffff);
current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
}
void
record_property_change (beg, length, prop, value, buffer)
int beg, length;
Lisp_Object prop, value, buffer;
{
Lisp_Object lbeg, lend, entry;
struct buffer *obuf = current_buffer;
int boundary = 0;
if (EQ (XBUFFER (buffer)->undo_list, Qt))
return;
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
if (!EQ (buffer, last_undo_buffer))
boundary = 1;
last_undo_buffer = buffer;
current_buffer = XBUFFER (buffer);
if (boundary)
Fundo_boundary ();
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
XSETINT (lbeg, beg);
XSETINT (lend, beg + length);
entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
current_buffer = obuf;
}
DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
"Mark a boundary between units of undo.\n\
An undo command will stop at this point,\n\
but another undo command will undo to the previous boundary.")
()
{
Lisp_Object tem;
if (EQ (current_buffer->undo_list, Qt))
return Qnil;
tem = Fcar (current_buffer->undo_list);
if (!NILP (tem))
{
if (!NILP (pending_boundary))
{
XCDR (pending_boundary) = current_buffer->undo_list;
current_buffer->undo_list = pending_boundary;
pending_boundary = Qnil;
}
else
current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
}
return Qnil;
}
Lisp_Object
truncate_undo_list (list, minsize, maxsize)
Lisp_Object list;
int minsize, maxsize;
{
Lisp_Object prev, next, last_boundary;
int size_so_far = 0;
prev = Qnil;
next = list;
last_boundary = Qnil;
if (CONSP (next) && NILP (XCAR (next)))
{
size_so_far += sizeof (struct Lisp_Cons);
prev = next;
next = XCDR (next);
}
while (CONSP (next) && ! NILP (XCAR (next)))
{
Lisp_Object elt;
elt = XCAR (next);
size_so_far += sizeof (struct Lisp_Cons);
if (CONSP (elt))
{
size_so_far += sizeof (struct Lisp_Cons);
if (STRINGP (XCAR (elt)))
size_so_far += (sizeof (struct Lisp_String) - 1
+ XSTRING (XCAR (elt))->size);
}
prev = next;
next = XCDR (next);
}
if (CONSP (next))
last_boundary = prev;
while (CONSP (next))
{
Lisp_Object elt;
elt = XCAR (next);
if (NILP (elt))
{
if (size_so_far > maxsize)
break;
last_boundary = prev;
if (size_so_far > minsize)
break;
}
size_so_far += sizeof (struct Lisp_Cons);
if (CONSP (elt))
{
size_so_far += sizeof (struct Lisp_Cons);
if (STRINGP (XCAR (elt)))
size_so_far += (sizeof (struct Lisp_String) - 1
+ XSTRING (XCAR (elt))->size);
}
prev = next;
next = XCDR (next);
}
if (NILP (next))
return list;
if (!NILP (last_boundary))
{
XCDR (last_boundary) = Qnil;
return list;
}
else
return Qnil;
}
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
"Undo N records from the front of the list LIST.\n\
Return what remains of the list.")
(n, list)
Lisp_Object n, list;
{
struct gcpro gcpro1, gcpro2;
Lisp_Object next;
int count = BINDING_STACK_SIZE ();
register int arg;
#if 0
Lisp_Object tem;
tem = Fcar (list);
if (NILP (tem))
list = Fcdr (list);
#endif
CHECK_NUMBER (n, 0);
arg = XINT (n);
next = Qnil;
GCPRO2 (next, list);
if (NILP (current_buffer->read_only))
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_point_motion_hooks, Qt);
while (arg > 0)
{
while (1)
{
next = Fcar (list);
list = Fcdr (list);
if (NILP (next))
break;
if (INTEGERP (next))
SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
else if (CONSP (next))
{
Lisp_Object car, cdr;
car = Fcar (next);
cdr = Fcdr (next);
if (EQ (car, Qt))
{
Lisp_Object high, low;
int mod_time;
struct buffer *base_buffer = current_buffer;
high = Fcar (cdr);
low = Fcdr (cdr);
mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
if (current_buffer->base_buffer)
base_buffer = current_buffer->base_buffer;
if (mod_time != base_buffer->modtime)
continue;
#ifdef CLASH_DETECTION
Funlock_buffer ();
#endif
Fset_buffer_modified_p (Qnil);
}
else if (EQ (car, Qnil))
{
Lisp_Object beg, end, prop, val;
prop = Fcar (cdr);
cdr = Fcdr (cdr);
val = Fcar (cdr);
cdr = Fcdr (cdr);
beg = Fcar (cdr);
end = Fcdr (cdr);
Fput_text_property (beg, end, prop, val, Qnil);
}
else if (INTEGERP (car) && INTEGERP (cdr))
{
if (XINT (car) < BEGV
|| XINT (cdr) > ZV)
error ("Changes to be undone are outside visible portion of buffer");
Fgoto_char (car);
Fdelete_region (car, cdr);
}
else if (STRINGP (car) && INTEGERP (cdr))
{
Lisp_Object membuf;
int pos = XINT (cdr);
membuf = car;
if (pos < 0)
{
if (-pos < BEGV || -pos > ZV)
error ("Changes to be undone are outside visible portion of buffer");
SET_PT (-pos);
Finsert (1, &membuf);
}
else
{
if (pos < BEGV || pos > ZV)
error ("Changes to be undone are outside visible portion of buffer");
SET_PT (pos);
Finsert (1, &membuf);
SET_PT (pos);
}
}
else if (MARKERP (car) && INTEGERP (cdr))
{
if (XMARKER (car)->buffer)
Fset_marker (car,
make_number (marker_position (car) - XINT (cdr)),
Fmarker_buffer (car));
}
}
}
arg--;
}
UNGCPRO;
return unbind_to (count, list);
}
void
syms_of_undo ()
{
Qinhibit_read_only = intern ("inhibit-read-only");
staticpro (&Qinhibit_read_only);
pending_boundary = Qnil;
staticpro (&pending_boundary);
defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
}