muse-html.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Muse HTML Publishing
   4 ;;
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 (require 'muse-publish)
   8 (require 'muse-regexps)
   9
  10 (defgroup muse-html nil
  11   "Options controlling the behaviour of Muse HTML publishing.
  12 See `muse-html' for more information."
  13   :group 'muse-publish)
  14
  15 (defcustom muse-html-extension ".html"
  16   "Default file extension for publishing HTML files."
  17   :type 'string
  18   :group 'muse-html)
  19
  20 (defcustom muse-html-style-sheet
  21   "<style type=\"text/css\">
  22 body {
  23   background: white; color: black;
  24   margin-left: 3%; margin-right: 7%;
  25 }
  26
  27 p { margin-top: 1% }
  28 p.verse { margin-left: 3% }
  29
  30 .example { margin-left: 3% }
  31
  32 h2 {
  33   margin-top: 25px;
  34   margin-bottom: 0px;
  35 }
  36 h3 { margin-bottom: 0px; }
  37     </style>"
  38   "Store your stylesheet definitions here.
  39 This is used in `muse-html-header'.
  40 You can put raw CSS in here or a <link> tag to an external stylesheet.
  41 This text may contain <lisp> markup tags.
  42
  43 An example of using <link> is as follows.
  44
  45 <link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">"
  46   :type 'string
  47   :group 'muse-html)
  48
  49 (defcustom muse-html-header
  50   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">
  51 <html>
  52   <head>
  53     <title><lisp>
  54   (concat (muse-publishing-directive \"title\")
  55           (let ((author (muse-publishing-directive \"author\")))
  56             (if (not (string= author (user-full-name)))
  57                 (concat \" (by \" author \")\"))))</lisp></title>
  58     <meta name=\"generator\" content=\"muse.el\">
  59     <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
  60           content=\"<lisp>muse-html-meta-content-type</lisp>\">
  61     <lisp>
  62       (let ((maintainer (muse-style-element :maintainer)))
  63         (when maintainer
  64           (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
  65     </lisp>
  66     <lisp>muse-html-style-sheet</lisp>
  67   </head>
  68   <body>
  69     <h1><lisp>
  70   (concat (muse-publishing-directive \"title\")
  71           (let ((author (muse-publishing-directive \"author\")))
  72             (if (not (string= author (user-full-name)))
  73                 (concat \" (by \" author \")\"))))</lisp></h1>
  74     <!-- Page published by Emacs Muse begins here -->\n"
  75   "Header used for publishing HTML files."
  76   :type '(choice string file)
  77   :group 'muse-html)
  78
  79 (defcustom muse-html-footer "
  80 <!-- Page published by Emacs Muse ends here -->
  81   </body>
  82 </html>\n"
  83   "Footer used for publishing HTML files."
  84   :type '(choice string file)
  85   :group 'muse-html)
  86
  87 (defcustom muse-html-anchor-on-word nil
  88   "When true, anchors surround the closest word. This allows you
  89 to select them in a browser (ie, for pasting), but has the
  90 side-effect of marking up headers in multiple colours if your
  91 header style is different from your link style."
  92   :type 'boolean
  93   :group 'muse-html)
  94
  95 (defcustom muse-html-table-attributes
  96   "class=\"muse-table\" border=\"2\" cellpadding=\"5\""
  97   "The attribute to be used with HTML <table> tags.
  98 Note that since Muse supports direct insertion of HTML tags, you
  99 can easily create any kind of table you want, as long as each
 100 line begins at column 0 (to prevent it from being blockquote'd).
 101 To make such a table, use this idiom:
 102
 103   <verbatim>
 104   <table>
 105     [... contents of my table, in raw HTML ...]
 106   </verbatim></table>
 107
 108 It may look strange to have the tags out of sequence, but this is
 109 because the Muse verbatim tag is handled during a different pass
 110 than the HTML table tag."
 111   :type 'string
 112   :group 'muse-html)
 113
 114 (defcustom muse-html-markup-regexps
 115   `(;; join together the parts of a list or table
 116     (10000 "</\\([oud]l\\)>\\s-*<\\1>\\s-*" 0 "")
 117     (10100 ,(concat "  </t\\(body\\|head\\|foot\\)>\\s-*</table>\\s-*"
 118                     "<table[^>]*>\\s-*<t\\1>\n") 0 "")
 119     (10200 "</table>\\s-*<table[^>]*>\n" 0 "")
 120
 121     ;; the beginning of the buffer begins the first paragraph
 122     (10300 "\\`\n*\\([^<-]\\|<\\(em\\|strong\\|code\\)>\\|<a \\)" 0
 123            "<p class=\"first\">\\1")
 124     ;; plain paragraph separator
 125     (10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
 126                     "\\(["
 127                     muse-regexp-blank
 128                     "]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?")
 129            0 muse-html-markup-paragraph)
 130     (10500 ,(concat "\\([^>"
 131                     muse-regexp-space
 132                     "]\\)\\s-*\\'")
 133            0 "\\1</p>\n"))
 134   "List of markup rules for publishing a Muse page to HTML.
 135 For more on the structure of this list, see `muse-publish-markup-regexps'."
 136   :type '(repeat (choice
 137                   (list :tag "Markup rule"
 138                         integer
 139                         (choice regexp symbol)
 140                         integer
 141                         (choice string function symbol))
 142                   function))
 143   :group 'muse-html)
 144
 145 (defcustom muse-html-markup-functions
 146   '((anchor   . muse-html-markup-anchor)
 147     (table    . muse-html-markup-table)
 148     (footnote . muse-html-markup-footnote))
 149   "An alist of style types to custom functions for that kind of text.
 150 For more on the structure of this list, see
 151 `muse-publish-markup-functions'."
 152   :type '(alist :key-type symbol :value-type function)
 153   :group 'muse-html)
 154
 155 (defcustom muse-html-markup-strings
 156   '((image-with-desc . "<img src=\"%s\" alt=\"%s\">")
 157     (image-link      . "<img src=\"%s\">")
 158     (url-with-image  . "<a class=\"image-link\" href=\"%s\"><img src=\"%s\"></a>")
 159     (url-link        . "<a href=\"%s\">%s</a>")
 160     (email-addr      . "<a href=\"mailto:%s\">%s</a>")
 161     (emdash          . " &mdash; ")
 162     (rule            . "<hr>")
 163     (fn-sep          . "<hr>\n")
 164     (enddots         . "....")
 165     (dots            . "...")
 166     (section         . "<h2>")
 167     (section-end     . "</h2>")
 168     (subsection      . "<h3>")
 169     (subsection-end  . "</h3>")
 170     (subsubsection   . "<h4>")
 171     (subsubsection-end . "</h4>")
 172     (begin-underline . "<u>")
 173     (end-underline   . "</u>")
 174     (begin-literal   . "<code>")
 175     (end-literal     . "</code>")
 176     (begin-emph      . "<em>")
 177     (end-emph        . "</em>")
 178     (begin-more-emph . "<strong>")
 179     (end-more-emph   . "</strong>")
 180     (begin-most-emph . "<strong><em>")
 181     (end-most-emph   . "</em></strong>")
 182     (begin-verse     . "<p class=\"verse\">\n")
 183     (verse-space     . "&nbsp;&nbsp;")
 184     (end-verse-line  . "<br>")
 185     (last-stanza-end . "<br>")
 186     (empty-verse-line . "<br>")
 187     (end-verse       . "</p>")
 188     (begin-example   . "<pre class=\"example\">")
 189     (end-example     . "</pre>")
 190     (begin-center    . "<center>\n")
 191     (end-center      . "\n</center>")
 192     (begin-quote     . "<blockquote>\n")
 193     (end-quote       . "\n</blockquote>")
 194     (begin-uli       . "<ul>\n<li>")
 195     (end-uli         . "</li>\n</ul>")
 196     (begin-oli       . "<ol>\n<li>")
 197     (end-oli         . "</li>\n</ol>")
 198     (begin-ddt       . "<dl>\n<dt><strong>")
 199     (start-dde       . "</strong></dt>\n<dd>")
 200     (end-ddt         . "</dd>\n</dl>"))
 201   "Strings used for marking up text.
 202 These cover the most basic kinds of markup, the handling of which
 203 differs little between the various styles."
 204   :type '(alist :key-type symbol :value-type string)
 205   :group 'muse-html)
 206
 207 (defcustom muse-html-markup-tags
 208   '(("class" t t muse-html-class-tag))
 209   "A list of tag specifications, for specially marking up HTML."
 210   :type '(repeat (list (string :tag "Markup tag")
 211                        (boolean :tag "Expect closing tag" :value t)
 212                        (boolean :tag "Parse attributes" :value nil)
 213                        function))
 214   :group 'muse-html)
 215
 216 (defcustom muse-html-markup-specials
 217   '((?\" . "&quot;")
 218     (?\< . "&lt;")
 219     (?\> . "&gt;")
 220     (?\& . "&amp;"))
 221   "A table of characters which must be represented specially."
 222   :type '(alist :key-type character :value-type string)
 223   :group 'muse-html)
 224
 225 (defcustom muse-html-meta-http-equiv "Content-Type"
 226   "The http-equiv attribute used for the HTML <meta> tag."
 227   :type 'string
 228   :group 'muse-html)
 229
 230 (defcustom muse-html-meta-content-type "text/html"
 231   "The content type used for the HTML <meta> tag."
 232   :type 'string
 233   :group 'muse-html)
 234
 235 (defcustom muse-html-meta-content-encoding (if (featurep 'mule)
 236                                               'detect
 237                                             "iso-8859-1")
 238   "If set to the symbol 'detect, use `muse-coding-map' to try
 239   and determine the HTML charset from emacs's coding. If set to a string, this
 240   string will be used to force a particular charset"
 241   :type '(choice string symbol)
 242   :group 'muse-html)
 243
 244 (defcustom muse-html-charset-default "iso-8859-1"
 245   "The default HTML meta charset to use if no translation is found in
 246   `muse-coding-map'"
 247   :type 'string
 248   :group 'muse-html)
 249
 250 (defcustom muse-html-encoding-default 'iso-8859-1
 251   "The default emacs coding  use if no special characters are found"
 252   :type 'symbol
 253   :group 'muse-html)
 254
 255 (defcustom muse-html-encoding-map
 256   '((iso-2022-jp        . "iso-2022-jp")
 257     (utf-8              . "utf-8")
 258     (japanese-iso-8bit  . "euc-jp")
 259     (chinese-big5       . "big5")
 260     (mule-utf-8         . "utf-8")
 261     (chinese-iso-8bit   . "gb2312")
 262     (chinese-gbk        . "gbk"))
 263   "An alist mapping emacs coding systems to appropriate HTML charsets.
 264   Use the base name of the coding system (ie, without the -unix)"
 265   :type '(alist :key-type coding-system :value-type string)
 266   :group 'muse-html)
 267
 268 (defun muse-html-transform-content-type (content-type)
 269   "Using `muse-html-encoding-map', try and resolve an emacs coding
 270 system to an associated HTML coding system. If no match is found,
 271 `muse-html-charset-default' is used instead."
 272   (let ((match (assoc (coding-system-base content-type)
 273                       muse-html-encoding-map)))
 274     (if match
 275         (cdr match)
 276       muse-html-charset-default)))
 277
 278 (defun muse-html-insert-anchor (anchor)
 279   "Insert an anchor, either around the word at point, or within a tag."
 280   (skip-chars-forward muse-regexp-space)
 281   (if (looking-at "<\\([^ />]+\\)>")
 282       (let ((tag (match-string 1)))
 283         (goto-char (match-end 0))
 284         (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 285         (when muse-html-anchor-on-word
 286           (or (and (search-forward (format "</%s>" tag)
 287                                    (line-end-position) t)
 288                    (goto-char (match-beginning 0)))
 289               (forward-word 1)))
 290         (insert "</a>"))
 291     (insert "<a name=\"" anchor "\" id=\"" anchor "\">")
 292     (when muse-html-anchor-on-word
 293       (forward-word 1))
 294     (insert "</a>")))
 295
 296 (unless (fboundp 'looking-back)
 297   (defun looking-back (regexp &optional limit)
 298     (save-excursion
 299       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 300
 301 (defun muse-html-markup-paragraph ()
 302   (let ((end (copy-marker (match-end 0) t)))
 303     (goto-char (match-beginning 0))
 304     (unless (eq (char-before) ?\>) (insert "</p>"))
 305     (goto-char end)
 306     (unless (and (eq (char-after) ?\<)
 307                  (not (or (looking-at "<\\(em\\|strong\\|code\\)>")
 308                           (and (looking-at "<a ")
 309                                (not (looking-at "<a[^>]+><img"))))))
 310       (cond
 311        ((looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
 312         (insert "<p class=\"first\">"))
 313        ((looking-back "<\\(blockquote\\|center\\)>\n")
 314         (insert "<p class=\"quoted\">"))
 315        (t
 316         (insert "<p>"))))))
 317
 318 (defun muse-html-markup-anchor ()
 319   (save-match-data
 320     (muse-html-insert-anchor (match-string 1))) "")
 321
 322 (defun muse-html-escape-string (str)
 323   "Convert to character entities any non-alphanumeric characters
 324 outside a few punctuation symbols, that risk being misinterpreted
 325 if not escaped."
 326   (when str
 327     (let (pos code len)
 328       (save-match-data
 329         (while (setq pos (string-match (concat "[^-"
 330                                                muse-regexp-alnum
 331                                                "/:._=@\\?~#]")
 332                                        str pos))
 333           (setq code (int-to-string (aref str pos))
 334                 len (length code)
 335                 str (replace-match (concat "&#" code ";") nil nil str)
 336                 pos (+ 3 len pos)))
 337         str))))
 338
 339 (defun muse-html-markup-footnote ()
 340   (if (/= (line-beginning-position) (match-beginning 0))
 341       "<sup><a name=\"fnr.\\1\" href=\"#fn.\\1\">\\1</a></sup>"
 342     (prog1
 343         "<p class=\"footnote\"><a name=\"fn.\\1\" href=\"#fnr.\\1\">\\1.</a>"
 344       (save-excursion
 345         (save-match-data
 346           (let* ((beg (goto-char (match-end 0)))
 347                  (end (and (search-forward "\n\n" nil t)
 348                            (prog1
 349                                (copy-marker (match-beginning 0))
 350                              (goto-char beg)))))
 351             (while (re-search-forward (concat "^["
 352                                               muse-regexp-blank
 353                                               "]+\\([^\n]\\)")
 354                                       end t)
 355               (replace-match "\\1" t))))))))
 356
 357 (defun muse-html-markup-table ()
 358   (let* ((str (prog1
 359                   (match-string 1)
 360                 (delete-region (match-beginning 0) (match-end 0))))
 361          (fields (split-string str "\\s-*|+\\s-*"))
 362          (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
 363                     (length (match-string 1 str))))
 364          (part (cond ((= type 1) "tbody")
 365                      ((= type 2) "thead")
 366                      ((= type 3) "tfoot")))
 367          (col (cond ((= type 1) "td")
 368                     ((= type 2) "th")
 369                     ((= type 3) "td")))
 370          field)
 371     (insert "<table " muse-html-table-attributes ">\n"
 372             "  <" part ">\n"
 373             "    <tr>\n")
 374     (dolist (field fields)
 375       (insert "      <" col ">" field "</" col ">\n"))
 376     (insert "    </tr>\n"
 377             "  </" part ">\n"
 378             "</table>\n")))
 379
 380 ;; Handling of tags for HTML
 381
 382 (defun muse-html-insert-contents (depth)
 383   (let ((max-depth (or depth 2))
 384         (index 1)
 385         base contents l)
 386     (save-excursion
 387       (goto-char (point-min))
 388       (search-forward "Page published by Emacs Muse begins here" nil t)
 389       (catch 'done
 390         (while (re-search-forward "^<h\\([0-9]+\\)>\\(.+?\\)</h\\1>" nil t)
 391           (unless (get-text-property (point) 'read-only)
 392             (setq l (1- (string-to-int (match-string 1))))
 393             (if (null base)
 394                 (setq base l)
 395               (if (< l base)
 396                   (throw 'done t)))
 397             (when (<= l max-depth)
 398               (setq contents (cons (cons l (match-string-no-properties 2))
 399                                    contents))
 400               (goto-char (match-beginning 2))
 401               (muse-html-insert-anchor (concat "sec" (int-to-string index)))
 402               (setq index (1+ index)))))))
 403     (setq index 1 contents (reverse contents))
 404     (let ((depth 1) (sub-open 0) (p (point)))
 405       (insert "<dl class=\"contents\">\n")
 406       (while contents
 407         (insert "<dt class=\"contents\">\n")
 408         (insert "<a href=\"#sec" (int-to-string index) "\">"
 409                 (muse-publish-strip-tags (cdar contents))
 410                 "</a>\n")
 411         (setq index (1+ index))
 412         (insert "</dt>\n")
 413         (setq depth (caar contents)
 414               contents (cdr contents))
 415         (if contents
 416             (cond
 417              ((< (caar contents) depth)
 418               (let ((idx (caar contents)))
 419                 (while (< idx depth)
 420                   (insert "</dl>\n</dd>\n")
 421                   (setq sub-open (1- sub-open)
 422                         idx (1+ idx)))))
 423              ((> (caar contents) depth) ; can't jump more than one ahead
 424               (insert "<dd>\n<dl class=\"contents\">\n")
 425               (setq sub-open (1+ sub-open))))))
 426       (while (> sub-open 0)
 427         (insert "</dl>\n</dd>\n")
 428         (setq sub-open (1- sub-open)))
 429       (insert "</dl>\n")
 430       (muse-publish-mark-read-only p (point)))))
 431
 432 (defun muse-html-class-tag (beg end attrs)
 433   (goto-char beg)
 434   (insert "<span class=\"" (cdr (assoc "name" attrs)) "\">")
 435   (goto-char end)
 436   (insert "</span>"))
 437
 438 ;; Register the Muse HTML Publisher
 439
 440 (defun muse-html-browse-file (file)
 441   (browse-url (concat "file:" file)))
 442
 443 (defun muse-html-encoding ()
 444   (if (stringp muse-html-meta-content-encoding)
 445       muse-html-meta-content-encoding
 446     (muse-html-transform-content-type
 447      (or buffer-file-coding-system
 448          muse-html-encoding-default))))
 449
 450 (defun muse-html-prepare-buffer ()
 451   (set (make-local-variable 'muse-publish-url-transforms)
 452        (cons 'muse-html-escape-string muse-publish-url-transforms))
 453   (make-local-variable 'muse-html-meta-http-equiv)
 454   (set (make-local-variable 'muse-html-meta-content-type)
 455        (concat muse-html-meta-content-type "; charset="
 456                (muse-html-encoding))))
 457
 458 (defun muse-html-finalize-buffer ()
 459   (when muse-publish-generate-contents
 460     (goto-char (car muse-publish-generate-contents))
 461     (muse-html-insert-contents (cdr muse-publish-generate-contents)))
 462   (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
 463     ;; make it agree with the default charset
 464     (setq buffer-file-coding-system muse-html-encoding-default)))
 465
 466 (unless (assoc "html" muse-publishing-styles)
 467   (muse-define-style "html"
 468                      :suffix    'muse-html-extension
 469                      :regexps   'muse-html-markup-regexps
 470                      :functions 'muse-html-markup-functions
 471                      :strings   'muse-html-markup-strings
 472                      :tags      'muse-html-markup-tags
 473                      :specials  'muse-html-markup-specials
 474                      :before    'muse-html-prepare-buffer
 475                      :after     'muse-html-finalize-buffer
 476                      :header    'muse-html-header
 477                      :footer    'muse-html-footer
 478                      :browser   'muse-html-browse-file))
 479
 480 (provide 'muse-html)
 481
 482 ;;; muse-html.el ends here