Commit 44dfa86b authored by Phillip Lord's avatar Phillip Lord Committed by Phillip Lord

The heuristic that Emacs uses to add an `undo-boundary' has been

reworked, as it interacts poorly with functions on `post-command-hook'
or `after-change-functions'.

* lisp/simple.el: New section added.
* src/cmds.c (remove_excessive_undo_boundaries): Now in lisp.
(self_insert_command): Calls simple.el to amalgamate.
(delete_char): Calls simple.el to amalgamate.
* src/keyboard.c (last_undo_boundary): Removed.
* src/undo.c (run_undoable_change): New function.
parent 0aec2aac
...@@ -2754,6 +2754,143 @@ with < or <= based on USE-<." ...@@ -2754,6 +2754,143 @@ with < or <= based on USE-<."
'(0 . 0))) '(0 . 0)))
'(0 . 0))) '(0 . 0)))
;;; Default undo-boundary addition
;;
;; This section adds a new undo-boundary at either after a command is
;; called or in some cases on a timer called after a change is made in
;; any buffer.
(defvar-local undo-auto--last-boundary-cause nil
"Describe the cause of the last undo-boundary.
If `explicit', the last boundary was caused by an explicit call to
`undo-boundary', that is one not called by the code in this
section.
If it is equal to `timer', then the last boundary was inserted
by `undo-auto--boundary-timer'.
If it is equal to `command', then the last boundary was inserted
automatically after a command, that is by the code defined in
this section.
If it is equal to a list, then the last boundary was inserted by
an amalgamating command. The car of the list is the number of
times an amalgamating command has been called, and the cdr are the
buffers that were changed during the last command.")
(defvar undo-auto--current-boundary-timer nil
"Current timer which will run `undo-auto--boundary-timer' or nil.
If set to non-nil, this will effectively disable the timer.")
(defvar undo-auto--this-command-amalgamating nil
"Non-nil if `this-command' should be amalgamated.
This variable is set to nil by `undo-auto--boundaries' and is set
by `undo-auto--amalgamate'." )
(defun undo-auto--needs-boundary-p ()
"Return non-nil if `buffer-undo-list' needs a boundary at the start."
(car-safe buffer-undo-list))
(defun undo-auto--last-boundary-amalgamating-number ()
"Return the number of amalgamating last commands or nil.
Amalgamating commands are, by default, either
`self-insert-command' and `delete-char', but can be any command
that calls `undo-auto--amalgamate'."
(car-safe undo-auto--last-boundary-cause))
(defun undo-auto--ensure-boundary (cause)
"Add an `undo-boundary' to the current buffer if needed.
REASON describes the reason that the boundary is being added; see
`undo-auto--last-boundary' for more information."
(when (and
(undo-auto--needs-boundary-p))
(let ((last-amalgamating
(undo-auto--last-boundary-amalgamating-number)))
(undo-boundary)
(setq undo-auto--last-boundary-cause
(if (eq 'amalgamate cause)
(cons
(if last-amalgamating (1+ last-amalgamating) 0)
undo-auto--undoably-changed-buffers)
cause)))))
(defun undo-auto--boundaries (cause)
"Check recently changed buffers and add a boundary if necessary.
REASON describes the reason that the boundary is being added; see
`undo-last-boundary' for more information."
(dolist (b undo-auto--undoably-changed-buffers)
(when (buffer-live-p b)
(with-current-buffer b
(undo-auto--ensure-boundary cause))))
(setq undo-auto--undoably-changed-buffers nil))
(defun undo-auto--boundary-timer ()
"Timer which will run `undo--auto-boundary-timer'."
(setq undo-auto--current-boundary-timer nil)
(undo-auto--boundaries 'timer))
(defun undo-auto--boundary-ensure-timer ()
"Ensure that the `undo-auto-boundary-timer' is set."
(unless undo-auto--current-boundary-timer
(setq undo-auto--current-boundary-timer
(run-at-time 10 nil #'undo-auto--boundary-timer))))
(defvar undo-auto--undoably-changed-buffers nil
"List of buffers that have changed recently.
This list is maintained by `undo-auto--undoable-change' and
`undo-auto--boundaries' and can be affected by changes to their
default values.
See also `undo-auto--buffer-undoably-changed'.")
(defun undo-auto--add-boundary ()
"Add an `undo-boundary' in appropriate buffers."
(undo-auto--boundaries
(if undo-auto--this-command-amalgamating
'amalgamate
'command))
(setq undo-auto--this-command-amalgamating nil))
(defun undo-auto--amalgamate ()
"Amalgamate undo if necessary.
This function can be called after an amalgamating command. It
removes the previous `undo-boundary' if a series of such calls
have been made. By default `self-insert-command' and
`delete-char' are the only amalgamating commands, although this
function could be called by any command wishing to have this
behaviour."
(let ((last-amalgamating-count
(undo-auto--last-boundary-amalgamating-number)))
(setq undo-auto--this-command-amalgamating t)
(when
last-amalgamating-count
(if
(and
(< last-amalgamating-count 20)
(eq this-command last-command))
;; Amalgamate all buffers that have changed.
(dolist (b (cdr undo-auto--last-boundary-cause))
(when (buffer-live-p b)
(with-current-buffer
b
(when
;; The head of `buffer-undo-list' is nil.
;; `car-safe' doesn't work because
;; `buffer-undo-list' need not be a list!
(and (listp buffer-undo-list)
(not (car buffer-undo-list)))
(setq buffer-undo-list
(cdr buffer-undo-list))))))
(setq undo-auto--last-boundary-cause 0)))))
(defun undo-auto--undoable-change ()
"Called after every undoable buffer change."
(add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))
(undo-auto--boundary-ensure-timer))
;; End auto-boundary section
(defcustom undo-ask-before-discard nil (defcustom undo-ask-before-discard nil
"If non-nil ask about discarding undo info for the current command. "If non-nil ask about discarding undo info for the current command.
Normally, Emacs discards the undo info for the current command if Normally, Emacs discards the undo info for the current command if
......
...@@ -220,36 +220,6 @@ to t. */) ...@@ -220,36 +220,6 @@ to t. */)
return Qnil; return Qnil;
} }
static int nonundocount;
static void
remove_excessive_undo_boundaries (void)
{
bool remove_boundary = true;
if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
nonundocount = 0;
if (NILP (Vexecuting_kbd_macro))
{
if (nonundocount <= 0 || nonundocount >= 20)
{
remove_boundary = false;
nonundocount = 0;
}
nonundocount++;
}
if (remove_boundary
&& CONSP (BVAR (current_buffer, undo_list))
&& NILP (XCAR (BVAR (current_buffer, undo_list)))
/* Only remove auto-added boundaries, not boundaries
added by explicit calls to undo-boundary. */
&& EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
/* Remove the undo_boundary that was just pushed. */
bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
}
DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP", DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
doc: /* Delete the following N characters (previous if N is negative). doc: /* Delete the following N characters (previous if N is negative).
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
...@@ -265,7 +235,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) ...@@ -265,7 +235,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */)
CHECK_NUMBER (n); CHECK_NUMBER (n);
if (abs (XINT (n)) < 2) if (abs (XINT (n)) < 2)
remove_excessive_undo_boundaries (); call0 (Qundo_auto__amalgamate);
pos = PT + XINT (n); pos = PT + XINT (n);
if (NILP (killflag)) if (NILP (killflag))
...@@ -311,7 +281,7 @@ At the end, it runs `post-self-insert-hook'. */) ...@@ -311,7 +281,7 @@ At the end, it runs `post-self-insert-hook'. */)
error ("Negative repetition argument %"pI"d", XFASTINT (n)); error ("Negative repetition argument %"pI"d", XFASTINT (n));
if (XFASTINT (n) < 2) if (XFASTINT (n) < 2)
remove_excessive_undo_boundaries (); call0 (Qundo_auto__amalgamate);
/* Barf if the key that invoked this was not a character. */ /* Barf if the key that invoked this was not a character. */
if (!CHARACTERP (last_command_event)) if (!CHARACTERP (last_command_event))
...@@ -321,7 +291,7 @@ At the end, it runs `post-self-insert-hook'. */) ...@@ -321,7 +291,7 @@ At the end, it runs `post-self-insert-hook'. */)
XINT (last_command_event)); XINT (last_command_event));
int val = internal_self_insert (character, XFASTINT (n)); int val = internal_self_insert (character, XFASTINT (n));
if (val == 2) if (val == 2)
nonundocount = 0; Fset (Qundo_auto__this_command_amalgamating, Qnil);
frame_make_pointer_invisible (SELECTED_FRAME ()); frame_make_pointer_invisible (SELECTED_FRAME ());
} }
...@@ -526,6 +496,10 @@ internal_self_insert (int c, EMACS_INT n) ...@@ -526,6 +496,10 @@ internal_self_insert (int c, EMACS_INT n)
void void
syms_of_cmds (void) syms_of_cmds (void)
{ {
DEFSYM (Qundo_auto__amalgamate, "undo-auto--amalgamate");
DEFSYM (Qundo_auto__this_command_amalgamating,
"undo-auto--this-command-amalgamating");
DEFSYM (Qkill_forward_chars, "kill-forward-chars"); DEFSYM (Qkill_forward_chars, "kill-forward-chars");
/* A possible value for a buffer's overwrite-mode variable. */ /* A possible value for a buffer's overwrite-mode variable. */
...@@ -555,7 +529,6 @@ keys_of_cmds (void) ...@@ -555,7 +529,6 @@ keys_of_cmds (void)
{ {
int n; int n;
nonundocount = 0;
initial_define_key (global_map, Ctl ('I'), "self-insert-command"); initial_define_key (global_map, Ctl ('I'), "self-insert-command");
for (n = 040; n < 0177; n++) for (n = 040; n < 0177; n++)
initial_define_key (global_map, n, "self-insert-command"); initial_define_key (global_map, n, "self-insert-command");
......
...@@ -1278,9 +1278,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, ...@@ -1278,9 +1278,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
bool, bool, bool, bool); bool, bool, bool, bool);
static void adjust_point_for_property (ptrdiff_t, bool); static void adjust_point_for_property (ptrdiff_t, bool);
/* The last boundary auto-added to buffer-undo-list. */
Lisp_Object last_undo_boundary;
/* FIXME: This is wrong rather than test window-system, we should call /* FIXME: This is wrong rather than test window-system, we should call
a new set-selection, which will then dispatch to x-set-selection, or a new set-selection, which will then dispatch to x-set-selection, or
tty-set-selection, or w32-set-selection, ... */ tty-set-selection, or w32-set-selection, ... */
...@@ -1505,14 +1502,10 @@ command_loop_1 (void) ...@@ -1505,14 +1502,10 @@ command_loop_1 (void)
} }
#endif #endif
if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ /* Ensure that we have added appropriate undo-boundaries as a
{ result of changes from the last command. */
Lisp_Object undo = BVAR (current_buffer, undo_list); call0 (Qundo_auto__add_boundary);
Fundo_boundary ();
last_undo_boundary
= (EQ (undo, BVAR (current_buffer, undo_list))
? Qnil : BVAR (current_buffer, undo_list));
}
call1 (Qcommand_execute, Vthis_command); call1 (Qcommand_execute, Vthis_command);
#ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_WINDOW_SYSTEM
...@@ -11095,6 +11088,8 @@ syms_of_keyboard (void) ...@@ -11095,6 +11088,8 @@ syms_of_keyboard (void)
DEFSYM (Qpre_command_hook, "pre-command-hook"); DEFSYM (Qpre_command_hook, "pre-command-hook");
DEFSYM (Qpost_command_hook, "post-command-hook"); DEFSYM (Qpost_command_hook, "post-command-hook");
DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary");
DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdeferred_action_function, "deferred-action-function");
DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
DEFSYM (Qfunction_key, "function-key"); DEFSYM (Qfunction_key, "function-key");
......
...@@ -4174,7 +4174,6 @@ extern void syms_of_casetab (void); ...@@ -4174,7 +4174,6 @@ extern void syms_of_casetab (void);
extern Lisp_Object echo_message_buffer; extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard; extern struct kboard *echo_kboard;
extern void cancel_echoing (void); extern void cancel_echoing (void);
extern Lisp_Object last_undo_boundary;
extern bool input_pending; extern bool input_pending;
#ifdef HAVE_STACK_OVERFLOW_HANDLING #ifdef HAVE_STACK_OVERFLOW_HANDLING
extern sigjmp_buf return_to_command_loop; extern sigjmp_buf return_to_command_loop;
......
...@@ -26,10 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ ...@@ -26,10 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "commands.h" #include "commands.h"
#include "window.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. */ /* Position of point last time we inserted a boundary. */
static struct buffer *last_boundary_buffer; static struct buffer *last_boundary_buffer;
static ptrdiff_t last_boundary_position; static ptrdiff_t last_boundary_position;
...@@ -41,6 +37,12 @@ static ptrdiff_t last_boundary_position; ...@@ -41,6 +37,12 @@ static ptrdiff_t last_boundary_position;
an undo-boundary. */ an undo-boundary. */
static Lisp_Object pending_boundary; static Lisp_Object pending_boundary;
void
run_undoable_change ()
{
call0 (Qundo_auto__undoable_change);
}
/* Record point as it was at beginning of this command (if necessary) /* Record point as it was at beginning of this command (if necessary)
and prepare the undo info for recording a change. and prepare the undo info for recording a change.
PT is the position of point that will naturally occur as a result of the PT is the position of point that will naturally occur as a result of the
...@@ -59,15 +61,7 @@ record_point (ptrdiff_t pt) ...@@ -59,15 +61,7 @@ record_point (ptrdiff_t pt)
if (NILP (pending_boundary)) if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil); pending_boundary = Fcons (Qnil, Qnil);
if ((current_buffer != last_undo_buffer) run_undoable_change ();
/* 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;
at_boundary = ! CONSP (BVAR (current_buffer, undo_list)) at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
|| NILP (XCAR (BVAR (current_buffer, undo_list))); || NILP (XCAR (BVAR (current_buffer, undo_list)));
...@@ -139,9 +133,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) ...@@ -139,9 +133,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
if (NILP (pending_boundary)) if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil); pending_boundary = Fcons (Qnil, Qnil);
if (current_buffer != last_undo_buffer) run_undoable_change ();
Fundo_boundary ();
last_undo_buffer = current_buffer;
for (m = BUF_MARKERS (current_buffer); m; m = m->next) for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{ {
...@@ -228,10 +220,6 @@ record_first_change (void) ...@@ -228,10 +220,6 @@ record_first_change (void)
if (EQ (BVAR (current_buffer, undo_list), Qt)) if (EQ (BVAR (current_buffer, undo_list), Qt))
return; return;
if (current_buffer != last_undo_buffer)
Fundo_boundary ();
last_undo_buffer = current_buffer;
if (base_buffer->base_buffer) if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer; base_buffer = base_buffer->base_buffer;
...@@ -259,15 +247,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, ...@@ -259,15 +247,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
if (NILP (pending_boundary)) if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil); pending_boundary = Fcons (Qnil, Qnil);
if (buf != last_undo_buffer)
boundary = true;
last_undo_buffer = buf;
/* Switch temporarily to the buffer that was changed. */ /* Switch temporarily to the buffer that was changed. */
current_buffer = buf; set_buffer_internal (buf);
if (boundary) run_undoable_change ();
Fundo_boundary ();
if (MODIFF <= SAVE_MODIFF) if (MODIFF <= SAVE_MODIFF)
record_first_change (); record_first_change ();
...@@ -278,7 +261,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, ...@@ -278,7 +261,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
bset_undo_list (current_buffer, bset_undo_list (current_buffer,
Fcons (entry, BVAR (current_buffer, undo_list))); Fcons (entry, BVAR (current_buffer, undo_list)));
current_buffer = obuf; /* Reset the buffer */
set_buffer_internal (obuf);
} }
DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
...@@ -308,6 +292,8 @@ but another undo command will undo to the previous boundary. */) ...@@ -308,6 +292,8 @@ but another undo command will undo to the previous boundary. */)
} }
last_boundary_position = PT; last_boundary_position = PT;
last_boundary_buffer = current_buffer; last_boundary_buffer = current_buffer;
Fset (Qundo_auto__last_boundary_cause, Qexplicit);
return Qnil; return Qnil;
} }
...@@ -383,7 +369,6 @@ truncate_undo_list (struct buffer *b) ...@@ -383,7 +369,6 @@ truncate_undo_list (struct buffer *b)
&& !NILP (Vundo_outer_limit_function)) && !NILP (Vundo_outer_limit_function))
{ {
Lisp_Object tem; Lisp_Object tem;
struct buffer *temp = last_undo_buffer;
/* Normally the function this calls is undo-outer-limit-truncate. */ /* Normally the function this calls is undo-outer-limit-truncate. */
tem = call1 (Vundo_outer_limit_function, make_number (size_so_far)); tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
...@@ -394,10 +379,6 @@ truncate_undo_list (struct buffer *b) ...@@ -394,10 +379,6 @@ truncate_undo_list (struct buffer *b)
unbind_to (count, Qnil); unbind_to (count, Qnil);
return; 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)) if (CONSP (next))
...@@ -455,6 +436,9 @@ void ...@@ -455,6 +436,9 @@ void
syms_of_undo (void) syms_of_undo (void)
{ {
DEFSYM (Qinhibit_read_only, "inhibit-read-only"); DEFSYM (Qinhibit_read_only, "inhibit-read-only");
DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
DEFSYM (Qexplicit, "explicit");
/* Marker for function call undo list elements. */ /* Marker for function call undo list elements. */
DEFSYM (Qapply, "apply"); DEFSYM (Qapply, "apply");
...@@ -462,7 +446,6 @@ syms_of_undo (void) ...@@ -462,7 +446,6 @@ syms_of_undo (void)
pending_boundary = Qnil; pending_boundary = Qnil;
staticpro (&pending_boundary); staticpro (&pending_boundary);
last_undo_buffer = NULL;
last_boundary_buffer = NULL; last_boundary_buffer = NULL;
defsubr (&Sundo_boundary); defsubr (&Sundo_boundary);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment