code.delx.au - gnu-emacs-elpa/blob - packages/muse/muse-html.el

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