如何崩溃撤消历史？

我正在使用一种Emacs模式，该模式可以让您通过语音识别控制Emacs。我遇到的问题之一是Emacs处理撤消的方式与您期望通过语音进行控制时的工作方式不匹配。

当用户说出几个字然后停顿时，这被称为“话语”。话语可能包含多个命令，供Emacs执行。识别器经常会错误地识别出话语中的一个或多个命令。在这一点上，我希望能够说“撤消”，并使Emacs撤消所有由语音执行的动作，而不仅仅是语音中的最后一个动作。换句话说，我希望Emacs就撤消而言将一个发声视为一个命令，即使一个发声包含多个命令也是如此。我还想指出要回到发话之前的确切位置，我注意到普通的Emacs撤消操作不会这样做。

我已经设置了Emacs来在每个话语的开始和结束时获取回调，所以我可以检测到这种情况，我只需要弄清楚Emacs会做什么。理想情况下，我会打电话给类似的东西(undo-start-collapsing)，然后(undo-stop-collapsing)将介于两者之间的所有内容神奇地折叠成一张唱片。

我在文档中进行了一些检索，发现了undo-boundary这一点，但这与我想要的相反-我需要将所有动作折叠成一个撤消记录，而不是拆分。我可以undo-boundary在发声之间使用，以确保插入被认为是分开的（默认情况下，Emacs将连续插入操作视为一个达到一定限制的操作），仅此而已。

其他并发症：

• 我的语音识别守护程序通过模拟X11按键来向Emacs发送一些命令，并通过emacsclient -e这样的方式发送一些命令，如果有人说(undo-collapse &rest ACTIONS)我没有可以包装的地方。
• 我使用undo-tree，不确定是否会使事情变得更复杂。理想情况下，解决方案将与undo-treeEmacs的正常撤消行为一起使用。
• 如果话语中的命令之一是“撤消”或“重做”怎么办？我想我可以更改回调逻辑，以始终将它们作为独特的发音发送给Emacs，以使事情变得更简单，然后应像使用键盘一样处理它。
• 延伸目标：语音可能包含用于切换当前活动窗口或缓冲区的命令。在这种情况下，最好在每个缓冲区中分别说一次“撤消”，我不需要那么花哨。但是，单个缓冲区中的所有命令仍应分组，因此，如果我说“ do-x do-y do-z switch-buffer do-a do-b do-c”，则x，y，z应该是一个撤消原始缓冲区中的记录，而a，b，c应该是切换到缓冲区中的一个记录。

是否有捷径可寻？AFAICT没有内置的功能，但Emacs广阔而深刻。

更新：我最终在下面使用了jhc的解决方案并添加了一些额外的代码。在全局中，before-change-hook我检查要更改的缓冲区是否在修改了此话语的全局缓冲区列表中，如果没有，它将进入列表并被undo-collapse-begin调用。然后，在发话结束时，我迭代列表中的所有缓冲区并调用undo-collapse-end。以下代码（为函数命名而在函数名称前添加md-）：

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

有趣的是，似乎没有内置功能可以做到这一点。

以下代码通过buffer-undo-list在可折叠块的开始处插入一个唯一的标记，并在块nil的末尾删除所有边界（元素），然后删除该标记来工作。万一出了问题，标记的形式(apply identity nil)可以确保如果它保留在撤消列表上，则什么也不做。

理想情况下，您应该使用with-undo-collapse宏，而不是基础函数。由于您提到不能进行包装，因此请确保将传递给低级功能标记eq，而不仅仅是equal。

如果调用的代码切换了缓冲区，则必须确保undo-collapse-end在与相同的缓冲区中调用undo-collapse-begin。在这种情况下，只有初始缓冲区中的撤消条目会被折叠。

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

这是用法示例：

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

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

撤消机制的一些更改“最近”破坏了一些viper-mode用于进行这种折叠的hack （出于好奇，在以下情况下使用了它：当您按下ESC以完成插入/替换/版本时，Viper希望将整个折叠起来更改为单个撤消步骤）。

为了彻底解决它，我们引入了一个新函数undo-amalgamate-change-group（或多或少地与您相对应undo-stop-collapsing），并重复使用现有功能prepare-change-group来标记开始（即，或多或少地与您相对应undo-start-collapsing）。

作为参考，以下是相应的新Viper代码：

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

此新功能将出现在Emacs-26中，因此，如果您想同时使用它，可以复制其定义（要求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))))))))

这是with-undo-collapse使用Emacs-26更改组功能的宏。

这是atomic-change-group一行更改，添加undo-amalgamate-change-group。

它具有以下优点：

• 不需要直接操作撤消数据。
• 它确保撤消数据不会被截断。

(defmacro with-undo-collapse (&rest body)
  "Like `progn' but perform BODY with undo collapsed."
  (declare (indent 0) (debug t))
  (let ((handle (make-symbol "--change-group-handle--"))
        (success (make-symbol "--change-group-success--")))
    `(let ((,handle (prepare-change-group))
            ;; Don't truncate any undo data in the middle of this.
            (undo-outer-limit nil)
            (undo-limit most-positive-fixnum)
            (undo-strong-limit most-positive-fixnum)
            (,success nil))
       (unwind-protect
         (progn
           (activate-change-group ,handle)
           (prog1 ,(macroexp-progn body)
             (setq ,success t)))
         (if ,success
           (progn
             (accept-change-group ,handle)
             (undo-amalgamate-change-group ,handle))
           (cancel-change-group ,handle))))))