Emacs: *Apropos* バッファの見出しにタイプ別で色を付ける

なんだか Emacs Lisp の練習問題みたいなネタですね。

最後の行から上向きに 1行ずつ見ていき、

• 見出し行でなければ "Function", "Variable" などのタイプを item-type にセット
• 見出し行なら item-type をもとにフェイス設定

という動作をしています。

他のトピック: アドバイス、連想配列、テキストプロパティ

;; hi-apro.el
;; author: sonota
;; license: GPL

(defvar hi-apro:type2face-alist
;;(setq hi-apro:type2face-alist
  '(("Command"  . font-lock-keyword-face)
    ("Face"     . font-lock-string-face)
    ("Function" . font-lock-function-name-face)
    ("Group"    . font-lock-constant-face)
    ("Macro"    . font-lock-warning-face)
    ("Plist"    . font-lock-type-face)
    ("Variable" . font-lock-variable-name-face)
    ("Widget"   . font-lock-builtin-face)
    ))

(defvar hi-apro:default-header-face
  'font-lock-comment-face)


(defun hi-apro:heading-line-p ()
  ;;(interactive)
  (eq 'bold (face-at-point)))

(defun hi-apro:type-of-item ()
  (save-excursion
    (goto-char (+ 2 (point)))          ; forward-char だと動かない
    (if (thing-at-point 'word)
        (substring-no-properties (thing-at-point 'word))
      nil)))

(defun hi-apro:type2face (type)
  (or (assoc-default type hi-apro:type2face-alist)
      hi-apro:default-header-face))

(defun hi-apro:sub ()
  (let ((item-type nil)
        (face nil))
    (goto-char (point-max))
    (while (> (point) (point-min))
      (unless (hi-apro:heading-line-p)
        (setq item-type (hi-apro:type-of-item)))
      (when (hi-apro:heading-line-p)
        (setq face (hi-apro:type2face item-type))
        (let ((beg (point)))
          (end-of-line)
          (put-text-property beg (point) 'face face)))
      ;;(message "%d" (point)) (sit-for 0.5)
      (forward-line -1)
      )))

(defun hi-apro ()
  ;;(interactive)
  (setq buffer-read-only nil)
  (save-excursion (hi-apro:sub))
  (setq buffer-read-only t))

(defadvice apropos
  (after hi-apro:advice activate)
  (hi-apro))
(ad-activate 'apropos)

;; (describe-function 'apropos)
;; (ad-remove-advice 'apropos 'after 'hi-apro:advice)