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