'(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
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).
CHECK_NUMBER (n);
if (abs (XINT (n)) < 2)
- remove_excessive_undo_boundaries ();
+ call0 (Qundo_auto__amalgamate);
pos = PT + XINT (n);
if (NILP (killflag))
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))
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 ());
}
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. */
{
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");
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, ... */
}
#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
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");
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;
#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;
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
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)));
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)
{
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;
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 ();
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,
}
last_boundary_position = PT;
last_boundary_buffer = current_buffer;
+
+ Fset (Qundo_auto__last_boundary_cause, Qexplicit);
return Qnil;
}
&& !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))
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");
pending_boundary = Qnil;
staticpro (&pending_boundary);
- last_undo_buffer = NULL;
last_boundary_buffer = NULL;
defsubr (&Sundo_boundary);
projects / emacs.git / commitdiff