/* undo handling for GNU Emacs.
- Copyright (C) 1990 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
This file is part of GNU Emacs.
and this notice must be preserved on all copies. */
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "buffer.h"
+#include "commands.h"
/* Last buffer for which undo information was recorded. */
Lisp_Object last_undo_buffer;
+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
{
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 (EQ (current_buffer->undo_list, Qt))
- return;
if (MODIFF <= current_buffer->save_modified)
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
+ if (CONSP (elt)
+ && INTEGERP (XCONS (elt)->car)
+ && INTEGERP (XCONS (elt)->cdr)
&& XINT (XCONS (elt)->cdr) == XINT (beg))
{
XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
}
lbeg = beg;
- XSET (lend, Lisp_Int, XINT (beg) + XINT (length));
+ XSETINT (lend, XINT (beg) + XINT (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);
+
+ at_boundary = (CONSP (current_buffer->undo_list)
+ && NILP (XCONS (current_buffer->undo_list)->car));
- if (EQ (current_buffer->undo_list, Qt))
- return;
if (MODIFF <= current_buffer->save_modified)
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 isn't at start of deleted range, record where it is. */
- if (PT != sbeg)
+ /* 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 (PT), current_buffer->undo_list);
+ = Fcons (make_number (last_point_position), current_buffer->undo_list);
current_buffer->undo_list
= Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
record_first_change ()
{
Lisp_Object high, low;
+
+ if (EQ (current_buffer->undo_list, Qt))
+ return;
+
+ if (current_buffer != XBUFFER (last_undo_buffer))
+ Fundo_boundary ();
+ XSETBUFFER (last_undo_buffer, current_buffer);
+
XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
XFASTINT (low) = current_buffer->modtime & 0xffff;
current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
struct buffer *obuf = current_buffer;
int boundary = 0;
+ 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 (EQ (current_buffer->undo_list, Qt))
- return;
-
/* Switch temporarily to the buffer that was changed. */
current_buffer = XBUFFER (buffer);
if (MODIFF <= current_buffer->save_modified)
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);
}
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.")
- (count, list)
- Lisp_Object count, list;
+ (n, list)
+ Lisp_Object n, list;
{
- register int arg = XINT (count);
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object next;
+ int count = specpdl_ptr - specpdl;
+ 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 (arg > 0)
{
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;
high = Fcar (cdr);
low = Fcdr (cdr);
- mod_time = (high << 16) + low;
+ mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
/* If this records an obsolete save
(not matching the actual disk file)
then don't mark unmodified. */
#endif /* CLASH_DETECTION */
Fset_buffer_modified_p (Qnil);
}
- if (EQ (car, Qnil))
+#ifdef USE_TEXT_PROPERTIES
+ else if (EQ (car, Qnil))
{
- /* Element (t prop val beg . end) records property change. */
+ /* Element (nil prop val beg . end) is property change. */
Lisp_Object beg, end, prop, val;
prop = Fcar (cdr);
Fput_text_property (beg, end, prop, val, Qnil);
}
- else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
+#endif /* USE_TEXT_PROPERTIES */
+ 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--;
}
- return list;
+ UNGCPRO;
+ return unbind_to (count, list);
}
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);
}
HCoop / bpt / emacs.git / blobdiff