LISPUSER

Dired に拡張子ベースで色を付ける - dired + font-lock

Emacs 仲間が dired モードの場合に拡張子で色をつけたい，とボヤいていまし た．で，調べたついでにここのネタにします．たしかに font-lock 周りの説明 は不足気味な上，dired の色付けに関するドキュメントはさらに少ないように 思います．

dired モードは Emacs の標準色付け機構 font-lock を使ってディレクトリや マークなどの操作に対応したハイライトをしています．dired がやっているの は実際には font-lock 用の正規表現とフェイスを設定しているだけで実際に色 をつけているのは font-lock 機構です．おおまかに説明すると

[dired-mode 起動時]
1. dired 起動
2. dired-mode 関数が呼ばれる
3. バッファローカルの変数 font-lock-defaults に dired-font-lock-keywords を指定

したがって，dired-font-lock-keywords を通じてカスタマイズが可能です．で は，dired.el の dired-font-lock-keywords 定義を見てみましょう……と思っ たんですが，はい，長いですね．カスタマイズ用の関数を用意しました．

(defvar *original-dired-font-lock-keywords* dired-font-lock-keywords)
(defun dired-highlight-by-extensions (highlight-list)
  "highlight-list accept list of (regexp [regexp] ... face)."
  (let ((lst nil))
    (dolist (highlight highlight-list)
      (push `(,(concat "\\.\\(" (regexp-opt (butlast highlight)) "\\)$")
              (".+" (dired-move-to-filename)
               nil (0 ,(car (last highlight)))))
            lst))
    (setq dired-font-lock-keywords
          (append *original-dired-font-lock-keywords* lst))))

使い方は次の通りです．

(dired-highlight-by-extensions
  '(("txt" font-lock-variable-name-face)
    ("odql" "tmpl" font-lock-type-face)
    ("lisp" "el" "pl" font-lock-constant-face)))

色づけを変更したい場合は再度 dired-highlight-by-extensions を呼び出して ください．

このように (拡張子 [拡張子] ... フェイス) という形式のリストでファ イル名を拡張子に応じて色付けします．ただ，ファイル数が遅いと性能にモロ に効いてきますので使いすぎには御注意下さい．:-)

おまけ．

別解 cl パッケージをつかって Common Lisp の LOOP スタイル．

(defun cl-dired-highlight-by-extensions (highlight-list)
  (loop for highlight in highlight-list
        for pattern = (butlast highlight)
        for face    = (car (last highlight))
        collect `(,(concat "\\.\\(" (regexp-opt (butlast highlight)) "\\)$")
                  (".+" (dired-move-to-filename)   
                   nil (0 ,(car (last highlight)))))
        into lst
        finally (setq dired-font-lock-keywords
                      (append *original-dired-font-lock-keywords* lst))))

Scheme ライクに再帰．

(defun scheme-dired-highlight-by-extensions (highlight-list &optional acc)
  (if (null highlight-list)
      (setq dired-font-lock-keywords (append *original-dired-font-lock-keywords* acc))
    (scheme-dired-highlight-by-extensions
     (cdr highlight-list)
     (cons
      `(,(concat "\\.\\(" (regexp-opt (butlast (car highlight-list))) "\\)$")
        (".+" (dired-move-to-filename) nil (0 ,(car (last (car highlight-list))))))
      acc))))

どちらでもお好みでどーぞ。