755 lines
28 KiB
EmacsLisp
755 lines
28 KiB
EmacsLisp
;;; 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
|