■[elisp] いいコードをみつけていい気分

• 元ネタ C-uを押した回数によって実行するコマンドを変えるコマンドを定義する為の拡張 prefix-arg-commands.el を公開しました。 - tm8stの日記

メインとなる部分を引用します。引数で与えた名前の関数を作るマクロですね。

;; https://github.com/tm8st/emacs-prefix-arg-commands/raw/master/prefix-arg-commands.el
(defmacro prefix-arg-commands-create (name cmds)
  "前置引数によってコマンドを呼びわけるコマンドを引数のリストから生成するマクロ"
  (fset name
    `(lambda (arg) (interactive "P")
       (cond
        ((equal arg `(0)) (prefix-arg-commands-call-func 0 ,cmds))
        ((equal arg `(4)) (prefix-arg-commands-call-func 1 ,cmds))        ;;C-u
        ((equal arg `(16)) (prefix-arg-commands-call-func 2 ,cmds))       ;;C-u C-u
        ((equal arg `(64)) (prefix-arg-commands-call-func 3 ,cmds))       ;;C-u C-u C-u
        ((equal arg `(256)) (prefix-arg-commands-call-func 4 ,cmds))      ;;C-u C-u C-u C-u
        ((equal arg `(1024)) (prefix-arg-commands-call-func 5 ,cmds))     ;;C-u C-u C-u C-u C-u
        ((equal arg `(4096)) (prefix-arg-commands-call-func 6 ,cmds))     ;;C-u C-u C-u C-u C-u C-u
        ((equal arg `(16384)) (prefix-arg-commands-call-func 7 ,cmds))    ;;C-u C-u C-u C-u C-u C-u C-u
        ((equal arg `(65536)) (prefix-arg-commands-call-func 8 ,cmds))    ;;C-u C-u C-u C-u C-u C-u C-u C-u
        ((equal arg `(262144)) (prefix-arg-commands-call-func 9 ,cmds))   ;;C-u C-u C-u C-u C-u C-u C-u C-u C-u
        ((equal arg `(1048576)) (prefix-arg-commands-call-func 10 ,cmds)) ;;C-u C-u C-u C-u C-u C-u C-u C-u C-u C-u
        (t (prefix-arg-commands-call-func 0 ,cmds))))))

引数で与えた未来の関数名に fset しているところに感心(の上から目線っぽいニュアンスをとったやつ)しました。よくあるのが、ラムダをそのまま返すパターン。C-u を付けて呼び出すのだから、global-set-key するときにキーを割りあてるわけだし、それは無名でも済む気もするけど、この方がわかりやすいです。ちなみに setq だと、変数セルに入ってしまいます。

smartchr.el の簡易版を改造して動作を確認しました。

;; http://d.hatena.ne.jp/IMAKADO/20080913/1221328814 を改変
(defun my-chr (name list-of-string)
  (lexical-let ((los list-of-string)
                (last-word "")
                (count 0))
    (fset name
    ;; (setq name
          (lambda ()
            (interactive)
            (if (eq this-command real-last-command)
                (incf count)
              (setq count 0))
            (when (>= count (length los))
              (setq count 0))
            (let ((word (nth count los)))
              (when (eq this-command real-last-command)
                (delete-backward-char (length last-word)))
              (setq last-word word)
              (insert word))))))

(my-chr 'hoge '(" = " " == " " === "))
(global-set-key (kbd "=") 'hoge)

(symbol-function 'hoge)
;=> (lambda (&rest --cl-rest--) (interactive) (apply (lambda (G101266 G101267 G101268) (if ... ... ...) (if ... ...) (let ... ... ... ...)) (quote --count--) (quote --last-word--) (quote --los--) --cl-rest--))

(symbol-value 'hoge)
;=> Lisp error: (void-variable hoge)

Permalink | コメント(0)