lisp/muse-html.el

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