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