57366f385a
* Added muse * Added graphviz-dot-mode * Remove all trailing whitespace on save. This is the last commit I'm going to do before throwing it all away again.
754 lines
28 KiB
EmacsLisp
754 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
|