/* 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
- && XINT (XCONS (elt)->cdr) == beg)
+ if (CONSP (elt)
+ && INTEGERP (XCONS (elt)->car)
+ && INTEGERP (XCONS (elt)->cdr)
+ && XINT (XCONS (elt)->cdr) == XINT (beg))
{
- XSETINT (XCONS (elt)->cdr, beg + length);
+ XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
return;
}
}
- XFASTINT (lbeg) = beg;
- XFASTINT (lend) = beg + length;
- current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list);
+ lbeg = beg;
+ XSETINT (lend, XINT (beg) + XINT (length));
+ current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
+ current_buffer->undo_list);
}
/* Record that a deletion is about to take place,
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 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);
+
current_buffer->undo_list
= Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
current_buffer->undo_list);
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);
}
+/* Record a change in property PROP (whose old value was VAL)
+ for LENGTH characters starting at position BEG in BUFFER. */
+
+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;
+
+ /* 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;
+
+ /* Switch temporarily to the buffer that was changed. */
+ current_buffer = XBUFFER (buffer);
+
+ if (boundary)
+ Fundo_boundary ();
+
+ if (MODIFF <= current_buffer->save_modified)
+ 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\
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
- && XCONS (next)->car == Qnil)
+ 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
- && XCONS (next)->car != Qnil)
+ 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, car, cdr;
next = Fcar (list);
list = Fcdr (list);
+ /* Exit inner loop at undo boundary. */
if (NILP (next))
break;
- car = Fcar (next);
- cdr = Fcdr (next);
- if (EQ (car, Qt))
+ /* Handle an integer by setting point to that value. */
+ if (INTEGERP (next))
+ SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
+ else if (CONSP (next))
{
- Lisp_Object high, low;
- int mod_time;
- high = Fcar (cdr);
- low = Fcdr (cdr);
- mod_time = (high << 16) + low;
- /* If this records an obsolete save
- (not matching the actual disk file)
- then don't mark unmodified. */
- if (mod_time != current_buffer->modtime)
- break;
+ Lisp_Object car, cdr;
+
+ car = Fcar (next);
+ cdr = Fcdr (next);
+ if (EQ (car, Qt))
+ {
+ /* Element (t high . low) records previous modtime. */
+ Lisp_Object high, low;
+ int mod_time;
+
+ high = Fcar (cdr);
+ low = Fcdr (cdr);
+ mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
+ /* If this records an obsolete save
+ (not matching the actual disk file)
+ then don't mark unmodified. */
+ if (mod_time != current_buffer->modtime)
+ break;
#ifdef CLASH_DETECTION
- Funlock_buffer ();
+ Funlock_buffer ();
#endif /* CLASH_DETECTION */
- Fset_buffer_modified_p (Qnil);
- }
- else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
- {
- Lisp_Object end;
- if (XINT (car) < BEGV
- || XINT (cdr) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
- Fdelete_region (car, cdr);
- Fgoto_char (car);
- }
- else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
- {
- Lisp_Object membuf;
- int pos = XINT (cdr);
- membuf = car;
- if (pos < 0)
+ Fset_buffer_modified_p (Qnil);
+ }
+#ifdef USE_TEXT_PROPERTIES
+ else if (EQ (car, Qnil))
{
- if (-pos < BEGV || -pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
- SET_PT (-pos);
- Finsert (1, &membuf);
+ /* Element (nil prop val beg . end) is property change. */
+ 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
+#endif /* USE_TEXT_PROPERTIES */
+ else if (INTEGERP (car) && INTEGERP (cdr))
{
- if (pos < BEGV || pos > ZV)
+ /* Element (BEG . END) means range was inserted. */
+ Lisp_Object end;
+
+ if (XINT (car) < BEGV
+ || XINT (cdr) > ZV)
error ("Changes to be undone are outside visible portion of buffer");
- SET_PT (pos);
-
- /* Insert before markers so that if the mark is
- currently on the boundary of this deletion, it
- ends up on the other side of the now-undeleted
- text from point. Since undo doesn't even keep
- track of the mark, this isn't really necessary,
- but it may lead to better behavior in certain
- situations. */
- Finsert_before_markers (1, &membuf);
- SET_PT (pos);
+ /* Set point first thing, so that undoing this undo
+ does not send point back to where it is now. */
+ Fgoto_char (car);
+ Fdelete_region (car, cdr);
+ }
+ else if (STRINGP (car) && INTEGERP (cdr))
+ {
+ /* Element (STRING . POS) means STRING was deleted. */
+ 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);
+
+ /* Insert before markers so that if the mark is
+ currently on the boundary of this deletion, it
+ ends up on the other side of the now-undeleted
+ text from point. Since undo doesn't even keep
+ track of the mark, this isn't really necessary,
+ but it may lead to better behavior in certain
+ situations. */
+ Finsert_before_markers (1, &membuf);
+ SET_PT (pos);
+ }
}
}
}
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