Як згортати історію скасування?

Я працюю в режимі 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 перемикач-буфер 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))))))