* lisp/simple.el (undo-amalgamate-change-group): New function

[gnu-emacs] / lisp / simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 37f6d5000e9cf4ee109b63317bf57ab8d526e327..51c9100d2c2969c9e11959bcaa3b078d61b0ca75 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -602,7 +602,7 @@ buffer if the variable `delete-trailing-lines' is non-nil."
                    (list nil nil))))
   (save-match-data
     (save-excursion
                    (list nil nil))))
   (save-match-data
     (save-excursion

-      (let ((end-marker (copy-marker (or end (point-max)))))
+      (let ((end-marker (and end (copy-marker end))))

         (goto-char (or start (point-min)))
         (with-syntax-table (make-syntax-table (syntax-table))
           ;; Don't delete formfeeds, even if they are considered whitespace.
         (goto-char (or start (point-min)))
         (with-syntax-table (make-syntax-table (syntax-table))
           ;; Don't delete formfeeds, even if they are considered whitespace.


@@ -611,15 +611,14 @@ buffer if the variable `delete-trailing-lines' is non-nil."
           (modify-syntax-entry ?\n "_")
           (while (re-search-forward "\\s-+$" end-marker t)
             (delete-region (match-beginning 0) (match-end 0))))
           (modify-syntax-entry ?\n "_")
           (while (re-search-forward "\\s-+$" end-marker t)
             (delete-region (match-beginning 0) (match-end 0))))

-        ;; Delete trailing empty lines.
-        (goto-char end-marker)
-        (when (and (not end)
-                  delete-trailing-lines
-                   ;; Really the end of buffer.
-                  (= (point-max) (1+ (buffer-size)))
-                   (<= (skip-chars-backward "\n") -2))
-          (delete-region (1+ (point)) end-marker))
-        (set-marker end-marker nil))))
+        (if end
+            (set-marker end-marker nil)
+          ;; Delete trailing empty lines.
+          (and delete-trailing-lines
+               ;; Really the end of buffer.
+               (= (goto-char (point-max)) (1+ (buffer-size)))
+               (<= (skip-chars-backward "\n") -2)
+               (delete-region (1+ (point)) (point-max)))))))

   ;; Return nil for the benefit of `write-file-functions'.
   nil)
 
   ;; Return nil for the benefit of `write-file-functions'.
   nil)
 


@@ -2959,6 +2958,41 @@ behavior."
   (undo-auto--boundary-ensure-timer))
 ;; End auto-boundary section
 
   (undo-auto--boundary-ensure-timer))
 ;; End auto-boundary section
 

+(defun undo-amalgamate-change-group (handle)
+  "Amalgamate changes in change-group since HANDLE.
+Remove all undo boundaries between the state of HANDLE and now.
+HANDLE is as returned by `prepare-change-group'."
+  (dolist (elt handle)
+    (with-current-buffer (car elt)
+      (setq elt (cdr elt))
+      (when (consp buffer-undo-list)
+        (let ((old-car (car-safe elt))
+              (old-cdr (cdr-safe elt)))
+          (unwind-protect
+              (progn
+                ;; Temporarily truncate the undo log at ELT.
+                (when (consp elt)
+                  (setcar elt t) (setcdr elt nil))
+                (when
+                    (or (null elt)        ;The undo-log was empty.
+                        ;; `elt' is still in the log: normal case.
+                        (eq elt (last buffer-undo-list))
+                        ;; `elt' is not in the log any more, but that's because
+                        ;; the log is "all new", so we should remove all
+                        ;; boundaries from it.
+                        (not (eq (last buffer-undo-list) (last old-cdr))))
+                  (cl-callf (lambda (x) (delq nil x))
+                      (if (car buffer-undo-list)
+                          buffer-undo-list
+                        ;; Preserve the undo-boundaries at either ends of the
+                        ;; change-groups.
+                        (cdr buffer-undo-list)))))
+            ;; Reset the modified cons cell ELT to its original content.
+            (when (consp elt)
+              (setcar elt old-car)
+              (setcdr elt old-cdr))))))))
+
+

 (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
 (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


@@ -3236,11 +3270,11 @@ Noninteractive callers can specify coding systems by binding
 
 The optional second argument OUTPUT-BUFFER, if non-nil,
 says to put the output in some other buffer.
 
 The optional second argument OUTPUT-BUFFER, if non-nil,
 says to put the output in some other buffer.

-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in current buffer.  (This cannot be done asynchronously.)
-In either case, the buffer is first erased, and the output is
-inserted after point (leaving mark after it).
+If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer
+and insert the output there.
+If OUTPUT-BUFFER is not a buffer and not nil, insert the output
+in current buffer after point leaving mark after it.
+This cannot be done asynchronously.

 
 If the command terminates without error, but generates output,
 and you did not specify \"insert it in the current buffer\",
 
 If the command terminates without error, but generates output,
 and you did not specify \"insert it in the current buffer\",


@@ -3329,6 +3363,8 @@ the use of a shell (with its need to quote arguments)."
                                     (current-buffer)))))
        ;; Output goes in a separate buffer.
        ;; Preserve the match data in case called from a program.
                                     (current-buffer)))))
        ;; Output goes in a separate buffer.
        ;; Preserve the match data in case called from a program.

+        ;; FIXME: It'd be ridiculous for an Elisp function to call
+        ;; shell-command and assume that it won't mess the match-data!

        (save-match-data
          (if (string-match "[ \t]*&[ \t]*\\'" command)
              ;; Command ending with ampersand means asynchronous.
        (save-match-data
          (if (string-match "[ \t]*&[ \t]*\\'" command)
              ;; Command ending with ampersand means asynchronous.


@@ -3505,10 +3541,10 @@ Command Output*' is deleted.
 
 Optional fourth arg OUTPUT-BUFFER specifies where to put the
 command's output.  If the value is a buffer or buffer name,
 
 Optional fourth arg OUTPUT-BUFFER specifies where to put the
 command's output.  If the value is a buffer or buffer name,

-put the output there.  If the value is nil, use the buffer
-`*Shell Command Output*'.  Any other value, excluding nil,
-means to insert the output in the current buffer.  In either case,
-the output is inserted after point (leaving mark after it).
+erase that buffer and insert the output there.
+If the value is nil, use the buffer `*Shell Command Output*'.
+Any other non-nil value means to insert the output in the
+current buffer after START.

 
 Optional fifth arg REPLACE, if non-nil, means to insert the
 output in place of text from START to END, putting point and mark
 
 Optional fifth arg REPLACE, if non-nil, means to insert the
 output in place of text from START to END, putting point and mark