diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse-html.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse-html.el | 754 |
1 files changed, 754 insertions, 0 deletions
diff --git a/emacs.d/elisp/muse/muse-html.el b/emacs.d/elisp/muse/muse-html.el new file mode 100644 index 0000000..6a9356b --- /dev/null +++ b/emacs.d/elisp/muse/muse-html.el @@ -0,0 +1,754 @@ +;;; muse-html.el --- publish to HTML and XHTML + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse 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 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested +;; appending an 'encoding="..."' fragment to the first line of the +;; sample publishing header so that when editing the resulting XHTML +;; file, Emacs would use the proper encoding. + +;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for +;; the <src> tag and provided an implementation for emacs-wiki. + +;; Charles Wang (wcy123 AT gmail DOT com) provided an initial +;; implementation of the <src> tag for Muse. + +;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further +;; ideas for the implementation of the <src> tag. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse HTML Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-regexps) +(require 'muse-xml-common) + +(defgroup muse-html nil + "Options controlling the behavior of Muse HTML publishing." + :group 'muse-publish) + +(defcustom muse-html-extension ".html" + "Default file extension for publishing HTML files." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-extension ".html" + "Default file extension for publishing XHTML files." + :type 'string + :group 'muse-html) + +(defcustom muse-html-style-sheet + "<style type=\"text/css\"> +body { + background: white; color: black; + margin-left: 3%; margin-right: 7%; +} + +p { margin-top: 1% } +p.verse { margin-left: 3% } + +.example { margin-left: 3% } + +h2 { + margin-top: 25px; + margin-bottom: 0px; +} +h3 { margin-bottom: 0px; } + </style>" + "Store your stylesheet definitions here. +This is used in `muse-html-header'. +You can put raw CSS in here or a <link> tag to an external stylesheet. +This text may contain <lisp> markup tags. + +An example of using <link> is as follows. + +<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">" + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-style-sheet + "<style type=\"text/css\"> +body { + background: white; color: black; + margin-left: 3%; margin-right: 7%; +} + +p { margin-top: 1% } +p.verse { margin-left: 3% } + +.example { margin-left: 3% } + +h2 { + margin-top: 25px; + margin-bottom: 0px; +} +h3 { margin-bottom: 0px; } + </style>" + "Store your stylesheet definitions here. +This is used in `muse-xhtml-header'. +You can put raw CSS in here or a <link> tag to an external stylesheet. +This text may contain <lisp> markup tags. + +An example of using <link> is as follows. + +<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />" + :type 'string + :group 'muse-html) + +(defcustom muse-html-header + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> +<html> + <head> + <title><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></title> + <meta name=\"generator\" content=\"muse.el\"> + <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\" + content=\"<lisp>muse-html-meta-content-type</lisp>\"> + <lisp> + (let ((maintainer (muse-style-element :maintainer))) + (when maintainer + (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\"))) + </lisp><lisp> + (muse-style-element :style-sheet muse-publishing-current-style) + </lisp> + </head> + <body> + <h1><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></h1> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing HTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-html-footer " +<!-- Page published by Emacs Muse ends here --> + </body> +</html>\n" + "Footer used for publishing HTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-header + "<?xml version=\"1.0\" encoding=\"<lisp> + (muse-html-encoding)</lisp>\"?> +<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" + \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> +<html xmlns=\"http://www.w3.org/1999/xhtml\"> + <head> + <title><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></title> + <meta name=\"generator\" content=\"muse.el\" /> + <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\" + content=\"<lisp>muse-html-meta-content-type</lisp>\" /> + <lisp> + (let ((maintainer (muse-style-element :maintainer))) + (when maintainer + (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\"))) + </lisp><lisp> + (muse-style-element :style-sheet muse-publishing-current-style) + </lisp> + </head> + <body> + <h1><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></h1> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing XHTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-footer " +<!-- Page published by Emacs Muse ends here --> + </body> +</html>\n" + "Footer used for publishing XHTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-html-anchor-on-word nil + "When true, anchors surround the closest word. This allows you +to select them in a browser (i.e. for pasting), but has the +side-effect of marking up headers in multiple colors if your +header style is different from your link style." + :type 'boolean + :group 'muse-html) + +(defcustom muse-html-table-attributes + " class=\"muse-table\" border=\"2\" cellpadding=\"5\"" + "The attribute to be used with HTML <table> tags. +Note that Muse supports insertion of raw HTML tags, as long +as you wrap the region in <literal></literal>." + :type 'string + :group 'muse-html) + +(defcustom muse-html-markup-regexps + `(;; Beginning of doc, end of doc, or plain paragraph separator + (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*" + "\\([" muse-regexp-blank "]*\n\\)\\)" + "\\|\\`\\s-*\\|\\s-*\\'\\)") + ;; this is somewhat repetitive because we only require the + ;; line just before the paragraph beginning to be not + ;; read-only + 3 muse-html-markup-paragraph)) + "List of markup rules for publishing a Muse page to HTML. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-html) + +(defcustom muse-html-markup-functions + '((anchor . muse-html-markup-anchor) + (table . muse-html-markup-table) + (footnote . muse-html-markup-footnote)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-html) + +(defcustom muse-html-markup-strings + '((image-with-desc . "<table class=\"image\" width=\"100%%\"> + <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr> + <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr> +</table>") + (image . "<img src=\"%s.%s\" alt=\"\">") + (image-link . "<a class=\"image-link\" href=\"%s\"> +<img src=\"%s.%s\"></a>") + (anchor-ref . "<a href=\"#%s\">%s</a>") + (url . "<a href=\"%s\">%s</a>") + (link . "<a href=\"%s\">%s</a>") + (link-and-anchor . "<a href=\"%s#%s\">%s</a>") + (email-addr . "<a href=\"mailto:%s\">%s</a>") + (anchor . "<a name=\"%1%\" id=\"%1%\">") + (emdash . "%s—%s") + (comment-begin . "<!-- ") + (comment-end . " -->") + (rule . "<hr>") + (fn-sep . "<hr>\n") + (no-break-space . " ") + (line-break . "<br>") + (enddots . "....") + (dots . "...") + (section . "<h2>") + (section-end . "</h2>") + (subsection . "<h3>") + (subsection-end . "</h3>") + (subsubsection . "<h4>") + (subsubsection-end . "</h4>") + (section-other . "<h5>") + (section-other-end . "</h5>") + (begin-underline . "<u>") + (end-underline . "</u>") + (begin-literal . "<code>") + (end-literal . "</code>") + (begin-cite . "<span class=\"citation\">") + (begin-cite-author . "<span class=\"citation-author\">") + (begin-cite-year . "<span class=\"citation-year\">") + (end-cite . "</span>") + (begin-emph . "<em>") + (end-emph . "</em>") + (begin-more-emph . "<strong>") + (end-more-emph . "</strong>") + (begin-most-emph . "<strong><em>") + (end-most-emph . "</em></strong>") + (begin-verse . "<p class=\"verse\">\n") + (verse-space . " ") + (end-verse-line . "<br>") + (end-last-stanza-line . "<br>") + (empty-verse-line . "<br>") + (end-verse . "</p>") + (begin-example . "<pre class=\"example\">") + (end-example . "</pre>") + (begin-center . "<center>\n<p>") + (end-center . "</p>\n</center>") + (begin-quote . "<blockquote>\n") + (end-quote . "\n</blockquote>") + (begin-quote-item . "<p class=\"quoted\">") + (end-quote-item . "</p>") + (begin-uli . "<ul>\n") + (end-uli . "\n</ul>") + (begin-uli-item . "<li>") + (end-uli-item . "</li>") + (begin-oli . "<ol>\n") + (end-oli . "\n</ol>") + (begin-oli-item . "<li>") + (end-oli-item . "</li>") + (begin-dl . "<dl>\n") + (end-dl . "\n</dl>") + (begin-ddt . "<dt><strong>") + (end-ddt . "</strong></dt>") + (begin-dde . "<dd>") + (end-dde . "</dd>") + (begin-table . "<table%s>\n") + (end-table . "</table>") + (begin-table-row . " <tr>\n") + (end-table-row . " </tr>\n") + (begin-table-entry . " <%s>") + (end-table-entry . "</%s>\n")) + "Strings used for marking up text as HTML. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-xhtml-markup-strings + '((image-with-desc . "<table class=\"image\" width=\"100%%\"> + <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr> + <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr> +</table>") + (image . "<img src=\"%s.%s\" alt=\"\" />") + (image-link . "<a class=\"image-link\" href=\"%s\"> +<img src=\"%s.%s\" alt=\"\" /></a>") + (rule . "<hr />") + (fn-sep . "<hr />\n") + (line-break . "<br />") + (begin-underline . "<span style=\"text-decoration: underline;\">") + (end-underline . "</span>") + (begin-center . "<p style=\"text-align: center;\">\n") + (end-center . "\n</p>") + (end-verse-line . "<br />") + (end-last-stanza-line . "<br />") + (empty-verse-line . "<br />")) + "Strings used for marking up text as XHTML. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles. + +If a markup rule is not found here, `muse-html-markup-strings' is +searched." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-xhtml1.1-markup-strings + '((anchor . "<a id=\"%s\">")) + "Strings used for marking up text as XHTML 1.1. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles. + +If a markup rule is not found here, `muse-xhtml-markup-strings' +and `muse-html-markup-strings' are searched." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-html-markup-tags + '(("class" t t t muse-html-class-tag) + ("div" t t t muse-html-div-tag) + ("src" t t nil muse-html-src-tag)) + "A list of tag specifications, for specially marking up HTML." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-html) + +(defcustom muse-html-meta-http-equiv "Content-Type" + "The http-equiv attribute used for the HTML <meta> tag." + :type 'string + :group 'muse-html) + +(defcustom muse-html-meta-content-type "text/html" + "The content type used for the HTML <meta> tag. +If you are striving for XHTML 1.1 compliance, you may want to +change this to \"application/xhtml+xml\"." + :type 'string + :group 'muse-html) + +(defcustom muse-html-meta-content-encoding (if (featurep 'mule) + 'detect + "iso-8859-1") + "The charset to append to the HTML <meta> tag. +If set to the symbol 'detect, use `muse-html-encoding-map' to try +and determine the HTML charset from emacs's coding. If set to a +string, this string will be used to force a particular charset" + :type '(choice string symbol) + :group 'muse-html) + +(defcustom muse-html-encoding-default 'iso-8859-1 + "The default Emacs buffer encoding to use in published files. +This will be used if no special characters are found." + :type 'symbol + :group 'muse-html) + +(defcustom muse-html-charset-default "iso-8859-1" + "The default HTML meta charset to use if no translation is found in +`muse-html-encoding-map'." + :type 'string + :group 'muse-html) + +(defcustom muse-html-src-allowed-modes t + "Modes that we allow the <src> tag to colorize. +If t, permit the <src> tag to colorize any mode. + +If a list of mode names, such as '(\"html\" \"latex\"), and the +lang argument to <src> is not in the list, then use fundamental +mode instead." + :type '(choice (const :tag "Any" t) + (repeat (string :tag "Mode"))) + :group 'muse-html) + +(defun muse-html-insert-anchor (anchor) + "Insert an anchor, either around the word at point, or within a tag." + (skip-chars-forward (concat muse-regexp-blank "\n")) + (if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>")) + (let ((tag (match-string 1))) + (goto-char (match-end 0)) + (muse-insert-markup (muse-markup-text 'anchor anchor)) + (when muse-html-anchor-on-word + (or (and (search-forward (format "</%s>" tag) + (muse-line-end-position) t) + (goto-char (match-beginning 0))) + (forward-word 1))) + (muse-insert-markup "</a>")) + (muse-insert-markup (muse-markup-text 'anchor anchor)) + (when muse-html-anchor-on-word + (forward-word 1)) + (muse-insert-markup "</a>\n"))) + +(defun muse-html-markup-anchor () + (unless (get-text-property (match-end 1) 'muse-link) + (save-match-data + (muse-html-insert-anchor (match-string 2))) + (match-string 1))) + +(defun muse-html-markup-paragraph () + (let ((end (copy-marker (match-end 0) t))) + (goto-char (match-beginning 0)) + (when (save-excursion + (save-match-data + (and (not (get-text-property (max (point-min) (1- (point))) + 'muse-no-paragraph)) + (re-search-backward "<\\(/?\\)p[ >]" nil t) + (not (string-equal (match-string 1) "/"))))) + (when (get-text-property (1- (point)) 'muse-end-list) + (goto-char (previous-single-property-change (1- (point)) + 'muse-end-list))) + (muse-insert-markup "</p>")) + (goto-char end)) + (cond + ((eobp) + (unless (bolp) + (insert "\n"))) + ((get-text-property (point) 'muse-no-paragraph) + (forward-char 1) + nil) + ((eq (char-after) ?\<) + (cond + ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]") + (muse-insert-markup "<p>")) + ((looking-at "<a ") + (if (looking-at "<a[^>\n]+><img") + (muse-insert-markup "<p class=\"image-link\">") + (muse-insert-markup "<p>"))) + ((looking-at "<img[ >]") + (muse-insert-markup "<p class=\"image\">")) + (t + (forward-char 1) + nil))) + ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n") + (muse-insert-markup "<p class=\"first\">")) + (t + (muse-insert-markup "<p>")))) + +(defun muse-html-markup-footnote () + (cond + ((get-text-property (match-beginning 0) 'muse-link) + nil) + ((= (muse-line-beginning-position) (match-beginning 0)) + (prog1 + (let ((text (match-string 1))) + (muse-insert-markup + (concat "<p class=\"footnote\">" + "<a class=\"footnum\" name=\"fn." text + "\" href=\"#fnr." text "\">" + text ".</a>"))) + (save-excursion + (save-match-data + (let* ((beg (goto-char (match-end 0))) + (end (and (search-forward "\n\n" nil t) + (prog1 + (copy-marker (match-beginning 0)) + (goto-char beg))))) + (while (re-search-forward (concat "^[" + muse-regexp-blank + "]+\\([^\n]\\)") + end t) + (replace-match "\\1" t))))) + (replace-match ""))) + (t (let ((text (match-string 1))) + (muse-insert-markup + (concat "<sup><a class=\"footref\" name=\"fnr." text + "\" href=\"#fn." text "\">" + text "</a></sup>"))) + (replace-match "")))) + +(defun muse-html-markup-table () + (muse-xml-markup-table muse-html-table-attributes)) + +;; Handling of tags for HTML + +(defun muse-html-strip-links (string) + "Remove all HTML links from STRING." + (muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t)) + +(defun muse-html-insert-contents (depth) + "Scan the current document and generate a table of contents at point. +DEPTH indicates how many levels of headings to include. The default is 2." + (let ((max-depth (or depth 2)) + (index 1) + base contents l end) + (save-excursion + (goto-char (point-min)) + (search-forward "Page published by Emacs Muse begins here" nil t) + (catch 'done + (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t) + (unless (and (get-text-property (point) 'read-only) + (not (get-text-property (match-beginning 0) + 'muse-contents))) + (remove-text-properties (match-beginning 0) (match-end 0) + '(muse-contents nil)) + (setq l (1- (string-to-number (match-string 1)))) + (if (null base) + (setq base l) + (if (< l base) + (throw 'done t))) + (when (<= l max-depth) + ;; escape specials now before copying the text, so that we + ;; can deal sanely with both emphasis in titles and + ;; special characters + (goto-char (match-end 2)) + (setq end (point-marker)) + (muse-publish-escape-specials (match-beginning 2) end + nil 'document) + (muse-publish-mark-read-only (match-beginning 2) end) + (setq contents (cons (cons l (buffer-substring-no-properties + (match-beginning 2) end)) + contents)) + (set-marker end nil) + (goto-char (match-beginning 2)) + (muse-html-insert-anchor (concat "sec" (int-to-string index))) + (setq index (1+ index))))))) + (setq index 1 contents (nreverse contents)) + (let ((depth 1) (sub-open 0) (p (point))) + (muse-insert-markup "<div class=\"contents\">\n<dl>\n") + (while contents + (muse-insert-markup "<dt>\n" + "<a href=\"#sec" (int-to-string index) "\">" + (muse-html-strip-links (cdar contents)) + "</a>\n" + "</dt>\n") + (setq index (1+ index) + depth (caar contents) + contents (cdr contents)) + (when contents + (cond + ((< (caar contents) depth) + (let ((idx (caar contents))) + (while (< idx depth) + (muse-insert-markup "</dl>\n</dd>\n") + (setq sub-open (1- sub-open) + idx (1+ idx))))) + ((> (caar contents) depth) ; can't jump more than one ahead + (muse-insert-markup "<dd>\n<dl>\n") + (setq sub-open (1+ sub-open)))))) + (while (> sub-open 0) + (muse-insert-markup "</dl>\n</dd>\n") + (setq sub-open (1- sub-open))) + (muse-insert-markup "</dl>\n</div>\n") + (muse-publish-mark-read-only p (point))))) + +(defun muse-html-denote-headings () + "Place a text property on any headings in the current buffer. +This allows the headings to be picked up later on if publishing a +table of contents." + (save-excursion + (goto-char (point-min)) + (search-forward "Page published by Emacs Muse begins here" nil t) + (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t) + (unless (get-text-property (point) 'read-only) + (add-text-properties (match-beginning 0) (match-end 0) + '(muse-contents t)))))) + +(defun muse-html-class-tag (beg end attrs) + (let ((name (cdr (assoc "name" attrs)))) + (when name + (goto-char beg) + (muse-insert-markup "<span class=\"" name "\">") + (save-excursion + (goto-char end) + (muse-insert-markup "</span>"))))) + +(defun muse-html-div-tag (beg end attrs) + "Publish a <div> tag for HTML." + (let ((id (cdr (assoc "id" attrs))) + (style (cdr (assoc "style" attrs)))) + (when (or id style) + (goto-char beg) + (if (null id) + (muse-insert-markup "<div style=\"" style "\">") + (muse-insert-markup "<div id=\"" id "\">")) + (save-excursion + (goto-char end) + (muse-insert-markup "</div>"))))) + +(defun muse-html-src-tag (beg end attrs) + "Publish the region using htmlize. +The language to use may be specified by the \"lang\" attribute. + +Muse will look for a function named LANG-mode, where LANG is the +value of the \"lang\" attribute. + +This tag requires htmlize 1.34 or later in order to work." + (if (condition-case nil + (progn + (require 'htmlize) + (if (fboundp 'htmlize-region-for-paste) + nil + (muse-display-warning + (concat "The `htmlize-region-for-paste' function was not" + " found.\nThis is available in htmlize.el 1.34" + " or later.")) + t)) + (error nil t)) + ;; if htmlize.el was not found, treat this like an example tag + (muse-publish-example-tag beg end) + (muse-publish-ensure-block beg end) + (let* ((lang (cdr (assoc "lang" attrs))) + (mode (or (and (not (eq muse-html-src-allowed-modes t)) + (not (member lang muse-html-src-allowed-modes)) + 'fundamental-mode) + (intern-soft (concat lang "-mode")))) + (text (muse-delete-and-extract-region beg end)) + (htmltext + (with-temp-buffer + (insert text) + (if (functionp mode) + (funcall mode) + (fundamental-mode)) + (font-lock-fontify-buffer) + ;; silence the byte-compiler + (when (fboundp 'htmlize-region-for-paste) + ;; transform the region to HTML + (htmlize-region-for-paste (point-min) (point-max)))))) + (save-restriction + (narrow-to-region (point) (point)) + (insert htmltext) + (goto-char (point-min)) + (re-search-forward "<pre\\([^>]*\\)>\n?" nil t) + (replace-match "<pre class=\"src\">") + (goto-char (point-max)) + (muse-publish-mark-read-only (point-min) (point-max)))))) + +;; Register the Muse HTML Publisher + +(defun muse-html-browse-file (file) + (browse-url (concat "file:" file))) + +(defun muse-html-encoding () + (if (stringp muse-html-meta-content-encoding) + muse-html-meta-content-encoding + (muse-xml-transform-content-type + (or (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system) + muse-html-encoding-default) + muse-html-charset-default))) + +(defun muse-html-prepare-buffer () + (make-local-variable 'muse-html-meta-http-equiv) + (set (make-local-variable 'muse-html-meta-content-type) + (if (save-match-data + (string-match "charset=" muse-html-meta-content-type)) + muse-html-meta-content-type + (concat muse-html-meta-content-type "; charset=" + (muse-html-encoding))))) + +(defun muse-html-munge-buffer () + (if muse-publish-generate-contents + (progn + (goto-char (car muse-publish-generate-contents)) + (muse-html-insert-contents (cdr muse-publish-generate-contents)) + (setq muse-publish-generate-contents nil)) + (muse-html-denote-headings))) + +(defun muse-html-finalize-buffer () + (when (and (boundp 'buffer-file-coding-system) + (memq buffer-file-coding-system '(no-conversion undecided-unix))) + ;; make it agree with the default charset + (setq buffer-file-coding-system muse-html-encoding-default))) + +;;; Register the Muse HTML and XHTML Publishers + +(muse-define-style "html" + :suffix 'muse-html-extension + :regexps 'muse-html-markup-regexps + :functions 'muse-html-markup-functions + :strings 'muse-html-markup-strings + :tags 'muse-html-markup-tags + :specials 'muse-xml-decide-specials + :before 'muse-html-prepare-buffer + :before-end 'muse-html-munge-buffer + :after 'muse-html-finalize-buffer + :header 'muse-html-header + :footer 'muse-html-footer + :style-sheet 'muse-html-style-sheet + :browser 'muse-html-browse-file) + +(muse-derive-style "xhtml" "html" + :suffix 'muse-xhtml-extension + :strings 'muse-xhtml-markup-strings + :header 'muse-xhtml-header + :footer 'muse-xhtml-footer + :style-sheet 'muse-xhtml-style-sheet) + +;; xhtml1.0 is an alias for xhtml +(muse-derive-style "xhtml1.0" "xhtml") + +;; xhtml1.1 has some quirks that need attention from us +(muse-derive-style "xhtml1.1" "xhtml" + :strings 'muse-xhtml1.1-markup-strings) + +(provide 'muse-html) + +;;; muse-html.el ends here |