lisp/org-html.el

   1 ;;; org-html.el --- HTML export for Org-mode
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8 ;; Homepage: http://orgmode.org
   9 ;; Version: 6.33trans
  10 ;;
  11 ;; This file is part of GNU Emacs.
  12 ;;
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;;; Commentary:
  28
  29 (require 'org-exp)
  30 (eval-when-compile (require 'cl))
  31
  32 (declare-function org-id-find-id-file "org-id" (id))
  33 (declare-function htmlize-region "ext:htmlize" (beg end))
  34
  35 (defgroup org-export-html nil
  36   "Options specific for HTML export of Org-mode files."
  37   :tag "Org Export HTML"
  38   :group 'org-export)
  39
  40 (defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
  41 <h2 class=\"footnotes\">%s: </h2>
  42 <div id=\"text-footnotes\">
  43 %s
  44 </div>
  45 </div>"
  46   "Format for the footnotes section.
  47 Should contain a two instances of %s.  The first will be replaced with the
  48 language-specific word for \"Footnotes\", the second one will be replaced
  49 by the footnotes themselves."
  50   :group 'org-export-html
  51   :type 'string)
  52
  53 (defcustom org-export-html-footnote-format "<sup>%s</sup>"
  54   "The format for the footnote reference.
  55 %s will be replaced by the footnote reference itself."
  56   :group 'org-export-html
  57   :type 'string)
  58
  59 (defcustom org-export-html-coding-system nil
  60   "Coding system for HTML export, defaults to buffer-file-coding-system."
  61   :group 'org-export-html
  62   :type 'coding-system)
  63
  64 (defcustom org-export-html-extension "html"
  65   "The extension for exported HTML files."
  66   :group 'org-export-html
  67   :type 'string)
  68
  69 (defcustom org-export-html-xml-declaration
  70   '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
  71     ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
  72   "The extension for exported HTML files.
  73 %s will be replaced with the charset of the exported file.
  74 This may be a string, or an alist with export extensions
  75 and corresponding declarations."
  76   :group 'org-export-html
  77   :type '(choice
  78           (string :tag "Single declaration")
  79           (repeat :tag "Dependent on extension"
  80                   (cons (string :tag "Extension")
  81                         (string :tag "Declaration")))))
  82
  83 (defcustom org-export-html-style-include-scripts t
  84   "Non-nil means, include the javascript snippets in exported HTML files.
  85 The actual script is defined in `org-export-html-scripts' and should
  86 not be modified."
  87   :group 'org-export-html
  88   :type 'boolean)
  89
  90 (defconst org-export-html-scripts
  91 "<script type=\"text/javascript\">
  92 <!--/*--><![CDATA[/*><!--*/
  93  function CodeHighlightOn(elem, id)
  94  {
  95    var target = document.getElementById(id);
  96    if(null != target) {
  97      elem.cacheClassElem = elem.className;
  98      elem.cacheClassTarget = target.className;
  99      target.className = \"code-highlighted\";
 100      elem.className   = \"code-highlighted\";
 101    }
 102  }
 103  function CodeHighlightOff(elem, id)
 104  {
 105    var target = document.getElementById(id);
 106    if(elem.cacheClassElem)
 107      elem.className = elem.cacheClassElem;
 108    if(elem.cacheClassTarget)
 109      target.className = elem.cacheClassTarget;
 110  }
 111 /*]]>*///-->
 112 </script>"
 113 "Basic javascript that is needed by HTML files produced by Org-mode.")
 114
 115 (defconst org-export-html-style-default
 116 "<style type=\"text/css\">
 117  <!--/*--><![CDATA[/*><!--*/
 118   html { font-family: Times, serif; font-size: 12pt; }
 119   .title  { text-align: center; }
 120   .todo   { color: red; }
 121   .done   { color: green; }
 122   .tag    { background-color: #add8e6; font-weight:normal }
 123   .target { }
 124   .timestamp { color: #bebebe; }
 125   .timestamp-kwd { color: #5f9ea0; }
 126   p.verse { margin-left: 3% }
 127   pre {
 128         border: 1pt solid #AEBDCC;
 129         background-color: #F3F5F7;
 130         padding: 5pt;
 131         font-family: courier, monospace;
 132         font-size: 90%;
 133         overflow:auto;
 134   }
 135   table { border-collapse: collapse; }
 136   td, th { vertical-align: top; }
 137   dt { font-weight: bold; }
 138   div.figure { padding: 0.5em; }
 139   div.figure p { text-align: center; }
 140   .linenr { font-size:smaller }
 141   .code-highlighted {background-color:#ffff00;}
 142   .org-info-js_info-navigation { border-style:none; }
 143   #org-info-js_console-label { font-size:10px; font-weight:bold;
 144                                white-space:nowrap; }
 145   .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
 146                                  font-weight:bold; }
 147   /*]]>*/-->
 148 </style>"
 149   "The default style specification for exported HTML files.
 150 Please use the variables `org-export-html-style' and
 151 `org-export-html-style-extra' to add to this style.  If you wish to not
 152 have the default style included, customize the variable
 153 `org-export-html-style-include-default'.")
 154
 155 (defcustom org-export-html-style-include-default t
 156   "Non-nil means, include the default style in exported HTML files.
 157 The actual style is defined in `org-export-html-style-default' and should
 158 not be modified.  Use the variables `org-export-html-style' to add
 159 your own style information."
 160   :group 'org-export-html
 161   :type 'boolean)
 162 ;;;###autoload
 163 (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
 164
 165 (defcustom org-export-html-style ""
 166   "Org-wide style definitions for exported HTML files.
 167
 168 This variable needs to contain the full HTML structure to provide a style,
 169 including the surrounding HTML tags.  If you set the value of this variable,
 170 you should consider to include definitions for the following classes:
 171  title, todo, done, timestamp, timestamp-kwd, tag, target.
 172
 173 For example, a valid value would be:
 174
 175    <style type=\"text/css\">
 176     <![CDATA[
 177        p { font-weight: normal; color: gray; }
 178        h1 { color: black; }
 179       .title { text-align: center; }
 180       .todo, .timestamp-kwd { color: red; }
 181       .done { color: green; }
 182     ]]>
 183    </style>
 184
 185 If you'd like to refer to en external style file, use something like
 186
 187    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
 188
 189 As the value of this option simply gets inserted into the HTML <head> header,
 190 you can \"misuse\" it to add arbitrary text to the header.
 191 See also the variable `org-export-html-style-extra'."
 192   :group 'org-export-html
 193   :type 'string)
 194 ;;;###autoload
 195 (put 'org-export-html-style 'safe-local-variable 'stringp)
 196
 197 (defcustom org-export-html-style-extra ""
 198   "Additional style information for HTML export.
 199 The value of this variable is inserted into the HTML buffer right after
 200 the value of `org-export-html-style'.  Use this variable for per-file
 201 settings of style information, and do not forget to surround the style
 202 settings with <style>...</style> tags."
 203   :group 'org-export-html
 204   :type 'string)
 205 ;;;###autoload
 206 (put 'org-export-html-style-extra 'safe-local-variable 'stringp)
 207
 208 (defcustom org-export-html-tag-class-prefix ""
 209   "Prefix to clas names for TODO keywords.
 210 Each tag gets a class given by the tag itself, with this prefix.
 211 The default prefix is empty because it is nice to just use the keyword
 212 as a class name.  But if you get into conflicts with other, existing
 213 CSS classes, then this prefic can be very useful."
 214   :group 'org-export-html
 215   :type 'string)
 216
 217 (defcustom org-export-html-todo-kwd-class-prefix ""
 218   "Prefix to clas names for TODO keywords.
 219 Each TODO keyword gets a class given by the keyword itself, with this prefix.
 220 The default prefix is empty because it is nice to just use the keyword
 221 as a class name.  But if you get into conflicts with other, existing
 222 CSS classes, then this prefic can be very useful."
 223   :group 'org-export-html
 224   :type 'string)
 225
 226 (defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
 227   "Format for typesetting the document title in HTML export."
 228   :group 'org-export-html
 229   :type 'string)
 230
 231 (defcustom org-export-html-home/up-format
 232   "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
 233  <a accesskey=\"h\" href=\"%s\"> UP </a>
 234  |
 235  <a accesskey=\"H\" href=\"%s\"> HOME </a>
 236 </div>"
 237   "Snippet used to insert the HOME and UP links.  This is a format,
 238 the first %s will receive the UP link, the second the HOME link.
 239 If both `org-export-html-link-up' and `org-export-html-link-home' are
 240 empty, the entire snippet will be ignored."
 241   :group 'org-export-html
 242   :type 'string)
 243
 244 (defcustom org-export-html-toplevel-hlevel 2
 245   "The <H> level for level 1 headings in HTML export.
 246 This is also important for the classes that will be wrapped around headlines
 247 and outline structure.  If this variable is 1, the top-level headlines will
 248 be <h1>, and the corresponding classes will be outline-1, section-number-1,
 249 and outline-text-1.  If this is 2, all of these will get a 2 instead.
 250 The default for this variable is 2, because we use <h1> for formatting the
 251 document title."
 252   :group 'org-export-html
 253   :type 'string)
 254
 255 (defcustom org-export-html-link-org-files-as-html t
 256   "Non-nil means, make file links to `file.org' point to `file.html'.
 257 When org-mode is exporting an org-mode file to HTML, links to
 258 non-html files are directly put into a href tag in HTML.
 259 However, links to other Org-mode files (recognized by the
 260 extension `.org.) should become links to the corresponding html
 261 file, assuming that the linked org-mode file will also be
 262 converted to HTML.
 263 When nil, the links still point to the plain `.org' file."
 264   :group 'org-export-html
 265   :type 'boolean)
 266
 267 (defcustom org-export-html-inline-images 'maybe
 268   "Non-nil means, inline images into exported HTML pages.
 269 This is done using an <img> tag.  When nil, an anchor with href is used to
 270 link to the image.  If this option is `maybe', then images in links with
 271 an empty description will be inlined, while images with a description will
 272 be linked only."
 273   :group 'org-export-html
 274   :type '(choice (const :tag "Never" nil)
 275                  (const :tag "Always" t)
 276                  (const :tag "When there is no description" maybe)))
 277
 278 (defcustom org-export-html-inline-image-extensions
 279   '("png" "jpeg" "jpg" "gif")
 280   "Extensions of image files that can be inlined into HTML."
 281   :group 'org-export-html
 282   :type '(repeat (string :tag "Extension")))
 283
 284 (defcustom org-export-html-table-tag
 285   "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
 286   "The HTML tag that is used to start a table.
 287 This must be a <table> tag, but you may change the options like
 288 borders and spacing."
 289   :group 'org-export-html
 290   :type 'string)
 291
 292 (defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>")
 293   "The opening tag for table header fields.
 294 This is customizable so that alignment options can be specified.
 295 %s will be filled with the scope of the field, either row or col.
 296 See also the variable `org-export-html-table-use-header-tags-for-first-column'."
 297   :group 'org-export-tables
 298   :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
 299
 300 (defcustom org-export-table-data-tags '("<td>" . "</td>")
 301   "The opening tag for table data fields.
 302 This is customizable so that alignment options can be specified."
 303   :group 'org-export-tables
 304   :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
 305
 306 (defcustom org-export-table-row-tags '("<tr>" . "</tr>")
 307   "The opening tag for table data fields.
 308 This is customizable so that alignment options can be specified.
 309 Instead of strings, these can be Lisp forms that will be evaluated
 310 for each row in order to construct the table row tags.  During evaluation,
 311 the variable `head' will be true when this is a header line, nil when this
 312 is a body line.  And the variable `nline' will contain the line number,
 313 starting from 1 in the first header line.  For example
 314
 315   (setq org-export-table-row-tags
 316         (cons '(if head
 317                    \"<tr>\"
 318                  (if (= (mod nline 2) 1)
 319                      \"<tr class=\\\"tr-odd\\\">\"
 320                    \"<tr class=\\\"tr-even\\\">\"))
 321               \"</tr>\"))
 322
 323 will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
 324   :group 'org-export-tables
 325   :type '(cons
 326           (choice :tag "Opening tag"
 327                   (string :tag "Specify")
 328                   (sexp))
 329           (choice :tag "Closing tag"
 330                   (string :tag "Specify")
 331                   (sexp))))
 332
 333
 334
 335 (defcustom org-export-html-table-use-header-tags-for-first-column nil
 336   "Non-nil means, format column one in tables with header tags.
 337 When nil, also column one will use data tags."
 338   :group 'org-export-tables
 339   :type 'boolean)
 340
 341 (defcustom org-export-html-validation-link nil
 342   "Non-nil means, add validationlink to postamble of HTML exported files."
 343   :group 'org-export-html
 344   :type '(choice
 345           (const :tag "Nothing" nil)
 346           (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>")
 347           (string :tag "Specify full HTML")))
 348
 349
 350 (defcustom org-export-html-with-timestamp nil
 351   "If non-nil, write `org-export-html-html-helper-timestamp'
 352 into the exported HTML text.  Otherwise, the buffer will just be saved
 353 to a file."
 354   :group 'org-export-html
 355   :type 'boolean)
 356
 357 (defcustom org-export-html-html-helper-timestamp
 358   "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
 359   "The HTML tag used as timestamp delimiter for HTML-helper-mode."
 360   :group 'org-export-html
 361   :type 'string)
 362
 363 (defgroup org-export-htmlize nil
 364   "Options for processing examples with htmlize.el."
 365   :tag "Org Export Htmlize"
 366   :group 'org-export-html)
 367
 368 (defcustom org-export-htmlize-output-type 'inline-css
 369   "Output type to be used by htmlize when formatting code snippets.
 370 We use as default  `inline-css', in order to make the resulting
 371 HTML self-containing.
 372 However, this will fail when using Emacs in batch mode for export, because
 373 then no rich font definitions are in place.  It will also not be good if
 374 people with different Emacs setup contribute HTML files to a website,
 375 because the fonts will represent the individual setups.  In these cases,
 376 it is much better to let Org/Htmlize assign classes only, and to use
 377 a style file to define the look of these classes.
 378 To get a start for your css file, start Emacs session and make sure that
 379 all the faces you are interested in are defined, for example by loading files
 380 in all modes you want.  Then, use the command
 381 \\[org-export-htmlize-generate-css] to extract class definitions."
 382   :group 'org-export-htmlize
 383   :type '(choice (const css) (const inline-css)))
 384
 385 (defcustom org-export-htmlize-css-font-prefix "org-"
 386   "The prefix for CSS class names for htmlize font specifications."
 387   :group 'org-export-htmlize
 388   :type 'string)
 389
 390 (defcustom org-export-htmlized-org-css-url nil
 391   "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
 392 Normally when creating an htmlized version of an Org buffer, htmlize will
 393 create CSS to define the font colors.  However, this does not work when
 394 converting in batch mode, and it also can look bad if different people
 395 with different fontification setup work on the same website.
 396 When this variable is non-nil, creating an htmlized version of an Org buffer
 397 using `org-export-as-org' will remove the internal CSS section and replace it
 398 with a link to this URL."
 399   :group 'org-export-htmlize
 400   :type '(choice
 401           (const :tag "Keep internal css" nil)
 402           (string :tag "URL or local href")))
 403
 404 ;;; Variables, constants, and parameter plists
 405
 406 (defvar org-export-html-preamble nil
 407   "Preamble, to be inserted just before <body>.  Set by publishing functions.
 408 This may also be a function, building and inserting the preamble.")
 409 (defvar org-export-html-postamble nil
 410   "Preamble, to be inserted just after </body>.  Set by publishing functions.
 411 This may also be a function, building and inserting the postamble.")
 412 (defvar org-export-html-auto-preamble t
 413   "Should default preamble be inserted?  Set by publishing functions.")
 414 (defvar org-export-html-auto-postamble t
 415   "Should default postamble be inserted?  Set by publishing functions.")
 416
 417 ;;; Hooks
 418
 419 (defvar org-export-html-after-blockquotes-hook nil
 420   "Hook run during HTML export, after blockquote, verse, center are done.")
 421
 422 (defvar org-export-html-final-hook nil
 423   "Hook run during HTML export, after blockquote, verse, center are done.")
 424
 425 ;;; HTML export
 426
 427 (defun org-export-html-preprocess (parameters)
 428   ;; Convert LaTeX fragments to images
 429   (when (and org-current-export-file
 430              (plist-get parameters :LaTeX-fragments))
 431     (org-format-latex
 432      (concat "ltxpng/" (file-name-sans-extension
 433                         (file-name-nondirectory
 434                          org-current-export-file)))
 435      org-current-export-dir nil "Creating LaTeX image %s"))
 436   (message "Exporting..."))
 437
 438 ;;;###autoload
 439 (defun org-export-as-html-and-open (arg)
 440   "Export the outline as HTML and immediately open it with a browser.
 441 If there is an active region, export only the region.
 442 The prefix ARG specifies how many levels of the outline should become
 443 headlines.  The default is 3.  Lower levels will become bulleted lists."
 444   (interactive "P")
 445   (org-export-as-html arg 'hidden)
 446   (org-open-file buffer-file-name))
 447
 448 ;;;###autoload
 449 (defun org-export-as-html-batch ()
 450   "Call `org-export-as-html', may be used in batch processing as
 451 emacs   --batch
 452         --load=$HOME/lib/emacs/org.el
 453         --eval \"(setq org-export-headline-levels 2)\"
 454         --visit=MyFile --funcall org-export-as-html-batch"
 455   (org-export-as-html org-export-headline-levels 'hidden))
 456
 457 ;;;###autoload
 458 (defun org-export-as-html-to-buffer (arg)
 459   "Call `org-export-as-html` with output to a temporary buffer.
 460 No file is created.  The prefix ARG is passed through to `org-export-as-html'."
 461   (interactive "P")
 462   (org-export-as-html arg nil nil "*Org HTML Export*")
 463   (when org-export-show-temporary-export-buffer
 464     (switch-to-buffer-other-window "*Org HTML Export*")))
 465
 466 ;;;###autoload
 467 (defun org-replace-region-by-html (beg end)
 468   "Assume the current region has org-mode syntax, and convert it to HTML.
 469 This can be used in any buffer.  For example, you could write an
 470 itemized list in org-mode syntax in an HTML buffer and then use this
 471 command to convert it."
 472   (interactive "r")
 473   (let (reg html buf pop-up-frames)
 474     (save-window-excursion
 475       (if (org-mode-p)
 476           (setq html (org-export-region-as-html
 477                       beg end t 'string))
 478         (setq reg (buffer-substring beg end)
 479               buf (get-buffer-create "*Org tmp*"))
 480         (with-current-buffer buf
 481           (erase-buffer)
 482           (insert reg)
 483           (org-mode)
 484           (setq html (org-export-region-as-html
 485                       (point-min) (point-max) t 'string)))
 486         (kill-buffer buf)))
 487     (delete-region beg end)
 488     (insert html)))
 489
 490 ;;;###autoload
 491 (defun org-export-region-as-html (beg end &optional body-only buffer)
 492   "Convert region from BEG to END in org-mode buffer to HTML.
 493 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
 494 contents, and only produce the region of converted text, useful for
 495 cut-and-paste operations.
 496 If BUFFER is a buffer or a string, use/create that buffer as a target
 497 of the converted HTML.  If BUFFER is the symbol `string', return the
 498 produced HTML as a string and leave not buffer behind.  For example,
 499 a Lisp program could call this function in the following way:
 500
 501   (setq html (org-export-region-as-html beg end t 'string))
 502
 503 When called interactively, the output buffer is selected, and shown
 504 in a window.  A non-interactive call will only return the buffer."
 505   (interactive "r\nP")
 506   (when (interactive-p)
 507     (setq buffer "*Org HTML Export*"))
 508   (let ((transient-mark-mode t) (zmacs-regions t)
 509         ext-plist rtn)
 510     (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
 511     (goto-char end)
 512     (set-mark (point)) ;; to activate the region
 513     (goto-char beg)
 514     (setq rtn (org-export-as-html
 515                nil nil ext-plist
 516                buffer body-only))
 517     (if (fboundp 'deactivate-mark) (deactivate-mark))
 518     (if (and (interactive-p) (bufferp rtn))
 519         (switch-to-buffer-other-window rtn)
 520       rtn)))
 521
 522 (defvar html-table-tag nil) ; dynamically scoped into this.
 523 (defvar org-par-open nil)
 524 ;;;###autoload
 525 (defun org-export-as-html (arg &optional hidden ext-plist
 526                                to-buffer body-only pub-dir)
 527   "Export the outline as a pretty HTML file.
 528 If there is an active region, export only the region.  The prefix
 529 ARG specifies how many levels of the outline should become
 530 headlines.  The default is 3.  Lower levels will become bulleted
 531 lists.  HIDDEN is obsolete and does nothing.
 532 EXT-PLIST is a property list with external parameters overriding
 533 org-mode's default settings, but still inferior to file-local
 534 settings.  When TO-BUFFER is non-nil, create a buffer with that
 535 name and export to that buffer.  If TO-BUFFER is the symbol
 536 `string', don't leave any buffer behind but just return the
 537 resulting HTML as a string.  When BODY-ONLY is set, don't produce
 538 the file header and footer, simply return the content of
 539 <body>...</body>, without even the body tags themselves.  When
 540 PUB-DIR is set, use this as the publishing directory."
 541   (interactive "P")
 542   (run-hooks 'org-export-first-hook)
 543
 544   ;; Make sure we have a file name when we need it.
 545   (when (and (not (or to-buffer body-only))
 546              (not buffer-file-name))
 547     (if (buffer-base-buffer)
 548         (org-set-local 'buffer-file-name
 549                        (with-current-buffer (buffer-base-buffer)
 550                          buffer-file-name))
 551       (error "Need a file name to be able to export")))
 552
 553   (message "Exporting...")
 554   (setq-default org-todo-line-regexp org-todo-line-regexp)
 555   (setq-default org-deadline-line-regexp org-deadline-line-regexp)
 556   (setq-default org-done-keywords org-done-keywords)
 557   (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
 558   (let* ((opt-plist
 559           (org-export-process-option-filters
 560            (org-combine-plists (org-default-export-plist)
 561                                ext-plist
 562                                (org-infile-export-plist))))
 563          (body-only (or body-only (plist-get opt-plist :body-only)))
 564          (style (concat (if (plist-get opt-plist :style-include-default)
 565                             org-export-html-style-default)
 566                         (plist-get opt-plist :style)
 567                         (plist-get opt-plist :style-extra)
 568                         "\n"
 569                         (if (plist-get opt-plist :style-include-scripts)
 570                             org-export-html-scripts)))
 571          (html-extension (plist-get opt-plist :html-extension))
 572          (link-validate (plist-get opt-plist :link-validation-function))
 573          valid thetoc have-headings first-heading-pos
 574          (odd org-odd-levels-only)
 575          (region-p (org-region-active-p))
 576          (rbeg (and region-p (region-beginning)))
 577          (rend (and region-p (region-end)))
 578          (subtree-p
 579           (if (plist-get opt-plist :ignore-subtree-p)
 580               nil
 581             (when region-p
 582               (save-excursion
 583                 (goto-char rbeg)
 584                 (and (org-at-heading-p)
 585                      (>= (org-end-of-subtree t t) rend))))))
 586          (level-offset (if subtree-p
 587                            (save-excursion
 588                              (goto-char rbeg)
 589                              (+ (funcall outline-level)
 590                                 (if org-odd-levels-only 1 0)))
 591                          0))
 592          (opt-plist (setq org-export-opt-plist
 593                           (if subtree-p
 594                               (org-export-add-subtree-options opt-plist rbeg)
 595                             opt-plist)))
 596          ;; The following two are dynamically scoped into other
 597          ;; routines below.
 598          (org-current-export-dir
 599           (or pub-dir (org-export-directory :html opt-plist)))
 600          (org-current-export-file buffer-file-name)
 601          (level 0) (line "") (origline "") txt todo
 602          (umax nil)
 603          (umax-toc nil)
 604          (filename (if to-buffer nil
 605                      (expand-file-name
 606                       (concat
 607                        (file-name-sans-extension
 608                         (or (and subtree-p
 609                                  (org-entry-get (region-beginning)
 610                                                 "EXPORT_FILE_NAME" t))
 611                             (file-name-nondirectory buffer-file-name)))
 612                        "." html-extension)
 613                       (file-name-as-directory
 614                        (or pub-dir (org-export-directory :html opt-plist))))))
 615          (current-dir (if buffer-file-name
 616                           (file-name-directory buffer-file-name)
 617                         default-directory))
 618          (buffer (if to-buffer
 619                      (cond
 620                       ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
 621                       (t (get-buffer-create to-buffer)))
 622                    (find-file-noselect filename)))
 623          (org-levels-open (make-vector org-level-max nil))
 624          (date (plist-get opt-plist :date))
 625          (author      (plist-get opt-plist :author))
 626          (title       (or (and subtree-p (org-export-get-title-from-subtree))
 627                           (plist-get opt-plist :title)
 628                           (and (not
 629                                 (plist-get opt-plist :skip-before-1st-heading))
 630                                (org-export-grab-title-from-buffer))
 631                           (and buffer-file-name
 632                                (file-name-sans-extension
 633                                 (file-name-nondirectory buffer-file-name)))
 634                           "UNTITLED"))
 635          (link-up (and (plist-get opt-plist :link-up)
 636                        (string-match "\\S-" (plist-get opt-plist :link-up))
 637                        (plist-get opt-plist :link-up)))
 638          (link-home (and (plist-get opt-plist :link-home)
 639                         (string-match "\\S-" (plist-get opt-plist :link-home))
 640                         (plist-get opt-plist :link-home)))
 641          (dummy (setq opt-plist (plist-put opt-plist :title title)))
 642          (html-table-tag (plist-get opt-plist :html-table-tag))
 643          (quote-re0   (concat "^[ \t]*" org-quote-string "\\>"))
 644          (quote-re    (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
 645          (inquote     nil)
 646          (infixed     nil)
 647          (inverse     nil)
 648          (in-local-list nil)
 649          (local-list-type nil)
 650          (local-list-indent nil)
 651          (llt org-plain-list-ordered-item-terminator)
 652          (email       (plist-get opt-plist :email))
 653          (language    (plist-get opt-plist :language))
 654          (keywords    (plist-get opt-plist :keywords))
 655          (description (plist-get opt-plist :description))
 656          (lang-words  nil)
 657          (head-count  0) cnt
 658          (start       0)
 659          (coding-system (and (boundp 'buffer-file-coding-system)
 660                              buffer-file-coding-system))
 661          (coding-system-for-write (or org-export-html-coding-system
 662                                       coding-system))
 663          (save-buffer-coding-system (or org-export-html-coding-system
 664                                         coding-system))
 665          (charset (and coding-system-for-write
 666                        (fboundp 'coding-system-get)
 667                        (coding-system-get coding-system-for-write
 668                                           'mime-charset)))
 669          (region
 670           (buffer-substring
 671            (if region-p (region-beginning) (point-min))
 672            (if region-p (region-end) (point-max))))
 673          (lines
 674           (org-split-string
 675            (org-export-preprocess-string
 676             region
 677             :emph-multiline t
 678             :for-html t
 679             :skip-before-1st-heading
 680             (plist-get opt-plist :skip-before-1st-heading)
 681             :drawers (plist-get opt-plist :drawers)
 682             :todo-keywords (plist-get opt-plist :todo-keywords)
 683             :tags (plist-get opt-plist :tags)
 684             :priority (plist-get opt-plist :priority)
 685             :footnotes (plist-get opt-plist :footnotes)
 686             :timestamps (plist-get opt-plist :timestamps)
 687             :archived-trees
 688             (plist-get opt-plist :archived-trees)
 689             :select-tags (plist-get opt-plist :select-tags)
 690             :exclude-tags (plist-get opt-plist :exclude-tags)
 691             :add-text
 692             (plist-get opt-plist :text)
 693             :LaTeX-fragments
 694             (plist-get opt-plist :LaTeX-fragments))
 695            "[\r\n]"))
 696          table-open type
 697          table-buffer table-orig-buffer
 698          ind item-type starter didclose
 699          rpl path attr desc descp desc1 desc2 link
 700          snumber fnc item-tag
 701          footnotes footref-seen
 702          id-file href
 703          )
 704
 705     (let ((inhibit-read-only t))
 706       (org-unmodified
 707        (remove-text-properties (point-min) (point-max)
 708                                '(:org-license-to-kill t))))
 709
 710     (message "Exporting...")
 711
 712     (setq org-min-level (org-get-min-level lines level-offset))
 713     (setq org-last-level org-min-level)
 714     (org-init-section-numbers)
 715
 716     (cond
 717      ((and date (string-match "%" date))
 718       (setq date (format-time-string date)))
 719      (date)
 720      (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
 721
 722     ;; Get the language-dependent settings
 723     (setq lang-words (or (assoc language org-export-language-setup)
 724                          (assoc "en" org-export-language-setup)))
 725
 726     ;; Switch to the output buffer
 727     (set-buffer buffer)
 728     (let ((inhibit-read-only t)) (erase-buffer))
 729     (fundamental-mode)
 730     (org-install-letbind)
 731
 732     (and (fboundp 'set-buffer-file-coding-system)
 733          (set-buffer-file-coding-system coding-system-for-write))
 734
 735     (let ((case-fold-search nil)
 736           (org-odd-levels-only odd))
 737       ;; create local variables for all options, to make sure all called
 738       ;; functions get the correct information
 739       (mapc (lambda (x)
 740               (set (make-local-variable (nth 2 x))
 741                    (plist-get opt-plist (car x))))
 742             org-export-plist-vars)
 743       (setq umax (if arg (prefix-numeric-value arg)
 744                    org-export-headline-levels))
 745       (setq umax-toc (if (integerp org-export-with-toc)
 746                          (min org-export-with-toc umax)
 747                        umax))
 748       (unless body-only
 749         ;; File header
 750         (insert (format
 751                  "%s
 752 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
 753                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 754 <html xmlns=\"http://www.w3.org/1999/xhtml\"
 755 lang=\"%s\" xml:lang=\"%s\">
 756 <head>
 757 <title>%s</title>
 758 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
 759 <meta name=\"generator\" content=\"Org-mode\"/>
 760 <meta name=\"generated\" content=\"%s\"/>
 761 <meta name=\"author\" content=\"%s\"/>
 762 <meta name=\"description\" content=\"%s\"/>
 763 <meta name=\"keywords\" content=\"%s\"/>
 764 %s
 765 </head>
 766 <body>
 767 <div id=\"content\">
 768 %s
 769 "
 770                  (format
 771                   (or (and (stringp org-export-html-xml-declaration)
 772                            org-export-html-xml-declaration)
 773                       (cdr (assoc html-extension org-export-html-xml-declaration))
 774                       (cdr (assoc "html" org-export-html-xml-declaration))
 775
 776                       "")
 777                   (or charset "iso-8859-1"))
 778                  language language
 779                  (org-html-expand title)
 780                  (or charset "iso-8859-1")
 781                  date author description keywords
 782                  style
 783                  (if (or link-up link-home)
 784                      (concat
 785                       (format org-export-html-home/up-format
 786                               (or link-up link-home)
 787                               (or link-home link-up))
 788                       "\n")
 789                    "")))
 790
 791         (org-export-html-insert-plist-item opt-plist :preamble opt-plist)
 792
 793         (when (plist-get opt-plist :auto-preamble)
 794           (if title (insert (format org-export-html-title-format
 795                                     (org-html-expand title))))))
 796
 797       (if (and org-export-with-toc (not body-only))
 798           (progn
 799             (push (format "<h%d>%s</h%d>\n"
 800                           org-export-html-toplevel-hlevel
 801                           (nth 3 lang-words)
 802                           org-export-html-toplevel-hlevel)
 803                   thetoc)
 804             (push "<div id=\"text-table-of-contents\">\n" thetoc)
 805             (push "<ul>\n<li>" thetoc)
 806             (setq lines
 807                   (mapcar '(lambda (line)
 808                     (if (string-match org-todo-line-regexp line)
 809                         ;; This is a headline
 810                         (progn
 811                           (setq have-headings t)
 812                           (setq level (- (match-end 1) (match-beginning 1)
 813                                          level-offset)
 814                                 level (org-tr-level level)
 815                                 txt (save-match-data
 816                                       (org-html-expand
 817                                        (org-export-cleanup-toc-line
 818                                         (match-string 3 line))))
 819                                 todo
 820                                 (or (and org-export-mark-todo-in-toc
 821                                          (match-beginning 2)
 822                                          (not (member (match-string 2 line)
 823                                                       org-done-keywords)))
 824                                         ; TODO, not DONE
 825                                     (and org-export-mark-todo-in-toc
 826                                          (= level umax-toc)
 827                                          (org-search-todo-below
 828                                           line lines level))))
 829                           (if (string-match
 830                                (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
 831                               (setq txt (replace-match  "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
 832                           (if (string-match quote-re0 txt)
 833                               (setq txt (replace-match "" t t txt)))
 834                           (setq snumber (org-section-number level))
 835                           (if org-export-with-section-numbers
 836                               (setq txt (concat snumber " " txt)))
 837                           (if (<= level (max umax umax-toc))
 838                               (setq head-count (+ head-count 1)))
 839                           (if (<= level umax-toc)
 840                               (progn
 841                                 (if (> level org-last-level)
 842                                     (progn
 843                                       (setq cnt (- level org-last-level))
 844                                       (while (>= (setq cnt (1- cnt)) 0)
 845                                         (push "\n<ul>\n<li>" thetoc))
 846                                       (push "\n" thetoc)))
 847                                 (if (< level org-last-level)
 848                                     (progn
 849                                       (setq cnt (- org-last-level level))
 850                                       (while (>= (setq cnt (1- cnt)) 0)
 851                                         (push "</li>\n</ul>" thetoc))
 852                                       (push "\n" thetoc)))
 853                                 ;; Check for targets
 854                                 (while (string-match org-any-target-regexp line)
 855                                   (setq line (replace-match
 856                                               (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
 857                                               t t line)))
 858                                 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
 859                                   (setq txt (replace-match "" t t txt)))
 860                                 (setq href (format "sec-%s" snumber))
 861                                 (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
 862                                 (push
 863                                  (format
 864                                   (if todo
 865                                       "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
 866                                     "</li>\n<li><a href=\"#%s\">%s</a>")
 867                                   href txt) thetoc)
 868
 869                                 (setq org-last-level level))
 870                             )))
 871                     line)
 872                           lines))
 873             (while (> org-last-level (1- org-min-level))
 874               (setq org-last-level (1- org-last-level))
 875               (push "</li>\n</ul>\n" thetoc))
 876             (push "</div>\n" thetoc)
 877             (setq thetoc (if have-headings (nreverse thetoc) nil))))
 878
 879       (setq head-count 0)
 880       (org-init-section-numbers)
 881
 882       (org-open-par)
 883
 884       (while (setq line (pop lines) origline line)
 885         (catch 'nextline
 886
 887           ;; end of quote section?
 888           (when (and inquote (string-match "^\\*+ " line))
 889             (insert "</pre>\n")
 890             (org-open-par)
 891             (setq inquote nil))
 892           ;; inside a quote section?
 893           (when inquote
 894             (insert (org-html-protect line) "\n")
 895             (throw 'nextline nil))
 896
 897           ;; Fixed-width, verbatim lines (examples)
 898           (when (and org-export-with-fixed-width
 899                      (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
 900             (when (not infixed)
 901               (setq infixed t)
 902               (org-close-par-maybe)
 903
 904               (insert "<pre class=\"example\">\n"))
 905             (insert (org-html-protect (match-string 3 line)) "\n")
 906             (when (or (not lines)
 907                       (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
 908                                          (car lines))))
 909               (setq infixed nil)
 910               (insert "</pre>\n")
 911               (org-open-par))
 912             (throw 'nextline nil))
 913
 914           (org-export-html-close-lists-maybe line)
 915
 916           ;; Protected HTML
 917           (when (get-text-property 0 'org-protected line)
 918             (let (par (ind (get-text-property 0 'original-indentation line)))
 919               (when (re-search-backward
 920                      "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
 921                 (setq par (match-string 1))
 922                 (replace-match "\\2\n"))
 923               (insert line "\n")
 924               (while (and lines
 925                           (or (= (length (car lines)) 0)
 926                               (not ind)
 927                               (equal ind (get-text-property 0 'original-indentation (car lines))))
 928                           (or (= (length (car lines)) 0)
 929                               (get-text-property 0 'org-protected (car lines))))
 930                 (insert (pop lines) "\n"))
 931               (and par (insert "<p>\n")))
 932             (throw 'nextline nil))
 933
 934           ;; Blockquotes, verse, and center
 935           (when (equal "ORG-BLOCKQUOTE-START" line)
 936             (org-close-par-maybe)
 937             (insert "<blockquote>\n")
 938             (org-open-par)
 939             (throw 'nextline nil))
 940           (when (equal "ORG-BLOCKQUOTE-END" line)
 941             (org-close-par-maybe)
 942             (insert "\n</blockquote>\n")
 943             (org-open-par)
 944             (throw 'nextline nil))
 945           (when (equal "ORG-VERSE-START" line)
 946             (org-close-par-maybe)
 947             (insert "\n<p class=\"verse\">\n")
 948             (setq inverse t)
 949             (throw 'nextline nil))
 950           (when (equal "ORG-VERSE-END" line)
 951             (insert "</p>\n")
 952             (org-open-par)
 953             (setq inverse nil)
 954             (throw 'nextline nil))
 955           (when (equal "ORG-CENTER-START" line)
 956             (org-close-par-maybe)
 957             (insert "\n<div style=\"text-align: center\">")
 958             (org-open-par)
 959             (throw 'nextline nil))
 960           (when (equal "ORG-CENTER-END" line)
 961             (org-close-par-maybe)
 962             (insert "\n</div>")
 963             (org-open-par)
 964             (throw 'nextline nil))
 965           (run-hooks 'org-export-html-after-blockquotes-hook)
 966           (when inverse
 967             (let ((i (org-get-string-indentation line)))
 968               (if (> i 0)
 969                   (setq line (concat (mapconcat 'identity
 970                                                 (make-list (* 2 i) "\\nbsp") "")
 971                                      " " (org-trim line))))
 972               (unless (string-match "\\\\\\\\[ \t]*$" line)
 973                 (setq line (concat line "\\\\")))))
 974
 975           ;; make targets to anchors
 976           (setq start 0)
 977           (while (string-match
 978                   "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
 979             (cond
 980              ((get-text-property (match-beginning 1) 'org-protected line)
 981               (setq start (match-end 1)))
 982              ((match-end 2)
 983               (setq line (replace-match
 984                           (format
 985                            "@<a name=\"%s\" id=\"%s\">@</a>"
 986                            (org-solidify-link-text (match-string 1 line))
 987                            (org-solidify-link-text (match-string 1 line)))
 988                           t t line)))
 989              ((and org-export-with-toc (equal (string-to-char line) ?*))
 990               ;; FIXME: NOT DEPENDENT on TOC?????????????????????
 991               (setq line (replace-match
 992                           (concat "@<span class=\"target\">"
 993                                   (match-string 1 line) "@</span> ")
 994                           ;; (concat "@<i>" (match-string 1 line) "@</i> ")
 995                           t t line)))
 996              (t
 997               (setq line (replace-match
 998                           (concat "@<a name=\""
 999                                   (org-solidify-link-text (match-string 1 line))
1000                                   "\" class=\"target\">" (match-string 1 line)
1001                                   "@</a> ")
1002                           t t line)))))
1003
1004           (setq line (org-html-handle-time-stamps line))
1005
1006           ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
1007           ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
1008           ;; Also handle sub_superscripts and checkboxes
1009           (or (string-match org-table-hline-regexp line)
1010               (setq line (org-html-expand line)))
1011
1012           ;; Format the links
1013           (setq start 0)
1014           (while (string-match org-bracket-link-analytic-regexp++ line start)
1015             (setq start (match-beginning 0))
1016             (setq path (save-match-data (org-link-unescape
1017                                          (match-string 3 line))))
1018             (setq type (cond
1019                         ((match-end 2) (match-string 2 line))
1020                         ((save-match-data
1021                            (or (file-name-absolute-p path)
1022                                (string-match "^\\.\\.?/" path)))
1023                          "file")
1024                         (t "internal")))
1025             (setq path (org-extract-attributes (org-link-unescape path)))
1026             (setq attr (get-text-property 0 'org-attributes path))
1027             (setq desc1 (if (match-end 5) (match-string 5 line))
1028                   desc2 (if (match-end 2) (concat type ":" path) path)
1029                   descp (and desc1 (not (equal desc1 desc2)))
1030                   desc (or desc1 desc2))
1031             ;; Make an image out of the description if that is so wanted
1032             (when (and descp (org-file-image-p
1033                               desc org-export-html-inline-image-extensions))
1034               (save-match-data
1035                 (if (string-match "^file:" desc)
1036                     (setq desc (substring desc (match-end 0)))))
1037               (setq desc (org-add-props
1038                              (concat "<img src=\"" desc "\"/>")
1039                              '(org-protected t))))
1040             ;; FIXME: do we need to unescape here somewhere?
1041             (cond
1042              ((equal type "internal")
1043               (setq rpl
1044                     (concat
1045                      "<a href=\""
1046                      (if (= (string-to-char path) ?#) "" "#")
1047                      (org-solidify-link-text
1048                       (save-match-data (org-link-unescape path)) nil)
1049                      "\"" attr ">"
1050                      (org-export-html-format-desc desc)
1051                      "</a>")))
1052              ((and (equal type "id")
1053                    (setq id-file (org-id-find-id-file path)))
1054               ;; This is an id: link to another file (if it was the same file,
1055               ;; it would have become an internal link...)
1056               (save-match-data
1057                 (setq id-file (file-relative-name
1058                                id-file (file-name-directory org-current-export-file)))
1059                 (setq id-file (concat (file-name-sans-extension id-file)
1060                                       "." html-extension))
1061                 (setq rpl (concat "<a href=\"" id-file "#"
1062                                   (if (org-uuidgen-p path) "ID-")
1063                                   path "\""
1064                                   attr ">"
1065                                   (org-export-html-format-desc desc)
1066                                   "</a>"))))
1067              ((member type '("http" "https"))
1068               ;; standard URL, just check if we need to inline an image
1069               (if (and (or (eq t org-export-html-inline-images)
1070                            (and org-export-html-inline-images (not descp)))
1071                        (org-file-image-p
1072                         path org-export-html-inline-image-extensions))
1073                   (setq rpl (org-export-html-format-image
1074                              (concat type ":" path) org-par-open))
1075                 (setq link (concat type ":" path))
1076                 (setq rpl (concat "<a href=\""
1077                                   (org-export-html-format-href link)
1078                                   "\"" attr ">"
1079                                   (org-export-html-format-desc desc)
1080                                   "</a>"))))
1081              ((member type '("ftp" "mailto" "news"))
1082               ;; standard URL
1083               (setq link (concat type ":" path))
1084               (setq rpl (concat "<a href=\""
1085                                 (org-export-html-format-href link)
1086                                 "\"" attr ">"
1087                                 (org-export-html-format-desc desc)
1088                                 "</a>")))
1089
1090              ((string= type "coderef")
1091               (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
1092                                 path path path
1093                                 (format (org-export-get-coderef-format path (and descp desc))
1094                                         (cdr (assoc path org-export-code-refs))))))
1095
1096              ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
1097               ;; The link protocol has a function for format the link
1098               (setq rpl
1099                     (save-match-data
1100                       (funcall fnc (org-link-unescape path) desc1 'html))))
1101
1102              ((string= type "file")
1103               ;; FILE link
1104               (let* ((filename path)
1105                      (abs-p (file-name-absolute-p filename))
1106                      thefile file-is-image-p search)
1107                 (save-match-data
1108                   (if (string-match "::\\(.*\\)" filename)
1109                       (setq search (match-string 1 filename)
1110                             filename (replace-match "" t nil filename)))
1111                   (setq valid
1112                         (if (functionp link-validate)
1113                             (funcall link-validate filename current-dir)
1114                           t))
1115                   (setq file-is-image-p
1116                         (org-file-image-p
1117                          filename org-export-html-inline-image-extensions))
1118                   (setq thefile (if abs-p (expand-file-name filename) filename))
1119                   (when (and org-export-html-link-org-files-as-html
1120                              (string-match "\\.org$" thefile))
1121                     (setq thefile (concat (substring thefile 0
1122                                                      (match-beginning 0))
1123                                           "." html-extension))
1124                     (if (and search
1125                              ;; make sure this is can be used as target search
1126                              (not (string-match "^[0-9]*$" search))
1127                              (not (string-match "^\\*" search))
1128                              (not (string-match "^/.*/$" search)))
1129                         (setq thefile (concat thefile "#"
1130                                               (org-solidify-link-text
1131                                                (org-link-unescape search)))))
1132                     (when (string-match "^file:" desc)
1133                       (setq desc (replace-match "" t t desc))
1134                       (if (string-match "\\.org$" desc)
1135                           (setq desc (replace-match "" t t desc))))))
1136                 (setq rpl (if (and file-is-image-p
1137                                    (or (eq t org-export-html-inline-images)
1138                                        (and org-export-html-inline-images
1139                                             (not descp))))
1140                               (progn
1141                                 (message "image %s %s" thefile org-par-open)
1142                                 (org-export-html-format-image thefile org-par-open))
1143                             (concat "<a href=\"" thefile "\"" attr ">"
1144                                     (org-export-html-format-desc desc)
1145                                     "</a>")))
1146                 (if (not valid) (setq rpl desc))))
1147
1148              (t
1149               ;; just publish the path, as default
1150               (setq rpl (concat "<i>&lt;" type ":"
1151                                 (save-match-data (org-link-unescape path))
1152                                 "&gt;</i>"))))
1153             (setq line (replace-match rpl t t line)
1154                   start (+ start (length rpl))))
1155
1156           ;; TODO items
1157           (if (and (string-match org-todo-line-regexp line)
1158                    (match-beginning 2))
1159
1160               (setq line
1161                     (concat (substring line 0 (match-beginning 2))
1162                             "<span class=\""
1163                             (if (member (match-string 2 line)
1164                                         org-done-keywords)
1165                                 "done" "todo")
1166                             " " (match-string 2 line)
1167                             "\"> " (org-export-html-get-todo-kwd-class-name
1168                                     (match-string 2 line))
1169                             "</span>" (substring line (match-end 2)))))
1170
1171           ;; Does this contain a reference to a footnote?
1172           (when org-export-with-footnotes
1173             (setq start 0)
1174             (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
1175               (if (get-text-property (match-beginning 2) 'org-protected line)
1176                   (setq start (match-end 2))
1177                 (let ((n (match-string 2 line)) extra a)
1178                   (if (setq a (assoc n footref-seen))
1179                       (progn
1180                         (setcdr a (1+ (cdr a)))
1181                         (setq extra (format ".%d" (cdr a))))
1182                     (setq extra "")
1183                     (push (cons n 1) footref-seen))
1184                   (setq line
1185                         (replace-match
1186                          (format
1187                           (concat "%s"
1188                                   (format org-export-html-footnote-format
1189                                           "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))
1190                           (or (match-string 1 line) "") n extra n n)
1191                          t t line))))))
1192
1193           (cond
1194            ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
1195             ;; This is a headline
1196             (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1197                                          level-offset))
1198                   txt (match-string 2 line))
1199             (if (string-match quote-re0 txt)
1200                 (setq txt (replace-match "" t t txt)))
1201             (if (<= level (max umax umax-toc))
1202                 (setq head-count (+ head-count 1)))
1203             (when in-local-list
1204               ;; Close any local lists before inserting a new header line
1205               (while local-list-type
1206                 (org-close-li (car local-list-type))
1207                 (insert (format "</%sl>\n" (car local-list-type)))
1208                 (pop local-list-type))
1209               (setq local-list-indent nil
1210                     in-local-list nil))
1211             (setq first-heading-pos (or first-heading-pos (point)))
1212             (org-html-level-start level txt umax
1213                                   (and org-export-with-toc (<= level umax))
1214                                   head-count)
1215
1216             ;; QUOTES
1217             (when (string-match quote-re line)
1218               (org-close-par-maybe)
1219               (insert "<pre>")
1220               (setq inquote t)))
1221
1222            ((string-match "^[ \t]*- __+[ \t]*$" line)
1223             ;; Explicit list closure
1224             (when local-list-type
1225               (let ((ind (org-get-indentation line)))
1226                 (while (and local-list-indent
1227                             (<= ind (car local-list-indent)))
1228                   (org-close-li (car local-list-type))
1229                   (insert (format "</%sl>\n" (car local-list-type)))
1230                   (pop local-list-type)
1231                   (pop local-list-indent))
1232                 (or local-list-indent (setq in-local-list nil))))
1233             (throw 'nextline nil))
1234
1235            ((and org-export-with-tables
1236                  (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1237             (when (not table-open)
1238               ;; New table starts
1239               (setq table-open t table-buffer nil table-orig-buffer nil))
1240
1241             ;; Accumulate lines
1242             (setq table-buffer (cons line table-buffer)
1243                   table-orig-buffer (cons origline table-orig-buffer))
1244             (when (or (not lines)
1245                       (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1246                                          (car lines))))
1247               (setq table-open nil
1248                     table-buffer (nreverse table-buffer)
1249                     table-orig-buffer (nreverse table-orig-buffer))
1250               (org-close-par-maybe)
1251               (insert (org-format-table-html table-buffer table-orig-buffer))))
1252            (t
1253             ;; Normal lines
1254             (when (string-match
1255                    (cond
1256                     ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1257                     ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1258                     ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1259                     (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
1260                    line)
1261               (setq ind (or (get-text-property 0 'original-indentation line)
1262                             (org-get-string-indentation line))
1263                     item-type (if (match-beginning 4) "o" "u")
1264                     starter (if (match-beginning 2)
1265                                 (substring (match-string 2 line) 0 -1))
1266                     line (substring line (match-beginning 5))
1267                     item-tag nil)
1268               (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
1269                   (setq item-type "d"
1270                         item-tag (match-string 1 line)
1271                         line (substring line (match-end 0))))
1272               (when (and (not (equal item-type "d"))
1273                          (not (string-match "[^ \t]" line)))
1274                 ;; empty line.  Pretend indentation is large.
1275                 (setq ind (if org-empty-line-terminates-plain-lists
1276                               0
1277                             (1+ (or (car local-list-indent) 1)))))
1278               (setq didclose nil)
1279               (while (and in-local-list
1280                           (or (and (= ind (car local-list-indent))
1281                                    (not starter))
1282                               (< ind (car local-list-indent))))
1283                 (setq didclose t)
1284                 (org-close-li (car local-list-type))
1285                 (insert (format "</%sl>\n" (car local-list-type)))
1286                 (pop local-list-type) (pop local-list-indent)
1287                 (setq in-local-list local-list-indent))
1288               (cond
1289                ((and starter
1290                      (or (not in-local-list)
1291                          (> ind (car local-list-indent))))
1292                 ;; Start new (level of) list
1293                 (org-close-par-maybe)
1294                 (insert (cond
1295                          ((equal item-type "u") "<ul>\n<li>\n")
1296                          ((equal item-type "o") "<ol>\n<li>\n")
1297                          ((equal item-type "d")
1298                           (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
1299                 (push item-type local-list-type)
1300                 (push ind local-list-indent)
1301                 (setq in-local-list t))
1302                (starter
1303                 ;; continue current list
1304                 (org-close-li (car local-list-type))
1305                 (insert (cond
1306                          ((equal (car local-list-type) "d")
1307                           (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
1308                          (t "<li>\n"))))
1309                (didclose
1310                 ;; we did close a list, normal text follows: need <p>
1311                 (org-open-par)))
1312               (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
1313                   (setq line
1314                         (replace-match
1315                          (if (equal (match-string 1 line) "X")
1316                              "<b>[X]</b>"
1317                            "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
1318                            t t line))))
1319
1320             ;; Horizontal line
1321             (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1322               (if org-par-open
1323                   (insert "\n</p>\n<hr/>\n<p>\n")
1324                 (insert "\n<hr/>\n"))
1325               (throw 'nextline nil))
1326
1327             ;; Empty lines start a new paragraph.  If hand-formatted lists
1328             ;; are not fully interpreted, lines starting with "-", "+", "*"
1329             ;; also start a new paragraph.
1330             (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
1331
1332             ;; Is this the start of a footnote?
1333             (when org-export-with-footnotes
1334               (when (and (boundp 'footnote-section-tag-regexp)
1335                          (string-match (concat "^" footnote-section-tag-regexp)
1336                                        line))
1337                 ;; ignore this line
1338                 (throw 'nextline nil))
1339               (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1340                 (org-close-par-maybe)
1341                 (let ((n (match-string 1 line)))
1342                   (setq org-par-open t
1343                         line (replace-match
1344                               (format
1345                                (concat "<p class=\"footnote\">"
1346                                        (format org-export-html-footnote-format
1347                                                "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
1348                                n n n) t t line)))))
1349             ;; Check if the line break needs to be conserved
1350             (cond
1351              ((string-match "\\\\\\\\[ \t]*$" line)
1352               (setq line (replace-match "<br/>" t t line)))
1353              (org-export-preserve-breaks
1354               (setq line (concat line "<br/>"))))
1355
1356             ;; Check if a paragraph should be started
1357             (let ((start 0))
1358               (while (and org-par-open
1359                           (string-match "\\\\par\\>" line start))
1360                 ;; Leave a space in the </p> so that the footnote matcher
1361                 ;; does not see this.
1362                 (if (not (get-text-property (match-beginning 0)
1363                                             'org-protected line))
1364                     (setq line (replace-match "</p ><p >" t t line)))
1365                 (setq start (match-end 0))))
1366
1367             (insert line "\n")))))
1368
1369       ;; Properly close all local lists and other lists
1370       (when inquote
1371         (insert "</pre>\n")
1372         (org-open-par))
1373       (when in-local-list
1374         ;; Close any local lists before inserting a new header line
1375         (while local-list-type
1376           (org-close-li (car local-list-type))
1377           (insert (format "</%sl>\n" (car local-list-type)))
1378           (pop local-list-type))
1379         (setq local-list-indent nil
1380               in-local-list nil))
1381       (org-html-level-start 1 nil umax
1382                             (and org-export-with-toc (<= level umax))
1383                             head-count)
1384       ;; the </div> to close the last text-... div.
1385       (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
1386
1387       (save-excursion
1388         (goto-char (point-min))
1389         (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
1390           (push (match-string 0) footnotes)
1391           (replace-match "" t t)))
1392       (when footnotes
1393         (insert (format org-export-html-footnotes-section
1394                         (nth 4 lang-words)
1395                         (mapconcat 'identity (nreverse footnotes) "\n"))
1396                 "\n"))
1397       (let ((bib (org-export-html-get-bibliography)))
1398         (when bib
1399           (insert "\n" bib "\n")))
1400       (unless body-only
1401         (when (plist-get opt-plist :auto-postamble)
1402           (insert "<div id=\"postamble\">\n")
1403           (when (and org-export-author-info author)
1404             (insert "<p class=\"author\"> "
1405                     (nth 1 lang-words) ": " author "\n")
1406             (when email
1407               (if (listp (split-string email ",+ *"))
1408                   (mapc (lambda(e)
1409                           (insert "<a href=\"mailto:" e "\">&lt;"
1410                                   e "&gt;</a>\n"))
1411                         (split-string email ",+ *"))
1412                 (insert "<a href=\"mailto:" email "\">&lt;"
1413                         email "&gt;</a>\n")))
1414             (insert "</p>\n"))
1415           (when (and date org-export-time-stamp-file)
1416             (insert "<p class=\"date\"> "
1417                     (nth 2 lang-words) ": "
1418                     date "</p>\n"))
1419           (when org-export-creator-info
1420             (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n"
1421                             org-version emacs-major-version)))
1422           (when org-export-html-validation-link
1423             (insert org-export-html-validation-link "\n"))
1424           (insert "</div>"))
1425
1426         (if org-export-html-with-timestamp
1427             (insert org-export-html-html-helper-timestamp))
1428         (org-export-html-insert-plist-item opt-plist :postamble opt-plist)
1429         (insert "\n</div>\n</body>\n</html>\n"))
1430
1431       (unless (plist-get opt-plist :buffer-will-be-killed)
1432         (normal-mode)
1433         (if (eq major-mode (default-value 'major-mode))
1434             (html-mode)))
1435
1436       ;; insert the table of contents
1437       (goto-char (point-min))
1438       (when thetoc
1439         (if (or (re-search-forward
1440                  "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1441                 (re-search-forward
1442                  "\\[TABLE-OF-CONTENTS\\]" nil t))
1443             (progn
1444               (goto-char (match-beginning 0))
1445               (replace-match ""))
1446           (goto-char first-heading-pos)
1447           (when (looking-at "\\s-*</p>")
1448             (goto-char (match-end 0))
1449             (insert "\n")))
1450         (insert "<div id=\"table-of-contents\">\n")
1451         (mapc 'insert thetoc)
1452         (insert "</div>\n"))
1453       ;; remove empty paragraphs and lists
1454       (goto-char (point-min))
1455       (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1456         (replace-match ""))
1457       (goto-char (point-min))
1458       (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
1459         (replace-match ""))
1460       (goto-char (point-min))
1461       (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
1462         (replace-match ""))
1463       ;; Convert whitespace place holders
1464       (goto-char (point-min))
1465       (let (beg end n)
1466         (while (setq beg (next-single-property-change (point) 'org-whitespace))
1467           (setq n (get-text-property beg 'org-whitespace)
1468                 end (next-single-property-change beg 'org-whitespace))
1469           (goto-char beg)
1470           (delete-region beg end)
1471           (insert (format "<span style=\"visibility:hidden;\">%s</span>"
1472                           (make-string n ?x)))))
1473       ;; Remove empty lines at the beginning of the file.
1474       (goto-char (point-min))
1475       (when (looking-at "\\s-+\n") (replace-match ""))
1476       ;; Run the hook
1477       (run-hooks 'org-export-html-final-hook)
1478       (or to-buffer (save-buffer))
1479       (goto-char (point-min))
1480       (or (org-export-push-to-kill-ring "HTML")
1481           (message "Exporting... done"))
1482       (if (eq to-buffer 'string)
1483           (prog1 (buffer-substring (point-min) (point-max))
1484             (kill-buffer (current-buffer)))
1485         (current-buffer)))))
1486
1487 (defun org-export-html-insert-plist-item (plist key &rest args)
1488   (let ((item (plist-get plist key)))
1489     (cond ((functionp item)
1490            (apply item args))
1491           (item
1492            (insert item)))))
1493
1494 (defun org-export-html-format-href (s)
1495   "Make sure the S is valid as a href reference in an XHTML document."
1496   (save-match-data
1497     (let ((start 0))
1498       (while (string-match "&" s start)
1499         (setq start (+ (match-beginning 0) 3)
1500               s (replace-match "&amp;" t t s)))))
1501   s)
1502
1503 (defun org-export-html-format-desc (s)
1504   "Make sure the S is valid as a description in a link."
1505   (if (and s (not (get-text-property 1 'org-protected s)))
1506       (save-match-data
1507         (org-html-do-expand s))
1508     s))
1509
1510 (defun org-export-html-format-image (src par-open)
1511   "Create image tag with source and attributes."
1512   (save-match-data
1513     (if (string-match "^ltxpng/" src)
1514         (format "<img src=\"%s\"/>" src)
1515       (let* ((caption (org-find-text-property-in-string 'org-caption src))
1516              (attr (org-find-text-property-in-string 'org-attributes src))
1517              (label (org-find-text-property-in-string 'org-label src)))
1518         (concat
1519         (if caption
1520             (format "%s<div %sclass=\"figure\">
1521 <p>"
1522                     (if org-par-open "</p>\n" "")
1523                     (if label (format "id=\"%s\" " label) "")))
1524         (format "<img src=\"%s\"%s />"
1525                 src
1526                 (if (string-match "\\<alt=" (or attr ""))
1527                     (concat " " attr )
1528                   (concat " " attr " alt=\"" src "\"")))
1529         (if caption
1530             (format "</p>%s
1531 </div>%s"
1532                 (concat "\n<p>" caption "</p>")
1533                 (if org-par-open "\n<p>" ""))))))))
1534
1535 (defun org-export-html-get-bibliography ()
1536   "Find bibliography, cut it out and return it."
1537   (catch 'exit
1538     (let (beg end (cnt 1) bib)
1539       (save-excursion
1540         (goto-char (point-min))
1541         (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
1542           (setq beg (match-beginning 0))
1543           (while (re-search-forward "</?div\\>" nil t)
1544             (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
1545             (when (= cnt 0)
1546               (and (looking-at ">") (forward-char 1))
1547               (setq bib (buffer-substring beg (point)))
1548               (delete-region beg (point))
1549             (throw 'exit bib))))
1550         nil))))
1551
1552 (defvar org-table-number-regexp) ; defined in org-table.el
1553 (defun org-format-table-html (lines olines)
1554   "Find out which HTML converter to use and return the HTML code."
1555   (if (stringp lines)
1556       (setq lines (org-split-string lines "\n")))
1557   (if (string-match "^[ \t]*|" (car lines))
1558       ;; A normal org table
1559       (org-format-org-table-html lines)
1560     ;; Table made by table.el - test for spanning
1561     (let* ((hlines (delq nil (mapcar
1562                               (lambda (x)
1563                                 (if (string-match "^[ \t]*\\+-" x) x
1564                                   nil))
1565                               lines)))
1566            (first (car hlines))
1567            (ll (and (string-match "\\S-+" first)
1568                     (match-string 0 first)))
1569            (re (concat "^[ \t]*" (regexp-quote ll)))
1570            (spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
1571                                        hlines))))
1572       (if (and (not spanning)
1573                (not org-export-prefer-native-exporter-for-tables))
1574           ;; We can use my own converter with HTML conversions
1575           (org-format-table-table-html lines)
1576         ;; Need to use the code generator in table.el, with the original text.
1577         (org-format-table-table-html-using-table-generate-source olines)))))
1578
1579 (defvar org-table-number-fraction) ; defined in org-table.el
1580 (defun org-format-org-table-html (lines &optional splice)
1581   "Format a table into HTML."
1582   (require 'org-table)
1583   ;; Get rid of hlines at beginning and end
1584   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1585   (setq lines (nreverse lines))
1586   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1587   (setq lines (nreverse lines))
1588   (when org-export-table-remove-special-lines
1589     ;; Check if the table has a marking column.  If yes remove the
1590     ;; column and the special lines
1591     (setq lines (org-table-clean-before-export lines)))
1592
1593   (let* ((caption (or (get-text-property 0 'org-caption (car lines))
1594                       (get-text-property (or (next-single-property-change
1595                                               0 'org-caption (car lines))
1596                                              0)
1597                                          'org-caption (car lines))))
1598          (attributes (or (get-text-property 0 'org-attributes (car lines))
1599                          (get-text-property (or (next-single-property-change
1600                                                  0 'org-attributes (car lines))
1601                                                 0)
1602                                             'org-attributes (car lines))))
1603          (html-table-tag (org-export-splice-attributes
1604                           html-table-tag attributes))
1605          (head (and org-export-highlight-first-table-line
1606                     (delq nil (mapcar
1607                                (lambda (x) (string-match "^[ \t]*|-" x))
1608                                (cdr lines)))))
1609
1610          (nline 0) fnum i
1611          tbopen line fields html gr colgropen rowstart rowend)
1612     (if splice (setq head nil))
1613     (unless splice (push (if head "<thead>" "<tbody>") html))
1614     (setq tbopen t)
1615     (while (setq line (pop lines))
1616       (catch 'next-line
1617         (if (string-match "^[ \t]*|-" line)
1618             (progn
1619               (unless splice
1620                 (push (if head "</thead>" "</tbody>") html)
1621                 (if lines (push "<tbody>" html) (setq tbopen nil)))
1622               (setq head nil)   ;; head ends here, first time around
1623               ;; ignore this line
1624               (throw 'next-line t)))
1625         ;; Break the line into fields
1626         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1627         (unless fnum (setq fnum (make-vector (length fields) 0)))
1628         (setq nline (1+ nline) i -1
1629               rowstart (eval (car org-export-table-row-tags))
1630               rowend (eval (cdr org-export-table-row-tags)))
1631         (push (concat rowstart
1632                       (mapconcat
1633                        (lambda (x)
1634                          (setq i (1+ i))
1635                          (if (and (< i nline)
1636                                   (string-match org-table-number-regexp x))
1637                              (incf (aref fnum i)))
1638                          (cond
1639                           (head
1640                            (concat
1641                             (format (car org-export-table-header-tags) "col")
1642                             x
1643                             (cdr org-export-table-header-tags)))
1644                           ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
1645                            (concat
1646                             (format (car org-export-table-header-tags) "row")
1647                             x
1648                             (cdr org-export-table-header-tags)))
1649                           (t
1650                            (concat (car org-export-table-data-tags) x
1651                                    (cdr org-export-table-data-tags)))))
1652                        fields "")
1653                       rowend)
1654               html)))
1655     (unless splice (if tbopen (push "</tbody>" html)))
1656     (unless splice (push "</table>\n" html))
1657     (setq html (nreverse html))
1658     (unless splice
1659       ;; Put in col tags with the alignment (unfortunately often ignored...)
1660       (unless (car org-table-colgroup-info)
1661         (setq org-table-colgroup-info
1662               (cons :start (cdr org-table-colgroup-info))))
1663       (push (mapconcat
1664              (lambda (x)
1665                (setq gr (pop org-table-colgroup-info))
1666                (format "%s<col align=\"%s\" />%s"
1667                        (if (memq gr '(:start :startend))
1668                            (prog1
1669                                (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
1670                              (setq colgropen t))
1671                          "")
1672                        (if (> (/ (float x) nline) org-table-number-fraction)
1673                            "right" "left")
1674                        (if (memq gr '(:end :startend))
1675                            (progn (setq colgropen nil) "</colgroup>")
1676                          "")))
1677              fnum "")
1678             html)
1679       (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
1680       ;; Since the output of HTML table formatter can also be used in
1681       ;; DocBook document, we want to always include the caption to make
1682       ;; DocBook XML file valid.
1683       (push (format "<caption>%s</caption>" (or caption "")) html)
1684       (push html-table-tag html))
1685     (concat (mapconcat 'identity html "\n") "\n")))
1686
1687 (defun org-export-splice-attributes (tag attributes)
1688   "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
1689   (if (not attributes)
1690       tag
1691     (let (oldatt newatt)
1692       (setq oldatt (org-extract-attributes-from-string tag)
1693             tag (pop oldatt)
1694             newatt (cdr (org-extract-attributes-from-string attributes)))
1695       (while newatt
1696         (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
1697       (if (string-match ">" tag)
1698           (setq tag
1699                 (replace-match (concat (org-attributes-to-string oldatt) ">")
1700                                t t tag)))
1701       tag)))
1702
1703 (defun org-format-table-table-html (lines)
1704   "Format a table generated by table.el into HTML.
1705 This conversion does *not* use `table-generate-source' from table.el.
1706 This has the advantage that Org-mode's HTML conversions can be used.
1707 But it has the disadvantage, that no cell- or row-spanning is allowed."
1708   (let (line field-buffer
1709              (head org-export-highlight-first-table-line)
1710              fields html empty i)
1711     (setq html (concat html-table-tag "\n"))
1712     (while (setq line (pop lines))
1713       (setq empty "&nbsp;")
1714       (catch 'next-line
1715         (if (string-match "^[ \t]*\\+-" line)
1716             (progn
1717               (if field-buffer
1718                   (progn
1719                     (setq
1720                      html
1721                      (concat
1722                       html
1723                       "<tr>"
1724                       (mapconcat
1725                        (lambda (x)
1726                          (if (equal x "") (setq x empty))
1727                          (if head
1728                              (concat
1729                               (format (car org-export-table-header-tags) "col")
1730                               x
1731                               (cdr org-export-table-header-tags))
1732                            (concat (car org-export-table-data-tags) x
1733                                    (cdr org-export-table-data-tags))))
1734                        field-buffer "\n")
1735                       "</tr>\n"))
1736                     (setq head nil)
1737                     (setq field-buffer nil)))
1738               ;; Ignore this line
1739               (throw 'next-line t)))
1740         ;; Break the line into fields and store the fields
1741         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1742         (if field-buffer
1743             (setq field-buffer (mapcar
1744                                 (lambda (x)
1745                                   (concat x "<br/>" (pop fields)))
1746                                 field-buffer))
1747           (setq field-buffer fields))))
1748     (setq html (concat html "</table>\n"))
1749     html))
1750
1751 (defun org-format-table-table-html-using-table-generate-source (lines)
1752   "Format a table into html, using `table-generate-source' from table.el.
1753 This has the advantage that cell- or row-spanning is allowed.
1754 But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
1755   (require 'table)
1756   (with-current-buffer (get-buffer-create " org-tmp1 ")
1757     (erase-buffer)
1758     (insert (mapconcat 'identity lines "\n"))
1759     (goto-char (point-min))
1760     (if (not (re-search-forward "|[^+]" nil t))
1761         (error "Error processing table"))
1762     (table-recognize-table)
1763     (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1764     (table-generate-source 'html " org-tmp2 ")
1765     (set-buffer " org-tmp2 ")
1766     (buffer-substring (point-min) (point-max))))
1767
1768 (defun org-export-splice-style (style extra)
1769   "Splice EXTRA into STYLE, just before \"</style>\"."
1770   (if (and (stringp extra)
1771            (string-match "\\S-" extra)
1772            (string-match "</style>" style))
1773       (concat (substring style 0 (match-beginning 0))
1774               "\n" extra "\n"
1775               (substring style (match-beginning 0)))
1776     style))
1777
1778 (defun org-html-handle-time-stamps (s)
1779   "Format time stamps in string S, or remove them."
1780   (catch 'exit
1781     (let (r b)
1782       (while (string-match org-maybe-keyword-time-regexp s)
1783         (or b (setq b (substring s 0 (match-beginning 0))))
1784         (setq r (concat
1785                  r (substring s 0 (match-beginning 0))
1786                  " @<span class=\"timestamp-wrapper\">"
1787                  (if (match-end 1)
1788                      (format "@<span class=\"timestamp-kwd\">%s @</span>"
1789                              (match-string 1 s)))
1790                  (format " @<span class=\"timestamp\">%s@</span>"
1791                          (substring
1792                           (org-translate-time (match-string 3 s)) 1 -1))
1793                  "@</span>")
1794               s (substring s (match-end 0))))
1795       ;; Line break if line started and ended with time stamp stuff
1796       (if (not r)
1797           s
1798         (setq r (concat r s))
1799         (unless (string-match "\\S-" (concat b s))
1800           (setq r (concat r "@<br/>")))
1801         r))))
1802
1803 (defvar htmlize-buffer-places)  ; from htmlize.el
1804 (defun org-export-htmlize-region-for-paste (beg end)
1805   "Convert the region to HTML, using htmlize.el.
1806 This is much like `htmlize-region-for-paste', only that it uses
1807 the settings define in the org-... variables."
1808   (let* ((htmlize-output-type org-export-htmlize-output-type)
1809          (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
1810          (htmlbuf (htmlize-region beg end)))
1811     (unwind-protect
1812         (with-current-buffer htmlbuf
1813           (buffer-substring (plist-get htmlize-buffer-places 'content-start)
1814                             (plist-get htmlize-buffer-places 'content-end)))
1815       (kill-buffer htmlbuf))))
1816
1817 ;;;###autoload
1818 (defun org-export-htmlize-generate-css ()
1819   "Create the CSS for all font definitions in the current Emacs session.
1820 Use this to create face definitions in your CSS style file that can then
1821 be used by code snippets transformed by htmlize.
1822 This command just produces a buffer that contains class definitions for all
1823 faces used in the current Emacs session.  You can copy and paste the ones you
1824 need into your CSS file.
1825
1826 If you then set `org-export-htmlize-output-type' to `css', calls to
1827 the function `org-export-htmlize-region-for-paste' will produce code
1828 that uses these same face definitions."
1829   (interactive)
1830   (require 'htmlize)
1831   (and (get-buffer "*html*") (kill-buffer "*html*"))
1832   (with-temp-buffer
1833     (let ((fl (face-list))
1834           (htmlize-css-name-prefix "org-")
1835           (htmlize-output-type 'css)
1836           f i)
1837       (while (setq f (pop fl)
1838                    i (and f (face-attribute f :inherit)))
1839         (when (and (symbolp f) (or (not i) (not (listp i))))
1840           (insert (org-add-props (copy-sequence "1") nil 'face f))))
1841       (htmlize-region (point-min) (point-max))))
1842   (switch-to-buffer "*html*")
1843   (goto-char (point-min))
1844   (if (re-search-forward "<style" nil t)
1845       (delete-region (point-min) (match-beginning 0)))
1846   (if (re-search-forward "</style>" nil t)
1847       (delete-region (1+ (match-end 0)) (point-max)))
1848   (beginning-of-line 1)
1849   (if (looking-at " +") (replace-match ""))
1850   (goto-char (point-min)))
1851
1852 (defun org-html-protect (s)
1853   ;; convert & to &amp;, < to &lt; and > to &gt;
1854   (let ((start 0))
1855     (while (string-match "&" s start)
1856       (setq s (replace-match "&amp;" t t s)
1857             start (1+ (match-beginning 0))))
1858     (while (string-match "<" s)
1859       (setq s (replace-match "&lt;" t t s)))
1860     (while (string-match ">" s)
1861       (setq s (replace-match "&gt;" t t s)))
1862 ;    (while (string-match "\"" s)
1863 ;      (setq s (replace-match "&quot;" t t s)))
1864     )
1865   s)
1866
1867 (defun org-html-expand (string)
1868   "Prepare STRING for HTML export.  Applies all active conversions.
1869 If there are links in the string, don't modify these."
1870   (let* ((re (concat org-bracket-link-regexp "\\|"
1871                      (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
1872          m s l res)
1873     (while (setq m (string-match re string))
1874       (setq s (substring string 0 m)
1875             l (match-string 0 string)
1876             string (substring string (match-end 0)))
1877       (push (org-html-do-expand s) res)
1878       (push l res))
1879     (push (org-html-do-expand string) res)
1880     (apply 'concat (nreverse res))))
1881
1882 (defun org-html-do-expand (s)
1883   "Apply all active conversions to translate special ASCII to HTML."
1884   (setq s (org-html-protect s))
1885   (if org-export-html-expand
1886       (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1887         (setq s (replace-match "<\\1>" t nil s))))
1888   (if org-export-with-emphasize
1889       (setq s (org-export-html-convert-emphasize s)))
1890   (if org-export-with-special-strings
1891       (setq s (org-export-html-convert-special-strings s)))
1892   (if org-export-with-sub-superscripts
1893       (setq s (org-export-html-convert-sub-super s)))
1894   (if org-export-with-TeX-macros
1895       (let ((start 0) wd ass)
1896         (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
1897                                          s start))
1898           (if (get-text-property (match-beginning 0) 'org-protected s)
1899               (setq start (match-end 0))
1900             (setq wd (match-string 1 s))
1901             (if (setq ass (assoc wd org-html-entities))
1902                 (setq s (replace-match (or (cdr ass)
1903                                            (concat "&" (car ass) ";"))
1904                                        t t s))
1905               (setq start (+ start (length wd))))))))
1906   s)
1907
1908 (defun org-export-html-convert-special-strings (string)
1909   "Convert special characters in STRING to HTML."
1910   (let ((all org-export-html-special-string-regexps)
1911         e a re rpl start)
1912     (while (setq a (pop all))
1913       (setq re (car a) rpl (cdr a) start 0)
1914       (while (string-match re string start)
1915         (if (get-text-property (match-beginning 0) 'org-protected string)
1916             (setq start (match-end 0))
1917           (setq string (replace-match rpl t nil string)))))
1918     string))
1919
1920 (defun org-export-html-convert-sub-super (string)
1921   "Convert sub- and superscripts in STRING to HTML."
1922   (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1923     (while (string-match org-match-substring-regexp string s)
1924       (cond
1925        ((and requireb (match-end 8)) (setq s (match-end 2)))
1926        ((get-text-property  (match-beginning 2) 'org-protected string)
1927         (setq s (match-end 2)))
1928        (t
1929         (setq s (match-end 1)
1930               key (if (string= (match-string 2 string) "_") "sub" "sup")
1931               c (or (match-string 8 string)
1932                     (match-string 6 string)
1933                     (match-string 5 string))
1934               string (replace-match
1935                       (concat (match-string 1 string)
1936                               "<" key ">" c "</" key ">")
1937                       t t string)))))
1938     (while (string-match "\\\\\\([_^]\\)" string)
1939       (setq string (replace-match (match-string 1 string) t t string)))
1940     string))
1941
1942 (defun org-export-html-convert-emphasize (string)
1943   "Apply emphasis."
1944   (let ((s 0) rpl)
1945     (while (string-match org-emph-re string s)
1946       (if (not (equal
1947                 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1948                 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1949           (setq s (match-beginning 0)
1950                 rpl
1951                 (concat
1952                  (match-string 1 string)
1953                  (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
1954                  (match-string 4 string)
1955                  (nth 3 (assoc (match-string 3 string)
1956                                org-emphasis-alist))
1957                  (match-string 5 string))
1958                 string (replace-match rpl t t string)
1959                 s (+ s (- (length rpl) 2)))
1960         (setq s (1+ s))))
1961     string))
1962
1963 (defun org-open-par ()
1964   "Insert <p>, but first close previous paragraph if any."
1965   (org-close-par-maybe)
1966   (insert "\n<p>")
1967   (setq org-par-open t))
1968 (defun org-close-par-maybe ()
1969   "Close paragraph if there is one open."
1970   (when org-par-open
1971     (insert "</p>")
1972     (setq org-par-open nil)))
1973 (defun org-close-li (&optional type)
1974   "Close <li> if necessary."
1975   (org-close-par-maybe)
1976   (insert (if (equal type "d") "</dd>\n" "</li>\n")))
1977
1978 (defvar in-local-list)
1979 (defvar local-list-indent)
1980 (defvar local-list-type)
1981 (defun org-export-html-close-lists-maybe (line)
1982   (let ((ind (or (get-text-property 0 'original-indentation line)))
1983 ;                (and (string-match "\\S-" line)
1984 ;                     (org-get-indentation line))))
1985         didclose)
1986     (when ind
1987       (while (and in-local-list
1988                   (<= ind (car local-list-indent)))
1989         (setq didclose t)
1990         (org-close-li (car local-list-type))
1991         (insert (format "</%sl>\n" (car local-list-type)))
1992         (pop local-list-type) (pop local-list-indent)
1993         (setq in-local-list local-list-indent))
1994       (and didclose (org-open-par)))))
1995
1996 (defvar body-only) ; dynamically scoped into this.
1997 (defun org-html-level-start (level title umax with-toc head-count)
1998   "Insert a new level in HTML export.
1999 When TITLE is nil, just close all open levels."
2000   (org-close-par-maybe)
2001   (let* ((target (and title (org-get-text-property-any 0 'target title)))
2002          (extra-targets (assoc target org-export-target-aliases))
2003          (preferred (cdr (assoc target org-export-preferred-target-alist)))
2004          (remove (or preferred target))
2005          (l org-level-max)
2006          snumber href suffix)
2007     (setq extra-targets (remove remove extra-targets))
2008     (setq extra-targets
2009           (mapconcat (lambda (x)
2010                        (if (org-uuidgen-p x) (setq x (concat "ID-" x)))
2011                        (format "<a name=\"%s\" id=\"%s\"></a>"
2012                                x x))
2013                      extra-targets
2014                      ""))
2015     (while (>= l level)
2016       (if (aref org-levels-open (1- l))
2017           (progn
2018             (org-html-level-close l umax)
2019             (aset org-levels-open (1- l) nil)))
2020       (setq l (1- l)))
2021     (when title
2022       ;; If title is nil, this means this function is called to close
2023       ;; all levels, so the rest is done only if title is given
2024         (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
2025           (setq title (replace-match
2026                        (if org-export-with-tags
2027                            (save-match-data
2028                              (concat
2029                               "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
2030                               (mapconcat
2031                                (lambda (x)
2032                                  (format "<span class=\"%s\">%s</span>"
2033                                          (org-export-html-get-tag-class-name x)
2034                                          x))
2035                                (org-split-string (match-string 1 title) ":")
2036                                "&nbsp;")
2037                               "</span>"))
2038                          "")
2039                        t t title)))
2040       (if (> level umax)
2041           (progn
2042             (if (aref org-levels-open (1- level))
2043                 (progn
2044                   (org-close-li)
2045                   (if target
2046                       (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
2047                     (insert "<li>" title "<br/>\n")))
2048               (aset org-levels-open (1- level) t)
2049               (org-close-par-maybe)
2050               (if target
2051                   (insert (format "<ul>\n<li id=\"%s\">" target)
2052                           extra-targets title "<br/>\n")
2053                 (insert "<ul>\n<li>" title "<br/>\n"))))
2054         (aset org-levels-open (1- level) t)
2055         (setq snumber (org-section-number level))
2056         (setq level (+ level org-export-html-toplevel-hlevel -1))
2057         (if (and org-export-with-section-numbers (not body-only))
2058             (setq title (concat
2059                          (format "<span class=\"section-number-%d\">%s</span>"
2060                                  level snumber)
2061                          " " title)))
2062         (unless (= head-count 1) (insert "\n</div>\n"))
2063         (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist)))
2064         (setq suffix (or href snumber))
2065         (setq href (or href (concat "sec-" snumber)))
2066         (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
2067                         suffix level level href
2068                         extra-targets
2069                         title level level suffix))
2070         (org-open-par)))))
2071
2072 (defun org-export-html-get-tag-class-name (tag)
2073   "Turn tag into a valid class name.
2074 Replaces invalid characters with \"_\" and then prepends a prefix."
2075   (save-match-data
2076     (while (string-match "[^a-zA-Z0-9_]" tag)
2077       (setq tag (replace-match "_" t t tag))))
2078   (concat org-export-html-tag-class-prefix tag))
2079
2080 (defun org-export-html-get-todo-kwd-class-name (kwd)
2081   "Turn todo keyword into a valid class name.
2082 Replaces invalid characters with \"_\" and then prepends a prefix."
2083   (save-match-data
2084     (while (string-match "[^a-zA-Z0-9_]" kwd)
2085       (setq kwd (replace-match "_" t t kwd))))
2086   (concat org-export-html-todo-kwd-class-prefix kwd))
2087
2088 (defun org-html-level-close (level max-outline-level)
2089   "Terminate one level in HTML export."
2090   (if (<= level max-outline-level)
2091       (insert "</div>\n")
2092     (org-close-li)
2093     (insert "</ul>\n")))
2094
2095 (provide 'org-html)
2096
2097 ;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1
2098 ;;; org-html.el ends here