#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "commands.h"
#include "window.h"
EMACS_INT undo_limit;
EMACS_INT undo_strong_limit;
Lisp_Object Vundo_outer_limit;
Lisp_Object Vundo_outer_limit_function;
Lisp_Object last_undo_buffer;
Lisp_Object Qinhibit_read_only;
Lisp_Object Qapply;
Lisp_Object pending_boundary;
static void
record_point (pt)
int pt;
{
int at_boundary;
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 = 1;
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
if (at_boundary
&& BUFFERP (last_point_position_buffer)
&& current_buffer == XBUFFER (last_point_position_buffer))
{
if (! EQ (last_point_position_window, selected_window))
last_point_position = marker_position (XWINDOW (selected_window)->pointm);
if (last_point_position != pt)
current_buffer->undo_list
= Fcons (make_number (last_point_position), current_buffer->undo_list);
}
}
void
record_insert (beg, length)
int beg, length;
{
Lisp_Object lbeg, lend;
if (EQ (current_buffer->undo_list, Qt))
return;
record_point (beg);
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)
{
XSETCDR (elt, make_number (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;
if (EQ (current_buffer->undo_list, Qt))
return;
if (PT == beg + SCHARS (string))
{
XSETINT (sbeg, -beg);
record_point (PT);
}
else
{
XSETFASTINT (sbeg, beg);
record_point (beg);
}
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,
doc: )
()
{
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))
{
XSETCDR (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;
}
void
truncate_undo_list (b)
struct buffer *b;
{
Lisp_Object list;
Lisp_Object prev, next, last_boundary;
int size_so_far = 0;
int count = inhibit_garbage_collection ();
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
set_buffer_internal (b);
list = b->undo_list;
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
+ SCHARS (XCAR (elt)));
}
prev = next;
next = XCDR (next);
}
if (INTEGERP (Vundo_outer_limit)
&& size_so_far > XINT (Vundo_outer_limit)
&& !NILP (Vundo_outer_limit_function))
{
Lisp_Object temp = last_undo_buffer, tem;
tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
if (! NILP (tem))
{
unbind_to (count, Qnil);
return;
}
last_undo_buffer = temp;
}
if (CONSP (next))
last_boundary = prev;
while (CONSP (next))
{
Lisp_Object elt;
elt = XCAR (next);
if (NILP (elt))
{
if (size_so_far > undo_strong_limit)
break;
last_boundary = prev;
if (size_so_far > undo_limit)
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
+ SCHARS (XCAR (elt)));
}
prev = next;
next = XCDR (next);
}
if (NILP (next))
;
else if (!NILP (last_boundary))
XSETCDR (last_boundary, Qnil);
else
b->undo_list = Qnil;
unbind_to (count, Qnil);
}
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
doc: )
(n, list)
Lisp_Object n, list;
{
struct gcpro gcpro1, gcpro2;
Lisp_Object next;
int count = SPECPDL_INDEX ();
register int arg;
Lisp_Object oldlist;
int did_apply = 0;
#if 0
Lisp_Object tem;
tem = Fcar (list);
if (NILP (tem))
list = Fcdr (list);
#endif
CHECK_NUMBER (n);
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);
oldlist = current_buffer->undo_list;
while (arg > 0)
{
while (CONSP (list))
{
next = XCAR (list);
list = XCDR (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 = XCAR (next);
cdr = XCDR (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);
if (XINT (beg) < BEGV || XINT (end) > ZV)
error ("Changes to be undone are outside visible portion of buffer");
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 (EQ (car, Qapply))
{
struct buffer *save_buffer = current_buffer;
car = Fcar (cdr);
cdr = Fcdr (cdr);
if (INTEGERP (car))
{
Lisp_Object delta = car;
Lisp_Object start = Fcar (cdr);
Lisp_Object end = Fcar (Fcdr (cdr));
Lisp_Object start_mark = Fcopy_marker (start, Qnil);
Lisp_Object end_mark = Fcopy_marker (end, Qt);
cdr = Fcdr (Fcdr (cdr));
apply1 (Fcar (cdr), Fcdr (cdr));
if (!EQ (start, Fmarker_position (start_mark))
|| (XINT (delta) + XINT (end)
!= marker_position (end_mark)))
error ("Changes to be undone by function different than announced");
Fset_marker (start_mark, Qnil, Qnil);
Fset_marker (end_mark, Qnil, Qnil);
}
else
apply1 (car, cdr);
if (save_buffer != current_buffer)
error ("Undo function switched buffer");
did_apply = 1;
}
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--;
}
if (did_apply
&& EQ (oldlist, current_buffer->undo_list))
current_buffer->undo_list
= Fcons (list3 (Qapply, Qcdr, Qnil), current_buffer->undo_list);
UNGCPRO;
return unbind_to (count, list);
}
void
syms_of_undo ()
{
Qinhibit_read_only = intern ("inhibit-read-only");
staticpro (&Qinhibit_read_only);
Qapply = intern ("apply");
staticpro (&Qapply);
pending_boundary = Qnil;
staticpro (&pending_boundary);
defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
DEFVAR_INT ("undo-limit", &undo_limit,
doc: );
undo_limit = 20000;
DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
doc: );
undo_strong_limit = 30000;
DEFVAR_LISP ("undo-outer-limit", &Vundo_outer_limit,
doc: );
Vundo_outer_limit = make_number (3000000);
DEFVAR_LISP ("undo-outer-limit-function", &Vundo_outer_limit_function,
doc: );
Vundo_outer_limit_function = Qnil;
}