Как свернуть историю отмен?

Я работаю над режимом Emacs, который позволяет вам управлять Emacs с помощью распознавания речи. Одна из проблем, с которыми я столкнулся, заключается в том, что способ обработки отмены Emacs не соответствует тому, как вы ожидаете, что он будет работать при управлении голосом.

Когда пользователь говорит несколько слов, а затем делает паузу, это называется «высказывание». Выражение может состоять из нескольких команд для выполнения Emacs. Часто случается, что распознаватель распознает одну или несколько команд в высказывании неправильно. В этот момент я хочу иметь возможность сказать «отменить» и заставить Emacs отменить все действия, выполняемые высказыванием, а не только последнее действие в высказывании. Другими словами, я хочу, чтобы Emacs рассматривал высказывание как отдельную команду, если речь идет об отмене, даже когда высказывание состоит из нескольких команд. Я также хотел бы вернуться к тому, что было до высказывания, я заметил, что обычная отмена Emacs этого не делает.

Я настроил Emacs для получения обратных вызовов в начале и в конце каждого высказывания, поэтому я могу определить ситуацию, мне просто нужно выяснить, что должен делать Emacs. В идеале я бы назвал что-то вроде этого, (undo-start-collapsing)и тогда (undo-stop-collapsing)все, что было сделано между ними, было бы волшебным образом свернуто в одну запись.

Я немного просмотрел документацию и нашел undo-boundary, но это противоположно тому, что я хочу - мне нужно объединить все действия внутри высказывания в одну запись отмены, а не разделить их. Я могу использовать undo-boundaryмежду высказываниями, чтобы убедиться, что вставки считаются отдельными (Emacs по умолчанию считает последовательные действия вставки одним действием до определенного предела), но это так.

Другие осложнения:

• Мой демон распознавания речи отправляет некоторые команды в Emacs, имитируя нажатия клавиш X11, и отправляет некоторые через, emacsclient -eтак что, если бы, скажем (undo-collapse &rest ACTIONS), не было центрального места, которое я мог бы обернуть.
• Я пользуюсь undo-tree, не уверен, что это усложнит ситуацию. В идеале решение должно работать с undo-treeнормальным поведением отмены Emacs.
• Что если одна из команд в высказывании - «отменить» или «повторить»? Я думаю, что я мог бы изменить логику обратного вызова, чтобы всегда отправлять их в 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использовавшиеся для этого вида свертывания (любопытно, что он используется в следующем случае: когда вы нажимаете, 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))))))