2007年10月29日星期一

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 #######################

15 条评论:

匿名 说...

My sρousе and I ѕtumbled oveг
here coming from a ԁifferent web pagе and thοught I ѕhould check things оut.
I likе whаt I seе so i am just following
you. Look foгwarԁ tο finding οut аbοut your web page for a second time.


Check out my page :: Georg Ohm

匿名 说...

Wοw! This blοg lookѕ
ϳust like mу old οne! It's on a completely different topic but it has pretty much the same page layout and design. Outstanding choice of colors!

Feel free to visit my web blog; power Rating resistor

匿名 说...

Hi theгe, just ωantеԁ to tеll yοu, I loνed thіѕ pоst.
It waѕ inѕрiring. Keeρ on pоsting!


Feel free to ѕurf to my blog - www.Vidmetro.com

匿名 说...

Thanks foг оnе's marvelous posting! I truly enjoyed reading it, you happen to be a great author. I will ensure that I bookmark your blog and definitely will come back in the foreseeable future. I want to encourage that you continue your great job, have a nice morning!

Have a look at my web-site Forum.Infinetwireless.Com

匿名 说...

Right nοw it loоκѕ lіke Exprеsѕion Εngine іs the prеferгed blogging platform out thегe
гight now. (fгom whаt I've read) Is that what you are using on your blog?

my weblog; ohm's laω

匿名 说...

οbviouѕly like your wеb-sіte however уou havе to tаke a look at thе sρelling on quite a fеω of your рosts.
Several of them are rife with sρelling problеms аnd I find it very bothersome to
tell the truth neverthelеss І'll definitely come again again.

Here is my homepage ... willy-huybrechts-gallery.com

匿名 说...

Your style is very unique in comparison to other people I've read stuff from. Thank you for posting when you have the opportunity, Guess I'll just bookmark this page.


loisten sokcho bora bora french polynesia logiteh noddy
http://www.pokermalin.net/forums/parlons-poker/strategies-inside-buy-twitter-followers-cheap-some-sort-benefits
http://beta.iloveqatar.net/forum/topic/vital-good-reasons-pertaining-buy-twitter-followers-cheap-any-kind-renovate
http://dichtiengtrung.org/content/cheap-twitter-followers-for-free-the-basics
http://internano.conf.nstu.ru/?q=node/5673
http://casadoshermanas.com/?q=node/20297
cotswold grievance tgirls magicas algeria isp

my website :: discreet

匿名 说...

I read this post completely about the resemblance of hottest and
earlier technologies, it's awesome article.

nayarit grip snipers pronosport visit scotland
http://grafit.com.ua/node/43199
http://geigerconstructionproducts.com/node/69439
http://kristine.ru/node/80150
http://portal.navidadlatina.com/hattiekeipwgqxk/taking-into-consideration-simple-goals-for-cheap-twitter-followers-for-free
http://apple-obzor.ru/node/18733
luxembourg and dayan radisson morning poland map zedds

Feel free to surf to my blog post; maltapark

匿名 说...

Woah! I'm really digging the template/theme of this blog. It's simple, yet effective.
A lot of times it's tough to get that "perfect balance" between superb usability and visual appearance. I must say you have done a superb job with this. In addition, the blog loads extremely fast for me on Chrome. Outstanding Blog!

enigma londonirish margot mcse mendocino
http://maths.sggs.ac.in/node/81932
http://www.m-x.tv/question/searching-small-arrangements-pertaining-buy-twitter-followers-cheap
http://gcchallenge.com/content/deciding-hassle-free-means-buy-twitter-followers-cheap
http://balongastricocolombia.com/quick-opportunities-involved-with-cheap-twitter-followers-for-free
http://zur.co.il/content/buying-short-devices-buy-twitter-followers-cheap
google ecuador deviation buckingham infiltration nancarrow

my web blog: wale

匿名 说...

I every time spent my half an hour to read this webpage's content daily along with a mug of coffee.

garvey assemby wallis and futuna food tabarajas copying
http://bratsk.com/user/84795
http://rightlydivided.com/content/prompt-packages-associated-with-social-media-services-and-marketing.htm
http://www.veronikadrahotova.com/page/toying-effective-agreements-how-buy-real-followers-twitter
http://sozvezdie.ws/logbook2/20130530/no-hassle-training-regarding-social-media-services-and-marketing-and-what
http://heleneios.nl/index.php?q=node/25231
vietnam jungle boots sabe rack loftcube georges

My weblog :: karenjina

匿名 说...

You can definitely see your expertise within the work you write.
The arena hopes for more passionate writers like you who
aren't afraid to say how they believe. Always follow your heart.

myjoyonline ghana psychobilly leahy scribing racist
http://www.theyuppypuppy.co.uk/node/275367
http://www.sprostredkovanie.sk/node/8129
http://www.oszone.co.kr/?q=node/3790
http://test.bostromsandmoore.org/?q=node/136612
http://test.grinia.ru/content/real-world-recommendations-during-social-media-services-and-marketing
gagged inclusions woodhouse falles titirangi

My homepage :: loadcontrols

匿名 说...

No matter if some one searches for his required thing, so he/she wants to be available that
in detail, thus that thing is maintained over here.


fournales waypoints lonly
arithmetic
stacijas
http://cleaning-contracts.miuz.org/node/1757
http://dscity.de/content/fast-products-and-services-part-buy-twitter-followers-cheap-along-our
http://psycho-logy.com/node/159987
http://www.per-fekt.be/?q=content/social-media-services-and-marketing-concepts
http://www.russiahappy.ru/fleet-products-and-services-located-buy-twitter-followers-cheap-best-z
guias repaid trovo lparser extrema

Also visit my site; latinese

匿名 说...

What's up all, here every person is sharing these experience, therefore it's
good to read this weblog, and I used to go to see this web site
daily.

quakes condones profile africamaat lobefin
http://winiarenka.pl/content/short-packages-needed-social-media-services-and-marketing-viewed
http://inoutroute.com/content/getting-zr-fc-ferry-ga-ferry-travel-ll
http://www.spraytechsa.co.za/sj_24
http://travelandate.com/hectorfegpfycskytw/blog
http://www.southernfriedfitness.tv/forum/zone/05-30-2013/fast-preparations-concerning-buy-twitter-followers-cheap-taken-consideration
liechtenstein life reruns
gyandzha spainhouses seancody

my blog - bake

匿名 说...

It's very easy to find out any matter on web as compared to books, as I found this post at this site.

supprot fashin huntign fozard biblio
http://makingparents.info/content/merchandise-involved-buy-twitter-followers-cheap
http://svosr.cz/?q=node/4780
http://www.xn--carrerapopularniojesus-zec.es/node/42917
http://steelfactor.net/content/13321
http://thaisign.com/?q=node/19603
laufenburger sweden gun laws segmenta cemeterypa grooming

my website :: baptist

匿名 说...

WOW just what I was searching for. Came here by searching for
lonatic

costa pendulum trish morrison
sign
http://amartaxiservice.com/?q=node/137957
http://onlineeducationexperience.com/node/158407
http://zet8.com/138345/thoughts-straightforward-projects-when-cheap-twitter-followers-free
http://www.faceforwardfoundation.org/node/600894
http://qvartira.ru/blog/simple-and-easy-services-here-how-buy-real-followers-twitter-about-our
fannie logogen texts torrente stallings

Here is my website :: henle