Emacs code-publish

;;; code-publish.el --- convert codes into html, used for msn space
;; Because of the limited allowed file types,
;; if the extension of this file is not .el, please change it manually.

;; Author: Qichen Huang <jasonal00+emacs at gmail.com>
;; Version: 0.2

;;; Commentary:
;; (require 'code-publish)

;; Usage:
;; M-x code-publish
;; the converted html code will be copied to kill-ring,
;; which could be directly pasted onto msn space as html code.

;; History:
;; 14.08.2006 Version 0.2
;; 14.08.2006  Added: tag <div>
;; 28.07.2006 Version 0.1

;;; Code:

(defun code-publish ()
  "Convert region between mark and point into HTML, save the result into kill ring."
  (interactive)
  (kill-new (code-publish-region (mark) (point)))
  (message "Code convert completed."))



(defvar font-header "<font size=\"2\">")
(defvar div-header "<div style=\"background-color:rgb(255,255,224);\">")
(defvar footer "</div></font>")
(defvar tag-open "<span style=\"font-family: Courier New,Courier,Monospace;")
(defvar tag-close ">")
(defvar tag-end "</span>")
(defvar newline-tag "<br>")
(defvar space "&nbsp;")
(defvar space2 "&nbsp;&nbsp;")
(defvar space4 "&nbsp;&nbsp;&nbsp;&nbsp;")

(defvar code-builtin-color       " color: rgb(0,139,0);\"")
(defvar code-comment-color       " color: rgb(205,0,0); font-style: italic;\"")
(defvar code-constant-color      " color: rgb(47,79,79);\"")
(defvar code-doc-color           " color: rgb(0,139,0);\"")
(defvar code-function-name-color " color: rgb(0,0,255); font-weight: bold;\"")
(defvar code-keyword-color       " color: rgb(160,32,240);\"")
(defvar code-preprocessor-color  " color: rgb(250,128,114);\"")
(defvar code-string-color        " color: rgb(0,139,0);\"")
(defvar code-type-color          " color: rgb(0,0,128);\"")
(defvar code-variable-name-color " color: rgb(139,90,40);\"")
(defvar code-warning-color       " color: rgb(255,0,0);\"")
(defvar code-default-color       " \"")

(defun code-publish-region (begin-point end-point)
  (let ((beg (min begin-point end-point))
        (end (max begin-point end-point))
        (str "")
        (tmp nil)
        (result nil)
        (tface nil)
        (color "")
        )
    ;;(beginning-of-buffer)
    (unless (= beg end)
      (save-excursion
        (setq result (concat result font-header))
        (setq result (concat result div-header))
        (goto-char beg)
        (while (< (point) end)
          (setq tmp (next-single-property-change (point) 'face))
          (unless tmp
            (setq tmp end)) ;; there is no face change, set tmp to end point
          ;; no cross-line properties
          (when (> tmp (line-end-position))
            (setq tmp (line-end-position))) ;; New line
          ;; skip spaces and tabs
          (save-excursion
            (goto-char tmp)
            (when (looking-at "[ \t]+")
              (re-search-forward "[ \t]+" (line-end-position) t)
              (setq tmp (point))))
          (when (> tmp end)
            (setq tmp end))
          (setq str (buffer-substring-no-properties (point) tmp))
          (while (string-match "<" str)
            (setq str (replace-match "&lt;" t nil str)))
          (while (string-match ">" str)
            (setq str (replace-match "&gt;" t nil str)))
          (while (string-match "  " str)
            (setq str (replace-match space2 t nil str)))
          (while (string-match "\t" str)
            (setq str (replace-match space4 t nil str)))
          (setq tface (get-text-property (point) 'face))
          (when (listp tface)
            (setq tface (car tface)))
          (cond
           ((eq tface font-lock-builtin-face)
            (setq color code-builtin-color))
           ((eq tface font-lock-comment-face)
            (setq color code-comment-color))
           ((eq tface font-lock-constant-face)
            (setq color code-constant-color))
           ((eq tface font-lock-doc-face)
            (setq color code-doc-color))
           ((eq tface font-lock-function-name-face)
            (setq color code-function-name-color))
           ((eq tface font-lock-keyword-face)
            (setq color code-keyword-color))
           ((eq tface font-lock-preprocessor-face)
            (setq color code-preprocessor-color))
           ((eq tface font-lock-string-face)
            (setq color code-string-color))
           ((eq tface font-lock-type-face)
            (setq color code-type-color))
           ((eq tface font-lock-variable-name-face)
            (setq color code-variable-name-color))
           ((eq tface font-lock-warning-face)
            (setq color code-warning-color))
           (t (setq color code-default-color)))
          ;; (setq color "<span color=\"\">")
          (setq result (concat result tag-open color tag-close str tag-end))
          (when (= tmp (line-end-position))
            (setq result (concat result newline-tag))
            (setq tmp (+ 1 (line-end-position))))
          (goto-char tmp))
        (setq result (concat result footer))
        result
        ))))

(provide 'code-publish)

;;; ################ code-publish ends here #######################