もっと便利なマーカが欲しい。

標準のマーカは各バッファに1つずつついてるのだが、現在の位置に他の位置からコピペしたいときは結構面倒くさい。コピーにマーカを使ってしまうため、セレクションを使うか、自力で戻らなくてはならない。グローバルマーカやレジスタもあるが、妙に使い勝手が悪い。グローバルマーカはメニューから選ばなくてはならないし、レジスタは標準のキーバインドが非常に長い。長い上にさらに登録キーを使う。

そんなわけで、移動用のマーカが欲しいのである。とはいえ、長いキーは覚えにくいし、短いキーは標準のコマンドで埋まっている。そんなときは、標準のコマンドをちょっとハックしてやればよいのである。

具体的には、普通のマーカに使うコマンド・・・set-mark-commandやexchange-point-and-markにuniversal-argumentに対応させる。これらに数値を与えた場合、それに対応するハッシュキーにマーカを登録したり、呼び出したりすれば良いのだ。入力は少し面倒だが、標準の拡張なので覚えやすいだろう。実際には、直接書き換えるのではなく、元のコマンドを呼び出すラッパーを作る。

(let ((table (make-hash-table :size 7)))
  (macrolet
      ((/new () `(set-marker (make-marker)))
       (/get () `(gethash n table))
       (/set (marker) `(setf (/get) ,marker))
       (/call () `(call-interactively func))
       (/command (&rest args)
         `(lambda (&optional n)
            (interactive "p")
            (if n (progn ,@args)
              (/call))))
       (/use (&rest args)
         `(let ((arg (/get)))
            (if arg (and
                     (set-buffer (marker-buffer arg))
                     (goto-marker arg)
                     ,@args)
              (message "マーカがセットされてないよ。")))))
    (labels ((/mem (func)
               (/command (/set (/new)) (message "マーカ設定")))
             (/go (func) (/command (/use)))
             (/swap (func)
               (/command
                (let ((new (/new)))
                  (/use (/set new) (message "入れ替え"))))))
      (labels ((gen (direction &optional command)
                 (case direction
                   (-1 (/mem command))
                   (1 (/go command))
                   (2 (/swap command))
                   (t table))))
        (setf (symbol-function 'embed-marker) #'gen)))))

(global-set-key #\NUL (embed-marker -1 'set-mark-command))
(global-set-key #\C-f (embed-marker 1 'forward-char))
(define-key ctl-x-map #\C-x (embed-marker 2 'exchange-point-and-mark))

バインドされている関数名が#になってしまうが、標準のキーに慣れていれば確認することもないだろう。気になる場合は、defunの定義にならって名前をつければよい。

また、基本的な動きはレジスタと同じ*1なので、必要であれば同様の拡張が出来る。

*1:キーではなく数値に関連付ける点は異なる。