font-lockで色付のソースコードをHTML化する
長いソースコードはキーワードが色分けされていないと読む気がしないので、ここのface2html.elをベースにHTMLで出力するプログラムを作った。
[];;[] [];; [][]face2html.el by TAMURA Kent <kent@xxx>[] [];; [][]$Id: face2html.el,v 1.2 2001/09/10 09:03:39 kent Exp $[] [];;[] [];; [][]Modified by Nozomu Kaneko <nozom.kaneko@xxx>[] [];; [][]■ Abstract[] [];;[] [];; [][]Emacs の バッファでの face 情報を読み取って、その字体を反映した[] [];; [][]HTML を出力するプログラムです。[] [];; [][]■ インストール[] [];;[] [];; [][]このファイル face2html.el を load-path が通ったディレクトリに[] [];; [][]置き、~/.emacs に[] [];; [][](autoload 'face2html "face2html" nil t)[] [];; [][]と書きます。[] [];;[] [];; [][]バイトコンパイルする/しないはどうぞご自由に。[] [];; [][]■ 使用[] [];;[] [];; [][]文字に色が付いているバッファで、M-x face2html としてください。[] [];; [][]バッファの内容を HTML 化したものがクリップボードに保存されます。[] [];;[] [];; [][]C-u M-x face2html とすると、*face2html output* というバッファができ[] [];; [][]て、そこに HTML 化したものが出力されます。出力のバッファ名は固定です[] [];; [][]ので、以前にface2html で出力した結果は問答無用に上書きされます。前の[] [];; [][]結果を残したいときは rename-buffer などで対処してください。[] [];;[] [];; [][]出力されたバッファで write-file (C-x C-w) などでファイルに保[] [];; [][]存することができます。[] [];; [][]■ Changes[] [];;[] [];; [][]19980908 The first release[] [];;[] [];; [][]20010910 Toru TSUNEYOSHI さんによる変更[] [];; [][]・リストな face に対応[] [];; [][]・ファイルに書き込むか、バッファに出すかを選択する[] [];; [][]・事前にバッファ全体を確実にフォントロックさせる[] [];; [][]・tab-width が 8 以外のときに untabify する[] [];;[] [];; [][]20060414 Nozomu Kaneko による変更[] [];; [][]・style ではなく class で出力する[] [];; [][]・常に span タグで出力する[] [];; [][]・リージョンに対応[] [];; [][]・出力をクリップボードまたはバッファに変更[] [];; [][]・tab-widthの処理を削除[] [];; [][]・with-current-buffer, with-temp-buffer を使って書き直し[] ([]defconst[][] [][]face2html-buffer-name[][] [][]"*face2html output*"[]) ([]defvar[][] [][]face2html-insert-pre[] t []"出力を PRE タグで囲む。"[]) ([]defvar[][] [][]face2html-close-at-eol[] t []"行末でタグを閉じる。"[]) ([]defun[][] [][]face2html[][] ([][]&optional[] arg) []"現在のバッファの face 情報を HTML 化する。"[] (interactive []"P"[]) (face2html-region (point-min) (point-max) arg)) ([]defun[][] [][]face2html-region[][] (start end [][]&optional[] arg) []"現在のリージョンの face 情報を HTML 化する。"[] (interactive []"rP"[]) ([]let[][] ([][](target-buffer (current-buffer)[])) ([]save-excursion[] ([]save-restriction[] (widen) []; [][]バッファ全てのフォントロック[] ([]let[][] ([][](font-lock-maximum-size (point-max)[])) (font-lock-fontify-buffer)) (narrow-to-region start end) ([]if[] arg ([]let[][] ([][](outbuf (get-buffer-create face2html-buffer-name)[])) ([]with-current-buffer[] outbuf (erase-buffer)) (face2html-write-to-buffer outbuf) (display-buffer outbuf)) ([]with-temp-buffer[] ([]let[][] ([][](outbuf (current-buffer)[])) ([]with-current-buffer[] target-buffer (face2html-write-to-buffer outbuf)) (kill-ring-save (point-min) (point-max)[]))[][]))[][]))[])) ([]defun[][] [][]face2html-write-to-buffer[] (outbuf) []"現在のバッファを HTML 化して outbuf に出力する。"[] (and face2html-insert-pre ([]with-current-buffer[] outbuf (insert []"<PRE>\n"[][])[])) ([]let[][] ([][](face-start (point-min)[]) (face nil) (thisface nil)) (goto-char (point-min)) ([]while[][] (< (point) (point-max)[]) (setq thisface ([]if[][] (and face2html-close-at-eol (eolp)[]) nil (get-text-property (point) 'face))) ([]when[][] (not (equal thisface face)[]) ([]let[][] ([][](face-end (point)[])) (face2html-create-html outbuf face-start face-end face) (setq face-start face-end) (setq face thisface))) (forward-char 1)) (face2html-create-html outbuf face-start (point-max) thisface)) (and face2html-insert-pre ([]with-current-buffer[] outbuf (insert []"</PRE>\n"[][])[][]))[]) ([]defun[][] [][]face2html-create-html[] (outbuf start end face) []"現行バッファの start から end までを outbuf のポイントに挿入する。[] []face に従って HTML のタグを挿入する。"[] ([]if[] (< start end) ([]let[][] ([][](target-buffer (current-buffer)[])) ([]with-current-buffer[] outbuf (and face (insert []"<SPAN class=\""[][] (face-name face) [][]"\">"[][])[]) ([]let[][] ([][](replace-start (point)[])) (insert-buffer-substring target-buffer start end) (face2html-to-entity-reference replace-start)) (and face (insert []"</SPAN>"[][])[][]))[][]))[]) ([]defun[][] [][]face2html-to-entity-reference[] (replace-start) []"replace-start から (point-max) までの <>& をそれぞれ < > & に置換する。"[] ([]save-excursion[] (goto-char replace-start) ([]while[][] (re-search-forward [][]"[<>&]"[] (point-max) t) ([]let[][] ([][](tl (buffer-substring (match-beginning 0) (match-end 0)[][]))[]) [] [][]([][]cond[][] ([][](string= tl [][]"<"[][]) (replace-match [][]"<"[][])[]) [] [][] ([][](string= tl [][]">"[][]) (replace-match [][]">"[][])[]) [] [][] ([][](string= tl [][]"&"[][]) (replace-match [][]"&"[][])[][]))[][]))[])) ([]provide[][] '[][]face2html[])
