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