emacsのバッファをHTMLに

what?

ちょっとだけxyzzyで遊んでたら、buf2html が面白そうだったので、emacsでも作ってみた。既にあるかもしれない。

06/16 補足: 既にありました→face2html

#include <stdio.h>

int main(int argc, char **argv )
{
        int i;

        if ( argc < 2 )
                puts("アレとかアレとか");
        
        for ( i=0; i<argc; i++ ) {
                puts( argv[i] );
        }
}

つかいかた

ロードしてM-x buf2htmlすると投げやりなHTMLを吐いてくれます。 preで囲ったり、一緒に出力される適当なCSSとかをうまくほげほげしてなんとかしてください。

ソース

下がbuf2html自身をbuf2htmlしたものをCSSとかちょろちょろやったもの。

;; Copyright (c) 2004 wo
;; Author: wo <mori_oto@hotmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

(defvar buf2html-class-prefix "face-"
  "*Prefix for class attributes generated by buf2html.")

(defvar buf2html-webcolors
  '(("aliceblue"."#f0f8ff")
    ("antiquewhite"."#faebd7")
    ("aqua"."#00ffff")
    ("aquamarine"."#7fffd4")
    ("azure"."#f0ffff")
    ("beige"."#f5f5dc")
    ("bisque"."#ffe4c4")
    ("black"."#000000")
    ("blanchedalmond"."#ffebcd")
    ("blue"."#0000ff")
    ("blueviolet"."#8a2be2")
    ("brown"."#a52a2a")
    ("burlywood"."#deb887")
    ("cadetblue"."#5f9ea0")
    ("chartreuse"."#7fff00")
    ("chocolate"."#d2691e")
    ("coral"."#ff7f50")
    ("cornflowerblue"."#6495ed")
    ("cornsilk"."#fff8dc")
    ("crimson"."#dc143c")
    ("cyan"."#00ffff")
    ("darkblue"."#00008b")
    ("darkcyan"."#008b8b")
    ("darkgoldenrod"."#b8860b")
    ("darkgray"."#a9a9a9")
    ("darkgreen"."#006400")
    ("darkgrey"."#a9a9a9")
    ("darkkhaki"."#bdb76b")
    ("darkmagenta"."#8b008b")
    ("darkolivegreen"."#556b2f")
    ("darkorange"."#ff8c00")
    ("darkorchid"."#9932cc")
    ("darkred"."#8b0000")
    ("darksalmon"."#e9967a")
    ("darkseagreen"."#8fbc8f")
    ("darkslateblue"."#483d8b")
    ("darkslategray"."#2f4f4f")
    ("darkslategrey"."#2f4f4f")
    ("darkturquoise"."#00ced1")
    ("darkviolet"."#9400d3")
    ("deeppink"."#ff1493")
    ("deepskyblue"."#00bfff")
    ("dimgray"."#696969")
    ("dimgrey"."#696969")
    ("dodgerblue"."#1e90ff")
    ("firebrick"."#b22222")
    ("floralwhite"."#fffaf0")
    ("forestgreen"."#228b22")
    ("fuchsia"."#ff00ff")
    ("gainsboro"."#dcdcdc")
    ("ghostwhite"."#f8f8ff")
    ("gold"."#ffd700")
    ("goldenrod"."#daa520")
    ("gray"."#808080")
    ("green"."#008000")
    ("greenyellow"."#adff2f")
    ("grey"."#808080")
    ("honeydew"."#f0fff0")
    ("hotpink"."#ff69b4")
    ("indianred"."#cd5c5c")
    ("indigo"."#4b0082")
    ("ivory"."#fffff0")
    ("khaki"."#f0e68c")
    ("lavender"."#e6e6fa")
    ("lavenderblush"."#fff0f5")
    ("lawngreen"."#7cfc00")
    ("lemonchiffon"."#fffacd")
    ("lightblue"."#add8e6")
    ("lightcoral"."#f08080")
    ("lightcyan"."#e0ffff")
    ("lightgoldenrodyellow"."#fafad2")
    ("lightgray"."#d3d3d3")
    ("lightgreen"."#90ee90")
    ("lightgrey"."#d3d3d3")
    ("lightpink"."#ffb6c1")
    ("lightsalmon"."#ffa07a")
    ("lightseagreen"."#20b2aa")
    ("lightskyblue"."#87cefa")
    ("lightslategray"."#778899")
    ("lightslategrey"."#778899")
    ("lightsteelblue"."#b0c4de")
    ("lightyellow"."#ffffe0")
    ("lime"."#00ff00")
    ("limegreen"."#32cd32")
    ("linen"."#faf0e6")
    ("magenta"."#ff00ff")
    ("maroon"."#800000")
    ("mediumaquamarine"."#66cdaa")
    ("mediumblue"."#0000cd")
    ("mediumorchid"."#ba55d3")
    ("mediumpurple"."#9370db")
    ("mediumseagreen"."#3cb371")
    ("mediumslateblue"."#7b68ee")
    ("mediumspringgreen"."#00fa9a")
    ("mediumturquoise"."#48d1cc")
    ("mediumvioletred"."#c71585")
    ("midnightblue"."#191970")
    ("mintcream"."#f5fffa")
    ("mistyrose"."#ffe4e1")
    ("moccasin"."#ffe4b5")
    ("navajowhite"."#ffdead")
    ("navy"."#000080")
    ("oldlace"."#fdf5e6")
    ("olive"."#808000")
    ("olivedrab"."#6b8e23")
    ("orange"."#ffa500")
    ("orangered"."#ff4500")
    ("orchid"."#da70d6")
    ("palegoldenrod"."#eee8aa")
    ("palegreen"."#98fb98")
    ("paleturquoise"."#afeeee")
    ("palevioletred"."#db7093")
    ("papayawhip"."#ffefd5")
    ("peachpuff"."#ffdab9")
    ("peru"."#cd853f")
    ("pink"."#ffc0cb")
    ("plum"."#dda0dd")
    ("powderblue"."#b0e0e6")
    ("purple"."#800080")
    ("red"."#ff0000")
    ("rosybrown"."#bc8f8f")
    ("royalblue"."#4169e1")
    ("saddlebrown"."#8b4513")
    ("salmon"."#fa8072")
    ("sandybrown"."#f4a460")
    ("seagreen"."#2e8b57")
    ("seashell"."#fff5ee")
    ("sienna"."#a0522d")
    ("silver"."#c0c0c0")
    ("skyblue"."#87ceeb")
    ("slateblue"."#6a5acd")
    ("slategray"."#708090")
    ("slategrey"."#708090")
    ("snow"."#fffafa")
    ("springgreen"."#00ff7f")
    ("steelblue"."#4682b4")
    ("tan"."#d2b48c")
    ("teal"."#008080")
    ("thistle"."#d8bfd8")
    ("tomato"."#ff6347")
    ("turquoise"."#40e0d0")
    ("violet"."#ee82ee")
    ("wheat"."#f5deb3")
    ("white"."#ffffff")
    ("whitesmoke"."#f5f5f5")
    ("yellow"."#ffff00")
    ("yellowgreen"."#9acd32")))

(defvar buf2html-rgb-txt "/usr/X11R6/lib/X11/rgb.txt"
  "*Path to X11's color database file.")
  
(defun buf2html-color-values-from-rgb.txt (x11color)
  (with-temp-buffer
    (let ((status (call-process "egrep" buf2html-rgb-txt (current-buffer) nil
                                "-wi" (concat "[0-9]+ +[0-9]+ +[0-9]+[ \t]+"
                                              x11color "$"))))
      (if (/= status 0)
          nil
        (goto-char (point-min))
        (looking-at " *\\([0-9]+\\) +\\([0-9]+\\) +\\([0-9]+\\)")
        ;; Multiply 8bit values by 257 to extend them to 16bit values.
        ;; (e.g., 0x81 => 0x8181, 0xFF => 0xFFFF)
        (list (* 257 (string-to-int (match-string 1)))
              (* 257 (string-to-int (match-string 2)))
              (* 257 (string-to-int (match-string 3))))))))

(defun buf2html-color-values (x11color)
  (if (eq (framep (selected-frame)) t)
      (buf2html-color-values-from-rgb.txt x11color)
    (color-values x11color)))

;; Not all X11 colors are supported by web browsers.
;; Some colors have different values between webcolors and X11 colors.
;; Return "#rrggbb" in such cases.
(defun buf2html-x11color-to-webcolor (x11color)
  (let (rgb)
    (cond
     ((eq (aref x11color 0) ?#) x11color)
     ((setq rgb (buf2html-color-values x11color))
      (let ((rgbcolor (apply 'format "#%02x%02x%02x"
                             (mapcar (lambda (val) (/ val 256)) rgb)))
            (canoncolor (if (string-match " " x11color)
                            (remove ?\  x11color)
                          x11color)))   ; do not downcase here to preserve
                                        ; case in output.
        (if (string= rgbcolor (cdr (assoc (downcase canoncolor)
                                          buf2html-webcolors)))
            canoncolor
          rgbcolor)))
     (t (error "Unknown color name: %s" x11color)))))

(defun buf2html-face2css (face-name)
  (interactive "i")
  (save-excursion
    (let ((face (or face-name
                    (intern (completing-read 
                             "face name: " 
                             (mapcar 
                              (lambda (face)
                                (cons (symbol-name face) 3)) (face-list)))))))
      
      (princ (format ".%s {\n" (buf2html-face-to-class face)))
       
      (if (face-bold-p face)
          (princ "\tfont-weight: bold;\n"))
      (if (face-foreground face)
          (princ (format "\tcolor: %s;\n" (buf2html-x11color-to-webcolor (face-foreground face)))))
      (if (face-background face)
          (princ (format "\tbackground-color: %s;\n" (buf2html-x11color-to-webcolor (face-background face)))))
      (princ "}\n"))))


(defun buf2html-get-valid-face (face)
  (let ((facel (member 'face face)))
    (and facel (car (cdr facel)))))

(defun buf2html-face-to-class (face)
  (concat buf2html-class-prefix (symbol-name face)))

(defun buf2html-print-begin-face (face)
  (let ((f (buf2html-get-valid-face face)))
    (if f (format "<span class=\"%s\">" (buf2html-face-to-class f))
      "")))

(defun buf2html-print-end-face (face)
  (if (buf2html-get-valid-face face)
      "</span>"
    ""))

(defun buf2html-region (beg end)
  "Convert region to HTML."
  (interactive "r")
  (let ((str (buffer-substring beg end)))
    (with-temp-buffer
      (insert str)
      (buf2html (current-buffer)))))


(defun buf2html (buffer)
  (interactive "bBuffer Name:")

  (set-buffer buffer)
  (save-excursion

    (let ((out (generate-new-buffer "*buf2html*")))

      (copy-to-buffer out (point-min) (point-max))
      (set-buffer out)
      (untabify (point-min) (point-max))
      
      (let* ((len (point-max))
             (beg (point-min))
             (end (or (next-property-change beg) len))
             (face (text-properties-at beg))
             (tagmarklist)
             (facelist))
        
        (while (< beg len)
          
          (goto-char beg)
          (setq tagmarklist 
                (cons (cons (point-marker) 
                            (buf2html-print-begin-face face)) tagmarklist))
          
          (goto-char end)
          (setq tagmarklist
                (cons (cons (point-marker)
                            (buf2html-print-end-face face)) tagmarklist))
          
          (setq beg end)
          (setq end (or (next-property-change beg) len))
          
          (setq face (text-properties-at beg))
          
          (let ((face (buf2html-get-valid-face face)))
            (if (and face
                     (not (member face facelist)))
                (setq facelist (cons face facelist)))))
        
        (format-replace-strings
         '(;;("  " . "  ")
           ("&" . "&amp;")
           (">" . "&gt;")
           ("<" . "&lt;")
           ;;("\n" . "<br>\n")
           ("\"" . "&quot;")))
        
        ;;(format-replace-strings 
        ;;'(("  " . "  ")))
        
        (mapcar (lambda (tag)
                  (goto-char (car tag))
                  (insert (cdr tag)))
                tagmarklist)
        
        (goto-char (point-max))

        (let ((standard-output (generate-new-buffer "*buf2html.css*")))
          (mapcar 'buf2html-face2css facelist)
          (delete-other-windows)
          (split-window-vertically)
          (switch-to-buffer out)
          (other-window 1)
          (switch-to-buffer standard-output))
        ))))