特定の場合のみ違うことをするコマンドを作る

たとえば C-k (kill-line) は普通、現在位置から行末を kill して改行が残るんだけど、行頭でやったら改行も含めて kill する（1行まるっと kill）にしたい。という場合。

よくあるやり方は、そういうコマンドを作って置き換えるパターン。xyzzyの音 - 編集にあるようなの。

今回これとはちょっと違うやり方をやりたかったので、ごちゃごちゃやってみた。

いくつかのキーで特定の場合に違うことをさせたい。
複数のモードで使いたい。
特定の場合以外では、普通に動いてて欲しい。

という感じ。

まず minor-mode を作る。

;;;; Keymap

(defvar *hoge-mode-keymap* nil)

(unless *hoge-mode-keymap*
  (let ((kmap (make-sparse-keymap)))
    (define-key #\C-k 'kill-whole-line-or-original)
    (setf *hoge-mode-keymap* kmap)))


;;;; Minor mode

(defvar-local hoge-mode nil)

(defun hoge-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode 'hoge-mode arg sv)
  (if 'hoge-mode
    (set-minor-mode-map *hoge-mode-keymap*)
    (unset-minor-mode-map *hoge-mode-keymap*))
  (update-mode-line t))
(pushnew '(hoge-mode . "Hoge") *minor-mode-alist* :key #'car)

マイナーモードのキーマップを使うだけ。そのキーマップは C-k に kill-whole-line-or-original というコマンドを割り当ててるだけ。

んで、コマンドがこんなの。

(defun kill-whole-line-or-original (&optional lines)
  (interactive "*p")
  (if (bolp)
    (let ((point (point))
          (lines (cond ((or (null lines)
                            (<= lines 1))
                         0)
                       (t
                         (- arg 1)))))
      (kill-region point
                   (progn
                     (forward-line lines)
                     (goto-eol)
                     (forward-char)
                     (point))))
    (call-interactively (original-command *last-command-char*))))

実装はxyzzyの音 - 編集をパクらせてもらった。要は (bolp) だったら行末まで kill してるのだが、(bolp) ではない場合に (call-interactively (original-command *last-command-char*)) とした。

original-command はこれから実装するので置いとくとして、*last-command-char* は押されたキーに束縛されてる。なので、押されたキーが実行するはずだったコマンドを探して call-interactively すればいいんじゃね。というのが今回の作戦であり、original-command は指定されたキーが実行するはずだったコマンドを探す関数。

;;; Modified version of original `lookup-key-command`
(defun original-command (key)
  (let ((bound (mapcar #'(lambda (x)
                           (when (and (keymapp x)
                                      (not (eql x *hoge-mode-keymap*)))
                             (lookup-keymap x key)))
                       (append (list (current-selection-keymap))
                               (minor-mode-map)
                               (list (local-keymap))
                               (list *global-keymap*)))))
    (or (find-if-not #'keymapp bound)
        (find-if #'identity bound))))

もともと xyzzy には lookup-key-command という、現在のバッファで使用してるキーマップから指定されたキーのコマンドを探し出す関数があるのだけど、そのままだとマイナーモードで上書きしたコマンド自身（今回の例だと kill-whole-line-or-original）が返ってきて再帰呼び出しになってしまうので、マイナーモードのキーマップ（*hoge-mode-keymap*）を除外して探すようにしたのがこれ。

これで (bolp) でなかったときは (original-command *last-command-char*) が見つけた kill-line を call-interactively して、普通に kill-line される（はず）。

FIXME: たぶん複数キーストローク（C-x f とか）に対応してない。