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