gistfile1.el

;;; -*- mode: emacs-lisp -*-
;;;
;;; Lisp 関数だけに色付け
;;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=font-lock-func

;;; Usage:
;; (require 'elisp-font-lock)

;;; Code:

(eval-when-compile (require 'cl))

(defface my-face-elisp-macro '((t (:foreground "sea green"))) nil)
(defface my-face-elisp-subr '((t (:foreground "purple"))) nil)
(defface my-face-elisp-func '((t (:foreground "medium blue"))) nil)

(defmacro* define-elisp-font-lock-function (fname &optional (fn 'identity))
  `(defun ,fname (limit)
     (when (re-search-forward "['(]\\([^() \n]+\\)" limit t)
       (or (and (not (memq (get-text-property 0 'face (match-string 1))
                           '(font-lock-comment-face font-lock-warning-face)))
                (funcall (function ,fn)
                         (condition-case nil
                             (symbol-function
                              (intern-soft (match-string-no-properties 1)))
                           (error nil))))
           (funcall (function ,fname) limit)))))

(define-elisp-font-lock-function my-font-lock-elisp-macro)
(define-elisp-font-lock-function my-font-lock-elisp-subr subrp)
(define-elisp-font-lock-function my-font-lock-elisp-func byte-code-function-p)

(mapc #'(lambda (mode)
          (font-lock-add-keywords mode
            '((my-font-lock-elisp-macro 1 'my-face-elisp-macro t)
              (my-font-lock-elisp-subr 1 'my-face-elisp-subr t)
              (my-font-lock-elisp-func 1 'my-face-elisp-func t))
            t))
      '(lisp-interaction-mode emacs-lisp-mode))

;; 再帰が深すぎると巨大なelispファイルを開いたときにエラーになるので適当に数値を大きく
(setq max-lisp-eval-depth 1000)

(provide 'elisp-font-lock)

;;; elisp-font-lock.el ends here