From 44dfa86b7d382b84564d68472da1448d08f48129 Mon Sep 17 00:00:00 2001 From: Phillip Lord Date: Thu, 6 Aug 2015 21:33:58 +0100 Subject: [PATCH] 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. --- lisp/simple.el | 137 +++++++++++++++++++++++++++++++++++++++++++++++++ src/cmds.c | 41 +++------------ src/keyboard.c | 17 +++--- src/lisp.h | 1 - src/undo.c | 51 ++++++------------ 5 files changed, 167 insertions(+), 80 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 00c25db07d7..821c7665c6c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2754,6 +2754,143 @@ with < or <= based on USE-<." '(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 "If non-nil ask about discarding undo info for the current command. Normally, Emacs discards the undo info for the current command if diff --git a/src/cmds.c b/src/cmds.c index a975a8ed4e0..6f19a046893 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -220,36 +220,6 @@ to t. */) 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", doc: /* Delete the following N characters (previous if N is negative). 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'. */) CHECK_NUMBER (n); if (abs (XINT (n)) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); pos = PT + XINT (n); if (NILP (killflag)) @@ -311,7 +281,7 @@ At the end, it runs `post-self-insert-hook'. */) error ("Negative repetition argument %"pI"d", XFASTINT (n)); if (XFASTINT (n) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) @@ -321,7 +291,7 @@ At the end, it runs `post-self-insert-hook'. */) XINT (last_command_event)); int val = internal_self_insert (character, XFASTINT (n)); if (val == 2) - nonundocount = 0; + Fset (Qundo_auto__this_command_amalgamating, Qnil); frame_make_pointer_invisible (SELECTED_FRAME ()); } @@ -526,6 +496,10 @@ internal_self_insert (int c, EMACS_INT n) 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"); /* A possible value for a buffer's overwrite-mode variable. */ @@ -555,7 +529,6 @@ keys_of_cmds (void) { int n; - nonundocount = 0; initial_define_key (global_map, Ctl ('I'), "self-insert-command"); for (n = 040; n < 0177; n++) initial_define_key (global_map, n, "self-insert-command"); diff --git a/src/keyboard.c b/src/keyboard.c index 5f8667586c4..1f08e1f23ed 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1278,9 +1278,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, bool, bool, bool, 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 a new set-selection, which will then dispatch to x-set-selection, or tty-set-selection, or w32-set-selection, ... */ @@ -1505,14 +1502,10 @@ command_loop_1 (void) } #endif - if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ - { - Lisp_Object undo = BVAR (current_buffer, undo_list); - Fundo_boundary (); - last_undo_boundary - = (EQ (undo, BVAR (current_buffer, undo_list)) - ? Qnil : BVAR (current_buffer, undo_list)); - } + /* Ensure that we have added appropriate undo-boundaries as a + result of changes from the last command. */ + call0 (Qundo_auto__add_boundary); + call1 (Qcommand_execute, Vthis_command); #ifdef HAVE_WINDOW_SYSTEM @@ -11095,6 +11088,8 @@ syms_of_keyboard (void) DEFSYM (Qpre_command_hook, "pre-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 (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); diff --git a/src/lisp.h b/src/lisp.h index 02109d72174..aaf52bdd1be 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4174,7 +4174,6 @@ extern void syms_of_casetab (void); extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); -extern Lisp_Object last_undo_boundary; extern bool input_pending; #ifdef HAVE_STACK_OVERFLOW_HANDLING extern sigjmp_buf return_to_command_loop; diff --git a/src/undo.c b/src/undo.c index 750bc8afff2..364b37eeeb4 100644 --- a/src/undo.c +++ b/src/undo.c @@ -26,10 +26,6 @@ along with GNU Emacs. If not, see . */ #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 ptrdiff_t last_boundary_position; @@ -41,6 +37,12 @@ static ptrdiff_t last_boundary_position; an undo-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) and prepare the undo info for recording a change. PT is the position of point that will naturally occur as a result of the @@ -59,15 +61,7 @@ record_point (ptrdiff_t pt) 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; + run_undoable_change (); at_boundary = ! CONSP (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) if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (current_buffer != last_undo_buffer) - Fundo_boundary (); - last_undo_buffer = current_buffer; + run_undoable_change (); for (m = BUF_MARKERS (current_buffer); m; m = m->next) { @@ -228,10 +220,6 @@ record_first_change (void) 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; @@ -259,15 +247,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (buf != last_undo_buffer) - boundary = true; - last_undo_buffer = buf; - /* Switch temporarily to the buffer that was changed. */ - current_buffer = buf; + set_buffer_internal (buf); - if (boundary) - Fundo_boundary (); + run_undoable_change (); if (MODIFF <= SAVE_MODIFF) record_first_change (); @@ -278,7 +261,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, bset_undo_list (current_buffer, 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, @@ -308,6 +292,8 @@ but another undo command will undo to the previous boundary. */) } last_boundary_position = PT; last_boundary_buffer = current_buffer; + + Fset (Qundo_auto__last_boundary_cause, Qexplicit); return Qnil; } @@ -383,7 +369,6 @@ truncate_undo_list (struct buffer *b) && !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)); @@ -394,10 +379,6 @@ truncate_undo_list (struct buffer *b) 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)) @@ -455,6 +436,9 @@ void syms_of_undo (void) { 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. */ DEFSYM (Qapply, "apply"); @@ -462,7 +446,6 @@ syms_of_undo (void) pending_boundary = Qnil; staticpro (&pending_boundary); - last_undo_buffer = NULL; last_boundary_buffer = NULL; defsubr (&Sundo_boundary); -- 2.39.2