/* undo handling for GNU Emacs.
- Copyright (C) 1990, 1993-1994, 2000-2012 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1994, 2000-2015 Free Software Foundation,
+ Inc.
This file is part of GNU Emacs.
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "buffer.h"
-#include "commands.h"
-#include "window.h"
-
-/* Last buffer for which undo information was recorded. */
-/* BEWARE: This is not traced by the GC, so never dereference it! */
-static struct buffer *last_undo_buffer;
-
-/* Position of point last time we inserted a boundary. */
-static struct buffer *last_boundary_buffer;
-static EMACS_INT last_boundary_position;
-
-Lisp_Object Qinhibit_read_only;
-
-/* Marker for function call undo list elements. */
-
-Lisp_Object Qapply;
+#include "keyboard.h"
/* The first time a command records something for undo.
it also allocates the undo-boundary object
/* Record point as it was at beginning of this command (if necessary)
and prepare the undo info for recording a change.
- PT is the position of point that will naturally occur as a result of the
- undo record that will be added just after this command terminates. */
-
+/* Prepare the undo info for recording a change. */
static void
-record_point (EMACS_INT pt)
+prepare_record ()
{
- int at_boundary;
-
- /* Don't record position of pt when undo_inhibit_record_point holds. */
- if (undo_inhibit_record_point)
- 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 != last_undo_buffer)
- /* Don't call Fundo_boundary for the first change. Otherwise we
- risk overwriting last_boundary_position in Fundo_boundary with
- PT of the current buffer and as a consequence not insert an
- undo boundary because last_boundary_position will equal pt in
- the test at the end of the present function (Bug#731). */
- && (MODIFF > SAVE_MODIFF))
- Fundo_boundary ();
- last_undo_buffer = current_buffer;
+ if (MODIFF <= SAVE_MODIFF)
+ record_first_change ();
+}
- if (CONSP (BVAR (current_buffer, undo_list)))
- {
- /* Set AT_BOUNDARY to 1 only when we have nothing other than
- marker adjustment before undo boundary. */
+/* Record point as it was at beginning of this command.
+ PT is the position of point that will naturally occur as a result of the
+ undo record that will be added just after this command terminates. */
+static void
+record_point (ptrdiff_t pt)
+{
+ /* Don't record position of pt when undo_inhibit_record_point holds. */
+ if (undo_inhibit_record_point)
+ return;
- Lisp_Object tail = BVAR (current_buffer, undo_list), elt;
+ bool at_boundary;
- 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;
+ at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
+ || NILP (XCAR (BVAR (current_buffer, undo_list)));
- if (MODIFF <= SAVE_MODIFF)
- record_first_change ();
+ prepare_record();
/* If we are just after an undo boundary, and
point wasn't at start of deleted range, record where it was. */
- if (at_boundary
- && current_buffer == last_boundary_buffer
- && last_boundary_position != pt)
- BVAR (current_buffer, undo_list)
- = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list));
+ if (at_boundary){
+ bset_undo_list (current_buffer,
+ Fcons (make_number (pt),
+ BVAR (current_buffer, undo_list)));
+ }
}
/* Record an insertion that just happened or is about to happen,
because we don't need to record the contents.) */
void
-record_insert (EMACS_INT beg, EMACS_INT length)
+record_insert (ptrdiff_t beg, ptrdiff_t length)
{
Lisp_Object lbeg, lend;
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
- record_point (beg);
+ prepare_record ();
/* If this is following another insertion and consecutive with it
in the buffer, combine the two. */
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
- BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend),
- BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
}
-/* Record that a deletion is about to take place,
- of the characters in STRING, at location BEG. */
+/* Record the fact that markers in the region of FROM, TO are about to
+ be adjusted. This is done only when a marker points within text
+ being deleted, because that's the only case where an automatic
+ marker adjustment won't be inverted automatically by undoing the
+ buffer modification. */
+static void
+record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
+{
+ Lisp_Object marker;
+ register struct Lisp_Marker *m;
+ register ptrdiff_t charpos, adjustment;
+
+ /* Allocate a cons cell to be the undo boundary after this command. */
+ if (NILP (pending_boundary))
+ pending_boundary = Fcons (Qnil, Qnil);
+
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
+ {
+ charpos = m->charpos;
+ eassert (charpos <= Z);
+
+ if (from <= charpos && charpos <= to)
+ {
+ /* insertion_type nil markers will end up at the beginning of
+ the re-inserted text after undoing a deletion, and must be
+ adjusted to move them to the correct place.
+
+ insertion_type t markers will automatically move forward
+ upon re-inserting the deleted text, so we have to arrange
+ for them to move backward to the correct position. */
+ adjustment = (m->insertion_type ? to : from) - charpos;
+
+ if (adjustment)
+ {
+ XSETMISC (marker, m);
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (marker, make_number (adjustment)),
+ BVAR (current_buffer, undo_list)));
+ }
+ }
+ }
+}
+
+/* Record that a deletion is about to take place, of the characters in
+ STRING, at location BEG. Optionally record adjustments for markers
+ in the region STRING occupies in the current buffer. */
void
-record_delete (EMACS_INT beg, Lisp_Object string)
+record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
{
Lisp_Object sbeg;
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
+ if (point_before_last_command_or_undo != beg &&
+ buffer_before_last_command_or_undo == current_buffer)
+ {
+ record_point (point_before_last_command_or_undo);
+ }
+
if (PT == beg + SCHARS (string))
{
XSETINT (sbeg, -beg);
- record_point (PT);
+ prepare_record ();
}
else
{
XSETFASTINT (sbeg, beg);
- record_point (beg);
+ prepare_record ();
}
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list));
-}
-
-/* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
- This is done only when a marker points within text being deleted,
- because that's the only case where an automatic marker adjustment
- won't be inverted automatically by undoing the buffer modification. */
-
-void
-record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment)
-{
- if (EQ (BVAR (current_buffer, undo_list), Qt))
- return;
+ /* primitive-undo assumes marker adjustments are recorded
+ immediately before the deletion is recorded. See bug 16818
+ discussion. */
+ if (record_markers)
+ record_marker_adjustments (beg, beg + SCHARS (string));
- /* Allocate a cons cell to be the undo boundary after this command. */
- if (NILP (pending_boundary))
- pending_boundary = Fcons (Qnil, Qnil);
-
- if (current_buffer != last_undo_buffer)
- Fundo_boundary ();
- last_undo_buffer = current_buffer;
-
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (marker, make_number (adjustment)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
}
/* Record that a replacement is about to take place,
The replacement must not change the number of characters. */
void
-record_change (EMACS_INT beg, EMACS_INT length)
+record_change (ptrdiff_t beg, ptrdiff_t length)
{
- record_delete (beg, make_buffer_string (beg, beg + length, 1));
+ record_delete (beg, make_buffer_string (beg, beg + length, true), false);
record_insert (beg, length);
}
\f
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
- if (current_buffer != last_undo_buffer)
- Fundo_boundary ();
- last_undo_buffer = current_buffer;
-
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- BVAR (current_buffer, undo_list) =
- Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Fcons (Qt, Fvisited_file_modtime ()),
+ BVAR (current_buffer, undo_list)));
}
/* Record a change in property PROP (whose old value was VAL)
for LENGTH characters starting at position BEG in BUFFER. */
void
-record_property_change (EMACS_INT beg, EMACS_INT length,
+record_property_change (ptrdiff_t beg, ptrdiff_t length,
Lisp_Object prop, Lisp_Object value,
Lisp_Object buffer)
{
Lisp_Object lbeg, lend, entry;
- struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
- int boundary = 0;
+ struct buffer *buf = XBUFFER (buffer);
if (EQ (BVAR (buf, undo_list), Qt))
return;
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
- if (buf != last_undo_buffer)
- boundary = 1;
- last_undo_buffer = buf;
-
- /* Switch temporarily to the buffer that was changed. */
- current_buffer = buf;
-
- 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))));
- BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list));
-
- current_buffer = obuf;
+ bset_undo_list (current_buffer,
+ Fcons (entry, BVAR (current_buffer, undo_list)));
}
DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
/* If we have preallocated the cons cell to use here,
use that one. */
XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
- BVAR (current_buffer, undo_list) = pending_boundary;
+ bset_undo_list (current_buffer, pending_boundary);
pending_boundary = Qnil;
}
else
- BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Qnil, BVAR (current_buffer, undo_list)));
}
- last_boundary_position = PT;
- last_boundary_buffer = current_buffer;
+
+ Fset (Qundo_auto__last_boundary_cause, Qexplicit);
+ point_before_last_command_or_undo = PT;
+ buffer_before_last_command_or_undo = current_buffer;
+
return Qnil;
}
{
Lisp_Object list;
Lisp_Object prev, next, last_boundary;
- int size_so_far = 0;
+ EMACS_INT size_so_far = 0;
/* Make sure that calling undo-outer-limit-function
won't cause another GC. */
- int count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
/* Make the buffer current to get its local values of variables such
as undo_limit. Also so that Vundo_outer_limit_function can
tell which buffer to operate on. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
set_buffer_internal (b);
list = BVAR (b, undo_list);
&& !NILP (Vundo_outer_limit_function))
{
Lisp_Object tem;
- struct buffer *temp = last_undo_buffer;
/* Normally the function this calls is undo-outer-limit-truncate. */
tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
unbind_to (count, Qnil);
return;
}
- /* That function probably used the minibuffer, and if so, that
- changed last_undo_buffer. Change it back so that we don't
- force next change to make an undo boundary here. */
- last_undo_buffer = temp;
}
if (CONSP (next))
XSETCDR (last_boundary, Qnil);
/* There's nothing we decided to keep, so clear it out. */
else
- BVAR (b, undo_list) = Qnil;
+ bset_undo_list (b, Qnil);
unbind_to (count, Qnil);
}
-\f
-DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
- doc: /* Undo N records from the front of the list LIST.
-Return what remains of the list. */)
- (Lisp_Object n, Lisp_Object list)
-{
- struct gcpro gcpro1, gcpro2;
- Lisp_Object next;
- int count = SPECPDL_INDEX ();
- register int arg;
- Lisp_Object oldlist;
- int did_apply = 0;
-
-#if 0 /* This is a good feature, but would make undo-start
- unable to do what is expected. */
- Lisp_Object tem;
-
- /* If the head of the list is a boundary, it is the boundary
- preceding this command. Get rid of it and don't count it. */
- tem = Fcar (list);
- if (NILP (tem))
- list = Fcdr (list);
-#endif
- CHECK_NUMBER (n);
- arg = XINT (n);
- next = Qnil;
- GCPRO2 (next, list);
- /* I don't think we need to gcpro oldlist, as we use it only
- to check for EQ. ++kfs */
-
- /* In a writable buffer, enable undoing read-only text that is so
- because of text properties. */
- if (NILP (BVAR (current_buffer, read_only)))
- specbind (Qinhibit_read_only, Qt);
-
- /* Don't let `intangible' properties interfere with undo. */
- specbind (Qinhibit_point_motion_hooks, Qt);
-
- oldlist = BVAR (current_buffer, undo_list);
-
- while (arg > 0)
- {
- while (CONSP (list))
- {
- next = XCAR (list);
- list = XCDR (list);
- /* Exit inner loop at undo boundary. */
- if (NILP (next))
- break;
- /* 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 car, cdr;
-
- car = XCAR (next);
- cdr = XCDR (next);
- if (EQ (car, Qt))
- {
- /* Element (t high . low) records previous modtime. */
- struct buffer *base_buffer = current_buffer;
- time_t mod_time;
- CONS_TO_INTEGER (cdr, time_t, mod_time);
-
- 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 != base_buffer->modtime)
- continue;
-#ifdef CLASH_DETECTION
- Funlock_buffer ();
-#endif /* CLASH_DETECTION */
- Fset_buffer_modified_p (Qnil);
- }
- 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);
-
- 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))
- {
- /* 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");
- /* 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 (EQ (car, Qapply))
- {
- /* Element (apply FUN . ARGS) means call FUN to undo. */
- struct buffer *save_buffer = current_buffer;
-
- car = Fcar (cdr);
- cdr = Fcdr (cdr);
- if (INTEGERP (car))
- {
- /* Long format: (apply DELTA START END FUN . ARGS). */
- 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));
-
- /* Check that the function did what the entry said it
- would do. */
- 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))
- {
- /* Element (STRING . POS) means STRING was deleted. */
- Lisp_Object membuf;
- EMACS_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);
-
- /* Now that we record marker adjustments
- (caused by deletion) for undo,
- we should always insert after markers,
- so that undoing the marker adjustments
- put the markers back in the right place. */
- Finsert (1, &membuf);
- SET_PT (pos);
- }
- }
- else if (MARKERP (car) && INTEGERP (cdr))
- {
- /* (MARKER . INTEGER) means a marker MARKER
- was adjusted by INTEGER. */
- if (XMARKER (car)->buffer)
- Fset_marker (car,
- make_number (marker_position (car) - XINT (cdr)),
- Fmarker_buffer (car));
- }
- }
- }
- arg--;
- }
-
-
- /* Make sure an apply entry produces at least one undo entry,
- so the test in `undo' for continuing an undo series
- will work right. */
- if (did_apply
- && EQ (oldlist, BVAR (current_buffer, undo_list)))
- BVAR (current_buffer, undo_list)
- = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list));
-
- UNGCPRO;
- return unbind_to (count, list);
-}
\f
void
syms_of_undo (void)
{
DEFSYM (Qinhibit_read_only, "inhibit-read-only");
+ DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
+ DEFSYM (Qexplicit, "explicit");
+
+ /* Marker for function call undo list elements. */
DEFSYM (Qapply, "apply");
pending_boundary = Qnil;
staticpro (&pending_boundary);
- last_undo_buffer = NULL;
- last_boundary_buffer = NULL;
-
- defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
DEFVAR_INT ("undo-limit", undo_limit,
DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point,
doc: /* Non-nil means do not record `point' in `buffer-undo-list'. */);
- undo_inhibit_record_point = 0;
+ undo_inhibit_record_point = false;
}