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