martes, noviembre 11, 2008

Copy to Html

I was going to write something completely different but I had some troubles copying the source code to my blog. I Usually use a little script from Steve Yegge for copying the highlighted text from Emacs to Html.

It had some strange trouble converting the RGB colors and it was not setting the values of the default font.

Here is the code: (using the highlighter :D)

(defun html-string-color (face key)
(mapconcat (lambda (x) (format "%.2x" (/ x 256)))
( color-values (face-attribute
(make-face face) key)) ""))

(defun syntax-highlight-region (start end)
"Adds <font> tags into the region that correspond to the
current color of the text. Throws the result into a temp
buffer, so you don't dork the original."

(interactive "r")
(let ((text (buffer-substring start end)))
(with-output-to-temp-buffer "*html-syntax*"
(set-buffer standard-output)
(insert (format "<div style=\"color:#%s; background:#%s\" ><pre>"
(html-string-color 'default :foreground)
(html-string-color 'default :background)))
(save-excursion (insert text))
(save-excursion (syntax-html-escape-text))
(while (not (eobp))
(let ((plist (text-properties-at (point)))
(next-change
(or (next-single-property-change
(point) 'face (current-buffer))
(point-max))))
(syntax-add-font-tags (point) next-change)
(goto-char next-change)))
(insert "\n</pre></div>"))))

(defun syntax-add-font-tags (start end)
"Puts <font> tag around text between START and END."
(let (face color rgb name r g b)
(and
(setq face (get-text-property start 'face))
(or (if (listp face) (setq face (car face))) t)
(setq color (face-attribute face :foreground))
(setq rgb (assoc (downcase color) color-name-rgb-alist))
(destructuring-bind (name r g b) rgb
(let ((text (buffer-substring-no-properties start end)))
(delete-region start end)
(insert (format "<font color=#%.2x%.2x%.2x>"
(/ r 256) (/ g 256) (/ b 256)))
(insert text)
(insert "</font>"))))))

(defun syntax-html-escape-text ()
"HTML-escapes all the text in the current buffer,
starting at (point)."

(save-excursion (replace-string "<" "<"))
(save-excursion (replace-string ">" ">")))


BTW there's some minor issue with the greater than symbol inside of the strings.

No hay comentarios.: