lisp/muse-html.el

   1 ;;; muse-html.el --- publish to HTML and XHTML
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008  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 3, 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 ;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for
  32 ;; the <src> tag and provided an implementation for emacs-wiki.
  33
  34 ;; Charles Wang (wcy123 AT gmail DOT com) provided an initial
  35 ;; implementation of the <src> tag for Muse.
  36
  37 ;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further
  38 ;; ideas for the implementation of the <src> tag.
  39
  40 ;;; Code:
  41
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;;
  44 ;; Muse HTML Publishing
  45 ;;
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47
  48 (require 'muse-publish)
  49 (require 'muse-regexps)
  50 (require 'muse-xml-common)
  51
  52 (defgroup muse-html nil
  53   "Options controlling the behavior of Muse HTML publishing."
  54   :group 'muse-publish)
  55
  56 (defcustom muse-html-extension ".html"
  57   "Default file extension for publishing HTML files."
  58   :type 'string
  59   :group 'muse-html)
  60
  61 (defcustom muse-xhtml-extension ".html"
  62   "Default file extension for publishing XHTML files."
  63   :type 'string
  64   :group 'muse-html)
  65
  66 (defcustom muse-html-style-sheet
  67   "<style type=\"text/css\">
  68 body {
  69   background: white; color: black;
  70   margin-left: 3%; margin-right: 7%;
  71 }
  72
  73 p { margin-top: 1% }
  74 p.verse { margin-left: 3% }
  75
  76 .example { margin-left: 3% }
  77
  78 h2 {
  79   margin-top: 25px;
  80   margin-bottom: 0px;
  81 }
  82 h3 { margin-bottom: 0px; }
  83     </style>"
  84   "Store your stylesheet definitions here.
  85 This is used in `muse-html-header'.
  86 You can put raw CSS in here or a <link> tag to an external stylesheet.
  87 This text may contain <lisp> markup tags.
  88
  89 An example of using <link> is as follows.
  90
  91 <link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">"
  92   :type 'string
  93   :group 'muse-html)
  94
  95 (defcustom muse-xhtml-style-sheet
  96   "<style type=\"text/css\">
  97 body {
  98   background: white; color: black;
  99   margin-left: 3%; margin-right: 7%;
 100 }
 101
 102 p { margin-top: 1% }
 103 p.verse { margin-left: 3% }
 104
 105 .example { margin-left: 3% }
 106
 107 h2 {
 108   margin-top: 25px;
 109   margin-bottom: 0px;
 110 }
 111 h3 { margin-bottom: 0px; }
 112     </style>"
 113   "Store your stylesheet definitions here.
 114 This is used in `muse-xhtml-header'.
 115 You can put raw CSS in here or a <link> tag to an external stylesheet.
 116 This text may contain <lisp> markup tags.
 117
 118 An example of using <link> is as follows.
 119
 120 <link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />"
 121   :type 'string
 122   :group 'muse-html)
 123
 124 (defcustom muse-html-header
 125   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
 126 <html>
 127   <head>
 128     <title><lisp>
 129   (concat (muse-publishing-directive \"title\")
 130           (let ((author (muse-publishing-directive \"author\")))
 131             (if (not (string= author (user-full-name)))
 132                 (concat \" (by \" author \")\"))))</lisp></title>
 133     <meta name=\"generator\" content=\"muse.el\">
 134     <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
 135           content=\"<lisp>muse-html-meta-content-type</lisp>\">
 136     <lisp>
 137       (let ((maintainer (muse-style-element :maintainer)))
 138         (when maintainer
 139           (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
 140     </lisp><lisp>
 141       (muse-style-element :style-sheet muse-publishing-current-style)
 142     </lisp>
 143   </head>
 144   <body>
 145     <h1><lisp>
 146   (concat (muse-publishing-directive \"title\")
 147           (let ((author (muse-publishing-directive \"author\")))
 148             (if (not (string= author (user-full-name)))
 149                 (concat \" (by \" author \")\"))))</lisp></h1>
 150     <!-- Page published by Emacs Muse begins here -->\n"
 151   "Header used for publishing HTML files.  This may be text or a filename."
 152   :type 'string
 153   :group 'muse-html)
 154
 155 (defcustom muse-html-footer "
 156 <!-- Page published by Emacs Muse ends here -->
 157   </body>
 158 </html>\n"
 159   "Footer used for publishing HTML files.  This may be text or a filename."
 160   :type 'string
 161   :group 'muse-html)
 162
 163 (defcustom muse-xhtml-header
 164   "<?xml version=\"1.0\" encoding=\"<lisp>
 165   (muse-html-encoding)</lisp>\"?>
 166 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
 167     \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 168 <html xmlns=\"http://www.w3.org/1999/xhtml\">
 169   <head>
 170     <title><lisp>
 171   (concat (muse-publishing-directive \"title\")
 172           (let ((author (muse-publishing-directive \"author\")))
 173             (if (not (string= author (user-full-name)))
 174                 (concat \" (by \" author \")\"))))</lisp></title>
 175     <meta name=\"generator\" content=\"muse.el\" />
 176     <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
 177           content=\"<lisp>muse-html-meta-content-type</lisp>\" />
 178     <lisp>
 179       (let ((maintainer (muse-style-element :maintainer)))
 180         (when maintainer
 181           (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\")))
 182     </lisp><lisp>
 183       (muse-style-element :style-sheet muse-publishing-current-style)
 184     </lisp>
 185   </head>
 186   <body>
 187     <h1><lisp>
 188   (concat (muse-publishing-directive \"title\")
 189           (let ((author (muse-publishing-directive \"author\")))
 190             (if (not (string= author (user-full-name)))
 191                 (concat \" (by \" author \")\"))))</lisp></h1>
 192     <!-- Page published by Emacs Muse begins here -->\n"
 193   "Header used for publishing XHTML files.  This may be text or a filename."
 194   :type 'string
 195   :group 'muse-html)
 196
 197 (defcustom muse-xhtml-footer "
 198 <!-- Page published by Emacs Muse ends here -->
 199   </body>
 200 </html>\n"
 201   "Footer used for publishing XHTML files.  This may be text or a filename."
 202   :type 'string
 203   :group 'muse-html)
 204
 205 (defcustom muse-html-anchor-on-word nil
 206   "When true, anchors surround the closest word. This allows you
 207 to select them in a browser (i.e. for pasting), but has the
 208 side-effect of marking up headers in multiple colors if your
 209 header style is different from your link style."
 210   :type 'boolean
 211   :group 'muse-html)
 212
 213 (defcustom muse-html-table-attributes
 214   " class=\"muse-table\" border=\"2\" cellpadding=\"5\""
 215   "The attribute to be used with HTML <table> tags.
 216 Note that Muse supports insertion of raw HTML tags, as long
 217 as you wrap the region in <literal></literal>."
 218   :type 'string
 219   :group 'muse-html)
 220
 221 (defcustom muse-html-markup-regexps
 222   `(;; Beginning of doc, end of doc, or plain paragraph separator
 223     (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
 224                     "\\([" muse-regexp-blank "]*\n\\)\\)"
 225                     "\\|\\`\\s-*\\|\\s-*\\'\\)")
 226            ;; this is somewhat repetitive because we only require the
 227            ;; line just before the paragraph beginning to be not
 228            ;; read-only
 229            3 muse-html-markup-paragraph))
 230   "List of markup rules for publishing a Muse page to HTML.
 231 For more on the structure of this list, see `muse-publish-markup-regexps'."
 232   :type '(repeat (choice
 233                   (list :tag "Markup rule"
 234                         integer
 235                         (choice regexp symbol)
 236                         integer
 237                         (choice string function symbol))
 238                   function))
 239   :group 'muse-html)
 240
 241 (defcustom muse-html-markup-functions
 242   '((anchor   . muse-html-markup-anchor)
 243     (table    . muse-html-markup-table)
 244     (footnote . muse-html-markup-footnote))
 245   "An alist of style types to custom functions for that kind of text.
 246 For more on the structure of this list, see
 247 `muse-publish-markup-functions'."
 248   :type '(alist :key-type symbol :value-type function)
 249   :group 'muse-html)
 250
 251 (defcustom muse-html-markup-strings
 252   '((image-with-desc . "<table class=\"image\" width=\"100%%\">
 253   <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr>
 254   <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
 255 </table>")
 256     (image           . "<img src=\"%s.%s\" alt=\"\">")
 257     (image-link      . "<a class=\"image-link\" href=\"%s\">
 258 <img src=\"%s.%s\"></a>")
 259     (anchor-ref      . "<a href=\"#%s\">%s</a>")
 260     (url             . "<a href=\"%s\">%s</a>")
 261     (link            . "<a href=\"%s\">%s</a>")
 262     (link-and-anchor . "<a href=\"%s#%s\">%s</a>")
 263     (email-addr      . "<a href=\"mailto:%s\">%s</a>")
 264     (anchor          . "<a name=\"%1%\" id=\"%1%\">")
 265     (emdash          . "%s&mdash;%s")
 266     (comment-begin   . "<!-- ")
 267     (comment-end     . " -->")
 268     (rule            . "<hr>")
 269     (fn-sep          . "<hr>\n")
 270     (no-break-space  . "&nbsp;")
 271     (line-break      . "<br>")
 272     (enddots         . "....")
 273     (dots            . "...")
 274     (section         . "<h2>")
 275     (section-end     . "</h2>")
 276     (subsection      . "<h3>")
 277     (subsection-end  . "</h3>")
 278     (subsubsection   . "<h4>")
 279     (subsubsection-end . "</h4>")
 280     (section-other   . "<h5>")
 281     (section-other-end . "</h5>")
 282     (begin-underline . "<u>")
 283     (end-underline   . "</u>")
 284     (begin-literal   . "<code>")
 285     (end-literal     . "</code>")
 286     (begin-cite      . "<span class=\"citation\">")
 287     (begin-cite-author . "<span class=\"citation-author\">")
 288     (begin-cite-year . "<span class=\"citation-year\">")
 289     (end-cite        . "</span>")
 290     (begin-emph      . "<em>")
 291     (end-emph        . "</em>")
 292     (begin-more-emph . "<strong>")
 293     (end-more-emph   . "</strong>")
 294     (begin-most-emph . "<strong><em>")
 295     (end-most-emph   . "</em></strong>")
 296     (begin-verse     . "<p class=\"verse\">\n")
 297     (verse-space     . "&nbsp;&nbsp;")
 298     (end-verse-line  . "<br>")
 299     (end-last-stanza-line . "<br>")
 300     (empty-verse-line . "<br>")
 301     (end-verse       . "</p>")
 302     (begin-example   . "<pre class=\"example\">")
 303     (end-example     . "</pre>")
 304     (begin-center    . "<center>\n<p>")
 305     (end-center      . "</p>\n</center>")
 306     (begin-quote     . "<blockquote>\n")
 307     (end-quote       . "\n</blockquote>")
 308     (begin-quote-item . "<p class=\"quoted\">")
 309     (end-quote-item  . "</p>")
 310     (begin-uli       . "<ul>\n")
 311     (end-uli         . "\n</ul>")
 312     (begin-uli-item  . "<li>")
 313     (end-uli-item    . "</li>")
 314     (begin-oli       . "<ol>\n")
 315     (end-oli         . "\n</ol>")
 316     (begin-oli-item  . "<li>")
 317     (end-oli-item    . "</li>")
 318     (begin-dl        . "<dl>\n")
 319     (end-dl          . "\n</dl>")
 320     (begin-ddt       . "<dt><strong>")
 321     (end-ddt         . "</strong></dt>")
 322     (begin-dde       . "<dd>")
 323     (end-dde         . "</dd>")
 324     (begin-table     . "<table%s>\n")
 325     (end-table       . "</table>")
 326     (begin-table-row . "    <tr>\n")
 327     (end-table-row   . "    </tr>\n")
 328     (begin-table-entry . "      <%s>")
 329     (end-table-entry . "</%s>\n"))
 330   "Strings used for marking up text as HTML.
 331 These cover the most basic kinds of markup, the handling of which
 332 differs little between the various styles."
 333   :type '(alist :key-type symbol :value-type string)
 334   :group 'muse-html)
 335
 336 (defcustom muse-xhtml-markup-strings
 337   '((image-with-desc . "<table class=\"image\" width=\"100%%\">
 338   <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr>
 339   <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
 340 </table>")
 341     (image           . "<img src=\"%s.%s\" alt=\"\" />")
 342     (image-link      . "<a class=\"image-link\" href=\"%s\">
 343 <img src=\"%s.%s\" alt=\"\" /></a>")
 344     (rule            . "<hr />")
 345     (fn-sep          . "<hr />\n")
 346     (line-break      . "<br />")
 347     (begin-underline . "<span style=\"text-decoration: underline;\">")
 348     (end-underline   . "</span>")
 349     (begin-center    . "<p style=\"text-align: center;\">\n")
 350     (end-center      . "\n</p>")
 351     (end-verse-line  . "<br />")
 352     (end-last-stanza-line . "<br />")
 353     (empty-verse-line . "<br />"))
 354   "Strings used for marking up text as XHTML.
 355 These cover the most basic kinds of markup, the handling of which
 356 differs little between the various styles.
 357
 358 If a markup rule is not found here, `muse-html-markup-strings' is
 359 searched."
 360   :type '(alist :key-type symbol :value-type string)
 361   :group 'muse-html)
 362
 363 (defcustom muse-xhtml1.1-markup-strings
 364   '((anchor          . "<a id=\"%s\">"))
 365   "Strings used for marking up text as XHTML 1.1.
 366 These cover the most basic kinds of markup, the handling of which
 367 differs little between the various styles.
 368
 369 If a markup rule is not found here, `muse-xhtml-markup-strings'
 370 and `muse-html-markup-strings' are searched."
 371   :type '(alist :key-type symbol :value-type string)
 372   :group 'muse-html)
 373
 374 (defcustom muse-html-markup-tags
 375   '(("class" t t   t muse-html-class-tag)
 376     ("div"   t t   t muse-html-div-tag)
 377     ("src"   t t nil muse-html-src-tag))
 378  "A list of tag specifications, for specially marking up HTML."
 379   :type '(repeat (list (string :tag "Markup tag")
 380                        (boolean :tag "Expect closing tag" :value t)
 381                        (boolean :tag "Parse attributes" :value nil)
 382                        (boolean :tag "Nestable" :value nil)
 383                        function))
 384   :group 'muse-html)
 385
 386 (defcustom muse-html-meta-http-equiv "Content-Type"
 387   "The http-equiv attribute used for the HTML <meta> tag."
 388   :type 'string
 389   :group 'muse-html)
 390
 391 (defcustom muse-html-meta-content-type "text/html"
 392   "The content type used for the HTML <meta> tag.
 393 If you are striving for XHTML 1.1 compliance, you may want to
 394 change this to \"application/xhtml+xml\"."
 395   :type 'string
 396   :group 'muse-html)
 397
 398 (defcustom muse-html-meta-content-encoding (if (featurep 'mule)
 399                                               'detect
 400                                             "iso-8859-1")
 401   "The charset to append to the HTML <meta> tag.
 402 If set to the symbol 'detect, use `muse-html-encoding-map' to try
 403 and determine the HTML charset from emacs's coding.  If set to a
 404 string, this string will be used to force a particular charset"
 405   :type '(choice string symbol)
 406   :group 'muse-html)
 407
 408 (defcustom muse-html-encoding-default 'iso-8859-1
 409   "The default Emacs buffer encoding to use in published files.
 410 This will be used if no special characters are found."
 411   :type 'symbol
 412   :group 'muse-html)
 413
 414 (defcustom muse-html-charset-default "iso-8859-1"
 415   "The default HTML meta charset to use if no translation is found in
 416 `muse-html-encoding-map'."
 417   :type 'string
 418   :group 'muse-html)
 419
 420 (defcustom muse-html-src-allowed-modes t
 421   "Modes that we allow the <src> tag to colorize.
 422 If t, permit the <src> tag to colorize any mode.
 423
 424 If a list of mode names, such as '(\"html\" \"latex\"), and the
 425 lang argument to <src> is not in the list, then use fundamental
 426 mode instead."
 427   :type '(choice (const :tag "Any" t)
 428                  (repeat (string :tag "Mode")))
 429   :group 'muse-html)
 430
 431 (defun muse-html-insert-anchor (anchor)
 432   "Insert an anchor, either around the word at point, or within a tag."
 433   (skip-chars-forward (concat muse-regexp-blank "\n"))
 434   (if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
 435       (let ((tag (match-string 1)))
 436         (goto-char (match-end 0))
 437         (muse-insert-markup (muse-markup-text 'anchor anchor))
 438         (when muse-html-anchor-on-word
 439           (or (and (search-forward (format "</%s>" tag)
 440                                    (muse-line-end-position) t)
 441                    (goto-char (match-beginning 0)))
 442               (forward-word 1)))
 443         (muse-insert-markup "</a>"))
 444     (muse-insert-markup (muse-markup-text 'anchor anchor))
 445     (when muse-html-anchor-on-word
 446       (forward-word 1))
 447     (muse-insert-markup "</a>\n")))
 448
 449 (defun muse-html-markup-anchor ()
 450   (unless (get-text-property (match-end 1) 'muse-link)
 451     (save-match-data
 452       (muse-html-insert-anchor (match-string 2)))
 453     (match-string 1)))
 454
 455 (defun muse-html-markup-paragraph ()
 456   (let ((end (copy-marker (match-end 0) t)))
 457     (goto-char (match-beginning 0))
 458     (when (save-excursion
 459             (save-match-data
 460               (and (not (get-text-property (max (point-min) (1- (point)))
 461                                            'muse-no-paragraph))
 462                    (re-search-backward "<\\(/?\\)p[ >]" nil t)
 463                    (not (string-equal (match-string 1) "/")))))
 464       (when (get-text-property (1- (point)) 'muse-end-list)
 465         (goto-char (previous-single-property-change (1- (point))
 466                                                     'muse-end-list)))
 467       (muse-insert-markup "</p>"))
 468     (goto-char end))
 469   (cond
 470    ((eobp)
 471     (unless (bolp)
 472       (insert "\n")))
 473    ((get-text-property (point) 'muse-no-paragraph)
 474     (forward-char 1)
 475     nil)
 476    ((eq (char-after) ?\<)
 477     (cond
 478      ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
 479       (muse-insert-markup "<p>"))
 480      ((looking-at "<a ")
 481       (if (looking-at "<a[^>\n]+><img")
 482           (muse-insert-markup "<p class=\"image-link\">")
 483         (muse-insert-markup "<p>")))
 484      ((looking-at "<img[ >]")
 485       (muse-insert-markup "<p class=\"image\">"))
 486      (t
 487       (forward-char 1)
 488       nil)))
 489    ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
 490     (muse-insert-markup "<p class=\"first\">"))
 491    (t
 492     (muse-insert-markup "<p>"))))
 493
 494 (defun muse-html-markup-footnote ()
 495   (cond
 496    ((get-text-property (match-beginning 0) 'muse-link)
 497     nil)
 498    ((= (muse-line-beginning-position) (match-beginning 0))
 499     (prog1
 500         (let ((text (match-string 1)))
 501           (muse-insert-markup
 502            (concat "<p class=\"footnote\">"
 503                    "<a class=\"footnum\" name=\"fn." text
 504                    "\" href=\"#fnr." text "\">"
 505                    text ".</a>")))
 506       (save-excursion
 507         (save-match-data
 508           (let* ((beg (goto-char (match-end 0)))
 509                  (end (and (search-forward "\n\n" nil t)
 510                            (prog1
 511                                (copy-marker (match-beginning 0))
 512                              (goto-char beg)))))
 513             (while (re-search-forward (concat "^["
 514                                               muse-regexp-blank
 515                                               "]+\\([^\n]\\)")
 516                                       end t)
 517               (replace-match "\\1" t)))))
 518       (replace-match "")))
 519    (t (let ((text (match-string 1)))
 520         (muse-insert-markup
 521          (concat "<sup><a class=\"footref\" name=\"fnr." text
 522                  "\" href=\"#fn." text "\">"
 523                  text "</a></sup>")))
 524       (replace-match ""))))
 525
 526 (defun muse-html-markup-table ()
 527   (muse-xml-markup-table muse-html-table-attributes))
 528
 529 ;; Handling of tags for HTML
 530
 531 (defun muse-html-strip-links (string)
 532   "Remove all HTML links from STRING."
 533   (muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t))
 534
 535 (defun muse-html-insert-contents (depth)
 536   "Scan the current document and generate a table of contents at point.
 537 DEPTH indicates how many levels of headings to include.  The default is 2."
 538   (let ((max-depth (or depth 2))
 539         (index 1)
 540         base contents l end)
 541     (save-excursion
 542       (goto-char (point-min))
 543       (search-forward "Page published by Emacs Muse begins here" nil t)
 544       (catch 'done
 545         (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
 546           (unless (and (get-text-property (point) 'read-only)
 547                        (not (get-text-property (match-beginning 0)
 548                                                'muse-contents)))
 549             (remove-text-properties (match-beginning 0) (match-end 0)
 550                                     '(muse-contents nil))
 551             (setq l (1- (string-to-number (match-string 1))))
 552             (if (null base)
 553                 (setq base l)
 554               (if (< l base)
 555                   (throw 'done t)))
 556             (when (<= l max-depth)
 557               ;; escape specials now before copying the text, so that we
 558               ;; can deal sanely with both emphasis in titles and
 559               ;; special characters
 560               (goto-char (match-end 2))
 561               (setq end (point-marker))
 562               (muse-publish-escape-specials (match-beginning 2) end
 563                                             nil 'document)
 564               (muse-publish-mark-read-only (match-beginning 2) end)
 565               (setq contents (cons (cons l (buffer-substring-no-properties
 566                                             (match-beginning 2) end))
 567                                    contents))
 568               (set-marker end nil)
 569               (goto-char (match-beginning 2))
 570               (muse-html-insert-anchor (concat "sec" (int-to-string index)))
 571               (setq index (1+ index)))))))
 572     (setq index 1 contents (nreverse contents))
 573     (let ((depth 1) (sub-open 0) (p (point)))
 574       (muse-insert-markup "<div class=\"contents\">\n<dl>\n")
 575       (while contents
 576         (muse-insert-markup "<dt>\n"
 577                             "<a href=\"#sec" (int-to-string index) "\">"
 578                             (muse-html-strip-links (cdar contents))
 579                             "</a>\n"
 580                             "</dt>\n")
 581         (setq index (1+ index)
 582               depth (caar contents)
 583               contents (cdr contents))
 584         (when contents
 585           (cond
 586            ((< (caar contents) depth)
 587             (let ((idx (caar contents)))
 588               (while (< idx depth)
 589                 (muse-insert-markup "</dl>\n</dd>\n")
 590                 (setq sub-open (1- sub-open)
 591                       idx (1+ idx)))))
 592            ((> (caar contents) depth) ; can't jump more than one ahead
 593             (muse-insert-markup "<dd>\n<dl>\n")
 594             (setq sub-open (1+ sub-open))))))
 595       (while (> sub-open 0)
 596         (muse-insert-markup "</dl>\n</dd>\n")
 597         (setq sub-open (1- sub-open)))
 598       (muse-insert-markup "</dl>\n</div>\n")
 599       (muse-publish-mark-read-only p (point)))))
 600
 601 (defun muse-html-denote-headings ()
 602   "Place a text property on any headings in the current buffer.
 603 This allows the headings to be picked up later on if publishing a
 604 table of contents."
 605   (save-excursion
 606     (goto-char (point-min))
 607     (search-forward "Page published by Emacs Muse begins here" nil t)
 608     (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
 609       (unless (get-text-property (point) 'read-only)
 610         (add-text-properties (match-beginning 0) (match-end 0)
 611                              '(muse-contents t))))))
 612
 613 (defun muse-html-class-tag (beg end attrs)
 614   (let ((name (cdr (assoc "name" attrs))))
 615     (when name
 616       (goto-char beg)
 617       (muse-insert-markup "<span class=\"" name "\">")
 618       (save-excursion
 619         (goto-char end)
 620         (muse-insert-markup "</span>")))))
 621
 622 (defun muse-html-div-tag (beg end attrs)
 623   "Publish a <div> tag for HTML."
 624   (let ((id (cdr (assoc "id" attrs)))
 625         (style (cdr (assoc "style" attrs))))
 626     (when (or id style)
 627       (goto-char beg)
 628       (if (null id)
 629           (muse-insert-markup "<div style=\"" style "\">")
 630         (muse-insert-markup "<div id=\"" id "\">"))
 631       (save-excursion
 632         (goto-char end)
 633         (muse-insert-markup "</div>")))))
 634
 635 (defun muse-html-src-tag (beg end attrs)
 636   "Publish the region using htmlize.
 637 The language to use may be specified by the \"lang\" attribute.
 638
 639 Muse will look for a function named LANG-mode, where LANG is the
 640 value of the \"lang\" attribute.
 641
 642 This tag requires htmlize 1.34 or later in order to work."
 643   (if (condition-case nil
 644           (progn
 645             (require 'htmlize)
 646             (if (fboundp 'htmlize-region-for-paste)
 647                 nil
 648               (muse-display-warning
 649                (concat "The `htmlize-region-for-paste' function was not"
 650                        " found.\nThis is available in htmlize.el 1.34"
 651                        " or later."))
 652               t))
 653         (error nil t))
 654       ;; if htmlize.el was not found, treat this like an example tag
 655       (muse-publish-example-tag beg end)
 656     (muse-publish-ensure-block beg end)
 657     (let* ((lang (cdr (assoc "lang" attrs)))
 658            (mode (or (and (not (eq muse-html-src-allowed-modes t))
 659                           (not (member lang muse-html-src-allowed-modes))
 660                           'fundamental-mode)
 661                      (intern-soft (concat lang "-mode"))))
 662            (text (muse-delete-and-extract-region beg end))
 663            (htmltext
 664             (with-temp-buffer
 665               (insert text)
 666               (if (functionp mode)
 667                   (funcall mode)
 668                 (fundamental-mode))
 669               (font-lock-fontify-buffer)
 670               ;; silence the byte-compiler
 671               (when (fboundp 'htmlize-region-for-paste)
 672                 ;; transform the region to HTML
 673                 (htmlize-region-for-paste (point-min) (point-max))))))
 674       (save-restriction
 675         (narrow-to-region (point) (point))
 676         (insert htmltext)
 677         (goto-char (point-min))
 678         (re-search-forward "<pre\\([^>]*\\)>\n?" nil t)
 679         (replace-match "<pre class=\"src\">")
 680         (goto-char (point-max))
 681         (muse-publish-mark-read-only (point-min) (point-max))))))
 682
 683 ;; Register the Muse HTML Publisher
 684
 685 (defun muse-html-browse-file (file)
 686   (browse-url (concat "file:" file)))
 687
 688 (defun muse-html-encoding ()
 689   (if (stringp muse-html-meta-content-encoding)
 690       muse-html-meta-content-encoding
 691     (muse-xml-transform-content-type
 692      (or (and (boundp 'buffer-file-coding-system)
 693               buffer-file-coding-system)
 694          muse-html-encoding-default)
 695      muse-html-charset-default)))
 696
 697 (defun muse-html-prepare-buffer ()
 698   (make-local-variable 'muse-html-meta-http-equiv)
 699   (set (make-local-variable 'muse-html-meta-content-type)
 700        (if (save-match-data
 701              (string-match "charset=" muse-html-meta-content-type))
 702            muse-html-meta-content-type
 703          (concat muse-html-meta-content-type "; charset="
 704                  (muse-html-encoding)))))
 705
 706 (defun muse-html-munge-buffer ()
 707   (if muse-publish-generate-contents
 708       (progn
 709         (goto-char (car muse-publish-generate-contents))
 710         (muse-html-insert-contents (cdr muse-publish-generate-contents))
 711         (setq muse-publish-generate-contents nil))
 712     (muse-html-denote-headings)))
 713
 714 (defun muse-html-finalize-buffer ()
 715   (when (and (boundp 'buffer-file-coding-system)
 716              (memq buffer-file-coding-system '(no-conversion undecided-unix)))
 717     ;; make it agree with the default charset
 718     (setq buffer-file-coding-system muse-html-encoding-default)))
 719
 720 ;;; Register the Muse HTML and XHTML Publishers
 721
 722 (muse-define-style "html"
 723                    :suffix    'muse-html-extension
 724                    :regexps   'muse-html-markup-regexps
 725                    :functions 'muse-html-markup-functions
 726                    :strings   'muse-html-markup-strings
 727                    :tags      'muse-html-markup-tags
 728                    :specials  'muse-xml-decide-specials
 729                    :before    'muse-html-prepare-buffer
 730                    :before-end 'muse-html-munge-buffer
 731                    :after     'muse-html-finalize-buffer
 732                    :header    'muse-html-header
 733                    :footer    'muse-html-footer
 734                    :style-sheet 'muse-html-style-sheet
 735                    :browser   'muse-html-browse-file)
 736
 737 (muse-derive-style "xhtml" "html"
 738                    :suffix    'muse-xhtml-extension
 739                    :strings   'muse-xhtml-markup-strings
 740                    :header    'muse-xhtml-header
 741                    :footer    'muse-xhtml-footer
 742                    :style-sheet 'muse-xhtml-style-sheet)
 743
 744 ;; xhtml1.0 is an alias for xhtml
 745 (muse-derive-style "xhtml1.0" "xhtml")
 746
 747 ;; xhtml1.1 has some quirks that need attention from us
 748 (muse-derive-style "xhtml1.1" "xhtml"
 749                    :strings   'muse-xhtml1.1-markup-strings)
 750
 751 (provide 'muse-html)
 752
 753 ;;; muse-html.el ends here