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