/* undo handling for GNU Emacs.
- Copyright (C) 1990, 1993 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object Qinhibit_read_only;
+/* The first time a command records something for undo.
+ it also allocates the undo-boundary object
+ which will be added to the list at the end of the command.
+ This ensures we can't run out of space while trying to make
+ an undo-boundary. */
+Lisp_Object pending_boundary;
+
/* Record an insertion that just happened or is about to happen,
for LENGTH characters at position BEG.
(It is possible to record an insertion before or after the fact
because we don't need to record the contents.) */
record_insert (beg, length)
- Lisp_Object beg, length;
+ int beg, length;
{
Lisp_Object lbeg, lend;
if (EQ (current_buffer->undo_list, Qt))
return;
+ /* Allocate a cons cell to be the undo boundary after this command. */
+ if (NILP (pending_boundary))
+ pending_boundary = Fcons (Qnil, Qnil);
+
if (current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
- XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
+ XSETBUFFER (last_undo_buffer, current_buffer);
- if (MODIFF <= current_buffer->save_modified)
+ if (MODIFF <= SAVE_MODIFF)
record_first_change ();
/* If this is following another insertion and consecutive with it
in the buffer, combine the two. */
- if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
+ if (CONSP (current_buffer->undo_list))
{
Lisp_Object elt;
elt = XCONS (current_buffer->undo_list)->car;
- if (XTYPE (elt) == Lisp_Cons
- && XTYPE (XCONS (elt)->car) == Lisp_Int
- && XTYPE (XCONS (elt)->cdr) == Lisp_Int
- && XINT (XCONS (elt)->cdr) == XINT (beg))
+ if (CONSP (elt)
+ && INTEGERP (XCONS (elt)->car)
+ && INTEGERP (XCONS (elt)->cdr)
+ && XINT (XCONS (elt)->cdr) == beg)
{
- XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
+ XSETINT (XCONS (elt)->cdr, beg + length);
return;
}
}
- lbeg = beg;
- XSET (lend, Lisp_Int, XINT (beg) + XINT (length));
+ XSETFASTINT (lbeg, beg);
+ XSETINT (lend, beg + length);
current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
current_buffer->undo_list);
}
int beg, length;
{
Lisp_Object lbeg, lend, sbeg;
+ int at_boundary;
if (EQ (current_buffer->undo_list, Qt))
return;
+ /* Allocate a cons cell to be the undo boundary after this command. */
+ if (NILP (pending_boundary))
+ pending_boundary = Fcons (Qnil, Qnil);
+
if (current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
- XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
+ XSETBUFFER (last_undo_buffer, current_buffer);
- if (MODIFF <= current_buffer->save_modified)
+ at_boundary = (CONSP (current_buffer->undo_list)
+ && NILP (XCONS (current_buffer->undo_list)->car));
+
+ if (MODIFF <= SAVE_MODIFF)
record_first_change ();
if (point == beg + length)
- XSET (sbeg, Lisp_Int, -beg);
+ XSETINT (sbeg, -beg);
else
- XFASTINT (sbeg) = beg;
- XFASTINT (lbeg) = beg;
- XFASTINT (lend) = beg + length;
-
- /* If point wasn't at start of deleted range, record where it was. */
- if (last_point_position != XFASTINT (sbeg))
+ XSETFASTINT (sbeg, beg);
+ XSETFASTINT (lbeg, beg);
+ XSETFASTINT (lend, beg + length);
+
+ /* If we are just after an undo boundary, and
+ point wasn't at start of deleted range, record where it was. */
+ if (at_boundary
+ && last_point_position != XFASTINT (sbeg)
+ && current_buffer == XBUFFER (last_point_position_buffer))
current_buffer->undo_list
= Fcons (make_number (last_point_position), current_buffer->undo_list);
record_first_change ()
{
Lisp_Object high, low;
+ struct buffer *base_buffer = current_buffer;
if (EQ (current_buffer->undo_list, Qt))
return;
if (current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
- XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
+ XSETBUFFER (last_undo_buffer, current_buffer);
- XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
- XFASTINT (low) = current_buffer->modtime & 0xffff;
+ 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);
}
if (EQ (XBUFFER (buffer)->undo_list, Qt))
return;
+ /* Allocate a cons cell to be the undo boundary after this command. */
+ if (NILP (pending_boundary))
+ pending_boundary = Fcons (Qnil, Qnil);
+
if (!EQ (buffer, last_undo_buffer))
boundary = 1;
last_undo_buffer = buffer;
if (boundary)
Fundo_boundary ();
- if (MODIFF <= current_buffer->save_modified)
+ if (MODIFF <= SAVE_MODIFF)
record_first_change ();
- XSET (lbeg, Lisp_Int, beg);
- XSET (lend, Lisp_Int, beg + length);
+ 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);
return Qnil;
tem = Fcar (current_buffer->undo_list);
if (!NILP (tem))
- current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
+ {
+ /* One way or another, cons nil onto the front of the undo list. */
+ if (!NILP (pending_boundary))
+ {
+ /* If we have preallocated the cons cell to use here,
+ use that one. */
+ XCONS (pending_boundary)->cdr = 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;
}
Skip, skip, skip the undo, skip, skip, skip the undo,
Skip, skip, skip the undo, skip to the undo bound'ry.
(Get it? "Skip to my Loo?") */
- if (XTYPE (next) == Lisp_Cons
- && NILP (XCONS (next)->car))
+ if (CONSP (next) && NILP (XCONS (next)->car))
{
/* Add in the space occupied by this element and its chain link. */
size_so_far += sizeof (struct Lisp_Cons);
prev = next;
next = XCONS (next)->cdr;
}
- while (XTYPE (next) == Lisp_Cons
- && ! NILP (XCONS (next)->car))
+ while (CONSP (next) && ! NILP (XCONS (next)->car))
{
Lisp_Object elt;
elt = XCONS (next)->car;
/* Add in the space occupied by this element and its chain link. */
size_so_far += sizeof (struct Lisp_Cons);
- if (XTYPE (elt) == Lisp_Cons)
+ if (CONSP (elt))
{
size_so_far += sizeof (struct Lisp_Cons);
- if (XTYPE (XCONS (elt)->car) == Lisp_String)
+ if (STRINGP (XCONS (elt)->car))
size_so_far += (sizeof (struct Lisp_String) - 1
+ XSTRING (XCONS (elt)->car)->size);
}
prev = next;
next = XCONS (next)->cdr;
}
- if (XTYPE (next) == Lisp_Cons)
+ if (CONSP (next))
last_boundary = prev;
- while (XTYPE (next) == Lisp_Cons)
+ while (CONSP (next))
{
Lisp_Object elt;
elt = XCONS (next)->car;
/* Add in the space occupied by this element and its chain link. */
size_so_far += sizeof (struct Lisp_Cons);
- if (XTYPE (elt) == Lisp_Cons)
+ if (CONSP (elt))
{
size_so_far += sizeof (struct Lisp_Cons);
- if (XTYPE (XCONS (elt)->car) == Lisp_String)
+ if (STRINGP (XCONS (elt)->car))
size_so_far += (sizeof (struct Lisp_String) - 1
+ XSTRING (XCONS (elt)->car)->size);
}
(n, list)
Lisp_Object n, list;
{
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object next;
int count = specpdl_ptr - specpdl;
- register int arg = XINT (n);
+ register int arg;
#if 0 /* This is a good feature, but would make undo-start
unable to do what is expected. */
Lisp_Object tem;
list = Fcdr (list);
#endif
+ CHECK_NUMBER (n, 0);
+ arg = XINT (n);
+ next = Qnil;
+ GCPRO2 (next, list);
+
/* Don't let read-only properties interfere with undo. */
if (NILP (current_buffer->read_only))
specbind (Qinhibit_read_only, Qt);
{
while (1)
{
- Lisp_Object next;
next = Fcar (list);
list = Fcdr (list);
/* Exit inner loop at undo boundary. */
if (NILP (next))
break;
/* Handle an integer by setting point to that value. */
- if (XTYPE (next) == Lisp_Int)
+ if (INTEGERP (next))
SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
- else if (XTYPE (next) == Lisp_Cons)
+ else if (CONSP (next))
{
Lisp_Object car, cdr;
/* Element (t high . low) records previous modtime. */
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 this records an obsolete save
(not matching the actual disk file)
then don't mark unmodified. */
- if (mod_time != current_buffer->modtime)
- break;
+ if (mod_time != base_buffer->modtime)
+ continue;
#ifdef CLASH_DETECTION
Funlock_buffer ();
#endif /* CLASH_DETECTION */
Fput_text_property (beg, end, prop, val, Qnil);
}
#endif /* USE_TEXT_PROPERTIES */
- else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
+ else if (INTEGERP (car) && INTEGERP (cdr))
{
/* Element (BEG . END) means range was inserted. */
Lisp_Object end;
Fgoto_char (car);
Fdelete_region (car, cdr);
}
- else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
+ else if (STRINGP (car) && INTEGERP (cdr))
{
/* Element (STRING . POS) means STRING was deleted. */
Lisp_Object membuf;
arg--;
}
+ UNGCPRO;
return unbind_to (count, list);
}
Qinhibit_read_only = intern ("inhibit-read-only");
staticpro (&Qinhibit_read_only);
+ pending_boundary = Qnil;
+ staticpro (&pending_boundary);
+
defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
}