◆mode2htm.l (2001/11/23) xyzzyの各modeの色分けにだいたい従ってソースをhtml化。 ◆ini2css.l (2001/11/23) 上記の色分け用。xyzzyの色設定をcss用に変換。 動作確認:WIN98se/xyzzy0.2.2.214以降/lisp/hsp (他のmodeでも変換できるかは未確認) |
|
これを作った人間はlispの知識が全くありません。作りっぱなしで放置とさせていただきます。著作権も放棄。 |
| ◆mode2htm.l (2001/11/23) 処理速度更に激遅。正規表現keywordの色分けでmatchした部分毎に色付けとcontextに対応。 指定によってはxyzzyと同じ色分けになりません(T^T) lisp-mode/hsp-mode以外での動作確認はしてません。 htmlファイルは変換できません(タグチェックが面倒なのと、やる意味が余りないと思うので) xyzzyの色分けに従って変換するのでxyzzy以上のものは出来ません。perlなどは自作した方がよろしいかと。 ・設定 各modeでmulti-comment(lispの#| |#とか、Cの /* */とか)は各自設定して下さい。 正規表現keywordの&<>は\\<,\\_<,\\>,\\_>以外は単純に置換します。実体参照文字にする必要がないか、 するとうまくいかない場合は*mode2htm-re-keyword-replace-p* をnilにしといて下さい。(一切置換しません) ・使い方 変換したいバッファで M-x mode2htm して下さい。範囲指定したい時はnarrow-to-regionで。 |
;;;mode2htm.l (2001/11/23) 正規表現keywordのmatchした部分毎の色付け対応 ;;;xyzzy 0.2.2.214以降用 ;;;使い方:変換したいバッファで M-x mode2htm ;;;htmlファイルは変換できません。 ;;;multi-commentは各自設定して下さい。 (defvar *mode2htm-multi-comment-regexp* nil) (defvar *mode2htm-kwd-case-fold* nil) (defvar *mode2htm-re-keyword-replace-p* t) ; 正規表現keywordの&<>を実体参照文字にするか? (defvar-local *amp* "&") (defvar-local *lt* "<") (defvar-local *gt* ">") ;;; &を&に <を<に >を>に変える ;;; lisp-modeの時は正規表現keywordのcontextチェックの為に";"なしで後で付ける (defun mode2htm-tag () (goto-char (point-min)) (replace-buffer "&" *amp*) (goto-char (point-min)) (replace-buffer "<" *lt*) (goto-char (point-min)) (replace-buffer ">" *gt*) t) (defun mode2htm-tag2 () (goto-char (point-min)) (replace-buffer "\\(&\\|<\\|>\\)\\([^;]\\)" "\\1;\\2" :regexp t :case-fold t )) ;;; 文字列部分にタグ "なら"に置換(先に置換するとsyntaxが使えない) (defun mode2htm-string () (goto-char (point-min)) (while (not (eobp)) (skip-syntax-spec-forward "^\"") ; 1個前がエスケープ=文字列の開始でないので置換だけして抜ける (cond ((or (syntax-escape-p (preceding-char)) (syntax-symbol-prefix-p (preceding-char))) (if (looking-for "\"") (progn (delete-char 1) (insert """) (forward-char -1)) (forward-char 1))) ; タグ或いはタグの中なら閉じタグ迄スキップ(その前にタグ内の""は置換する) ((or (looking-at "[^<]*>") (looking-at "[^>]*</" )) (let ((end (progn (scan-buffer "</") (point)))) (save-restriction (narrow-to-region (progn (scan-buffer ">" :tail t :reverse t) (point)) end) (goto-char (point-min)) (replace-buffer "\"" """) (goto-char (point-max))))) (t (insert "<span class=\"string\">") ; 開始タグ挿入 ""か''かで対応する閉じ記号を探しに行く (if (looking-for "\"") (progn (escape-string-chk) (and (looking-for "\"") (delete-char 1) (insert """))) (progn (forward-char 1) (escape-string-chk2) (forward-char 1))) (insert "</span>") (forward-char -1))) (or (forward-char 1) (return)))) ;;; 文字列内の"\"\"\""のチェックと置換 (defun escape-string-chk () (delete-char 1) (insert """) (skip-chars-forward "^\"") (when (syntax-escape-p (preceding-char)) (unless (looking-back "\\\\") (escape-string-chk)))) (defun escape-string-chk2 () (skip-syntax-spec-forward "^\"") (and (looking-for "\"") (delete-char 1) (insert """) (escape-string-chk2))) ;;; keywordの色指定をタグにする (defun mode2htm-keyword-color (col) (let ((btag nil) (etag nil) (c (mod col #x100000))) (cond ((case c (#x400 (setq btag "<span class=\"kwd1\">" etag "</span>")) ;kwd1=;*0 (#x600 (setq btag "<span class=\"kwd2\">" etag "</span>")) ;kwd2=;*1 (#x800 (setq btag "<span class=\"kwd3\">" etag "</span>")) ;kwd3=;*2 (#xa00 (setq btag "<span class=\"kwd1h\">" etag "</span>")) ;kwd1反転=;*3 (#xc00 (setq btag "<span class=\"kwd2h\">" etag "</span>")) ;kwd2反転=;*4 (#xe00 (setq btag "<span class=\"kwd3h\">" etag "</span>")) ;kwd3反転=;*5 (#xa02 (setq btag "<h6 class=\"kwd1h\">" etag "</h6>")) ;kwd1行反転=;*6 (#xc02 (setq btag "<h6 class=\"kwd2h\">" etag "</h6>")) ;kwd2行反転=;*7 (#xe02 (setq btag "<h6 class=\"kwd3h\">" etag "</h6>")) ;kwd3行反転=;*8 (#x1a00 (setq btag "<span class=\"string\">" etag "</span>")) ;string (#x1c00 (setq btag "<span class=\"tag\">" etag "</span>")) ;tag (#x1e00 (setq btag "<span class=\"comment\">" etag "</span>")))) ;comment ((or (< 0 (floor (mod (1- c) #x20000) #x200) 16) (< 0 (floor (1- c) #x20000) 16)) (if (< 0 (floor (mod (1- c) #x20000) #x200) 16) (setq btag (format nil "<span class=\"fg~A" (floor (mod (1- c) #x20000) #x200))) ; 文字色1-15 (setq btag "<span class=\"fg0")) ; 文字色0 (and (< 0 (floor (1- c) #x20000) 16) (setq btag (format nil "~A bg~A" btag (floor (1- c) #x20000) 16))) ; 背景色1-15 (setq btag (concat btag "\">") etag "</span>")) ((eq col 0) ; 正規表現kwdのcolor=t=0 元の色 (setq btag "<span class=\"fg0\">" etag "</span>"))) (and (eq (logand col #x200000 ) #x200000) (setq btag (concat btag "<b>") etag (concat "</b>" etag))) ;bold=$200000 (and (eq (logand col #x800000 ) #x800000) (setq btag (concat btag "<u>") etag (concat "</u>" etag))) ;underline=$800000 (and (eq (logand col #x1000000 ) #x1000000) (setq btag (concat btag "<strike>") etag (concat "</strike>" etag))) ;strike=$1000000 (values btag etag))) (defun make-list-from-keyword-table-2 (hash) (let ((list nil)) (when (hash-table-p hash) (maphash #'(lambda (x y) (and (stringp x) (push (cons x y) list))) hash)) list)) ;;; hash-tableからkeyword取ってきてリストにする (defun mode2htm-make-kwd-list () (setq list (make-list-from-keyword-table-2 ed::keyword-hash-table)) (setq list (sort list #'< :key #'cdr)) (let ((lst nil)) (while (not (endp list)) (setq c (cdar list)) ; listの色指定部分 (setq l (remove c list :test-not #'eql :key #'cdr)) ; 色指定がcでないものを取り除いたリスト (setq l (string-right-trim "|" (format nil "~{~A\\|~}" (mapcar #'car l)))) (setq l (substitute-string l "&" *amp*)) (setq l (substitute-string l "<" *lt*)) (setq l (substitute-string l ">" *gt*)) (setq l (compile-regexp (concat "\\_b\\(" l ")\\_b") *mode2htm-kwd-case-fold*)) (push (list l c) lst) ; (keyword 色指定)のリスト (setq list (delete c list :test #'eql :key #'cdr))) ; 色指定がcのものをlistから取り除く lst)) ;;; keywordにタグ挿入 (defun mode2htm-keyword (reg col) (multiple-value-bind (btag etag) (mode2htm-keyword-color col) (goto-char (point-max)) (while (scan-buffer reg :reverse t ) (let ((beg (match-beginning 0)) (end (match-end 0))) (unless (or (eq (parse-point-syntax (1+ (point))) :string) (eq (parse-point-syntax (1+ (point))) :comment) (eq (parse-point-syntax (1+ (point))) :tag) (looking-at "[^<]*>") ; タグの開始がなくて閉じていればタグの中 (looking-at "[^>]*</") ; 開始タグがなくて閉じてれば正規表現keywordの中 (syntax-escape-p (preceding-char)) (syntax-symbol-prefix-p (preceding-char)) (and (eq buffer-mode 'perl-mode) (looking-at "gt\\|lt") (looking-back "&")) (if (scan-buffer "<" :reverse t) (looking-at "<[^/]+")) ; 開始タグがあれば正規表現keywordの中 ) (kwd-tag col btag etag beg end)) (or (goto-char (- beg 1)) (return)))))) ;;;....................................... ;;; タグを入れる (defun kwd-tag (col btag etag beg end) (and etag (if (eq (logand col 2) 2) ; 色指定 1行丸ごと (goto-eol) (goto-char end)) (insert etag)) (and btag (if (eq (logand col 2) 2) ; 色指定 1行丸ごと (goto-bol) (goto-char beg)) (insert btag))) ;;; 正規表現keywordの&<>を実体参照文字にする (defun mode2htm-re-kwd-replace (reg) (let ((lst (compiled-regexp-source reg))) (setq lst (substitute-string lst "&" *amp*)) (setq lst (substitute-string lst "\\(^\\|[^\\_]\\)<" (concat "\\1" *lt*))) (setq lst (substitute-string lst "\\(^\\|[^\\_]\\)>" (concat "\\1" *gt*))) (setq lst (compile-regexp lst (compiled-regexp-case-fold-p reg))) lst)) ;;; 正規表現keywordの色指定をlistにする (defun mode2htm-make-re-kwd-color-list (col) (let ((lst nil)) (cond ((consp col) (sort col #'< :key #'car) (dolist (x col) ;colorがnilの時はリストに入れない（不具合あるかも） (and (cdr x) (multiple-value-bind (btag etag) (mode2htm-keyword-color (cdr x)) ; (matchした部分 色指定 開始タグ 閉じタグ)のlist (push (list (car x) (cdr x) btag etag) lst))))) (t (multiple-value-bind (btag etag) (mode2htm-keyword-color col) (setq lst (list btag etag))))) ; (開始タグ 閉じタグ)のlist lst)) ;;;正規表現keywordにタグ (defun mode2htm-re-keyword (reg col context matchb matche) (and *mode2htm-re-keyword-replace-p* (setq reg (mode2htm-re-kwd-replace reg))) (setq lst (mode2htm-make-re-kwd-color-list col)) (and (consp col) ; マッチした全体用ダミーの開始タグ（普通のキーワードとのバッティングのチェック用。後で削除） (setq z '(0 0 " <dummy>" nil)) (find '0 lst :key #'car) (setq z (find '0 lst :key #'car)) ; z=マッチした全体の色指定 (delete '0 lst :key #'car)) (goto-char (point-max)) (while (scan-buffer reg :reverse t ) ;context キーワードが有効な文脈 (cond ((eq (logand context 15) 15) ; すべての文脈で有効 (cond ((consp col) ; match-end 0に閉じタグ (kwd-tag (cadr z) nil (cadddr z) nil (match-end 0)) ; matchした部分毎にタグ (dolist (x lst) (kwd-tag (cadr x) (caddr x) (cadddr x) (match-beginning (car x)) (match-end (car x)))) ; 最後にmatch-beginning 0に開始タグ(先に入れるとポイントがずれる) (kwd-tag (cadr z) (caddr z) nil (match-beginning 0) nil)) (t (kwd-tag col (car lst) (cadr lst) (match-beginning matchb) (match-end matche))))) ; 文字列、タグ、コメント以外で有効 ((eq (logand context 1) 1) (unless (or (eq (parse-point-syntax (1+ (point))) :string) (eq (parse-point-syntax (1+ (point))) :comment) (eq (parse-point-syntax (1+ (point))) :tag)) (cond ((consp col) (kwd-tag (cadr z) nil (cadddr z) nil (match-end 0)) (dolist (x lst) (kwd-tag (cadr x) (caddr x) (cadddr x) (match-beginning (car x)) (match-end (car x)))) (kwd-tag (cadr z) (caddr z) nil (match-beginning 0) nil)) (t (kwd-tag col (car lst) (cadr lst) (match-beginning matchb) (match-end matche)))))) ; 文字列内部で有効 ((eq (logand context 2) 2) (and (eq (parse-point-syntax (1+ (point))) :string) (cond ((consp col) (kwd-tag (cadr z) nil (cadddr z) nil (match-end 0)) (dolist (x lst) (kwd-tag (cadr x) (caddr x) (cadddr x) (match-beginning (car x)) (match-end (car x)))) (kwd-tag (cadr z) (caddr z) nil (match-beginning 0) nil)) (t (kwd-tag col (car lst) (cadr lst) (match-beginning matchb) (match-end matche)))))) ; タグ内部で有効 ((eq (logand context 4) 4) (and (eq (parse-point-syntax (1+ (point))) :tag) (cond ((consp col) (kwd-tag (cadr z) nil (cadddr z) nil (match-end 0)) (dolist (x lst) (kwd-tag (cadr x) (caddr x) (cadddr x) (match-beginning (car x)) (match-end (car x)))) (kwd-tag (cadr z) (caddr z) nil (match-beginning 0) nil)) (t (kwd-tag col (car lst) (cadr lst) (match-beginning matchb) (match-end matche)))))) ; コメント内部で有効 ((eq (logand context 8) 8) (and (eq (parse-point-syntax (1+ (point))) :comment) (cond ((consp col) (kwd-tag (cadr z) nil (cadddr z) nil (match-end 0)) (dolist (x lst) (kwd-tag (cadr x) (caddr x) (cadddr x) (match-beginning (car x)) (match-end (car x)))) (kwd-tag (cadr z) (caddr z) nil (match-beginning 0) nil)) (t (kwd-tag col (car lst) (cadr lst) (match-beginning matchb) (match-end matche))))))) (or (goto-char (- (match-beginning 0) 1)) (return)))) ;;;.................................... ;;; 1文字コメントの始めと終わりにタグ挿入 (defun mode2htm-comment () (goto-char (point-min)) (forward-char 1) ; 1文字目がcommentだとうまくhitしなかったので1個進めてみる (if (eq (parse-point-syntax (point)) :comment) (progn (forward-char -1) (insert "<span class=\"comment\">") (skip-syntax-spec-forward "^>") (insert "</span>")) (forward-char -1)) (while (not (eobp)) (and (skip-syntax-spec-forward "^<") (unless (or (eq (parse-point-syntax (point)) :string) (syntax-escape-p (preceding-char)) (syntax-symbol-prefix-p (preceding-char))) (insert "<span class=\"comment\">") (skip-syntax-spec-forward "^>") (insert "</span>") (forward-char -1))) (or (forward-char 1) (return)))) ;;; multi-comment (defun mode2htm-multi-comment (reg) (goto-char (point-max)) (while (scan-buffer reg :reverse t ) (unless (eq (parse-point-syntax (point)) :string) (goto-char (match-end 0)) (insert "</span>") (goto-char (match-beginning 0)) (insert "<span class=\"comment\">")) (goto-char (match-beginning 0)) (or (forward-char -1) (return)))) ;;; 各modeのソースをhtmに(本体) (defun mode2htm () (interactive) (let ((contents (buffer-substring (point-min) (point-max))) ; バッファの内容を取ってくる (mode buffer-mode)) ; modeをチェックしてmulti-commentとkwd-case-foldをset (cond ((or (string-equal mode "lisp-mode") (string-equal mode "lisp-interaction-mode")) (setq *mode2htm-multi-comment-regexp* (compile-regexp "#|\\([^#|]\\)*|#")) ; lispのmulti-comment検索用 (setq *mode2htm-kwd-case-fold* nil)) ((string-equal mode "hsp-mode") (setq *mode2htm-multi-comment-regexp* nil) (setq *mode2htm-kwd-case-fold* t)) ((or (string-equal mode "c-mode") (string-equal mode "c++-mode")) (setq *mode2htm-multi-comment-regexp* (compile-regexp "\\(^\\|[^/]\\)/\\*/?\\([^/]\\|[^*]/\\)*\\*/")) ; Cのmulti-comment検索用 (setq *mode2htm-kwd-case-fold* nil)) ((string-equal mode "perl-mode") (setq *mode2htm-multi-comment-regexp* nil) (setq *mode2htm-kwd-case-fold* nil)) ) (if (or (string-equal mode "html-mode") (string-equal mode "html+-mode")) (message "~A はこれではうまく変換できません" mode) (mode2htm1 contents mode)))) ;;; 変換実行処理 (defun mode2htm1 (contents mode) (setq bname (buffer-name (selected-buffer))) (setq tmp (concat "*mode2htm* " bname)) ; 出力用バッファ名 (get-buffer-create tmp) (set-buffer tmp) (erase-buffer tmp) (setq need-not-save t) (setq auto-save nil) (funcall mode) ; 入力バッファのモードにする (insert contents) ; 入力バッファの内容挿入 (long-operation (message "変換中.") (if (or (eq buffer-mode 'lisp-mode) (eq buffer-mode 'lisp-interaction-mode) (eq buffer-mode 'hsp-mode)) (setq *amp* "&" *lt* "<" *gt* ">") (setq *amp* "&" *lt* "<" *gt* ">")) (mode2htm-tag) (and regexp-keyword-list (mapcar #'(lambda (x) (apply #'mode2htm-re-keyword x)) regexp-keyword-list)) (setq list (mode2htm-make-kwd-list)) (and list (mapcar #'(lambda (x) (apply #'mode2htm-keyword x)) list)) (goto-char (point-min)) (replace-buffer " <dummy>" "") (and *mode2htm-multi-comment-regexp* (mode2htm-multi-comment *mode2htm-multi-comment-regexp*)) (and (or (eq buffer-mode 'c-mode) (eq buffer-mode 'c++-mode)) (mode2htm-multi-comment (compile-regexp "//.*$"))) ; c++-comment (mode2htm-comment) (goto-char (point-max)) (when (scan-buffer "<span class=\"comment\"></span>" :reverse t :limit (- (point-max) 31)) (delete-region (match-beginning 0) (match-end 0))) ; 文末に空タグが入るので消してみる (mode2htm-string) (goto-char (point-max)) (when (scan-buffer "<span class=\"string\"></span>" :reverse t :limit (- (point-max) 30)) (delete-region (match-beginning 0) (match-end 0))) ; 文末に空タグが入るので消してみる (and (string-equal *amp* "&") (mode2htm-tag2)) (set-buffer tmp) (html-mode) ; html-modeにする。html+-modeでもok (pop-to-buffer tmp) (set-buffer-modified-p nil) (message "chenged."))) ; これが出なかったらどっかで無限ループってるのでC-gで止めてみて |
| 不具合：正規表現キーワードと普通のキーワードがバッティングした時xyzzyと同じ色分けにならない。 （正規表現に先にタグを入れてるのでそちらが優先されることが多い） lisp-modeの時：キーワードで&<>に続くキーワードを検索する時に失敗するかも。 （”&optional”がbuffer内で”&optional”(”;”なし)になってるので”\\<optional”とかで探せない等等...） ”let*”もタグが入らなかった。132行目辺りを(concat "\\_b\\(" l ")\\>")とかに変えてみて下さい。 |
| ◆ini2css.l (2001/11/23) 上の変更に合わせて文字色0(元の色)のタグ追加 |
;;;xyzzy.iniの色設定をcssにする (2001/11/23) ;;;xyzzy.ini(~xyzzy/user/の中にある)を読み込んで ;;; M-x mode2htm-ini-to-css ;;; ;;;textColor=#ffcc00 =(B*$10000)+(G*$100)+R (16進数 ff0000+cc00+00) ;;;fg1=#ff =#0000ff (defun ini-scan-col (col) (setq col (parse-integer col :radix 16)) (setq b (floor col #x10000)) (setq g (floor (mod col #x10000) #x100)) (setq r (mod col #x100)) (setq col (+ (* r #x10000) (* g #x100) b))) (defun ini-scan (reg st et) (when (scan-buffer reg :tail t) (setq col (ini-scan-col (match-string 1))) (format t "~A~6,'0x~A~%" st col et))) (defun ini-scan1 (reg st et) (when (scan-buffer reg :tail t) (setq col (ini-scan-col (match-string 2))) (format t ".~A~A~6,'0x~A~%" (match-string 1) st col et))) (defun mode2htm-ini-to-css () (interactive) (setq bname (buffer-name (selected-buffer))) (setq tmp "*ini-css*") ; 出力用バッファ名 (get-buffer-create tmp) (set-buffer tmp) (erase-buffer tmp) (setq need-not-save t) (setq auto-save nil) (set-buffer bname) (goto-char (point-min)) (with-output-to-buffer (tmp nil) (ini-scan (compile-regexp "textColor=#\\([0-9a-f]+\\)" t) "body{color:#" ";}") ; "検索文字列" "cssのtag" (ini-scan (compile-regexp "backColor=#\\([0-9a-f]+\\)" t) "body{background-color:#" ";}") (ini-scan (compile-regexp "kwdColor1=#\\([0-9a-f]+\\)" t) "span.kwd1{color:#" ";}") (ini-scan (compile-regexp "kwdColor2=#\\([0-9a-f]+\\)" t) "span.kwd2{color:#" ";}") (ini-scan (compile-regexp "kwdColor3=#\\([0-9a-f]+\\)" t) "span.kwd3{color:#" ";}") (ini-scan (compile-regexp "stringColor=#\\([0-9a-f]+\\)" t) "span.string{color:#" ";}") (ini-scan (compile-regexp "commentColor=#\\([0-9a-f]+\\)" t) "span.comment{color:#" ";}") (ini-scan (compile-regexp "tagColor=#\\([0-9a-f]+\\)" t) "span.tag{color:#" ";}") (setq freg (compile-regexp "\\(fg[0-9]+\\)=#\\([0-9a-f]+\\)" t)) (setq breg (compile-regexp "\\(bg[0-9]+\\)=#\\([0-9a-f]+\\)" t)) (dotimes (n 16) (ini-scan1 freg "{color:#" ";}") ; 文字色1-15 (ini-scan1 breg "{background-color:#" ";}")) ; 背景色1-15 (set-buffer tmp) (goto-char (point-min)) ; 文字色0 元の色 (and (scan-buffer "body{color:#\\([0-9a-f]+\\)" :regexp t :tail t :case-fold t ) (format t ".fg0{color:#~A;}~%" (match-string 1))) ; kwd1-3反転 (setq bg (and (scan-buffer "body{background-color:#\\([0-9a-f]+\\)" :regexp t :case-fold t ) (match-string 1))) (while (scan-buffer "span.kwd\\([1-3]+\\){color:#\\([0-9a-f]+\\)" :regexp t :tail t :case-fold t ) (format t ".kwd~Ah{color:#~A;background-color:#~A;}~%" (match-string 1) bg (match-string 2))) (css-mode) ; css-modeにする (pop-to-buffer tmp) (set-buffer-modified-p nil) (message "chenged."))) |