関数生成関数の利用例: ミニバッファ履歴の整理

id:reinyannyan:20070416:p1 (簡易クロージャの実装) で、変数の値を関数式の中にインライン展開することで擬似クロージャを作成する方法を考えました*1。今回はその応用編です。

savehist-mode を有効にして、ミニバッファの入力履歴を Emacs セッションを通じて記憶しておく、というケースを題材にします。


保存された履歴ファイル (~/.emacs.d/history) を眺めてみると、入力内容に重複があることに気付きます。

まずは単純に重複を削除することを思い付くんですが、それだけだと compose や curry の出る幕はありません。

そこで、ファイル名の履歴に注目してみると、入力内容に特徴的なばらつきがあることが分かります。

例えば、ディレクトリ名がスラッシュで終わっていたりいなかったり、"~/.emacs" を "~/work/../.emacs" のようにアクセスしていたり、という具合です。

ということで、そんなファイル名のばらつきを統一した上で重複を削除する、というのが今回の主題となります。


はじめに "../" を削除する関数を作ります:

(defun normalize-file-name (filename)
  (let ((skip nil))
    (mapconcat 'identity
               (nreverse
                (mapcan (lambda (str)
                          (let ((res nil))
                            (cond ((string= str ".")) ; do nothing
                                  ((string= str "..")
                                   (push t skip))
                                  (skip
                                   (pop skip))
                                  (t (push str res))) ; listify `str'
                            res))
                        (nreverse (split-string filename "/"))))
               "/")))

ここで、mapcan はリスト中のコンスを繋ぎ合わせる関数です (cl-extra.el にもあります):

(defun mapcan (mapcan-fn mapcan-lst)
  (apply 'nconc (mapcar mapcan-fn mapcan-lst)))

これは例えば

(mapcan 'identity '((a) nil (b) nil (c)))
; => (a b c)

のように、コンス (リスト) のリストを平らなリストにすると同時に、nil 部分を縮める効果もあります。このことを利用して

("~" "work" ".." ".emacs")

のようにリスト化したパスを

(("~") nil nil (".emacs"))

のように変形して繋ぎ合わせる、ということをしています。

さらに、独立した関数として、ディレクトリにスラッシュを付けて返す関数を作ります:

(defun file-name-maybe-as-directory (filename)
  (or (and (file-directory-p filename)
           (file-name-as-directory filename))
      filename))

利用例:

(normalize-file-name "~/work/lib/../../.emacs.d")
; => "~/.emacs.d"

(funcall (compose 'file-name-maybe-as-directory
                  'normalize-file-name)
         "~/work/lib/../../.emacs.d")
; => "~/.emacs.d/"

以上でファイル名のばらつきを統一する方法が整いました。ここで、重複の削除に移る前に、既に存在しないファイルは履歴から消すことにしてみましょう。

(filter 'file-exists-p file-list)

このように filter 関数 (後述) を使えば簡単です。

ただ、これだと ftp などのファイルが履歴にある場合、勝手にリモートへのアクセスが生じてしまいます。

同じインターフェースでローカルもリモートも扱える仕組み自体は大変素晴らしいんですが、定期的にアクセスが発生するのは少々鬱陶しいです*2。そこで、リモートファイルのパターンにマッチするものは無条件に残すようにしたいと思います。

簡単に、こんなプレディケート (真偽値を返す関数) を用意します:

(defun file-remote-p (filename)
  (save-match-data
    (not (null (string-match "\\`/[^/:]+:" filename)))))

さて、filter 関数で複数のプレディケートのいずれかが真となる要素を抜き出すにはどうすれば良いでしょうか?

Paul Graham"On Lisp"*3 PDF 版 P.80 (pdf のページ数です) に "fun" (function union) という便利な関数が紹介されています。elisp 用にマクロ的手法で移植してみました:

(defun fun (fn &rest fns)
  (if (null fns)
      fn
    (let ((chain (apply 'fun fns)))
      `(lambda (x)
         (or (funcall ',fn x)
             (funcall ',chain x))))))

再帰を使っているのでちょっと怖いですが、動きます。複数のプレディケートのいずれかが真の時に真を返す関数を作る関数です。これで目的のことが簡潔に書けるようになります:

(filter (fun 'file-remote-p
             'file-exists-p)
        file-list)

(順番が重要です。file-remote-p が先に適用されるようにします。)

もう一つ、file-name-maybe-as-directory の方でも file-directory-p によってリモートアクセスが生じ得ます。これを抑止するのにうってつけの関数が都合良く "fun" と同じページに紹介されていました (移植版):

(defun fif (if then &optional else)
  `(lambda (x)
     (if (funcall ',if x)
         (funcall ',then x)
       (if (not (null ',else)) (funcall ',else x)))))

利用例:

(funcall (fif 'file-remote-p
              'identity
              'file-name-maybe-as-directory)
         file-name)


なお、filter の実装はこんな感じになっています:

(defun filter (pred lst)
  (mapcan (lambda (x)
            (and (funcall pred x) (list x)))
          lst))

Paul の書く filter 関数 (同 P.60) は mapcar に取捨選択機能をミックスしたような関数なんですが、ここでは取捨選択機能のみの (Haskell とか Python にあるような) 一般的な実装にしました。プレディケートを渡すだけで良いので便利です。


以上を組み合わせて、全体としてはこのようになります:

(add-hook
 'savehist-save-hook
 (lambda ()
   (mapc (lambda (symbol)
           (and (boundp symbol)
                (set symbol
                     (delete-dups
                      (funcall (if (eq symbol 'file-name-history)
                                   (compose
                                    (curry 'filter (fun 'file-remote-p
                                                        'file-exists-p))
                                    (curry 'mapcar
                                           (compose
                                            (fif 'file-remote-p
                                                 'identity
                                                 'file-name-maybe-as-directory)
                                            'normalize-file-name)))
                                 'identity)
                               (symbol-value symbol))))))
         savehist-minibuffer-history-variables)))

(Meadow3 でのみ動作確認しています)


余談ですが、リーダーが解析エラーを起こすような文字を残してしまうものなど、保存したくない履歴項目がある場合、変数 `savehist-ignored-variables' にそれらを設定して、さらに次のような処理を追加で定義しておくと良いでしょう:

(add-hook
 'savehist-save-hook
 (lambda ()
   (setq savehist-minibuffer-history-variables
         (filter (lambda (symbol)
                   (not (memq symbol savehist-ignored-variables)))
                 savehist-minibuffer-history-variables))))

savehist-ignored-variables を設定しただけでは履歴ファイルには反映されないため、このような明示的な処理が必要です。

ただし、解析エラーを起こすデータ自体は手作業で履歴ファイルから削除する必要があります (でないと savehist 自体が起動できないためです)。

*1:素直に cl の lexical-let を使うべきではないか、という問いには今後改めて向き合うつもりです。

*2:この問題は savehist-autosave-interval を nil にすることでも回避可能です。

*3:最近邦訳が出たそうです。