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