lisp/muse-html.el

   1 ;;; muse-html.el --- publish to HTML and XHTML
   2
   3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 2, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; 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     (no-break-space  . "&nbsp;")
 280     (enddots         . "....")
 281     (dots            . "...")
 282     (section         . "<h2>")
 283     (section-end     . "</h2>")
 284     (subsection      . "<h3>")
 285     (subsection-end  . "</h3>")
 286     (subsubsection   . "<h4>")
 287     (subsubsection-end . "</h4>")
 288     (section-other   . "<h5>")
 289     (section-other-end . "</h5>")
 290     (begin-underline . "<u>")
 291     (end-underline   . "</u>")
 292     (begin-literal   . "<code>")
 293     (end-literal     . "</code>")
 294     (begin-emph      . "<em>")
 295     (end-emph        . "</em>")
 296     (begin-more-emph . "<strong>")
 297     (end-more-emph   . "</strong>")
 298     (begin-most-emph . "<strong><em>")
 299     (end-most-emph   . "</em></strong>")
 300     (begin-verse     . "<p class=\"verse\">\n")
 301     (verse-space     . "&nbsp;&nbsp;")
 302     (end-verse-line  . "<br>")
 303     (end-last-stanza-line . "<br>")
 304     (empty-verse-line . "<br>")
 305     (end-verse       . "</p>")
 306     (begin-example   . "<pre class=\"example\">")
 307     (end-example     . "</pre>")
 308     (begin-center    . "<center>\n")
 309     (end-center      . "\n</center>")
 310     (begin-quote     . "<blockquote>\n")
 311     (end-quote       . "\n</blockquote>")
 312     (begin-uli       . "<ul>\n<li>")
 313     (end-uli         . "</li>\n</ul>")
 314     (begin-oli       . "<ol>\n<li>")
 315     (end-oli         . "</li>\n</ol>")
 316     (begin-ddt       . "<dl>\n<dt><strong>")
 317     (start-dde       . "</strong></dt>\n<dd>")
 318     (end-ddt         . "</dd>\n</dl>"))
 319   "Strings used for marking up text as HTML.
 320 These cover the most basic kinds of markup, the handling of which
 321 differs little between the various styles."
 322   :type '(alist :key-type symbol :value-type string)
 323   :group 'muse-html)
 324
 325 (defcustom muse-xhtml-markup-strings
 326   '((image-with-desc . "<img src=\"%s\" alt=\"%s\" />")
 327     (image-link      . "<img src=\"%s\" alt=\"\" />")
 328     (url-with-image  . "<a class=\"image-link\" href=\"%s\"><img src=\"%s\" alt=\"\" /></a>")
 329     (rule            . "<hr />")
 330     (fn-sep          . "<hr />\n")
 331     (begin-underline . "<span style=\"text-decoration: underline;\">")
 332     (end-underline   . "</span>")
 333     (begin-center    . "<p style=\"text-align: center;\">\n")
 334     (end-center      . "\n</p>")
 335     (end-verse-line  . "<br />")
 336     (end-last-stanza-line . "<br />")
 337     (empty-verse-line . "<br />"))
 338   "Strings used for marking up text as XHTML.
 339 These cover the most basic kinds of markup, the handling of which
 340 differs little between the various styles.
 341
 342 If a markup rule is not found here, `muse-html-markup-strings' is
 343 searched."
 344   :type '(alist :key-type symbol :value-type string)
 345   :group 'muse-html)
 346
 347 (defcustom muse-html-markup-tags
 348   '(("class" t t muse-html-class-tag))
 349   "A list of tag specifications, for specially marking up HTML."
 350   :type '(repeat (list (string :tag "Markup tag")
 351                        (boolean :tag "Expect closing tag" :value t)
 352                        (boolean :tag "Parse attributes" :value nil)
 353                        function))
 354   :group 'muse-html)
 355
 356 (defcustom muse-html-markup-specials
 357   '((?\" . "&quot;")
 358     (?\< . "&lt;")
 359     (?\> . "&gt;")
 360     (?\& . "&amp;"))
 361   "A table of characters which must be represented specially."
 362   :type '(alist :key-type character :value-type string)
 363   :group 'muse-html)
 364
 365 (defcustom muse-html-meta-http-equiv "Content-Type"
 366   "The http-equiv attribute used for the HTML <meta> tag."
 367   :type 'string
 368   :group 'muse-html)
 369
 370 (defcustom muse-html-meta-content-type "text/html"
 371   "The content type used for the HTML <meta> tag.
 372 If you are striving for XHTML 1.1 compliance, you may want to
 373 change this to \"application/xhtml+xml\"."
 374   :type 'string
 375   :group 'muse-html)
 376
 377 (defcustom muse-html-meta-content-encoding (if (featurep 'mule)
 378                                               'detect
 379                                             "iso-8859-1")
 380   "The charset to append to the HTML <meta> tag.
 381 If set to the symbol 'detect, use `muse-html-encoding-map' to try
 382 and determine the HTML charset from emacs's coding.  If set to a
 383 string, this string will be used to force a particular charset"
 384   :type '(choice string symbol)
 385   :group 'muse-html)
 386
 387 (defcustom muse-html-charset-default "iso-8859-1"
 388   "The default HTML meta charset to use if no translation is found in
 389 `muse-html-encoding-map'."
 390   :type 'string
 391   :group 'muse-html)
 392
 393 (defcustom muse-html-encoding-default 'iso-8859-1
 394   "The default Emacs buffer encoding to use in published files.
 395 This will be used if no special characters are found."
 396   :type 'symbol
 397   :group 'muse-html)
 398
 399 (defcustom muse-html-encoding-map
 400   '((iso-8859-1         . "iso-8859-1")
 401     (iso-2022-jp        . "iso-2022-jp")
 402     (utf-8              . "utf-8")
 403     (japanese-iso-8bit  . "euc-jp")
 404     (chinese-big5       . "big5")
 405     (mule-utf-8         . "utf-8")
 406     (chinese-iso-8bit   . "gb2312")
 407     (chinese-gbk        . "gbk"))
 408   "An alist mapping emacs coding systems to appropriate HTML charsets.
 409 Use the base name of the coding system (i.e. without the -unix)."
 410   :type '(alist :key-type coding-system :value-type string)
 411   :group 'muse-html)
 412
 413 (defun muse-html-transform-content-type (content-type)
 414   "Using `muse-html-encoding-map', try and resolve an emacs coding
 415 system to an associated HTML coding system. If no match is found,
 416 `muse-html-charset-default' is used instead."
 417   (let ((match (and (fboundp 'coding-system-base)
 418                     (assoc (coding-system-base content-type)
 419                            muse-html-encoding-map))))
 420     (if match
 421         (cdr match)
 422       muse-html-charset-default)))
 423
 424 (defun muse-html-insert-anchor (anchor)
 425   "Insert an anchor, either around the word at point, or within a tag."
 426   (unless (get-text-property (match-end 1) 'noemphasis)
 427     (skip-chars-forward (concat muse-regexp-blank "\n"))
 428     (if (looking-at "<\\([^ />]+\\)>")
 429         (let ((tag (match-string 1)))
 430           (goto-char (match-end 0))
 431           (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 432           (when muse-html-anchor-on-word
 433             (or (and (search-forward (format "</%s>" tag)
 434                                      (muse-line-end-position) t)
 435                      (goto-char (match-beginning 0)))
 436                 (forward-word 1)))
 437           (insert "</a>"))
 438       (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 439       (when muse-html-anchor-on-word
 440         (forward-word 1))
 441       (insert "</a>\n"))))
 442
 443 (defun muse-html-markup-anchor ()
 444   (save-match-data
 445     (muse-html-insert-anchor (match-string 2)))
 446   (match-string 1))
 447
 448 (defun muse-html-markup-paragraph ()
 449   (let ((end (copy-marker (match-end 0) t)))
 450     (goto-char (match-beginning 0))
 451     (when (save-excursion
 452             (save-match-data
 453               (and (re-search-backward "<\\(/?\\)p[ >]" nil t)
 454                    (not (string-equal (match-string 1) "/")))))
 455       (insert "</p>"))
 456     (goto-char end))
 457   (cond
 458    ((eobp)
 459     (unless (bolp)
 460       (insert "\n")))
 461    ((eq (char-after) ?\<)
 462     (cond
 463      ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
 464       (insert "<p>"))
 465      ((looking-at "<a ")
 466       (if (looking-at "<a[^>]+><img")
 467           (insert "<p class=\"image-link\">")
 468         (insert "<p>")))
 469      ((looking-at "<img[ >]")
 470       (insert "<p class=\"image-link\">"))))
 471    ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
 472     (insert "<p class=\"first\">"))
 473    ((muse-looking-back "<\\(blockquote\\|center\\)>\n")
 474     (insert "<p class=\"quoted\">"))
 475    (t
 476     (insert "<p>"))))
 477
 478 (defun muse-html-escape-string (str &rest ignored)
 479   "Convert to character entities any non-alphanumeric characters
 480 outside a few punctuation symbols, that risk being misinterpreted
 481 if not escaped."
 482   (when str
 483     (let (pos code len ch)
 484       (save-match-data
 485         (while (setq pos (string-match (concat "[^-"
 486                                                muse-regexp-alnum
 487                                                "/:._=@\\?~#%\"\\+<>&;]")
 488                                        str pos))
 489           (setq ch (aref str pos)
 490                 code (concat "&#"
 491                                  (int-to-string
 492                                   (cond ((fboundp 'char-to-ucs)
 493                                          (char-to-ucs ch))
 494                                         ((fboundp 'char-to-int)
 495                                          (char-to-int ch))
 496                                         (t ch)))
 497                                  ";")
 498                 len (length code)
 499                 str (concat (substring str 0 pos)
 500                             code
 501                             (when (< pos (length str))
 502                               (substring str (1+ pos) nil)))
 503                 pos (+ len pos)))
 504         str))))
 505
 506 (defun muse-html-markup-footnote ()
 507   (if (/= (muse-line-beginning-position) (match-beginning 0))
 508       "<sup><a name=\"fnr.\\1\" href=\"#fn.\\1\">\\1</a></sup>"
 509     (prog1
 510         "<p class=\"footnote\"><a name=\"fn.\\1\" href=\"#fnr.\\1\">\\1.</a>"
 511       (save-excursion
 512         (save-match-data
 513           (let* ((beg (goto-char (match-end 0)))
 514                  (end (and (search-forward "\n\n" nil t)
 515                            (prog1
 516                                (copy-marker (match-beginning 0))
 517                              (goto-char beg)))))
 518             (while (re-search-forward (concat "^["
 519                                               muse-regexp-blank
 520                                               "]+\\([^\n]\\)")
 521                                       end t)
 522               (replace-match "\\1" t))))))))
 523
 524 (defun muse-html-markup-table ()
 525   (let* ((str (prog1
 526                   (match-string 1)
 527                 (delete-region (match-beginning 0) (match-end 0))))
 528          (fields (split-string str "\\s-*|+\\s-*"))
 529          (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
 530                     (length (match-string 1 str))))
 531          (part (cond ((= type 1) "tbody")
 532                      ((= type 2) "thead")
 533                      ((= type 3) "tfoot")))
 534          (col (cond ((= type 1) "td")
 535                     ((= type 2) "th")
 536                     ((= type 3) "td"))))
 537     (insert "<table " muse-html-table-attributes ">\n"
 538             "  <" part ">\n"
 539             "    <tr>\n")
 540     (dolist (field fields)
 541       (insert "      <" col ">" field "</" col ">\n"))
 542     (insert "    </tr>\n"
 543             "  </" part ">\n"
 544             "</table>\n")))
 545
 546 ;; Handling of tags for HTML
 547
 548 (defun muse-html-insert-contents (depth)
 549   (let ((max-depth (or depth 2))
 550         (index 1)
 551         base contents l)
 552     (save-excursion
 553       (goto-char (point-min))
 554       (search-forward "Page published by Emacs Muse begins here" nil t)
 555       (catch 'done
 556         (while (re-search-forward "^<h\\([0-9]+\\)>\\(.+?\\)</h\\1>" nil t)
 557           (unless (get-text-property (point) 'read-only)
 558             (setq l (1- (string-to-number (match-string 1))))
 559             (if (null base)
 560                 (setq base l)
 561               (if (< l base)
 562                   (throw 'done t)))
 563             (when (<= l max-depth)
 564               (setq contents (cons (cons l (muse-match-string-no-properties 2))
 565                                    contents))
 566               (goto-char (match-beginning 2))
 567               (muse-html-insert-anchor (concat "sec" (int-to-string index)))
 568               (setq index (1+ index)))))))
 569     (setq index 1 contents (reverse contents))
 570     (let ((depth 1) (sub-open 0) (p (point)))
 571       (insert "<dl class=\"contents\">\n")
 572       (while contents
 573         (insert "<dt class=\"contents\">\n")
 574         (insert "<a href=\"#sec" (int-to-string index) "\">"
 575                 (muse-publish-strip-tags (cdar contents))
 576                 "</a>\n")
 577         (setq index (1+ index))
 578         (insert "</dt>\n")
 579         (setq depth (caar contents)
 580               contents (cdr contents))
 581         (if contents
 582             (cond
 583              ((< (caar contents) depth)
 584               (let ((idx (caar contents)))
 585                 (while (< idx depth)
 586                   (insert "</dl>\n</dd>\n")
 587                   (setq sub-open (1- sub-open)
 588                         idx (1+ idx)))))
 589              ((> (caar contents) depth) ; can't jump more than one ahead
 590               (insert "<dd>\n<dl class=\"contents\">\n")
 591               (setq sub-open (1+ sub-open))))))
 592       (while (> sub-open 0)
 593         (insert "</dl>\n</dd>\n")
 594         (setq sub-open (1- sub-open)))
 595       (insert "</dl>\n")
 596       (muse-publish-mark-read-only p (point)))))
 597
 598 (defun muse-html-class-tag (beg end attrs)
 599   (goto-char beg)
 600   (insert "<span class=\"" (cdr (assoc "name" attrs)) "\">")
 601   (goto-char end)
 602   (insert "</span>"))
 603
 604 ;; Register the Muse HTML Publisher
 605
 606 (defun muse-html-browse-file (file)
 607   (browse-url (concat "file:" file)))
 608
 609 (defun muse-html-encoding ()
 610   (if (stringp muse-html-meta-content-encoding)
 611       muse-html-meta-content-encoding
 612     (muse-html-transform-content-type
 613      (or (and (boundp 'buffer-file-coding-system)
 614               buffer-file-coding-system)
 615          muse-html-encoding-default))))
 616
 617 (defun muse-html-prepare-buffer ()
 618   (set (make-local-variable 'muse-publish-url-transforms)
 619        (cons 'muse-html-escape-string muse-publish-url-transforms))
 620   (make-local-variable 'muse-html-meta-http-equiv)
 621   (set (make-local-variable 'muse-html-meta-content-type)
 622        (if (save-match-data
 623              (string-match "charset=" muse-html-meta-content-type))
 624            muse-html-meta-content-type
 625          (concat muse-html-meta-content-type "; charset="
 626                  (muse-html-encoding)))))
 627
 628 (defun muse-html-fixup-tables ()
 629   "Sort table parts."
 630   (goto-char (point-min))
 631   (let (last)
 632     (while (re-search-forward "^<table[^>]*>$" nil t)
 633       (unless (get-text-property (point) 'read-only)
 634         (forward-line 1)
 635         (save-restriction
 636           (let ((beg (point)))
 637             (narrow-to-region beg (and (re-search-forward "^</table>"
 638                                                           nil t)
 639                                        (match-beginning 0))))
 640           (goto-char (point-min))
 641           (let ((inhibit-read-only t))
 642             (sort-subr nil
 643                        (function
 644                         (lambda ()
 645                           (if (re-search-forward
 646                                "^\\s-*<t\\(head\\|body\\|foot\\)>$" nil t)
 647                               (goto-char (match-beginning 0))
 648                             (goto-char (point-max)))))
 649                        (function
 650                         (lambda ()
 651                           (if (re-search-forward
 652                                "^\\s-*</t\\(head\\|body\\|foot\\)>$" nil t)
 653                               (goto-char (match-end 0))
 654                             (goto-char (point-max)))))
 655                        (function
 656                         (lambda ()
 657                           (looking-at "\\s-*<t\\(head\\|body\\|foot\\)>")
 658                           (cond ((string= (match-string 1) "head") 1)
 659                                 ((string= (match-string 1) "foot") 2)
 660                                 (t 3)))))))))))
 661
 662 (defun muse-html-finalize-buffer ()
 663   (when muse-publish-generate-contents
 664     (goto-char (car muse-publish-generate-contents))
 665     (muse-html-insert-contents (cdr muse-publish-generate-contents)))
 666   (when (and (boundp 'buffer-file-coding-system)
 667              (memq buffer-file-coding-system '(no-conversion undecided-unix)))
 668     ;; make it agree with the default charset
 669     (setq buffer-file-coding-system muse-html-encoding-default)))
 670
 671 (unless (assoc "html" muse-publishing-styles)
 672   (muse-define-style "html"
 673                      :suffix    'muse-html-extension
 674                      :regexps   'muse-html-markup-regexps
 675                      :functions 'muse-html-markup-functions
 676                      :strings   'muse-html-markup-strings
 677                      :tags      'muse-html-markup-tags
 678                      :specials  'muse-html-markup-specials
 679                      :before    'muse-html-prepare-buffer
 680                      :before-end 'muse-html-fixup-tables
 681                      :after     'muse-html-finalize-buffer
 682                      :header    'muse-html-header
 683                      :footer    'muse-html-footer
 684                      :browser   'muse-html-browse-file)
 685
 686   (muse-derive-style "xhtml" "html"
 687                      :suffix    'muse-xhtml-extension
 688                      :strings   'muse-xhtml-markup-strings
 689                      :header    'muse-xhtml-header
 690                      :footer    'muse-xhtml-footer))
 691
 692 (provide 'muse-html)
 693
 694 ;;; muse-html.el ends here