lisp/org-exp.el

   1 ;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar 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.25trans
  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)
  30 (require 'org-agenda)
  31 (eval-and-compile
  32   (require 'cl))
  33
  34 (declare-function org-export-latex-preprocess "org-export-latex" (parameters))
  35 (declare-function org-export-docbook-preprocess "org-docbook" (parameters))
  36 (declare-function org-agenda-skip "org-agenda" ())
  37 (declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
  38 (declare-function htmlize-region "ext:htmlize" (beg end))
  39 (declare-function org-id-find-id-file "org-id" (id))
  40 (defvar htmlize-buffer-places)  ; from htmlize.el
  41
  42 (defgroup org-export nil
  43   "Options for exporting org-listings."
  44   :tag "Org Export"
  45   :group 'org)
  46
  47 (defgroup org-export-general nil
  48   "General options for exporting Org-mode files."
  49   :tag "Org Export General"
  50   :group 'org-export)
  51
  52 ;; FIXME
  53 (defvar org-export-publishing-directory nil)
  54
  55 (defcustom org-export-run-in-background nil
  56   "Non-nil means export and publishing commands will run in background.
  57 This works by starting up a separate Emacs process visiting the same file
  58 and doing the export from there.
  59 Not all export commands are affected by this - only the ones which
  60 actually write to a file, and that do not depend on the buffer state.
  61
  62 If this option is nil, you can still get background export by calling
  63 `org-export' with a double prefix arg: `C-u C-u C-c C-e'.
  64
  65 If this option is t, the double prefix can be used to exceptionally
  66 force an export command into the current process."
  67   :group 'org-export-general
  68   :type 'boolean)
  69
  70
  71 (defcustom org-export-select-tags '("export")
  72   "Tags that select a tree for export.
  73 If any such tag is found in a buffer, all trees that do not carry one
  74 of these tags will be deleted before export.
  75 Inside trees that are selected like this, you can still deselect a
  76 subtree by tagging it with one of the `org-export-exclude-tags'."
  77   :group 'org-export-general
  78   :type '(repeat (string :tag "Tag")))
  79
  80 (defcustom org-export-exclude-tags '("noexport")
  81   "Tags that exclude a tree from export.
  82 All trees carrying any of these tags will be excluded from export.
  83 This is without condition, so even subtrees inside that carry one of the
  84 `org-export-select-tags' will be removed."
  85   :group 'org-export-general
  86   :type '(repeat (string :tag "Tag")))
  87
  88 (defcustom org-export-with-special-strings t
  89   "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
  90 When this option is turned on, these strings will be exported as:
  91
  92   Org   HTML       LaTeX
  93  -----+----------+--------
  94   \\-    &shy;      \\-
  95   --    &ndash;    --
  96   ---   &mdash;    ---
  97   ...   &hellip;   \ldots
  98
  99 This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
 100   :group 'org-export-translation
 101   :type 'boolean)
 102
 103 (defcustom org-export-language-setup
 104   '(("en" "Author"     "Date"  "Table of Contents" "Footnotes")
 105     ("ca"  "Autor"      "Data" "&Iacute;ndex" "Peus de p&agrave;gina")
 106     ("cs" "Autor"      "Datum" "Obsah" "Pozn\xe1mky pod carou")
 107     ("da" "Ophavsmand" "Dato"  "Indhold" "Fodnoter")
 108     ("de" "Autor"      "Datum" "Inhaltsverzeichnis" "Fu&szlig;noten")
 109     ("eo"  "A&#365;toro"      "Dato" "Enhavo" "Piednotoj")
 110     ("es" "Autor"      "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
 111     ("fi" "Tekij&auml;"     "P&auml;iv&auml;m&auml;&auml;r&auml;"   "Sis&auml;llysluettelo"  "Alaviitteet")
 112     ("fr" "Auteur"     "Date"  "Table des mati&egrave;res" "Notes de bas de page")
 113     ("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
 114     ("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
 115     ("it" "Autore"     "Data"  "Indice" "Note a pi&egrave; di pagina")
 116     ("nl" "Auteur"     "Datum" "Inhoudsopgave" "Voetnoten")
 117     ("no" "Forfatter"  "Dato"  "Innhold" "Fotnoter")
 118     ("nb" "Forfatter"  "Dato"  "Innhold" "Fotnoter")  ;; nb = Norsk (bokm.l)
 119     ("nn" "Forfattar"  "Dato"  "Innhald" "Fotnotar")  ;; nn = Norsk (nynorsk)
 120     ("pl" "Autor"      "Data" "Spis tre&sacute;ci"  "Przypis")
 121     ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter"))
 122   "Terms used in export text, translated to different languages.
 123 Use the variable `org-export-default-language' to set the language,
 124 or use the +OPTION lines for a per-file setting."
 125   :group 'org-export-general
 126   :type '(repeat
 127           (list
 128            (string :tag "HTML language tag")
 129            (string :tag "Author")
 130            (string :tag "Date")
 131            (string :tag "Table of Contents")
 132            (string :tag "Footnotes"))))
 133
 134 (defcustom org-export-default-language "en"
 135   "The default language of HTML export, as a string.
 136 This should have an association in `org-export-language-setup'."
 137   :group 'org-export-general
 138   :type 'string)
 139
 140 (defvar org-export-page-description ""
 141   "The page description, for the XHTML meta tag.
 142 This is best set with the #+DESCRIPTION line in a file, it does not make
 143 sense to set this globally.")
 144
 145 (defvar org-export-page-keywords ""
 146   "The page description, for the XHTML meta tag.
 147 This is best set with the #+KEYWORDS line in a file, it does not make
 148 sense to set this globally.")
 149
 150 (defcustom org-export-skip-text-before-1st-heading nil
 151   "Non-nil means, skip all text before the first headline when exporting.
 152 When nil, that text is exported as well."
 153   :group 'org-export-general
 154   :type 'boolean)
 155
 156 (defcustom org-export-headline-levels 3
 157   "The last level which is still exported as a headline.
 158 Inferior levels will produce itemize lists when exported.
 159 Note that a numeric prefix argument to an exporter function overrides
 160 this setting.
 161
 162 This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
 163   :group 'org-export-general
 164   :type 'integer)
 165
 166 (defcustom org-export-with-section-numbers t
 167   "Non-nil means, add section numbers to headlines when exporting.
 168
 169 This option can also be set with the +OPTIONS line, e.g. \"num:t\"."
 170   :group 'org-export-general
 171   :type 'boolean)
 172
 173 (defcustom org-export-section-number-format '((("1" ".")) . "")
 174   "Format of section numbers for export.
 175 The variable has two components.
 176 1. A list of lists, each indicating a counter type and a separator.
 177    The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"a\".
 178    It causes causes numeric, alphabetic, or roman counters, respectively.
 179    The separator is only used if another counter for a subsection is being
 180    added.
 181    If there are more numbered section levels than entries in this lists,
 182    then the last entry will be reused.
 183 2. A terminator string that will be added after the entire
 184    section number."
 185   :group 'org-export-general
 186   :type '(cons
 187           (repeat
 188            (list
 189             (string :tag "Counter Type")
 190             (string :tag "Separator   ")))
 191           (string :tag "Terminator")))
 192
 193 (defcustom org-export-with-toc t
 194   "Non-nil means, create a table of contents in exported files.
 195 The TOC contains headlines with levels up to`org-export-headline-levels'.
 196 When an integer, include levels up to N in the toc, this may then be
 197 different from `org-export-headline-levels', but it will not be allowed
 198 to be larger than the number of headline levels.
 199 When nil, no table of contents is made.
 200
 201 Headlines which contain any TODO items will be marked with \"(*)\" in
 202 ASCII export, and with red color in HTML output, if the option
 203 `org-export-mark-todo-in-toc' is set.
 204
 205 In HTML output, the TOC will be clickable.
 206
 207 This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"
 208 or \"toc:3\"."
 209   :group 'org-export-general
 210   :type '(choice
 211           (const :tag "No Table of Contents" nil)
 212           (const :tag "Full Table of Contents" t)
 213           (integer :tag "TOC to level")))
 214
 215 (defcustom org-export-mark-todo-in-toc nil
 216   "Non-nil means, mark TOC lines that contain any open TODO items."
 217   :group 'org-export-general
 218   :type 'boolean)
 219
 220 (defcustom org-export-with-todo-keywords t
 221   "Non-nil means, include TODO keywords in export.
 222 When nil, remove all these keywords from the export."
 223   :group 'org-export-general
 224   :type 'boolean)
 225
 226 (defcustom org-export-with-priority nil
 227   "Non-nil means, include priority cookies in export.
 228 When nil, remove priority cookies for export."
 229   :group 'org-export-general
 230   :type 'boolean)
 231
 232 (defcustom org-export-preserve-breaks nil
 233   "Non-nil means, preserve all line breaks when exporting.
 234 Normally, in HTML output paragraphs will be reformatted.  In ASCII
 235 export, line breaks will always be preserved, regardless of this variable.
 236
 237 This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
 238   :group 'org-export-general
 239   :type 'boolean)
 240
 241 (defcustom org-export-with-archived-trees 'headline
 242   "Whether subtrees with the ARCHIVE tag should be exported.
 243 This can have three different values
 244 nil       Do not export, pretend this tree is not present
 245 t         Do export the entire tree
 246 headline  Only export the headline, but skip the tree below it."
 247   :group 'org-export-general
 248   :group 'org-archive
 249   :type '(choice
 250           (const :tag "not at all" nil)
 251           (const :tag "headline only" 'headline)
 252           (const :tag "entirely" t)))
 253
 254 (defcustom org-export-author-info t
 255   "Non-nil means, insert author name and email into the exported file.
 256
 257 This option can also be set with the +OPTIONS line,
 258 e.g. \"author-info:nil\"."
 259   :group 'org-export-general
 260   :type 'boolean)
 261
 262 (defcustom org-export-creator-info t
 263   "Non-nil means, the postamble should contain a creator sentence.
 264 This sentence is \"HTML generated by org-mode XX in emacs XXX\"."
 265   :group 'org-export-general
 266   :type 'boolean)
 267
 268 (defcustom org-export-time-stamp-file t
 269   "Non-nil means, insert a time stamp into the exported file.
 270 The time stamp shows when the file was created.
 271
 272 This option can also be set with the +OPTIONS line,
 273 e.g. \"timestamp:nil\"."
 274   :group 'org-export-general
 275   :type 'boolean)
 276
 277 (defcustom org-export-with-timestamps t
 278   "If nil, do not export time stamps and associated keywords."
 279   :group 'org-export-general
 280   :type 'boolean)
 281
 282 (defcustom org-export-remove-timestamps-from-toc t
 283   "If nil, remove timestamps from the table of contents entries."
 284   :group 'org-export-general
 285   :type 'boolean)
 286
 287 (defcustom org-export-with-tags 'not-in-toc
 288   "If nil, do not export tags, just remove them from headlines.
 289 If this is the symbol `not-in-toc', tags will be removed from table of
 290 contents entries, but still be shown in the headlines of the document.
 291
 292 This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
 293   :group 'org-export-general
 294   :type '(choice
 295           (const :tag "Off" nil)
 296           (const :tag "Not in TOC" not-in-toc)
 297           (const :tag "On" t)))
 298
 299 (defcustom org-export-with-drawers nil
 300   "Non-nil means, export with drawers like the property drawer.
 301 When t, all drawers are exported.  This may also be a list of
 302 drawer names to export."
 303   :group 'org-export-general
 304   :type '(choice
 305           (const :tag "All drawers" t)
 306           (const :tag "None" nil)
 307           (repeat :tag "Selected drawers"
 308                   (string :tag "Drawer name"))))
 309
 310 (defvar org-export-preprocess-hook nil
 311   "Hook for preprocessing an export buffer.
 312 Pretty much the first thing when exporting is running this hook.")
 313
 314 (defvar org-export-preprocess-after-include-files-hook nil
 315   "Hook for preprocessing an export buffer.
 316 This is run after the contents of included files have been inserted.")
 317
 318 (defvar org-export-preprocess-after-tree-selection-hook nil
 319   "Hook for preprocessing an export buffer.
 320 This is run after selection of trees to be exported has happened.
 321 This selection includes tags-based selection, as well as removal
 322 of commented and archived trees.")
 323
 324 (defvar org-export-preprocess-before-backend-specifics-hook nil
 325   "Hook run before backend-specific functions are called during preprocessing.")
 326
 327 (defvar org-export-preprocess-final-hook nil
 328   "Hook for preprocessing an export buffer.
 329 This is run as the last thing in the preprocessing buffer, just before
 330 returning the buffer string to the backend.")
 331
 332 (defgroup org-export-translation nil
 333   "Options for translating special ascii sequences for the export backends."
 334   :tag "Org Export Translation"
 335   :group 'org-export)
 336
 337 (defcustom org-export-with-emphasize t
 338   "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text.
 339 If the export target supports emphasizing text, the word will be
 340 typeset in bold, italic, or underlined, respectively.  Works only for
 341 single words, but you can say: I *really* *mean* *this*.
 342 Not all export backends support this.
 343
 344 This option can also be set with the +OPTIONS line, e.g. \"*:nil\"."
 345   :group 'org-export-translation
 346   :type 'boolean)
 347
 348 (defcustom org-export-with-footnotes t
 349   "If nil, export [1] as a footnote marker.
 350 Lines starting with [1] will be formatted as footnotes.
 351
 352 This option can also be set with the +OPTIONS line, e.g. \"f:nil\"."
 353   :group 'org-export-translation
 354   :type 'boolean)
 355
 356 (defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
 357 <h2 class=\"footnotes\">%s: </h2>
 358 <div id=\"text-footnotes\">
 359 %s
 360 </div>
 361 </div>"
 362   "Format for the footnotes section.
 363 Should contain a two instances of %s.  The first will be replaced with the
 364 language-specific word for \"Footnotes\", the second one will be replaced
 365 by the footnotes themselves."
 366   :group 'org-export-html
 367   :type 'string)
 368
 369 (defcustom org-export-with-sub-superscripts t
 370   "Non-nil means, interpret \"_\" and \"^\" for export.
 371 When this option is turned on, you can use TeX-like syntax for sub- and
 372 superscripts.  Several characters after \"_\" or \"^\" will be
 373 considered as a single item - so grouping with {} is normally not
 374 needed.  For example, the following things will be parsed as single
 375 sub- or superscripts.
 376
 377  10^24   or   10^tau     several digits will be considered 1 item.
 378  10^-12  or   10^-tau    a leading sign with digits or a word
 379  x^2-y^3                 will be read as x^2 - y^3, because items are
 380                          terminated by almost any nonword/nondigit char.
 381  x_{i^2} or   x^(2-i)    braces or parenthesis do grouping.
 382
 383 Still, ambiguity is possible - so when in doubt use {} to enclose the
 384 sub/superscript.  If you set this variable to the symbol `{}',
 385 the braces are *required* in order to trigger interpretations as
 386 sub/superscript.  This can be helpful in documents that need \"_\"
 387 frequently in plain text.
 388
 389 Not all export backends support this, but HTML does.
 390
 391 This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
 392   :group 'org-export-translation
 393   :type '(choice
 394           (const :tag "Always interpret" t)
 395           (const :tag "Only with braces" {})
 396           (const :tag "Never interpret" nil)))
 397
 398 (defcustom org-export-with-TeX-macros t
 399   "Non-nil means, interpret simple TeX-like macros when exporting.
 400 For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
 401 Not only real TeX macros will work here, but the standard HTML entities
 402 for math can be used as macro names as well.  For a list of supported
 403 names in HTML export, see the constant `org-html-entities'.
 404 Not all export backends support this.
 405
 406 This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
 407   :group 'org-export-translation
 408   :group 'org-export-latex
 409   :type 'boolean)
 410
 411 (defcustom org-export-with-LaTeX-fragments nil
 412   "Non-nil means, convert LaTeX fragments to images when exporting to HTML.
 413 When set, the exporter will find LaTeX environments if the \\begin line is
 414 the first non-white thing on a line.  It will also find the math delimiters
 415 like $a=b$ and \\( a=b \\) for inline math,  $$a=b$$ and \\[ a=b \\] for
 416 display math.
 417
 418 This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"."
 419   :group 'org-export-translation
 420   :group 'org-export-latex
 421   :type 'boolean)
 422
 423 (defcustom org-export-with-fixed-width t
 424   "Non-nil means, lines starting with \":\" will be in fixed width font.
 425 This can be used to have pre-formatted text, fragments of code etc.  For
 426 example:
 427   : ;; Some Lisp examples
 428   : (while (defc cnt)
 429   :   (ding))
 430 will be looking just like this in also HTML.  See also the QUOTE keyword.
 431 Not all export backends support this.
 432
 433 This option can also be set with the +OPTIONS line, e.g. \"::nil\"."
 434   :group 'org-export-translation
 435   :type 'boolean)
 436
 437 (defcustom org-match-sexp-depth 3
 438   "Number of stacked braces for sub/superscript matching.
 439 This has to be set before loading org.el to be effective."
 440   :group 'org-export-translation
 441   :type 'integer)
 442
 443 (defgroup org-export-tables nil
 444   "Options for exporting tables in Org-mode."
 445   :tag "Org Export Tables"
 446   :group 'org-export)
 447
 448 (defcustom org-export-with-tables t
 449   "If non-nil, lines starting with \"|\" define a table.
 450 For example:
 451
 452   | Name        | Address  | Birthday  |
 453   |-------------+----------+-----------|
 454   | Arthur Dent | England  | 29.2.2100 |
 455
 456 Not all export backends support this.
 457
 458 This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
 459   :group 'org-export-tables
 460   :type 'boolean)
 461
 462 (defcustom org-export-highlight-first-table-line t
 463   "Non-nil means, highlight the first table line.
 464 In HTML export, this means use <th> instead of <td>.
 465 In tables created with table.el, this applies to the first table line.
 466 In Org-mode tables, all lines before the first horizontal separator
 467 line will be formatted with <th> tags."
 468   :group 'org-export-tables
 469   :type 'boolean)
 470
 471 (defcustom org-export-table-remove-special-lines t
 472   "Remove special lines and marking characters in calculating tables.
 473 This removes the special marking character column from tables that are set
 474 up for spreadsheet calculations.  It also removes the entire lines
 475 marked with `!', `_', or `^'.  The lines with `$' are kept, because
 476 the values of constants may be useful to have."
 477   :group 'org-export-tables
 478   :type 'boolean)
 479
 480 (defcustom org-export-prefer-native-exporter-for-tables nil
 481   "Non-nil means, always export tables created with table.el natively.
 482 Natively means, use the HTML code generator in table.el.
 483 When nil, Org-mode's own HTML generator is used when possible (i.e. if
 484 the table does not use row- or column-spanning).  This has the
 485 advantage, that the automatic HTML conversions for math symbols and
 486 sub/superscripts can be applied.  Org-mode's HTML generator is also
 487 much faster."
 488   :group 'org-export-tables
 489   :type 'boolean)
 490
 491
 492 (defgroup org-export-xml nil
 493   "Options specific for XML export of Org-mode files."
 494   :tag "Org Export XML"
 495   :group 'org-export)
 496
 497 (defgroup org-export-html nil
 498   "Options specific for HTML export of Org-mode files."
 499   :tag "Org Export HTML"
 500   :group 'org-export)
 501
 502 (defcustom org-export-html-coding-system nil
 503   "Coding system for HTML export, defaults to buffer-file-coding-system."
 504   :group 'org-export-html
 505   :type 'coding-system)
 506
 507 (defcustom org-export-html-extension "html"
 508   "The extension for exported HTML files."
 509   :group 'org-export-html
 510   :type 'string)
 511
 512 (defcustom org-export-html-link-up ""
 513   "Where should the \"UP\" link of exported HTML pages lead?"
 514   :group 'org-export-html
 515   :type '(string :tag "File or URL"))
 516
 517 (defcustom org-export-html-link-home ""
 518   "Where should the \"HOME\" link of exported HTML pages lead?"
 519   :group 'org-export-html
 520   :type '(string :tag "File or URL"))
 521
 522 (defcustom org-export-html-style-include-scripts t
 523   "Non-nil means, include the javascript snippets in exported HTML files.
 524 The actual script is defined in `org-export-html-scripts' and should
 525 not be modified."
 526   :group 'org-export-html
 527   :type 'boolean)
 528
 529 (defconst org-export-html-scripts
 530 "<script type=\"text/javascript\">
 531 <!--/*--><![CDATA[/*><!--*/
 532  function CodeHighlightOn(elem, id)
 533  {
 534    var target = document.getElementById(id);
 535    if(null != target) {
 536      elem.cacheClassElem = elem.className;
 537      elem.cacheClassTarget = target.className;
 538      target.className = \"code-highlighted\";
 539      elem.className   = \"code-highlighted\";
 540    }
 541  }
 542  function CodeHighlightOff(elem, id)
 543  {
 544    var target = document.getElementById(id);
 545    if(elem.cacheClassElem)
 546      elem.className = elem.cacheClassElem;
 547    if(elem.cacheClassTarget)
 548      target.className = elem.cacheClassTarget;
 549  }
 550 /*]]>*///-->
 551 </script>"
 552 "Basic javascript that is needed by HTML files produced by Org-mode.")
 553
 554 (defconst org-export-html-style-default
 555 "<style type=\"text/css\">
 556  <!--/*--><![CDATA[/*><!--*/
 557   html { font-family: Times, serif; font-size: 12pt; }
 558   .title  { text-align: center; }
 559   .todo   { color: red; }
 560   .done   { color: green; }
 561   .tag    { background-color: #add8e6; font-weight:normal }
 562   .target { }
 563   .timestamp { color: #bebebe; }
 564   .timestamp-kwd { color: #5f9ea0; }
 565   p.verse { margin-left: 3% }
 566   pre {
 567         border: 1pt solid #AEBDCC;
 568         background-color: #F3F5F7;
 569         padding: 5pt;
 570         font-family: courier, monospace;
 571         font-size: 90%;
 572         overflow:auto;
 573   }
 574   table { border-collapse: collapse; }
 575   td, th { vertical-align: top; }
 576   dt { font-weight: bold; }
 577   div.figure { padding: 0.5em; }
 578   div.figure p { text-align: center; }
 579   .linenr { font-size:smaller }
 580   .code-highlighted {background-color:#ffff00;}
 581   .org-info-js_info-navigation { border-style:none; }
 582   #org-info-js_console-label { font-size:10px; font-weight:bold;
 583                                white-space:nowrap; }
 584   .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
 585                                  font-weight:bold; }
 586   /*]]>*///-->
 587 </style>"
 588   "The default style specification for exported HTML files.
 589 Please use the variables `org-export-html-style' and
 590 `org-export-html-style-extra' to add to this style.  If you wish to not
 591 have the default style included, customize the variable
 592 `org-export-html-style-include-default'.")
 593
 594 (defcustom org-export-html-style-include-default t
 595   "Non-nil means, include the default style in exported HTML files.
 596 The actual style is defined in `org-export-html-style-default' and should
 597 not be modified.  Use the variables `org-export-html-style' to add
 598 your own style information."
 599   :group 'org-export-html
 600   :type 'boolean)
 601 ;;;###autoload
 602 (put 'org-export-html-style 'safe-local-variable 'booleanp)
 603
 604 (defcustom org-export-html-style ""
 605   "Org-wide style definitions for exported HTML files.
 606
 607 This variable needs to contain the full HTML structure to provide a style,
 608 including the surrounding HTML tags.  If you set the value of this variable,
 609 you should consider to include definitions for the following classes:
 610  title, todo, done, timestamp, timestamp-kwd, tag, target.
 611
 612 For example, a valid value would be:
 613
 614    <style type=\"text/css\">
 615     <![CDATA[
 616        p { font-weight: normal; color: gray; }
 617        h1 { color: black; }
 618       .title { text-align: center; }
 619       .todo, .timestamp-kwd { color: red; }
 620       .done { color: green; }
 621     ]]>
 622    </style>
 623
 624 If you'd like to refer to en external style file, use something like
 625
 626    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
 627
 628 As the value of this option simply gets inserted into the HTML <head> header,
 629 you can \"misuse\" it to add arbitrary text to the header.
 630 See also the variable `org-export-html-style-extra'."
 631   :group 'org-export-html
 632   :type 'string)
 633 ;;;###autoload
 634 (put 'org-export-html-style 'safe-local-variable 'stringp)
 635
 636 (defcustom org-export-html-style-extra ""
 637   "Additional style information for HTML export.
 638 The value of this variable is inserted into the HTML buffer right after
 639 the value of `org-export-html-style'.  Use this variable for per-file
 640 settings of style information, and do not forget to surround the style
 641 settings with <style>...</style> tags."
 642   :group 'org-export-html
 643   :type 'string)
 644 ;;;###autoload
 645 (put 'org-export-html-style-extra 'safe-local-variable 'stringp)
 646
 647 (defcustom org-export-html-tag-class-prefix ""
 648   "Prefix to clas names for TODO keywords.
 649 Each tag gets a class given by the tag itself, with this prefix.
 650 The default prefix is empty because it is nice to just use the keyword
 651 as a class name.  But if you get into conflicts with other, existing
 652 CSS classes, then this prefic can be very useful."
 653   :group 'org-export-html
 654   :type 'string)
 655
 656 (defcustom org-export-html-todo-kwd-class-prefix ""
 657   "Prefix to clas names for TODO keywords.
 658 Each TODO keyword gets a class given by the keyword itself, with this prefix.
 659 The default prefix is empty because it is nice to just use the keyword
 660 as a class name.  But if you get into conflicts with other, existing
 661 CSS classes, then this prefic can be very useful."
 662   :group 'org-export-html
 663   :type 'string)
 664
 665 (defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
 666   "Format for typesetting the document title in HTML export."
 667   :group 'org-export-html
 668   :type 'string)
 669
 670 (defcustom org-export-html-toplevel-hlevel 2
 671   "The <H> level for level 1 headings in HTML export.
 672 This is also important for the classes that will be wrapped around headlines
 673 and outline structure.  If this variable is 1, the top-level headlines will
 674 be <h1>, and the corresponding classes will be outline-1, section-number-1,
 675 and outline-text-1.  If this is 2, all of these will get a 2 instead.
 676 The default for this variable is 2, because we use <h1> for formatting the
 677 document title."
 678   :group 'org-export-html
 679   :type 'string)
 680
 681 (defcustom org-export-html-link-org-files-as-html t
 682   "Non-nil means, make file links to `file.org' point to `file.html'.
 683 When org-mode is exporting an org-mode file to HTML, links to
 684 non-html files are directly put into a href tag in HTML.
 685 However, links to other Org-mode files (recognized by the
 686 extension `.org.) should become links to the corresponding html
 687 file, assuming that the linked org-mode file will also be
 688 converted to HTML.
 689 When nil, the links still point to the plain `.org' file."
 690   :group 'org-export-html
 691   :type 'boolean)
 692
 693 (defcustom org-export-html-inline-images 'maybe
 694   "Non-nil means, inline images into exported HTML pages.
 695 This is done using an <img> tag.  When nil, an anchor with href is used to
 696 link to the image.  If this option is `maybe', then images in links with
 697 an empty description will be inlined, while images with a description will
 698 be linked only."
 699   :group 'org-export-html
 700   :type '(choice (const :tag "Never" nil)
 701                  (const :tag "Always" t)
 702                  (const :tag "When there is no description" maybe)))
 703
 704 (defcustom org-export-html-inline-image-extensions
 705   '("png" "jpeg" "jpg" "gif")
 706   "Extensions of image files that can be inlined into HTML."
 707   :group 'org-export-html
 708   :type '(repeat (string :tag "Extension")))
 709
 710 ;; FIXME: rename
 711 (defcustom org-export-html-expand t
 712   "Non-nil means, for HTML export, treat @<...> as HTML tag.
 713 When nil, these tags will be exported as plain text and therefore
 714 not be interpreted by a browser.
 715
 716 This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
 717   :group 'org-export-html
 718   :type 'boolean)
 719
 720 (defcustom org-export-html-table-tag
 721   "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
 722   "The HTML tag that is used to start a table.
 723 This must be a <table> tag, but you may change the options like
 724 borders and spacing."
 725   :group 'org-export-html
 726   :type 'string)
 727
 728 (defcustom org-export-table-header-tags '("<th>" . "</th>")
 729   "The opening tag for table header fields.
 730 This is customizable so that alignment options can be specified."
 731   :group 'org-export-tables
 732   :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
 733
 734 (defcustom org-export-table-data-tags '("<td>" . "</td>")
 735   "The opening tag for table data fields.
 736 This is customizable so that alignment options can be specified."
 737   :group 'org-export-tables
 738   :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
 739
 740 (defcustom org-export-html-validation-link nil
 741   "Non-nil means, add validationlink to postamble of HTML exported files."
 742   :group 'org-export-html
 743   :type '(choice
 744           (const :tag "Nothing" nil)
 745           (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>")
 746           (string :tag "Specify full HTML")))
 747
 748
 749 (defcustom org-export-html-with-timestamp nil
 750   "If non-nil, write `org-export-html-html-helper-timestamp'
 751 into the exported HTML text.  Otherwise, the buffer will just be saved
 752 to a file."
 753   :group 'org-export-html
 754   :type 'boolean)
 755
 756 (defcustom org-export-html-html-helper-timestamp
 757   "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
 758   "The HTML tag used as timestamp delimiter for HTML-helper-mode."
 759   :group 'org-export-html
 760   :type 'string)
 761
 762 (defgroup org-export-htmlize nil
 763   "Options for processing examples with htmlize.el."
 764   :tag "Org Export Htmlize"
 765   :group 'org-export-html)
 766
 767 (defcustom org-export-htmlize-output-type 'inline-css
 768   "Output type to be used by htmlize when formatting code snippets.
 769 We use as default  `inline-css', in order to make the resulting
 770 HTML self-containing.
 771 However, this will fail when using Emacs in batch mode for export, because
 772 then no rich font definitions are in place.  It will also not be good if
 773 people with different Emacs setup contribute HTML files to a website,
 774 because the fonts will represent the individual setups.  In these cases,
 775 it is much better to let Org/Htmlize assign classes only, and to use
 776 a style file to define the look of these classes.
 777 To get a start for your css file, start Emacs session nnd make sure that
 778 all the faces you are interested in are defined, for example by loading files
 779 in all modes you want.  Then, use the command
 780 \\[org-export-htmlize-generate-css] to extract class definitions."
 781   :group 'org-export-htmlize
 782   :type '(choice (const css) (const inline-css)))
 783
 784 (defcustom org-export-htmlize-css-font-prefix "org-"
 785   "The prefix for CSS class names for htmlize font specifications."
 786   :group 'org-export-htmlize
 787   :type 'string)
 788
 789 (defgroup org-export-icalendar nil
 790   "Options specific for iCalendar export of Org-mode files."
 791   :tag "Org Export iCalendar"
 792   :group 'org-export)
 793
 794 (defcustom org-combined-agenda-icalendar-file "~/org.ics"
 795   "The file name for the iCalendar file covering all agenda files.
 796 This file is created with the command \\[org-export-icalendar-all-agenda-files].
 797 The file name should be absolute, the file will be overwritten without warning."
 798   :group 'org-export-icalendar
 799   :type 'file)
 800
 801 (defcustom org-icalendar-combined-name "OrgMode"
 802   "Calendar name for the combined iCalendar representing all agenda files."
 803   :group 'org-export-icalendar
 804   :type 'string)
 805
 806 (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
 807   "Contexts where iCalendar export should use a deadline time stamp.
 808 This is a list with several symbols in it.  Valid symbol are:
 809
 810 event-if-todo       Deadlines in TODO entries become calendar events.
 811 event-if-not-todo   Deadlines in non-TODO entries become calendar events.
 812 todo-due            Use deadlines in TODO entries as due-dates"
 813   :group 'org-export-icalendar
 814   :type '(set :greedy t
 815               (const :tag "Deadlines in non-TODO entries become events"
 816                      event-if-not-todo)
 817               (const :tag "Deadline in TODO entries become events"
 818                      event-if-todo)
 819               (const :tag "Deadlines in TODO entries become due-dates"
 820                      todo-due)))
 821
 822 (defcustom org-icalendar-use-scheduled '(todo-start)
 823   "Contexts where iCalendar export should use a scheduling time stamp.
 824 This is a list with several symbols in it.  Valid symbol are:
 825
 826 event-if-todo       Scheduling time stamps in TODO entries become an event.
 827 event-if-not-todo   Scheduling time stamps in non-TODO entries become an event.
 828 todo-start          Scheduling time stamps in TODO entries become start date.
 829                     Some calendar applications show TODO entries only after
 830                     that date."
 831   :group 'org-export-icalendar
 832   :type '(set :greedy t
 833               (const :tag
 834                      "SCHEDULED timestamps in non-TODO entries become events"
 835                      event-if-not-todo)
 836               (const :tag "SCHEDULED timestamps in TODO entries become events"
 837                      event-if-todo)
 838               (const :tag "SCHEDULED in TODO entries become start date"
 839                      todo-start)))
 840
 841 (defcustom org-icalendar-categories '(local-tags category)
 842   "Items that should be entered into the categories field.
 843 This is a list of symbols, the following are valid:
 844
 845 category    The Org-mode category of the current file or tree
 846 todo-state  The todo state, if any
 847 local-tags  The tags, defined in the current line
 848 all-tags    All tags, including inherited ones."
 849   :group 'org-export-icalendar
 850   :type '(repeat
 851           (choice
 852            (const :tag "The file or tree category" category)
 853            (const :tag "The TODO state" todo-state)
 854            (const :tag "Tags defined in current line" local-tags)
 855            (const :tag "All tags, including inherited ones" all-tags))))
 856
 857 (defcustom org-icalendar-include-todo nil
 858   "Non-nil means, export to iCalendar files should also cover TODO items."
 859   :group 'org-export-icalendar
 860   :type '(choice
 861           (const :tag "None" nil)
 862           (const :tag "Unfinished" t)
 863           (const :tag "All" all)))
 864
 865 (defcustom org-icalendar-include-sexps t
 866   "Non-nil means, export to iCalendar files should also cover sexp entries.
 867 These are entries like in the diary, but directly in an Org-mode file."
 868   :group 'org-export-icalendar
 869   :type 'boolean)
 870
 871 (defcustom org-icalendar-include-body 100
 872   "Amount of text below headline to be included in iCalendar export.
 873 This is a number of characters that should maximally be included.
 874 Properties, scheduling and clocking lines will always be removed.
 875 The text will be inserted into the DESCRIPTION field."
 876   :group 'org-export-icalendar
 877   :type '(choice
 878           (const :tag "Nothing" nil)
 879           (const :tag "Everything" t)
 880           (integer :tag "Max characters")))
 881
 882 (defcustom org-icalendar-store-UID nil
 883   "Non-nil means, store any created UIDs in properties.
 884 The iCalendar standard requires that all entries have a unique identifier.
 885 Org will create these identifiers as needed.  When this variable is non-nil,
 886 the created UIDs will be stored in the ID property of the entry.  Then the
 887 next time this entry is exported, it will be exported with the same UID,
 888 superceding the previous form of it.  This is essential for
 889 synchronization services.
 890 This variable is not turned on by default because we want to avoid creating
 891 a property drawer in every entry if people are only playing with this feature,
 892 or if they are only using it locally."
 893   :group 'org-export-icalendar
 894   :type 'boolean)
 895
 896 ;;;; Exporting
 897
 898 ;;; Variables, constants, and parameter plists
 899
 900 (defconst org-level-max 20)
 901
 902 (defvar org-export-html-preamble nil
 903   "Preamble, to be inserted just before <body>.  Set by publishing functions.")
 904 (defvar org-export-html-postamble nil
 905   "Preamble, to be inserted just after </body>.  Set by publishing functions.")
 906 (defvar org-export-html-auto-preamble t
 907   "Should default preamble be inserted?  Set by publishing functions.")
 908 (defvar org-export-html-auto-postamble t
 909   "Should default postamble be inserted?  Set by publishing functions.")
 910 (defvar org-current-export-file nil) ; dynamically scoped parameter
 911 (defvar org-current-export-dir nil) ; dynamically scoped parameter
 912 (defvar org-export-opt-plist nil
 913   "Contains the current option plist.")
 914 (defvar org-last-level nil) ; dynamically scoped variable
 915 (defvar org-min-level nil) ; dynamically scoped variable
 916 (defvar org-levels-open nil) ; dynamically scoped parameter
 917
 918 (defconst org-export-plist-vars
 919   '((:link-up                 nil         org-export-html-link-up)
 920     (:link-home               nil         org-export-html-link-home)
 921     (:language                nil         org-export-default-language)
 922     (:keywords                nil         org-export-page-keywords)
 923     (:description             nil         org-export-page-description)
 924     (:customtime              nil         org-display-custom-times)
 925     (:headline-levels         "H"         org-export-headline-levels)
 926     (:section-numbers         "num"       org-export-with-section-numbers)
 927     (:section-number-format   nil         org-export-section-number-format)
 928     (:table-of-contents       "toc"       org-export-with-toc)
 929     (:preserve-breaks         "\\n"       org-export-preserve-breaks)
 930     (:archived-trees          nil         org-export-with-archived-trees)
 931     (:emphasize               "*"         org-export-with-emphasize)
 932     (:sub-superscript         "^"         org-export-with-sub-superscripts)
 933     (:special-strings         "-"         org-export-with-special-strings)
 934     (:footnotes               "f"         org-export-with-footnotes)
 935     (:drawers                 "d"         org-export-with-drawers)
 936     (:tags                    "tags"      org-export-with-tags)
 937     (:todo-keywords           "todo"      org-export-with-todo-keywords)
 938     (:priority                "pri"       org-export-with-priority)
 939     (:TeX-macros              "TeX"       org-export-with-TeX-macros)
 940     (:LaTeX-fragments         "LaTeX"     org-export-with-LaTeX-fragments)
 941     (:skip-before-1st-heading "skip"      org-export-skip-text-before-1st-heading)
 942     (:fixed-width             ":"         org-export-with-fixed-width)
 943     (:timestamps              "<"         org-export-with-timestamps)
 944     (:author-info             "author"    org-export-author-info)
 945     (:creator-info            "creator"   org-export-creator-info)
 946     (:time-stamp-file         "timestamp" org-export-time-stamp-file)
 947     (:tables                  "|"         org-export-with-tables)
 948     (:table-auto-headline     nil         org-export-highlight-first-table-line)
 949     (:style-include-default   nil         org-export-html-style-include-default)
 950     (:style-include-scripts   nil         org-export-html-style-include-scripts)
 951     (:style                   nil         org-export-html-style)
 952     (:style-extra             nil         org-export-html-style-extra)
 953     (:agenda-style            nil         org-agenda-export-html-style)
 954     (:convert-org-links       nil         org-export-html-link-org-files-as-html)
 955     (:inline-images           nil         org-export-html-inline-images)
 956     (:html-extension          nil         org-export-html-extension)
 957     (:html-table-tag          nil         org-export-html-table-tag)
 958     (:expand-quoted-html      "@"         org-export-html-expand)
 959     (:timestamp               nil         org-export-html-with-timestamp)
 960     (:publishing-directory    nil         org-export-publishing-directory)
 961     (:preamble                nil         org-export-html-preamble)
 962     (:postamble               nil         org-export-html-postamble)
 963     (:auto-preamble           nil         org-export-html-auto-preamble)
 964     (:auto-postamble          nil         org-export-html-auto-postamble)
 965     (:author                  nil         user-full-name)
 966     (:email                   nil         user-mail-address)
 967     (:select-tags             nil         org-export-select-tags)
 968     (:exclude-tags            nil         org-export-exclude-tags))
 969   "List of properties that represent export/publishing variables.
 970 Each element is a list of 3 items:
 971 1. The property that is used internally, and also for org-publish-project-alist
 972 2. The string that can be used in the OPTION lines to set this option,
 973    or nil if this option cannot be changed in this way
 974 3. The customization variable that sets the default for this option."
 975
 976 )
 977
 978 (defun org-default-export-plist ()
 979   "Return the property list with default settings for the export variables."
 980   (let ((l org-export-plist-vars) rtn e)
 981     (while (setq e (pop l))
 982       (setq rtn (cons (car e) (cons (symbol-value (nth 2 e)) rtn))))
 983     rtn))
 984
 985 (defvar org-export-inbuffer-options-extra nil
 986   "List of additional in-buffer options that should be detected.
 987 Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL,
 988 etc.  Extensions can add to this list to get their options detected, and they
 989 can then add a function to `org-export-options-filters' to process these
 990 options.
 991 Each element in this list must be a list, with the in-buffer keyword as car,
 992 and a property (a symbol) as the next element.  All occurrences of the
 993 keyword will be found, the values concatenated with a space character
 994 in between, and the result stored in the export options property list.")
 995
 996 (defvar org-export-options-filters nil
 997   "Functions to be called to finalize the export/publishing options.
 998 All these options are stored in a property list, and each of the functions
 999 in this hook gets a chance to modify this property list.  Each function
1000 must accept the property list as an argument, and must return the (possibly
1001 modified) list.")
1002
1003 ;; FIXME: should we fold case here?
1004 (defun org-infile-export-plist ()
1005   "Return the property list with file-local settings for export."
1006   (save-excursion
1007     (save-restriction
1008       (widen)
1009       (goto-char (point-min))
1010       (let ((re (org-make-options-regexp
1011                  (append
1012                   '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
1013                     "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER"
1014                     "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
1015                     "KEYWORDS" "DESCRIPTION")
1016                   (mapcar 'car org-export-inbuffer-options-extra))))
1017             p key val text options a pr style
1018             latex-header
1019             ext-setup-or-nil setup-contents (start 0))
1020         (while (or (and ext-setup-or-nil
1021                         (string-match re ext-setup-or-nil start)
1022                         (setq start (match-end 0)))
1023                    (and (setq ext-setup-or-nil nil start 0)
1024                         (re-search-forward re nil t)))
1025           (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil))
1026                 val (org-match-string-no-properties 2 ext-setup-or-nil))
1027           (cond
1028            ((setq a (assoc key org-export-inbuffer-options-extra))
1029             (setq pr (nth 1 a))
1030             (setq p (plist-put p pr (concat (plist-get p pr) " " val))))
1031            ((string-equal key "TITLE") (setq p (plist-put p :title val)))
1032            ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
1033            ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
1034            ((string-equal key "DATE") (setq p (plist-put p :date val)))
1035            ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
1036            ((string-equal key "DESCRIPTION")
1037             (setq p (plist-put p :description val)))
1038            ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
1039            ((string-equal key "STYLE")
1040             (setq style (concat style "\n" val)))
1041            ((string-equal key "LATEX_HEADER")
1042             (setq latex-header (concat latex-header "\n" val)))
1043            ((string-equal key "TEXT")
1044             (setq text (if text (concat text "\n" val) val)))
1045            ((string-equal key "OPTIONS")
1046             (setq options (concat val " " options)))
1047            ((string-equal key "LINK_UP")
1048             (setq p (plist-put p :link-up val)))
1049            ((string-equal key "LINK_HOME")
1050             (setq p (plist-put p :link-home val)))
1051            ((string-equal key "EXPORT_SELECT_TAGS")
1052             (setq p (plist-put p :select-tags (org-split-string val))))
1053            ((string-equal key "EXPORT_EXCLUDE_TAGS")
1054             (setq p (plist-put p :exclude-tags (org-split-string val))))
1055            ((equal key "SETUPFILE")
1056             (setq setup-contents (org-file-contents
1057                                   (expand-file-name
1058                                    (org-remove-double-quotes
1059                                     (org-trim val)))
1060                                   'noerror))
1061             (if (not ext-setup-or-nil)
1062                 (setq ext-setup-or-nil setup-contents start 0)
1063               (setq ext-setup-or-nil
1064                     (concat (substring ext-setup-or-nil 0 start)
1065                             "\n" setup-contents "\n"
1066                             (substring ext-setup-or-nil start)))))))
1067         (setq p (plist-put p :text text))
1068         (when style (setq p (plist-put p :style-extra style)))
1069         (when latex-header
1070           (setq p (plist-put p :latex-header-extra (substring latex-header 1))))
1071         (when options
1072           (setq p (org-export-add-options-to-plist p options)))
1073         ;; Add macro definitions
1074         (goto-char (point-min))
1075         (while (re-search-forward
1076                 "^#\\+macro:[ \t]+\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)"
1077                 nil t)
1078           (setq p (plist-put p (intern (concat ":macro-"
1079                                                (downcase (match-string 1))))
1080                              (match-string 2))))
1081         p))))
1082
1083 (defun org-export-add-options-to-plist (p options)
1084   "Parse an OPTIONS line and set values in the property list P."
1085   (let (o)
1086     (when options
1087       (let ((op org-export-plist-vars))
1088         (while (setq o (pop op))
1089           (if (and (nth 1 o)
1090                    (string-match (concat (regexp-quote (nth 1 o))
1091                                          ":\\([^ \t\n\r;,.]*\\)")
1092                                  options))
1093               (setq p (plist-put p (car o)
1094                                  (car (read-from-string
1095                                        (match-string 1 options))))))))))
1096   p)
1097
1098 (defun org-export-add-subtree-options (p pos)
1099   "Add options in subtree at position POS to property list P."
1100   (save-excursion
1101     (goto-char pos)
1102     (when (org-at-heading-p)
1103       (let (a)
1104         ;; This is actually read in `org-export-get-title-from-subtree'
1105         ;; (when (setq a (org-entry-get pos "EXPORT_TITLE"))
1106         ;;   (setq p (plist-put p :title a)))
1107         (when (setq a (org-entry-get pos "EXPORT_TEXT"))
1108           (setq p (plist-put p :text a)))
1109         (when (setq a (org-entry-get pos "EXPORT_OPTIONS"))
1110           (setq p (org-export-add-options-to-plist p a)))))
1111     p))
1112
1113 (defun org-export-directory (type plist)
1114   (let* ((val (plist-get plist :publishing-directory))
1115          (dir (if (listp val)
1116                   (or (cdr (assoc type val)) ".")
1117                 val)))
1118     dir))
1119
1120 (defun org-export-process-option-filters (plist)
1121   (let ((functions org-export-options-filters) f)
1122     (while (setq f (pop functions))
1123       (setq plist (funcall f plist))))
1124   plist)
1125
1126 ;;;###autoload
1127 (defun org-export (&optional arg)
1128   "Export dispatcher for Org-mode.
1129 When `org-export-run-in-background' is non-nil, try to run the command
1130 in the background.  This will be done only for commands that write
1131 to a file.  For details see the docstring of `org-export-run-in-background'.
1132
1133 The prefix argument ARG will be passed to the exporter.  However, if
1134 ARG is a double universal prefix `C-u C-u', that means to inverse the
1135 value of `org-export-run-in-background'."
1136   (interactive "P")
1137   (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
1138          (help "[t]   insert the export option template
1139 \[v]   limit export to visible part of outline tree
1140
1141 \[a] export as ASCII
1142
1143 \[h] export as HTML    [H] to temporary buffer   [R] export region
1144 \[b] export as HTML and open in browser
1145
1146 \[l] export as LaTeX   [L] to temporary buffer
1147 \[p] export as LaTeX and process to PDF
1148 \[d] export as LaTeX, process to PDF, and open the resulting PDF document
1149
1150 \[D] export as DocBook
1151 \[V] export as DocBook, process to PDF, and open the resulting PDF document
1152
1153 \[x] export as XOXO
1154
1155 \[i] export current file as iCalendar file
1156 \[I] export all agenda files as iCalendar files
1157 \[c] export agenda files into combined iCalendar file
1158
1159 \[F] publish current file          [P] publish current project
1160 \[X] publish a project...          [A] publish all projects")
1161          (cmds
1162           '((?t org-insert-export-options-template nil)
1163             (?v org-export-visible nil)
1164             (?a org-export-as-ascii t)
1165             (?h org-export-as-html t)
1166             (?b org-export-as-html-and-open t)
1167             (?H org-export-as-html-to-buffer nil)
1168             (?R org-export-region-as-html nil)
1169             (?x org-export-as-xoxo t)
1170             (?D org-export-as-docbook t)
1171             (?V org-export-as-docbook-pdf-and-open t)
1172             (?l org-export-as-latex t)
1173             (?p org-export-as-pdf t)
1174             (?d org-export-as-pdf-and-open t)
1175             (?L org-export-as-latex-to-buffer nil)
1176             (?i org-export-icalendar-this-file t)
1177             (?I org-export-icalendar-all-agenda-files t)
1178             (?c org-export-icalendar-combine-agenda-files t)
1179             (?F org-publish-current-file t)
1180             (?P org-publish-current-project t)
1181             (?X org-publish t)
1182             (?A org-publish-all t)))
1183          r1 r2 ass)
1184     (save-excursion
1185       (save-window-excursion
1186         (delete-other-windows)
1187         (with-output-to-temp-buffer "*Org Export/Publishing Help*"
1188           (princ help))
1189         (org-fit-window-to-buffer (get-buffer-window
1190                                    "*Org Export/Publishing Help*"))
1191         (message "Select command: ")
1192         (setq r1 (read-char-exclusive))))
1193     (setq r2 (if (< r1 27) (+ r1 96) r1))
1194     (unless (setq ass (assq r2 cmds))
1195       (error "No command associated with key %c" r1))
1196     (if (and bg (nth 2 ass)
1197              (not (buffer-base-buffer))
1198              (not (org-region-active-p)))
1199         ;; execute in background
1200         (let ((p (start-process
1201                   (concat "Exporting " (file-name-nondirectory (buffer-file-name)))
1202                   "*Org Processes*"
1203                   (expand-file-name invocation-name invocation-directory)
1204                   "-batch"
1205                   "-l" user-init-file
1206                   "--eval" "(require 'org-exp)"
1207                   "--eval" "(setq org-wait .2)"
1208                   (buffer-file-name)
1209                   "-f" (symbol-name (nth 1 ass)))))
1210           (set-process-sentinel p 'org-export-process-sentinel)
1211           (message "Background process \"%s\": started" p))
1212       ;; background processing not requested, or not possible
1213       (call-interactively (nth 1 ass)))))
1214
1215 (defun org-export-process-sentinel (process status)
1216   (if (string-match "\n+\\'" status)
1217       (setq status (substring status 0 -1)))
1218   (message "Background process \"%s\": %s" process status))
1219
1220 (defconst org-html-entities
1221   '(("nbsp")
1222     ("iexcl")
1223     ("cent")
1224     ("pound")
1225     ("curren")
1226     ("yen")
1227     ("brvbar")
1228     ("vert" . "&#124;")
1229     ("sect")
1230     ("uml")
1231     ("copy")
1232     ("ordf")
1233     ("laquo")
1234     ("not")
1235     ("shy")
1236     ("reg")
1237     ("macr")
1238     ("deg")
1239     ("plusmn")
1240     ("sup2")
1241     ("sup3")
1242     ("acute")
1243     ("micro")
1244     ("para")
1245     ("middot")
1246     ("odot"."o")
1247     ("star"."*")
1248     ("cedil")
1249     ("sup1")
1250     ("ordm")
1251     ("raquo")
1252     ("frac14")
1253     ("frac12")
1254     ("frac34")
1255     ("iquest")
1256     ("Agrave")
1257     ("Aacute")
1258     ("Acirc")
1259     ("Atilde")
1260     ("Auml")
1261     ("Aring") ("AA"."&Aring;")
1262     ("AElig")
1263     ("Ccedil")
1264     ("Egrave")
1265     ("Eacute")
1266     ("Ecirc")
1267     ("Euml")
1268     ("Igrave")
1269     ("Iacute")
1270     ("Icirc")
1271     ("Iuml")
1272     ("ETH")
1273     ("Ntilde")
1274     ("Ograve")
1275     ("Oacute")
1276     ("Ocirc")
1277     ("Otilde")
1278     ("Ouml")
1279     ("times")
1280     ("Oslash")
1281     ("Ugrave")
1282     ("Uacute")
1283     ("Ucirc")
1284     ("Uuml")
1285     ("Yacute")
1286     ("THORN")
1287     ("szlig")
1288     ("agrave")
1289     ("aacute")
1290     ("acirc")
1291     ("atilde")
1292     ("auml")
1293     ("aring")
1294     ("aelig")
1295     ("ccedil")
1296     ("egrave")
1297     ("eacute")
1298     ("ecirc")
1299     ("euml")
1300     ("igrave")
1301     ("iacute")
1302     ("icirc")
1303     ("iuml")
1304     ("eth")
1305     ("ntilde")
1306     ("ograve")
1307     ("oacute")
1308     ("ocirc")
1309     ("otilde")
1310     ("ouml")
1311     ("divide")
1312     ("oslash")
1313     ("ugrave")
1314     ("uacute")
1315     ("ucirc")
1316     ("uuml")
1317     ("yacute")
1318     ("thorn")
1319     ("yuml")
1320     ("fnof")
1321     ("Alpha")
1322     ("Beta")
1323     ("Gamma")
1324     ("Delta")
1325     ("Epsilon")
1326     ("Zeta")
1327     ("Eta")
1328     ("Theta")
1329     ("Iota")
1330     ("Kappa")
1331     ("Lambda")
1332     ("Mu")
1333     ("Nu")
1334     ("Xi")
1335     ("Omicron")
1336     ("Pi")
1337     ("Rho")
1338     ("Sigma")
1339     ("Tau")
1340     ("Upsilon")
1341     ("Phi")
1342     ("Chi")
1343     ("Psi")
1344     ("Omega")
1345     ("alpha")
1346     ("beta")
1347     ("gamma")
1348     ("delta")
1349     ("epsilon")
1350     ("varepsilon"."&epsilon;")
1351     ("zeta")
1352     ("eta")
1353     ("theta")
1354     ("iota")
1355     ("kappa")
1356     ("lambda")
1357     ("mu")
1358     ("nu")
1359     ("xi")
1360     ("omicron")
1361     ("pi")
1362     ("rho")
1363     ("sigmaf") ("varsigma"."&sigmaf;")
1364     ("sigma")
1365     ("tau")
1366     ("upsilon")
1367     ("phi")
1368     ("chi")
1369     ("psi")
1370     ("omega")
1371     ("thetasym") ("vartheta"."&thetasym;")
1372     ("upsih")
1373     ("piv")
1374     ("bull") ("bullet"."&bull;")
1375     ("hellip") ("dots"."&hellip;")
1376     ("prime")
1377     ("Prime")
1378     ("oline")
1379     ("frasl")
1380     ("weierp")
1381     ("image")
1382     ("real")
1383     ("trade")
1384     ("alefsym")
1385     ("larr") ("leftarrow"."&larr;") ("gets"."&larr;")
1386     ("uarr") ("uparrow"."&uarr;")
1387     ("rarr") ("to"."&rarr;") ("rightarrow"."&rarr;")
1388     ("darr")("downarrow"."&darr;")
1389     ("harr") ("leftrightarrow"."&harr;")
1390     ("crarr") ("hookleftarrow"."&crarr;") ; has round hook, not quite CR
1391     ("lArr") ("Leftarrow"."&lArr;")
1392     ("uArr") ("Uparrow"."&uArr;")
1393     ("rArr") ("Rightarrow"."&rArr;")
1394     ("dArr") ("Downarrow"."&dArr;")
1395     ("hArr") ("Leftrightarrow"."&hArr;")
1396     ("forall")
1397     ("part") ("partial"."&part;")
1398     ("exist") ("exists"."&exist;")
1399     ("empty") ("emptyset"."&empty;")
1400     ("nabla")
1401     ("isin") ("in"."&isin;")
1402     ("notin")
1403     ("ni")
1404     ("prod")
1405     ("sum")
1406     ("minus")
1407     ("lowast") ("ast"."&lowast;")
1408     ("radic")
1409     ("prop") ("proptp"."&prop;")
1410     ("infin") ("infty"."&infin;")
1411     ("ang") ("angle"."&ang;")
1412     ("and") ("wedge"."&and;")
1413     ("or") ("vee"."&or;")
1414     ("cap")
1415     ("cup")
1416     ("int")
1417     ("there4")
1418     ("sim")
1419     ("cong") ("simeq"."&cong;")
1420     ("asymp")("approx"."&asymp;")
1421     ("ne") ("neq"."&ne;")
1422     ("equiv")
1423     ("le")
1424     ("ge")
1425     ("sub") ("subset"."&sub;")
1426     ("sup") ("supset"."&sup;")
1427     ("nsub")
1428     ("sube")
1429     ("supe")
1430     ("oplus")
1431     ("otimes")
1432     ("perp")
1433     ("sdot") ("cdot"."&sdot;")
1434     ("lceil")
1435     ("rceil")
1436     ("lfloor")
1437     ("rfloor")
1438     ("lang")
1439     ("rang")
1440     ("loz") ("Diamond"."&loz;")
1441     ("spades") ("spadesuit"."&spades;")
1442     ("clubs") ("clubsuit"."&clubs;")
1443     ("hearts") ("diamondsuit"."&hearts;")
1444     ("diams") ("diamondsuit"."&diams;")
1445     ("smile"."&#9786;") ("blacksmile"."&#9787;") ("sad"."&#9785;")
1446     ("quot")
1447     ("amp")
1448     ("lt")
1449     ("gt")
1450     ("OElig")
1451     ("oelig")
1452     ("Scaron")
1453     ("scaron")
1454     ("Yuml")
1455     ("circ")
1456     ("tilde")
1457     ("ensp")
1458     ("emsp")
1459     ("thinsp")
1460     ("zwnj")
1461     ("zwj")
1462     ("lrm")
1463     ("rlm")
1464     ("ndash")
1465     ("mdash")
1466     ("lsquo")
1467     ("rsquo")
1468     ("sbquo")
1469     ("ldquo")
1470     ("rdquo")
1471     ("bdquo")
1472     ("dagger")
1473     ("Dagger")
1474     ("permil")
1475     ("lsaquo")
1476     ("rsaquo")
1477     ("euro")
1478
1479     ("arccos"."arccos")
1480     ("arcsin"."arcsin")
1481     ("arctan"."arctan")
1482     ("arg"."arg")
1483     ("cos"."cos")
1484     ("cosh"."cosh")
1485     ("cot"."cot")
1486     ("coth"."coth")
1487     ("csc"."csc")
1488     ("deg"."deg")
1489     ("det"."det")
1490     ("dim"."dim")
1491     ("exp"."exp")
1492     ("gcd"."gcd")
1493     ("hom"."hom")
1494     ("inf"."inf")
1495     ("ker"."ker")
1496     ("lg"."lg")
1497     ("lim"."lim")
1498     ("liminf"."liminf")
1499     ("limsup"."limsup")
1500     ("ln"."ln")
1501     ("log"."log")
1502     ("max"."max")
1503     ("min"."min")
1504     ("Pr"."Pr")
1505     ("sec"."sec")
1506     ("sin"."sin")
1507     ("sinh"."sinh")
1508     ("sup"."sup")
1509     ("tan"."tan")
1510     ("tanh"."tanh")
1511     )
1512   "Entities for TeX->HTML translation.
1513 Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
1514 \"&ent;\".  An entry can also be a dotted pair like (\"ent\".\"&other;\").
1515 In that case, \"\\ent\" will be translated to \"&other;\".
1516 The list contains HTML entities for Latin-1, Greek and other symbols.
1517 It is supplemented by a number of commonly used TeX macros with appropriate
1518 translations.  There is currently no way for users to extend this.")
1519
1520 ;;; General functions for all backends
1521
1522 (defvar org-export-target-aliases nil
1523   "Alist of targets with invisible aliases.")
1524 (defvar org-export-code-refs nil
1525   "Alist of code references and line numbers")
1526
1527 (defun org-export-preprocess-string (string &rest parameters)
1528   "Cleanup STRING so that that the true exported has a more consistent source.
1529 This function takes STRING, which should be a buffer-string of an org-file
1530 to export.  It then creates a temporary buffer where it does its job.
1531 The result is then again returned as a string, and the exporter works
1532 on this string to produce the exported version."
1533   (interactive)
1534   (let* ((htmlp (plist-get parameters :for-html))
1535          (asciip (plist-get parameters :for-ascii))
1536          (latexp (plist-get parameters :for-LaTeX))
1537          (docbookp (plist-get parameters :for-docbook))
1538          (backend (cond (htmlp 'html)
1539                         (latexp 'latex)
1540                         (asciip 'ascii)
1541                         (docbookp 'docbook)))
1542          (archived-trees (plist-get parameters :archived-trees))
1543          (inhibit-read-only t)
1544          (drawers org-drawers)
1545          (outline-regexp "\\*+ ")
1546          target-alist rtn)
1547
1548     (setq org-export-target-aliases nil)
1549     (setq org-export-code-refs nil)
1550
1551     (with-current-buffer (get-buffer-create " org-mode-tmp")
1552       (erase-buffer)
1553       (insert string)
1554       (setq case-fold-search t)
1555
1556       ;; Remove license-to-kill stuff
1557       ;; The caller marks some stuff for killing, stuff that has been
1558       ;; used to create the page title, for example.
1559       (org-export-kill-licensed-text)
1560
1561       (let ((org-inhibit-startup t)) (org-mode))
1562       (setq case-fold-search t)
1563
1564       ;; Call the hook
1565       (run-hooks 'org-export-preprocess-hook)
1566
1567       ;; Process the macros
1568       (org-export-preprocess-apply-macros)
1569       (run-hooks 'org-export-preprocess-after-macros-hook)
1570
1571       (untabify (point-min) (point-max))
1572
1573       ;; Handle include files, and call a hook
1574       (org-export-handle-include-files)
1575       (run-hooks 'org-export-preprocess-after-include-files-hook)
1576
1577       ;; Get rid of archived trees
1578       (org-export-remove-archived-trees archived-trees)
1579
1580       ;; Remove comment environment and comment subtrees
1581       (org-export-remove-comment-blocks-and-subtrees)
1582
1583       ;; Get rid of excluded trees, and call a hook
1584       (org-export-handle-export-tags (plist-get parameters :select-tags)
1585                                      (plist-get parameters :exclude-tags))
1586       (run-hooks 'org-export-preprocess-after-tree-selection-hook)
1587
1588       ;; Handle source code snippets
1589       (org-export-replace-src-segments-and-examples backend)
1590
1591       ;; Protect short examples marked by a leading colon
1592       (org-export-protect-colon-examples)
1593
1594       ;; Normalize footnotes
1595       (when (plist-get parameters :footnotes)
1596         (org-footnote-normalize nil t))
1597
1598       ;; Find all headings and compute the targets for them
1599       (setq target-alist (org-export-define-heading-targets target-alist))
1600
1601       ;; Get rid of drawers
1602       (org-export-remove-or-extract-drawers drawers
1603                                             (plist-get parameters :drawers))
1604
1605       ;; Get the correct stuff before the first headline
1606       (when (plist-get parameters :skip-before-1st-heading)
1607         (goto-char (point-min))
1608         (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
1609           (delete-region (point-min) (match-beginning 0))
1610           (goto-char (point-min))
1611           (insert "\n")))
1612       (when (plist-get parameters :add-text)
1613         (goto-char (point-min))
1614         (insert (plist-get parameters :add-text) "\n"))
1615
1616       ;; Remove todo-keywords before exporting, if the user has requested so
1617       (org-export-remove-headline-metadata parameters)
1618
1619       ;; Find targets in comments and move them out of comments,
1620       ;; but mark them as targets that should be invisible
1621       (setq target-alist (org-export-handle-invisible-targets target-alist))
1622
1623       ;; Select and protect backend specific stuff, throw away stuff
1624       ;; that is specific for other backends
1625       (org-export-select-backend-specific-text backend)
1626
1627       ;; Protect quoted subtrees
1628       (org-export-protect-quoted-subtrees)
1629
1630       ;; Remove clock lines
1631       (org-export-remove-clock-lines)
1632
1633       ;; Protect verbatim elements
1634       (org-export-protect-verbatim)
1635
1636       ;; Blockquotes, verse, and center
1637       (org-export-mark-blockquote-verse-center)
1638
1639       ;; Remove timestamps, if the user has requested so
1640       (unless (plist-get parameters :timestamps)
1641         (org-export-remove-timestamps))
1642
1643       ;; Attach captions to the correct object
1644       (setq target-alist (org-export-attach-captions-and-attributes
1645                           backend target-alist))
1646
1647       ;; Find matches for radio targets and turn them into internal links
1648       (org-export-mark-radio-links)
1649
1650       ;; Find all links that contain a newline and put them into a single line
1651       (org-export-concatenate-multiline-links)
1652
1653       ;; Normalize links: Convert angle and plain links into bracket links
1654       ;; and expand link abbreviations
1655       (org-export-normalize-links)
1656
1657       ;; Find all internal links.  If they have a fuzzy match (i.e. not
1658       ;; a *dedicated* target match, let the link  point to the
1659       ;; corresponding section.
1660       (org-export-target-internal-links target-alist)
1661
1662       ;; Find multiline emphasis and put them into single line
1663       (when (plist-get parameters :emph-multiline)
1664         (org-export-concatenate-multiline-emphasis))
1665
1666       ;; Remove special table lines
1667       (when org-export-table-remove-special-lines
1668         (org-export-remove-special-table-lines))
1669
1670       ;; Another hook
1671       (run-hooks 'org-export-preprocess-before-backend-specifics-hook)
1672
1673       ;; LaTeX-specific preprocessing
1674       (when latexp
1675         (require 'org-export-latex nil)
1676         (org-export-latex-preprocess parameters))
1677
1678       ;; ASCII-specific preprocessing
1679       (when asciip
1680         (org-export-ascii-preprocess))
1681
1682       ;; HTML-specific preprocessing
1683       (when htmlp
1684         (org-export-html-preprocess parameters))
1685
1686       ;; DocBook-specific preprocessing
1687       (when docbookp
1688         (require 'org-docbook nil)
1689         (org-export-docbook-preprocess parameters))
1690
1691       ;; Remove or replace comments
1692       (org-export-handle-comments (plist-get parameters :comments))
1693
1694       ;; Run the final hook
1695       (run-hooks 'org-export-preprocess-final-hook)
1696
1697       (setq rtn (buffer-string)))
1698     (kill-buffer " org-mode-tmp")
1699     rtn))
1700
1701 (defun org-export-kill-licensed-text ()
1702   "Remove all text that is marked with a :org-license-to-kill property."
1703   (let (p)
1704     (while (setq p (text-property-any (point-min) (point-max)
1705                                       :org-license-to-kill t))
1706       (delete-region
1707        p (or (next-single-property-change p :org-license-to-kill)
1708              (point-max))))))
1709
1710 (defun org-export-define-heading-targets (target-alist)
1711   "Find all headings and define the targets for them.
1712 The new targets are added to TARGET-ALIST, which is also returned."
1713   (goto-char (point-min))
1714   (org-init-section-numbers)
1715   (let ((re (concat "^" org-outline-regexp
1716                     "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)"))
1717         level target last-section-target a)
1718     (while (re-search-forward re nil t)
1719       (if (match-end 1)
1720           (progn
1721             (push (cons (org-match-string-no-properties 1)
1722                         target) target-alist)
1723             (setq a (or (assoc last-section-target org-export-target-aliases)
1724                         (progn
1725                           (push (list last-section-target)
1726                                 org-export-target-aliases)
1727                           (car org-export-target-aliases))))
1728             (push (caar target-alist) (cdr a)))
1729         (setq level (org-reduced-level
1730                      (save-excursion (goto-char (point-at-bol))
1731                                      (org-outline-level))))
1732         (setq target (org-solidify-link-text
1733                       (format "sec-%s" (org-section-number level))))
1734         (setq last-section-target target)
1735         (push (cons target target) target-alist)
1736         (add-text-properties
1737          (point-at-bol) (point-at-eol)
1738          (list 'target target)))))
1739   target-alist)
1740
1741 (defun org-export-handle-invisible-targets (target-alist)
1742   "Find targets in comments and move them out of comments.
1743 Mark them as invisible targets."
1744   (let (target tmp a)
1745     (goto-char (point-min))
1746     (while (re-search-forward "^#.*?\\(<<<?\\([^>\r\n]+\\)>>>?\\).*" nil t)
1747       ;; Check if the line before or after is a headline with a target
1748       (if (setq target (or (get-text-property (point-at-bol 0) 'target)
1749                            (get-text-property (point-at-bol 2) 'target)))
1750           (progn
1751             ;; use the existing target in a neighboring line
1752             (setq tmp (match-string 2))
1753             (replace-match "")
1754             (and (looking-at "\n") (delete-char 1))
1755             (push (cons (setq tmp (org-solidify-link-text tmp)) target)
1756                   target-alist)
1757             (setq a (or (assoc target org-export-target-aliases)
1758                         (progn
1759                           (push (list target) org-export-target-aliases)
1760                           (car org-export-target-aliases))))
1761             (push tmp (cdr a)))
1762         ;; Make an invisible target
1763         (replace-match "\\1(INVISIBLE)"))))
1764   target-alist)
1765
1766 (defun org-export-target-internal-links (target-alist)
1767   "Find all internal links and assign targets to them.
1768 If a link has a fuzzy match (i.e. not a *dedicated* target match),
1769 let the link  point to the corresponding section.
1770 This function also handles the id links, if they have a match in
1771 the current file."
1772   (goto-char (point-min))
1773   (while (re-search-forward org-bracket-link-regexp nil t)
1774     (org-if-unprotected
1775      (let* ((md (match-data))
1776             (desc (match-end 2))
1777             (link (org-link-unescape (match-string 1)))
1778             (slink (org-solidify-link-text link))
1779             found props pos cref
1780             (target
1781              (cond
1782               ((= (string-to-char link) ?#)
1783                ;; user wants exactly this link
1784                link)
1785               ((cdr (assoc slink target-alist)))
1786               ((and (string-match "^id:" link)
1787                     (cdr (assoc (substring link 3) target-alist))))
1788               ((string-match "^(\\(.*\\))$" link)
1789                (setq cref (match-string 1 link))
1790                (concat "coderef:" cref))
1791               ((string-match org-link-types-re link) nil)
1792               ((or (file-name-absolute-p link)
1793                    (string-match "^\\." link))
1794                nil)
1795               (t
1796                (save-excursion
1797                  (setq found (condition-case nil (org-link-search link)
1798                                (error nil)))
1799                  (when (and found
1800                             (or (org-on-heading-p)
1801                                 (not (eq found 'dedicated))))
1802                    (or (get-text-property (point) 'target)
1803                        (get-text-property
1804                         (max (point-min)
1805                              (1- (or (previous-single-property-change
1806                                       (point) 'target) 0)))
1807                         'target))))))))
1808        (when target
1809          (set-match-data md)
1810          (goto-char (match-beginning 1))
1811          (setq props (text-properties-at (point)))
1812          (delete-region (match-beginning 1) (match-end 1))
1813          (setq pos (point))
1814          (insert target)
1815          (unless desc (insert "][" link))
1816          (add-text-properties pos (point) props))))))
1817
1818 (defun org-export-remove-or-extract-drawers (all-drawers exp-drawers)
1819   "Remove drawers, or extract the content.
1820 ALL-DRAWERS is a list of all drawer names valid in the current buffer.
1821 EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers
1822 whose content to keep."
1823   (unless (eq t exp-drawers)
1824     (goto-char (point-min))
1825     (let ((re (concat "^[ \t]*:\\("
1826                       (mapconcat
1827                        'identity
1828                        (org-delete-all exp-drawers
1829                                        (copy-sequence all-drawers))
1830                        "\\|")
1831                       "\\):[ \t]*\n\\([^\000]*?\n\\)?[ \t]*:END:[ \t]*\n")))
1832       (while (re-search-forward re nil t)
1833         (org-if-unprotected
1834          (replace-match ""))))))
1835
1836 (defun org-export-handle-export-tags (select-tags exclude-tags)
1837   "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS.
1838 Both arguments are lists of tags.
1839 If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG
1840 will be removed.
1841 After that, all subtrees that are marked by EXCLUDE-TAGS will be
1842 removed as well."
1843   (remove-text-properties (point-min) (point-max) '(:org-delete t))
1844   (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote
1845                                            select-tags "\\|")
1846                          "\\):"))
1847          (re-excl (concat ":\\(" (mapconcat 'regexp-quote
1848                                            exclude-tags "\\|")
1849                         "\\):"))
1850          beg end cont)
1851     (goto-char (point-min))
1852     (when (and select-tags
1853                (re-search-forward
1854                 (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t))
1855       ;; At least one tree is marked for export, this means
1856       ;; all the unmarked stuff needs to go.
1857       ;; Dig out the trees that should be exported
1858       (goto-char (point-min))
1859       (outline-next-heading)
1860       (setq beg (point))
1861       (put-text-property beg (point-max) :org-delete t)
1862       (while (re-search-forward re-sel nil t)
1863         (when (org-on-heading-p)
1864           (org-back-to-heading)
1865           (remove-text-properties
1866            (max (1- (point)) (point-min))
1867            (setq cont (save-excursion (org-end-of-subtree t t)))
1868            '(:org-delete t))
1869           (while (and (org-up-heading-safe)
1870                       (get-text-property (point) :org-delete))
1871             (remove-text-properties (max (1- (point)) (point-min))
1872                                     (point-at-eol) '(:org-delete t)))
1873           (goto-char cont))))
1874     ;; Remove the trees explicitly marked for noexport
1875     (when exclude-tags
1876       (goto-char (point-min))
1877       (while (re-search-forward re-excl nil t)
1878         (when (org-at-heading-p)
1879           (org-back-to-heading t)
1880           (setq beg (point))
1881           (org-end-of-subtree t)
1882           (delete-region beg (point)))))
1883     ;; Remove everything that is now still marked for deletion
1884     (goto-char (point-min))
1885     (while (setq beg (text-property-any (point-min) (point-max) :org-delete t))
1886       (setq end (or (next-single-property-change beg :org-delete)
1887                     (point-max)))
1888       (delete-region beg end))))
1889
1890 (defun org-export-remove-archived-trees (export-archived-trees)
1891   "Remove archived trees.
1892 When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported.
1893 When it is t, the entire archived tree will be exported.
1894 When it is nil the entire tree including the headline will be removed
1895 from the buffer."
1896   (let ((re-archive (concat ":" org-archive-tag ":"))
1897         a b)
1898     (when (not (eq export-archived-trees t))
1899       (goto-char (point-min))
1900       (while (re-search-forward re-archive nil t)
1901         (if (not (org-on-heading-p t))
1902             (org-end-of-subtree t)
1903           (beginning-of-line 1)
1904           (setq a (if export-archived-trees
1905                       (1+ (point-at-eol)) (point))
1906                 b (org-end-of-subtree t))
1907           (if (> b a) (delete-region a b)))))))
1908
1909 (defun org-export-remove-headline-metadata (opts)
1910   "Remove meta data from the headline, according to user options."
1911   (let ((re org-complex-heading-regexp)
1912         (todo (plist-get opts :todo-keywords))
1913         (tags (plist-get opts :tags))
1914         (pri  (plist-get opts :priority))
1915         (elts '(1 2 3 4 5))
1916         rpl)
1917     (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5))))
1918     (when (or (not todo) (not tags) (not pri))
1919       (goto-char (point-min))
1920       (while (re-search-forward re nil t)
1921         (org-if-unprotected
1922          (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) ""))
1923                               elts " "))
1924          (replace-match rpl t t))))))
1925
1926 (defun org-export-remove-timestamps ()
1927   "Remove timestamps and keywords for export."
1928   (while (re-search-forward org-maybe-keyword-time-regexp nil t)
1929     (backward-char 1)
1930     (org-if-unprotected
1931      (unless (save-match-data (org-at-table-p))
1932        (replace-match "")
1933        (beginning-of-line 1)
1934        (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n")
1935            (replace-match ""))))))
1936
1937 (defun org-export-remove-clock-lines ()
1938   "Remove clock lines for export."
1939   (let ((re (concat "^[ \t]*" org-clock-string ".*\n?")))
1940     (while (re-search-forward re nil t)
1941       (org-if-unprotected
1942        (replace-match "")))))
1943
1944 (defun org-export-protect-quoted-subtrees ()
1945   "Mark quoted subtrees with the protection property."
1946   (let ((re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
1947     (goto-char (point-min))
1948     (while (re-search-forward re-quote nil t)
1949       (goto-char (match-beginning 0))
1950       (end-of-line 1)
1951       (add-text-properties (point) (org-end-of-subtree t)
1952                            '(org-protected t)))))
1953
1954 (defun org-export-protect-verbatim ()
1955   "Mark verbatim snippets with the protection property."
1956   (goto-char (point-min))
1957   (while (re-search-forward org-verbatim-re nil t)
1958     (add-text-properties (match-beginning 4) (match-end 4)
1959                          '(org-protected t))
1960     (goto-char (1+ (match-end 4)))))
1961
1962 (defun org-export-protect-colon-examples ()
1963   "Protect lines starting with a colon."
1964   (goto-char (point-min))
1965   (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg)
1966     (while (re-search-forward re nil t)
1967       (beginning-of-line 1)
1968       (setq beg (point))
1969       (while (looking-at re)
1970         (end-of-line 1)
1971         (or (eobp) (forward-char 1)))
1972       (add-text-properties beg (if (bolp) (1- (point)) (point))
1973                            '(org-protected t)))))
1974
1975 (defun org-export-select-backend-specific-text (backend)
1976   (let ((formatters
1977          '((docbook "DOCBOOK" "BEGIN_DOCBOOK" "END_DOCBOOK")
1978            (html "HTML" "BEGIN_HTML" "END_HTML")
1979            (ascii "ASCII" "BEGIN_ASCII" "END_ASCII")
1980            (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
1981         (case-fold-search t)
1982         fmt)
1983
1984     (while formatters
1985       (setq fmt (pop formatters))
1986       (when (eq (car fmt) backend)
1987         ;; This is selected code, put it into the file for real
1988         (goto-char (point-min))
1989         (while (re-search-forward (concat "^#\\+" (cadr fmt)
1990                                           ":[ \t]*\\(.*\\)") nil t)
1991           (replace-match "\\1" t)
1992           (add-text-properties
1993            (point-at-bol) (min (1+ (point-at-eol)) (point-max))
1994            '(org-protected t))))
1995       (goto-char (point-min))
1996       (while (re-search-forward
1997               (concat "^#\\+"
1998                       (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+"
1999                       (cadddr fmt) "\\>.*\n?") nil t)
2000         (if (eq (car fmt) backend)
2001             ;; yes, keep this
2002             (add-text-properties (match-beginning 1) (1+ (match-end 1))
2003                                  '(org-protected t))
2004           ;; No, this is for a different backend, kill it
2005           (delete-region (match-beginning 0) (match-end 0)))))))
2006
2007 (defun org-export-mark-blockquote-verse-center ()
2008   "Mark block quote and verse environments with special cookies.
2009 These special cookies will later be interpreted by the backend."
2010   ;; Blockquotes
2011   (goto-char (point-min))
2012   (while (re-search-forward "^#\\+\\(begin\\|end\\)_\\(block\\)?quote\\>.*"
2013                             nil t)
2014     (replace-match (if (equal (downcase (match-string 1)) "end")
2015                        "ORG-BLOCKQUOTE-END" "ORG-BLOCKQUOTE-START")
2016                    t t))
2017   ;; Verse
2018   (goto-char (point-min))
2019   (while (re-search-forward "^#\\+\\(begin\\|end\\)_verse\\>.*" nil t)
2020     (replace-match (if (equal (downcase (match-string 1)) "end")
2021                        "ORG-VERSE-END" "ORG-VERSE-START")
2022                    t t))
2023   ;; Center
2024   (goto-char (point-min))
2025   (while (re-search-forward "^#\\+\\(begin\\|end\\)_center\\>.*" nil t)
2026     (replace-match (if (equal (downcase (match-string 1)) "end")
2027                        "ORG-CENTER-END" "ORG-CENTER-START")
2028                    t t)))
2029
2030 (defun org-export-attach-captions-and-attributes (backend target-alist)
2031   "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties.
2032 If the next thing following is a table, add the text properties to the first
2033 table line.  If it is a link, add it to the line containing the link."
2034   (goto-char (point-min))
2035   (remove-text-properties (point-min) (point-max)
2036                           '(org-caption nil org-attributes nil))
2037   (let ((case-fold-search t)
2038         (re (concat "^#\\+caption:[ \t]+\\(.*\\)"
2039                     "\\|"
2040                     "^#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)"
2041                     "\\|"
2042                     "^#\\+label:[ \t]+\\(.*\\)"
2043                     "\\|"
2044                     "^[ \t]*|[^-]"
2045                     "\\|"
2046                     "^[ \t]*\\[\\[.*\\]\\][ \t]*$"))
2047         cap attr label)
2048     (while (re-search-forward re nil t)
2049       (cond
2050        ((match-end 1)
2051         (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))))
2052        ((match-end 2)
2053         (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))))
2054        ((match-end 3)
2055         (setq label (org-trim (match-string 3))))
2056        (t
2057         (add-text-properties (point-at-bol) (point-at-eol)
2058                              (list 'org-caption cap
2059                                    'org-attributes attr
2060                                    'org-label label))
2061         (if label (push (cons label label) target-alist))
2062         (setq cap nil attr nil label nil)))))
2063   target-alist)
2064
2065 (defun org-export-remove-comment-blocks-and-subtrees ()
2066   "Remove the comment environment, and also commented subtrees."
2067   (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
2068         (case-fold-search nil))
2069     ;; Remove comment environment
2070     (goto-char (point-min))
2071     (while (re-search-forward
2072             "^#\\+BEGIN_COMMENT[ \t]*\n[^\000]*?^#\\+END_COMMENT\\>.*" nil t)
2073       (replace-match "" t t))
2074     ;; Remove subtrees that are commented
2075     (goto-char (point-min))
2076     (while (re-search-forward re-commented nil t)
2077       (goto-char (match-beginning 0))
2078       (delete-region (point) (org-end-of-subtree t)))))
2079
2080 (defun org-export-handle-comments (commentsp)
2081   "Remove comments, or convert to backend-specific format.
2082 COMMENTSP can be a format string for publishing comments.
2083 When it is nil, all comments will be removed."
2084   (let ((re "^#\\(.*\n?\\)")
2085         pos)
2086     (goto-char (point-min))
2087     (while (or (looking-at re)
2088                (re-search-forward re nil t))
2089       (setq pos (match-beginning 0))
2090       (if commentsp
2091           (progn (add-text-properties
2092                   (match-beginning 0) (match-end 0) '(org-protected t))
2093                  (replace-match (format commentsp (match-string 1)) t t))
2094         (goto-char (1+ pos))
2095         (org-if-unprotected
2096          (replace-match "")
2097          (goto-char (max (point-min) (1- pos))))))))
2098
2099 (defun org-export-mark-radio-links ()
2100   "Find all matches for radio targets and turn them into internal links."
2101   (let ((re-radio (and org-target-link-regexp
2102                        (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))))
2103     (goto-char (point-min))
2104     (when re-radio
2105       (while (re-search-forward re-radio nil t)
2106         (org-if-unprotected
2107          (replace-match "\\1[[\\2]]"))))))
2108
2109 (defun org-export-remove-special-table-lines ()
2110   "Remove tables lines that are used for internal purposes."
2111   (goto-char (point-min))
2112   (while (re-search-forward "^[ \t]*|" nil t)
2113     (beginning-of-line 1)
2114     (if (or (looking-at "[ \t]*| *[!_^] *|")
2115             (and (looking-at ".*?| *<[0-9]+> *|")
2116                  (not (looking-at ".*?| *[^ <|]"))))
2117         (delete-region (max (point-min) (1- (point-at-bol)))
2118                        (point-at-eol))
2119       (end-of-line 1))))
2120
2121 (defun org-export-normalize-links ()
2122   "Convert all links to bracket links, and expand link abbreviations."
2123   (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
2124         (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)))
2125     (goto-char (point-min))
2126     (while (re-search-forward re-plain-link nil t)
2127       (goto-char (1- (match-end 0)))
2128       (org-if-unprotected-at (1+ (match-beginning 0))
2129        (let* ((s (concat (match-string 1) "[[" (match-string 2)
2130                          ":" (match-string 3) "]]")))
2131          ;; added 'org-link face to links
2132          (put-text-property 0 (length s) 'face 'org-link s)
2133          (replace-match s t t))))
2134     (goto-char (point-min))
2135     (while (re-search-forward re-angle-link nil t)
2136       (goto-char (1- (match-end 0)))
2137       (org-if-unprotected
2138        (let* ((s (concat (match-string 1) "[[" (match-string 2)
2139                          ":" (match-string 3) "]]")))
2140          (put-text-property 0 (length s) 'face 'org-link s)
2141          (replace-match s t t))))
2142     (goto-char (point-min))
2143     (while (re-search-forward org-bracket-link-regexp nil t)
2144       (goto-char (1- (match-end 0)))
2145       (org-if-unprotected
2146        (let* ((xx (save-match-data
2147                     (org-translate-link
2148                      (org-link-expand-abbrev (match-string 1)))))
2149               (s (concat
2150                   "[[" (org-add-props (copy-sequence xx)
2151                            nil 'org-protected t)
2152                   "]"
2153                   (if (match-end 3)
2154                       (match-string 2)
2155                     (concat "[" (org-add-props
2156                                     (copy-sequence xx)
2157                                     '(org-protected t))
2158                             "]"))
2159                   "]")))
2160          (put-text-property 0 (length s) 'face 'org-link s)
2161          (replace-match s t t))))))
2162
2163 (defun org-export-concatenate-multiline-links ()
2164   "Find multi-line links and put it all into a single line.
2165 This is to make sure that the line-processing export backends
2166 can work correctly."
2167   (goto-char (point-min))
2168   (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
2169     (org-if-unprotected
2170      (replace-match "\\1 \\3")
2171      (goto-char (match-beginning 0)))))
2172
2173 (defun org-export-concatenate-multiline-emphasis ()
2174   "Find multi-line emphasis and put it all into a single line.
2175 This is to make sure that the line-processing export backends
2176 can work correctly."
2177   (goto-char (point-min))
2178   (while (re-search-forward org-emph-re nil t)
2179     (if (and (not (= (char-after (match-beginning 3))
2180                      (char-after (match-beginning 4))))
2181              (save-excursion (goto-char (match-beginning 0))
2182                              (save-match-data (not (org-at-table-p)))))
2183         (org-if-unprotected
2184          (subst-char-in-region (match-beginning 0) (match-end 0)
2185                                ?\n ?\  t)
2186          (goto-char (1- (match-end 0))))
2187       (goto-char (1+ (match-beginning 0))))))
2188
2189 (defun org-export-grab-title-from-buffer ()
2190   "Get a title for the current document, from looking at the buffer."
2191   (let ((inhibit-read-only t))
2192     (save-excursion
2193       (goto-char (point-min))
2194       (let ((end (if (looking-at org-outline-regexp)
2195                      (point)
2196                    (save-excursion (outline-next-heading) (point)))))
2197         (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t)
2198           ;; Mark the line so that it will not be exported as normal text.
2199           (org-unmodified
2200            (add-text-properties (match-beginning 0) (match-end 0)
2201                                 (list :org-license-to-kill t)))
2202           ;; Return the title string
2203           (org-trim (match-string 0)))))))
2204
2205 (defun org-export-get-title-from-subtree ()
2206   "Return subtree title and exclude it from export."
2207   (let (title (rbeg (region-beginning)) (rend (region-end)))
2208     (save-excursion
2209       (goto-char rbeg)
2210       (when (and (org-at-heading-p)
2211                  (>= (org-end-of-subtree t t) rend))
2212         ;; This is a subtree, we take the title from the first heading
2213         (goto-char rbeg)
2214         (looking-at org-todo-line-regexp)
2215         (setq title (match-string 3))
2216         (org-unmodified
2217          (add-text-properties (point) (1+ (point-at-eol))
2218                               (list :org-license-to-kill t)))
2219         (setq title (or (org-entry-get nil "EXPORT_TITLE") title))))
2220     title))
2221
2222 (defun org-solidify-link-text (s &optional alist)
2223   "Take link text and make a safe target out of it."
2224   (save-match-data
2225     (let* ((rtn
2226             (mapconcat
2227              'identity
2228              (org-split-string s "[ \t\r\n]+") "=="))
2229            (a (assoc rtn alist)))
2230       (or (cdr a) rtn))))
2231
2232 (defun org-get-min-level (lines &optional offset)
2233   "Get the minimum level in LINES."
2234   (let ((re "^\\(\\*+\\) ") l)
2235     (catch 'exit
2236       (while (setq l (pop lines))
2237         (if (string-match re l)
2238             (throw 'exit (org-tr-level (- (length (match-string 1 l))
2239                                           (or offset 0))))))
2240       1)))
2241
2242 ;; Variable holding the vector with section numbers
2243 (defvar org-section-numbers (make-vector org-level-max 0))
2244
2245 (defun org-init-section-numbers ()
2246   "Initialize the vector for the section numbers."
2247   (let* ((level  -1)
2248          (numbers (nreverse (org-split-string "" "\\.")))
2249          (depth (1- (length org-section-numbers)))
2250          (i depth) number-string)
2251     (while (>= i 0)
2252       (if (> i level)
2253           (aset org-section-numbers i 0)
2254         (setq number-string (or (car numbers) "0"))
2255         (if (string-match "\\`[A-Z]\\'" number-string)
2256             (aset org-section-numbers i
2257                   (- (string-to-char number-string) ?A -1))
2258           (aset org-section-numbers i (string-to-number number-string)))
2259         (pop numbers))
2260       (setq i (1- i)))))
2261
2262 (defun org-section-number (&optional level)
2263   "Return a string with the current section number.
2264 When LEVEL is non-nil, increase section numbers on that level."
2265   (let* ((depth (1- (length org-section-numbers)))
2266          (string "")
2267          (fmts (car org-export-section-number-format))
2268          (term (cdr org-export-section-number-format))
2269          (sep "")
2270          ctype fmt idx n)
2271     (when level
2272       (when (> level -1)
2273         (aset org-section-numbers
2274               level (1+ (aref org-section-numbers level))))
2275       (setq idx (1+ level))
2276       (while (<= idx depth)
2277         (if (not (= idx 1))
2278             (aset org-section-numbers idx 0))
2279         (setq idx (1+ idx))))
2280     (setq idx 0)
2281     (while (<= idx depth)
2282       (when (> (aref org-section-numbers idx) 0)
2283         (setq fmt (or (pop fmts) fmt)
2284               ctype (car fmt)
2285               n (aref org-section-numbers idx)
2286               string (if (> n 0)
2287                          (concat string sep (org-number-to-counter n ctype))
2288                        (concat string ".0"))
2289               sep (nth 1 fmt)))
2290       (setq idx (1+ idx)))
2291     (save-match-data
2292       (if (string-match "\\`\\([@0]\\.\\)+" string)
2293           (setq string (replace-match "" t nil string)))
2294       (if (string-match "\\(\\.0\\)+\\'" string)
2295           (setq string (replace-match "" t nil string))))
2296     (concat string term)))
2297
2298 (defun org-number-to-counter (n type)
2299   "Concert number N to a string counter, according to TYPE.
2300 TYPE must be a string, any of:
2301  1  number
2302  A  A,B,....
2303  a  a,b,....
2304  I  upper case roman numeral
2305  i  lower case roman numeral"
2306   (cond
2307    ((equal type "1") (number-to-string n))
2308    ((equal type "A") (char-to-string (+ ?A n -1)))
2309    ((equal type "a") (char-to-string (+ ?a n -1)))
2310    ((equal type "I") (org-number-to-roman n))
2311    ((equal type "i") (downcase (org-number-to-roman n)))
2312    (t (error "Invalid counter type `%s'" type))))
2313
2314 (defun org-number-to-roman (n)
2315   "Convert integer N into a roman numeral."
2316   (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
2317                  ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
2318                  (  10 . "X") (  9 . "IX") (  5 . "V") (  4 . "IV")
2319                  (   1 . "I")))
2320         (res ""))
2321     (if (<= n 0)
2322         (number-to-string n)
2323       (while roman
2324         (if (>= n (caar roman))
2325             (setq n (- n (caar roman))
2326                   res (concat res (cdar roman)))
2327           (pop roman)))
2328       res)))
2329
2330 ;;; Macros
2331
2332 (defun org-export-preprocess-apply-macros ()
2333   "Replace macro references."
2334   (goto-char (point-min))
2335   (let (sy val key)
2336     (while (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)}}}" nil t)
2337       (setq key (downcase (match-string 1)))
2338       (when (setq val (or (plist-get org-export-opt-plist
2339                                      (intern (concat ":macro-" key)))
2340                           (plist-get org-export-opt-plist
2341                                      (intern (concat ":" key)))))
2342         (and (stringp val)
2343              (replace-match val t t))))))
2344
2345 (defun org-export-apply-macros-in-string (s)
2346   "Apply the macros in string S."
2347   (when s
2348     (with-temp-buffer
2349       (insert s)
2350       (org-export-preprocess-apply-macros)
2351       (buffer-string))))
2352
2353 ;;; Include files
2354
2355 (defun org-export-handle-include-files ()
2356   "Include the contents of include files, with proper formatting."
2357   (let ((case-fold-search t)
2358         params file markup lang start end prefix prefix1 switches)
2359     (goto-char (point-min))
2360     (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t)
2361       (setq params (read (concat "(" (match-string 1) ")"))
2362             prefix (org-get-and-remove-property 'params :prefix)
2363             prefix1 (org-get-and-remove-property 'params :prefix1)
2364             file (org-symname-or-string (pop params))
2365             markup (org-symname-or-string (pop params))
2366             lang (and (member markup '("src" "SRC"))
2367                       (org-symname-or-string (pop params)))
2368             switches (mapconcat '(lambda (x) (format "%s" x)) params " "))
2369       (delete-region (match-beginning 0) (match-end 0))
2370       (if (or (not file)
2371               (not (file-exists-p file))
2372               (not (file-readable-p file)))
2373           (insert (format "CANNOT INCLUDE FILE %s" file))
2374         (when markup
2375           (if (equal (downcase markup) "src")
2376               (setq start (format "#+begin_src %s %s\n"
2377                                   (or lang "fundamental")
2378                                   (or switches ""))
2379                     end "#+end_src")
2380             (setq start (format "#+begin_%s %s\n" markup switches)
2381                   end  (format "#+end_%s" markup))))
2382         (insert (or start ""))
2383         (insert (org-get-file-contents (expand-file-name file) prefix prefix1))
2384         (or (bolp) (newline))
2385         (insert (or end ""))))))
2386
2387 (defun org-get-file-contents (file &optional prefix prefix1)
2388   "Get the contents of FILE and return them as a string.
2389 If PREFIX is a string, prepend it to each line.  If PREFIX1
2390 is a string, prepend it to the first line instead of PREFIX."
2391   (with-temp-buffer
2392     (insert-file-contents file)
2393     (when (or prefix prefix1)
2394       (goto-char (point-min))
2395       (while (not (eobp))
2396         (insert (or prefix1 prefix))
2397         (setq prefix1 nil)
2398         (beginning-of-line 2)))
2399     (buffer-string)))
2400
2401 (defun org-get-and-remove-property (listvar prop)
2402   "Check if the value of LISTVAR contains PROP as a property.
2403 If yes, return the value of that property (i.e. the element following
2404 in the list) and remove property and value from the list in LISTVAR."
2405   (let ((list (symbol-value listvar)) m v)
2406     (when (setq m (member prop list))
2407       (setq v (nth 1 m))
2408       (if (equal (car list) prop)
2409           (set listvar (cddr list))
2410         (setcdr (nthcdr (- (length list) (length m) 1) list)
2411                 (cddr m))
2412         (set listvar list)))
2413     v))
2414
2415 (defun org-symname-or-string (s)
2416   (if (symbolp s)
2417       (if s (symbol-name s) s)
2418     s))
2419
2420 ;;; Fontification and line numbers for code examples
2421
2422 (defvar org-export-last-code-line-counter-value 0)
2423
2424 (defun org-export-replace-src-segments-and-examples (backend)
2425   "Replace source code segments with special code for export."
2426   (setq org-export-last-code-line-counter-value 0)
2427   (let ((case-fold-search t)
2428         lang code trans opts)
2429     (goto-char (point-min))
2430     (while (re-search-forward
2431             "\\(^#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)#\\+END_SRC.*\\)\\|\\(^#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)#\\+END_EXAMPLE.*\\)"
2432             nil t)
2433       (if (match-end 1)
2434           ;; src segments
2435           (setq lang (match-string 2)
2436                 opts (match-string 3)
2437                 code (match-string 4))
2438         (setq lang nil
2439               opts (match-string 6)
2440               code (match-string 7)))
2441
2442       (setq trans (org-export-format-source-code-or-example
2443                    backend lang code opts))
2444       (replace-match trans t t))))
2445
2446 (defvar htmlp)  ;; dynamically scoped
2447 (defvar latexp)  ;; dynamically scoped
2448
2449 (defun org-export-format-source-code-or-example (backend
2450                                                  lang code &optional opts)
2451   "Format CODE from language LANG and return it formatted for export.
2452 If LANG is nil, do not add any fontification.
2453 OPTS contains formatting optons, like `-n' for triggering numbering lines,
2454 and `+n' for continuing previous numering.
2455 Code formatting according to language currently only works for HTML.
2456 Numbering lines works for all three major backends (html, latex, and ascii)."
2457   (save-match-data
2458     (let (num cont rtn rpllbl keepp textareap cols rows fmt)
2459       (setq opts (or opts "")
2460             num (string-match "[-+]n\\>" opts)
2461             cont (string-match "\\+n\\>" opts)
2462             rpllbl (string-match "-r\\>" opts)
2463             keepp (string-match "-k\\>" opts)
2464             textareap (string-match "-t\\>" opts)
2465             cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts)
2466                      (string-to-number (match-string 1 opts))
2467                    80)
2468             rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts)
2469                      (string-to-number (match-string 1 opts))
2470                    (org-count-lines code))
2471             fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts)
2472                     (match-string 1 opts)))
2473       (when (and textareap (eq backend 'html))
2474         ;; we cannot use numbering or highlighting.
2475         (setq num nil cont nil lang nil))
2476       (if keepp (setq rpllbl 'keep))
2477       (setq rtn code)
2478       (when (equal lang "org")
2479         (setq rtn (with-temp-buffer
2480                     (insert rtn)
2481                     ;; Free up the protected lines
2482                     (goto-char (point-min))
2483                     (while (re-search-forward "^," nil t)
2484                       (replace-match "")
2485                       (end-of-line 1))
2486                     (buffer-string))))
2487       ;; Now backend-specific coding
2488       (cond
2489        ((eq backend 'docbook)
2490         (setq rtn (org-export-number-lines rtn 'docbook 0 0 num cont rpllbl fmt))
2491         (concat "\n#+BEGIN_DOCBOOK\n"
2492                 (org-add-props (concat "<programlisting><![CDATA["
2493                                        rtn
2494                                        "]]>\n</programlisting>\n")
2495                     '(org-protected t))
2496                 "#+END_DOCBOOK\n"))
2497        ((eq backend 'html)
2498         ;; We are exporting to HTML
2499         (when lang
2500           (require 'htmlize nil t)
2501           (when (not (fboundp 'htmlize-region-for-paste))
2502             ;; we do not have htmlize.el, or an old version of it
2503             (setq lang nil)
2504             (message
2505              "htmlize.el 1.34 or later is needed for source code formatting")))
2506
2507         (if lang
2508             (let* ((mode (and lang (intern (concat lang "-mode"))))
2509                    (org-inhibit-startup t)
2510                    (org-startup-folded nil))
2511               (setq rtn
2512                     (with-temp-buffer
2513                       (insert rtn)
2514                       (if (functionp mode)
2515                           (funcall mode)
2516                         (fundamental-mode))
2517                       (font-lock-fontify-buffer)
2518                       (set-buffer-modified-p nil)
2519                       (org-export-htmlize-region-for-paste
2520                        (point-min) (point-max))))
2521               (if (string-match "<pre\\([^>]*\\)>\n?" rtn)
2522                   (setq rtn (replace-match
2523                              (format "<pre class=\"src src-%s\">\n" lang)
2524                              t t rtn))))
2525           (if textareap
2526               (setq rtn (concat
2527                          (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n"
2528                                  cols rows)
2529                          rtn "</textarea>\n</p>\n"))
2530             (with-temp-buffer
2531               (insert rtn)
2532               (goto-char (point-min))
2533               (while (re-search-forward "[<>&]" nil t)
2534                 (replace-match (cdr (assq (char-before)
2535                                           '((?&."&amp;")(?<."&lt;")(?>."&gt;"))))
2536                                t t))
2537               (setq rtn (buffer-string)))
2538             (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n"))))
2539         (unless textareap
2540           (setq rtn (org-export-number-lines rtn 'html 1 1 num
2541                                              cont rpllbl fmt)))
2542         (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n"))
2543        ((eq backend 'latex)
2544         (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt))
2545         (concat "\n#+BEGIN_LaTeX\n"
2546                 (org-add-props (concat "\\begin{verbatim}\n" rtn "\n\\end{verbatim}\n")
2547                     '(org-protected t))
2548                 "#+END_LaTeX\n\n"))
2549        ((eq backend 'ascii)
2550         ;; This is not HTML or LaTeX, so just make it an example.
2551         (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt))
2552         (concat "#+BEGIN_ASCII\n"
2553                 (org-add-props
2554                     (concat
2555                      (mapconcat
2556                       (lambda (l) (concat "  " l))
2557                       (org-split-string rtn "\n")
2558                       "\n")
2559                      "\n")
2560                     '(org-protected t))
2561                 "#+END_ASCII\n"))))))
2562
2563 (defun org-export-number-lines (text backend
2564                                      &optional skip1 skip2 number cont
2565                                      replace-labels label-format)
2566   (if (and (not number) (not (eq replace-labels 'keep)))
2567       (setq replace-labels nil)) ;; must use names if no numbers
2568   (setq skip1 (or skip1 0) skip2 (or skip2 0))
2569   (if (not cont) (setq org-export-last-code-line-counter-value 0))
2570   (with-temp-buffer
2571     (insert text)
2572     (goto-char (point-max))
2573     (skip-chars-backward " \t\n\r")
2574     (delete-region (point) (point-max))
2575     (beginning-of-line (- 1 skip2))
2576     (let* ((last (org-current-line))
2577            (n org-export-last-code-line-counter-value)
2578            (nmax (+ n (- last skip1)))
2579            (fmt (format "%%%dd:  " (length (number-to-string nmax))))
2580            (fm
2581             (cond
2582              ((eq backend 'html) (format "<span class=\"linenr\">%s</span>"
2583                                          fmt))
2584              ((eq backend 'ascii) fmt)
2585              ((eq backend 'latex) fmt)
2586              ((eq backend 'docbook) fmt)
2587              (t "")))
2588            (label-format (or label-format org-coderef-label-format))
2589            (label-pre (if (string-match "%s" label-format)
2590                           (substring label-format 0 (match-beginning 0))
2591                         label-format))
2592            (label-post (if (string-match "%s" label-format)
2593                            (substring label-format (match-end 0))
2594                          ""))
2595            (lbl-re
2596             (concat
2597              ".*?\\S-.*?\\([ \t]*\\("
2598              (regexp-quote label-pre)
2599              "\\([-a-zA-Z0-9_]+\\)"
2600              (regexp-quote label-post)
2601              "\\)\\)"))
2602            ref)
2603
2604       (goto-line (1+ skip1))
2605       (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax))
2606         (if number
2607             (insert (format fm (incf n)))
2608           (forward-char 1))
2609         (when (and (not (eq replace-labels 'keep))
2610                    (looking-at lbl-re))
2611           (setq ref (match-string 3))
2612           (if replace-labels
2613               (progn
2614                 (delete-region (match-beginning 1) (match-end 1))
2615                 (push (cons ref n) org-export-code-refs))
2616             (goto-char (match-beginning 2))
2617             (delete-region (match-beginning 2) (match-end 2))
2618             (insert "(" ref ")")
2619             (push (cons ref (concat "(" ref ")")) org-export-code-refs))
2620           (when (eq backend 'html)
2621             (save-excursion
2622               (beginning-of-line 1)
2623               (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">"
2624                               ref))
2625               (end-of-line 1)
2626               (insert "</span>")))))
2627       (setq org-export-last-code-line-counter-value n)
2628       (goto-char (point-max))
2629       (newline)
2630       (buffer-string))))
2631
2632 (defun org-search-todo-below (line lines level)
2633   "Search the subtree below LINE for any TODO entries."
2634   (let ((rest (cdr (memq line lines)))
2635         (re org-todo-line-regexp)
2636         line lv todo)
2637     (catch 'exit
2638       (while (setq line (pop rest))
2639         (if (string-match re line)
2640             (progn
2641               (setq lv (- (match-end 1) (match-beginning 1))
2642                     todo (and (match-beginning 2)
2643                               (not (member (match-string 2 line)
2644                                           org-done-keywords))))
2645                                         ; TODO, not DONE
2646               (if (<= lv level) (throw 'exit nil))
2647               (if todo (throw 'exit t))))))))
2648
2649 ;;;###autoload
2650 (defun org-export-visible (type arg)
2651   "Create a copy of the visible part of the current buffer, and export it.
2652 The copy is created in a temporary buffer and removed after use.
2653 TYPE is the final key (as a string) that also select the export command in
2654 the `C-c C-e' export dispatcher.
2655 As a special case, if the you type SPC at the prompt, the temporary
2656 org-mode file will not be removed but presented to you so that you can
2657 continue to use it.  The prefix arg ARG is passed through to the exporting
2658 command."
2659   (interactive
2660    (list (progn
2661            (message "Export visible: [a]SCII  [h]tml  [b]rowse HTML [H/R]uffer with HTML  [D]ocBook  [x]OXO  [ ]keep buffer")
2662            (read-char-exclusive))
2663          current-prefix-arg))
2664   (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?D ?x ?\ )))
2665       (error "Invalid export key"))
2666   (let* ((binding (cdr (assoc type
2667                               '((?a . org-export-as-ascii)
2668                                 (?\C-a . org-export-as-ascii)
2669                                 (?b . org-export-as-html-and-open)
2670                                 (?\C-b . org-export-as-html-and-open)
2671                                 (?h . org-export-as-html)
2672                                 (?H . org-export-as-html-to-buffer)
2673                                 (?R . org-export-region-as-html)
2674                                 (?D . org-export-as-docbook)
2675                                 (?x . org-export-as-xoxo)))))
2676          (keepp (equal type ?\ ))
2677          (file buffer-file-name)
2678          (buffer (get-buffer-create "*Org Export Visible*"))
2679          s e)
2680     ;; Need to hack the drawers here.
2681     (save-excursion
2682       (goto-char (point-min))
2683       (while (re-search-forward org-drawer-regexp nil t)
2684         (goto-char (match-beginning 1))
2685         (or (org-invisible-p) (org-flag-drawer nil))))
2686     (with-current-buffer buffer (erase-buffer))
2687     (save-excursion
2688       (setq s (goto-char (point-min)))
2689       (while (not (= (point) (point-max)))
2690         (goto-char (org-find-invisible))
2691         (append-to-buffer buffer s (point))
2692         (setq s (goto-char (org-find-visible))))
2693       (org-cycle-hide-drawers 'all)
2694       (goto-char (point-min))
2695       (unless keepp
2696         ;; Copy all comment lines to the end, to make sure #+ settings are
2697         ;; still available for the second export step.  Kind of a hack, but
2698         ;; does do the trick.
2699         (if (looking-at "#[^\r\n]*")
2700             (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
2701         (while (re-search-forward "[\n\r]#[^\n\r]*" nil t)
2702           (append-to-buffer buffer (1+ (match-beginning 0))
2703                             (min (point-max) (1+ (match-end 0))))))
2704       (set-buffer buffer)
2705       (let ((buffer-file-name file)
2706             (org-inhibit-startup t))
2707         (org-mode)
2708         (show-all)
2709         (unless keepp (funcall binding arg))))
2710     (if (not keepp)
2711         (kill-buffer buffer)
2712       (switch-to-buffer-other-window buffer)
2713       (goto-char (point-min)))))
2714
2715 (defun org-find-visible ()
2716   (let ((s (point)))
2717     (while (and (not (= (point-max) (setq s (next-overlay-change s))))
2718                 (get-char-property s 'invisible)))
2719     s))
2720 (defun org-find-invisible ()
2721   (let ((s (point)))
2722     (while (and (not (= (point-max) (setq s (next-overlay-change s))))
2723                 (not (get-char-property s 'invisible))))
2724     s))
2725
2726 ;;; HTML export
2727
2728 (defvar org-archive-location)  ;; gets loaded with the org-archive require.
2729 (defun org-get-current-options ()
2730   "Return a string with current options as keyword options.
2731 Does include HTML export options as well as TODO and CATEGORY stuff."
2732   (require 'org-archive)
2733   (format
2734    "#+TITLE:     %s
2735 #+AUTHOR:    %s
2736 #+EMAIL:     %s
2737 #+DATE:      %s
2738 #+DESCRIPTION:
2739 #+KEYWORDS:
2740 #+LANGUAGE:  %s
2741 #+OPTIONS:   H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s
2742 #+OPTIONS:   TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s
2743 %s
2744 #+EXPORT_SELECT_TAGS: %s
2745 #+EXPORT_EXCLUDE_TAGS: %s
2746 #+LINK_UP:   %s
2747 #+LINK_HOME: %s
2748 #+CATEGORY:  %s
2749 #+SEQ_TODO:  %s
2750 #+TYP_TODO:  %s
2751 #+PRIORITIES: %c %c %c
2752 #+DRAWERS:   %s
2753 #+STARTUP:   %s %s %s %s %s
2754 #+TAGS:      %s
2755 #+FILETAGS:  %s
2756 #+ARCHIVE:   %s
2757 #+LINK:      %s
2758 "
2759    (buffer-name) (user-full-name) user-mail-address
2760    (format-time-string (substring (car org-time-stamp-formats) 1 -1))
2761    org-export-default-language
2762    org-export-headline-levels
2763    org-export-with-section-numbers
2764    org-export-with-toc
2765    org-export-preserve-breaks
2766    org-export-html-expand
2767    org-export-with-fixed-width
2768    org-export-with-tables
2769    org-export-with-sub-superscripts
2770    org-export-with-special-strings
2771    org-export-with-footnotes
2772    org-export-with-emphasize
2773    org-export-with-timestamps
2774    org-export-with-TeX-macros
2775    org-export-with-LaTeX-fragments
2776    org-export-skip-text-before-1st-heading
2777    org-export-with-drawers
2778    org-export-with-todo-keywords
2779    org-export-with-priority
2780    org-export-with-tags
2781    (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "")
2782    (mapconcat 'identity org-export-select-tags " ")
2783    (mapconcat 'identity org-export-exclude-tags " ")
2784    org-export-html-link-up
2785    org-export-html-link-home
2786    (or (ignore-errors
2787          (file-name-sans-extension
2788           (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))
2789        "NOFILENAME")
2790    "TODO FEEDBACK VERIFY DONE"
2791    "Me Jason Marie DONE"
2792    org-highest-priority org-lowest-priority org-default-priority
2793    (mapconcat 'identity org-drawers " ")
2794    (cdr (assoc org-startup-folded
2795                '((nil . "showall") (t . "overview") (content . "content"))))
2796    (if org-odd-levels-only "odd" "oddeven")
2797    (if org-hide-leading-stars "hidestars" "showstars")
2798    (if org-startup-align-all-tables "align" "noalign")
2799    (cond ((eq org-log-done t) "logdone")
2800          ((equal org-log-done 'note) "lognotedone")
2801          ((not org-log-done) "nologdone"))
2802    (or (mapconcat (lambda (x)
2803                     (cond
2804                      ((equal '(:startgroup) x) "{")
2805                      ((equal '(:endgroup) x) "}")
2806                      ((cdr x) (format "%s(%c)" (car x) (cdr x)))
2807                      (t (car x))))
2808                   (or org-tag-alist (org-get-buffer-tags)) " ") "")
2809    (mapconcat 'identity org-file-tags " ")
2810    org-archive-location
2811    "org file:~/org/%s.org"
2812    ))
2813
2814 (defun org-export-html-preprocess (parameters)
2815   ;; Convert LaTeX fragments to images
2816   (when (and org-current-export-file
2817              (plist-get parameters :LaTeX-fragments))
2818     (org-format-latex
2819      (concat "ltxpng/" (file-name-sans-extension
2820                         (file-name-nondirectory
2821                          org-current-export-file)))
2822      org-current-export-dir nil "Creating LaTeX image %s"))
2823   (message "Exporting..."))
2824
2825 ;;;###autoload
2826 (defun org-insert-export-options-template ()
2827   "Insert into the buffer a template with information for exporting."
2828   (interactive)
2829   (if (not (bolp)) (newline))
2830   (let ((s (org-get-current-options)))
2831     (and (string-match "#\\+CATEGORY" s)
2832          (setq s (substring s 0 (match-beginning 0))))
2833     (insert s)))
2834
2835 ;;;###autoload
2836 (defun org-export-as-html-and-open (arg)
2837   "Export the outline as HTML and immediately open it with a browser.
2838 If there is an active region, export only the region.
2839 The prefix ARG specifies how many levels of the outline should become
2840 headlines.  The default is 3.  Lower levels will become bulleted lists."
2841   (interactive "P")
2842   (org-export-as-html arg 'hidden)
2843   (org-open-file buffer-file-name))
2844
2845 ;;;###autoload
2846 (defun org-export-as-html-batch ()
2847   "Call `org-export-as-html', may be used in batch processing as
2848 emacs   --batch
2849         --load=$HOME/lib/emacs/org.el
2850         --eval \"(setq org-export-headline-levels 2)\"
2851         --visit=MyFile --funcall org-export-as-html-batch"
2852   (org-export-as-html org-export-headline-levels 'hidden))
2853
2854 ;;;###autoload
2855 (defun org-export-as-html-to-buffer (arg)
2856   "Call `org-export-as-html` with output to a temporary buffer.
2857 No file is created.  The prefix ARG is passed through to `org-export-as-html'."
2858   (interactive "P")
2859   (org-export-as-html arg nil nil "*Org HTML Export*")
2860   (switch-to-buffer-other-window "*Org HTML Export*"))
2861
2862 ;;;###autoload
2863 (defun org-replace-region-by-html (beg end)
2864   "Assume the current region has org-mode syntax, and convert it to HTML.
2865 This can be used in any buffer.  For example, you could write an
2866 itemized list in org-mode syntax in an HTML buffer and then use this
2867 command to convert it."
2868   (interactive "r")
2869   (let (reg html buf pop-up-frames)
2870     (save-window-excursion
2871       (if (org-mode-p)
2872           (setq html (org-export-region-as-html
2873                       beg end t 'string))
2874         (setq reg (buffer-substring beg end)
2875               buf (get-buffer-create "*Org tmp*"))
2876         (with-current-buffer buf
2877           (erase-buffer)
2878           (insert reg)
2879           (org-mode)
2880           (setq html (org-export-region-as-html
2881                       (point-min) (point-max) t 'string)))
2882         (kill-buffer buf)))
2883     (delete-region beg end)
2884     (insert html)))
2885
2886 ;;;###autoload
2887 (defun org-export-region-as-html (beg end &optional body-only buffer)
2888   "Convert region from BEG to END in org-mode buffer to HTML.
2889 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
2890 contents, and only produce the region of converted text, useful for
2891 cut-and-paste operations.
2892 If BUFFER is a buffer or a string, use/create that buffer as a target
2893 of the converted HTML.  If BUFFER is the symbol `string', return the
2894 produced HTML as a string and leave not buffer behind.  For example,
2895 a Lisp program could call this function in the following way:
2896
2897   (setq html (org-export-region-as-html beg end t 'string))
2898
2899 When called interactively, the output buffer is selected, and shown
2900 in a window.  A non-interactive call will only return the buffer."
2901   (interactive "r\nP")
2902   (when (interactive-p)
2903     (setq buffer "*Org HTML Export*"))
2904   (let ((transient-mark-mode t) (zmacs-regions t)
2905         ext-plist rtn)
2906     (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
2907     (goto-char end)
2908     (set-mark (point)) ;; to activate the region
2909     (goto-char beg)
2910     (setq rtn (org-export-as-html
2911                nil nil ext-plist
2912                buffer body-only))
2913     (if (fboundp 'deactivate-mark) (deactivate-mark))
2914     (if (and (interactive-p) (bufferp rtn))
2915         (switch-to-buffer-other-window rtn)
2916       rtn)))
2917
2918 (defvar html-table-tag nil) ; dynamically scoped into this.
2919 (defvar org-par-open nil)
2920 ;;;###autoload
2921 (defun org-export-as-html (arg &optional hidden ext-plist
2922                                to-buffer body-only pub-dir)
2923   "Export the outline as a pretty HTML file.
2924 If there is an active region, export only the region.  The prefix
2925 ARG specifies how many levels of the outline should become
2926 headlines.  The default is 3.  Lower levels will become bulleted
2927 lists.  When HIDDEN is non-nil, don't display the HTML buffer.
2928 EXT-PLIST is a property list with external parameters overriding
2929 org-mode's default settings, but still inferior to file-local
2930 settings.  When TO-BUFFER is non-nil, create a buffer with that
2931 name and export to that buffer.  If TO-BUFFER is the symbol
2932 `string', don't leave any buffer behind but just return the
2933 resulting HTML as a string.  When BODY-ONLY is set, don't produce
2934 the file header and footer, simply return the content of
2935 <body>...</body>, without even the body tags themselves.  When
2936 PUB-DIR is set, use this as the publishing directory."
2937   (interactive "P")
2938
2939   ;; Make sure we have a file name when we need it.
2940   (when (and (not (or to-buffer body-only))
2941              (not buffer-file-name))
2942     (if (buffer-base-buffer)
2943         (org-set-local 'buffer-file-name
2944                        (with-current-buffer (buffer-base-buffer)
2945                          buffer-file-name))
2946       (error "Need a file name to be able to export.")))
2947
2948   (message "Exporting...")
2949   (setq-default org-todo-line-regexp org-todo-line-regexp)
2950   (setq-default org-deadline-line-regexp org-deadline-line-regexp)
2951   (setq-default org-done-keywords org-done-keywords)
2952   (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
2953   (let* ((opt-plist
2954           (org-export-process-option-filters
2955            (org-combine-plists (org-default-export-plist)
2956                                ext-plist
2957                                (org-infile-export-plist))))
2958          (style (concat (if (plist-get opt-plist :style-include-default)
2959                             org-export-html-style-default)
2960                         (plist-get opt-plist :style)
2961                         (plist-get opt-plist :style-extra)
2962                         "\n"
2963                         (if (plist-get opt-plist :style-include-scripts)
2964                             org-export-html-scripts)))
2965          (html-extension (plist-get opt-plist :html-extension))
2966          (link-validate (plist-get opt-plist :link-validation-function))
2967          valid thetoc have-headings first-heading-pos
2968          (odd org-odd-levels-only)
2969          (region-p (org-region-active-p))
2970          (rbeg (and region-p (region-beginning)))
2971          (rend (and region-p (region-end)))
2972          (subtree-p
2973           (if (plist-get opt-plist :ignore-subree-p)
2974               nil
2975             (when region-p
2976               (save-excursion
2977                 (goto-char rbeg)
2978                 (and (org-at-heading-p)
2979                      (>= (org-end-of-subtree t t) rend))))))
2980          (level-offset (if subtree-p
2981                            (save-excursion
2982                              (goto-char rbeg)
2983                              (+ (funcall outline-level)
2984                                 (if org-odd-levels-only 1 0)))
2985                          0))
2986          (opt-plist (setq org-export-opt-plist
2987                           (if subtree-p
2988                               (org-export-add-subtree-options opt-plist rbeg)
2989                             opt-plist)))
2990          ;; The following two are dynamically scoped into other
2991          ;; routines below.
2992          (org-current-export-dir
2993           (or pub-dir (org-export-directory :html opt-plist)))
2994          (org-current-export-file buffer-file-name)
2995          (level 0) (line "") (origline "") txt todo
2996          (umax nil)
2997          (umax-toc nil)
2998          (filename (if to-buffer nil
2999                      (expand-file-name
3000                       (concat
3001                        (file-name-sans-extension
3002                         (or (and subtree-p
3003                                  (org-entry-get (region-beginning)
3004                                                 "EXPORT_FILE_NAME" t))
3005                             (file-name-nondirectory buffer-file-name)))
3006                        "." html-extension)
3007                       (file-name-as-directory
3008                        (or pub-dir (org-export-directory :html opt-plist))))))
3009          (current-dir (if buffer-file-name
3010                           (file-name-directory buffer-file-name)
3011                         default-directory))
3012          (buffer (if to-buffer
3013                      (cond
3014                       ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
3015                       (t (get-buffer-create to-buffer)))
3016                    (find-file-noselect filename)))
3017          (org-levels-open (make-vector org-level-max nil))
3018          (date (plist-get opt-plist :date))
3019          (author      (plist-get opt-plist :author))
3020          (title       (or (and subtree-p (org-export-get-title-from-subtree))
3021                           (plist-get opt-plist :title)
3022                           (and (not
3023                                 (plist-get opt-plist :skip-before-1st-heading))
3024                                (org-export-grab-title-from-buffer))
3025                           (and buffer-file-name
3026                                (file-name-sans-extension
3027                                 (file-name-nondirectory buffer-file-name)))
3028                           "UNTITLED"))
3029          (html-table-tag (plist-get opt-plist :html-table-tag))
3030          (quote-re0   (concat "^[ \t]*" org-quote-string "\\>"))
3031          (quote-re    (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
3032          (inquote     nil)
3033          (infixed     nil)
3034          (inverse     nil)
3035          (in-local-list nil)
3036          (local-list-type nil)
3037          (local-list-indent nil)
3038          (llt org-plain-list-ordered-item-terminator)
3039          (email       (plist-get opt-plist :email))
3040          (language    (plist-get opt-plist :language))
3041          (keywords    (plist-get opt-plist :keywords))
3042          (description (plist-get opt-plist :description))
3043          (lang-words  nil)
3044          (head-count  0) cnt
3045          (start       0)
3046          (coding-system (and (boundp 'buffer-file-coding-system)
3047                              buffer-file-coding-system))
3048          (coding-system-for-write (or org-export-html-coding-system
3049                                       coding-system))
3050          (save-buffer-coding-system (or org-export-html-coding-system
3051                                         coding-system))
3052          (charset (and coding-system-for-write
3053                        (fboundp 'coding-system-get)
3054                        (coding-system-get coding-system-for-write
3055                                           'mime-charset)))
3056          (region
3057           (buffer-substring
3058            (if region-p (region-beginning) (point-min))
3059            (if region-p (region-end) (point-max))))
3060          (lines
3061           (org-split-string
3062            (org-export-preprocess-string
3063             region
3064             :emph-multiline t
3065             :for-html t
3066             :skip-before-1st-heading
3067             (plist-get opt-plist :skip-before-1st-heading)
3068             :drawers (plist-get opt-plist :drawers)
3069             :todo-keywords (plist-get opt-plist :todo-keywords)
3070             :tags (plist-get opt-plist :tags)
3071             :priority (plist-get opt-plist :priority)
3072             :footnotes (plist-get opt-plist :footnotes)
3073             :timestamps (plist-get opt-plist :timestamps)
3074             :archived-trees
3075             (plist-get opt-plist :archived-trees)
3076             :select-tags (plist-get opt-plist :select-tags)
3077             :exclude-tags (plist-get opt-plist :exclude-tags)
3078             :add-text
3079             (plist-get opt-plist :text)
3080             :LaTeX-fragments
3081             (plist-get opt-plist :LaTeX-fragments))
3082            "[\r\n]"))
3083          table-open type
3084          table-buffer table-orig-buffer
3085          ind item-type starter didclose
3086          rpl path attr desc descp desc1 desc2 link
3087          snumber fnc item-tag
3088          footnotes footref-seen
3089          id-file
3090          )
3091
3092     (let ((inhibit-read-only t))
3093       (org-unmodified
3094        (remove-text-properties (point-min) (point-max)
3095                                '(:org-license-to-kill t))))
3096
3097     (message "Exporting...")
3098
3099     (setq org-min-level (org-get-min-level lines level-offset))
3100     (setq org-last-level org-min-level)
3101     (org-init-section-numbers)
3102
3103     (cond
3104      ((and date (string-match "%" date))
3105       (setq date (format-time-string date)))
3106      (date)
3107      (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
3108
3109     ;; Get the language-dependent settings
3110     (setq lang-words (or (assoc language org-export-language-setup)
3111                          (assoc "en" org-export-language-setup)))
3112
3113     ;; Switch to the output buffer
3114     (set-buffer buffer)
3115     (let ((inhibit-read-only t)) (erase-buffer))
3116     (fundamental-mode)
3117
3118     (and (fboundp 'set-buffer-file-coding-system)
3119          (set-buffer-file-coding-system coding-system-for-write))
3120
3121     (let ((case-fold-search nil)
3122           (org-odd-levels-only odd))
3123       ;; create local variables for all options, to make sure all called
3124       ;; functions get the correct information
3125       (mapc (lambda (x)
3126               (set (make-local-variable (nth 2 x))
3127                    (plist-get opt-plist (car x))))
3128             org-export-plist-vars)
3129       (setq umax (if arg (prefix-numeric-value arg)
3130                    org-export-headline-levels))
3131       (setq umax-toc (if (integerp org-export-with-toc)
3132                          (min org-export-with-toc umax)
3133                        umax))
3134       (unless body-only
3135         ;; File header
3136         (insert (format
3137                  "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
3138                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
3139 <html xmlns=\"http://www.w3.org/1999/xhtml\"
3140 lang=\"%s\" xml:lang=\"%s\">
3141 <head>
3142 <title>%s</title>
3143 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
3144 <meta name=\"generator\" content=\"Org-mode\"/>
3145 <meta name=\"generated\" content=\"%s\"/>
3146 <meta name=\"author\" content=\"%s\"/>
3147 <meta name=\"description\" content=\"%s\"/>
3148 <meta name=\"keywords\" content=\"%s\"/>
3149 %s
3150 </head>
3151 <body>
3152 <div id=\"content\">
3153 "
3154                  language language (org-html-expand title)
3155                  (or charset "iso-8859-1")
3156                  date author description keywords
3157                  style))
3158
3159         (insert (or (plist-get opt-plist :preamble) ""))
3160
3161         (when (plist-get opt-plist :auto-preamble)
3162           (if title (insert (format org-export-html-title-format
3163                                     (org-html-expand title))))))
3164
3165       (if (and org-export-with-toc (not body-only))
3166           (progn
3167             (push (format "<h%d>%s</h%d>\n"
3168                           org-export-html-toplevel-hlevel
3169                           (nth 3 lang-words)
3170                           org-export-html-toplevel-hlevel)
3171                   thetoc)
3172             (push "<div id=\"text-table-of-contents\">\n" thetoc)
3173             (push "<ul>\n<li>" thetoc)
3174             (setq lines
3175                   (mapcar '(lambda (line)
3176                     (if (string-match org-todo-line-regexp line)
3177                         ;; This is a headline
3178                         (progn
3179                           (setq have-headings t)
3180                           (setq level (- (match-end 1) (match-beginning 1)
3181                                          level-offset)
3182                                 level (org-tr-level level)
3183                                 txt (save-match-data
3184                                       (org-html-expand
3185                                        (org-export-cleanup-toc-line
3186                                         (match-string 3 line))))
3187                                 todo
3188                                 (or (and org-export-mark-todo-in-toc
3189                                          (match-beginning 2)
3190                                          (not (member (match-string 2 line)
3191                                                       org-done-keywords)))
3192                                         ; TODO, not DONE
3193                                     (and org-export-mark-todo-in-toc
3194                                          (= level umax-toc)
3195                                          (org-search-todo-below
3196                                           line lines level))))
3197                           (if (string-match
3198                                (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
3199                               (setq txt (replace-match  "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
3200                           (if (string-match quote-re0 txt)
3201                               (setq txt (replace-match "" t t txt)))
3202                           (setq snumber (org-section-number level))
3203                           (if org-export-with-section-numbers
3204                               (setq txt (concat snumber " " txt)))
3205                           (if (<= level (max umax umax-toc))
3206                               (setq head-count (+ head-count 1)))
3207                           (if (<= level umax-toc)
3208                               (progn
3209                                 (if (> level org-last-level)
3210                                     (progn
3211                                       (setq cnt (- level org-last-level))
3212                                       (while (>= (setq cnt (1- cnt)) 0)
3213                                         (push "\n<ul>\n<li>" thetoc))
3214                                       (push "\n" thetoc)))
3215                                 (if (< level org-last-level)
3216                                     (progn
3217                                       (setq cnt (- org-last-level level))
3218                                       (while (>= (setq cnt (1- cnt)) 0)
3219                                         (push "</li>\n</ul>" thetoc))
3220                                       (push "\n" thetoc)))
3221                                 ;; Check for targets
3222                                 (while (string-match org-any-target-regexp line)
3223                                   (setq line (replace-match
3224                                               (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
3225                                               t t line)))
3226                                 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
3227                                   (setq txt (replace-match "" t t txt)))
3228                                 (push
3229                                  (format
3230                                   (if todo
3231                                       "</li>\n<li><a href=\"#sec-%s\"><span class=\"todo\">%s</span></a>"
3232                                     "</li>\n<li><a href=\"#sec-%s\">%s</a>")
3233                                   snumber txt) thetoc)
3234
3235                                 (setq org-last-level level))
3236                             )))
3237                     line)
3238                           lines))
3239             (while (> org-last-level (1- org-min-level))
3240               (setq org-last-level (1- org-last-level))
3241               (push "</li>\n</ul>\n" thetoc))
3242             (push "</div>\n" thetoc)
3243             (setq thetoc (if have-headings (nreverse thetoc) nil))))
3244
3245       (setq head-count 0)
3246       (org-init-section-numbers)
3247
3248       (org-open-par)
3249
3250       (while (setq line (pop lines) origline line)
3251         (catch 'nextline
3252
3253           ;; end of quote section?
3254           (when (and inquote (string-match "^\\*+ " line))
3255             (insert "</pre>\n")
3256             (setq inquote nil))
3257           ;; inside a quote section?
3258           (when inquote
3259             (insert (org-html-protect line) "\n")
3260             (throw 'nextline nil))
3261
3262           ;; Fixed-width, verbatim lines (examples)
3263           (when (and org-export-with-fixed-width
3264                      (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
3265             (when (not infixed)
3266               (setq infixed t)
3267               (org-close-par-maybe)
3268
3269               (insert "<pre class=\"example\">\n"))
3270             (insert (org-html-protect (match-string 3 line)) "\n")
3271             (when (or (not lines)
3272                       (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
3273                                          (car lines))))
3274               (setq infixed nil)
3275               (insert "</pre>\n"))
3276             (throw 'nextline nil))
3277
3278           ;; Protected HTML
3279           (when (get-text-property 0 'org-protected line)
3280             (let (par)
3281               (when (re-search-backward
3282                      "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
3283                 (setq par (match-string 1))
3284                 (replace-match "\\2\n"))
3285               (insert line "\n")
3286               (while (and lines
3287                           (or (= (length (car lines)) 0)
3288                               (get-text-property 0 'org-protected (car lines))))
3289                 (insert (pop lines) "\n"))
3290               (and par (insert "<p>\n")))
3291             (throw 'nextline nil))
3292
3293           ;; Horizontal line
3294           (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
3295             (if org-par-open
3296                 (insert "\n</p>\n<hr/>\n<p>\n")
3297               (insert "\n<hr/>\n"))
3298             (throw 'nextline nil))
3299
3300           ;; Blockquotes, verse, and center
3301           (when (equal "ORG-BLOCKQUOTE-START" line)
3302             (org-close-par-maybe)
3303             (insert "<blockquote>\n")
3304             (org-open-par)
3305             (throw 'nextline nil))
3306           (when (equal "ORG-BLOCKQUOTE-END" line)
3307             (org-close-par-maybe)
3308             (insert "\n</blockquote>\n")
3309             (throw 'nextline nil))
3310           (when (equal "ORG-VERSE-START" line)
3311             (org-close-par-maybe)
3312             (insert "\n<p class=\"verse\">\n")
3313             (setq inverse t)
3314             (throw 'nextline nil))
3315           (when (equal "ORG-VERSE-END" line)
3316             (insert "</p>\n")
3317             (setq inverse nil)
3318             (throw 'nextline nil))
3319           (when (equal "ORG-CENTER-START" line)
3320             (org-close-par-maybe)
3321             (insert "\n<div style=\"text-align: center\">")
3322             (org-open-par)
3323             (throw 'nextline nil))
3324           (when (equal "ORG-CENTER-END" line)
3325             (org-close-par-maybe)
3326             (insert "\n</div>")
3327             (throw 'nextline nil))
3328           (when inverse
3329             (let ((i (org-get-string-indentation line)))
3330               (if (> i 0)
3331                   (setq line (concat (mapconcat 'identity
3332                                                 (make-list (* 2 i) "\\nbsp") "")
3333                                      " " (org-trim line))))
3334               (unless (string-match "\\\\\\\\[ \t]*$" line)
3335                 (setq line (concat line "\\\\")))))
3336
3337           ;; make targets to anchors
3338           (while (string-match
3339                   "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
3340             (cond
3341              ((match-end 2)
3342               (setq line (replace-match
3343                           (format
3344                            "@<a name=\"%s\" id=\"%s\">@</a>"
3345                            (org-solidify-link-text (match-string 1 line))
3346                            (org-solidify-link-text (match-string 1 line)))
3347                           t t line)))
3348              ((and org-export-with-toc (equal (string-to-char line) ?*))
3349               ;; FIXME: NOT DEPENDENT on TOC?????????????????????
3350               (setq line (replace-match
3351                           (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
3352 ;                         (concat "@<i>" (match-string 1 line) "@</i> ")
3353                           t t line)))
3354              (t
3355               (setq line (replace-match
3356                           (concat "@<a name=\""
3357                                   (org-solidify-link-text (match-string 1 line))
3358                                   "\" class=\"target\">" (match-string 1 line) "@</a> ")
3359                           t t line)))))
3360
3361           (setq line (org-html-handle-time-stamps line))
3362
3363           ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
3364           ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
3365           ;; Also handle sub_superscripts and checkboxes
3366           (or (string-match org-table-hline-regexp line)
3367               (setq line (org-html-expand line)))
3368
3369           ;; Format the links
3370           (setq start 0)
3371           (while (string-match org-bracket-link-analytic-regexp++ line start)
3372             (setq start (match-beginning 0))
3373             (setq path (save-match-data (org-link-unescape
3374                                          (match-string 3 line))))
3375             (setq type (cond
3376                         ((match-end 2) (match-string 2 line))
3377                         ((save-match-data
3378                            (or (file-name-absolute-p path)
3379                                (string-match "^\\.\\.?/" path)))
3380                          "file")
3381                         (t "internal")))
3382             (setq path (org-extract-attributes (org-link-unescape path)))
3383             (setq attr (get-text-property 0 'org-attributes path))
3384             (setq desc1 (if (match-end 5) (match-string 5 line))
3385                   desc2 (if (match-end 2) (concat type ":" path) path)
3386                   descp (and desc1 (not (equal desc1 desc2)))
3387                   desc (or desc1 desc2))
3388             ;; Make an image out of the description if that is so wanted
3389             (when (and descp (org-file-image-p
3390                               desc org-export-html-inline-image-extensions))
3391               (save-match-data
3392                 (if (string-match "^file:" desc)
3393                     (setq desc (substring desc (match-end 0)))))
3394               (setq desc (org-add-props
3395                              (concat "<img src=\"" desc "\"/>")
3396                              '(org-protected t))))
3397             ;; FIXME: do we need to unescape here somewhere?
3398             (cond
3399              ((equal type "internal")
3400               (setq rpl
3401                     (concat
3402                      "<a href=\""
3403                      (if (= (string-to-char path) ?#) "" "#")
3404                      (org-solidify-link-text
3405                       (save-match-data (org-link-unescape path)) nil)
3406                      "\"" attr ">"
3407                      (org-export-html-format-desc desc)
3408                      "</a>")))
3409              ((and (equal type "id")
3410                    (setq id-file (org-id-find-id-file path)))
3411               ;; This is an id: link to another file (if it was the same file,
3412               ;; it would have become an internal link...)
3413               (setq id-file (file-relative-name
3414                              id-file (file-name-directory org-current-export-file)))
3415               (setq id-file (concat (file-name-sans-extension id-file)
3416                                     "." html-extension))
3417               (setq rpl (concat "<a href=\"" id-file "#"
3418                                 (if (org-uuidgen-p path) "ID-")
3419                                 path "\""
3420                                 attr ">"
3421                                 (org-export-html-format-desc desc)
3422                                 "</a>")))
3423              ((member type '("http" "https"))
3424               ;; standard URL, just check if we need to inline an image
3425               (if (and (or (eq t org-export-html-inline-images)
3426                            (and org-export-html-inline-images (not descp)))
3427                        (org-file-image-p
3428                         path org-export-html-inline-image-extensions))
3429                   (setq rpl (org-export-html-format-image
3430                              (concat type ":" path) org-par-open))
3431                 (setq link (concat type ":" path))
3432                 (setq rpl (concat "<a href=\""
3433                                   (org-export-html-format-href link)
3434                                   "\"" attr ">"
3435                                   (org-export-html-format-desc desc)
3436                                   "</a>"))))
3437              ((member type '("ftp" "mailto" "news"))
3438               ;; standard URL
3439               (setq link (concat type ":" path))
3440               (setq rpl (concat "<a href=\""
3441                                 (org-export-html-format-href link)
3442                                 "\"" attr ">"
3443                                 (org-export-html-format-desc desc)
3444                                 "</a>")))
3445
3446              ((string= type "coderef")
3447
3448               (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
3449                                 path path path
3450                                 (format (org-export-get-coderef-format path (and descp desc))
3451                                         (cdr (assoc path org-export-code-refs))))))
3452
3453              ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
3454               ;; The link protocol has a function for format the link
3455               (setq rpl
3456                     (save-match-data
3457                       (funcall fnc (org-link-unescape path) desc1 'html))))
3458
3459              ((string= type "file")
3460               ;; FILE link
3461               (let* ((filename path)
3462                      (abs-p (file-name-absolute-p filename))
3463                      thefile file-is-image-p search)
3464                 (save-match-data
3465                   (if (string-match "::\\(.*\\)" filename)
3466                       (setq search (match-string 1 filename)
3467                             filename (replace-match "" t nil filename)))
3468                   (setq valid
3469                         (if (functionp link-validate)
3470                             (funcall link-validate filename current-dir)
3471                           t))
3472                   (setq file-is-image-p
3473                         (org-file-image-p
3474                          filename org-export-html-inline-image-extensions))
3475                   (setq thefile (if abs-p (expand-file-name filename) filename))
3476                   (when (and org-export-html-link-org-files-as-html
3477                              (string-match "\\.org$" thefile))
3478                     (setq thefile (concat (substring thefile 0
3479                                                      (match-beginning 0))
3480                                           "." html-extension))
3481                     (if (and search
3482                              ;; make sure this is can be used as target search
3483                              (not (string-match "^[0-9]*$" search))
3484                              (not (string-match "^\\*" search))
3485                              (not (string-match "^/.*/$" search)))
3486                         (setq thefile (concat thefile "#"
3487                                               (org-solidify-link-text
3488                                                (org-link-unescape search)))))
3489                     (when (string-match "^file:" desc)
3490                       (setq desc (replace-match "" t t desc))
3491                       (if (string-match "\\.org$" desc)
3492                           (setq desc (replace-match "" t t desc))))))
3493                 (setq rpl (if (and file-is-image-p
3494                                    (or (eq t org-export-html-inline-images)
3495                                        (and org-export-html-inline-images
3496                                             (not descp))))
3497                               (progn
3498                                 (message "image %s %s" thefile org-par-open)
3499                                 (org-export-html-format-image thefile org-par-open))
3500                             (concat "<a href=\"" thefile "\"" attr ">"
3501                                     (org-export-html-format-desc desc)
3502                                     "</a>")))
3503                 (if (not valid) (setq rpl desc))))
3504
3505              (t
3506               ;; just publish the path, as default
3507               (setq rpl (concat "<i>&lt;" type ":"
3508                                 (save-match-data (org-link-unescape path))
3509                                 "&gt;</i>"))))
3510             (setq line (replace-match rpl t t line)
3511                   start (+ start (length rpl))))
3512
3513           ;; TODO items
3514           (if (and (string-match org-todo-line-regexp line)
3515                    (match-beginning 2))
3516
3517               (setq line
3518                     (concat (substring line 0 (match-beginning 2))
3519                             "<span class=\""
3520                             (if (member (match-string 2 line)
3521                                         org-done-keywords)
3522                                 "done" "todo")
3523                             " " (match-string 2 line)
3524                             "\"> " (org-export-html-get-todo-kwd-class-name
3525                                     (match-string 2 line))
3526                             "</span>" (substring line (match-end 2)))))
3527
3528           ;; Does this contain a reference to a footnote?
3529           (when org-export-with-footnotes
3530             (setq start 0)
3531             (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
3532               (if (get-text-property (match-beginning 2) 'org-protected line)
3533                   (setq start (match-end 2))
3534                 (let ((n (match-string 2 line)) extra a)
3535                   (if (setq a (assoc n footref-seen))
3536                       (progn
3537                         (setcdr a (1+ (cdr a)))
3538                         (setq extra (format ".%d" (cdr a))))
3539                     (setq extra "")
3540                     (push (cons n 1) footref-seen))
3541                   (setq line
3542                         (replace-match
3543                          (format
3544                           "%s<sup><a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a></sup>"
3545                           (match-string 1 line) n extra n n)
3546                          t t line))))))
3547
3548           (cond
3549            ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
3550             ;; This is a headline
3551             (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
3552                                          level-offset))
3553                   txt (match-string 2 line))
3554             (if (string-match quote-re0 txt)
3555                 (setq txt (replace-match "" t t txt)))
3556             (if (<= level (max umax umax-toc))
3557                 (setq head-count (+ head-count 1)))
3558             (when in-local-list
3559               ;; Close any local lists before inserting a new header line
3560               (while local-list-type
3561                 (org-close-li (car local-list-type))
3562                 (insert (format "</%sl>\n" (car local-list-type)))
3563                 (pop local-list-type))
3564               (setq local-list-indent nil
3565                     in-local-list nil))
3566             (setq first-heading-pos (or first-heading-pos (point)))
3567             (org-html-level-start level txt umax
3568                                   (and org-export-with-toc (<= level umax))
3569                                   head-count)
3570
3571             ;; QUOTES
3572             (when (string-match quote-re line)
3573               (org-close-par-maybe)
3574               (insert "<pre>")
3575               (setq inquote t)))
3576
3577            ((string-match "^[ \t]*- __+[ \t]*$" line)
3578             ;; Explicit list closure
3579             (when local-list-type
3580               (let ((ind (org-get-indentation line)))
3581                 (while (and local-list-indent
3582                             (<= ind (car local-list-indent)))
3583                   (org-close-li (car local-list-type))
3584                   (insert (format "</%sl>\n" (car local-list-type)))
3585                   (pop local-list-type)
3586                   (pop local-list-indent))
3587                 (or local-list-indent (setq in-local-list nil))))
3588             (throw 'nextline nil))
3589
3590            ((and org-export-with-tables
3591                  (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
3592             (when (not table-open)
3593               ;; New table starts
3594               (setq table-open t table-buffer nil table-orig-buffer nil))
3595
3596             ;; Accumulate lines
3597             (setq table-buffer (cons line table-buffer)
3598                   table-orig-buffer (cons origline table-orig-buffer))
3599             (when (or (not lines)
3600                       (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
3601                                          (car lines))))
3602               (setq table-open nil
3603                     table-buffer (nreverse table-buffer)
3604                     table-orig-buffer (nreverse table-orig-buffer))
3605               (org-close-par-maybe)
3606               (insert (org-format-table-html table-buffer table-orig-buffer))))
3607            (t
3608             ;; Normal lines
3609             (when (string-match
3610                    (cond
3611                     ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3612                     ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3613                     ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3614                     (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
3615                    line)
3616               (setq ind (org-get-string-indentation line)
3617                     item-type (if (match-beginning 4) "o" "u")
3618                     starter (if (match-beginning 2)
3619                                 (substring (match-string 2 line) 0 -1))
3620                     line (substring line (match-beginning 5))
3621                     item-tag nil)
3622               (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
3623                   (setq item-type "d"
3624                         item-tag (match-string 1 line)
3625                         line (substring line (match-end 0))))
3626               (when (and (not (equal item-type "d"))
3627                          (not (string-match "[^ \t]" line)))
3628                 ;; empty line.  Pretend indentation is large.
3629                 (setq ind (if org-empty-line-terminates-plain-lists
3630                               0
3631                             (1+ (or (car local-list-indent) 1)))))
3632               (setq didclose nil)
3633               (while (and in-local-list
3634                           (or (and (= ind (car local-list-indent))
3635                                    (not starter))
3636                               (< ind (car local-list-indent))))
3637                 (setq didclose t)
3638                 (org-close-li (car local-list-type))
3639                 (insert (format "</%sl>\n" (car local-list-type)))
3640                 (pop local-list-type) (pop local-list-indent)
3641                 (setq in-local-list local-list-indent))
3642               (cond
3643                ((and starter
3644                      (or (not in-local-list)
3645                          (> ind (car local-list-indent))))
3646                 ;; Start new (level of) list
3647                 (org-close-par-maybe)
3648                 (insert (cond
3649                          ((equal item-type "u") "<ul>\n<li>\n")
3650                          ((equal item-type "o") "<ol>\n<li>\n")
3651                          ((equal item-type "d")
3652                           (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
3653                 (push item-type local-list-type)
3654                 (push ind local-list-indent)
3655                 (setq in-local-list t))
3656                (starter
3657                 ;; continue current list
3658                 (org-close-li (car local-list-type))
3659                 (insert (cond
3660                          ((equal (car local-list-type) "d")
3661                           (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
3662                          (t "<li>\n"))))
3663                (didclose
3664                 ;; we did close a list, normal text follows: need <p>
3665                 (org-open-par)))
3666               (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
3667                   (setq line
3668                         (replace-match
3669                          (if (equal (match-string 1 line) "X")
3670                              "<b>[X]</b>"
3671                            "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
3672                            t t line))))
3673
3674             ;; Empty lines start a new paragraph.  If hand-formatted lists
3675             ;; are not fully interpreted, lines starting with "-", "+", "*"
3676             ;; also start a new paragraph.
3677             (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
3678
3679             ;; Is this the start of a footnote?
3680             (when org-export-with-footnotes
3681               (when (and (boundp 'footnote-section-tag-regexp)
3682                          (string-match (concat "^" footnote-section-tag-regexp)
3683                                        line))
3684                 ;; ignore this line
3685                 (throw 'nextline nil))
3686               (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
3687                 (org-close-par-maybe)
3688                 (let ((n (match-string 1 line)))
3689                   (setq org-par-open t
3690                         line (replace-match
3691                               (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line)))))
3692
3693             ;; Check if the line break needs to be conserved
3694             (cond
3695              ((string-match "\\\\\\\\[ \t]*$" line)
3696               (setq line (replace-match "<br/>" t t line)))
3697              (org-export-preserve-breaks
3698               (setq line (concat line "<br/>"))))
3699
3700             ;; Check if a paragraph should be started
3701             (let ((start 0))
3702               (while (and org-par-open
3703                           (string-match "\\\\par\\>" line start))
3704                 ;; Leave a space in the </p> so that the footnote matcher
3705                 ;; does not see this.
3706                 (if (not (get-text-property (match-beginning 0)
3707                                             'org-protected line))
3708                     (setq line (replace-match "</p ><p >" t t line)))
3709                 (setq start (match-end 0))))
3710
3711             (insert line "\n")))))
3712
3713       ;; Properly close all local lists and other lists
3714       (when inquote
3715         (insert "</pre>\n")
3716         (org-open-par))
3717       (when in-local-list
3718         ;; Close any local lists before inserting a new header line
3719         (while local-list-type
3720           (org-close-li (car local-list-type))
3721           (insert (format "</%sl>\n" (car local-list-type)))
3722           (pop local-list-type))
3723         (setq local-list-indent nil
3724               in-local-list nil))
3725       (org-html-level-start 1 nil umax
3726                             (and org-export-with-toc (<= level umax))
3727                             head-count)
3728       ;; the </div> to close the last text-... div.
3729       (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
3730
3731       (save-excursion
3732         (goto-char (point-min))
3733         (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
3734           (push (match-string 0) footnotes)
3735           (replace-match "" t t)))
3736       (when footnotes
3737         (insert (format org-export-html-footnotes-section
3738                         (or (nth 4 lang-words) "Footnotes")
3739                         (mapconcat 'identity (nreverse footnotes) "\n"))
3740                 "\n"))
3741       (let ((bib (org-export-html-get-bibliography)))
3742         (when bib
3743           (insert "\n" bib "\n")))
3744       (unless body-only
3745         (when (plist-get opt-plist :auto-postamble)
3746           (insert "<div id=\"postamble\">\n")
3747           (when (and org-export-author-info author)
3748             (insert "<p class=\"author\"> "
3749                     (nth 1 lang-words) ": " author "\n")
3750             (when email
3751               (if (listp (split-string email ",+ *"))
3752                   (mapc (lambda(e)
3753                           (insert "<a href=\"mailto:" e "\">&lt;"
3754                                   e "&gt;</a>\n"))
3755                         (split-string email ",+ *"))
3756                 (insert "<a href=\"mailto:" email "\">&lt;"
3757                         email "&gt;</a>\n")))
3758             (insert "</p>\n"))
3759           (when (and date org-export-time-stamp-file)
3760             (insert "<p class=\"date\"> "
3761                     (nth 2 lang-words) ": "
3762                     date "</p>\n"))
3763           (when org-export-creator-info
3764             (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n"
3765                             org-version emacs-major-version)))
3766           (when org-export-html-validation-link
3767             (insert org-export-html-validation-link "\n"))
3768           (insert "</div>"))
3769
3770         (if org-export-html-with-timestamp
3771             (insert org-export-html-html-helper-timestamp))
3772         (insert (or (plist-get opt-plist :postamble) ""))
3773         (insert "\n</div>\n</body>\n</html>\n"))
3774
3775       (unless (plist-get opt-plist :buffer-will-be-killed)
3776         (normal-mode)
3777         (if (eq major-mode default-major-mode) (html-mode)))
3778
3779       ;; insert the table of contents
3780       (goto-char (point-min))
3781       (when thetoc
3782         (if (or (re-search-forward
3783                  "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
3784                 (re-search-forward
3785                  "\\[TABLE-OF-CONTENTS\\]" nil t))
3786             (progn
3787               (goto-char (match-beginning 0))
3788               (replace-match ""))
3789           (goto-char first-heading-pos)
3790           (when (looking-at "\\s-*</p>")
3791             (goto-char (match-end 0))
3792             (insert "\n")))
3793         (insert "<div id=\"table-of-contents\">\n")
3794         (mapc 'insert thetoc)
3795         (insert "</div>\n"))
3796       ;; remove empty paragraphs and lists
3797       (goto-char (point-min))
3798       (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
3799         (replace-match ""))
3800       (goto-char (point-min))
3801       (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
3802         (replace-match ""))
3803       (goto-char (point-min))
3804       (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
3805         (replace-match ""))
3806       ;; Convert whitespace place holders
3807       (goto-char (point-min))
3808       (let (beg end n)
3809         (while (setq beg (next-single-property-change (point) 'org-whitespace))
3810           (setq n (get-text-property beg 'org-whitespace)
3811                 end (next-single-property-change beg 'org-whitespace))
3812           (goto-char beg)
3813           (delete-region beg end)
3814           (insert (format "<span style=\"visibility:hidden;\">%s</span>"
3815                           (make-string n ?x)))))
3816       (or to-buffer (save-buffer))
3817       (goto-char (point-min))
3818       (message "Exporting... done")
3819       (if (eq to-buffer 'string)
3820           (prog1 (buffer-substring (point-min) (point-max))
3821             (kill-buffer (current-buffer)))
3822         (current-buffer)))))
3823
3824 (defun org-export-get-coderef-format (path desc)
3825   (save-match-data
3826     (if (and desc (string-match
3827                    (regexp-quote (concat "(" path ")"))
3828                    desc))
3829         (replace-match "%s" t t desc)
3830       "%s")))
3831
3832
3833 (defun org-export-html-format-href (s)
3834   "Make sure the S is valid as a href reference in an XHTML document."
3835   (save-match-data
3836     (let ((start 0))
3837       (while (string-match "&" s start)
3838         (setq start (+ (match-beginning 0) 3)
3839               s (replace-match "&amp;" t t s)))))
3840   s)
3841
3842 (defun org-export-html-format-desc (s)
3843   "Make sure the S is valid as a description in a link."
3844   (if (and s (not (get-text-property 1 'org-protected s)))
3845       (save-match-data
3846         (org-html-do-expand s))
3847     s))
3848
3849 (defun org-export-html-format-image (src par-open)
3850   "Create image tag with source and attributes."
3851   (save-match-data
3852     (if (string-match "^ltxpng/" src)
3853         (format "<img src=\"%s\"/>" src)
3854       (let* ((caption (org-find-text-property-in-string 'org-caption src))
3855              (attr (org-find-text-property-in-string 'org-attributes src))
3856              (label (org-find-text-property-in-string 'org-label src)))
3857         (format "%s<div %sclass=\"figure\">
3858 <p><img src=\"%s\"%s /></p>%s
3859 </div>%s"
3860                 (if org-par-open "</p>\n" "")
3861                 (if label (format "id=\"%s\" " label) "")
3862                 src
3863                 (if (string-match "\\<alt=" (or attr ""))
3864                     (concat " " attr )
3865                   (concat " " attr " alt=\"" src "\""))
3866                 (if caption (concat "\n<p>" caption "</p>") "")
3867                 (if org-par-open "\n<p>" ""))))))
3868
3869 (defun org-export-html-get-bibliography ()
3870   "Find bibliography, cut it out and return it."
3871   (catch 'exit
3872     (let (beg end (cnt 1) bib)
3873       (save-excursion
3874         (goto-char (point-min))
3875         (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
3876           (setq beg (match-beginning 0))
3877           (while (re-search-forward "</?div\\>" nil t)
3878             (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
3879             (when (= cnt 0)
3880               (and (looking-at ">") (forward-char 1))
3881               (setq bib (buffer-substring beg (point)))
3882               (delete-region beg (point))
3883             (throw 'exit bib))))
3884         nil))))
3885
3886 (defvar org-table-colgroup-info nil)
3887
3888 (defvar org-table-number-regexp) ; defined in org-table.el
3889 (defun org-format-table-html (lines olines)
3890   "Find out which HTML converter to use and return the HTML code."
3891   (if (stringp lines)
3892       (setq lines (org-split-string lines "\n")))
3893   (if (string-match "^[ \t]*|" (car lines))
3894       ;; A normal org table
3895       (org-format-org-table-html lines)
3896     ;; Table made by table.el - test for spanning
3897     (let* ((hlines (delq nil (mapcar
3898                               (lambda (x)
3899                                 (if (string-match "^[ \t]*\\+-" x) x
3900                                   nil))
3901                               lines)))
3902            (first (car hlines))
3903            (ll (and (string-match "\\S-+" first)
3904                     (match-string 0 first)))
3905            (re (concat "^[ \t]*" (regexp-quote ll)))
3906            (spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
3907                                        hlines))))
3908       (if (and (not spanning)
3909                (not org-export-prefer-native-exporter-for-tables))
3910           ;; We can use my own converter with HTML conversions
3911           (org-format-table-table-html lines)
3912         ;; Need to use the code generator in table.el, with the original text.
3913         (org-format-table-table-html-using-table-generate-source olines)))))
3914
3915 (defvar org-table-number-fraction) ; defined in org-table.el
3916 (defun org-format-org-table-html (lines &optional splice)
3917   "Format a table into HTML."
3918   (require 'org-table)
3919   ;; Get rid of hlines at beginning and end
3920   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
3921   (setq lines (nreverse lines))
3922   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
3923   (setq lines (nreverse lines))
3924   (when org-export-table-remove-special-lines
3925     ;; Check if the table has a marking column.  If yes remove the
3926     ;; column and the special lines
3927     (setq lines (org-table-clean-before-export lines)))
3928
3929   (let* ((caption (or (get-text-property 0 'org-caption (car lines))
3930                       (get-text-property (or (next-single-property-change
3931                                               0 'org-caption (car lines))
3932                                              0)
3933                                          'org-caption (car lines))))
3934          (attributes (or (get-text-property 0 'org-attributes (car lines))
3935                          (get-text-property (or (next-single-property-change
3936                                                  0 'org-attributes (car lines))
3937                                                 0)
3938                                             'org-attributes (car lines))))
3939          (html-table-tag (org-export-splice-attributes
3940                           html-table-tag attributes))
3941          (head (and org-export-highlight-first-table-line
3942                     (delq nil (mapcar
3943                                (lambda (x) (string-match "^[ \t]*|-" x))
3944                                (cdr lines)))))
3945
3946          (nlines 0) fnum i
3947          tbopen line fields html gr colgropen)
3948     (if splice (setq head nil))
3949     (unless splice (push (if head "<thead>" "<tbody>") html))
3950     (setq tbopen t)
3951     (while (setq line (pop lines))
3952       (catch 'next-line
3953         (if (string-match "^[ \t]*|-" line)
3954             (progn
3955               (unless splice
3956                 (push (if head "</thead>" "</tbody>") html)
3957                 (if lines (push "<tbody>" html) (setq tbopen nil)))
3958               (setq head nil)   ;; head ends here, first time around
3959               ;; ignore this line
3960               (throw 'next-line t)))
3961         ;; Break the line into fields
3962         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
3963         (unless fnum (setq fnum (make-vector (length fields) 0)))
3964         (setq nlines (1+ nlines) i -1)
3965         (push (concat "<tr>"
3966                       (mapconcat
3967                        (lambda (x)
3968                          (setq i (1+ i))
3969                          (if (and (< i nlines)
3970                                   (string-match org-table-number-regexp x))
3971                              (incf (aref fnum i)))
3972                          (if head
3973                              (concat (car org-export-table-header-tags) x
3974                                      (cdr org-export-table-header-tags))
3975                            (concat (car org-export-table-data-tags) x
3976                                    (cdr org-export-table-data-tags))))
3977                        fields "")
3978                       "</tr>")
3979               html)))
3980     (unless splice (if tbopen (push "</tbody>" html)))
3981     (unless splice (push "</table>\n" html))
3982     (setq html (nreverse html))
3983     (unless splice
3984       ;; Put in col tags with the alignment (unfortunately often ignored...)
3985       (push (mapconcat
3986              (lambda (x)
3987                (setq gr (pop org-table-colgroup-info))
3988                (format "%s<col align=\"%s\"></col>%s"
3989                        (if (memq gr '(:start :startend))
3990                            (prog1
3991                                (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
3992                              (setq colgropen t))
3993                          "")
3994                        (if (> (/ (float x) nlines) org-table-number-fraction)
3995                            "right" "left")
3996                        (if (memq gr '(:end :startend))
3997                            (progn (setq colgropen nil) "</colgroup>")
3998                          "")))
3999              fnum "")
4000             html)
4001       (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
4002       ;; Since the output of HTML table formatter can also be used in
4003       ;; DocBook document, we want to always include the caption to make
4004       ;; DocBook XML file valid.
4005       (push (format "<caption>%s</caption>" (or caption "")) html)
4006       (push html-table-tag html))
4007     (concat (mapconcat 'identity html "\n") "\n")))
4008
4009 (defun org-export-splice-attributes (tag attributes)
4010   "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
4011   (if (not attributes)
4012       tag
4013     (let (oldatt newatt)
4014       (setq oldatt (org-extract-attributes-from-string tag)
4015             tag (pop oldatt)
4016             newatt (cdr (org-extract-attributes-from-string attributes)))
4017       (while newatt
4018         (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
4019       (if (string-match ">" tag)
4020           (setq tag
4021                 (replace-match (concat (org-attributes-to-string oldatt) ">")
4022                                t t tag)))
4023       tag)))
4024
4025 (defun org-table-clean-before-export (lines &optional maybe-quoted)
4026   "Check if the table has a marking column.
4027 If yes remove the column and the special lines."
4028   (setq org-table-colgroup-info nil)
4029   (if (memq nil
4030             (mapcar
4031              (lambda (x) (or (string-match "^[ \t]*|-" x)
4032                              (string-match
4033                               (if maybe-quoted
4034                                   "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|"
4035                                 "^[ \t]*| *\\([\#!$*_^ /]\\) *|")
4036                               x)))
4037              lines))
4038       (progn
4039         (setq org-table-clean-did-remove-column nil)
4040         (delq nil
4041               (mapcar
4042                (lambda (x)
4043                  (cond
4044                   ((string-match  "^[ \t]*| */ *|" x)
4045                    (setq org-table-colgroup-info
4046                          (mapcar (lambda (x)
4047                                    (cond ((member x '("<" "&lt;")) :start)
4048                                          ((member x '(">" "&gt;")) :end)
4049                                          ((member x '("<>" "&lt;&gt;")) :startend)
4050                                          (t nil)))
4051                                  (org-split-string x "[ \t]*|[ \t]*")))
4052                    nil)
4053                   (t x)))
4054                lines)))
4055     (setq org-table-clean-did-remove-column t)
4056     (delq nil
4057           (mapcar
4058            (lambda (x)
4059              (cond
4060               ((string-match  "^[ \t]*| */ *|" x)
4061                (setq org-table-colgroup-info
4062                      (mapcar (lambda (x)
4063                                (cond ((member x '("<" "&lt;")) :start)
4064                                      ((member x '(">" "&gt;")) :end)
4065                                      ((member x '("<>" "&lt;&gt;")) :startend)
4066                                      (t nil)))
4067                              (cdr (org-split-string x "[ \t]*|[ \t]*"))))
4068                nil)
4069               ((string-match "^[ \t]*| *[!_^/] *|" x)
4070                nil) ; ignore this line
4071               ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
4072                    (string-match "^\\([ \t]*\\)|[^|]*|" x))
4073                ;; remove the first column
4074                (replace-match "\\1|" t nil x))))
4075            lines))))
4076
4077 (defun org-format-table-table-html (lines)
4078   "Format a table generated by table.el into HTML.
4079 This conversion does *not* use `table-generate-source' from table.el.
4080 This has the advantage that Org-mode's HTML conversions can be used.
4081 But it has the disadvantage, that no cell- or row-spanning is allowed."
4082   (let (line field-buffer
4083              (head org-export-highlight-first-table-line)
4084              fields html empty)
4085     (setq html (concat html-table-tag "\n"))
4086     (while (setq line (pop lines))
4087       (setq empty "&nbsp;")
4088       (catch 'next-line
4089         (if (string-match "^[ \t]*\\+-" line)
4090             (progn
4091               (if field-buffer
4092                   (progn
4093                     (setq
4094                      html
4095                      (concat
4096                       html
4097                       "<tr>"
4098                       (mapconcat
4099                        (lambda (x)
4100                          (if (equal x "") (setq x empty))
4101                          (if head
4102                              (concat (car org-export-table-header-tags) x
4103                                      (cdr org-export-table-header-tags))
4104                            (concat (car org-export-table-data-tags) x
4105                                    (cdr org-export-table-data-tags))))
4106                        field-buffer "\n")
4107                       "</tr>\n"))
4108                     (setq head nil)
4109                     (setq field-buffer nil)))
4110               ;; Ignore this line
4111               (throw 'next-line t)))
4112         ;; Break the line into fields and store the fields
4113         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
4114         (if field-buffer
4115             (setq field-buffer (mapcar
4116                                 (lambda (x)
4117                                   (concat x "<br/>" (pop fields)))
4118                                 field-buffer))
4119           (setq field-buffer fields))))
4120     (setq html (concat html "</table>\n"))
4121     html))
4122
4123 (defun org-format-table-table-html-using-table-generate-source (lines)
4124   "Format a table into html, using `table-generate-source' from table.el.
4125 This has the advantage that cell- or row-spanning is allowed.
4126 But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
4127   (require 'table)
4128   (with-current-buffer (get-buffer-create " org-tmp1 ")
4129     (erase-buffer)
4130     (insert (mapconcat 'identity lines "\n"))
4131     (goto-char (point-min))
4132     (if (not (re-search-forward "|[^+]" nil t))
4133         (error "Error processing table"))
4134     (table-recognize-table)
4135     (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
4136     (table-generate-source 'html " org-tmp2 ")
4137     (set-buffer " org-tmp2 ")
4138     (buffer-substring (point-min) (point-max))))
4139
4140 (defun org-export-splice-style (style extra)
4141   "Splice EXTRA into STYLE, just before \"</style>\"."
4142   (if (and (stringp extra)
4143            (string-match "\\S-" extra)
4144            (string-match "</style>" style))
4145       (concat (substring style 0 (match-beginning 0))
4146               "\n" extra "\n"
4147               (substring style (match-beginning 0)))
4148     style))
4149
4150 (defun org-html-handle-time-stamps (s)
4151   "Format time stamps in string S, or remove them."
4152   (catch 'exit
4153     (let (r b)
4154       (while (string-match org-maybe-keyword-time-regexp s)
4155         (or b (setq b (substring s 0 (match-beginning 0))))
4156         (setq r (concat
4157                  r (substring s 0 (match-beginning 0))
4158                  (if (match-end 1)
4159                      (format "@<span class=\"timestamp-kwd\">%s @</span>"
4160                              (match-string 1 s)))
4161                  (format " @<span class=\"timestamp\">%s@</span>"
4162                          (substring
4163                           (org-translate-time (match-string 3 s)) 1 -1)))
4164               s (substring s (match-end 0))))
4165       ;; Line break if line started and ended with time stamp stuff
4166       (if (not r)
4167           s
4168         (setq r (concat r s))
4169         (unless (string-match "\\S-" (concat b s))
4170           (setq r (concat r "@<br/>")))
4171         r))))
4172
4173 (defun org-export-htmlize-region-for-paste (beg end)
4174   "Convert the region to HTML, using htmlize.el.
4175 This is much like `htmlize-region-for-paste', only that it uses
4176 the settings define in the org-... variables."
4177   (let* ((htmlize-output-type org-export-htmlize-output-type)
4178          (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
4179          (htmlbuf (htmlize-region beg end)))
4180     (unwind-protect
4181         (with-current-buffer htmlbuf
4182           (buffer-substring (plist-get htmlize-buffer-places 'content-start)
4183                             (plist-get htmlize-buffer-places 'content-end)))
4184       (kill-buffer htmlbuf))))
4185
4186 ;;;###autoload
4187 (defun org-export-htmlize-generate-css ()
4188   "Create the CSS for all font definitions in the current Emacs session.
4189 Use this to create face definitions in your CSS style file that can then
4190 be used by code snippets transformed by htmlize.
4191 This command just produces a buffer that contains class definitions for all
4192 faces used in the current Emacs session.  You can copy and paste the ones you
4193 need into your CSS file.
4194
4195 If you then set `org-export-htmlize-output-type' to `css', calls to
4196 the function `org-export-htmlize-region-for-paste' will produce code
4197 that uses these same face definitions."
4198   (interactive)
4199   (require 'htmlize)
4200   (and (get-buffer "*html*") (kill-buffer "*html*"))
4201   (with-temp-buffer
4202     (let ((fl (face-list))
4203           (htmlize-css-name-prefix "org-")
4204           (htmlize-output-type 'css)
4205           f i)
4206       (while (setq f (pop fl)
4207                    i (and f (face-attribute f :inherit)))
4208         (when (and (symbolp f) (or (not i) (not (listp i))))
4209           (insert (org-add-props (copy-sequence "1") nil 'face f))))
4210       (htmlize-region (point-min) (point-max))))
4211   (switch-to-buffer "*html*")
4212   (goto-char (point-min))
4213   (if (re-search-forward "<style" nil t)
4214       (delete-region (point-min) (match-beginning 0)))
4215   (if (re-search-forward "</style>" nil t)
4216       (delete-region (1+ (match-end 0)) (point-max)))
4217   (beginning-of-line 1)
4218   (if (looking-at " +") (replace-match ""))
4219   (goto-char (point-min)))
4220
4221 (defun org-html-protect (s)
4222   ;; convert & to &amp;, < to &lt; and > to &gt;
4223   (let ((start 0))
4224     (while (string-match "&" s start)
4225       (setq s (replace-match "&amp;" t t s)
4226             start (1+ (match-beginning 0))))
4227     (while (string-match "<" s)
4228       (setq s (replace-match "&lt;" t t s)))
4229     (while (string-match ">" s)
4230       (setq s (replace-match "&gt;" t t s)))
4231 ;    (while (string-match "\"" s)
4232 ;      (setq s (replace-match "&quot;" t t s)))
4233     )
4234   s)
4235
4236 (defun org-export-cleanup-toc-line (s)
4237   "Remove tags and timestamps from lines going into the toc."
4238   (when (memq org-export-with-tags '(not-in-toc nil))
4239     (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
4240         (setq s (replace-match "" t t s))))
4241   (when org-export-remove-timestamps-from-toc
4242     (while (string-match org-maybe-keyword-time-regexp s)
4243       (setq s (replace-match "" t t s))))
4244   (while (string-match org-bracket-link-regexp s)
4245     (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
4246                            t t s)))
4247   s)
4248
4249 (defun org-html-expand (string)
4250   "Prepare STRING for HTML export.  Applies all active conversions.
4251 If there are links in the string, don't modify these."
4252   (let* ((re (concat org-bracket-link-regexp "\\|"
4253                      (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
4254          m s l res)
4255     (while (setq m (string-match re string))
4256       (setq s (substring string 0 m)
4257             l (match-string 0 string)
4258             string (substring string (match-end 0)))
4259       (push (org-html-do-expand s) res)
4260       (push l res))
4261     (push (org-html-do-expand string) res)
4262     (apply 'concat (nreverse res))))
4263
4264 (defun org-html-do-expand (s)
4265   "Apply all active conversions to translate special ASCII to HTML."
4266   (setq s (org-html-protect s))
4267   (if org-export-html-expand
4268       (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
4269         (setq s (replace-match "<\\1>" t nil s))))
4270   (if org-export-with-emphasize
4271       (setq s (org-export-html-convert-emphasize s)))
4272   (if org-export-with-special-strings
4273       (setq s (org-export-html-convert-special-strings s)))
4274   (if org-export-with-sub-superscripts
4275       (setq s (org-export-html-convert-sub-super s)))
4276   (if org-export-with-TeX-macros
4277       (let ((start 0) wd ass)
4278         (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
4279                                          s start))
4280           (if (get-text-property (match-beginning 0) 'org-protected s)
4281               (setq start (match-end 0))
4282             (setq wd (match-string 1 s))
4283             (if (setq ass (assoc wd org-html-entities))
4284                 (setq s (replace-match (or (cdr ass)
4285                                            (concat "&" (car ass) ";"))
4286                                        t t s))
4287               (setq start (+ start (length wd))))))))
4288   s)
4289
4290 (defun org-create-multibrace-regexp (left right n)
4291   "Create a regular expression which will match a balanced sexp.
4292 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
4293 as single character strings.
4294 The regexp returned will match the entire expression including the
4295 delimiters.  It will also define a single group which contains the
4296 match except for the outermost delimiters.  The maximum depth of
4297 stacked delimiters is N.  Escaping delimiters is not possible."
4298   (let* ((nothing (concat "[^" left right "]*?"))
4299          (or "\\|")
4300          (re nothing)
4301          (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
4302     (while (> n 1)
4303       (setq n (1- n)
4304             re (concat re or next)
4305             next (concat "\\(?:" nothing left next right "\\)+" nothing)))
4306     (concat left "\\(" re "\\)" right)))
4307
4308 (defvar org-match-substring-regexp
4309   (concat
4310    "\\([^\\]\\)\\([_^]\\)\\("
4311    "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
4312    "\\|"
4313    "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
4314    "\\|"
4315    "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
4316   "The regular expression matching a sub- or superscript.")
4317
4318 (defvar org-match-substring-with-braces-regexp
4319   (concat
4320    "\\([^\\]\\)\\([_^]\\)\\("
4321    "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
4322    "\\)")
4323   "The regular expression matching a sub- or superscript, forcing braces.")
4324
4325 (defconst org-export-html-special-string-regexps
4326   '(("\\\\-" . "&shy;")
4327     ("---\\([^-]\\)" . "&mdash;\\1")
4328     ("--\\([^-]\\)" . "&ndash;\\1")
4329     ("\\.\\.\\." . "&hellip;"))
4330   "Regular expressions for special string conversion.")
4331
4332 (defun org-export-html-convert-special-strings (string)
4333   "Convert special characters in STRING to HTML."
4334   (let ((all org-export-html-special-string-regexps)
4335         e a re rpl start)
4336     (while (setq a (pop all))
4337       (setq re (car a) rpl (cdr a) start 0)
4338       (while (string-match re string start)
4339         (if (get-text-property (match-beginning 0) 'org-protected string)
4340             (setq start (match-end 0))
4341           (setq string (replace-match rpl t nil string)))))
4342     string))
4343
4344 (defun org-export-html-convert-sub-super (string)
4345   "Convert sub- and superscripts in STRING to HTML."
4346   (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
4347     (while (string-match org-match-substring-regexp string s)
4348       (cond
4349        ((and requireb (match-end 8)) (setq s (match-end 2)))
4350        ((get-text-property  (match-beginning 2) 'org-protected string)
4351         (setq s (match-end 2)))
4352        (t
4353         (setq s (match-end 1)
4354               key (if (string= (match-string 2 string) "_") "sub" "sup")
4355               c (or (match-string 8 string)
4356                     (match-string 6 string)
4357                     (match-string 5 string))
4358               string (replace-match
4359                       (concat (match-string 1 string)
4360                               "<" key ">" c "</" key ">")
4361                       t t string)))))
4362     (while (string-match "\\\\\\([_^]\\)" string)
4363       (setq string (replace-match (match-string 1 string) t t string)))
4364     string))
4365
4366 (defun org-export-html-convert-emphasize (string)
4367   "Apply emphasis."
4368   (let ((s 0) rpl)
4369     (while (string-match org-emph-re string s)
4370       (if (not (equal
4371                 (substring string (match-beginning 3) (1+ (match-beginning 3)))
4372                 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
4373           (setq s (match-beginning 0)
4374                 rpl
4375                 (concat
4376                  (match-string 1 string)
4377                  (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
4378                  (match-string 4 string)
4379                  (nth 3 (assoc (match-string 3 string)
4380                                org-emphasis-alist))
4381                  (match-string 5 string))
4382                 string (replace-match rpl t t string)
4383                 s (+ s (- (length rpl) 2)))
4384         (setq s (1+ s))))
4385     string))
4386
4387 (defun org-open-par ()
4388   "Insert <p>, but first close previous paragraph if any."
4389   (org-close-par-maybe)
4390   (insert "\n<p>")
4391   (setq org-par-open t))
4392 (defun org-close-par-maybe ()
4393   "Close paragraph if there is one open."
4394   (when org-par-open
4395     (insert "</p>")
4396     (setq org-par-open nil)))
4397 (defun org-close-li (&optional type)
4398   "Close <li> if necessary."
4399   (org-close-par-maybe)
4400   (insert (if (equal type "d") "</dd>\n" "</li>\n")))
4401
4402 (defvar body-only) ; dynamically scoped into this.
4403 (defun org-html-level-start (level title umax with-toc head-count)
4404   "Insert a new level in HTML export.
4405 When TITLE is nil, just close all open levels."
4406   (org-close-par-maybe)
4407   (let* ((target (and title (org-get-text-property-any 0 'target title)))
4408          (extra-targets
4409           (mapconcat (lambda (x)
4410                        (if (org-uuidgen-p x) (setq x (concat "ID-" x)))
4411                        (format "<a name=\"%s\" id=\"%s\"></a>"
4412                                x x))
4413                      (cdr (assoc target org-export-target-aliases))
4414                      ""))
4415          (l org-level-max)
4416          snumber)
4417     (while (>= l level)
4418       (if (aref org-levels-open (1- l))
4419           (progn
4420             (org-html-level-close l umax)
4421             (aset org-levels-open (1- l) nil)))
4422       (setq l (1- l)))
4423     (when title
4424       ;; If title is nil, this means this function is called to close
4425       ;; all levels, so the rest is done only if title is given
4426         (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
4427           (setq title (replace-match
4428                        (if org-export-with-tags
4429                            (save-match-data
4430                              (concat
4431                               "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
4432                               (mapconcat
4433                                (lambda (x)
4434                                  (format "<span class=\"%s\">%s</span>"
4435                                          (org-export-html-get-tag-class-name x)
4436                                          x))
4437                                (org-split-string (match-string 1 title) ":")
4438                                "&nbsp;")
4439                               "</span>"))
4440                          "")
4441                        t t title)))
4442       (if (> level umax)
4443           (progn
4444             (if (aref org-levels-open (1- level))
4445                 (progn
4446                   (org-close-li)
4447                   (if target
4448                       (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
4449                     (insert "<li>" title "<br/>\n")))
4450               (aset org-levels-open (1- level) t)
4451               (org-close-par-maybe)
4452               (if target
4453                   (insert (format "<ul>\n<li id=\"%s\">" target)
4454                           extra-targets title "<br/>\n")
4455                 (insert "<ul>\n<li>" title "<br/>\n"))))
4456         (aset org-levels-open (1- level) t)
4457         (setq snumber (org-section-number level))
4458         (setq level (+ level org-export-html-toplevel-hlevel -1))
4459         (if (and org-export-with-section-numbers (not body-only))
4460             (setq title (concat
4461                          (format "<span class=\"section-number-%d\">%s</span>"
4462                                  level snumber)
4463                          " " title)))
4464         (unless (= head-count 1) (insert "\n</div>\n"))
4465         (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"sec-%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
4466                         snumber level level snumber extra-targets
4467                         title level level snumber))
4468         (org-open-par)))))
4469
4470 (defun org-get-text-property-any (pos prop &optional object)
4471   (or (get-text-property pos prop object)
4472       (and (setq pos (next-single-property-change pos prop object))
4473            (get-text-property pos prop object))))
4474
4475 (defun org-export-html-get-tag-class-name (tag)
4476   "Turn tag into a valid class name.
4477 Replaces invalid characters with \"_\" and then prepends a prefix."
4478   (save-match-data
4479     (while (string-match "[^a-zA-Z0-9_]" tag)
4480       (setq tag (replace-match "_" t t tag))))
4481   (concat org-export-html-tag-class-prefix tag))
4482
4483 (defun org-export-html-get-todo-kwd-class-name (kwd)
4484   "Turn todo keyword into a valid class name.
4485 Replaces invalid characters with \"_\" and then prepends a prefix."
4486   (save-match-data
4487     (while (string-match "[^a-zA-Z0-9_]" kwd)
4488       (setq kwd (replace-match "_" t t kwd))))
4489   (concat org-export-html-todo-kwd-class-prefix kwd))
4490
4491 (defun org-html-level-close (level max-outline-level)
4492   "Terminate one level in HTML export."
4493   (if (<= level max-outline-level)
4494       (insert "</div>\n")
4495     (org-close-li)
4496     (insert "</ul>\n")))
4497
4498 ;;; iCalendar export
4499
4500 ;;;###autoload
4501 (defun org-export-icalendar-this-file ()
4502   "Export current file as an iCalendar file.
4503 The iCalendar file will be located in the same directory as the Org-mode
4504 file, but with extension `.ics'."
4505   (interactive)
4506   (org-export-icalendar nil buffer-file-name))
4507
4508 ;;;###autoload
4509 (defun org-export-icalendar-all-agenda-files ()
4510   "Export all files in `org-agenda-files' to iCalendar .ics files.
4511 Each iCalendar file will be located in the same directory as the Org-mode
4512 file, but with extension `.ics'."
4513   (interactive)
4514   (apply 'org-export-icalendar nil (org-agenda-files t)))
4515
4516 ;;;###autoload
4517 (defun org-export-icalendar-combine-agenda-files ()
4518   "Export all files in `org-agenda-files' to a single combined iCalendar file.
4519 The file is stored under the name `org-combined-agenda-icalendar-file'."
4520   (interactive)
4521   (apply 'org-export-icalendar t (org-agenda-files t)))
4522
4523 (defun org-export-icalendar (combine &rest files)
4524   "Create iCalendar files for all elements of FILES.
4525 If COMBINE is non-nil, combine all calendar entries into a single large
4526 file and store it under the name `org-combined-agenda-icalendar-file'."
4527   (save-excursion
4528     (org-prepare-agenda-buffers files)
4529     (let* ((dir (org-export-directory
4530                  :ical (list :publishing-directory
4531                              org-export-publishing-directory)))
4532            file ical-file ical-buffer category started org-agenda-new-buffers)
4533       (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
4534       (when combine
4535         (setq ical-file
4536               (if (file-name-absolute-p org-combined-agenda-icalendar-file)
4537                   org-combined-agenda-icalendar-file
4538                 (expand-file-name org-combined-agenda-icalendar-file dir))
4539               ical-buffer (org-get-agenda-file-buffer ical-file))
4540         (set-buffer ical-buffer) (erase-buffer))
4541       (while (setq file (pop files))
4542         (catch 'nextfile
4543           (org-check-agenda-file file)
4544           (set-buffer (org-get-agenda-file-buffer file))
4545           (unless combine
4546             (setq ical-file (concat (file-name-as-directory dir)
4547                                     (file-name-sans-extension
4548                                      (file-name-nondirectory buffer-file-name))
4549                                     ".ics"))
4550             (setq ical-buffer (org-get-agenda-file-buffer ical-file))
4551             (with-current-buffer ical-buffer (erase-buffer)))
4552           (setq category (or org-category
4553                              (file-name-sans-extension
4554                               (file-name-nondirectory buffer-file-name))))
4555           (if (symbolp category) (setq category (symbol-name category)))
4556           (let ((standard-output ical-buffer))
4557             (if combine
4558                 (and (not started) (setq started t)
4559                      (org-start-icalendar-file org-icalendar-combined-name))
4560               (org-start-icalendar-file category))
4561             (org-print-icalendar-entries combine)
4562             (when (or (and combine (not files)) (not combine))
4563               (org-finish-icalendar-file)
4564               (set-buffer ical-buffer)
4565               (run-hooks 'org-before-save-iCalendar-file-hook)
4566               (save-buffer)
4567               (run-hooks 'org-after-save-iCalendar-file-hook)
4568               (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
4569               ))))
4570       (org-release-buffers org-agenda-new-buffers))))
4571
4572 (defvar org-before-save-iCalendar-file-hook nil
4573   "Hook run before  an iCalendar file has been saved.
4574 This can be used to modify the result of the export.")
4575
4576 (defvar org-after-save-iCalendar-file-hook nil
4577   "Hook run after an iCalendar file has been saved.
4578 The iCalendar buffer is still current when this hook is run.
4579 A good way to use this is to tell a desktop calendar application to re-read
4580 the iCalendar file.")
4581
4582 (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
4583 (defun org-print-icalendar-entries (&optional combine)
4584   "Print iCalendar entries for the current Org-mode file to `standard-output'.
4585 When COMBINE is non nil, add the category to each line."
4586   (require 'org-agenda)
4587   (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
4588         (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
4589         (dts (org-ical-ts-to-string
4590               (format-time-string (cdr org-time-stamp-formats) (current-time))
4591               "DTSTART"))
4592         hd ts ts2 state status (inc t) pos b sexp rrule
4593         scheduledp deadlinep todo prefix due start
4594         tmp pri categories location summary desc uid
4595         (sexp-buffer (get-buffer-create "*ical-tmp*")))
4596     (org-refresh-category-properties)
4597     (save-excursion
4598       (goto-char (point-min))
4599       (while (re-search-forward re1 nil t)
4600         (catch :skip
4601           (org-agenda-skip)
4602           (when (boundp 'org-icalendar-verify-function)
4603             (unless (funcall org-icalendar-verify-function)
4604               (outline-next-heading)
4605               (backward-char 1)
4606               (throw :skip nil)))
4607           (setq pos (match-beginning 0)
4608                 ts (match-string 0)
4609                 inc t
4610                 hd (condition-case nil
4611                        (org-icalendar-cleanup-string
4612                         (org-get-heading))
4613                      (error (throw :skip nil)))
4614                 summary (org-icalendar-cleanup-string
4615                          (org-entry-get nil "SUMMARY"))
4616                 desc (org-icalendar-cleanup-string
4617                       (or (org-entry-get nil "DESCRIPTION")
4618                           (and org-icalendar-include-body (org-get-entry)))
4619                       t org-icalendar-include-body)
4620                 location (org-icalendar-cleanup-string
4621                           (org-entry-get nil "LOCATION" 'selective))
4622                 uid (if org-icalendar-store-UID
4623                         (org-id-get-create)
4624                       (or (org-id-get) (org-id-new)))
4625                 categories (org-export-get-categories)
4626                 deadlinep nil scheduledp nil)
4627           (if (looking-at re2)
4628               (progn
4629                 (goto-char (match-end 0))
4630                 (setq ts2 (match-string 1)
4631                       inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
4632             (setq tmp (buffer-substring (max (point-min)
4633                                              (- pos org-ds-keyword-length))
4634                                         pos)
4635                   ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
4636                           (progn
4637                             (setq inc nil)
4638                             (replace-match "\\1" t nil ts))
4639                         ts)
4640                   deadlinep (string-match org-deadline-regexp tmp)
4641                   scheduledp (string-match org-scheduled-regexp tmp)
4642                   todo (org-get-todo-state)
4643                   ;; donep (org-entry-is-done-p)
4644                   ))
4645           (when (and
4646                  deadlinep
4647                  (if todo
4648                      (not (memq 'event-if-todo org-icalendar-use-deadline))
4649                    (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
4650             (throw :skip t))
4651           (when (and
4652                  scheduledp
4653                  (if todo
4654                      (not (memq 'event-if-todo org-icalendar-use-scheduled))
4655                    (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
4656             (throw :skip t))
4657           (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
4658           (if (or (string-match org-tr-regexp hd)
4659                   (string-match org-ts-regexp hd))
4660               (setq hd (replace-match "" t t hd)))
4661           (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
4662               (setq rrule
4663                     (concat "\nRRULE:FREQ="
4664                             (cdr (assoc
4665                                   (match-string 2 ts)
4666                                   '(("d" . "DAILY")("w" . "WEEKLY")
4667                                     ("m" . "MONTHLY")("y" . "YEARLY"))))
4668                             ";INTERVAL=" (match-string 1 ts)))
4669             (setq rrule ""))
4670           (setq summary (or summary hd))
4671           (if (string-match org-bracket-link-regexp summary)
4672               (setq summary
4673                     (replace-match (if (match-end 3)
4674                                        (match-string 3 summary)
4675                                      (match-string 1 summary))
4676                                    t t summary)))
4677           (if deadlinep (setq summary (concat "DL: " summary)))
4678           (if scheduledp (setq summary (concat "S: " summary)))
4679           (if (string-match "\\`<%%" ts)
4680               (with-current-buffer sexp-buffer
4681                 (insert (substring ts 1 -1) " " summary "\n"))
4682             (princ (format "BEGIN:VEVENT
4683 UID: %s
4684 %s
4685 %s%s
4686 SUMMARY:%s%s%s
4687 CATEGORIES:%s
4688 END:VEVENT\n"
4689                            (concat prefix uid)
4690                            (org-ical-ts-to-string ts "DTSTART")
4691                            (org-ical-ts-to-string ts2 "DTEND" inc)
4692                            rrule summary
4693                            (if (and desc (string-match "\\S-" desc))
4694                                (concat "\nDESCRIPTION: " desc) "")
4695                            (if (and location (string-match "\\S-" location))
4696                                (concat "\nLOCATION: " location) "")
4697                            categories)))))
4698       (when (and org-icalendar-include-sexps
4699                  (condition-case nil (require 'icalendar) (error nil))
4700                  (fboundp 'icalendar-export-region))
4701         ;; Get all the literal sexps
4702         (goto-char (point-min))
4703         (while (re-search-forward "^&?%%(" nil t)
4704           (catch :skip
4705             (org-agenda-skip)
4706             (setq b (match-beginning 0))
4707             (goto-char (1- (match-end 0)))
4708             (forward-sexp 1)
4709             (end-of-line 1)
4710             (setq sexp (buffer-substring b (point)))
4711             (with-current-buffer sexp-buffer
4712               (insert sexp "\n"))))
4713         (princ (org-diary-to-ical-string sexp-buffer))
4714         (kill-buffer sexp-buffer))
4715
4716       (when org-icalendar-include-todo
4717         (setq prefix "TODO-")
4718         (goto-char (point-min))
4719         (while (re-search-forward org-todo-line-regexp nil t)
4720           (catch :skip
4721             (org-agenda-skip)
4722             (when (boundp 'org-icalendar-verify-function)
4723               (unless (funcall org-icalendar-verify-function)
4724                 (outline-next-heading)
4725                 (backward-char 1)
4726                 (throw :skip nil)))
4727             (setq state (match-string 2))
4728             (setq status (if (member state org-done-keywords)
4729                              "COMPLETED" "NEEDS-ACTION"))
4730             (when (and state
4731                        (or (not (member state org-done-keywords))
4732                            (eq org-icalendar-include-todo 'all))
4733                        (not (member org-archive-tag (org-get-tags-at)))
4734                        )
4735               (setq hd (match-string 3)
4736                     summary (org-icalendar-cleanup-string
4737                              (org-entry-get nil "SUMMARY"))
4738                     desc (org-icalendar-cleanup-string
4739                           (or (org-entry-get nil "DESCRIPTION")
4740                               (and org-icalendar-include-body (org-get-entry)))
4741                           t org-icalendar-include-body)
4742                     location (org-icalendar-cleanup-string
4743                               (org-entry-get nil "LOCATION" 'selective))
4744                     due (and (member 'todo-due org-icalendar-use-deadline)
4745                              (org-entry-get nil "DEADLINE"))
4746                     start (and (member 'todo-start org-icalendar-use-scheduled)
4747                              (org-entry-get nil "SCHEDULED"))
4748                     categories (org-export-get-categories)
4749                     uid (if org-icalendar-store-UID
4750                             (org-id-get-create)
4751                           (or (org-id-get) (org-id-new))))
4752               (and due (setq due (org-ical-ts-to-string due "DUE")))
4753               (and start (setq start (org-ical-ts-to-string start "DTSTART")))
4754
4755               (if (string-match org-bracket-link-regexp hd)
4756                   (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
4757                                             (match-string 1 hd))
4758                                           t t hd)))
4759               (if (string-match org-priority-regexp hd)
4760                   (setq pri (string-to-char (match-string 2 hd))
4761                         hd (concat (substring hd 0 (match-beginning 1))
4762                                    (substring hd (match-end 1))))
4763                 (setq pri org-default-priority))
4764               (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
4765                                              (- org-lowest-priority org-highest-priority))))))
4766
4767               (princ (format "BEGIN:VTODO
4768 UID: %s
4769 %s
4770 SUMMARY:%s%s%s%s
4771 CATEGORIES:%s
4772 SEQUENCE:1
4773 PRIORITY:%d
4774 STATUS:%s
4775 END:VTODO\n"
4776                              (concat prefix uid)
4777                              (or start dts)
4778                              (or summary hd)
4779                              (if (and location (string-match "\\S-" location))
4780                                  (concat "\nLOCATION: " location) "")
4781                              (if (and desc (string-match "\\S-" desc))
4782                                  (concat "\nDESCRIPTION: " desc) "")
4783                              (if due (concat "\n" due) "")
4784                              categories
4785                              pri status)))))))))
4786
4787 (defun org-export-get-categories ()
4788   "Get categories according to `org-icalendar-categories'."
4789   (let ((cs org-icalendar-categories) c rtn tmp)
4790     (while (setq c (pop cs))
4791       (cond
4792        ((eq c 'category) (push (org-get-category) rtn))
4793        ((eq c 'todo-state)
4794         (setq tmp (org-get-todo-state))
4795         (and tmp (push tmp rtn)))
4796        ((eq c 'local-tags)
4797         (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
4798        ((eq c 'all-tags)
4799         (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
4800     (mapconcat 'identity (nreverse rtn) ",")))
4801
4802 (defun org-icalendar-cleanup-string (s &optional is-body maxlength)
4803   "Take out stuff and quote what needs to be quoted.
4804 When IS-BODY is non-nil, assume that this is the body of an item, clean up
4805 whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
4806 characters."
4807   (if (not s)
4808       nil
4809     (when is-body
4810       (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
4811             (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
4812         (while (string-match re s) (setq s (replace-match "" t t s)))
4813         (while (string-match re2 s) (setq s (replace-match "" t t s)))))
4814     (let ((start 0))
4815       (while (string-match "\\([,;]\\)" s start)
4816         (setq start (+ (match-beginning 0) 2)
4817               s (replace-match "\\\\\\1" nil nil s))))
4818     (setq s (org-trim s))
4819     (when is-body
4820       (while (string-match "[ \t]*\n[ \t]*" s)
4821         (setq s (replace-match "\\n" t t s))))
4822     (if is-body
4823         (if maxlength
4824             (if (and (numberp maxlength)
4825                      (> (length s) maxlength))
4826                 (setq s (substring s 0 maxlength)))))
4827     s))
4828
4829 (defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
4830   "Take out stuff and quote what needs to be quoted.
4831 When IS-BODY is non-nil, assume that this is the body of an item, clean up
4832 whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
4833 characters.
4834 This seems to be more like RFC 2455, but it causes problems, so it is
4835 not used right now."
4836   (if (not s)
4837       nil
4838     (if is-body
4839         (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
4840               (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
4841           (while (string-match re s) (setq s (replace-match "" t t s)))
4842           (while (string-match re2 s) (setq s (replace-match "" t t s)))
4843           (setq s (org-trim s))
4844           (while (string-match "[ \t]*\n[ \t]*" s)
4845             (setq s (replace-match "\\n" t t s)))
4846           (if maxlength
4847               (if (and (numberp maxlength)
4848                        (> (length s) maxlength))
4849                   (setq s (substring s 0 maxlength)))))
4850       (setq s (org-trim s)))
4851     (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
4852     (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
4853     s))
4854
4855 (defun org-get-entry ()
4856   "Clean-up description string."
4857   (save-excursion
4858     (org-back-to-heading t)
4859     (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
4860
4861 (defun org-start-icalendar-file (name)
4862   "Start an iCalendar file by inserting the header."
4863   (let ((user user-full-name)
4864         (name (or name "unknown"))
4865         (timezone (cadr (current-time-zone))))
4866     (princ
4867      (format "BEGIN:VCALENDAR
4868 VERSION:2.0
4869 X-WR-CALNAME:%s
4870 PRODID:-//%s//Emacs with Org-mode//EN
4871 X-WR-TIMEZONE:%s
4872 CALSCALE:GREGORIAN\n" name user timezone))))
4873
4874 (defun org-finish-icalendar-file ()
4875   "Finish an iCalendar file by inserting the END statement."
4876   (princ "END:VCALENDAR\n"))
4877
4878 (defun org-ical-ts-to-string (s keyword &optional inc)
4879   "Take a time string S and convert it to iCalendar format.
4880 KEYWORD is added in front, to make a complete line like DTSTART....
4881 When INC is non-nil, increase the hour by two (if time string contains
4882 a time), or the day by one (if it does not contain a time)."
4883   (let ((t1 (org-parse-time-string s 'nodefault))
4884         t2 fmt have-time time)
4885     (if (and (car t1) (nth 1 t1) (nth 2 t1))
4886         (setq t2 t1 have-time t)
4887       (setq t2 (org-parse-time-string s)))
4888     (let ((s (car t2))   (mi (nth 1 t2)) (h (nth 2 t2))
4889           (d (nth 3 t2)) (m  (nth 4 t2)) (y (nth 5 t2)))
4890       (when inc
4891         (if have-time
4892             (if org-agenda-default-appointment-duration
4893                 (setq mi (+ org-agenda-default-appointment-duration mi))
4894               (setq h (+ 2 h)))
4895           (setq d (1+ d))))
4896       (setq time (encode-time s mi h d m y)))
4897     (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
4898     (concat keyword (format-time-string fmt time))))
4899
4900 ;;; XOXO export
4901
4902 (defun org-export-as-xoxo-insert-into (buffer &rest output)
4903   (with-current-buffer buffer
4904     (apply 'insert output)))
4905 (put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
4906
4907 ;;;###autoload
4908 (defun org-export-as-xoxo (&optional buffer)
4909   "Export the org buffer as XOXO.
4910 The XOXO buffer is named *xoxo-<source buffer name>*"
4911   (interactive (list (current-buffer)))
4912   ;; A quickie abstraction
4913
4914   ;; Output everything as XOXO
4915   (with-current-buffer (get-buffer buffer)
4916     (let* ((pos (point))
4917            (opt-plist (org-combine-plists (org-default-export-plist)
4918                                         (org-infile-export-plist)))
4919            (filename (concat (file-name-as-directory
4920                               (org-export-directory :xoxo opt-plist))
4921                              (file-name-sans-extension
4922                               (file-name-nondirectory buffer-file-name))
4923                              ".html"))
4924            (out (find-file-noselect filename))
4925            (last-level 1)
4926            (hanging-li nil))
4927       (goto-char (point-min))  ;; CD:  beginning-of-buffer is not allowed.
4928       ;; Check the output buffer is empty.
4929       (with-current-buffer out (erase-buffer))
4930       ;; Kick off the output
4931       (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
4932       (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
4933         (let* ((hd (match-string-no-properties 1))
4934                (level (length hd))
4935                (text (concat
4936                       (match-string-no-properties 2)
4937                       (save-excursion
4938                         (goto-char (match-end 0))
4939                         (let ((str ""))
4940                           (catch 'loop
4941                             (while 't
4942                               (forward-line)
4943                               (if (looking-at "^[ \t]\\(.*\\)")
4944                                   (setq str (concat str (match-string-no-properties 1)))
4945                                 (throw 'loop str)))))))))
4946
4947           ;; Handle level rendering
4948           (cond
4949            ((> level last-level)
4950             (org-export-as-xoxo-insert-into out "\n<ol>\n"))
4951
4952            ((< level last-level)
4953             (dotimes (- (- last-level level) 1)
4954               (if hanging-li
4955                   (org-export-as-xoxo-insert-into out "</li>\n"))
4956               (org-export-as-xoxo-insert-into out "</ol>\n"))
4957             (when hanging-li
4958               (org-export-as-xoxo-insert-into out "</li>\n")
4959               (setq hanging-li nil)))
4960
4961            ((equal level last-level)
4962             (if hanging-li
4963                 (org-export-as-xoxo-insert-into out "</li>\n")))
4964            )
4965
4966           (setq last-level level)
4967
4968           ;; And output the new li
4969           (setq hanging-li 't)
4970           (if (equal ?+ (elt text 0))
4971               (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
4972             (org-export-as-xoxo-insert-into out "<li>" text))))
4973
4974       ;; Finally finish off the ol
4975       (dotimes (- last-level 1)
4976         (if hanging-li
4977             (org-export-as-xoxo-insert-into out "</li>\n"))
4978         (org-export-as-xoxo-insert-into out "</ol>\n"))
4979
4980       (goto-char pos)
4981       ;; Finish the buffer off and clean it up.
4982       (switch-to-buffer-other-window out)
4983       (indent-region (point-min) (point-max) nil)
4984       (save-buffer)
4985       (goto-char (point-min))
4986       )))
4987
4988 (provide 'org-exp)
4989
4990 ;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
4991
4992 ;;; org-exp.el ends here