Keyboard macros resumable after C-g

kmacro-start-macro-resuming-recent.el

;;; kmacro.el --- Enhancement to kmacro recording.

;; Copyright (c) 2014 Chris Done. All rights reserved.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(defvar kmacro-start-keys (vector)
  "The keys used to start macro recording.")

(defun kmacro-start-macro-resuming-recent (arg)
  "A version of `kmacro-start-macro' which when ARG is passed
will resume recording with the keys pressed since it was last
invoked, excluding the last (presumed to be error) command run."
  (interactive "P")
  (if (and (not (or defining-kbd-macro executing-kbd-macro))
           arg)
      (let* ((keys (recent-keys))
             ;; Let's strip off the keys used to run this command.
             (unmuddied-keys
              (apply #'vector
                     (loop for i from 0 to (1- (- (length keys)
                                                  (length (this-command-keys))))
                           collect (elt keys i)))))
        (let ((start-keys kmacro-start-keys))
          (setq kmacro-start-keys (this-command-keys))
          (kmacro-user-prompt-resume
           arg
           (kmacro-recent-keys start-keys
                               unmuddied-keys))))
    (progn (setq kmacro-start-keys (this-command-keys))
           (kmacro-start-macro nil))))

(defun kmacro-show-key (ev)
  "Show a key without throwing an error for mouse events."
  (cond
   ((atom ev)
    (edmacro-format-keys (vector ev)))
   ((eq (car ev) 'help-echo)
    (edmacro-format-keys (vector ev)))
   ((eq (car ev) 'switch-frame)
    (edmacro-format-keys (vector ev)))
   ((equal ev '(menu-bar))
    (edmacro-format-keys (vector ev)))
   ((equal (cl-cadadr ev) '(menu-bar))
    (edmacro-format-keys (vector ev)))
   (t "<mouse-event>")))

(defun kmacro-user-prompt-resume (arg keys)
  "Prompt for the user to resume with the given incomplete
keyboard macro."
  (let ((done nil))
    (while (not done)
      (let ((key (read-event
                  (concat (propertize
                           "Resume macro with (RET: continue, DEL: remove last): "
                           'face 'minibuffer-prompt)
                          (mapconcat #'kmacro-show-key
                                     (loop for i from 0 to (max 0 (- (length keys) 2))
                                           collect (elt keys i))
                                     " ")
                          " "
                          (propertize (kmacro-show-key
                                       (elt keys (1- (length keys))))
                                      'face 'bold)))))
        (case key
          (7
           (keyboard-quit))
          (backspace
           (setq keys
                 (apply #'vector
                        (loop for i from 0 to (max 0 (- (length keys) 2))
                              collect (elt keys i))))
           (when (= 0 (length keys))
             (setq done t)))
          (return
           (setq done t))))))
  (unless (= (length keys) 0)
    (setq last-kbd-macro keys)
    (kmacro-start-macro arg)))

(defun kmacro-recent-keys (prefix keys)
  "Get the keys of the current macro, by searching for the start
specified by PREFIX."
  (let ((j 0))
    (remove-if
     (lambda (k) (equal k 7)) ;; Strip out `C-g'.
     (if (= (length prefix) 0)
         keys
       (apply #'vector
              (let ((result (list)))
                (loop for i from 0 to (1- (length keys))
                      ;; Constantly append to the buffer.
                      do (add-to-list 'result (elt keys i) t (lambda (_ _) nil))
                      ;; Reset whenever the `prefix' is invalidated.
                      when (and (< j (length prefix))
                                (not (equal (elt keys i) (elt prefix j))))
                      do (setq j 0)
                      ;; Reset whenever we encounter the start of the
                      ;; `prefix' (this assumes no repeated start keys).
                      when (equal (elt keys i) (elt prefix 0))
                      do (setq j 0)
                      ;; While prefix is being satisfied, increment `j'.
                      ;; Resets the `result' buffer when we've finished
                      ;; identifying the `prefix'.
                      when (and (< j (length prefix))
                                (equal (elt keys i) (elt prefix j)))
                      do (progn (setq j (1+ j))
                                (when (= j (length prefix))
                                  ;; If we're at the end of the vector, that means the last
                                  ;; key sequence pressed was our prefix. So let's strip that
                                  ;; off.
                                  (if (= i (1- (length keys)))
                                      (setq result (nbutlast result
                                                             (length prefix)))
                                    (setq result (list))))))
                result))))))

(defun kmacro-test-recent-keys ()
  "Run tests for `kmacro-recent-keys'."
  (interactive)
  (loop for test in '((([] []) . [])
                      (([] [1]) . [1])
                      (([] [1 2]) . [1 2])
                      (([1] [1 2]) . [2])
                      (([1] [1]) . [])
                      (([1 2] [1 2]) . [])
                      (([1] [1 2 3 4 5]) . [2 3 4 5])
                      (([1 2] [1 2 3 4 5]) . [3 4 5])
                      (([1 2] [1 2 3 1 2 4 5]) . [4 5])
                      (([1 2] [1 2 3 1 2]) . [3])
                      (([1 2 3] [1 2]) . [1 2])
                      (([1 2 3] []) . [])
                      (([0 1] [right up 1 11 f3 102 111 111 7 21 0 1]) .
                       [right up 1 11 f3 102 111 111 21]))
        when (not (equalp (apply #'kmacro-recent-keys (car test))
                          (cdr test)))
        do (error "Test failed for %S:\n\nexpected: %S\nactual: %S"
                  `(kmacro-recent-keys ,(caar test) ,(cadar test))
                  (cdr test)
                  (apply #'kmacro-recent-keys (car test))))
  (message "OK."))