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