/* undo handling for GNU Emacs.
- Copyright (C) 1990 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993 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"
/* Last buffer for which undo information was recorded. */
Lisp_Object last_undo_buffer;
+Lisp_Object Qinhibit_read_only;
+
/* 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;
+
if (current_buffer != XBUFFER (last_undo_buffer))
Fundo_boundary ();
XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
- if (EQ (current_buffer->undo_list, Qt))
- return;
if (MODIFF <= current_buffer->save_modified)
record_first_change ();
if (XTYPE (elt) == Lisp_Cons
&& XTYPE (XCONS (elt)->car) == Lisp_Int
&& XTYPE (XCONS (elt)->cdr) == Lisp_Int
- && XINT (XCONS (elt)->cdr) == beg)
+ && 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;
+ XSET (lend, Lisp_Int, 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,
{
Lisp_Object lbeg, lend, sbeg;
+ 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);
- if (EQ (current_buffer->undo_list, Qt))
- return;
if (MODIFF <= current_buffer->save_modified)
record_first_change ();
XFASTINT (lend) = beg + length;
/* If point isn't at start of deleted range, record where it is. */
- if (PT != sbeg)
+ if (PT != XFASTINT (sbeg))
current_buffer->undo_list
= Fcons (make_number (PT), 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 ();
+ XSET (last_undo_buffer, Lisp_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;
+
+ 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 ();
+
+ XSET (lbeg, Lisp_Int, beg);
+ XSET (lend, Lisp_Int, 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\
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)
+ && NILP (XCONS (next)->car))
{
/* Add in the space occupied by this element and its chain link. */
size_so_far += sizeof (struct Lisp_Cons);
next = XCONS (next)->cdr;
}
while (XTYPE (next) == Lisp_Cons
- && XCONS (next)->car != Qnil)
+ && ! NILP (XCONS (next)->car))
{
Lisp_Object elt;
elt = XCONS (next)->car;
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);
+ int count = specpdl_ptr - specpdl;
+ register int arg = XINT (n);
#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
+ /* 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)
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. */
if (mod_time != current_buffer->modtime)
break;
- #ifdef CLASH_DETECTION
+#ifdef CLASH_DETECTION
Funlock_buffer ();
- #endif /* CLASH_DETECTION */
+#endif /* CLASH_DETECTION */
Fset_buffer_modified_p (Qnil);
}
+#ifdef USE_TEXT_PROPERTIES
+ else if (EQ (car, Qnil))
+ {
+ /* 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);
+ }
+#endif /* USE_TEXT_PROPERTIES */
else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
{
/* Element (BEG . END) means range was inserted. */
if (XINT (car) < BEGV
|| XINT (cdr) > ZV)
error ("Changes to be undone are outside visible portion of buffer");
- Fdelete_region (car, cdr);
+ /* 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 (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
{
arg--;
}
- return list;
+ return unbind_to (count, list);
}
syms_of_undo ()
{
+ Qinhibit_read_only = intern ("inhibit-read-only");
+ staticpro (&Qinhibit_read_only);
+
defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
}