17

I'm working on an Emacs mode that lets you control Emacs with speech recognition. One of the problems I've ran into is that the way Emacs handles undo doesn't match how you would expect it to work when controlling by voice.

When the user speaks several words and then pauses, that's called an 'utterance.' An utterance may consist of multiple commands for Emacs to execute. It's often the case that the recognizer recognizes one or more commands within an utterance incorrectly. At that point I want to be able to say "undo" and have Emacs undo all actions done by the utterance, not just the last action within the utterance. In other words, I want Emacs to treat an utterance as a single command as far as undo is concerned, even when an utterance consists of multiple commands. I'd also like point to go back to exactly where it was before the utterance, I've noticed normal Emacs undo doesn't do this.

I have setup Emacs to get callbacks at the beginning and end of each utterance, so I can detect the situation, I just need to figure out what to have Emacs do. Ideally I'd call something like (undo-start-collapsing) and then (undo-stop-collapsing) and anything done inbetween would be magically collapsed into one record.

I did some trawling through the documentation and found undo-boundary, but it's the opposite of what I want -- I need to collapse all the actions within an utterance into one undo record, not split them up. I can use undo-boundary between utterances to make sure insertions are considered separate (Emacs by default considers consecutive insert actions to be one action up to some limit), but that's it.

Other complications:

  • My speech recognition daemon sends some commands to Emacs by simulating X11 keypresses and sends some via emacsclient -e so, if there were say an (undo-collapse &rest ACTIONS) there's no central place I can wrap.
  • I use undo-tree, not sure if this makes things more complicated. Ideally a solution would work with undo-tree and Emacs' normal undo behavior.
  • What if one of the commands within an utterance is "undo" or "redo"? I'm thinking I could change the callback logic to always send these to Emacs as distinct utterances to keep things simpler, then it should be handled just like it would if I were using the keyboard.
  • Stretch goal: An utterance may contain a command that switches the currently active window or buffer. In this case it's fine to have to say "undo" once separately in each buffer, I don't need it to be that fancy. But all the commands in a single buffer should still be grouped, so if I say "do-x do-y do-z switch-buffer do-a do-b do-c" then x,y,z should be one undo record in the original buffer and a,b,c should be one record in the switched to buffer.

Is there an easy way to do this? AFAICT there is nothing built-in but Emacs is vast and deep...

Update: I ended up using jhc's solution below with a little extra code. In the global before-change-hook I check if the buffer being changed is in a global list of buffers modified this utterance, if not it goes into the list and undo-collapse-begin is called. Then at the end of the utterance I iterate all the buffers in the list and call undo-collapse-end. Code below (md- added before function names for namespacing purposes):

(defvar md-utterance-changed-buffers nil)
(defvar-local md-collapse-undo-marker nil)

(defun md-undo-collapse-begin (marker)
  "Mark the beginning of a collapsible undo block.
This must be followed with a call to undo-collapse-end with a marker
eq to this one.

Taken from jch's stackoverflow answer here:
http://emacs.stackexchange.com/a/7560/2301
"
  (push marker buffer-undo-list))

(defun md-undo-collapse-end (marker)
  "Collapse undo history until a matching marker.

Taken from jch's stackoverflow answer here:
http://emacs.stackexchange.com/a/7560/2301"
  (cond
    ((eq (car buffer-undo-list) marker)
     (setq buffer-undo-list (cdr buffer-undo-list)))
    (t
     (let ((l buffer-undo-list))
       (while (not (eq (cadr l) marker))
         (cond
           ((null (cdr l))
            (error "md-undo-collapse-end with no matching marker"))
           ((eq (cadr l) nil)
            (setf (cdr l) (cddr l)))
           (t (setq l (cdr l)))))
       ;; remove the marker
       (setf (cdr l) (cddr l))))))

(defmacro md-with-undo-collapse (&rest body)
  "Execute body, then collapse any resulting undo boundaries.

Taken from jch's stackoverflow answer here:
http://emacs.stackexchange.com/a/7560/2301"
  (declare (indent 0))
  (let ((marker (list 'apply 'identity nil)) ; build a fresh list
        (buffer-var (make-symbol "buffer")))
    `(let ((,buffer-var (current-buffer)))
       (unwind-protect
           (progn
             (md-undo-collapse-begin ',marker)
             ,@body)
         (with-current-buffer ,buffer-var
           (md-undo-collapse-end ',marker))))))

(defun md-check-undo-before-change (beg end)
  "When a modification is detected, we push the current buffer
onto a list of buffers modified this utterance."
  (unless (or
           ;; undo itself causes buffer modifications, we
           ;; don't want to trigger on those
           undo-in-progress
           ;; we only collapse utterances, not general actions
           (not md-in-utterance)
           ;; ignore undo disabled buffers
           (eq buffer-undo-list t)
           ;; ignore read only buffers
           buffer-read-only
           ;; ignore buffers we already marked
           (memq (current-buffer) md-utterance-changed-buffers)
           ;; ignore buffers that have been killed
           (not (buffer-name)))
    (push (current-buffer) md-utterance-changed-buffers)
    (setq md-collapse-undo-marker (list 'apply 'identity nil))
    (undo-boundary)
    (md-undo-collapse-begin md-collapse-undo-marker)))

(defun md-pre-utterance-undo-setup ()
  (setq md-utterance-changed-buffers nil)
  (setq md-collapse-undo-marker nil))

(defun md-post-utterance-collapse-undo ()
  (unwind-protect
      (dolist (i md-utterance-changed-buffers)
        ;; killed buffers have a name of nil, no point
        ;; in undoing those
        (when (buffer-name i)
          (with-current-buffer i
            (condition-case nil
                (md-undo-collapse-end md-collapse-undo-marker)
              (error (message "Couldn't undo in buffer %S" i))))))
    (setq md-utterance-changed-buffers nil)
    (setq md-collapse-undo-marker nil)))

(defun md-force-collapse-undo ()
  "Forces undo history to collapse, we invoke when the user is
trying to do an undo command so the undo itself is not collapsed."
  (when (memq (current-buffer) md-utterance-changed-buffers)
    (md-undo-collapse-end md-collapse-undo-marker)
    (setq md-utterance-changed-buffers (delq (current-buffer) md-utterance-changed-buffers))))

(defun md-resume-collapse-after-undo ()
  "After the 'undo' part of the utterance has passed, we still want to
collapse anything that comes after."
  (when md-in-utterance
    (md-check-undo-before-change nil nil)))

(defun md-enable-utterance-undo ()
  (setq md-utterance-changed-buffers nil)
  (when (featurep 'undo-tree)
    (advice-add #'md-force-collapse-undo :before #'undo-tree-undo)
    (advice-add #'md-resume-collapse-after-undo :after #'undo-tree-undo)
    (advice-add #'md-force-collapse-undo :before #'undo-tree-redo)
    (advice-add #'md-resume-collapse-after-undo :after #'undo-tree-redo))
  (advice-add #'md-force-collapse-undo :before #'undo)
  (advice-add #'md-resume-collapse-after-undo :after #'undo)
  (add-hook 'before-change-functions #'md-check-undo-before-change)
  (add-hook 'md-start-utterance-hooks #'md-pre-utterance-undo-setup)
  (add-hook 'md-end-utterance-hooks #'md-post-utterance-collapse-undo))

(defun md-disable-utterance-undo ()
  ;;(md-force-collapse-undo)
  (when (featurep 'undo-tree)
    (advice-remove #'md-force-collapse-undo :before #'undo-tree-undo)
    (advice-remove #'md-resume-collapse-after-undo :after #'undo-tree-undo)
    (advice-remove #'md-force-collapse-undo :before #'undo-tree-redo)
    (advice-remove #'md-resume-collapse-after-undo :after #'undo-tree-redo))
  (advice-remove #'md-force-collapse-undo :before #'undo)
  (advice-remove #'md-resume-collapse-after-undo :after #'undo)
  (remove-hook 'before-change-functions #'md-check-undo-before-change)
  (remove-hook 'md-start-utterance-hooks #'md-pre-utterance-undo-setup)
  (remove-hook 'md-end-utterance-hooks #'md-post-utterance-collapse-undo))

(md-enable-utterance-undo)
;; (md-disable-utterance-undo)
  • Not aware of a built-in mechanism for this. You might be able to insert your own entries in to the buffer-undo-list as a marker -- perhaps an entry of the form (apply FUN-NAME . ARGS)? Then to undo an utterance you repeatedly call undo until find your next marker. But I suspect there are all sorts of complications here. :) – glucas Jan 19 '15 at 23:22
  • Removing boundaries would seem a better bet. – jch Jan 19 '15 at 23:46
  • Does manipulating buffer-undo-list work if I'm using undo-tree? I see it referenced in the undo-tree source so I'm guessing yes but making sense of the whole mode would be a big endeavor. – Joseph Garvin Jan 20 '15 at 0:52
  • @JosephGarvin I'm interested in controlling Emacs with speech as well. Do you have any source available? – PythonNut Sep 22 '15 at 21:33
  • @PythonNut: yes :) github.com/jgarvin/mandimus the packaging is incomplete... and the code is also partially in my joe-etc repo :p But I use it all day and it works. – Joseph Garvin Sep 22 '15 at 22:03
13

Interestingly enough, there appears to be no built-in function to do that.

The following code works by inserting a unique marker on the buffer-undo-list at the beginning of a collapsible block, and removing all boundaries (nil elements) at the end of a block, then removing the marker. In case something goes wrong, the marker is of the form (apply identity nil) to ensure that it does nothing if it remains on the undo list.

Ideally, you should use the with-undo-collapse macro, not the underlying functions. Since you mentioned that you cannot do the wrapping, make sure that you pass to the low-level functions markers that are eq, not just equal.

If the invoked code switches buffers, you must ensure that undo-collapse-end is called in the same buffer as undo-collapse-begin. In that case, only the undo entries in the initial buffer will be collapsed.

(defun undo-collapse-begin (marker)
  "Mark the beginning of a collapsible undo block.
This must be followed with a call to undo-collapse-end with a marker
eq to this one."
  (push marker buffer-undo-list))

(defun undo-collapse-end (marker)
  "Collapse undo history until a matching marker."
  (cond
    ((eq (car buffer-undo-list) marker)
     (setq buffer-undo-list (cdr buffer-undo-list)))
    (t
     (let ((l buffer-undo-list))
       (while (not (eq (cadr l) marker))
         (cond
           ((null (cdr l))
            (error "undo-collapse-end with no matching marker"))
           ((null (cadr l))
            (setf (cdr l) (cddr l)))
           (t (setq l (cdr l)))))
       ;; remove the marker
       (setf (cdr l) (cddr l))))))

 (defmacro with-undo-collapse (&rest body)
  "Execute body, then collapse any resulting undo boundaries."
  (declare (indent 0))
  (let ((marker (list 'apply 'identity nil)) ; build a fresh list
        (buffer-var (make-symbol "buffer")))
    `(let ((,buffer-var (current-buffer)))
       (unwind-protect
            (progn
              (undo-collapse-begin ',marker)
              ,@body)
         (with-current-buffer ,buffer-var
           (undo-collapse-end ',marker))))))

Here's an example of usage:

(defun test-no-collapse ()
  (interactive)
  (insert "toto")
  (undo-boundary)
  (insert "titi"))

(defun test-collapse ()
  (interactive)
  (with-undo-collapse
    (insert "toto")
    (undo-boundary)
    (insert "titi")))
  • I understand why your marker is a fresh list, but is there a reason for those specific elements? – Malabarba Jan 20 '15 at 1:23
  • @Malabarba that's because an entry (apply identity nil) will do nothing if you call primitive-undo on it — it will not break anything if for some reason it is left on the list. – jch Jan 20 '15 at 1:25
  • Updated my question to include the code I added. Thanks! – Joseph Garvin Jan 20 '15 at 5:40
  • Any reason to do (eq (cadr l) nil) instead of (null (cadr l)) ? – ideasman42 Dec 4 at 12:10
  • @ideasman42 modified according to your suggestion. – jch Dec 5 at 22:17
3

Some changes to the undo machinery "recently" broke some hack viper-mode was using to do this kind of collapsing (for the curious, it's used in the following case: when you press ESC to finish an insertion/replacement/edition, Viper wants to collapse the whole change into a single undo step).

To fix it cleanly, we introduced a new function undo-amalgamate-change-group (which corresponds more or less to your undo-stop-collapsing) and reuses the existing prepare-change-group to mark the beginning (i.e. corresponds more or less to your undo-start-collapsing).

For reference, here's the corresponding new Viper code:

(viper-deflocalvar viper--undo-change-group-handle nil)
(put 'viper--undo-change-group-handle 'permanent-local t)

(defun viper-adjust-undo ()
  (when viper--undo-change-group-handle
    (undo-amalgamate-change-group
     (prog1 viper--undo-change-group-handle
       (setq viper--undo-change-group-handle nil)))))

(defun viper-set-complex-command-for-undo ()
  (and (listp buffer-undo-list)
       (not viper--undo-change-group-handle)
       (setq viper--undo-change-group-handle
             (prepare-change-group))))

This new function will appear in Emacs-26, so if you want to use it in the mean time, you can copy its definition (requires cl-lib):

(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))))))))
  • I looked into undo-amalgamate-change-group, and there doesn't seem to be a convenient way to use this like the with-undo-collapse macro defined on this page, since atomic-change-group doesn't work in a way that allows calling the group with undo-amalgamate-change-group. – ideasman42 Dec 4 at 20:33
  • Of course, you don't use it with atomic-change-group: you use it with prepare-change-group, which returns the handle you then ned to pass to undo-amalgamate-change-group when you're done. – Stefan Dec 4 at 21:08
  • Wouldn't a macro that deals with this be useful? (with-undo-amalgamate ...) which handles the change group stuff. Otherwise this is a bit of a hassle for collapsing a few operations. – ideasman42 Dec 4 at 21:45
  • So far it's used only by viper IIRC and Viper wouldn't be able to use such a macro because the two calls happen in separate commands, so there's no crying need for it. But it would be trivial to write such a macro, of course. – Stefan Dec 4 at 22:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.