LISPUSER

LISPMEMOLisp isn't a language, it's a building material. -- Alan Kay

(top)  (memo)  (rss)

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))))

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

posted: 2006/08/30 23:06 | permanent link to this entry | Tags: EMACS

(top)  (memo)  (rss)