Change groups

[Richard Stallman]

Here is an interesting new feature that I just implemented.
I started from undo-get-status which Stefan wrote,
and made it clean, reliable, convenient and more powerful.
I plan to check it in in a couple of days when I am in
a more convenient place.


(defmacro with-change-group (&rest body)
  "Perform BODY as an atomic change group.
This means that if BODY exits abnormally,
all of its changes to the current buffer are undone.
This works regadless of whether undo is enabled in the buffer.

This mechanism is transparent to ordinary use of undo;
if undo is enabled in the buffer and BODY succeeds, the
user can undo the change normally."
  (let ((handle (make-symbol "--change-group-handle--"))
        (success (make-symbol "--change-group-success--")))
    `(let ((,handle (prepare-change-group))
           (,success nil))
       (unwind-protect
           (progn
             ;; This is inside the unwind-protect because
             ;; it enables undo if that was disabled; we need
             ;; to make sure that it gets disabled again.
             (activate-change-group ,handle)
             ,@body
             (setq ,success t))
         ;; Either of these functions will disable undo
         ;; if it was disabled before.
         (if ,success
             (accept-change-group ,handle)
           (cancel-change-group ,handle))))))

(defun prepare-change-group (&optional buffer)
  "Return a handle for the current buffer's state, for a change group.
If you specify BUFFER, make a handle for BUFFER's state instead.

Pass the handle to `activate-change-group' afterward to initiate
the actual changes of the change group.

To finish the change group, call either `accept-change-group' or
`cancel-change-group' passing the same handle as argument.  Call
`accept-change-group' to accept the changes in the group as final;
call `cancel-change-group' to undo them all.  You should use
`unwind-protect' to make sure the group is always finished.  The call
to `activate-change-group' should be inside the `unwind-protect'.
Once you finish the group, don't use the handle again--don't try to
finish the same group twice.  For a simple example of correct use, see
the source code of `with-change-group'.

The handle records only the specified buffer.  To make a multibuffer
change group, call this function once for each buffer you want to
cover, then use `nconc' to combine the returned values, like this:

  (nconc (prepare-change-group buffer-1)
         (prepare-change-group buffer-2))

You can then activate that multibuffer change group with a single
call to `activate-change-group' and finish it with a single call
to `accept-change-group' or `cancel-change-group'."

  (list (cons (current-buffer) buffer-undo-list)))

(defun activate-change-group (handle)
  "Activate a change group made with `prepare-change-group' (which see)."
  (dolist (elt handle)
    (with-current-buffer (car elt)
      (if (eq buffer-undo-list t)
          (setq buffer-undo-list nil)))))

(defun accept-change-group (handle)
  "Finish a change group made with `prepare-change-group' (which see).
This finishes the change group by accepting its changes as final."
  (dolist (elt handle)
    (with-current-buffer (car elt)
      (if (eq elt t)
          (setq buffer-undo-list t)))))

(defun cancel-change-group (handle)
  "Finish a change group made with `prepare-change-group' (which see).
This finishes the change group by reverting all of its changes."
  (dolist (elt handle)
    (with-current-buffer (car elt)
      (setq elt (cdr elt))
      (let ((old-car 
             (if (consp elt) (car elt)))
            (old-cdr
             (if (consp elt) (cdr elt))))
        ;; Temporarily truncate the undo log at ELT.
        (when (consp elt)
          (setcar elt nil) (setcdr elt nil))
        (unless (eq last-command 'undo) (undo-start))
        ;; Make sure there's no confusion.
        (when (and (consp elt) (not (eq elt (last pending-undo-list))))
          (error "Undoing to some unrelated state"))
        ;; Undo it all.
        (while pending-undo-list (undo-more 1))
        ;; Reset the modified cons cell ELT to its original content.
        (when (consp elt)
          (setcar elt old-car)
          (setcdr elt old-cdr))
        ;; Revert the undo info to what it was when we grabbed the state.
        (setq buffer-undo-list elt)))))