diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/simple.el | 137 |
1 files changed, 137 insertions, 0 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 |