Header/footer docfix; ChangeLog correction.
[muse-el.git] / lisp / muse-html.el
blob3a51b281541634a381c63cabd6e889af1cf238cc
1 ;;; muse-html.el --- Publish to HTML and XHTML.
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
5 ;; This file is not part of GNU Emacs.
7 ;; This is free software; you can redistribute it and/or modify it under
8 ;; the terms of the GNU General Public License as published by the Free
9 ;; Software Foundation; either version 2, or (at your option) any later
10 ;; version.
12 ;; This is distributed in the hope that it will be useful, but WITHOUT
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 ;; for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA.
22 ;;; Commentary:
24 ;;; Contributors:
26 ;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested
27 ;; appending an 'encoding="..."' fragment to the first line of the
28 ;; sample publishing header so that when editing the resulting XHTML
29 ;; file, Emacs would use the proper encoding.
31 ;;; Code:
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; Muse HTML Publishing
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 (require 'muse-publish)
40 (require 'muse-regexps)
42 (defgroup muse-html nil
43 "Options controlling the behavior of Muse HTML publishing.
44 See `muse-html' for more information."
45 :group 'muse-publish)
47 (defcustom muse-html-extension ".html"
48 "Default file extension for publishing HTML files."
49 :type 'string
50 :group 'muse-html)
52 (defcustom muse-html-style-sheet
53 "<style type=\"text/css\">
54 body {
55 background: white; color: black;
56 margin-left: 3%; margin-right: 7%;
59 p { margin-top: 1% }
60 p.verse { margin-left: 3% }
62 .example { margin-left: 3% }
64 h2 {
65 margin-top: 25px;
66 margin-bottom: 0px;
68 h3 { margin-bottom: 0px; }
69 </style>"
70 "Store your stylesheet definitions here.
71 This is used in `muse-html-header'.
72 You can put raw CSS in here or a <link> tag to an external stylesheet.
73 This text may contain <lisp> markup tags.
75 An example of using <link> is as follows.
77 <link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">
79 If you are using XHTML, make sure to close the tag properly, as
80 shown in the following example.
82 <link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />"
83 :type 'string
84 :group 'muse-html)
86 (defcustom muse-html-header
87 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
88 <html>
89 <head>
90 <title><lisp>
91 (concat (muse-publishing-directive \"title\")
92 (let ((author (muse-publishing-directive \"author\")))
93 (if (not (string= author (user-full-name)))
94 (concat \" (by \" author \")\"))))</lisp></title>
95 <meta name=\"generator\" content=\"muse.el\">
96 <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
97 content=\"<lisp>muse-html-meta-content-type</lisp>\">
98 <lisp>
99 (let ((maintainer (muse-style-element :maintainer)))
100 (when maintainer
101 (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
102 </lisp>
103 <lisp>muse-html-style-sheet</lisp>
104 </head>
105 <body>
106 <h1><lisp>
107 (concat (muse-publishing-directive \"title\")
108 (let ((author (muse-publishing-directive \"author\")))
109 (if (not (string= author (user-full-name)))
110 (concat \" (by \" author \")\"))))</lisp></h1>
111 <!-- Page published by Emacs Muse begins here -->\n"
112 "Header used for publishing HTML files. This may be text or a filename."
113 :type 'string
114 :group 'muse-html)
116 (defcustom muse-html-footer "
117 <!-- Page published by Emacs Muse ends here -->
118 </body>
119 </html>\n"
120 "Footer used for publishing HTML files. This may be text or a filename."
121 :type 'string
122 :group 'muse-html)
124 (defcustom muse-xhtml-header
125 "<?xml version=\"1.0\" encoding=\"<lisp>
126 (muse-html-encoding)</lisp>\"?>
127 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
128 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
129 <html xmlns=\"http://www.w3.org/1999/xhtml\">
130 <head>
131 <title><lisp>
132 (concat (muse-publishing-directive \"title\")
133 (let ((author (muse-publishing-directive \"author\")))
134 (if (not (string= author (user-full-name)))
135 (concat \" (by \" author \")\"))))</lisp></title>
136 <meta name=\"generator\" content=\"muse.el\" />
137 <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
138 content=\"<lisp>muse-html-meta-content-type</lisp>\" />
139 <lisp>
140 (let ((maintainer (muse-style-element :maintainer)))
141 (when maintainer
142 (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\")))
143 </lisp>
144 <lisp>muse-html-style-sheet</lisp>
145 </head>
146 <body>
147 <h1><lisp>
148 (concat (muse-publishing-directive \"title\")
149 (let ((author (muse-publishing-directive \"author\")))
150 (if (not (string= author (user-full-name)))
151 (concat \" (by \" author \")\"))))</lisp></h1>
152 <!-- Page published by Emacs Muse begins here -->\n"
153 "Header used for publishing XHTML files. This may be text or a filename."
154 :type 'string
155 :group 'muse-html)
157 (defcustom muse-xhtml-footer "
158 <!-- Page published by Emacs Muse ends here -->
159 </body>
160 </html>\n"
161 "Footer used for publishing XHTML files. This may be text or a filename."
162 :type 'string
163 :group 'muse-html)
165 (defcustom muse-html-anchor-on-word nil
166 "When true, anchors surround the closest word. This allows you
167 to select them in a browser (i.e. for pasting), but has the
168 side-effect of marking up headers in multiple colors if your
169 header style is different from your link style."
170 :type 'boolean
171 :group 'muse-html)
173 (defcustom muse-html-table-attributes
174 "class=\"muse-table\" border=\"2\" cellpadding=\"5\""
175 "The attribute to be used with HTML <table> tags.
176 Note that since Muse supports direct insertion of HTML tags, you
177 can easily create any kind of table you want, as long as each
178 line begins at column 0 (to prevent it from being blockquoted).
179 To make such a table, use this idiom:
181 <verbatim>
182 <table>
183 [... contents of my table, in raw HTML ...]
184 </verbatim></table>
186 It may look strange to have the tags out of sequence, but this is
187 because the Muse verbatim tag is handled during a different pass
188 than the HTML table tag."
189 :type 'string
190 :group 'muse-html)
192 (defcustom muse-html-markup-regexps
193 `(;; join together the parts of a list or table
194 (10000 "</\\([oud]l\\)>\\s-*<\\1>\\s-*" 0 "")
195 (10100 ,(concat " </t\\(body\\|head\\|foot\\)>\\s-*</table>\\s-*"
196 "<table[^>]*>\\s-*<t\\1>\n") 0 "")
197 (10200 "</table>\\s-*<table[^>]*>\n" 0 "")
199 ;; beginning of doc, end of doc, or plain paragraph separator
200 (10300 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?"
201 "\\(?:\n\\(["
202 muse-regexp-blank
203 "]*\n\\)+\\|\\`\\s-*\\|\\s-*\\'\\)"
204 "\\(<\\(blockquote\\|center\\)>\n\\)?")
205 0 muse-html-markup-paragraph))
206 "List of markup rules for publishing a Muse page to HTML.
207 For more on the structure of this list, see `muse-publish-markup-regexps'."
208 :type '(repeat (choice
209 (list :tag "Markup rule"
210 integer
211 (choice regexp symbol)
212 integer
213 (choice string function symbol))
214 function))
215 :group 'muse-html)
217 (defcustom muse-html-markup-functions
218 '((anchor . muse-html-markup-anchor)
219 (table . muse-html-markup-table)
220 (footnote . muse-html-markup-footnote))
221 "An alist of style types to custom functions for that kind of text.
222 For more on the structure of this list, see
223 `muse-publish-markup-functions'."
224 :type '(alist :key-type symbol :value-type function)
225 :group 'muse-html)
227 (defcustom muse-html-markup-strings
228 '((image-with-desc . "<img src=\"%s\" alt=\"%s\">")
229 (image-link . "<img src=\"%s\" alt=\"\">")
230 (url-with-image . "<a class=\"image-link\" href=\"%s\"><img src=\"%s\"></a>")
231 (url-link . "<a href=\"%s\">%s</a>")
232 (email-addr . "<a href=\"mailto:%s\">%s</a>")
233 (emdash . " &mdash; ")
234 (rule . "<hr>")
235 (fn-sep . "<hr>\n")
236 (enddots . "....")
237 (dots . "...")
238 (section . "<h2>")
239 (section-end . "</h2>")
240 (subsection . "<h3>")
241 (subsection-end . "</h3>")
242 (subsubsection . "<h4>")
243 (subsubsection-end . "</h4>")
244 (begin-underline . "<u>")
245 (end-underline . "</u>")
246 (begin-literal . "<code>")
247 (end-literal . "</code>")
248 (begin-emph . "<em>")
249 (end-emph . "</em>")
250 (begin-more-emph . "<strong>")
251 (end-more-emph . "</strong>")
252 (begin-most-emph . "<strong><em>")
253 (end-most-emph . "</em></strong>")
254 (begin-verse . "<p class=\"verse\">\n")
255 (verse-space . "&nbsp;&nbsp;")
256 (end-verse-line . "<br>")
257 (last-stanza-end . "<br>")
258 (empty-verse-line . "<br>")
259 (end-verse . "</p>")
260 (begin-example . "<pre class=\"example\">")
261 (end-example . "</pre>")
262 (begin-center . "<center>\n")
263 (end-center . "\n</center>")
264 (begin-quote . "<blockquote>\n")
265 (end-quote . "\n</blockquote>")
266 (begin-uli . "<ul>\n<li>")
267 (end-uli . "</li>\n</ul>")
268 (begin-oli . "<ol>\n<li>")
269 (end-oli . "</li>\n</ol>")
270 (begin-ddt . "<dl>\n<dt><strong>")
271 (start-dde . "</strong></dt>\n<dd>")
272 (end-ddt . "</dd>\n</dl>"))
273 "Strings used for marking up text as HTML.
274 These cover the most basic kinds of markup, the handling of which
275 differs little between the various styles."
276 :type '(alist :key-type symbol :value-type string)
277 :group 'muse-html)
279 (defcustom muse-xhtml-markup-strings
280 '((image-with-desc . "<img src=\"%s\" alt=\"%s\" />")
281 (image-link . "<img src=\"%s\" alt=\"\" />")
282 (url-with-image . "<a class=\"image-link\" href=\"%s\"><img src=\"%s\" alt=\"\" /></a>")
283 (rule . "<hr />")
284 (fn-sep . "<hr />\n")
285 (begin-underline . "<span style=\"text-decoration: underline;\">\n")
286 (end-underline . "</span>")
287 (begin-center . "<span style=\"text-align: center;\">\n")
288 (end-verse-line . "<br />")
289 (last-stanza-end . "<br />")
290 (empty-verse-line . "<br />")
291 (end-center . "\n</span>"))
292 "Strings used for marking up text as XHTML.
293 These cover the most basic kinds of markup, the handling of which
294 differs little between the various styles.
296 If a markup rule is not found here, `muse-html-markup-strings' is
297 searched."
298 :type '(alist :key-type symbol :value-type string)
299 :group 'muse-html)
301 (defcustom muse-html-markup-tags
302 '(("class" t t muse-html-class-tag))
303 "A list of tag specifications, for specially marking up HTML."
304 :type '(repeat (list (string :tag "Markup tag")
305 (boolean :tag "Expect closing tag" :value t)
306 (boolean :tag "Parse attributes" :value nil)
307 function))
308 :group 'muse-html)
310 (defcustom muse-html-markup-specials
311 '((?\" . "&quot;")
312 (?\< . "&lt;")
313 (?\> . "&gt;")
314 (?\& . "&amp;"))
315 "A table of characters which must be represented specially."
316 :type '(alist :key-type character :value-type string)
317 :group 'muse-html)
319 (defcustom muse-html-meta-http-equiv "Content-Type"
320 "The http-equiv attribute used for the HTML <meta> tag."
321 :type 'string
322 :group 'muse-html)
324 (defcustom muse-html-meta-content-type "text/html"
325 "The content type used for the HTML <meta> tag.
326 If you are striving for XHTML 1.1 compliance, you may want to
327 change this to \"application/xhtml+xml\"."
328 :type 'string
329 :group 'muse-html)
331 (defcustom muse-html-meta-content-encoding (if (featurep 'mule)
332 'detect
333 "iso-8859-1")
334 "The charset to append to the HTML <meta> tag.
335 If set to the symbol 'detect, use `muse-html-encoding-map' to try
336 and determine the HTML charset from emacs's coding. If set to a
337 string, this string will be used to force a particular charset"
338 :type '(choice string symbol)
339 :group 'muse-html)
341 (defcustom muse-html-charset-default "iso-8859-1"
342 "The default HTML meta charset to use if no translation is found in
343 `muse-html-encoding-map'."
344 :type 'string
345 :group 'muse-html)
347 (defcustom muse-html-encoding-default 'iso-8859-1
348 "The default Emacs buffer encoding to use in published files.
349 This will be used if no special characters are found."
350 :type 'symbol
351 :group 'muse-html)
353 (defcustom muse-html-encoding-map
354 '((iso-8859-1 . "iso-8859-1")
355 (iso-2022-jp . "iso-2022-jp")
356 (utf-8 . "utf-8")
357 (japanese-iso-8bit . "euc-jp")
358 (chinese-big5 . "big5")
359 (mule-utf-8 . "utf-8")
360 (chinese-iso-8bit . "gb2312")
361 (chinese-gbk . "gbk"))
362 "An alist mapping emacs coding systems to appropriate HTML charsets.
363 Use the base name of the coding system (i.e. without the -unix)."
364 :type '(alist :key-type coding-system :value-type string)
365 :group 'muse-html)
367 (defun muse-html-transform-content-type (content-type)
368 "Using `muse-html-encoding-map', try and resolve an emacs coding
369 system to an associated HTML coding system. If no match is found,
370 `muse-html-charset-default' is used instead."
371 (let ((match (assoc (coding-system-base content-type)
372 muse-html-encoding-map)))
373 (if match
374 (cdr match)
375 muse-html-charset-default)))
377 (defun muse-html-insert-anchor (anchor)
378 "Insert an anchor, either around the word at point, or within a tag."
379 (skip-chars-forward muse-regexp-space)
380 (if (looking-at "<\\([^ />]+\\)>")
381 (let ((tag (match-string 1)))
382 (goto-char (match-end 0))
383 (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
384 (when muse-html-anchor-on-word
385 (or (and (search-forward (format "</%s>" tag)
386 (muse-line-end-position) t)
387 (goto-char (match-beginning 0)))
388 (forward-word 1)))
389 (insert "</a>"))
390 (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
391 (when muse-html-anchor-on-word
392 (forward-word 1))
393 (insert "</a>\n")))
395 (defun muse-html-markup-paragraph ()
396 (let ((end (copy-marker (match-end 0) t)))
397 (goto-char (match-beginning 0))
398 (when (save-excursion
399 (save-match-data
400 (and (re-search-backward "<\\(/?\\)p[ >]" nil t)
401 (not (string-equal (match-string 1) "/")))))
402 (insert "</p>"))
403 (goto-char end))
404 (cond
405 ((eobp)
406 (unless (bolp)
407 (insert "\n")))
408 ((eq (char-after) ?\<)
409 (cond
410 ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
411 (insert "<p>"))
412 ((looking-at "<a ")
413 (if (looking-at "<a[^>]+><img")
414 (insert "<p class=\"image-link\">")
415 (insert "<p>")))
416 ((looking-at "<img[ >]")
417 (insert "<p class=\"image-link\">"))))
418 ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
419 (insert "<p class=\"first\">"))
420 ((muse-looking-back "<\\(blockquote\\|center\\)>\n")
421 (insert "<p class=\"quoted\">"))
423 (insert "<p>"))))
425 (defun muse-html-markup-anchor ()
426 (save-match-data
427 (muse-html-insert-anchor (match-string 1))) "")
429 (defun muse-html-escape-string (str &rest ignored)
430 "Convert to character entities any non-alphanumeric characters
431 outside a few punctuation symbols, that risk being misinterpreted
432 if not escaped."
433 (when str
434 (let (pos code len ch)
435 (save-match-data
436 (while (setq pos (string-match (concat "[^-"
437 muse-regexp-alnum
438 "/:._=@\\?~#]")
439 str pos))
440 (setq ch (aref str pos)
441 code (cond
442 ((char-equal ch ?\&)
443 "&amp;")
444 ((char-equal ch ?\<)
445 "&lt;")
446 ((char-equal ch ?\>)
447 "&gt;")
448 (t (concat "&#"
449 (int-to-string
450 (cond ((fboundp 'char-to-ucs)
451 (char-to-ucs ch))
452 ((fboundp 'char-to-int)
453 (char-to-int ch))
454 (t ch)))
455 ";")))
456 len (length code)
457 str (concat (substring str 0 pos)
458 code
459 (when (< pos (length str))
460 (substring str (1+ pos) nil)))
461 pos (+ len pos)))
462 str))))
464 (defun muse-html-markup-footnote ()
465 (if (/= (muse-line-beginning-position) (match-beginning 0))
466 "<sup><a name=\"fnr.\\1\" href=\"#fn.\\1\">\\1</a></sup>"
467 (prog1
468 "<p class=\"footnote\"><a name=\"fn.\\1\" href=\"#fnr.\\1\">\\1.</a>"
469 (save-excursion
470 (save-match-data
471 (let* ((beg (goto-char (match-end 0)))
472 (end (and (search-forward "\n\n" nil t)
473 (prog1
474 (copy-marker (match-beginning 0))
475 (goto-char beg)))))
476 (while (re-search-forward (concat "^["
477 muse-regexp-blank
478 "]+\\([^\n]\\)")
479 end t)
480 (replace-match "\\1" t))))))))
482 (defun muse-html-markup-table ()
483 (let* ((str (prog1
484 (match-string 1)
485 (delete-region (match-beginning 0) (match-end 0))))
486 (fields (split-string str "\\s-*|+\\s-*"))
487 (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
488 (length (match-string 1 str))))
489 (part (cond ((= type 1) "tbody")
490 ((= type 2) "thead")
491 ((= type 3) "tfoot")))
492 (col (cond ((= type 1) "td")
493 ((= type 2) "th")
494 ((= type 3) "td"))))
495 (insert "<table " muse-html-table-attributes ">\n"
496 " <" part ">\n"
497 " <tr>\n")
498 (dolist (field fields)
499 (insert " <" col ">" field "</" col ">\n"))
500 (insert " </tr>\n"
501 " </" part ">\n"
502 "</table>\n")))
504 ;; Handling of tags for HTML
506 (defun muse-html-insert-contents (depth)
507 (let ((max-depth (or depth 2))
508 (index 1)
509 base contents l)
510 (save-excursion
511 (goto-char (point-min))
512 (search-forward "Page published by Emacs Muse begins here" nil t)
513 (catch 'done
514 (while (re-search-forward "^<h\\([0-9]+\\)>\\(.+?\\)</h\\1>" nil t)
515 (unless (get-text-property (point) 'read-only)
516 (setq l (1- (string-to-number (match-string 1))))
517 (if (null base)
518 (setq base l)
519 (if (< l base)
520 (throw 'done t)))
521 (when (<= l max-depth)
522 (setq contents (cons (cons l (muse-match-string-no-properties 2))
523 contents))
524 (goto-char (match-beginning 2))
525 (muse-html-insert-anchor (concat "sec" (int-to-string index)))
526 (setq index (1+ index)))))))
527 (setq index 1 contents (reverse contents))
528 (let ((depth 1) (sub-open 0) (p (point)))
529 (insert "<dl class=\"contents\">\n")
530 (while contents
531 (insert "<dt class=\"contents\">\n")
532 (insert "<a href=\"#sec" (int-to-string index) "\">"
533 (muse-publish-strip-tags (cdar contents))
534 "</a>\n")
535 (setq index (1+ index))
536 (insert "</dt>\n")
537 (setq depth (caar contents)
538 contents (cdr contents))
539 (if contents
540 (cond
541 ((< (caar contents) depth)
542 (let ((idx (caar contents)))
543 (while (< idx depth)
544 (insert "</dl>\n</dd>\n")
545 (setq sub-open (1- sub-open)
546 idx (1+ idx)))))
547 ((> (caar contents) depth) ; can't jump more than one ahead
548 (insert "<dd>\n<dl class=\"contents\">\n")
549 (setq sub-open (1+ sub-open))))))
550 (while (> sub-open 0)
551 (insert "</dl>\n</dd>\n")
552 (setq sub-open (1- sub-open)))
553 (insert "</dl>\n")
554 (muse-publish-mark-read-only p (point)))))
556 (defun muse-html-class-tag (beg end attrs)
557 (goto-char beg)
558 (insert "<span class=\"" (cdr (assoc "name" attrs)) "\">")
559 (goto-char end)
560 (insert "</span>"))
562 ;; Register the Muse HTML Publisher
564 (defun muse-html-browse-file (file)
565 (browse-url (concat "file:" file)))
567 (defun muse-html-encoding ()
568 (if (stringp muse-html-meta-content-encoding)
569 muse-html-meta-content-encoding
570 (muse-html-transform-content-type
571 (or buffer-file-coding-system
572 muse-html-encoding-default))))
574 (defun muse-html-prepare-buffer ()
575 (set (make-local-variable 'muse-publish-url-transforms)
576 (cons 'muse-html-escape-string muse-publish-url-transforms))
577 (make-local-variable 'muse-html-meta-http-equiv)
578 (set (make-local-variable 'muse-html-meta-content-type)
579 (concat muse-html-meta-content-type "; charset="
580 (muse-html-encoding))))
582 (defun muse-html-finalize-buffer ()
583 (when muse-publish-generate-contents
584 (goto-char (car muse-publish-generate-contents))
585 (muse-html-insert-contents (cdr muse-publish-generate-contents)))
586 (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
587 ;; make it agree with the default charset
588 (setq buffer-file-coding-system muse-html-encoding-default)))
590 (unless (assoc "html" muse-publishing-styles)
591 (muse-define-style "html"
592 :suffix 'muse-html-extension
593 :regexps 'muse-html-markup-regexps
594 :functions 'muse-html-markup-functions
595 :strings 'muse-html-markup-strings
596 :tags 'muse-html-markup-tags
597 :specials 'muse-html-markup-specials
598 :before 'muse-html-prepare-buffer
599 :after 'muse-html-finalize-buffer
600 :header 'muse-html-header
601 :footer 'muse-html-footer
602 :browser 'muse-html-browse-file)
604 (muse-derive-style "xhtml" "html"
605 :strings 'muse-xhtml-markup-strings
606 :header 'muse-xhtml-header
607 :footer 'muse-xhtml-footer))
609 (provide 'muse-html)
611 ;;; muse-html.el ends here