aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBastien Guerry2013-11-12 14:13:04 +0100
committerBastien Guerry2013-11-12 14:13:04 +0100
commit9b1ee27c6c88619f32fdbc4e5be7c745763c3b65 (patch)
treea7d497c5244dc50eb09526a4d6cfcaec814b755c
parent271672fad74cdbc9065d23d6e6cee1b8540f571b (diff)
downloademacs-9b1ee27c6c88619f32fdbc4e5be7c745763c3b65.tar.gz
emacs-9b1ee27c6c88619f32fdbc4e5be7c745763c3b65.zip
Fix previous commit: remove files that are not part of Org 8.2.3a anymore
Diffstat
-rw-r--r--lisp/org/org-ascii.el730
-rw-r--r--lisp/org/org-beamer.el657
-rw-r--r--lisp/org/org-exp-blocks.el402
-rw-r--r--lisp/org/org-exp.el3354
-rw-r--r--lisp/org/org-freemind.el1227
-rw-r--r--lisp/org/org-html.el2761
-rw-r--r--lisp/org/org-icalendar.el692
-rw-r--r--lisp/org/org-jsinfo.el262
-rw-r--r--lisp/org/org-latex.el2901
-rw-r--r--lisp/org/org-lparse.el2303
-rw-r--r--lisp/org/org-mac-message.el216
-rw-r--r--lisp/org/org-mew.el136
-rw-r--r--lisp/org/org-mks.el134
-rw-r--r--lisp/org/org-odt.el2859
-rw-r--r--lisp/org/org-publish.el1198
-rw-r--r--lisp/org/org-remember.el1156
-rw-r--r--lisp/org/org-special-blocks.el104
-rw-r--r--lisp/org/org-vm.el180
-rw-r--r--lisp/org/org-wl.el316
-rw-r--r--lisp/org/org-xoxo.el129
20 files changed, 0 insertions, 21717 deletions
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el
deleted file mode 100644
index c5a4b3775e8..00000000000
--- a/lisp/org/org-ascii.el
+++ /dev/null
@@ -1,730 +0,0 @@
1;;; org-ascii.el --- ASCII export for Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;;; Code:
28
29(require 'org-exp)
30
31(eval-when-compile
32 (require 'cl))
33
34(defgroup org-export-ascii nil
35 "Options specific for ASCII export of Org-mode files."
36 :tag "Org Export ASCII"
37 :group 'org-export)
38
39(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
40 "Characters for underlining headings in ASCII export.
41In the given sequence, these characters will be used for level 1, 2, ..."
42 :group 'org-export-ascii
43 :type '(repeat character))
44
45(defcustom org-export-ascii-bullets '(?* ?+ ?-)
46 "Bullet characters for headlines converted to lists in ASCII export.
47The first character is used for the first lest level generated in this
48way, and so on. If there are more levels than characters given here,
49the list will be repeated.
50Note that plain lists will keep the same bullets as the have in the
51Org-mode file."
52 :group 'org-export-ascii
53 :type '(repeat character))
54
55(defcustom org-export-ascii-links-to-notes t
56 "Non-nil means convert links to notes before the next headline.
57When nil, the link will be exported in place. If the line becomes long
58in this way, it will be wrapped."
59 :group 'org-export-ascii
60 :type 'boolean)
61
62(defcustom org-export-ascii-table-keep-all-vertical-lines nil
63 "Non-nil means keep all vertical lines in ASCII tables.
64When nil, vertical lines will be removed except for those needed
65for column grouping."
66 :group 'org-export-ascii
67 :type 'boolean)
68
69(defcustom org-export-ascii-table-widen-columns t
70 "Non-nil means widen narrowed columns for export.
71When nil, narrowed columns will look in ASCII export just like in org-mode,
72i.e. with \"=>\" as ellipsis."
73 :group 'org-export-ascii
74 :type 'boolean)
75
76(defvar org-export-ascii-entities 'ascii
77 "The ascii representation to be used during ascii export.
78Possible values are:
79
80ascii Only use plain ASCII characters
81latin1 Include Latin-1 character
82utf8 Use all UTF-8 characters")
83
84;;; Hooks
85
86(defvar org-export-ascii-final-hook nil
87 "Hook run at the end of ASCII export, in the new buffer.")
88
89;;; ASCII export
90
91(defvar org-ascii-current-indentation nil) ; For communication
92
93;;;###autoload
94(defun org-export-as-latin1 (&rest args)
95 "Like `org-export-as-ascii', use latin1 encoding for special symbols."
96 (interactive)
97 (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any)
98 'latin1 args))
99
100;;;###autoload
101(defun org-export-as-latin1-to-buffer (&rest args)
102 "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
103 (interactive)
104 (org-export-as-encoding 'org-export-as-ascii-to-buffer
105 (org-called-interactively-p 'any) 'latin1 args))
106
107;;;###autoload
108(defun org-export-as-utf8 (&rest args)
109 "Like `org-export-as-ascii', use encoding for special symbols."
110 (interactive)
111 (org-export-as-encoding 'org-export-as-ascii
112 (org-called-interactively-p 'any)
113 'utf8 args))
114
115;;;###autoload
116(defun org-export-as-utf8-to-buffer (&rest args)
117 "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
118 (interactive)
119 (org-export-as-encoding 'org-export-as-ascii-to-buffer
120 (org-called-interactively-p 'any) 'utf8 args))
121
122(defun org-export-as-encoding (command interactivep encoding &rest args)
123 (let ((org-export-ascii-entities encoding))
124 (if interactivep
125 (call-interactively command)
126 (apply command args))))
127
128
129;;;###autoload
130(defun org-export-as-ascii-to-buffer (arg)
131 "Call `org-export-as-ascii` with output to a temporary buffer.
132No file is created. The prefix ARG is passed through to `org-export-as-ascii'."
133 (interactive "P")
134 (org-export-as-ascii arg nil "*Org ASCII Export*")
135 (when org-export-show-temporary-export-buffer
136 (switch-to-buffer-other-window "*Org ASCII Export*")))
137
138;;;###autoload
139(defun org-replace-region-by-ascii (beg end)
140 "Assume the current region has org-mode syntax, and convert it to plain ASCII.
141This can be used in any buffer. For example, you could write an
142itemized list in org-mode syntax in a Mail buffer and then use this
143command to convert it."
144 (interactive "r")
145 (let (reg ascii buf pop-up-frames)
146 (save-window-excursion
147 (if (derived-mode-p 'org-mode)
148 (setq ascii (org-export-region-as-ascii
149 beg end t 'string))
150 (setq reg (buffer-substring beg end)
151 buf (get-buffer-create "*Org tmp*"))
152 (with-current-buffer buf
153 (erase-buffer)
154 (insert reg)
155 (org-mode)
156 (setq ascii (org-export-region-as-ascii
157 (point-min) (point-max) t 'string)))
158 (kill-buffer buf)))
159 (delete-region beg end)
160 (insert ascii)))
161
162;;;###autoload
163(defun org-export-region-as-ascii (beg end &optional body-only buffer)
164 "Convert region from BEG to END in org-mode buffer to plain ASCII.
165If prefix arg BODY-ONLY is set, omit file header, footer, and table of
166contents, and only produce the region of converted text, useful for
167cut-and-paste operations.
168If BUFFER is a buffer or a string, use/create that buffer as a target
169of the converted ASCII. If BUFFER is the symbol `string', return the
170produced ASCII as a string and leave not buffer behind. For example,
171a Lisp program could call this function in the following way:
172
173 (setq ascii (org-export-region-as-ascii beg end t 'string))
174
175When called interactively, the output buffer is selected, and shown
176in a window. A non-interactive call will only return the buffer."
177 (interactive "r\nP")
178 (when (org-called-interactively-p 'any)
179 (setq buffer "*Org ASCII Export*"))
180 (let ((transient-mark-mode t) (zmacs-regions t)
181 ext-plist rtn)
182 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
183 (goto-char end)
184 (set-mark (point)) ;; to activate the region
185 (goto-char beg)
186 (setq rtn (org-export-as-ascii nil ext-plist buffer body-only))
187 (if (fboundp 'deactivate-mark) (deactivate-mark))
188 (if (and (org-called-interactively-p 'any) (bufferp rtn))
189 (switch-to-buffer-other-window rtn)
190 rtn)))
191
192;;;###autoload
193(defun org-export-as-ascii (arg &optional ext-plist to-buffer body-only pub-dir)
194 "Export the outline as a pretty ASCII file.
195If there is an active region, export only the region.
196The prefix ARG specifies how many levels of the outline should become
197underlined headlines, default is 3. Lower levels will become bulleted
198lists. EXT-PLIST is a property list with external parameters overriding
199org-mode's default settings, but still inferior to file-local
200settings. When TO-BUFFER is non-nil, create a buffer with that
201name and export to that buffer. If TO-BUFFER is the symbol
202`string', don't leave any buffer behind but just return the
203resulting ASCII as a string. When BODY-ONLY is set, don't produce
204the file header and footer. When PUB-DIR is set, use this as the
205publishing directory."
206 (interactive "P")
207 (run-hooks 'org-export-first-hook)
208 (setq-default org-todo-line-regexp org-todo-line-regexp)
209 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
210 ext-plist
211 (org-infile-export-plist)))
212 (region-p (org-region-active-p))
213 (rbeg (and region-p (region-beginning)))
214 (rend (and region-p (region-end)))
215 (subtree-p
216 (if (plist-get opt-plist :ignore-subtree-p)
217 nil
218 (when region-p
219 (save-excursion
220 (goto-char rbeg)
221 (and (org-at-heading-p)
222 (>= (org-end-of-subtree t t) rend))))))
223 (level-offset (if subtree-p
224 (save-excursion
225 (goto-char rbeg)
226 (+ (funcall outline-level)
227 (if org-odd-levels-only 1 0)))
228 0))
229 (opt-plist (setq org-export-opt-plist
230 (if subtree-p
231 (org-export-add-subtree-options opt-plist rbeg)
232 opt-plist)))
233 ;; The following two are dynamically scoped into other
234 ;; routines below.
235 (org-current-export-dir
236 (or pub-dir (org-export-directory :html opt-plist)))
237 (org-current-export-file buffer-file-name)
238 (custom-times org-display-custom-times)
239 (org-ascii-current-indentation '(0 . 0))
240 (level 0) line txt
241 (umax nil)
242 (umax-toc nil)
243 (case-fold-search nil)
244 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
245 (filename (if to-buffer
246 nil
247 (concat (file-name-as-directory
248 (or pub-dir
249 (org-export-directory :ascii opt-plist)))
250 (file-name-sans-extension
251 (or (and subtree-p
252 (org-entry-get (region-beginning)
253 "EXPORT_FILE_NAME" t))
254 (file-name-nondirectory bfname)))
255 ".txt")))
256 (filename (and filename
257 (if (equal (file-truename filename)
258 (file-truename bfname))
259 (concat filename ".txt")
260 filename)))
261 (buffer (if to-buffer
262 (cond
263 ((eq to-buffer 'string)
264 (get-buffer-create "*Org ASCII Export*"))
265 (t (get-buffer-create to-buffer)))
266 (find-file-noselect filename)))
267 (org-levels-open (make-vector org-level-max nil))
268 (odd org-odd-levels-only)
269 (date (plist-get opt-plist :date))
270 (author (plist-get opt-plist :author))
271 (title (or (and subtree-p (org-export-get-title-from-subtree))
272 (plist-get opt-plist :title)
273 (and (not
274 (plist-get opt-plist :skip-before-1st-heading))
275 (org-export-grab-title-from-buffer))
276 (and (buffer-file-name)
277 (file-name-sans-extension
278 (file-name-nondirectory bfname)))
279 "UNTITLED"))
280 (email (plist-get opt-plist :email))
281 (language (plist-get opt-plist :language))
282 (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)"))
283 (todo nil)
284 (lang-words nil)
285 (region
286 (buffer-substring
287 (if (org-region-active-p) (region-beginning) (point-min))
288 (if (org-region-active-p) (region-end) (point-max))))
289 (org-export-footnotes-seen nil)
290 (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
291 (lines (org-split-string
292 (org-export-preprocess-string
293 region
294 :for-backend 'ascii
295 :skip-before-1st-heading
296 (plist-get opt-plist :skip-before-1st-heading)
297 :drawers (plist-get opt-plist :drawers)
298 :tags (plist-get opt-plist :tags)
299 :priority (plist-get opt-plist :priority)
300 :footnotes (plist-get opt-plist :footnotes)
301 :timestamps (plist-get opt-plist :timestamps)
302 :todo-keywords (plist-get opt-plist :todo-keywords)
303 :tasks (plist-get opt-plist :tasks)
304 :verbatim-multiline t
305 :select-tags (plist-get opt-plist :select-tags)
306 :exclude-tags (plist-get opt-plist :exclude-tags)
307 :archived-trees
308 (plist-get opt-plist :archived-trees)
309 :add-text (plist-get opt-plist :text))
310 "\n"))
311 thetoc have-headings first-heading-pos
312 table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
313 (let ((inhibit-read-only t))
314 (org-unmodified
315 (remove-text-properties (point-min) (point-max)
316 '(:org-license-to-kill t))))
317
318 (setq org-min-level (org-get-min-level lines level-offset))
319 (setq org-last-level org-min-level)
320 (org-init-section-numbers)
321 (setq lang-words (or (assoc language org-export-language-setup)
322 (assoc "en" org-export-language-setup)))
323 (set-buffer buffer)
324 (erase-buffer)
325 (fundamental-mode)
326 (org-install-letbind)
327 ;; create local variables for all options, to make sure all called
328 ;; functions get the correct information
329 (mapc (lambda (x)
330 (set (make-local-variable (nth 2 x))
331 (plist-get opt-plist (car x))))
332 org-export-plist-vars)
333 (org-set-local 'org-odd-levels-only odd)
334 (setq umax (if arg (prefix-numeric-value arg)
335 org-export-headline-levels))
336 (setq umax-toc (if (integerp org-export-with-toc)
337 (min org-export-with-toc umax)
338 umax))
339
340 ;; File header
341 (unless body-only
342 (when (and title (not (string= "" title)))
343 (org-insert-centered title ?=)
344 (insert "\n"))
345
346 (if (and (or author email)
347 org-export-author-info)
348 (insert (concat (nth 1 lang-words) ": " (or author "")
349 (if (and org-export-email-info
350 email (string-match "\\S-" email))
351 (concat " <" email ">") "")
352 "\n")))
353
354 (cond
355 ((and date (string-match "%" date))
356 (setq date (format-time-string date)))
357 (date)
358 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
359
360 (if (and date org-export-time-stamp-file)
361 (insert (concat (nth 2 lang-words) ": " date"\n")))
362
363 (unless (= (point) (point-min))
364 (insert "\n\n")))
365
366 (if (and org-export-with-toc (not body-only))
367 (progn
368 (push (concat (nth 3 lang-words) "\n") thetoc)
369 (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
370 "\n") thetoc)
371 (mapc #'(lambda (line)
372 (if (string-match org-todo-line-regexp
373 line)
374 ;; This is a headline
375 (progn
376 (setq have-headings t)
377 (setq level (- (match-end 1) (match-beginning 1)
378 level-offset)
379 level (org-tr-level level)
380 txt (match-string 3 line)
381 todo
382 (or (and org-export-mark-todo-in-toc
383 (match-beginning 2)
384 (not (member (match-string 2 line)
385 org-done-keywords)))
386 ; TODO, not DONE
387 (and org-export-mark-todo-in-toc
388 (= level umax-toc)
389 (org-search-todo-below
390 line lines level))))
391 (setq txt (org-html-expand-for-ascii txt))
392
393 (while (string-match org-bracket-link-regexp txt)
394 (setq txt
395 (replace-match
396 (match-string (if (match-end 2) 3 1) txt)
397 t t txt)))
398
399 (if (and (memq org-export-with-tags '(not-in-toc nil))
400 (string-match
401 (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
402 txt))
403 (setq txt (replace-match "" t t txt)))
404 (if (string-match quote-re0 txt)
405 (setq txt (replace-match "" t t txt 1)))
406
407 (if org-export-with-section-numbers
408 (setq txt (concat (org-section-number level)
409 " " txt)))
410 (if (<= level umax-toc)
411 (progn
412 (push
413 (concat
414 (make-string
415 (* (max 0 (- level org-min-level)) 4) ?\ )
416 (format (if todo "%s (*)\n" "%s\n") txt))
417 thetoc)
418 (setq org-last-level level))
419 ))))
420 lines)
421 (setq thetoc (if have-headings (nreverse thetoc) nil))))
422
423 (org-init-section-numbers)
424 (while (setq line (pop lines))
425 (when (and link-buffer (string-match org-outline-regexp-bol line))
426 (org-export-ascii-push-links (nreverse link-buffer))
427 (setq link-buffer nil))
428 (setq wrap nil)
429 ;; Remove the quoted HTML tags.
430 (setq line (org-html-expand-for-ascii line))
431 ;; Replace links with the description when possible
432 (while (string-match org-bracket-link-analytic-regexp++ line)
433 (setq path (match-string 3 line)
434 link (concat (match-string 1 line) path)
435 type (match-string 2 line)
436 desc0 (match-string 5 line)
437 desc0 (replace-regexp-in-string "\\\\_" "_" desc0)
438 desc (or desc0 link)
439 desc (replace-regexp-in-string "\\\\_" "_" desc))
440 (if (and (> (length link) 8)
441 (equal (substring link 0 8) "coderef:"))
442 (setq line (replace-match
443 (format (org-export-get-coderef-format (substring link 8) desc)
444 (cdr (assoc
445 (substring link 8)
446 org-export-code-refs)))
447 t t line))
448 (setq rpl (concat "[" desc "]"))
449 (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
450 (setq rpl (or (save-match-data
451 (funcall fnc (org-link-unescape path)
452 desc0 'ascii))
453 rpl))
454 (when (and desc0 (not (equal desc0 link)))
455 (if org-export-ascii-links-to-notes
456 (push (cons desc0 link) link-buffer)
457 (setq rpl (concat rpl " (" link ")")
458 wrap (+ (length line) (- (length (match-string 0 line)))
459 (length desc))))))
460 (setq line (replace-match rpl t t line))))
461 (when custom-times
462 (setq line (org-translate-time line)))
463 (cond
464 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
465 ;; a Headline
466 (setq first-heading-pos (or first-heading-pos (point)))
467 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
468 level-offset))
469 txt (match-string 2 line))
470 (org-ascii-level-start level txt umax lines))
471
472 ((and org-export-with-tables
473 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
474 (if (not table-open)
475 ;; New table starts
476 (setq table-open t table-buffer nil))
477 ;; Accumulate lines
478 (setq table-buffer (cons line table-buffer))
479 (when (or (not lines)
480 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
481 (car lines))))
482 (setq table-open nil
483 table-buffer (nreverse table-buffer))
484 (insert (mapconcat
485 (lambda (x)
486 (org-fix-indentation x org-ascii-current-indentation))
487 (org-format-table-ascii table-buffer)
488 "\n") "\n")))
489 (t
490 (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
491 line)
492 (setq line (replace-match "\\1\\3:" t nil line)))
493 (setq line (org-fix-indentation line org-ascii-current-indentation))
494 ;; Remove forced line breaks
495 (if (string-match "\\\\\\\\[ \t]*$" line)
496 (setq line (replace-match "" t t line)))
497 (if (and org-export-with-fixed-width
498 (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
499 (setq line (replace-match "\\1" nil nil line))
500 (if wrap (setq line (org-export-ascii-wrap line wrap))))
501 (insert line "\n"))))
502
503 (org-export-ascii-push-links (nreverse link-buffer))
504
505 (normal-mode)
506
507 ;; insert the table of contents
508 (when thetoc
509 (goto-char (point-min))
510 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
511 (progn
512 (goto-char (match-beginning 0))
513 (replace-match ""))
514 (goto-char first-heading-pos))
515 (mapc 'insert thetoc)
516 (or (looking-at "[ \t]*\n[ \t]*\n")
517 (insert "\n\n")))
518
519 ;; Convert whitespace place holders
520 (goto-char (point-min))
521 (let (beg end)
522 (while (setq beg (next-single-property-change (point) 'org-whitespace))
523 (setq end (next-single-property-change beg 'org-whitespace))
524 (goto-char beg)
525 (delete-region beg end)
526 (insert (make-string (- end beg) ?\ ))))
527
528 ;; remove display and invisible chars
529 (let (beg end)
530 (goto-char (point-min))
531 (while (setq beg (next-single-property-change (point) 'display))
532 (setq end (next-single-property-change beg 'display))
533 (delete-region beg end)
534 (goto-char beg)
535 (insert "=>"))
536 (goto-char (point-min))
537 (while (setq beg (next-single-property-change (point) 'org-cwidth))
538 (setq end (next-single-property-change beg 'org-cwidth))
539 (delete-region beg end)
540 (goto-char beg)))
541 (run-hooks 'org-export-ascii-final-hook)
542 (or to-buffer (save-buffer))
543 (goto-char (point-min))
544 (or (org-export-push-to-kill-ring "ASCII")
545 (message "Exporting... done"))
546 ;; Return the buffer or a string, according to how this function was called
547 (if (eq to-buffer 'string)
548 (prog1 (buffer-substring (point-min) (point-max))
549 (kill-buffer (current-buffer)))
550 (current-buffer))))
551
552;;;###autoload
553(defun org-export-ascii-preprocess (parameters)
554 "Do extra work for ASCII export."
555 ;;
556 ;; Realign tables to get rid of narrowing
557 (when org-export-ascii-table-widen-columns
558 (let ((org-table-do-narrow nil))
559 (goto-char (point-min))
560 (org-ascii-replace-entities)
561 (goto-char (point-min))
562 (org-table-map-tables
563 (lambda () (org-if-unprotected (org-table-align)))
564 'quietly)))
565 ;; Put quotes around verbatim text
566 (goto-char (point-min))
567 (while (re-search-forward org-verbatim-re nil t)
568 (org-if-unprotected-at (match-beginning 4)
569 (goto-char (match-end 2))
570 (backward-delete-char 1) (insert "'")
571 (goto-char (match-beginning 2))
572 (delete-char 1) (insert "`")
573 (goto-char (match-end 2))))
574 ;; Remove target markers
575 (goto-char (point-min))
576 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
577 (org-if-unprotected-at (match-beginning 1)
578 (replace-match "\\1\\2")))
579 ;; Remove list start counters
580 (goto-char (point-min))
581 (while (org-list-search-forward
582 "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t)
583 (replace-match ""))
584 (remove-text-properties
585 (point-min) (point-max)
586 '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
587
588(defun org-html-expand-for-ascii (line)
589 "Handle quoted HTML for ASCII export."
590 (if org-export-html-expand
591 (while (string-match "@<[^<>\n]*>" line)
592 ;; We just remove the tags for now.
593 (setq line (replace-match "" nil nil line))))
594 line)
595
596(defun org-ascii-replace-entities ()
597 "Replace entities with the ASCII representation."
598 (let (e)
599 (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
600 (org-if-unprotected-at (match-beginning 1)
601 (setq e (org-entity-get-representation (match-string 1)
602 org-export-ascii-entities))
603 (and e (replace-match e t t))))))
604
605(defun org-export-ascii-wrap (line where)
606 "Wrap LINE at or before WHERE."
607 (let ((ind (org-get-indentation line))
608 pos)
609 (catch 'found
610 (loop for i from where downto (/ where 2) do
611 (and (equal (aref line i) ?\ )
612 (setq pos i)
613 (throw 'found t))))
614 (if pos
615 (concat (substring line 0 pos) "\n"
616 (make-string ind ?\ )
617 (substring line (1+ pos)))
618 line)))
619
620(defun org-export-ascii-push-links (link-buffer)
621 "Push out links in the buffer."
622 (when link-buffer
623 ;; We still have links to push out.
624 (insert "\n")
625 (let ((ind ""))
626 (save-match-data
627 (if (save-excursion
628 (re-search-backward
629 (concat "^\\(\\([ \t]*\\)\\|\\("
630 org-outline-regexp
631 "\\)\\)[^ \t\n]") nil t))
632 (setq ind (or (match-string 2)
633 (make-string (length (match-string 3)) ?\ )))))
634 (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
635 link-buffer))
636 (insert "\n")))
637
638(defun org-ascii-level-start (level title umax &optional lines)
639 "Insert a new level in ASCII export."
640 (let (char (n (- level umax 1)) (ind 0))
641 (if (> level umax)
642 (progn
643 (insert (make-string (* 2 n) ?\ )
644 (char-to-string (nth (% n (length org-export-ascii-bullets))
645 org-export-ascii-bullets))
646 " " title "\n")
647 ;; find the indentation of the next non-empty line
648 (catch 'stop
649 (while lines
650 (if (string-match "^\\* " (car lines)) (throw 'stop nil))
651 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
652 (throw 'stop (setq ind (org-get-indentation (car lines)))))
653 (pop lines)))
654 (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
655 (if (or (not (equal (char-before) ?\n))
656 (not (equal (char-before (1- (point))) ?\n)))
657 (insert "\n"))
658 (setq char (or (nth (1- level) org-export-ascii-underline)
659 (car (last org-export-ascii-underline))))
660 (unless org-export-with-tags
661 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
662 (setq title (replace-match "" t t title))))
663 (if org-export-with-section-numbers
664 (setq title (concat (org-section-number level) " " title)))
665 (insert title "\n" (make-string (string-width title) char) "\n")
666 (setq org-ascii-current-indentation '(0 . 0)))))
667
668(defun org-insert-centered (s &optional underline)
669 "Insert the string S centered and underline it with character UNDERLINE."
670 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
671 (insert (make-string ind ?\ ) s "\n")
672 (if underline
673 (insert (make-string ind ?\ )
674 (make-string (string-width s) underline)
675 "\n"))))
676
677(defvar org-table-colgroup-info nil)
678(defun org-format-table-ascii (lines)
679 "Format a table for ascii export."
680 (if (stringp lines)
681 (setq lines (org-split-string lines "\n")))
682 (if (not (string-match "^[ \t]*|" (car lines)))
683 ;; Table made by table.el - test for spanning
684 lines
685
686 ;; A normal org table
687 ;; Get rid of hlines at beginning and end
688 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
689 (setq lines (nreverse lines))
690 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
691 (setq lines (nreverse lines))
692 (when org-export-table-remove-special-lines
693 ;; Check if the table has a marking column. If yes remove the
694 ;; column and the special lines
695 (setq lines (org-table-clean-before-export lines)))
696 ;; Get rid of the vertical lines except for grouping
697 (if org-export-ascii-table-keep-all-vertical-lines
698 lines
699 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
700 rtn line vl1 start)
701 (while (setq line (pop lines))
702 (if (string-match org-table-hline-regexp line)
703 (and (string-match "|\\(.*\\)|" line)
704 (setq line (replace-match " \\1" t nil line)))
705 (setq start 0 vl1 vl)
706 (while (string-match "|" line start)
707 (setq start (match-end 0))
708 (or (pop vl1) (setq line (replace-match " " t t line)))))
709 (push line rtn))
710 (nreverse rtn)))))
711
712(defun org-colgroup-info-to-vline-list (info)
713 (let (vl new last)
714 (while info
715 (setq last new new (pop info))
716 (if (or (memq last '(:end :startend))
717 (memq new '(:start :startend)))
718 (push t vl)
719 (push nil vl)))
720 (setq vl (nreverse vl))
721 (and vl (setcar vl nil))
722 vl))
723
724(provide 'org-ascii)
725
726;; Local variables:
727;; generated-autoload-file: "org-loaddefs.el"
728;; End:
729
730;;; org-ascii.el ends here
diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el
deleted file mode 100644
index 78b57a4c005..00000000000
--- a/lisp/org/org-beamer.el
+++ /dev/null
@@ -1,657 +0,0 @@
1;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
2;;
3;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
4;;
5;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
6;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
7;; Keywords: org, wp, tex
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25;;
26;; This library implement the special treatment needed by using the
27;; beamer class during LaTeX export.
28
29;;; Code:
30
31(require 'org)
32(require 'org-exp)
33
34(defvar org-export-latex-header)
35(defvar org-export-latex-options-plist)
36(defvar org-export-opt-plist)
37
38(defgroup org-beamer nil
39 "Options specific for using the beamer class in LaTeX export."
40 :tag "Org Beamer"
41 :group 'org-export-latex)
42
43(defcustom org-beamer-use-parts nil
44 ""
45 :group 'org-beamer
46 :version "24.1"
47 :type 'boolean)
48
49(defcustom org-beamer-frame-level 1
50 "The level that should be interpreted as a frame.
51The levels above this one will be translated into a sectioning structure.
52Setting this to 2 will allow sections, 3 will allow subsections as well.
53You can set this to 4 as well, if you at the same time set
54`org-beamer-use-parts' to make the top levels `\part'."
55 :group 'org-beamer
56 :version "24.1"
57 :type '(choice
58 (const :tag "Frames need a BEAMER_env property" nil)
59 (integer :tag "Specific level makes a frame")))
60
61(defcustom org-beamer-frame-default-options ""
62 "Default options string to use for frames, should contains the [brackets].
63And example for this is \"[allowframebreaks]\"."
64 :group 'org-beamer
65 :version "24.1"
66 :type '(string :tag "[options]"))
67
68(defcustom org-beamer-column-view-format
69 "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)"
70 "Default column view format that should be used to fill the template."
71 :group 'org-beamer
72 :version "24.1"
73 :type '(choice
74 (const :tag "Do not insert Beamer column view format" nil)
75 (string :tag "Beamer column view format")))
76
77(defcustom org-beamer-themes
78 "\\usetheme{default}\\usecolortheme{default}"
79 "Default string to be used for extra heading stuff in beamer presentations.
80When a beamer template is filled, this will be the default for
81BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
82 :group 'org-beamer
83 :version "24.1"
84 :type '(choice
85 (const :tag "Do not insert Beamer themes" nil)
86 (string :tag "Beamer themes")))
87
88(defconst org-beamer-column-widths
89 "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
90 "The column widths that should be installed as allowed property values.")
91
92(defconst org-beamer-transitions
93 "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
94 "Transitions available for beamer.
95These are just a completion help.")
96
97(defconst org-beamer-environments-default
98 '(("frame" "f" "dummy- special handling hard coded" "dummy")
99 ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}")
100 ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}")
101 ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}")
102 ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}")
103 ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}")
104 ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}")
105 ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}")
106 ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}")
107 ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
108 ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
109 ("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
110 ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
111 ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
112 ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
113 ("normal" "h" "%h" "") ; Emit the heading as normal text
114 ("note" "n" "\\note%o%a{%h" "}")
115 ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading
116 ("ignoreheading" "i" "%%%% %h" ""))
117 "Environments triggered by properties in Beamer export.
118These are the defaults - for user definitions, see
119`org-beamer-environments-extra'.
120\"normal\" is a special fake environment, which emit the heading as
121normal text. It is needed when an environment should be surrounded
122by normal text. Since beamer export converts nodes into environments,
123you need to have a node to end the environment.
124For example
125
126 ** a frame
127 some text
128 *** Blocktitle :B_block:
129 inside the block
130 *** After the block :B_normal:
131 continuing here
132 ** next frame")
133
134(defcustom org-beamer-environments-extra nil
135 "Environments triggered by tags in Beamer export.
136Each entry has 4 elements:
137
138name Name of the environment
139key Selection key for `org-beamer-select-environment'
140open The opening template for the environment, with the following escapes
141 %a the action/overlay specification
142 %A the default action/overlay specification
143 %o the options argument of the template
144 %h the headline text
145 %H if there is headline text, that text in {} braces
146 %U if there is headline text, that text in [] brackets
147 %x the content of the BEAMER_extra property
148close The closing string of the environment."
149
150 :group 'org-beamer
151 :version "24.1"
152 :type '(repeat
153 (list
154 (string :tag "Environment")
155 (string :tag "Selection key")
156 (string :tag "Begin")
157 (string :tag "End"))))
158
159(defcustom org-beamer-inherited-properties nil
160 "Properties that should be inherited during beamer export."
161 :group 'org-beamer
162 :type '(repeat
163 (string :tag "Property")))
164
165(defvar org-beamer-frame-level-now nil)
166(defvar org-beamer-header-extra nil)
167(defvar org-beamer-export-is-beamer-p nil)
168(defvar org-beamer-inside-frame-at-level nil)
169(defvar org-beamer-columns-open nil)
170(defvar org-beamer-column-open nil)
171
172(defun org-beamer-cleanup-column-width (width)
173 "Make sure the width is not empty, and that it has a unit."
174 (setq width (org-trim (or width "")))
175 (unless (string-match "\\S-" width) (setq width "0.5"))
176 (if (string-match "\\`[.0-9]+\\'" width)
177 (setq width (concat width "\\textwidth")))
178 width)
179
180(defun org-beamer-open-column (&optional width opt)
181 (org-beamer-close-column-maybe)
182 (setq org-beamer-column-open t)
183 (setq width (org-beamer-cleanup-column-width width))
184 (insert (format "\\begin{column}%s{%s}\n" (or opt "") width)))
185(defun org-beamer-close-column-maybe ()
186 (when org-beamer-column-open
187 (setq org-beamer-column-open nil)
188 (insert "\\end{column}\n")))
189(defun org-beamer-open-columns-maybe (&optional opts)
190 (unless org-beamer-columns-open
191 (setq org-beamer-columns-open t)
192 (insert (format "\\begin{columns}%s\n" (or opts "")))))
193(defun org-beamer-close-columns-maybe ()
194 (org-beamer-close-column-maybe)
195 (when org-beamer-columns-open
196 (setq org-beamer-columns-open nil)
197 (insert "\\end{columns}\n")))
198
199(defun org-beamer-select-environment ()
200 "Select the environment to be used by beamer for this entry.
201While this uses (for convenience) a tag selection interface, the result
202of this command will be that the BEAMER_env *property* of the entry is set.
203
204In addition to this, the command will also set a tag as a visual aid, but
205the tag does not have any semantic meaning."
206 (interactive)
207 (let* ((envs (append org-beamer-environments-extra
208 org-beamer-environments-default))
209 (org-tag-alist
210 (append '((:startgroup))
211 (mapcar (lambda (e) (cons (concat "B_" (car e))
212 (string-to-char (nth 1 e))))
213 envs)
214 '((:endgroup))
215 '(("BMCOL" . ?|))))
216 (org-fast-tag-selection-single-key t))
217 (org-set-tags)
218 (let ((tags (or (ignore-errors (org-get-tags-string)) "")))
219 (cond
220 ((equal org-last-tag-selection-key ?|)
221 (if (string-match ":BMCOL:" tags)
222 (org-set-property "BEAMER_col" (read-string "Column width: "))
223 (org-delete-property "BEAMER_col")))
224 ((string-match (concat ":B_\\("
225 (mapconcat 'car envs "\\|")
226 "\\):")
227 tags)
228 (org-entry-put nil "BEAMER_env" (match-string 1 tags)))
229 (t (org-entry-delete nil "BEAMER_env"))))))
230
231;;;###autoload
232(defun org-beamer-sectioning (level text)
233 "Return the sectioning entry for the current headline.
234LEVEL is the reduced level of the headline.
235TEXT is the text of the headline, everything except the leading stars.
236The return value is a cons cell. The car is the headline text, usually
237just TEXT, but possibly modified if options have been extracted from the
238text. The cdr is the sectioning entry, similar to what is given
239in org-export-latex-classes."
240 (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level))
241 (default
242 (if org-beamer-use-parts
243 '((1 . ("\\part{%s}" . "\\part*{%s}"))
244 (2 . ("\\section{%s}" . "\\section*{%s}"))
245 (3 . ("\\subsection{%s}" . "\\subsection*{%s}")))
246 '((1 . ("\\section{%s}" . "\\section*{%s}"))
247 (2 . ("\\subsection{%s}" . "\\subsection*{%s}")))))
248 (envs (append org-beamer-environments-extra
249 org-beamer-environments-default))
250 (props (org-get-text-property-any 0 'org-props text))
251 (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra
252 columns-option column-option
253 env have-text ass tmp)
254 (if (= frame-level 0) (setq frame-level nil))
255 (when (and org-beamer-inside-frame-at-level
256 (<= level org-beamer-inside-frame-at-level))
257 (setq org-beamer-inside-frame-at-level nil))
258 (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props))
259 (if (and (string-match "\\`[0-9.]+\\'" tmp)
260 (or (= (string-to-number tmp) 1.0)
261 (= (string-to-number tmp) 0.0)))
262 ;; column width 1 means close columns, go back to full width
263 (org-beamer-close-columns-maybe)
264 (when (setq ass (assoc "BEAMER_envargs" props))
265 (let (case-fold-search)
266 (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
267 (setq columns-option (match-string 1 (cdr ass)))
268 (setcdr ass (replace-match "" t t (cdr ass))))
269 (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
270 (setq column-option (match-string 1 (cdr ass)))
271 (setcdr ass (replace-match "" t t (cdr ass))))))
272 (org-beamer-open-columns-maybe columns-option)
273 (org-beamer-open-column tmp column-option)))
274 (cond
275 ((or (equal (cdr (assoc "BEAMER_env" props)) "frame")
276 (and frame-level (= level frame-level)))
277 ;; A frame
278 (org-beamer-get-special props)
279
280 (setq in (org-fill-template
281 "\\begin{frame}%a%A%o%T%S%x"
282 (list (cons "a" (or org-beamer-action ""))
283 (cons "A" (or org-beamer-defaction ""))
284 (cons "o" (or org-beamer-option org-beamer-frame-default-options ""))
285 (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
286 (cons "h" "%s")
287 (cons "T" (if (string-match "\\S-" text)
288 "\n\\frametitle{%s}" ""))
289 (cons "S" (if (string-match "\\\\\\\\" text)
290 "\n\\framesubtitle{%s}" ""))))
291 out (copy-sequence "\\end{frame}"))
292 (org-add-props out
293 '(org-insert-hook org-beamer-close-columns-maybe))
294 (setq org-beamer-inside-frame-at-level level)
295 (cons text (list in out in out)))
296 ((and (setq env (cdr (assoc "BEAMER_env" props)))
297 (setq ass (assoc env envs)))
298 ;; A beamer environment selected by the BEAMER_env property
299 (if (string-match "[ \t]+:[ \t]*$" text)
300 (setq text (replace-match "" t t text)))
301 (if (member env '("note" "noteNH"))
302 ;; There should be no labels in a note, so we remove the targets
303 ;; FIXME???
304 (remove-text-properties 0 (length text) '(target nil) text))
305 (org-beamer-get-special props)
306 (setq text (org-trim text))
307 (setq have-text (string-match "\\S-" text))
308 (setq in (org-fill-template
309 (nth 2 ass)
310 (list (cons "a" (or org-beamer-action ""))
311 (cons "A" (or org-beamer-defaction ""))
312 (cons "o" (or org-beamer-option ""))
313 (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
314 (cons "h" "%s")
315 (cons "H" (if have-text (concat "{" text "}") ""))
316 (cons "U" (if have-text (concat "[" text "]") ""))))
317 out (nth 3 ass))
318 (cond
319 ((equal out "\\end{columns}")
320 (setq org-beamer-columns-open t)
321 (setq out (org-add-props (copy-sequence out)
322 '(org-insert-hook
323 (lambda ()
324 (org-beamer-close-column-maybe)
325 (setq org-beamer-columns-open nil))))))
326 ((equal out "\\end{column}")
327 (org-beamer-open-columns-maybe)))
328 (cons text (list in out in out)))
329 ((and (not org-beamer-inside-frame-at-level)
330 (or (not frame-level)
331 (< level frame-level))
332 (assoc level default))
333 ;; Normal sectioning
334 (cons text (cdr (assoc level default))))
335 (t nil))))
336
337(defvar org-beamer-extra)
338(defvar org-beamer-option)
339(defvar org-beamer-action)
340(defvar org-beamer-defaction)
341(defvar org-beamer-environment)
342(defun org-beamer-get-special (props)
343 "Extract an option, action, and default action string from text.
344The variables org-beamer-option, org-beamer-action, org-beamer-defaction,
345org-beamer-extra are all scoped into this function dynamically."
346 (let (tmp)
347 (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props))
348 (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
349 (when org-beamer-extra
350 (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra)))
351 (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props))
352 (when tmp
353 (setq tmp (copy-sequence tmp))
354 (if (string-match "\\[<[^][<>]*>\\]" tmp)
355 (setq org-beamer-defaction (match-string 0 tmp)
356 tmp (replace-match "" t t tmp)))
357 (if (string-match "\\[[^][]*\\]" tmp)
358 (setq org-beamer-option (match-string 0 tmp)
359 tmp (replace-match "" t t tmp)))
360 (if (string-match "<[^<>]*>" tmp)
361 (setq org-beamer-action (match-string 0 tmp)
362 tmp (replace-match "" t t tmp))))))
363
364(defun org-beamer-assoc-not-empty (elt list)
365 (let ((tmp (cdr (assoc elt list))))
366 (and tmp (string-match "\\S-" tmp) tmp)))
367
368
369(defvar org-beamer-mode-map (make-sparse-keymap)
370 "The keymap for `org-beamer-mode'.")
371(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
372
373;;;###autoload
374(define-minor-mode org-beamer-mode
375 "Special support for editing Org-mode files made to export to beamer."
376 nil " Bm" nil)
377(when (fboundp 'font-lock-add-keywords)
378 (font-lock-add-keywords
379 'org-mode
380 '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend))
381 'prepent))
382
383(defun org-beamer-place-default-actions-for-lists ()
384 "Find default overlay specifications in items, and move them.
385The need to be after the begin statement of the environment."
386 (when org-beamer-export-is-beamer-p
387 (let (dovl)
388 (goto-char (point-min))
389 (while (re-search-forward
390 "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t)
391 (if (setq dovl (cdr (assoc "BEAMER_dovl"
392 (get-text-property (match-end 0)
393 'org-props))))
394 (save-excursion
395 (goto-char (1+ (match-end 1)))
396 (insert dovl)))))))
397
398(defun org-beamer-amend-header ()
399 "Add `org-beamer-header-extra' to the LaTeX header.
400If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line
401by itself, it will be replaced with `org-beamer-header-extra'. If not,
402the value will be inserted right after the documentclass statement."
403 (when (and org-beamer-export-is-beamer-p
404 org-beamer-header-extra)
405 (goto-char (point-min))
406 (cond
407 ((re-search-forward
408 "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t)
409 (replace-match org-beamer-header-extra t t)
410 (or (bolp) (insert "\n")))
411 ((re-search-forward "^[ \t]*\\\\begin{document}" nil t)
412 (beginning-of-line 1)
413 (insert org-beamer-header-extra)
414 (or (bolp) (insert "\n"))))))
415
416(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
417 "If this regexp matches in a frame, the frame is marked as fragile."
418 :group 'org-beamer
419 :version "24.1"
420 :type 'regexp)
421
422(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
423 "The special face for beamer tags."
424 :group 'org-beamer)
425
426
427;; Functions to initialize and post-process
428;; These functions will be hooked into various places in the export process
429
430(defun org-beamer-initialize-open-trackers ()
431 "Reset variables that track if certain environments are open during export."
432 (setq org-beamer-columns-open nil)
433 (setq org-beamer-column-open nil)
434 (setq org-beamer-inside-frame-at-level nil)
435 (setq org-beamer-export-is-beamer-p nil))
436
437(defun org-beamer-after-initial-vars ()
438 "Find special settings for beamer and store them.
439The effect is that these values will be accessible during export."
440 ;; First verify that we are exporting using the beamer class
441 (setq org-beamer-export-is-beamer-p
442 (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}"
443 org-export-latex-header))
444 (when org-beamer-export-is-beamer-p
445 ;; Find the frame level
446 (setq org-beamer-frame-level-now
447 (or (and (org-region-active-p)
448 (save-excursion
449 (goto-char (region-beginning))
450 (and (looking-at org-complex-heading-regexp)
451 (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective))))
452 (save-excursion
453 (save-restriction
454 (widen)
455 (goto-char (point-min))
456 (and (re-search-forward
457 "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t)
458 (match-string 1))))
459 (plist-get org-export-latex-options-plist :beamer-frame-level)
460 org-beamer-frame-level))
461 ;; Normalize the value so that the functions can trust the value
462 (cond
463 ((not org-beamer-frame-level-now)
464 (setq org-beamer-frame-level-now nil))
465 ((stringp org-beamer-frame-level-now)
466 (setq org-beamer-frame-level-now
467 (string-to-number org-beamer-frame-level-now))))
468 ;; Find the header additions, most likely theme commands
469 (setq org-beamer-header-extra
470 (or (and (org-region-active-p)
471 (save-excursion
472 (goto-char (region-beginning))
473 (and (looking-at org-complex-heading-regexp)
474 (org-entry-get nil "BEAMER_HEADER_EXTRA"
475 'selective))))
476 (save-excursion
477 (save-restriction
478 (widen)
479 (let ((txt ""))
480 (goto-char (point-min))
481 (while (re-search-forward
482 "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$"
483 nil t)
484 (setq txt (concat txt "\n" (match-string 1))))
485 (if (> (length txt) 0) (substring txt 1)))))
486 (plist-get org-export-latex-options-plist
487 :beamer-header-extra)))
488 (let ((inhibit-read-only t)
489 (case-fold-search nil)
490 props)
491 (org-unmodified
492 (remove-text-properties (point-min) (point-max) '(org-props nil))
493 (org-map-entries
494 '(progn
495 (setq props (org-entry-properties nil 'standard))
496 (if (and (not (assoc "BEAMER_env" props))
497 (looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
498 (push (cons "BEAMER_env" (match-string 1)) props))
499 (when (org-bound-and-true-p org-beamer-inherited-properties)
500 (mapc (lambda (p)
501 (unless (assoc p props)
502 (let ((v (org-entry-get nil p 'inherit)))
503 (and v (push (cons p v) props)))))
504 org-beamer-inherited-properties))
505 (put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
506 (setq org-export-latex-options-plist
507 (plist-put org-export-latex-options-plist :tags nil))))))
508
509(defun org-beamer-auto-fragile-frames ()
510 "Mark any frames containing verbatim environments as fragile.
511This function will run in the final LaTeX document."
512 (when org-beamer-export-is-beamer-p
513 (let (opts)
514 (goto-char (point-min))
515 ;; Find something that might be fragile
516 (while (re-search-forward org-beamer-fragile-re nil t)
517 (save-excursion
518 ;; Are we inside a frame here?
519 (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?"
520 nil t)
521 (equal (match-string 1) "begin"))
522 ;; yes, inside a frame, make sure "fragile" is one of the options
523 (goto-char (match-end 0))
524 (if (not (looking-at "\\[.*?\\]"))
525 (insert "[fragile]")
526 (setq opts (substring (match-string 0) 1 -1))
527 (delete-region (match-beginning 0) (match-end 0))
528 (setq opts (org-split-string opts ","))
529 (add-to-list 'opts "fragile")
530 (insert "[" (mapconcat 'identity opts ",") "]"))))))))
531
532(defcustom org-beamer-outline-frame-title "Outline"
533 "Default title of a frame containing an outline."
534 :group 'org-beamer
535 :version "24.1"
536 :type '(string :tag "Outline frame title")
537 )
538
539(defcustom org-beamer-outline-frame-options nil
540 "Outline frame options appended after \\begin{frame}.
541You might want to put e.g. [allowframebreaks=0.9] here. Remember to
542include square brackets."
543 :group 'org-beamer
544 :version "24.1"
545 :type '(string :tag "Outline frame options")
546 )
547
548(defun org-beamer-fix-toc ()
549 "Fix the table of contents by removing the vspace line."
550 (when org-beamer-export-is-beamer-p
551 (save-excursion
552 (goto-char (point-min))
553 (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)"
554 nil t)
555 (replace-match
556 (concat "\\\\begin{frame}" org-beamer-outline-frame-options
557 "\n\\\\frametitle{"
558 org-beamer-outline-frame-title
559 "}\n\\1\\\\end{frame}")
560 t nil)))))
561
562(defun org-beamer-property-changed (property value)
563 "Track the BEAMER_env property with tags."
564 (cond
565 ((equal property "BEAMER_env")
566 (save-excursion
567 (org-back-to-heading t)
568 (let ((tags (org-get-tags)))
569 (setq tags (delq nil (mapcar (lambda (x)
570 (if (string-match "^B_" x) nil x))
571 tags)))
572 (org-set-tags-to tags))
573 (when (and value (stringp value) (string-match "\\S-" value))
574 (org-toggle-tag (concat "B_" value) 'on))))
575 ((equal property "BEAMER_col")
576 (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value))
577 'on 'off)))))
578
579(defun org-beamer-select-beamer-code ()
580 "Take code marked for BEAMER and turn it into marked for LaTeX."
581 (when org-beamer-export-is-beamer-p
582 (goto-char (point-min))
583 (while (re-search-forward
584 "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t)
585 (replace-match "\\1latex"))))
586
587;; OK, hook all these functions into appropriate places
588(add-hook 'org-export-first-hook
589 'org-beamer-initialize-open-trackers)
590(add-hook 'org-property-changed-functions
591 'org-beamer-property-changed)
592(add-hook 'org-export-latex-after-initial-vars-hook
593 'org-beamer-after-initial-vars)
594(add-hook 'org-export-latex-final-hook
595 'org-beamer-place-default-actions-for-lists)
596(add-hook 'org-export-latex-final-hook
597 'org-beamer-auto-fragile-frames)
598(add-hook 'org-export-latex-final-hook
599 'org-beamer-fix-toc)
600(add-hook 'org-export-latex-final-hook
601 'org-beamer-amend-header)
602(add-hook 'org-export-preprocess-before-selecting-backend-code-hook
603 'org-beamer-select-beamer-code)
604
605(defun org-insert-beamer-options-template (&optional kind)
606 "Insert a settings template, to make sure users do this right."
607 (interactive (progn
608 (message "Current [s]ubtree or [g]lobal?")
609 (if (equal (read-char-exclusive) ?g)
610 (list 'global)
611 (list 'subtree))))
612 (if (eq kind 'subtree)
613 (progn
614 (org-back-to-heading t)
615 (org-reveal)
616 (org-entry-put nil "LaTeX_CLASS" "beamer")
617 (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]")
618 (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
619 (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string
620 org-beamer-frame-level))
621 (when org-beamer-themes
622 (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes))
623 (when org-beamer-column-view-format
624 (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
625 (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC"))
626 (insert "#+LaTeX_CLASS: beamer\n")
627 (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
628 (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n")
629 (when org-beamer-themes
630 (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n"))
631 (when org-beamer-column-view-format
632 (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
633 (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n")))
634
635
636(defun org-beamer-allowed-property-values (property)
637 "Supply allowed values for BEAMER properties."
638 (cond
639 ((and (equal property "BEAMER_env")
640 (not (org-entry-get nil (concat property "_ALL") 'inherit)))
641 ;; If no allowed values for BEAMER_env have been defined,
642 ;; supply all defined environments
643 (mapcar 'car (append org-beamer-environments-extra
644 org-beamer-environments-default)))
645 ((and (equal property "BEAMER_col")
646 (not (org-entry-get nil (concat property "_ALL") 'inherit)))
647 ;; If no allowed values for BEAMER_col have been defined,
648 ;; supply some
649 '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC"))
650 (t nil)))
651
652(add-hook 'org-property-allowed-value-functions
653 'org-beamer-allowed-property-values)
654
655(provide 'org-beamer)
656
657;;; org-beamer.el ends here
diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el
deleted file mode 100644
index d3789ad3aa8..00000000000
--- a/lisp/org/org-exp-blocks.el
+++ /dev/null
@@ -1,402 +0,0 @@
1;;; org-exp-blocks.el --- pre-process blocks when exporting org files
2
3;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
4
5;; Author: Eric Schulte
6
7;; This file is part of GNU Emacs.
8;;
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23;;
24;; This is a utility for pre-processing blocks in org files before
25;; export using the `org-export-preprocess-hook'. It can be used for
26;; exporting new types of blocks from org-mode files and also for
27;; changing the default export behavior of existing org-mode blocks.
28;; The `org-export-blocks' and `org-export-interblocks' variables can
29;; be used to control how blocks and the spaces between blocks
30;; respectively are processed upon export.
31;;
32;; The type of a block is defined as the string following =#+begin_=,
33;; so for example the following block would be of type ditaa. Note
34;; that both upper or lower case are allowed in =#+BEGIN_= and
35;; =#+END_=.
36;;
37;; #+begin_ditaa blue.png -r -S
38;; +---------+
39;; | cBLU |
40;; | |
41;; | +----+
42;; | |cPNK|
43;; | | |
44;; +----+----+
45;; #+end_ditaa
46;;
47;;; Currently Implemented Block Types
48;;
49;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
50;; ascii pictures to actual images using ditaa
51;; http://ditaa.sourceforge.net/. To use this set
52;; `org-ditaa-jar-path' to the path to ditaa.jar on your
53;; system (should be set automatically in most cases) .
54;;
55;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
56;; graphs defined using the dot graphing language to images
57;; using the dot utility. For information on dot see
58;; http://www.graphviz.org/
59;;
60;; export-comment :: Wrap comments with titles and author information,
61;; in their own divs with author-specific ids allowing for
62;; css coloring of comments based on the author.
63;;
64;;; Adding new blocks
65;;
66;; When adding a new block type first define a formatting function
67;; along the same lines as `org-export-blocks-format-dot' and then use
68;; `org-export-blocks-add-block' to add your block type to
69;; `org-export-blocks'.
70
71;;; Code:
72
73(eval-when-compile
74 (require 'cl))
75(require 'find-func)
76(require 'org-compat)
77
78(declare-function org-split-string "org" (string &optional separators))
79(declare-function org-remove-indentation "org" (code &optional n))
80
81(defvar org-protecting-blocks nil) ; From org.el
82
83(defun org-export-blocks-set (var value)
84 "Set the value of `org-export-blocks' and install fontification."
85 (set var value)
86 (mapc (lambda (spec)
87 (if (nth 2 spec)
88 (setq org-protecting-blocks
89 (delete (symbol-name (car spec))
90 org-protecting-blocks))
91 (add-to-list 'org-protecting-blocks
92 (symbol-name (car spec)))))
93 value))
94
95(defcustom org-export-blocks
96 '((export-comment org-export-blocks-format-comment t)
97 (ditaa org-export-blocks-format-ditaa nil)
98 (dot org-export-blocks-format-dot nil))
99 "Use this alist to associate block types with block exporting functions.
100The type of a block is determined by the text immediately
101following the '#+BEGIN_' portion of the block header. Each block
102export function should accept three arguments."
103 :group 'org-export-general
104 :type '(repeat
105 (list
106 (symbol :tag "Block name")
107 (function :tag "Block formatter")
108 (boolean :tag "Fontify content as Org syntax")))
109 :set 'org-export-blocks-set)
110
111(defun org-export-blocks-add-block (block-spec)
112 "Add a new block type to `org-export-blocks'.
113BLOCK-SPEC should be a three element list the first element of
114which should indicate the name of the block, the second element
115should be the formatting function called by
116`org-export-blocks-preprocess' and the third element a flag
117indicating whether these types of blocks should be fontified in
118org-mode buffers (see `org-protecting-blocks'). For example the
119BLOCK-SPEC for ditaa blocks is as follows.
120
121 (ditaa org-export-blocks-format-ditaa nil)"
122 (unless (member block-spec org-export-blocks)
123 (setq org-export-blocks (cons block-spec org-export-blocks))
124 (org-export-blocks-set 'org-export-blocks org-export-blocks)))
125
126(defcustom org-export-interblocks
127 '()
128 "Use this a-list to associate block types with block exporting functions.
129The type of a block is determined by the text immediately
130following the '#+BEGIN_' portion of the block header. Each block
131export function should accept three arguments."
132 :group 'org-export-general
133 :type 'alist)
134
135(defcustom org-export-blocks-witheld
136 '(hidden)
137 "List of block types (see `org-export-blocks') which should not be exported."
138 :group 'org-export-general
139 :type 'list)
140
141(defcustom org-export-blocks-postblock-hook nil
142 "Run after blocks have been processed with `org-export-blocks-preprocess'."
143 :group 'org-export-general
144 :version "24.1"
145 :type 'hook)
146
147(defun org-export-blocks-html-quote (body &optional open close)
148 "Protect BODY from org html export.
149The optional OPEN and CLOSE tags will be inserted around BODY."
150 (concat
151 "\n#+BEGIN_HTML\n"
152 (or open "")
153 body (if (string-match "\n$" body) "" "\n")
154 (or close "")
155 "#+END_HTML\n"))
156
157(defun org-export-blocks-latex-quote (body &optional open close)
158 "Protect BODY from org latex export.
159The optional OPEN and CLOSE tags will be inserted around BODY."
160 (concat
161 "\n#+BEGIN_LaTeX\n"
162 (or open "")
163 body (if (string-match "\n$" body) "" "\n")
164 (or close "")
165 "#+END_LaTeX\n"))
166
167(defvar org-src-preserve-indentation) ; From org-src.el
168(defun org-export-blocks-preprocess ()
169 "Export all blocks according to the `org-export-blocks' block export alist.
170Does not export block types specified in specified in BLOCKS
171which defaults to the value of `org-export-blocks-witheld'."
172 (interactive)
173 (save-window-excursion
174 (let ((case-fold-search t)
175 (interblock (lambda (start end)
176 (mapcar (lambda (pair) (funcall (second pair) start end))
177 org-export-interblocks)))
178 matched indentation type types func
179 start end body headers preserve-indent progress-marker)
180 (goto-char (point-min))
181 (setq start (point))
182 (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
183 (while (re-search-forward beg-re nil t)
184 (let* ((match-start (copy-marker (match-beginning 0)))
185 (body-start (copy-marker (match-end 0)))
186 (indentation (length (match-string 1)))
187 (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
188 (regexp-quote (downcase (match-string 2)))))
189 (type (intern (downcase (match-string 2))))
190 (headers (save-match-data
191 (org-split-string (match-string 3) "[ \t]+")))
192 (balanced 1)
193 (preserve-indent (or org-src-preserve-indentation
194 (member "-i" headers)))
195 match-end)
196 (while (and (not (zerop balanced))
197 (re-search-forward inner-re nil t))
198 (if (string= (downcase (match-string 1)) "end")
199 (decf balanced)
200 (incf balanced)))
201 (when (not (zerop balanced))
202 (error "Unbalanced begin/end_%s blocks with %S"
203 type (buffer-substring match-start (point))))
204 (setq match-end (copy-marker (match-end 0)))
205 (unless preserve-indent
206 (setq body (save-match-data (org-remove-indentation
207 (buffer-substring
208 body-start (match-beginning 0))))))
209 (unless (memq type types) (setq types (cons type types)))
210 (save-match-data (funcall interblock start match-start))
211 (when (setq func (cadr (assoc type org-export-blocks)))
212 (let ((replacement (save-match-data
213 (if (memq type org-export-blocks-witheld) ""
214 (apply func body headers)))))
215 ;; ;; un-comment this code after the org-element merge
216 ;; (save-match-data
217 ;; (when (and replacement (string= replacement ""))
218 ;; (delete-region
219 ;; (car (org-element-collect-affiliated-keyword))
220 ;; match-start)))
221 (when replacement
222 (delete-region match-start match-end)
223 (goto-char match-start) (insert replacement)
224 (if preserve-indent
225 ;; indent only the code block markers
226 (save-excursion
227 (indent-line-to indentation) ; indent end_block
228 (goto-char match-start)
229 (indent-line-to indentation)) ; indent begin_block
230 ;; indent everything
231 (indent-code-rigidly match-start (point) indentation)))))
232 ;; cleanup markers
233 (set-marker match-start nil)
234 (set-marker body-start nil)
235 (set-marker match-end nil))
236 (setq start (point))))
237 (funcall interblock start (point-max))
238 (run-hooks 'org-export-blocks-postblock-hook))))
239
240;;================================================================================
241;; type specific functions
242
243;;--------------------------------------------------------------------------------
244;; ditaa: create images from ASCII art using the ditaa utility
245(defcustom org-ditaa-jar-path (expand-file-name
246 "ditaa.jar"
247 (file-name-as-directory
248 (expand-file-name
249 "scripts"
250 (file-name-as-directory
251 (expand-file-name
252 "../contrib"
253 (file-name-directory (org-find-library-dir "org")))))))
254 "Path to the ditaa jar executable."
255 :group 'org-babel
256 :type 'string)
257
258(defvar org-export-current-backend) ; dynamically bound in org-exp.el
259(defun org-export-blocks-format-ditaa (body &rest headers)
260 "DEPRECATED: use begin_src ditaa code blocks
261
262Pass block BODY to the ditaa utility creating an image.
263Specify the path at which the image should be saved as the first
264element of headers, any additional elements of headers will be
265passed to the ditaa utility as command line arguments."
266 (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
267 (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
268 (data-file (make-temp-file "org-ditaa"))
269 (hash (progn
270 (set-text-properties 0 (length body) nil body)
271 (sha1 (prin1-to-string (list body args)))))
272 (raw-out-file (if headers (car headers)))
273 (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
274 (cons (match-string 1 raw-out-file)
275 (match-string 2 raw-out-file))
276 (cons raw-out-file "png")))
277 (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
278 (unless (file-exists-p org-ditaa-jar-path)
279 (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
280 (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
281 body
282 (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
283 (org-split-string body "\n")
284 "\n")))
285 (prog1
286 (cond
287 ((member org-export-current-backend '(html latex docbook))
288 (unless (file-exists-p out-file)
289 (mapc ;; remove old hashed versions of this file
290 (lambda (file)
291 (when (and (string-match (concat (regexp-quote (car out-file-parts))
292 "_\\([[:alnum:]]+\\)\\."
293 (regexp-quote (cdr out-file-parts)))
294 file)
295 (= (length (match-string 1 out-file)) 40))
296 (delete-file (expand-file-name file
297 (file-name-directory out-file)))))
298 (directory-files (or (file-name-directory out-file)
299 default-directory)))
300 (with-temp-file data-file (insert body))
301 (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
302 (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
303 (format "\n[[file:%s]]\n" out-file))
304 (t (concat
305 "\n#+BEGIN_EXAMPLE\n"
306 body (if (string-match "\n$" body) "" "\n")
307 "#+END_EXAMPLE\n")))
308 (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
309
310;;--------------------------------------------------------------------------------
311;; dot: create graphs using the dot graphing language
312;; (require the dot executable to be in your path)
313(defun org-export-blocks-format-dot (body &rest headers)
314 "DEPRECATED: use \"#+begin_src dot\" code blocks
315
316Pass block BODY to the dot graphing utility creating an image.
317Specify the path at which the image should be saved as the first
318element of headers, any additional elements of headers will be
319passed to the dot utility as command line arguments. Don't
320forget to specify the output type for the dot command, so if you
321are exporting to a file with a name like 'image.png' you should
322include a '-Tpng' argument, and your block should look like the
323following.
324
325#+begin_dot models.png -Tpng
326digraph data_relationships {
327 \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
328 \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
329 \"data_requirement\" -> \"data_product\"
330}
331#+end_dot"
332 (message "begin_dot blocks are DEPRECATED, use begin_src blocks")
333 (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
334 (data-file (make-temp-file "org-ditaa"))
335 (hash (progn
336 (set-text-properties 0 (length body) nil body)
337 (sha1 (prin1-to-string (list body args)))))
338 (raw-out-file (if headers (car headers)))
339 (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
340 (cons (match-string 1 raw-out-file)
341 (match-string 2 raw-out-file))
342 (cons raw-out-file "png")))
343 (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
344 (prog1
345 (cond
346 ((member org-export-current-backend '(html latex docbook))
347 (unless (file-exists-p out-file)
348 (mapc ;; remove old hashed versions of this file
349 (lambda (file)
350 (when (and (string-match (concat (regexp-quote (car out-file-parts))
351 "_\\([[:alnum:]]+\\)\\."
352 (regexp-quote (cdr out-file-parts)))
353 file)
354 (= (length (match-string 1 out-file)) 40))
355 (delete-file (expand-file-name file
356 (file-name-directory out-file)))))
357 (directory-files (or (file-name-directory out-file)
358 default-directory)))
359 (with-temp-file data-file (insert body))
360 (message (concat "dot " data-file " " args " -o " out-file))
361 (shell-command (concat "dot " data-file " " args " -o " out-file)))
362 (format "\n[[file:%s]]\n" out-file))
363 (t (concat
364 "\n#+BEGIN_EXAMPLE\n"
365 body (if (string-match "\n$" body) "" "\n")
366 "#+END_EXAMPLE\n")))
367 (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
368
369;;--------------------------------------------------------------------------------
370;; comment: export comments in author-specific css-stylable divs
371(defun org-export-blocks-format-comment (body &rest headers)
372 "Format comment BODY by OWNER and return it formatted for export.
373Currently, this only does something for HTML export, for all
374other backends, it converts the comment into an EXAMPLE segment."
375 (let ((owner (if headers (car headers)))
376 (title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
377 (cond
378 ((eq org-export-current-backend 'html) ;; We are exporting to HTML
379 (concat "#+BEGIN_HTML\n"
380 "<div class=\"org-comment\""
381 (if owner (format " id=\"org-comment-%s\" " owner))
382 ">\n"
383 (if owner (concat "<b>" owner "</b> ") "")
384 (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
385 "<p>\n"
386 "#+END_HTML\n"
387 body
388 "\n#+BEGIN_HTML\n"
389 "</p>\n"
390 "</div>\n"
391 "#+END_HTML\n"))
392 (t ;; This is not HTML, so just make it an example.
393 (concat "#+BEGIN_EXAMPLE\n"
394 (if title (concat "Title:" title "\n") "")
395 (if owner (concat "By:" owner "\n") "")
396 body
397 (if (string-match "\n\\'" body) "" "\n")
398 "#+END_EXAMPLE\n")))))
399
400(provide 'org-exp-blocks)
401
402;;; org-exp-blocks.el ends here
diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el
deleted file mode 100644
index 82b9003e4fd..00000000000
--- a/lisp/org/org-exp.el
+++ /dev/null
@@ -1,3354 +0,0 @@
1;;; org-exp.el --- Export internals for Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;;; Code:
28
29(require 'org)
30(require 'org-macs)
31(require 'org-agenda)
32(require 'org-exp-blocks)
33(require 'ob-exp)
34(require 'org-src)
35
36(eval-when-compile
37 (require 'cl))
38
39(declare-function org-export-latex-preprocess "org-latex" (parameters))
40(declare-function org-export-ascii-preprocess "org-ascii" (parameters))
41(declare-function org-export-html-preprocess "org-html" (parameters))
42(declare-function org-export-docbook-preprocess "org-docbook" (parameters))
43(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
44(declare-function org-export-htmlize-region-for-paste "org-html" (beg end))
45(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
46(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
47(declare-function org-table-cookie-line-p "org-table" (line))
48(declare-function org-table-colgroup-line-p "org-table" (line))
49(declare-function org-pop-to-buffer-same-window "org-compat"
50 (&optional buffer-or-name norecord label))
51(declare-function org-unescape-code-in-region "org-src" (beg end))
52
53(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
54
55(autoload 'org-export-as-odt "org-odt"
56 "Export the outline to a OpenDocument Text file." t)
57(autoload 'org-export-as-odt-and-open "org-odt"
58 "Export the outline to a OpenDocument Text file and open it." t)
59
60(defgroup org-export nil
61 "Options for exporting org-listings."
62 :tag "Org Export"
63 :group 'org)
64
65(defgroup org-export-general nil
66 "General options for exporting Org-mode files."
67 :tag "Org Export General"
68 :group 'org-export)
69
70(defcustom org-export-allow-BIND 'confirm
71 "Non-nil means allow #+BIND to define local variable values for export.
72This is a potential security risk, which is why the user must confirm the
73use of these lines."
74 :group 'org-export-general
75 :type '(choice
76 (const :tag "Never" nil)
77 (const :tag "Always" t)
78 (const :tag "Make the user confirm for each file" confirm)))
79
80;; FIXME
81(defvar org-export-publishing-directory nil)
82
83(defcustom org-export-show-temporary-export-buffer t
84 "Non-nil means show buffer after exporting to temp buffer.
85When Org exports to a file, the buffer visiting that file is ever
86shown, but remains buried. However, when exporting to a temporary
87buffer, that buffer is popped up in a second window. When this variable
88is nil, the buffer remains buried also in these cases."
89 :group 'org-export-general
90 :type 'boolean)
91
92(defcustom org-export-copy-to-kill-ring t
93 "Non-nil means exported stuff will also be pushed onto the kill ring."
94 :group 'org-export-general
95 :type 'boolean)
96
97(defcustom org-export-kill-product-buffer-when-displayed nil
98 "Non-nil means kill the product buffer if it is displayed immediately.
99This applied to the commands `org-export-as-html-and-open' and
100`org-export-as-pdf-and-open'."
101 :group 'org-export-general
102 :version "24.1"
103 :type 'boolean)
104
105(defcustom org-export-run-in-background nil
106 "Non-nil means export and publishing commands will run in background.
107This works by starting up a separate Emacs process visiting the same file
108and doing the export from there.
109Not all export commands are affected by this - only the ones which
110actually write to a file, and that do not depend on the buffer state.
111\\<org-mode-map>
112If this option is nil, you can still get background export by calling
113`org-export' with a double prefix arg: \
114\\[universal-argument] \\[universal-argument] \\[org-export].
115
116If this option is t, the double prefix can be used to exceptionally
117force an export command into the current process."
118 :group 'org-export-general
119 :type 'boolean)
120
121(defcustom org-export-initial-scope 'buffer
122 "The initial scope when exporting with `org-export'.
123This variable can be either set to 'buffer or 'subtree."
124 :group 'org-export-general
125 :version "24.1"
126 :type '(choice
127 (const :tag "Export current buffer" 'buffer)
128 (const :tag "Export current subtree" 'subtree)))
129
130(defcustom org-export-select-tags '("export")
131 "Tags that select a tree for export.
132If any such tag is found in a buffer, all trees that do not carry one
133of these tags will be deleted before export.
134Inside trees that are selected like this, you can still deselect a
135subtree by tagging it with one of the `org-export-exclude-tags'."
136 :group 'org-export-general
137 :type '(repeat (string :tag "Tag")))
138
139(defcustom org-export-exclude-tags '("noexport")
140 "Tags that exclude a tree from export.
141All trees carrying any of these tags will be excluded from export.
142This is without condition, so even subtrees inside that carry one of the
143`org-export-select-tags' will be removed."
144 :group 'org-export-general
145 :type '(repeat (string :tag "Tag")))
146
147;; FIXME: rename, this is a general variable
148(defcustom org-export-html-expand t
149 "Non-nil means for HTML export, treat @<...> as HTML tag.
150When nil, these tags will be exported as plain text and therefore
151not be interpreted by a browser.
152
153This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
154 :group 'org-export-html
155 :group 'org-export-general
156 :type 'boolean)
157
158(defcustom org-export-with-special-strings t
159 "Non-nil means interpret \"\-\", \"--\" and \"---\" for export.
160When this option is turned on, these strings will be exported as:
161
162 Org HTML LaTeX
163 -----+----------+--------
164 \\- &shy; \\-
165 -- &ndash; --
166 --- &mdash; ---
167 ... &hellip; \ldots
168
169This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
170 :group 'org-export-translation
171 :type 'boolean)
172
173(defcustom org-export-html-link-up ""
174 "Where should the \"UP\" link of exported HTML pages lead?"
175 :group 'org-export-html
176 :group 'org-export-general
177 :type '(string :tag "File or URL"))
178
179(defcustom org-export-html-link-home ""
180 "Where should the \"HOME\" link of exported HTML pages lead?"
181 :group 'org-export-html
182 :group 'org-export-general
183 :type '(string :tag "File or URL"))
184
185(defcustom org-export-language-setup
186 '(("en" "Author" "Date" "Table of Contents" "Footnotes")
187 ("ca" "Autor" "Data" "&Iacute;ndex" "Peus de p&agrave;gina")
188 ("cs" "Autor" "Datum" "Obsah" "Pozn\xe1mky pod carou")
189 ("da" "Ophavsmand" "Dato" "Indhold" "Fodnoter")
190 ("de" "Autor" "Datum" "Inhaltsverzeichnis" "Fu&szlig;noten")
191 ("eo" "A&#365;toro" "Dato" "Enhavo" "Piednotoj")
192 ("es" "Autor" "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
193 ("fi" "Tekij&auml;" "P&auml;iv&auml;m&auml;&auml;r&auml;" "Sis&auml;llysluettelo" "Alaviitteet")
194 ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page")
195 ("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
196 ("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
197 ("it" "Autore" "Data" "Indice" "Note a pi&egrave; di pagina")
198 ;; Use numeric character entities for proper rendering of non-UTF8 documents
199 ;; ("ja" "著者" "日付" "目次" "脚注")
200 ("ja" "&#33879;&#32773;" "&#26085;&#20184;" "&#30446;&#27425;" "&#33050;&#27880;")
201 ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten")
202 ("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
203 ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
204 ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
205 ("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
206 ;; Use numeric character entities for proper rendering of non-UTF8 documents
207 ;; ("ru" "Автор" "Дата" "Содержание" "Сноски")
208 ("ru" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;")
209 ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter")
210 ;; Use numeric character entities for proper rendering of non-UTF8 documents
211 ;; ("uk" "Автор" "Дата" "Зміст" "Примітки")
212 ("uk" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1047;&#1084;&#1110;&#1089;&#1090;" "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;")
213 ;; Use numeric character entities for proper rendering of non-UTF8 documents
214 ;; ("zh-CN" "作者" "日期" "目录" "脚注")
215 ("zh-CN" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#24405;" "&#33050;&#27880;")
216 ;; Use numeric character entities for proper rendering of non-UTF8 documents
217 ;; ("zh-TW" "作者" "日期" "目錄" "腳註")
218 ("zh-TW" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#37636;" "&#33139;&#35387;"))
219 "Terms used in export text, translated to different languages.
220Use the variable `org-export-default-language' to set the language,
221or use the +OPTION lines for a per-file setting."
222 :group 'org-export-general
223 :type '(repeat
224 (list
225 (string :tag "HTML language tag")
226 (string :tag "Author")
227 (string :tag "Date")
228 (string :tag "Table of Contents")
229 (string :tag "Footnotes"))))
230
231(defcustom org-export-default-language "en"
232 "The default language for export and clocktable translations, as a string.
233This should have an association in `org-export-language-setup'
234and in `org-clock-clocktable-language-setup'."
235 :group 'org-export-general
236 :type 'string)
237
238(defcustom org-export-date-timestamp-format "%Y-%m-%d"
239 "Time string format for Org timestamps in the #+DATE option."
240 :group 'org-export-general
241 :version "24.1"
242 :type 'string)
243
244(defvar org-export-page-description ""
245 "The page description, for the XHTML meta tag.
246This is best set with the #+DESCRIPTION line in a file, it does not make
247sense to set this globally.")
248
249(defvar org-export-page-keywords ""
250 "The page description, for the XHTML meta tag.
251This is best set with the #+KEYWORDS line in a file, it does not make
252sense to set this globally.")
253
254(defcustom org-export-skip-text-before-1st-heading nil
255 "Non-nil means skip all text before the first headline when exporting.
256When nil, that text is exported as well."
257 :group 'org-export-general
258 :type 'boolean)
259
260(defcustom org-export-headline-levels 3
261 "The last level which is still exported as a headline.
262Inferior levels will produce itemize lists when exported.
263Note that a numeric prefix argument to an exporter function overrides
264this setting.
265
266This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
267 :group 'org-export-general
268 :type 'integer)
269
270(defcustom org-export-with-section-numbers t
271 "Non-nil means add section numbers to headlines when exporting.
272
273This option can also be set with the +OPTIONS line, e.g. \"num:t\"."
274 :group 'org-export-general
275 :type 'boolean)
276
277(defcustom org-export-section-number-format '((("1" ".")) . "")
278 "Format of section numbers for export.
279The variable has two components.
2801. A list of lists, each indicating a counter type and a separator.
281 The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\".
282 It causes causes numeric, alphabetic, or roman counters, respectively.
283 The separator is only used if another counter for a subsection is being
284 added.
285 If there are more numbered section levels than entries in this lists,
286 then the last entry will be reused.
2872. A terminator string that will be added after the entire
288 section number."
289 :group 'org-export-general
290 :type '(cons
291 (repeat
292 (list
293 (string :tag "Counter Type")
294 (string :tag "Separator ")))
295 (string :tag "Terminator")))
296
297(defcustom org-export-with-toc t
298 "Non-nil means create a table of contents in exported files.
299The TOC contains headlines with levels up to`org-export-headline-levels'.
300When an integer, include levels up to N in the toc, this may then be
301different from `org-export-headline-levels', but it will not be allowed
302to be larger than the number of headline levels.
303When nil, no table of contents is made.
304
305Headlines which contain any TODO items will be marked with \"(*)\" in
306ASCII export, and with red color in HTML output, if the option
307`org-export-mark-todo-in-toc' is set.
308
309In HTML output, the TOC will be clickable.
310
311This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"
312or \"toc:3\"."
313 :group 'org-export-general
314 :type '(choice
315 (const :tag "No Table of Contents" nil)
316 (const :tag "Full Table of Contents" t)
317 (integer :tag "TOC to level")))
318
319(defcustom org-export-mark-todo-in-toc nil
320 "Non-nil means mark TOC lines that contain any open TODO items."
321 :group 'org-export-general
322 :type 'boolean)
323
324(defcustom org-export-with-todo-keywords t
325 "Non-nil means include TODO keywords in export.
326When nil, remove all these keywords from the export."
327 :group 'org-export-general
328 :type 'boolean)
329
330(defcustom org-export-with-tasks t
331 "Non-nil means include TODO items for export.
332This may have the following values:
333t include tasks independent of state.
334todo include only tasks that are not yet done.
335done include only tasks that are already done.
336nil remove all tasks before export
337list of TODO kwds keep only tasks with these keywords"
338 :group 'org-export-general
339 :version "24.1"
340 :type '(choice
341 (const :tag "All tasks" t)
342 (const :tag "No tasks" nil)
343 (const :tag "Not-done tasks" todo)
344 (const :tag "Only done tasks" done)
345 (repeat :tag "Specific TODO keywords"
346 (string :tag "Keyword"))))
347
348(defcustom org-export-with-priority nil
349 "Non-nil means include priority cookies in export.
350When nil, remove priority cookies for export."
351 :group 'org-export-general
352 :type 'boolean)
353
354(defcustom org-export-preserve-breaks nil
355 "Non-nil means preserve all line breaks when exporting.
356Normally, in HTML output paragraphs will be reformatted. In ASCII
357export, line breaks will always be preserved, regardless of this variable.
358
359This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
360 :group 'org-export-general
361 :type 'boolean)
362
363(defcustom org-export-with-archived-trees 'headline
364 "Whether subtrees with the ARCHIVE tag should be exported.
365This can have three different values
366nil Do not export, pretend this tree is not present
367t Do export the entire tree
368headline Only export the headline, but skip the tree below it."
369 :group 'org-export-general
370 :group 'org-archive
371 :type '(choice
372 (const :tag "not at all" nil)
373 (const :tag "headline only" 'headline)
374 (const :tag "entirely" t)))
375
376(defcustom org-export-author-info t
377 "Non-nil means insert author name and email into the exported file.
378
379This option can also be set with the +OPTIONS line,
380e.g. \"author:nil\"."
381 :group 'org-export-general
382 :type 'boolean)
383
384(defcustom org-export-email-info nil
385 "Non-nil means insert author name and email into the exported file.
386
387This option can also be set with the +OPTIONS line,
388e.g. \"email:t\"."
389 :group 'org-export-general
390 :version "24.1"
391 :type 'boolean)
392
393(defcustom org-export-creator-info t
394 "Non-nil means the postamble should contain a creator sentence.
395This sentence is \"HTML generated by org-mode XX in emacs XXX\"."
396 :group 'org-export-general
397 :type 'boolean)
398
399(defcustom org-export-time-stamp-file t
400 "Non-nil means insert a time stamp into the exported file.
401The time stamp shows when the file was created.
402
403This option can also be set with the +OPTIONS line,
404e.g. \"timestamp:nil\"."
405 :group 'org-export-general
406 :type 'boolean)
407
408(defcustom org-export-with-timestamps t
409 "If nil, do not export time stamps and associated keywords."
410 :group 'org-export-general
411 :type 'boolean)
412
413(defcustom org-export-remove-timestamps-from-toc t
414 "If t, remove timestamps from the table of contents entries."
415 :group 'org-export-general
416 :type 'boolean)
417
418(defcustom org-export-with-tags 'not-in-toc
419 "If nil, do not export tags, just remove them from headlines.
420If this is the symbol `not-in-toc', tags will be removed from table of
421contents entries, but still be shown in the headlines of the document.
422
423This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
424 :group 'org-export-general
425 :type '(choice
426 (const :tag "Off" nil)
427 (const :tag "Not in TOC" not-in-toc)
428 (const :tag "On" t)))
429
430(defcustom org-export-with-drawers nil
431 "Non-nil means export with drawers like the property drawer.
432When t, all drawers are exported. This may also be a list of
433drawer names to export."
434 :group 'org-export-general
435 :type '(choice
436 (const :tag "All drawers" t)
437 (const :tag "None" nil)
438 (repeat :tag "Selected drawers"
439 (string :tag "Drawer name"))))
440
441(defvar org-export-first-hook nil
442 "Hook called as the first thing in each exporter.
443Point will be still in the original buffer.
444Good for general initialization")
445
446(defvar org-export-preprocess-hook nil
447 "Hook for preprocessing an export buffer.
448Pretty much the first thing when exporting is running this hook.
449Point will be in a temporary buffer that contains a copy of
450the original buffer, or of the section that is being exported.
451All the other hooks in the org-export-preprocess... category
452also work in that temporary buffer, already modified by various
453stages of the processing.")
454
455(defvar org-export-preprocess-after-include-files-hook nil
456 "Hook for preprocessing an export buffer.
457This is run after the contents of included files have been inserted.")
458
459(defvar org-export-preprocess-after-tree-selection-hook nil
460 "Hook for preprocessing an export buffer.
461This is run after selection of trees to be exported has happened.
462This selection includes tags-based selection, as well as removal
463of commented and archived trees.")
464
465(defvar org-export-preprocess-after-headline-targets-hook nil
466 "Hook for preprocessing export buffer.
467This is run just after the headline targets have been defined and
468the target-alist has been set up.")
469
470(defvar org-export-preprocess-before-selecting-backend-code-hook nil
471 "Hook for preprocessing an export buffer.
472This is run just before backend-specific blocks get selected.")
473
474(defvar org-export-preprocess-after-blockquote-hook nil
475 "Hook for preprocessing an export buffer.
476This is run after blockquote/quote/verse/center have been marked
477with cookies.")
478
479(defvar org-export-preprocess-after-radio-targets-hook nil
480 "Hook for preprocessing an export buffer.
481This is run after radio target processing.")
482
483(defvar org-export-preprocess-before-normalizing-links-hook nil
484 "Hook for preprocessing an export buffer.
485This hook is run before links are normalized.")
486
487(defvar org-export-preprocess-before-backend-specifics-hook nil
488 "Hook run before backend-specific functions are called during preprocessing.")
489
490(defvar org-export-preprocess-final-hook nil
491 "Hook for preprocessing an export buffer.
492This is run as the last thing in the preprocessing buffer, just before
493returning the buffer string to the backend.")
494
495(defgroup org-export-translation nil
496 "Options for translating special ascii sequences for the export backends."
497 :tag "Org Export Translation"
498 :group 'org-export)
499
500(defcustom org-export-with-emphasize t
501 "Non-nil means interpret *word*, /word/, and _word_ as emphasized text.
502If the export target supports emphasizing text, the word will be
503typeset in bold, italic, or underlined, respectively. Works only for
504single words, but you can say: I *really* *mean* *this*.
505Not all export backends support this.
506
507This option can also be set with the +OPTIONS line, e.g. \"*:nil\"."
508 :group 'org-export-translation
509 :type 'boolean)
510
511(defcustom org-export-with-footnotes t
512 "If nil, export [1] as a footnote marker.
513Lines starting with [1] will be formatted as footnotes.
514
515This option can also be set with the +OPTIONS line, e.g. \"f:nil\"."
516 :group 'org-export-translation
517 :type 'boolean)
518
519(defcustom org-export-with-TeX-macros t
520 "Non-nil means interpret simple TeX-like macros when exporting.
521For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
522Not only real TeX macros will work here, but the standard HTML entities
523for math can be used as macro names as well. For a list of supported
524names in HTML export, see the constant `org-entities' and the user option
525`org-entities-user'.
526Not all export backends support this.
527
528This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
529 :group 'org-export-translation
530 :group 'org-export-latex
531 :type 'boolean)
532
533(defcustom org-export-with-LaTeX-fragments t
534 "Non-nil means process LaTeX math fragments for HTML display.
535When set, the exporter will find and process LaTeX environments if the
536\\begin line is the first non-white thing on a line. It will also find
537and process the math delimiters like $a=b$ and \\( a=b \\) for inline math,
538$$a=b$$ and \\=\\[ a=b \\] for display math.
539
540This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
541
542Allowed values are:
543
544nil Don't do anything.
545verbatim Keep everything in verbatim
546dvipng Process the LaTeX fragments to images.
547 This will also include processing of non-math environments.
548imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
549 to convert pdf files to png files.
550t Do MathJax preprocessing if there is at least on math snippet,
551 and arrange for MathJax.js to be loaded.
552
553The default is nil, because this option needs the `dvipng' program which
554is not available on all systems."
555 :group 'org-export-translation
556 :group 'org-export-latex
557 :type '(choice
558 (const :tag "Do not process math in any way" nil)
559 (const :tag "Obsolete, use dvipng setting" t)
560 (const :tag "Use dvipng to make images" dvipng)
561 (const :tag "Use imagemagick to make images" imagemagick)
562 (const :tag "Use MathJax to display math" mathjax)
563 (const :tag "Leave math verbatim" verbatim)))
564
565(defcustom org-export-with-fixed-width t
566 "Non-nil means lines starting with \":\" will be in fixed width font.
567This can be used to have pre-formatted text, fragments of code etc. For
568example:
569 : ;; Some Lisp examples
570 : (while (defc cnt)
571 : (ding))
572will be looking just like this in also HTML. See also the QUOTE keyword.
573Not all export backends support this.
574
575This option can also be set with the +OPTIONS line, e.g. \"::nil\"."
576 :group 'org-export-translation
577 :type 'boolean)
578
579(defgroup org-export-tables nil
580 "Options for exporting tables in Org-mode."
581 :tag "Org Export Tables"
582 :group 'org-export)
583
584(defcustom org-export-with-tables t
585 "If non-nil, lines starting with \"|\" define a table.
586For example:
587
588 | Name | Address | Birthday |
589 |-------------+----------+-----------|
590 | Arthur Dent | England | 29.2.2100 |
591
592Not all export backends support this.
593
594This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
595 :group 'org-export-tables
596 :type 'boolean)
597
598(defcustom org-export-highlight-first-table-line t
599 "Non-nil means highlight the first table line.
600In HTML export, this means use <th> instead of <td>.
601In tables created with table.el, this applies to the first table line.
602In Org-mode tables, all lines before the first horizontal separator
603line will be formatted with <th> tags."
604 :group 'org-export-tables
605 :type 'boolean)
606
607(defcustom org-export-table-remove-special-lines t
608 "Remove special lines and marking characters in calculating tables.
609This removes the special marking character column from tables that are set
610up for spreadsheet calculations. It also removes the entire lines
611marked with `!', `_', or `^'. The lines with `$' are kept, because
612the values of constants may be useful to have."
613 :group 'org-export-tables
614 :type 'boolean)
615
616(defcustom org-export-table-remove-empty-lines t
617 "Remove empty lines when exporting tables.
618This is the global equivalent of the :remove-nil-lines option
619when locally sending a table with #+ORGTBL."
620 :group 'org-export-tables
621 :version "24.1"
622 :type 'boolean)
623
624(defcustom org-export-prefer-native-exporter-for-tables nil
625 "Non-nil means always export tables created with table.el natively.
626Natively means use the HTML code generator in table.el.
627When nil, Org-mode's own HTML generator is used when possible (i.e. if
628the table does not use row- or column-spanning). This has the
629advantage, that the automatic HTML conversions for math symbols and
630sub/superscripts can be applied. Org-mode's HTML generator is also
631much faster. The LaTeX exporter always use the native exporter for
632table.el tables."
633 :group 'org-export-tables
634 :type 'boolean)
635
636;;;; Exporting
637
638;;; Variables, constants, and parameter plists
639
640(defconst org-level-max 20)
641
642(defvar org-export-current-backend nil
643 "During export, this will be bound to a symbol such as 'html,
644 'latex, 'docbook, 'ascii, etc, indicating which of the export
645 backends is in use. Otherwise it has the value nil. Users
646 should not attempt to change the value of this variable
647 directly, but it can be used in code to test whether export is
648 in progress, and if so, what the backend is.")
649
650(defvar org-current-export-file nil) ; dynamically scoped parameter
651(defvar org-current-export-dir nil) ; dynamically scoped parameter
652(defvar org-export-opt-plist nil
653 "Contains the current option plist.")
654(defvar org-last-level nil) ; dynamically scoped variable
655(defvar org-min-level nil) ; dynamically scoped variable
656(defvar org-levels-open nil) ; dynamically scoped parameter
657(defvar org-export-footnotes-data nil
658 "Alist of labels used in buffers, along with their definition.")
659(defvar org-export-footnotes-seen nil
660 "Alist of labels encountered so far by the exporter, along with their definition.")
661
662
663(defconst org-export-plist-vars
664 '((:link-up nil org-export-html-link-up)
665 (:link-home nil org-export-html-link-home)
666 (:language nil org-export-default-language)
667 (:keywords nil org-export-page-keywords)
668 (:description nil org-export-page-description)
669 (:customtime nil org-display-custom-times)
670 (:headline-levels "H" org-export-headline-levels)
671 (:section-numbers "num" org-export-with-section-numbers)
672 (:section-number-format nil org-export-section-number-format)
673 (:table-of-contents "toc" org-export-with-toc)
674 (:preserve-breaks "\\n" org-export-preserve-breaks)
675 (:archived-trees nil org-export-with-archived-trees)
676 (:emphasize "*" org-export-with-emphasize)
677 (:sub-superscript "^" org-export-with-sub-superscripts)
678 (:special-strings "-" org-export-with-special-strings)
679 (:footnotes "f" org-export-with-footnotes)
680 (:drawers "d" org-export-with-drawers)
681 (:tags "tags" org-export-with-tags)
682 (:todo-keywords "todo" org-export-with-todo-keywords)
683 (:tasks "tasks" org-export-with-tasks)
684 (:priority "pri" org-export-with-priority)
685 (:TeX-macros "TeX" org-export-with-TeX-macros)
686 (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments)
687 (:latex-listings nil org-export-latex-listings)
688 (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading)
689 (:fixed-width ":" org-export-with-fixed-width)
690 (:timestamps "<" org-export-with-timestamps)
691 (:author nil user-full-name)
692 (:email nil user-mail-address)
693 (:author-info "author" org-export-author-info)
694 (:email-info "email" org-export-email-info)
695 (:creator-info "creator" org-export-creator-info)
696 (:time-stamp-file "timestamp" org-export-time-stamp-file)
697 (:tables "|" org-export-with-tables)
698 (:table-auto-headline nil org-export-highlight-first-table-line)
699 (:style-include-default nil org-export-html-style-include-default)
700 (:style-include-scripts nil org-export-html-style-include-scripts)
701 (:style nil org-export-html-style)
702 (:style-extra nil org-export-html-style-extra)
703 (:agenda-style nil org-agenda-export-html-style)
704 (:convert-org-links nil org-export-html-link-org-files-as-html)
705 (:inline-images nil org-export-html-inline-images)
706 (:html-extension nil org-export-html-extension)
707 (:html-preamble nil org-export-html-preamble)
708 (:html-postamble nil org-export-html-postamble)
709 (:xml-declaration nil org-export-html-xml-declaration)
710 (:html-table-tag nil org-export-html-table-tag)
711 (:expand-quoted-html "@" org-export-html-expand)
712 (:timestamp nil org-export-html-with-timestamp)
713 (:publishing-directory nil org-export-publishing-directory)
714 (:select-tags nil org-export-select-tags)
715 (:exclude-tags nil org-export-exclude-tags)
716
717 (:latex-image-options nil org-export-latex-image-default-option))
718 "List of properties that represent export/publishing variables.
719Each element is a list of 3 items:
7201. The property that is used internally, and also for org-publish-project-alist
7212. The string that can be used in the OPTION lines to set this option,
722 or nil if this option cannot be changed in this way
7233. The customization variable that sets the default for this option."
724 )
725
726(defun org-default-export-plist ()
727 "Return the property list with default settings for the export variables."
728 (let* ((infile (org-infile-export-plist))
729 (letbind (plist-get infile :let-bind))
730 (l org-export-plist-vars) rtn e s v)
731 (while (setq e (pop l))
732 (setq s (nth 2 e)
733 v (cond
734 ((assq s letbind) (nth 1 (assq s letbind)))
735 ((boundp s) (symbol-value s)))
736 rtn (cons (car e) (cons v rtn))))
737 rtn))
738
739(defvar org-export-inbuffer-options-extra nil
740 "List of additional in-buffer options that should be detected.
741Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL,
742etc. Extensions can add to this list to get their options detected, and they
743can then add a function to `org-export-options-filters' to process these
744options.
745Each element in this list must be a list, with the in-buffer keyword as car,
746and a property (a symbol) as the next element. All occurrences of the
747keyword will be found, the values concatenated with a space character
748in between, and the result stored in the export options property list.")
749
750(defvar org-export-options-filters nil
751 "Functions to be called to finalize the export/publishing options.
752All these options are stored in a property list, and each of the functions
753in this hook gets a chance to modify this property list. Each function
754must accept the property list as an argument, and must return the (possibly
755modified) list.")
756
757;; FIXME: should we fold case here?
758
759(defun org-infile-export-plist ()
760 "Return the property list with file-local settings for export."
761 (save-excursion
762 (save-restriction
763 (widen)
764 (goto-char (point-min))
765 (let ((re (org-make-options-regexp
766 (append
767 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
768 "MATHJAX"
769 "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
770 "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS"
771 "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
772 "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
773 (mapcar 'car org-export-inbuffer-options-extra))))
774 (case-fold-search t)
775 p key val text options mathjax a pr style
776 latex-header latex-class latex-class-options macros letbind
777 ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
778 (while (or (and ext-setup-or-nil
779 (string-match re ext-setup-or-nil start)
780 (setq start (match-end 0)))
781 (and (setq ext-setup-or-nil nil start 0)
782 (re-search-forward re nil t)))
783 (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil))
784 val (org-match-string-no-properties 2 ext-setup-or-nil))
785 (cond
786 ((setq a (assoc key org-export-inbuffer-options-extra))
787 (setq pr (nth 1 a))
788 (setq p (plist-put p pr (concat (plist-get p pr) " " val))))
789 ((string-equal key "TITLE") (setq p (plist-put p :title val)))
790 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
791 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
792 ((string-equal key "DATE")
793 ;; If date is an Org timestamp, convert it to a time
794 ;; string using `org-export-date-timestamp-format'
795 (when (string-match org-ts-regexp3 val)
796 (setq val (format-time-string
797 org-export-date-timestamp-format
798 (apply 'encode-time (org-parse-time-string
799 (match-string 0 val))))))
800 (setq p (plist-put p :date val)))
801 ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
802 ((string-equal key "DESCRIPTION")
803 (setq p (plist-put p :description val)))
804 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
805 ((string-equal key "STYLE")
806 (setq style (concat style "\n" val)))
807 ((string-equal key "LATEX_HEADER")
808 (setq latex-header (concat latex-header "\n" val)))
809 ((string-equal key "LATEX_CLASS")
810 (setq latex-class val))
811 ((string-equal key "LATEX_CLASS_OPTIONS")
812 (setq latex-class-options val))
813 ((string-equal key "TEXT")
814 (setq text (if text (concat text "\n" val) val)))
815 ((string-equal key "OPTIONS")
816 (setq options (concat val " " options)))
817 ((string-equal key "MATHJAX")
818 (setq mathjax (concat val " " mathjax)))
819 ((string-equal key "BIND")
820 (push (read (concat "(" val ")")) letbind))
821 ((string-equal key "XSLT")
822 (setq p (plist-put p :xslt val)))
823 ((string-equal key "LINK_UP")
824 (setq p (plist-put p :link-up val)))
825 ((string-equal key "LINK_HOME")
826 (setq p (plist-put p :link-home val)))
827 ((string-equal key "EXPORT_SELECT_TAGS")
828 (setq p (plist-put p :select-tags (org-split-string val))))
829 ((string-equal key "EXPORT_EXCLUDE_TAGS")
830 (setq p (plist-put p :exclude-tags (org-split-string val))))
831 ((string-equal key "MACRO")
832 (push val macros))
833 ((equal key "SETUPFILE")
834 (setq setup-file (org-remove-double-quotes (org-trim val))
835 ;; take care of recursive inclusion of setupfiles
836 setup-file (if (or (file-name-absolute-p val) (not setup-dir))
837 (expand-file-name setup-file)
838 (let ((default-directory setup-dir))
839 (expand-file-name setup-file))))
840 (setq setup-dir (file-name-directory setup-file))
841 (setq setup-contents (org-file-contents setup-file 'noerror))
842 (if (not ext-setup-or-nil)
843 (setq ext-setup-or-nil setup-contents start 0)
844 (setq ext-setup-or-nil
845 (concat (substring ext-setup-or-nil 0 start)
846 "\n" setup-contents "\n"
847 (substring ext-setup-or-nil start)))))))
848 (setq p (plist-put p :text text))
849 (when (and letbind (org-export-confirm-letbind))
850 (setq p (plist-put p :let-bind letbind)))
851 (when style (setq p (plist-put p :style-extra style)))
852 (when latex-header
853 (setq p (plist-put p :latex-header-extra (substring latex-header 1))))
854 (when latex-class
855 (setq p (plist-put p :latex-class latex-class)))
856 (when latex-class-options
857 (setq p (plist-put p :latex-class-options latex-class-options)))
858 (when options
859 (setq p (org-export-add-options-to-plist p options)))
860 (when mathjax
861 (setq p (plist-put p :mathjax mathjax)))
862 ;; Add macro definitions
863 (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
864 (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
865 (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))
866 (setq p (plist-put
867 p :macro-modification-time
868 (and (buffer-file-name)
869 (file-exists-p (buffer-file-name))
870 (concat
871 "(eval (format-time-string \"$1\" '"
872 (prin1-to-string (nth 5 (file-attributes
873 (buffer-file-name))))
874 "))"))))
875 (setq p (plist-put p :macro-input-file (and (buffer-file-name)
876 (file-name-nondirectory
877 (buffer-file-name)))))
878 (while (setq val (pop macros))
879 (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val)
880 (setq p (plist-put
881 p (intern
882 (concat ":macro-" (downcase (match-string 1 val))))
883 (org-export-interpolate-newlines (match-string 2 val))))))
884 p))))
885
886(defun org-export-interpolate-newlines (s)
887 (while (string-match "\\\\n" s)
888 (setq s (replace-match "\n" t t s)))
889 s)
890
891(defvar org-export-allow-BIND-local nil)
892(defun org-export-confirm-letbind ()
893 "Can we use #+BIND values during export?
894By default this will ask for confirmation by the user, to divert possible
895security risks."
896 (cond
897 ((not org-export-allow-BIND) nil)
898 ((eq org-export-allow-BIND t) t)
899 ((local-variable-p 'org-export-allow-BIND-local (current-buffer))
900 org-export-allow-BIND-local)
901 (t (org-set-local 'org-export-allow-BIND-local
902 (yes-or-no-p "Allow BIND values in this buffer? ")))))
903
904(defun org-install-letbind ()
905 "Install the values from #+BIND lines as local variables."
906 (let ((letbind (plist-get org-export-opt-plist :let-bind))
907 pair)
908 (while (setq pair (pop letbind))
909 (org-set-local (car pair) (nth 1 pair)))))
910
911(defun org-export-add-options-to-plist (p options)
912 "Parse an OPTIONS line and set values in the property list P."
913 (let (o)
914 (when options
915 (let ((op org-export-plist-vars))
916 (while (setq o (pop op))
917 (if (and (nth 1 o)
918 (string-match (concat "\\(\\`\\|[ \t]\\)"
919 (regexp-quote (nth 1 o))
920 ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
921 options))
922 (setq p (plist-put p (car o)
923 (car (read-from-string
924 (match-string 2 options))))))))))
925 p)
926
927(defun org-export-add-subtree-options (p pos)
928 "Add options in subtree at position POS to property list P."
929 (save-excursion
930 (goto-char pos)
931 (when (org-at-heading-p)
932 (let (a)
933 ;; This is actually read in `org-export-get-title-from-subtree'
934 ;; (when (setq a (org-entry-get pos "EXPORT_TITLE"))
935 ;; (setq p (plist-put p :title a)))
936 (when (setq a (org-entry-get pos "EXPORT_TEXT"))
937 (setq p (plist-put p :text a)))
938 (when (setq a (org-entry-get pos "EXPORT_AUTHOR"))
939 (setq p (plist-put p :author a)))
940 (when (setq a (org-entry-get pos "EXPORT_DATE"))
941 (setq p (plist-put p :date a)))
942 (when (setq a (org-entry-get pos "EXPORT_OPTIONS"))
943 (setq p (org-export-add-options-to-plist p a)))))
944 p))
945
946(defun org-export-directory (type plist)
947 (let* ((val (plist-get plist :publishing-directory))
948 (dir (if (listp val)
949 (or (cdr (assoc type val)) ".")
950 val)))
951 dir))
952
953(defun org-export-process-option-filters (plist)
954 (let ((functions org-export-options-filters) f)
955 (while (setq f (pop functions))
956 (setq plist (funcall f plist))))
957 plist)
958
959;;;###autoload
960(defun org-export (&optional arg)
961 "Export dispatcher for Org-mode.
962When `org-export-run-in-background' is non-nil, try to run the command
963in the background. This will be done only for commands that write
964to a file. For details see the docstring of `org-export-run-in-background'.
965
966The prefix argument ARG will be passed to the exporter. However, if
967ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \
968that means to inverse the
969value of `org-export-run-in-background'.
970
971If `org-export-initial-scope' is set to 'subtree, try to export
972the current subtree, otherwise try to export the whole buffer.
973Pressing `1' will switch between these two options."
974 (interactive "P")
975 (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
976 (subtree-p (or (org-region-active-p)
977 (eq org-export-initial-scope 'subtree)))
978 (regb (and (org-region-active-p) (region-beginning)))
979 (rege (and (org-region-active-p) (region-end)))
980 (help "[t] insert the export option template
981\[v] limit export to visible part of outline tree
982\[1] switch buffer/subtree export
983\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop)
984
985\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer
986
987\[h] export as HTML [H] to temporary buffer [R] export region
988\[b] export as HTML and open in browser
989
990\[l] export as LaTeX [L] to temporary buffer
991\[p] export as LaTeX and process to PDF [d] ... and open PDF file
992
993\[D] export as DocBook [V] export as DocBook, process to PDF, and open
994
995\[o] export as OpenDocument Text [O] ... and open
996
997\[j] export as TaskJuggler [J] ... and open
998
999\[m] export as Freemind mind map
1000\[x] export as XOXO
1001\[g] export using Wes Hardaker's generic exporter
1002
1003\[i] export current file as iCalendar file
1004\[I] export all agenda files as iCalendar files [c] ...as one combined file
1005
1006\[F] publish current file [P] publish current project
1007\[X] publish a project... [E] publish every projects")
1008 (cmds
1009 '((?t org-insert-export-options-template nil)
1010 (?v org-export-visible nil)
1011 (?a org-export-as-ascii t)
1012 (?A org-export-as-ascii-to-buffer t)
1013 (?n org-export-as-latin1 t)
1014 (?N org-export-as-latin1-to-buffer t)
1015 (?u org-export-as-utf8 t)
1016 (?U org-export-as-utf8-to-buffer t)
1017 (?h org-export-as-html t)
1018 (?b org-export-as-html-and-open t)
1019 (?H org-export-as-html-to-buffer nil)
1020 (?R org-export-region-as-html nil)
1021 (?x org-export-as-xoxo t)
1022 (?g org-export-generic t)
1023 (?D org-export-as-docbook t)
1024 (?V org-export-as-docbook-pdf-and-open t)
1025 (?o org-export-as-odt t)
1026 (?O org-export-as-odt-and-open t)
1027 (?j org-export-as-taskjuggler t)
1028 (?J org-export-as-taskjuggler-and-open t)
1029 (?m org-export-as-freemind t)
1030 (?l org-export-as-latex t)
1031 (?p org-export-as-pdf t)
1032 (?d org-export-as-pdf-and-open t)
1033 (?L org-export-as-latex-to-buffer nil)
1034 (?i org-export-icalendar-this-file t)
1035 (?I org-export-icalendar-all-agenda-files t)
1036 (?c org-export-icalendar-combine-agenda-files t)
1037 (?F org-publish-current-file t)
1038 (?P org-publish-current-project t)
1039 (?X org-publish t)
1040 (?E org-publish-all t)))
1041 r1 r2 ass
1042 (cpos (point)) (cbuf (current-buffer)) bpos)
1043 (save-excursion
1044 (save-window-excursion
1045 (if subtree-p
1046 (message "Export subtree: ")
1047 (message "Export buffer: "))
1048 (delete-other-windows)
1049 (with-output-to-temp-buffer "*Org Export/Publishing Help*"
1050 (princ help))
1051 (org-fit-window-to-buffer (get-buffer-window
1052 "*Org Export/Publishing Help*"))
1053 (while (eq (setq r1 (read-char-exclusive)) ?1)
1054 (cond (subtree-p
1055 (setq subtree-p nil)
1056 (message "Export buffer: "))
1057 ((not subtree-p)
1058 (setq subtree-p t)
1059 (setq bpos (point))
1060 (org-mark-subtree)
1061 (org-activate-mark)
1062 (setq regb (and (org-region-active-p) (region-beginning)))
1063 (setq rege (and (org-region-active-p) (region-end)))
1064 (message "Export subtree: "))))
1065 (when (eq r1 ?\ )
1066 (let ((case-fold-search t)
1067 (end (save-excursion (while (org-up-heading-safe)) (point))))
1068 (outline-next-heading)
1069 (if (re-search-backward
1070 "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-"
1071 end t)
1072 (progn
1073 (org-back-to-heading t)
1074 (setq subtree-p t)
1075 (setq bpos (point))
1076 (message "Select command (for subtree): ")
1077 (setq r1 (read-char-exclusive)))
1078 (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME")
1079 )))))
1080 (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay)
1081 (and bpos (goto-char bpos))
1082 (setq r2 (if (< r1 27) (+ r1 96) r1))
1083 (unless (setq ass (assq r2 cmds))
1084 (error "No command associated with key %c" r1))
1085 (if (and bg (nth 2 ass)
1086 (not (buffer-base-buffer))
1087 (not (org-region-active-p)))
1088 ;; execute in background
1089 (let ((p (start-process
1090 (concat "Exporting " (file-name-nondirectory (buffer-file-name)))
1091 "*Org Processes*"
1092 (expand-file-name invocation-name invocation-directory)
1093 "-batch"
1094 "-l" user-init-file
1095 "--eval" "(require 'org-exp)"
1096 "--eval" "(setq org-wait .2)"
1097 (buffer-file-name)
1098 "-f" (symbol-name (nth 1 ass)))))
1099 (set-process-sentinel p 'org-export-process-sentinel)
1100 (message "Background process \"%s\": started" p))
1101 ;; set the mark correctly when exporting a subtree
1102 (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb)))
1103
1104 (call-interactively (nth 1 ass))
1105 (when (and bpos (get-buffer-window cbuf))
1106 (let ((cw (selected-window)))
1107 (select-window (get-buffer-window cbuf))
1108 (goto-char cpos)
1109 (deactivate-mark)
1110 (select-window cw))))))
1111
1112(defun org-export-process-sentinel (process status)
1113 (if (string-match "\n+\\'" status)
1114 (setq status (substring status 0 -1)))
1115 (message "Background process \"%s\": %s" process status))
1116
1117;;; General functions for all backends
1118
1119(defvar org-export-target-aliases nil
1120 "Alist of targets with invisible aliases.")
1121(defvar org-export-preferred-target-alist nil
1122 "Alist of section id's with preferred aliases.")
1123(defvar org-export-id-target-alist nil
1124 "Alist of section id's with preferred aliases.")
1125(defvar org-export-code-refs nil
1126 "Alist of code references and line numbers.")
1127
1128(defun org-export-preprocess-string (string &rest parameters)
1129 "Cleanup STRING so that the true exported has a more consistent source.
1130This function takes STRING, which should be a buffer-string of an org-file
1131to export. It then creates a temporary buffer where it does its job.
1132The result is then again returned as a string, and the exporter works
1133on this string to produce the exported version."
1134 (interactive)
1135 (let* ((org-export-current-backend (or (plist-get parameters :for-backend)
1136 org-export-current-backend))
1137 (archived-trees (plist-get parameters :archived-trees))
1138 (inhibit-read-only t)
1139 (drawers org-drawers)
1140 (source-buffer (current-buffer))
1141 target-alist rtn)
1142
1143 (setq org-export-target-aliases nil
1144 org-export-preferred-target-alist nil
1145 org-export-id-target-alist nil
1146 org-export-code-refs nil)
1147
1148 (with-temp-buffer
1149 (erase-buffer)
1150 (insert string)
1151 (setq case-fold-search t)
1152
1153 (let ((inhibit-read-only t))
1154 (remove-text-properties (point-min) (point-max)
1155 '(read-only t)))
1156
1157 ;; Remove license-to-kill stuff
1158 ;; The caller marks some stuff for killing, stuff that has been
1159 ;; used to create the page title, for example.
1160 (org-export-kill-licensed-text)
1161
1162 (let ((org-inhibit-startup t)) (org-mode))
1163 (setq case-fold-search t)
1164 (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)")
1165 (org-install-letbind)
1166
1167 ;; Call the hook
1168 (run-hooks 'org-export-preprocess-hook)
1169
1170 (untabify (point-min) (point-max))
1171
1172 ;; Handle include files, and call a hook
1173 (org-export-handle-include-files-recurse)
1174 (run-hooks 'org-export-preprocess-after-include-files-hook)
1175
1176 ;; Get rid of archived trees
1177 (org-export-remove-archived-trees archived-trees)
1178
1179 ;; Remove comment environment and comment subtrees
1180 (org-export-remove-comment-blocks-and-subtrees)
1181
1182 ;; Get rid of excluded trees, and call a hook
1183 (org-export-handle-export-tags (plist-get parameters :select-tags)
1184 (plist-get parameters :exclude-tags))
1185 (run-hooks 'org-export-preprocess-after-tree-selection-hook)
1186
1187 ;; Get rid of tasks, depending on configuration
1188 (org-export-remove-tasks (plist-get parameters :tasks))
1189
1190 ;; Prepare footnotes for export. During that process, footnotes
1191 ;; actually included in the exported part of the buffer go
1192 ;; though some transformations:
1193
1194 ;; 1. They have their label normalized (like "[N]");
1195
1196 ;; 2. They get moved at the same place in the buffer (usually at
1197 ;; its end, but backends may define another place via
1198 ;; `org-footnote-insert-pos-for-preprocessor');
1199
1200 ;; 3. The are stored in `org-export-footnotes-seen', while
1201 ;; `org-export-preprocess-string' is applied to their
1202 ;; definition.
1203
1204 ;; Line-wise exporters ignore `org-export-footnotes-seen', as
1205 ;; they interpret footnotes at the moment they see them in the
1206 ;; buffer. Context-wise exporters grab all the info needed in
1207 ;; that variable and delete moved definitions (as described in
1208 ;; 2nd step).
1209 (when (plist-get parameters :footnotes)
1210 (org-footnote-normalize nil parameters))
1211
1212 ;; Change lists ending. Other parts of export may insert blank
1213 ;; lines and lists' structure could be altered.
1214 (org-export-mark-list-end)
1215
1216 ;; Process the macros
1217 (org-export-preprocess-apply-macros)
1218 (run-hooks 'org-export-preprocess-after-macros-hook)
1219
1220 ;; Export code blocks
1221 (org-export-blocks-preprocess)
1222
1223 ;; Mark lists with properties
1224 (org-export-mark-list-properties)
1225
1226 ;; Handle source code snippets
1227 (org-export-replace-src-segments-and-examples)
1228
1229 ;; Protect short examples marked by a leading colon
1230 (org-export-protect-colon-examples)
1231
1232 ;; Protected spaces
1233 (org-export-convert-protected-spaces)
1234
1235 ;; Find all headings and compute the targets for them
1236 (setq target-alist (org-export-define-heading-targets target-alist))
1237
1238 (run-hooks 'org-export-preprocess-after-headline-targets-hook)
1239
1240 ;; Find HTML special classes for headlines
1241 (org-export-remember-html-container-classes)
1242
1243 ;; Get rid of drawers
1244 (org-export-remove-or-extract-drawers
1245 drawers (plist-get parameters :drawers))
1246
1247 ;; Get the correct stuff before the first headline
1248 (when (plist-get parameters :skip-before-1st-heading)
1249 (goto-char (point-min))
1250 (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
1251 (delete-region (point-min) (match-beginning 0))
1252 (goto-char (point-min))
1253 (insert "\n")))
1254 (when (plist-get parameters :add-text)
1255 (goto-char (point-min))
1256 (insert (plist-get parameters :add-text) "\n"))
1257
1258 ;; Remove todo-keywords before exporting, if the user has requested so
1259 (org-export-remove-headline-metadata parameters)
1260
1261 ;; Find targets in comments and move them out of comments,
1262 ;; but mark them as targets that should be invisible
1263 (setq target-alist (org-export-handle-invisible-targets target-alist))
1264
1265 ;; Select and protect backend specific stuff, throw away stuff
1266 ;; that is specific for other backends
1267 (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook)
1268 (org-export-select-backend-specific-text)
1269
1270 ;; Protect quoted subtrees
1271 (org-export-protect-quoted-subtrees)
1272
1273 ;; Remove clock lines
1274 (org-export-remove-clock-lines)
1275
1276 ;; Protect verbatim elements
1277 (org-export-protect-verbatim)
1278
1279 ;; Blockquotes, verse, and center
1280 (org-export-mark-blockquote-verse-center)
1281 (run-hooks 'org-export-preprocess-after-blockquote-hook)
1282
1283 ;; Remove timestamps, if the user has requested so
1284 (unless (plist-get parameters :timestamps)
1285 (org-export-remove-timestamps))
1286
1287 ;; Attach captions to the correct object
1288 (setq target-alist (org-export-attach-captions-and-attributes target-alist))
1289
1290 ;; Find matches for radio targets and turn them into internal links
1291 (org-export-mark-radio-links)
1292 (run-hooks 'org-export-preprocess-after-radio-targets-hook)
1293
1294 ;; Find all links that contain a newline and put them into a single line
1295 (org-export-concatenate-multiline-links)
1296
1297 ;; Normalize links: Convert angle and plain links into bracket links
1298 ;; and expand link abbreviations
1299 (run-hooks 'org-export-preprocess-before-normalizing-links-hook)
1300 (org-export-normalize-links)
1301
1302 ;; Find all internal links. If they have a fuzzy match (i.e. not
1303 ;; a *dedicated* target match, let the link point to the
1304 ;; corresponding section.
1305 (org-export-target-internal-links target-alist)
1306
1307 ;; Find multiline emphasis and put them into single line
1308 (when (plist-get parameters :emph-multiline)
1309 (org-export-concatenate-multiline-emphasis))
1310
1311 ;; Remove special table lines, and store alignment information
1312 (org-store-forced-table-alignment)
1313 (when org-export-table-remove-special-lines
1314 (org-export-remove-special-table-lines))
1315
1316 ;; Another hook
1317 (run-hooks 'org-export-preprocess-before-backend-specifics-hook)
1318
1319 ;; Backend-specific preprocessing
1320 (let* ((backend-name (symbol-name org-export-current-backend))
1321 (f (intern (format "org-export-%s-preprocess" backend-name))))
1322 (require (intern (concat "org-" backend-name)) nil)
1323 (funcall f parameters))
1324
1325 ;; Remove or replace comments
1326 (org-export-handle-comments (plist-get parameters :comments))
1327
1328 ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
1329 (org-export-handle-metalines)
1330
1331 ;; Run the final hook
1332 (run-hooks 'org-export-preprocess-final-hook)
1333
1334 (setq rtn (buffer-string)))
1335 rtn))
1336
1337(defun org-export-kill-licensed-text ()
1338 "Remove all text that is marked with a :org-license-to-kill property."
1339 (let (p)
1340 (while (setq p (text-property-any (point-min) (point-max)
1341 :org-license-to-kill t))
1342 (delete-region
1343 p (or (next-single-property-change p :org-license-to-kill)
1344 (point-max))))))
1345
1346(defvar org-export-define-heading-targets-headline-hook nil
1347 "Hook that is run when a headline was matched during target search.
1348This is part of the preprocessing for export.")
1349
1350(defun org-export-define-heading-targets (target-alist)
1351 "Find all headings and define the targets for them.
1352The new targets are added to TARGET-ALIST, which is also returned.
1353Also find all ID and CUSTOM_ID properties and store them."
1354 (goto-char (point-min))
1355 (org-init-section-numbers)
1356 (let ((re (concat "^" org-outline-regexp
1357 "\\|"
1358 "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)"))
1359 level target last-section-target a id)
1360 (while (re-search-forward re nil t)
1361 (org-if-unprotected-at (match-beginning 0)
1362 (if (match-end 2)
1363 (progn
1364 (setq id (org-match-string-no-properties 2))
1365 (push (cons id target) target-alist)
1366 (setq a (or (assoc last-section-target org-export-target-aliases)
1367 (progn
1368 (push (list last-section-target)
1369 org-export-target-aliases)
1370 (car org-export-target-aliases))))
1371 (push (caar target-alist) (cdr a))
1372 (when (equal (match-string 1) "CUSTOM_ID")
1373 (if (not (assoc last-section-target
1374 org-export-preferred-target-alist))
1375 (push (cons last-section-target id)
1376 org-export-preferred-target-alist)))
1377 (when (equal (match-string 1) "ID")
1378 (if (not (assoc last-section-target
1379 org-export-id-target-alist))
1380 (push (cons last-section-target (concat "ID-" id))
1381 org-export-id-target-alist))))
1382 (setq level (org-reduced-level
1383 (save-excursion (goto-char (point-at-bol))
1384 (org-outline-level))))
1385 (setq target (org-solidify-link-text
1386 (format "sec-%s" (replace-regexp-in-string
1387 "\\." "-"
1388 (org-section-number level)))))
1389 (setq last-section-target target)
1390 (push (cons target target) target-alist)
1391 (add-text-properties
1392 (point-at-bol) (point-at-eol)
1393 (list 'target target))
1394 (run-hooks 'org-export-define-heading-targets-headline-hook)))))
1395 target-alist)
1396
1397(defun org-export-handle-invisible-targets (target-alist)
1398 "Find targets in comments and move them out of comments.
1399Mark them as invisible targets."
1400 (let (target tmp a)
1401 (goto-char (point-min))
1402 (while (re-search-forward "^#.*?\\(<<<?\\([^>\r\n]+\\)>>>?\\).*" nil t)
1403 ;; Check if the line before or after is a headline with a target
1404 (if (setq target (or (get-text-property (point-at-bol 0) 'target)
1405 (get-text-property (point-at-bol 2) 'target)))
1406 (progn
1407 ;; use the existing target in a neighboring line
1408 (setq tmp (match-string 2))
1409 (replace-match "")
1410 (and (looking-at "\n") (delete-char 1))
1411 (push (cons (setq tmp (org-solidify-link-text tmp)) target)
1412 target-alist)
1413 (setq a (or (assoc target org-export-target-aliases)
1414 (progn
1415 (push (list target) org-export-target-aliases)
1416 (car org-export-target-aliases))))
1417 (push tmp (cdr a)))
1418 ;; Make an invisible target
1419 (replace-match "\\1(INVISIBLE)"))))
1420 target-alist)
1421
1422(defun org-export-target-internal-links (target-alist)
1423 "Find all internal links and assign targets to them.
1424If a link has a fuzzy match (i.e. not a *dedicated* target match),
1425let the link point to the corresponding section.
1426This function also handles the id links, if they have a match in
1427the current file."
1428 (goto-char (point-min))
1429 (while (re-search-forward org-bracket-link-regexp nil t)
1430 (org-if-unprotected-at (1+ (match-beginning 0))
1431 (let* ((org-link-search-must-match-exact-headline t)
1432 (md (match-data))
1433 (desc (match-end 2))
1434 (link (org-link-unescape (match-string 1)))
1435 (slink (org-solidify-link-text link))
1436 found props pos cref
1437 (target
1438 (cond
1439 ((= (string-to-char link) ?#)
1440 ;; user wants exactly this link
1441 link)
1442 ((cdr (assoc slink target-alist))
1443 (or (cdr (assoc (assoc slink target-alist)
1444 org-export-preferred-target-alist))
1445 (cdr (assoc slink target-alist))))
1446 ((and (string-match "^id:" link)
1447 (cdr (assoc (substring link 3) target-alist))))
1448 ((string-match "^(\\(.*\\))$" link)
1449 (setq cref (match-string 1 link))
1450 (concat "coderef:" cref))
1451 ((string-match org-link-types-re link) nil)
1452 ((or (file-name-absolute-p link)
1453 (string-match "^\\." link))
1454 nil)
1455 (t
1456 (let ((org-link-search-inhibit-query t))
1457 (save-excursion
1458 (setq found (condition-case nil (org-link-search link)
1459 (error nil)))
1460 (when (and found
1461 (or (org-at-heading-p)
1462 (not (eq found 'dedicated))))
1463 (or (get-text-property (point) 'target)
1464 (get-text-property
1465 (max (point-min)
1466 (1- (or (previous-single-property-change
1467 (point) 'target) 0)))
1468 'target)))))))))
1469 (when target
1470 (set-match-data md)
1471 (goto-char (match-beginning 1))
1472 (setq props (text-properties-at (point)))
1473 (delete-region (match-beginning 1) (match-end 1))
1474 (setq pos (point))
1475 (insert target)
1476 (unless desc (insert "][" link))
1477 (add-text-properties pos (point) props))))))
1478
1479(defun org-export-remember-html-container-classes ()
1480 "Store the HTML_CONTAINER_CLASS properties in a text property."
1481 (goto-char (point-min))
1482 (let (class)
1483 (while (re-search-forward
1484 "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
1485 (setq class (match-string 1))
1486 (save-excursion
1487 (when (re-search-backward "^\\*" (point-min) t)
1488 (org-back-to-heading t)
1489 (put-text-property (point-at-bol) (point-at-eol)
1490 'html-container-class class))))))
1491
1492(defvar org-export-format-drawer-function nil
1493 "Function to be called to format the contents of a drawer.
1494The function must accept two parameters:
1495 NAME the drawer name, like \"PROPERTIES\"
1496 CONTENT the content of the drawer.
1497You can check the export backend through `org-export-current-backend'.
1498The function should return the text to be inserted into the buffer.
1499If this is nil, `org-export-format-drawer' is used as a default.")
1500
1501(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers)
1502 "Remove drawers, or extract and format the content.
1503ALL-DRAWERS is a list of all drawer names valid in the current buffer.
1504EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers
1505whose content to keep. Any drawers that are in ALL-DRAWERS but not in
1506EXP-DRAWERS will be removed."
1507 (goto-char (point-min))
1508 (let ((re (concat "^[ \t]*:\\("
1509 (mapconcat 'identity all-drawers "\\|")
1510 "\\):[ \t]*$"))
1511 name beg beg-content eol content)
1512 (while (re-search-forward re nil t)
1513 (org-if-unprotected
1514 (setq name (match-string 1))
1515 (setq beg (match-beginning 0)
1516 beg-content (1+ (point-at-eol))
1517 eol (point-at-eol))
1518 (if (not (and (re-search-forward
1519 "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" nil t)
1520 (match-end 1)))
1521 (goto-char eol)
1522 (goto-char (match-beginning 0))
1523 (and (looking-at ".*\n?") (replace-match ""))
1524 (setq content (buffer-substring beg-content (point)))
1525 (delete-region beg (point))
1526 (when (or (eq exp-drawers t)
1527 (member name exp-drawers))
1528 (setq content (funcall (or org-export-format-drawer-function
1529 'org-export-format-drawer)
1530 name content))
1531 (insert content)))))))
1532
1533(defun org-export-format-drawer (name content)
1534 "Format the content of a drawer as a colon example."
1535 (if (string-match "[ \t]+\\'" content)
1536 (setq content (substring content (match-beginning 0))))
1537 (while (string-match "\\`[ \t]*\n" content)
1538 (setq content (substring content (match-end 0))))
1539 (setq content (org-remove-indentation content))
1540 (setq content (concat ": " (mapconcat 'identity
1541 (org-split-string content "\n")
1542 "\n: ")
1543 "\n"))
1544 (setq content (concat " : " (upcase name) "\n" content))
1545 (org-add-props content nil 'org-protected t))
1546
1547(defun org-export-handle-export-tags (select-tags exclude-tags)
1548 "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS.
1549Both arguments are lists of tags.
1550If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG
1551will be removed.
1552After that, all subtrees that are marked by EXCLUDE-TAGS will be
1553removed as well."
1554 (remove-text-properties (point-min) (point-max) '(:org-delete t))
1555 (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote
1556 select-tags "\\|")
1557 "\\):"))
1558 (re-excl (concat ":\\(" (mapconcat 'regexp-quote
1559 exclude-tags "\\|")
1560 "\\):"))
1561 beg end cont)
1562 (goto-char (point-min))
1563 (when (and select-tags
1564 (re-search-forward
1565 (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t))
1566 ;; At least one tree is marked for export, this means
1567 ;; all the unmarked stuff needs to go.
1568 ;; Dig out the trees that should be exported
1569 (goto-char (point-min))
1570 (outline-next-heading)
1571 (setq beg (point))
1572 (put-text-property beg (point-max) :org-delete t)
1573 (while (re-search-forward re-sel nil t)
1574 (when (org-at-heading-p)
1575 (org-back-to-heading)
1576 (remove-text-properties
1577 (max (1- (point)) (point-min))
1578 (setq cont (save-excursion (org-end-of-subtree t t)))
1579 '(:org-delete t))
1580 (while (and (org-up-heading-safe)
1581 (get-text-property (point) :org-delete))
1582 (remove-text-properties (max (1- (point)) (point-min))
1583 (point-at-eol) '(:org-delete t)))
1584 (goto-char cont))))
1585 ;; Remove the trees explicitly marked for noexport
1586 (when exclude-tags
1587 (goto-char (point-min))
1588 (while (re-search-forward re-excl nil t)
1589 (when (org-at-heading-p)
1590 (org-back-to-heading t)
1591 (setq beg (point))
1592 (org-end-of-subtree t t)
1593 (delete-region beg (point))
1594 (when (featurep 'org-inlinetask)
1595 (org-inlinetask-remove-END-maybe)))))
1596 ;; Remove everything that is now still marked for deletion
1597 (goto-char (point-min))
1598 (while (setq beg (text-property-any (point-min) (point-max) :org-delete t))
1599 (setq end (or (next-single-property-change beg :org-delete)
1600 (point-max)))
1601 (delete-region beg end))))
1602
1603(defun org-export-remove-tasks (keep)
1604 "Remove tasks depending on configuration.
1605When KEEP is nil, remove all tasks.
1606When KEEP is `todo', remove the tasks that are DONE.
1607When KEEP is `done', remove the tasks that are not yet done.
1608When it is a list of strings, keep only tasks with these TODO keywords."
1609 (when (or (listp keep) (memq keep '(todo done nil)))
1610 (let ((re (concat "^\\*+[ \t]+\\("
1611 (mapconcat
1612 'regexp-quote
1613 (cond ((not keep) org-todo-keywords-1)
1614 ((eq keep 'todo) org-done-keywords)
1615 ((eq keep 'done) org-not-done-keywords)
1616 ((listp keep)
1617 (org-delete-all keep (copy-sequence
1618 org-todo-keywords-1))))
1619 "\\|")
1620 "\\)\\($\\|[ \t]\\)"))
1621 (case-fold-search nil)
1622 beg)
1623 (goto-char (point-min))
1624 (while (re-search-forward re nil t)
1625 (org-if-unprotected
1626 (setq beg (match-beginning 0))
1627 (org-end-of-subtree t t)
1628 (if (looking-at "^\\*+[ \t]+END[ \t]*$")
1629 ;; Kill the END line of the inline task
1630 (goto-char (min (point-max) (1+ (match-end 0)))))
1631 (delete-region beg (point)))))))
1632
1633(defun org-export-remove-archived-trees (export-archived-trees)
1634 "Remove archived trees.
1635When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported.
1636When it is t, the entire archived tree will be exported.
1637When it is nil the entire tree including the headline will be removed
1638from the buffer."
1639 (let ((re-archive (concat ":" org-archive-tag ":"))
1640 a b)
1641 (when (not (eq export-archived-trees t))
1642 (goto-char (point-min))
1643 (while (re-search-forward re-archive nil t)
1644 (if (not (org-at-heading-p t))
1645 (goto-char (point-at-eol))
1646 (beginning-of-line 1)
1647 (setq a (if export-archived-trees
1648 (1+ (point-at-eol)) (point))
1649 b (org-end-of-subtree t))
1650 (if (> b a) (delete-region a b)))))))
1651
1652(defun org-export-remove-headline-metadata (opts)
1653 "Remove meta data from the headline, according to user options."
1654 (let ((re org-complex-heading-regexp)
1655 (todo (plist-get opts :todo-keywords))
1656 (tags (plist-get opts :tags))
1657 (pri (plist-get opts :priority))
1658 (elts '(1 2 3 4 5))
1659 (case-fold-search nil)
1660 rpl)
1661 (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5))))
1662 (when (or (not todo) (not tags) (not pri))
1663 (goto-char (point-min))
1664 (while (re-search-forward re nil t)
1665 (org-if-unprotected
1666 (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) ""))
1667 elts " "))
1668 (replace-match rpl t t))))))
1669
1670(defun org-export-remove-timestamps ()
1671 "Remove timestamps and keywords for export."
1672 (goto-char (point-min))
1673 (while (re-search-forward org-maybe-keyword-time-regexp nil t)
1674 (backward-char 1)
1675 (org-if-unprotected
1676 (unless (save-match-data (org-at-table-p))
1677 (replace-match "")
1678 (beginning-of-line 1)
1679 (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n")
1680 (replace-match ""))))))
1681
1682(defun org-export-remove-clock-lines ()
1683 "Remove clock lines for export."
1684 (goto-char (point-min))
1685 (let ((re (concat "^[ \t]*" org-clock-string ".*\n?")))
1686 (while (re-search-forward re nil t)
1687 (org-if-unprotected
1688 (replace-match "")))))
1689
1690(defvar org-heading-keyword-regexp-format) ; defined in org.el
1691(defun org-export-protect-quoted-subtrees ()
1692 "Mark quoted subtrees with the protection property."
1693 (let ((org-re-quote (format org-heading-keyword-regexp-format
1694 org-quote-string)))
1695 (goto-char (point-min))
1696 (while (re-search-forward org-re-quote nil t)
1697 (goto-char (match-beginning 0))
1698 (end-of-line 1)
1699 (add-text-properties (point) (org-end-of-subtree t)
1700 '(org-protected t)))))
1701
1702(defun org-export-convert-protected-spaces ()
1703 "Convert strings like \\____ to protected spaces in all backends."
1704 (goto-char (point-min))
1705 (while (re-search-forward "\\\\__+" nil t)
1706 (org-if-unprotected-1
1707 (replace-match
1708 (org-add-props
1709 (cond
1710 ((eq org-export-current-backend 'latex)
1711 (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0))))
1712 ((eq org-export-current-backend 'html)
1713 (org-add-props (match-string 0) nil
1714 'org-whitespace (- (match-end 0) (match-beginning 0))))
1715 ;; ((eq org-export-current-backend 'docbook))
1716 ((eq org-export-current-backend 'ascii)
1717 (org-add-props (match-string 0) '(org-whitespace t)))
1718 (t (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
1719 '(org-protected t))
1720 t t))))
1721
1722(defun org-export-protect-verbatim ()
1723 "Mark verbatim snippets with the protection property."
1724 (goto-char (point-min))
1725 (while (re-search-forward org-verbatim-re nil t)
1726 (org-if-unprotected
1727 (add-text-properties (match-beginning 4) (match-end 4)
1728 '(org-protected t org-verbatim-emph t))
1729 (goto-char (1+ (match-end 4))))))
1730
1731(defun org-export-protect-colon-examples ()
1732 "Protect lines starting with a colon."
1733 (goto-char (point-min))
1734 (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg)
1735 (while (re-search-forward re nil t)
1736 (beginning-of-line 1)
1737 (setq beg (point))
1738 (while (looking-at re)
1739 (end-of-line 1)
1740 (or (eobp) (forward-char 1)))
1741 (add-text-properties beg (if (bolp) (1- (point)) (point))
1742 '(org-protected t)))))
1743
1744(defvar org-export-backends
1745 '(docbook html beamer ascii latex)
1746 "List of Org supported export backends.")
1747
1748(defun org-export-select-backend-specific-text ()
1749 (let ((formatters org-export-backends)
1750 (case-fold-search t)
1751 backend backend-name beg beg-content end end-content ind)
1752
1753 (while formatters
1754 (setq backend (pop formatters)
1755 backend-name (symbol-name backend))
1756
1757 ;; Handle #+BACKEND: stuff
1758 (goto-char (point-min))
1759 (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name
1760 ":[ \t]*\\(.*\\)") nil t)
1761 (if (not (eq backend org-export-current-backend))
1762 (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
1763 (let ((ind (get-text-property (point-at-bol) 'original-indentation)))
1764 (replace-match "\\1\\2" t)
1765 (add-text-properties
1766 (point-at-bol) (min (1+ (point-at-eol)) (point-max))
1767 `(org-protected t original-indentation ,ind org-native-text t)))))
1768 ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
1769 ;; matching the current backend will be taken care of by
1770 ;; `org-export-attach-captions-and-attributes'
1771 (goto-char (point-min))
1772 (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name
1773 ":[ \t]*\\(.*\\)") nil t)
1774 (setq ind (org-get-indentation))
1775 (when (not (eq backend org-export-current-backend))
1776 (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
1777 ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff
1778 (goto-char (point-min))
1779 (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?")
1780 nil t)
1781 (setq beg (match-beginning 0) beg-content (match-end 0))
1782 (setq ind (or (get-text-property beg 'original-indentation)
1783 (save-excursion (goto-char beg) (org-get-indentation))))
1784 (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?")
1785 nil t)
1786 (setq end (match-end 0) end-content (match-beginning 0))
1787 (if (eq backend org-export-current-backend)
1788 ;; yes, keep this
1789 (progn
1790 (add-text-properties
1791 beg-content end-content
1792 `(org-protected t original-indentation ,ind org-native-text t))
1793 ;; strip protective commas
1794 (org-unescape-code-in-region beg-content end-content)
1795 (delete-region (match-beginning 0) (match-end 0))
1796 (save-excursion
1797 (goto-char beg)
1798 (delete-region (point) (1+ (point-at-eol)))))
1799 ;; No, this is for a different backend, kill it
1800 (delete-region beg end)))))))
1801
1802(defun org-export-mark-blockquote-verse-center ()
1803 "Mark block quote and verse environments with special cookies.
1804These special cookies will later be interpreted by the backend."
1805 ;; Blockquotes
1806 (let (type t1 ind beg end beg1 end1 content)
1807 (goto-char (point-min))
1808 (while (re-search-forward
1809 "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)"
1810 nil t)
1811 (setq ind (length (match-string 1))
1812 type (downcase (match-string 3))
1813 t1 (if (equal type "quote") "blockquote" type))
1814 (setq beg (match-beginning 0)
1815 beg1 (1+ (match-end 0)))
1816 (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t)
1817 (setq end1 (1- (match-beginning 0))
1818 end (+ (point-at-eol) (if (looking-at "\n$") 1 0)))
1819 (setq content (org-remove-indentation (buffer-substring beg1 end1)))
1820 (setq content (concat "ORG-" (upcase t1) "-START\n"
1821 content "\n"
1822 "ORG-" (upcase t1) "-END\n"))
1823 (delete-region beg end)
1824 (insert (org-add-props content nil 'original-indentation ind))))))
1825
1826(defun org-export-mark-list-end ()
1827 "Mark all list endings with a special string."
1828 (unless (eq org-export-current-backend 'ascii)
1829 (mapc
1830 (lambda (e)
1831 ;; For each type allowing list export, find every list, remove
1832 ;; ending regexp if needed, and insert org-list-end.
1833 (goto-char (point-min))
1834 (while (re-search-forward (org-item-beginning-re) nil t)
1835 (when (eq (nth 2 (org-list-context)) e)
1836 (let* ((struct (org-list-struct))
1837 (bottom (org-list-get-bottom-point struct))
1838 (top (point-at-bol))
1839 (top-ind (org-list-get-ind top struct)))
1840 (goto-char bottom)
1841 (when (and (not (looking-at "[ \t]*$"))
1842 (looking-at org-list-end-re))
1843 (replace-match ""))
1844 (unless (bolp) (insert "\n"))
1845 ;; As org-list-end is inserted at column 0, it would end
1846 ;; by indentation any list. It can be problematic when
1847 ;; there are lists within lists: the inner list end would
1848 ;; also become the outer list end. To avoid this, text
1849 ;; property `original-indentation' is added, as
1850 ;; `org-list-struct' pays attention to it when reading a
1851 ;; list.
1852 (insert (org-add-props
1853 "ORG-LIST-END-MARKER\n"
1854 (list 'original-indentation top-ind)))))))
1855 (cons nil org-list-export-context))))
1856
1857(defun org-export-mark-list-properties ()
1858 "Mark list with special properties.
1859These special properties will later be interpreted by the backend."
1860 (let ((mark-list
1861 (function
1862 ;; Mark a list with 3 properties: `list-item' which is
1863 ;; position at beginning of line, `list-struct' which is
1864 ;; list structure, and `list-prevs' which is the alist of
1865 ;; item and its predecessor. Leave point at list ending.
1866 (lambda (ctxt)
1867 (let* ((struct (org-list-struct))
1868 (top (org-list-get-top-point struct))
1869 (bottom (org-list-get-bottom-point struct))
1870 (prevs (org-list-prevs-alist struct))
1871 poi)
1872 ;; Get every item and ending position, without dups and
1873 ;; without bottom point of list.
1874 (mapc (lambda (e)
1875 (let ((pos (car e))
1876 (end (nth 6 e)))
1877 (unless (memq pos poi)
1878 (push pos poi))
1879 (unless (or (= end bottom) (memq end poi))
1880 (push end poi))))
1881 struct)
1882 (setq poi (sort poi '<))
1883 ;; For every point of interest, mark the whole line with
1884 ;; its position in list.
1885 (mapc
1886 (lambda (e)
1887 (goto-char e)
1888 (add-text-properties (point-at-bol) (point-at-eol)
1889 (list 'list-item (point-at-bol)
1890 'list-struct struct
1891 'list-prevs prevs)))
1892 poi)
1893 ;; Take care of bottom point. As babel may have inserted
1894 ;; a new list in buffer, list ending isn't always
1895 ;; marked. Now mark every list ending and add properties
1896 ;; useful to line processing exporters.
1897 (goto-char bottom)
1898 (when (or (looking-at "^ORG-LIST-END-MARKER\n")
1899 (and (not (looking-at "[ \t]*$"))
1900 (looking-at org-list-end-re)))
1901 (replace-match ""))
1902 (unless (bolp) (insert "\n"))
1903 (insert
1904 (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
1905 'list-struct struct
1906 'list-prevs prevs)))
1907 ;; Following property is used by LaTeX exporter.
1908 (add-text-properties top (point) (list 'list-context ctxt)))))))
1909 ;; Mark lists except for backends not interpreting them.
1910 (unless (eq org-export-current-backend 'ascii)
1911 (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
1912 (mapc
1913 (lambda (e)
1914 (goto-char (point-min))
1915 (while (re-search-forward (org-item-beginning-re) nil t)
1916 (let ((context (nth 2 (org-list-context))))
1917 (if (eq context e)
1918 (funcall mark-list e)
1919 (put-text-property (point-at-bol) (point-at-eol)
1920 'list-context context)))))
1921 (cons nil org-list-export-context))))))
1922
1923(defun org-export-attach-captions-and-attributes (target-alist)
1924 "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties.
1925If the next thing following is a table, add the text properties to the first
1926table line. If it is a link, add it to the line containing the link."
1927 (goto-char (point-min))
1928 (remove-text-properties (point-min) (point-max)
1929 '(org-caption nil org-attributes nil))
1930 (let ((case-fold-search t)
1931 (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)"
1932 "\\|"
1933 "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)"
1934 "\\|"
1935 "^[ \t]*#\\+label:[ \t]+\\(.*\\)"
1936 "\\|"
1937 "^[ \t]*\\(|[^-]\\)"
1938 "\\|"
1939 "^[ \t]*\\[\\[.*\\]\\][ \t]*$"))
1940 cap shortn attr label end)
1941 (while (re-search-forward re nil t)
1942 (cond
1943 ;; there is a caption
1944 ((match-end 1)
1945 (progn
1946 (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))
1947 (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap)
1948 (setq shortn (match-string 1 cap)
1949 cap (match-string 2 cap)))
1950 (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
1951 ;; there is an attribute
1952 ((match-end 2)
1953 (progn
1954 (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))
1955 (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
1956 ;; there is a label
1957 ((match-end 3)
1958 (progn
1959 (setq label (org-trim (match-string 3)))
1960 (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
1961 (t
1962 (setq end (if (match-end 4)
1963 (let ((ee (org-table-end)))
1964 (prog1 (1- (marker-position ee)) (move-marker ee nil)))
1965 (point-at-eol)))
1966 (add-text-properties (point-at-bol) end
1967 (list 'org-caption cap
1968 'org-caption-shortn shortn
1969 'org-attributes attr
1970 'org-label label))
1971 (if label (push (cons label label) target-alist))
1972 (goto-char end)
1973 (setq cap nil shortn nil attr nil label nil)))))
1974 target-alist)
1975
1976(defun org-export-remove-comment-blocks-and-subtrees ()
1977 "Remove the comment environment, and also commented subtrees."
1978 (let ((re-commented (format org-heading-keyword-regexp-format
1979 org-comment-string))
1980 case-fold-search)
1981 ;; Remove comment environment
1982 (goto-char (point-min))
1983 (setq case-fold-search t)
1984 (while (re-search-forward
1985 "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t)
1986 (replace-match "" t t))
1987 ;; Remove subtrees that are commented
1988 (goto-char (point-min))
1989 (setq case-fold-search nil)
1990 (while (re-search-forward re-commented nil t)
1991 (goto-char (match-beginning 0))
1992 (delete-region (point) (org-end-of-subtree t)))))
1993
1994(defun org-export-handle-comments (org-commentsp)
1995 "Remove comments, or convert to backend-specific format.
1996ORG-COMMENTSP can be a format string for publishing comments.
1997When it is nil, all comments will be removed."
1998 (let ((re "^[ \t]*#\\( \\|$\\)"))
1999 (goto-char (point-min))
2000 (while (re-search-forward re nil t)
2001 (let ((pos (match-beginning 0))
2002 (end (progn (forward-line) (point))))
2003 (if (get-text-property pos 'org-protected)
2004 (forward-line)
2005 (if (not org-commentsp) (delete-region pos end)
2006 (add-text-properties pos end '(org-protected t))
2007 (replace-match
2008 (org-add-props
2009 (format org-commentsp (buffer-substring (match-end 0) end))
2010 nil 'org-protected t)
2011 t t)))))
2012 ;; Hack attack: previous implementation also removed keywords at
2013 ;; column 0. Brainlessly do it again.
2014 (goto-char (point-min))
2015 (while (re-search-forward "^#\\+" nil t)
2016 (unless (get-text-property (point-at-bol) 'org-protected)
2017 (delete-region (point-at-bol) (progn (forward-line) (point)))))))
2018
2019(defun org-export-handle-metalines ()
2020 "Remove tables and source blocks metalines.
2021This function should only be called after all block processing
2022has taken place."
2023 (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)")
2024 (case-fold-search t)
2025 pos)
2026 (goto-char (point-min))
2027 (while (or (looking-at re)
2028 (re-search-forward re nil t))
2029 (setq pos (match-beginning 0))
2030 (if (get-text-property (match-beginning 1) 'org-protected)
2031 (goto-char (1+ pos))
2032 (goto-char (1+ pos))
2033 (replace-match "")
2034 (goto-char (max (point-min) (1- pos)))))))
2035
2036(defun org-export-mark-radio-links ()
2037 "Find all matches for radio targets and turn them into internal links."
2038 (let ((re-radio (and org-target-link-regexp
2039 (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))))
2040 (goto-char (point-min))
2041 (when re-radio
2042 (while (re-search-forward re-radio nil t)
2043 (unless
2044 (save-match-data
2045 (or (org-in-regexp org-bracket-link-regexp)
2046 (org-in-regexp org-plain-link-re)
2047 (org-in-regexp "<<[^<>]+>>")))
2048 (org-if-unprotected
2049 (replace-match "\\1[[\\2]]")))))))
2050
2051(defun org-store-forced-table-alignment ()
2052 "Find table lines which force alignment, store the results in properties."
2053 (let (line cnt cookies)
2054 (goto-char (point-min))
2055 (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|"
2056 nil t)
2057 ;; OK, this looks like a table line with an alignment cookie
2058 (org-if-unprotected
2059 (setq line (buffer-substring (point-at-bol) (point-at-eol)))
2060 (when (and (org-at-table-p)
2061 (org-table-cookie-line-p line))
2062 (setq cnt 0 cookies nil)
2063 (mapc
2064 (lambda (x)
2065 (setq cnt (1+ cnt))
2066 (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x)
2067 (let ((align (and (match-end 1)
2068 (downcase (match-string 1 x))))
2069 (width (and (match-end 2)
2070 (string-to-number (match-string 2 x)))))
2071 (push (cons cnt (list align width)) cookies))))
2072 (org-split-string line "[ \t]*|[ \t]*"))
2073 (add-text-properties (org-table-begin) (org-table-end)
2074 (list 'org-col-cookies cookies))))
2075 (goto-char (point-at-eol)))))
2076
2077(defun org-export-remove-special-table-lines ()
2078 "Remove tables lines that are used for internal purposes.
2079Also, store forced alignment information found in such lines."
2080 (goto-char (point-min))
2081 (while (re-search-forward "^[ \t]*|" nil t)
2082 (org-if-unprotected-at (1- (point))
2083 (beginning-of-line 1)
2084 (if (or (looking-at "[ \t]*| *[!_^] *|")
2085 (not
2086 (memq
2087 nil
2088 (mapcar
2089 (lambda (f)
2090 (or (and org-export-table-remove-empty-lines (= (length f) 0))
2091 (string-match
2092 "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f)))
2093 (org-split-string ;; FIXME, can't we do without splitting???
2094 (buffer-substring (point-at-bol) (point-at-eol))
2095 "[ \t]*|[ \t]*")))))
2096 (delete-region (max (point-min) (1- (point-at-bol)))
2097 (point-at-eol))
2098 (end-of-line 1)))))
2099
2100(defun org-export-protect-sub-super (s)
2101 (save-match-data
2102 (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s)
2103 (setq s (replace-match "\\1\\\\\\2" nil nil s)))
2104 s))
2105
2106(defun org-export-normalize-links ()
2107 "Convert all links to bracket links, and expand link abbreviations."
2108 (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
2109 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
2110 nodesc)
2111 (goto-char (point-min))
2112 (while (re-search-forward org-bracket-link-regexp nil t)
2113 (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t))
2114 (goto-char (point-min))
2115 (while (re-search-forward re-plain-link nil t)
2116 (unless (get-text-property (match-beginning 0) 'org-normalized-link)
2117 (goto-char (1- (match-end 0)))
2118 (org-if-unprotected-at (1+ (match-beginning 0))
2119 (let* ((s (concat (match-string 1)
2120 "[[" (match-string 2) ":" (match-string 3)
2121 "][" (match-string 2) ":" (org-export-protect-sub-super
2122 (match-string 3))
2123 "]]")))
2124 ;; added 'org-link face to links
2125 (put-text-property 0 (length s) 'face 'org-link s)
2126 (replace-match s t t)))))
2127 (goto-char (point-min))
2128 (while (re-search-forward re-angle-link nil t)
2129 (goto-char (1- (match-end 0)))
2130 (org-if-unprotected
2131 (let* ((s (concat (match-string 1)
2132 "[[" (match-string 2) ":" (match-string 3)
2133 "][" (match-string 2) ":" (org-export-protect-sub-super
2134 (match-string 3))
2135 "]]")))
2136 (put-text-property 0 (length s) 'face 'org-link s)
2137 (replace-match s t t))))
2138 (goto-char (point-min))
2139 (while (re-search-forward org-bracket-link-regexp nil t)
2140 (goto-char (1- (match-end 0)))
2141 (setq nodesc (not (match-end 3)))
2142 (org-if-unprotected
2143 (let* ((xx (save-match-data
2144 (org-translate-link
2145 (org-link-expand-abbrev (match-string 1)))))
2146 (s (concat
2147 "[[" (org-add-props (copy-sequence xx)
2148 nil 'org-protected t 'org-no-description nodesc)
2149 "]"
2150 (if (match-end 3)
2151 (match-string 2)
2152 (concat "[" (copy-sequence xx)
2153 "]"))
2154 "]")))
2155 (put-text-property 0 (length s) 'face 'org-link s)
2156 (replace-match s t t))))))
2157
2158(defun org-export-concatenate-multiline-links ()
2159 "Find multi-line links and put it all into a single line.
2160This is to make sure that the line-processing export backends
2161can work correctly."
2162 (goto-char (point-min))
2163 (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
2164 (org-if-unprotected-at (match-beginning 1)
2165 (replace-match "\\1 \\3")
2166 (goto-char (match-beginning 0)))))
2167
2168(defun org-export-concatenate-multiline-emphasis ()
2169 "Find multi-line emphasis and put it all into a single line.
2170This is to make sure that the line-processing export backends
2171can work correctly."
2172 (goto-char (point-min))
2173 (while (re-search-forward org-emph-re nil t)
2174 (if (and (not (= (char-after (match-beginning 3))
2175 (char-after (match-beginning 4))))
2176 (save-excursion (goto-char (match-beginning 0))
2177 (save-match-data
2178 (and (not (org-at-table-p))
2179 (not (org-at-heading-p))))))
2180 (org-if-unprotected
2181 (subst-char-in-region (match-beginning 0) (match-end 0)
2182 ?\n ?\ t)
2183 (goto-char (1- (match-end 0))))
2184 (goto-char (1+ (match-beginning 0))))))
2185
2186(defun org-export-grab-title-from-buffer ()
2187 "Get a title for the current document, from looking at the buffer."
2188 (let ((inhibit-read-only t))
2189 (save-excursion
2190 (goto-char (point-min))
2191 (let ((end (if (looking-at org-outline-regexp)
2192 (point)
2193 (save-excursion (outline-next-heading) (point)))))
2194 (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t)
2195 ;; Mark the line so that it will not be exported as normal text.
2196 (unless (org-in-block-p org-list-forbidden-blocks)
2197 (org-unmodified
2198 (add-text-properties (match-beginning 0) (match-end 0)
2199 (list :org-license-to-kill t))))
2200 ;; Return the title string
2201 (org-trim (match-string 0)))))))
2202
2203(defun org-export-get-title-from-subtree ()
2204 "Return subtree title and exclude it from export."
2205 (let ((rbeg (region-beginning)) (rend (region-end))
2206 (inhibit-read-only t)
2207 (tags (plist-get (org-infile-export-plist) :tags))
2208 title)
2209 (save-excursion
2210 (goto-char rbeg)
2211 (when (and (org-at-heading-p)
2212 (>= (org-end-of-subtree t t) rend))
2213 (when (plist-member org-export-opt-plist :tags)
2214 (setq tags (or (plist-get org-export-opt-plist :tags) tags)))
2215 ;; This is a subtree, we take the title from the first heading
2216 (goto-char rbeg)
2217 (looking-at org-todo-line-tags-regexp)
2218 (setq title (if (and (eq tags t) (match-string 4))
2219 (format "%s\t%s" (match-string 3) (match-string 4))
2220 (match-string 3)))
2221 (org-unmodified
2222 (add-text-properties (point) (1+ (point-at-eol))
2223 (list :org-license-to-kill t)))
2224 (setq title (or (org-entry-get nil "EXPORT_TITLE") title))))
2225 title))
2226
2227(defun org-solidify-link-text (s &optional alist)
2228 "Take link text and make a safe target out of it."
2229 (save-match-data
2230 (let* ((rtn
2231 (mapconcat
2232 'identity
2233 (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-"))
2234 (a (assoc rtn alist)))
2235 (or (cdr a) rtn))))
2236
2237(defun org-get-min-level (lines &optional offset)
2238 "Get the minimum level in LINES."
2239 (let ((re "^\\(\\*+\\) ") l)
2240 (catch 'exit
2241 (while (setq l (pop lines))
2242 (if (string-match re l)
2243 (throw 'exit (org-tr-level (- (length (match-string 1 l))
2244 (or offset 0))))))
2245 1)))
2246
2247;; Variable holding the vector with section numbers
2248(defvar org-section-numbers (make-vector org-level-max 0))
2249
2250(defun org-init-section-numbers ()
2251 "Initialize the vector for the section numbers."
2252 (let* ((level -1)
2253 (numbers (nreverse (org-split-string "" "\\.")))
2254 (depth (1- (length org-section-numbers)))
2255 (i depth) number-string)
2256 (while (>= i 0)
2257 (if (> i level)
2258 (aset org-section-numbers i 0)
2259 (setq number-string (or (car numbers) "0"))
2260 (if (string-match "\\`[A-Z]\\'" number-string)
2261 (aset org-section-numbers i
2262 (- (string-to-char number-string) ?A -1))
2263 (aset org-section-numbers i (string-to-number number-string)))
2264 (pop numbers))
2265 (setq i (1- i)))))
2266
2267(defun org-section-number (&optional level)
2268 "Return a string with the current section number.
2269When LEVEL is non-nil, increase section numbers on that level."
2270 (let* ((depth (1- (length org-section-numbers)))
2271 (string "")
2272 (fmts (car org-export-section-number-format))
2273 (term (cdr org-export-section-number-format))
2274 (sep "")
2275 ctype fmt idx n)
2276 (when level
2277 (when (> level -1)
2278 (aset org-section-numbers
2279 level (1+ (aref org-section-numbers level))))
2280 (setq idx (1+ level))
2281 (while (<= idx depth)
2282 (if (not (= idx 1))
2283 (aset org-section-numbers idx 0))
2284 (setq idx (1+ idx))))
2285 (setq idx 0)
2286 (while (<= idx depth)
2287 (when (> (aref org-section-numbers idx) 0)
2288 (setq fmt (or (pop fmts) fmt)
2289 ctype (car fmt)
2290 n (aref org-section-numbers idx)
2291 string (if (> n 0)
2292 (concat string sep (org-number-to-counter n ctype))
2293 (concat string ".0"))
2294 sep (nth 1 fmt)))
2295 (setq idx (1+ idx)))
2296 (save-match-data
2297 (if (string-match "\\`\\([@0]\\.\\)+" string)
2298 (setq string (replace-match "" t nil string)))
2299 (if (string-match "\\(\\.0\\)+\\'" string)
2300 (setq string (replace-match "" t nil string))))
2301 (concat string term)))
2302
2303(defun org-number-to-counter (n type)
2304 "Concert number N to a string counter, according to TYPE.
2305TYPE must be a string, any of:
2306 1 number
2307 A A,B,....
2308 a a,b,....
2309 I upper case roman numeral
2310 i lower case roman numeral"
2311 (cond
2312 ((equal type "1") (number-to-string n))
2313 ((equal type "A") (char-to-string (+ ?A n -1)))
2314 ((equal type "a") (char-to-string (+ ?a n -1)))
2315 ((equal type "I") (org-number-to-roman n))
2316 ((equal type "i") (downcase (org-number-to-roman n)))
2317 (t (error "Invalid counter type `%s'" type))))
2318
2319(defun org-number-to-roman (n)
2320 "Convert integer N into a roman numeral."
2321 (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
2322 ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
2323 ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV")
2324 ( 1 . "I")))
2325 (res ""))
2326 (if (<= n 0)
2327 (number-to-string n)
2328 (while roman
2329 (if (>= n (caar roman))
2330 (setq n (- n (caar roman))
2331 res (concat res (cdar roman)))
2332 (pop roman)))
2333 res)))
2334
2335;;; Macros
2336
2337(defun org-export-preprocess-apply-macros ()
2338 "Replace macro references."
2339 (goto-char (point-min))
2340 (let (sy val key args args2 ind-str s n)
2341 (while (re-search-forward
2342 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
2343 nil t)
2344 (unless (save-match-data (save-excursion
2345 (goto-char (point-at-bol))
2346 (looking-at "[ \t]*#\\+macro")))
2347 ;; Get macro name (KEY), arguments (ARGS), and indentation of
2348 ;; current line (IND-STR) as strings.
2349 (setq key (downcase (match-string 1))
2350 args (match-string 3)
2351 ind-str (save-match-data (save-excursion
2352 (beginning-of-line)
2353 (looking-at "^\\([ \t]*\\).*")
2354 (match-string 1))))
2355 ;; When macro is defined, retrieve replacement text in VAL,
2356 ;; and proceed with expansion.
2357 (when (setq val (or (plist-get org-export-opt-plist
2358 (intern (concat ":macro-" key)))
2359 (plist-get org-export-opt-plist
2360 (intern (concat ":" key)))))
2361 (save-match-data
2362 ;; If arguments are provided, first retrieve them properly
2363 ;; (in ARGS, as a list), then replace them in VAL.
2364 (when args
2365 (setq args (org-split-string args ",") args2 nil)
2366 (while args
2367 (while (string-match "\\\\\\'" (car args))
2368 ;; Repair bad splits.
2369 (setcar (cdr args) (concat (substring (car args) 0 -1)
2370 "," (nth 1 args)))
2371 (pop args))
2372 (push (pop args) args2))
2373 (setq args (mapcar 'org-trim (nreverse args2)))
2374 (setq s 0)
2375 (while (string-match "\\$\\([0-9]+\\)" val s)
2376 (setq s (1+ (match-beginning 0))
2377 n (string-to-number (match-string 1 val)))
2378 (and (>= (length args) n)
2379 (setq val (replace-match (nth (1- n) args) t t val)))))
2380 ;; VAL starts with "(eval": it is a sexp, `eval' it.
2381 (when (string-match "\\`(eval\\>" val)
2382 (setq val (eval (read val))))
2383 ;; Ensure VAL is a string (or nil) and that each new line
2384 ;; is indented as the first one.
2385 (setq val (and val
2386 (mapconcat 'identity
2387 (org-split-string
2388 (if (stringp val) val (format "%s" val))
2389 "\n")
2390 (concat "\n" ind-str)))))
2391 ;; Eventually do the replacement, if VAL isn't nil. Move
2392 ;; point at beginning of macro for recursive expansions.
2393 (when val
2394 (replace-match val t t)
2395 (goto-char (match-beginning 0))))))))
2396
2397(defun org-export-apply-macros-in-string (s)
2398 "Apply the macros in string S."
2399 (when s
2400 (with-temp-buffer
2401 (insert s)
2402 (org-export-preprocess-apply-macros)
2403 (buffer-string))))
2404
2405;;; Include files
2406
2407(defun org-export-handle-include-files ()
2408 "Include the contents of include files, with proper formatting."
2409 (let ((case-fold-search t)
2410 params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines)
2411 (goto-char (point-min))
2412 (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t)
2413 (setq params (read (concat "(" (match-string 1) ")"))
2414 prefix (org-get-and-remove-property 'params :prefix)
2415 prefix1 (org-get-and-remove-property 'params :prefix1)
2416 minlevel (org-get-and-remove-property 'params :minlevel)
2417 addlevel (org-get-and-remove-property 'params :addlevel)
2418 lines (org-get-and-remove-property 'params :lines)
2419 file (org-symname-or-string (pop params))
2420 markup (org-symname-or-string (pop params))
2421 lang (and (member markup '("src" "SRC"))
2422 (org-symname-or-string (pop params)))
2423 switches (mapconcat #'(lambda (x) (format "%s" x)) params " ")
2424 start nil end nil)
2425 (delete-region (match-beginning 0) (match-end 0))
2426 (setq currentlevel (or (org-current-level) 0))
2427 (if (or (not file)
2428 (not (file-exists-p file))
2429 (not (file-readable-p file)))
2430 (insert (format "CANNOT INCLUDE FILE %s" file))
2431 (setq all (cons file all))
2432 (when markup
2433 (if (equal (downcase markup) "src")
2434 (setq start (format "#+begin_src %s %s\n"
2435 (or lang "fundamental")
2436 (or switches ""))
2437 end "#+end_src")
2438 (setq start (format "#+begin_%s %s\n" markup switches)
2439 end (format "#+end_%s" markup))))
2440 (insert (or start ""))
2441 (insert (org-get-file-contents (expand-file-name file)
2442 prefix prefix1 markup currentlevel minlevel addlevel lines))
2443 (or (bolp) (newline))
2444 (insert (or end ""))))
2445 all))
2446
2447(defun org-export-handle-include-files-recurse ()
2448 "Recursively include files aborting on circular inclusion."
2449 (let ((now (list org-current-export-file)) all)
2450 (while now
2451 (setq all (append now all))
2452 (setq now (org-export-handle-include-files))
2453 (let ((intersection
2454 (delq nil
2455 (mapcar (lambda (el) (when (member el all) el)) now))))
2456 (when intersection
2457 (error "Recursive #+INCLUDE: %S" intersection))))))
2458
2459(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines)
2460 "Get the contents of FILE and return them as a string.
2461If PREFIX is a string, prepend it to each line. If PREFIX1
2462is a string, prepend it to the first line instead of PREFIX.
2463If MARKUP, don't protect org-like lines, the exporter will
2464take care of the block they are in. If ADDLEVEL is a number,
2465demote included file to current heading level+ADDLEVEL.
2466If LINES is a string specifying a range of lines,
2467include only those lines."
2468 (if (stringp markup) (setq markup (downcase markup)))
2469 (with-temp-buffer
2470 (insert-file-contents file)
2471 (when lines
2472 (let* ((lines (split-string lines "-"))
2473 (lbeg (string-to-number (car lines)))
2474 (lend (string-to-number (cadr lines)))
2475 (beg (if (zerop lbeg) (point-min)
2476 (goto-char (point-min))
2477 (forward-line (1- lbeg))
2478 (point)))
2479 (end (if (zerop lend) (point-max)
2480 (goto-char (point-min))
2481 (forward-line (1- lend))
2482 (point))))
2483 (narrow-to-region beg end)))
2484 (when (or prefix prefix1)
2485 (goto-char (point-min))
2486 (while (not (eobp))
2487 (insert (or prefix1 prefix))
2488 (setq prefix1 "")
2489 (beginning-of-line 2)))
2490 (buffer-string)
2491 (when (member markup '("src" "example"))
2492 (goto-char (point-min))
2493 (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t)
2494 (goto-char (match-beginning 0))
2495 (insert ",")
2496 (end-of-line 1)))
2497 (when minlevel
2498 (dotimes (lvl minlevel)
2499 (org-map-region 'org-demote (point-min) (point-max))))
2500 (when addlevel
2501 (let ((inclevel (or (if (org-before-first-heading-p)
2502 (1- (and (outline-next-heading)
2503 (org-current-level)))
2504 (1- (org-current-level)))
2505 0)))
2506 (dotimes (level (- (+ parentlevel addlevel) inclevel))
2507 (org-map-region 'org-demote (point-min) (point-max)))))
2508 (buffer-string)))
2509
2510(defun org-get-and-remove-property (listvar prop)
2511 "Check if the value of LISTVAR contains PROP as a property.
2512If yes, return the value of that property (i.e. the element following
2513in the list) and remove property and value from the list in LISTVAR."
2514 (let ((list (symbol-value listvar)) m v)
2515 (when (setq m (member prop list))
2516 (setq v (nth 1 m))
2517 (if (equal (car list) prop)
2518 (set listvar (cddr list))
2519 (setcdr (nthcdr (- (length list) (length m) 1) list)
2520 (cddr m))
2521 (set listvar list)))
2522 v))
2523
2524(defun org-symname-or-string (s)
2525 (if (symbolp s)
2526 (if s (symbol-name s) s)
2527 s))
2528
2529;;; Fontification and line numbers for code examples
2530
2531(defvar org-export-last-code-line-counter-value 0)
2532
2533(defun org-export-replace-src-segments-and-examples ()
2534 "Replace source code segments with special code for export."
2535 (setq org-export-last-code-line-counter-value 0)
2536 (let ((case-fold-search t)
2537 lang code trans opts indent caption)
2538 (goto-char (point-min))
2539 (while (re-search-forward
2540 "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)"
2541 nil t)
2542 (if (match-end 1)
2543 (if (not (match-string 4))
2544 (error "Source block missing language specification: %s"
2545 (let* ((body (match-string 6))
2546 (nothing (message "body:%s" body))
2547 (preview (or (and (string-match
2548 "^[ \t]*\\([^\n\r]*\\)" body)
2549 (match-string 1 body)) body)))
2550 (if (> (length preview) 35)
2551 (concat (substring preview 0 32) "...")
2552 preview)))
2553 ;; src segments
2554 (setq lang (match-string 4)
2555 opts (match-string 5)
2556 code (match-string 6)
2557 indent (length (match-string 2))
2558 caption (get-text-property 0 'org-caption (match-string 0))))
2559 (setq lang nil
2560 opts (match-string 9)
2561 code (match-string 10)
2562 indent (length (match-string 8))
2563 caption (get-text-property 0 'org-caption (match-string 0))))
2564
2565 (setq trans (org-export-format-source-code-or-example
2566 lang code opts indent caption))
2567 (replace-match trans t t))))
2568
2569(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el
2570(defvar org-export-latex-listings) ;; defined in org-latex.el
2571(defvar org-export-latex-listings-langs) ;; defined in org-latex.el
2572(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el
2573(defvar org-export-latex-minted-langs) ;; defined in org-latex.el
2574(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el
2575(defvar org-export-latex-listings-options) ;; defined in org-latex.el
2576(defvar org-export-latex-minted-options) ;; defined in org-latex.el
2577
2578(defun org-remove-formatting-on-newlines-in-region (beg end)
2579 "Remove formatting on newline characters."
2580 (interactive "r")
2581 (save-excursion
2582 (goto-char beg)
2583 (while (progn (end-of-line) (< (point) end))
2584 (put-text-property (point) (1+ (point)) 'face nil)
2585 (forward-char 1))))
2586
2587(defun org-export-format-source-code-or-example
2588 (lang code &optional opts indent caption)
2589 "Format CODE from language LANG and return it formatted for export.
2590The CODE is marked up in `org-export-current-backend' format.
2591
2592Check if a function by name
2593\"org-<backend>-format-source-code-or-example\" is bound. If yes,
2594use it as the custom formatter. Otherwise, use the default
2595formatter. Default formatters are provided for docbook, html,
2596latex and ascii backends. For example, use
2597`org-html-format-source-code-or-example' to provide a custom
2598formatter for export to \"html\".
2599
2600If LANG is nil, do not add any fontification.
2601OPTS contains formatting options, like `-n' for triggering numbering lines,
2602and `+n' for continuing previous numbering.
2603Code formatting according to language currently only works for HTML.
2604Numbering lines works for all three major backends (html, latex, and ascii).
2605INDENT was the original indentation of the block."
2606 (save-match-data
2607 (let* ((backend-name (symbol-name org-export-current-backend))
2608 (backend-formatter
2609 (intern (format "org-%s-format-source-code-or-example"
2610 backend-name)))
2611 (backend-feature (intern (concat "org-" backend-name)))
2612 (backend-formatter
2613 (and (require (intern (concat "org-" backend-name)) nil)
2614 (fboundp backend-formatter) backend-formatter))
2615 num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt)
2616 (setq opts (or opts "")
2617 num (string-match "[-+]n\\>" opts)
2618 cont (string-match "\\+n\\>" opts)
2619 rpllbl (string-match "-r\\>" opts)
2620 keepp (string-match "-k\\>" opts)
2621 textareap (string-match "-t\\>" opts)
2622 preserve-indentp (or org-src-preserve-indentation
2623 (string-match "-i\\>" opts))
2624 cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts)
2625 (string-to-number (match-string 1 opts))
2626 80)
2627 rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts)
2628 (string-to-number (match-string 1 opts))
2629 (org-count-lines code))
2630 fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts)
2631 (match-string 1 opts)))
2632 (when (and textareap (eq org-export-current-backend 'html))
2633 ;; we cannot use numbering or highlighting.
2634 (setq num nil cont nil lang nil))
2635 (if keepp (setq rpllbl 'keep))
2636 (setq rtn (if preserve-indentp code (org-remove-indentation code)))
2637 (when (string-match "^," rtn)
2638 (setq rtn (with-temp-buffer
2639 (insert rtn)
2640 ;; Free up the protected lines
2641 (goto-char (point-min))
2642 (while (re-search-forward "^," nil t)
2643 (if (or (equal lang "org")
2644 (save-match-data
2645 (looking-at "\\([*#]\\|[ \t]*#\\+\\)")))
2646 (replace-match ""))
2647 (end-of-line 1))
2648 (buffer-string))))
2649 ;; Now backend-specific coding
2650 (setq rtn
2651 (cond
2652 (backend-formatter
2653 (funcall backend-formatter rtn lang caption textareap cols rows num
2654 cont rpllbl fmt))
2655 ((eq org-export-current-backend 'docbook)
2656 (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
2657 (concat "<programlisting><![CDATA["
2658 rtn
2659 "]]></programlisting>\n"))
2660 ((eq org-export-current-backend 'html)
2661 ;; We are exporting to HTML
2662 (when lang
2663 (if (featurep 'xemacs)
2664 (require 'htmlize)
2665 (require 'htmlize nil t))
2666 (when (not (fboundp 'htmlize-region-for-paste))
2667 ;; we do not have htmlize.el, or an old version of it
2668 (setq lang nil)
2669 (message
2670 "htmlize.el 1.34 or later is needed for source code formatting")))
2671
2672 (if lang
2673 (let* ((lang-m (when lang
2674 (or (cdr (assoc lang org-src-lang-modes))
2675 lang)))
2676 (mode (and lang-m (intern
2677 (concat
2678 (if (symbolp lang-m)
2679 (symbol-name lang-m)
2680 lang-m)
2681 "-mode"))))
2682 (org-inhibit-startup t)
2683 (org-startup-folded nil))
2684 (setq rtn
2685 (with-temp-buffer
2686 (insert rtn)
2687 (if (functionp mode)
2688 (funcall mode)
2689 (fundamental-mode))
2690 (font-lock-fontify-buffer)
2691 ;; markup each line separately
2692 (org-remove-formatting-on-newlines-in-region (point-min) (point-max))
2693 (org-src-mode)
2694 (set-buffer-modified-p nil)
2695 (org-export-htmlize-region-for-paste
2696 (point-min) (point-max))))
2697 (if (string-match "<pre\\([^>]*\\)>\n*" rtn)
2698 (setq rtn
2699 (concat
2700 (if caption
2701 (concat
2702 "<div class=\"org-src-container\">"
2703 (format
2704 "<label class=\"org-src-name\">%s</label>"
2705 caption))
2706 "")
2707 (replace-match
2708 (format "<pre class=\"src src-%s\">\n" lang)
2709 t t rtn)
2710 (if caption "</div>" "")))))
2711 (if textareap
2712 (setq rtn (concat
2713 (format "<p>\n<textarea cols=\"%d\" rows=\"%d\">"
2714 cols rows)
2715 rtn "</textarea>\n</p>\n"))
2716 (with-temp-buffer
2717 (insert rtn)
2718 (goto-char (point-min))
2719 (while (re-search-forward "[<>&]" nil t)
2720 (replace-match (cdr (assq (char-before)
2721 '((?&."&amp;")(?<."&lt;")(?>."&gt;"))))
2722 t t))
2723 (setq rtn (buffer-string)))
2724 (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n"))))
2725 (unless textareap
2726 (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt)))
2727 (if (string-match "\\(\\`<[^>]*>\\)\n" rtn)
2728 (setq rtn (replace-match "\\1" t nil rtn)))
2729 rtn)
2730 ((eq org-export-current-backend 'latex)
2731 (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
2732 (cond
2733 ((and lang org-export-latex-listings)
2734 (let* ((make-option-string
2735 (lambda (pair)
2736 (concat (first pair)
2737 (if (> (length (second pair)) 0)
2738 (concat "=" (second pair))))))
2739 (lang-sym (intern lang))
2740 (minted-p (eq org-export-latex-listings 'minted))
2741 (listings-p (not minted-p))
2742 (backend-lang
2743 (or (cadr
2744 (assq
2745 lang-sym
2746 (cond
2747 (minted-p org-export-latex-minted-langs)
2748 (listings-p org-export-latex-listings-langs))))
2749 lang))
2750 (custom-environment
2751 (cadr
2752 (assq
2753 lang-sym
2754 org-export-latex-custom-lang-environments))))
2755 (concat
2756 (when (and listings-p (not custom-environment))
2757 (format
2758 "\\lstset{%s}\n"
2759 (mapconcat
2760 make-option-string
2761 (append org-export-latex-listings-options
2762 `(("language" ,backend-lang))) ",")))
2763 (when (and caption org-export-latex-listings-w-names)
2764 (format
2765 "\n%s $\\equiv$ \n"
2766 (replace-regexp-in-string "_" "\\\\_" caption)))
2767 (cond
2768 (custom-environment
2769 (format "\\begin{%s}\n%s\\end{%s}\n"
2770 custom-environment rtn custom-environment))
2771 (listings-p
2772 (format "\\begin{%s}\n%s\\end{%s}"
2773 "lstlisting" rtn "lstlisting"))
2774 (minted-p
2775 (format
2776 "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
2777 (mapconcat make-option-string
2778 org-export-latex-minted-options ",")
2779 backend-lang rtn))))))
2780 (t (concat (car org-export-latex-verbatim-wrap)
2781 rtn (cdr org-export-latex-verbatim-wrap)))))
2782 ((eq org-export-current-backend 'ascii)
2783 ;; This is not HTML or LaTeX, so just make it an example.
2784 (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
2785 (concat caption "\n"
2786 (concat
2787 (mapconcat
2788 (lambda (l) (concat " " l))
2789 (org-split-string rtn "\n")
2790 "\n")
2791 "\n")))
2792 (t
2793 (error "Don't know how to markup source or example block in %s"
2794 (upcase backend-name)))))
2795 (setq rtn
2796 (concat
2797 "\n#+BEGIN_" backend-name "\n"
2798 (org-add-props rtn
2799 '(org-protected t org-example t org-native-text t))
2800 "\n#+END_" backend-name "\n"))
2801 (org-add-props rtn nil 'original-indentation indent))))
2802
2803(defun org-export-number-lines (text &optional skip1 skip2 number cont
2804 replace-labels label-format preprocess)
2805 "Apply line numbers to literal examples and handle code references.
2806Handle user-specified options under info node `(org)Literal
2807examples' and return the modified source block.
2808
2809TEXT contains the source or example block.
2810
2811SKIP1 and SKIP2 are the number of lines that are to be skipped at
2812the beginning and end of TEXT. Use these to skip over
2813backend-specific lines pre-pended or appended to the original
2814source block.
2815
2816NUMBER is non-nil if the literal example specifies \"+n\" or
2817\"-n\" switch. If NUMBER is non-nil add line numbers.
2818
2819CONT is non-nil if the literal example specifies \"+n\" switch.
2820If CONT is nil, start numbering this block from 1. Otherwise
2821continue numbering from the last numbered block.
2822
2823REPLACE-LABELS is dual-purpose.
28241. It controls the retention of labels in the exported block.
28252. It specifies in what manner the links (or references) to a
2826 labeled line be formatted.
2827
2828REPLACE-LABELS is the symbol `keep' if the literal example
2829specifies \"-k\" option, is numeric if the literal example
2830specifies \"-r\" option and is nil otherwise.
2831
2832Handle REPLACE-LABELS as below:
2833- If nil, retain labels in the exported block and use
2834 user-provided labels for referencing the labeled lines.
2835- If it is a number, remove labels in the exported block and use
2836 one of line numbers or labels for referencing labeled lines based
2837 on NUMBER option.
2838- If it is a keep, retain labels in the exported block and use
2839 one of line numbers or labels for referencing labeled lines
2840 based on NUMBER option.
2841
2842LABEL-FORMAT is the value of \"-l\" switch associated with
2843literal example. See `org-coderef-label-format'.
2844
2845PREPROCESS is intended for backend-agnostic handling of source
2846block numbering. When non-nil do the following:
2847- do not number the lines
2848- always strip the labels from exported block
2849- do not make the labeled line a target of an incoming link.
2850 Instead mark the labeled line with `org-coderef' property and
2851 store the label in it."
2852 (setq skip1 (or skip1 0) skip2 (or skip2 0))
2853 (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0))
2854 (with-temp-buffer
2855 (insert text)
2856 (goto-char (point-max))
2857 (skip-chars-backward " \t\n\r")
2858 (delete-region (point) (point-max))
2859 (beginning-of-line (- 1 skip2))
2860 (let* ((last (org-current-line))
2861 (n org-export-last-code-line-counter-value)
2862 (nmax (+ n (- last skip1)))
2863 (fmt (format "%%%dd: " (length (number-to-string nmax))))
2864 (fm
2865 (cond
2866 ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
2867 fmt))
2868 ((eq org-export-current-backend 'ascii) fmt)
2869 ((eq org-export-current-backend 'latex) fmt)
2870 ((eq org-export-current-backend 'docbook) fmt)
2871 (t "")))
2872 (label-format (or label-format org-coderef-label-format))
2873 (label-pre (if (string-match "%s" label-format)
2874 (substring label-format 0 (match-beginning 0))
2875 label-format))
2876 (label-post (if (string-match "%s" label-format)
2877 (substring label-format (match-end 0))
2878 ""))
2879 (lbl-re
2880 (concat
2881 ".*?\\S-.*?\\([ \t]*\\("
2882 (regexp-quote label-pre)
2883 "\\([-a-zA-Z0-9_ ]+\\)"
2884 (regexp-quote label-post)
2885 "\\)\\)"))
2886 ref)
2887
2888 (org-goto-line (1+ skip1))
2889 (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax))
2890 (when number (incf n))
2891 (if (or preprocess (not number))
2892 (forward-char 1)
2893 (insert (format fm n)))
2894 (when (looking-at lbl-re)
2895 (setq ref (match-string 3))
2896 (cond ((numberp replace-labels)
2897 ;; remove labels; use numbers for references when lines
2898 ;; are numbered, use labels otherwise
2899 (delete-region (match-beginning 1) (match-end 1))
2900 (push (cons ref (if (> n 0) n ref)) org-export-code-refs))
2901 ((eq replace-labels 'keep)
2902 ;; don't remove labels; use numbers for references when
2903 ;; lines are numbered, use labels otherwise
2904 (goto-char (match-beginning 2))
2905 (delete-region (match-beginning 2) (match-end 2))
2906 (unless preprocess
2907 (insert "(" ref ")"))
2908 (push (cons ref (if (> n 0) n (concat "(" ref ")")))
2909 org-export-code-refs))
2910 (t
2911 ;; don't remove labels and don't use numbers for
2912 ;; references
2913 (goto-char (match-beginning 2))
2914 (delete-region (match-beginning 2) (match-end 2))
2915 (unless preprocess
2916 (insert "(" ref ")"))
2917 (push (cons ref (concat "(" ref ")")) org-export-code-refs)))
2918 (when (and (eq org-export-current-backend 'html) (not preprocess))
2919 (save-excursion
2920 (beginning-of-line 1)
2921 (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">"
2922 ref))
2923 (end-of-line 1)
2924 (insert "</span>")))
2925 (when preprocess
2926 (add-text-properties
2927 (point-at-bol) (point-at-eol) (list 'org-coderef ref)))))
2928 (setq org-export-last-code-line-counter-value n)
2929 (goto-char (point-max))
2930 (newline)
2931 (buffer-string))))
2932
2933(defun org-search-todo-below (line lines level)
2934 "Search the subtree below LINE for any TODO entries."
2935 (let ((rest (cdr (memq line lines)))
2936 (re org-todo-line-regexp)
2937 line lv todo)
2938 (catch 'exit
2939 (while (setq line (pop rest))
2940 (if (string-match re line)
2941 (progn
2942 (setq lv (- (match-end 1) (match-beginning 1))
2943 todo (and (match-beginning 2)
2944 (not (member (match-string 2 line)
2945 org-done-keywords))))
2946 ; TODO, not DONE
2947 (if (<= lv level) (throw 'exit nil))
2948 (if todo (throw 'exit t))))))))
2949
2950;;;###autoload
2951(defun org-export-visible (type arg)
2952 "Create a copy of the visible part of the current buffer, and export it.
2953The copy is created in a temporary buffer and removed after use.
2954TYPE is the final key (as a string) that also selects the export command in
2955the \\<org-mode-map>\\[org-export] export dispatcher.
2956As a special case, if the you type SPC at the prompt, the temporary
2957org-mode file will not be removed but presented to you so that you can
2958continue to use it. The prefix arg ARG is passed through to the exporting
2959command."
2960 (interactive
2961 (list (progn
2962 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer")
2963 (read-char-exclusive))
2964 current-prefix-arg))
2965 (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R)))
2966 (error "Invalid export key"))
2967 (let* ((binding (cdr (assoc type
2968 '(
2969 (?a . org-export-as-ascii)
2970 (?A . org-export-as-ascii-to-buffer)
2971 (?n . org-export-as-latin1)
2972 (?N . org-export-as-latin1-to-buffer)
2973 (?u . org-export-as-utf8)
2974 (?U . org-export-as-utf8-to-buffer)
2975 (?\C-a . org-export-as-ascii)
2976 (?b . org-export-as-html-and-open)
2977 (?\C-b . org-export-as-html-and-open)
2978 (?h . org-export-as-html)
2979 (?H . org-export-as-html-to-buffer)
2980 (?R . org-export-region-as-html)
2981 (?D . org-export-as-docbook)
2982
2983 (?l . org-export-as-latex)
2984 (?p . org-export-as-pdf)
2985 (?d . org-export-as-pdf-and-open)
2986 (?L . org-export-as-latex-to-buffer)
2987
2988 (?x . org-export-as-xoxo)))))
2989 (keepp (equal type ?\ ))
2990 (file buffer-file-name)
2991 (buffer (get-buffer-create "*Org Export Visible*"))
2992 s e)
2993 ;; Need to hack the drawers here.
2994 (save-excursion
2995 (goto-char (point-min))
2996 (while (re-search-forward org-drawer-regexp nil t)
2997 (goto-char (match-beginning 1))
2998 (or (outline-invisible-p) (org-flag-drawer nil))))
2999 (with-current-buffer buffer (erase-buffer))
3000 (save-excursion
3001 (setq s (goto-char (point-min)))
3002 (while (not (= (point) (point-max)))
3003 (goto-char (org-find-invisible))
3004 (append-to-buffer buffer s (point))
3005 (setq s (goto-char (org-find-visible))))
3006 (org-cycle-hide-drawers 'all)
3007 (goto-char (point-min))
3008 (unless keepp
3009 ;; Copy all comment lines to the end, to make sure #+ settings are
3010 ;; still available for the second export step. Kind of a hack, but
3011 ;; does do the trick.
3012 (if (looking-at "#[^\r\n]*")
3013 (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
3014 (when (re-search-forward "^\\*+[ \t]+" nil t)
3015 (while (re-search-backward "[\n\r]#[^\n\r]*" nil t)
3016 (append-to-buffer buffer (1+ (match-beginning 0))
3017 (min (point-max) (1+ (match-end 0)))))))
3018 (set-buffer buffer)
3019 (let ((buffer-file-name file)
3020 (org-inhibit-startup t))
3021 (org-mode)
3022 (show-all)
3023 (unless keepp (funcall binding arg))))
3024 (if (not keepp)
3025 (kill-buffer buffer)
3026 (switch-to-buffer-other-window buffer)
3027 (goto-char (point-min)))))
3028
3029(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
3030
3031(defun org-export-string (string fmt &optional dir)
3032 "Export STRING to FMT using existing export facilities.
3033During export STRING is saved to a temporary file whose location
3034could vary. Optional argument DIR can be used to force the
3035directory in which the temporary file is created during export
3036which can be useful for resolving relative paths. Dir defaults
3037to the value of `temporary-file-directory'."
3038 (let ((temporary-file-directory (or dir temporary-file-directory))
3039 (tmp-file (make-temp-file "org-")))
3040 (unwind-protect
3041 (with-temp-buffer
3042 (insert string)
3043 (write-file tmp-file)
3044 (org-load-modules-maybe)
3045 (unless org-local-vars
3046 (setq org-local-vars (org-get-local-variables)))
3047 (eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode'
3048 (list 'let org-local-vars
3049 (list (intern (format "org-export-as-%s" fmt))
3050 nil nil ''string t dir))))
3051 (delete-file tmp-file))))
3052
3053;;;###autoload
3054(defun org-export-as-org (arg &optional ext-plist to-buffer body-only pub-dir)
3055 "Make a copy with not-exporting stuff removed.
3056The purpose of this function is to provide a way to export the source
3057Org file of a webpage in Org format, but with sensitive and/or irrelevant
3058stuff removed. This command will remove the following:
3059
3060- archived trees (if the variable `org-export-with-archived-trees' is nil)
3061- comment blocks and trees starting with the COMMENT keyword
3062- only trees that are consistent with `org-export-select-tags'
3063 and `org-export-exclude-tags'.
3064
3065The only arguments that will be used are EXT-PLIST and PUB-DIR,
3066all the others will be ignored (but are present so that the general
3067mechanism to call publishing functions will work).
3068
3069EXT-PLIST is a property list with external parameters overriding
3070org-mode's default settings, but still inferior to file-local
3071settings. When PUB-DIR is set, use this as the publishing
3072directory."
3073 (interactive "P")
3074 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
3075 ext-plist
3076 (org-infile-export-plist)))
3077 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
3078 (filename (concat (file-name-as-directory
3079 (or pub-dir
3080 (org-export-directory :org opt-plist)))
3081 (file-name-sans-extension
3082 (file-name-nondirectory bfname))
3083 ".org"))
3084 (filename (and filename
3085 (if (equal (file-truename filename)
3086 (file-truename bfname))
3087 (concat (file-name-sans-extension filename)
3088 "-source."
3089 (file-name-extension filename))
3090 filename)))
3091 (backup-inhibited t)
3092 (buffer (find-file-noselect filename))
3093 (region (buffer-string))
3094 str-ret)
3095 (save-excursion
3096 (org-pop-to-buffer-same-window buffer)
3097 (erase-buffer)
3098 (insert region)
3099 (let ((org-inhibit-startup t)) (org-mode))
3100 (org-install-letbind)
3101
3102 ;; Get rid of archived trees
3103 (org-export-remove-archived-trees (plist-get opt-plist :archived-trees))
3104
3105 ;; Remove comment environment and comment subtrees
3106 (org-export-remove-comment-blocks-and-subtrees)
3107
3108 ;; Get rid of excluded trees
3109 (org-export-handle-export-tags (plist-get opt-plist :select-tags)
3110 (plist-get opt-plist :exclude-tags))
3111
3112 (when (or (plist-get opt-plist :plain-source)
3113 (not (or (plist-get opt-plist :plain-source)
3114 (plist-get opt-plist :htmlized-source))))
3115 ;; Either nothing special is requested (default call)
3116 ;; or the plain source is explicitly requested
3117 ;; so: save it
3118 (save-buffer))
3119 (when (plist-get opt-plist :htmlized-source)
3120 ;; Make the htmlized version
3121 (require 'htmlize)
3122 (require 'org-html)
3123 (font-lock-fontify-buffer)
3124 (let* ((htmlize-output-type 'css)
3125 (newbuf (htmlize-buffer)))
3126 (with-current-buffer newbuf
3127 (when org-export-htmlized-org-css-url
3128 (goto-char (point-min))
3129 (and (re-search-forward
3130 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*"
3131 nil t)
3132 (replace-match
3133 (format
3134 "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
3135 org-export-htmlized-org-css-url)
3136 t t)))
3137 (write-file (concat filename ".html")))
3138 (kill-buffer newbuf)))
3139 (set-buffer-modified-p nil)
3140 (if (equal to-buffer 'string)
3141 (progn (setq str-ret (buffer-string))
3142 (kill-buffer (current-buffer))
3143 str-ret)
3144 (kill-buffer (current-buffer))))))
3145
3146(defvar org-archive-location) ;; gets loaded with the org-archive require.
3147(defun org-get-current-options ()
3148 "Return a string with current options as keyword options.
3149Does include HTML export options as well as TODO and CATEGORY stuff."
3150 (require 'org-archive)
3151 (format
3152 "#+TITLE: %s
3153#+AUTHOR: %s
3154#+EMAIL: %s
3155#+DATE: %s
3156#+DESCRIPTION:
3157#+KEYWORDS:
3158#+LANGUAGE: %s
3159#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s
3160#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s
3161%s
3162#+EXPORT_SELECT_TAGS: %s
3163#+EXPORT_EXCLUDE_TAGS: %s
3164#+LINK_UP: %s
3165#+LINK_HOME: %s
3166#+XSLT:
3167#+CATEGORY: %s
3168#+SEQ_TODO: %s
3169#+TYP_TODO: %s
3170#+PRIORITIES: %c %c %c
3171#+DRAWERS: %s
3172#+STARTUP: %s %s %s %s %s
3173#+TAGS: %s
3174#+FILETAGS: %s
3175#+ARCHIVE: %s
3176#+LINK: %s
3177"
3178 (buffer-name) (user-full-name) user-mail-address
3179 (format-time-string (substring (car org-time-stamp-formats) 1 -1))
3180 org-export-default-language
3181 org-export-headline-levels
3182 org-export-with-section-numbers
3183 org-export-with-toc
3184 org-export-preserve-breaks
3185 org-export-html-expand
3186 org-export-with-fixed-width
3187 org-export-with-tables
3188 org-export-with-sub-superscripts
3189 org-export-with-special-strings
3190 org-export-with-footnotes
3191 org-export-with-emphasize
3192 org-export-with-timestamps
3193 org-export-with-TeX-macros
3194 org-export-with-LaTeX-fragments
3195 org-export-skip-text-before-1st-heading
3196 org-export-with-drawers
3197 org-export-with-todo-keywords
3198 org-export-with-priority
3199 org-export-with-tags
3200 (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "")
3201 (mapconcat 'identity org-export-select-tags " ")
3202 (mapconcat 'identity org-export-exclude-tags " ")
3203 org-export-html-link-up
3204 org-export-html-link-home
3205 (or (ignore-errors
3206 (file-name-sans-extension
3207 (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))
3208 "NOFILENAME")
3209 "TODO FEEDBACK VERIFY DONE"
3210 "Me Jason Marie DONE"
3211 org-highest-priority org-lowest-priority org-default-priority
3212 (mapconcat 'identity org-drawers " ")
3213 (cdr (assoc org-startup-folded
3214 '((nil . "showall") (t . "overview") (content . "content"))))
3215 (if org-odd-levels-only "odd" "oddeven")
3216 (if org-hide-leading-stars "hidestars" "showstars")
3217 (if org-startup-align-all-tables "align" "noalign")
3218 (cond ((eq org-log-done t) "logdone")
3219 ((equal org-log-done 'note) "lognotedone")
3220 ((not org-log-done) "nologdone"))
3221 (or (mapconcat (lambda (x)
3222 (cond
3223 ((equal :startgroup (car x)) "{")
3224 ((equal :endgroup (car x)) "}")
3225 ((equal :newline (car x)) "")
3226 ((cdr x) (format "%s(%c)" (car x) (cdr x)))
3227 (t (car x))))
3228 (or org-tag-alist (org-get-buffer-tags)) " ") "")
3229 (mapconcat 'identity org-file-tags " ")
3230 org-archive-location
3231 "org file:~/org/%s.org"))
3232
3233(defun org-insert-export-options-template ()
3234 "Insert into the buffer a template with information for exporting."
3235 (interactive)
3236 (if (not (bolp)) (newline))
3237 (let ((s (org-get-current-options)))
3238 (and (string-match "#\\+CATEGORY" s)
3239 (setq s (substring s 0 (match-beginning 0))))
3240 (insert s)))
3241
3242(defvar org-table-colgroup-info nil)
3243
3244(defun org-table-clean-before-export (lines &optional maybe-quoted)
3245 "Check if the table has a marking column.
3246If yes remove the column and the special lines."
3247 (setq org-table-colgroup-info nil)
3248 (if (memq nil
3249 (mapcar
3250 (lambda (x) (or (string-match "^[ \t]*|-" x)
3251 (string-match
3252 (if maybe-quoted
3253 "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|"
3254 "^[ \t]*| *\\([\#!$*_^ /]\\) *|")
3255 x)))
3256 lines))
3257 ;; No special marking column
3258 (progn
3259 (setq org-table-clean-did-remove-column nil)
3260 (delq nil
3261 (mapcar
3262 (lambda (x)
3263 (cond
3264 ((org-table-colgroup-line-p x)
3265 ;; This line contains colgroup info, extract it
3266 ;; and then discard the line
3267 (setq org-table-colgroup-info
3268 (mapcar (lambda (x)
3269 (cond ((member x '("<" "&lt;")) :start)
3270 ((member x '(">" "&gt;")) :end)
3271 ((member x '("<>" "&lt;&gt;")) :startend)))
3272 (org-split-string x "[ \t]*|[ \t]*")))
3273 nil)
3274 ((org-table-cookie-line-p x)
3275 ;; This line contains formatting cookies, discard it
3276 nil)
3277 (t x)))
3278 lines)))
3279 ;; there is a special marking column
3280 (setq org-table-clean-did-remove-column t)
3281 (delq nil
3282 (mapcar
3283 (lambda (x)
3284 (cond
3285 ((org-table-colgroup-line-p x)
3286 ;; This line contains colgroup info, extract it
3287 ;; and then discard the line
3288 (setq org-table-colgroup-info
3289 (mapcar (lambda (x)
3290 (cond ((member x '("<" "&lt;")) :start)
3291 ((member x '(">" "&gt;")) :end)
3292 ((member x '("<>" "&lt;&gt;")) :startend)))
3293 (cdr (org-split-string x "[ \t]*|[ \t]*"))))
3294 nil)
3295 ((org-table-cookie-line-p x)
3296 ;; This line contains formatting cookies, discard it
3297 nil)
3298 ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x)
3299 ;; ignore this line
3300 nil)
3301 ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
3302 (string-match "^\\([ \t]*\\)|[^|]*|" x))
3303 ;; remove the first column
3304 (replace-match "\\1|" t nil x))))
3305 lines))))
3306
3307(defun org-export-cleanup-toc-line (s)
3308 "Remove tags and timestamps from lines going into the toc."
3309 (if (not s)
3310 "" ; Return a string when argument is nil
3311 (when (memq org-export-with-tags '(not-in-toc nil))
3312 (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
3313 (setq s (replace-match "" t t s))))
3314 (when org-export-remove-timestamps-from-toc
3315 (while (string-match org-maybe-keyword-time-regexp s)
3316 (setq s (replace-match "" t t s))))
3317 (while (string-match org-bracket-link-regexp s)
3318 (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
3319 t t s)))
3320 (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
3321 (setq s (replace-match "" t t s)))
3322 s))
3323
3324
3325(defun org-get-text-property-any (pos prop &optional object)
3326 (or (get-text-property pos prop object)
3327 (and (setq pos (next-single-property-change pos prop object))
3328 (get-text-property pos prop object))))
3329
3330(defun org-export-get-coderef-format (path desc)
3331 (save-match-data
3332 (if (and desc (string-match
3333 (regexp-quote (concat "(" path ")"))
3334 desc))
3335 (replace-match "%s" t t desc)
3336 (or desc "%s"))))
3337
3338(defun org-export-push-to-kill-ring (format)
3339 "Push buffer content to kill ring.
3340The depends on the variable `org-export-copy-to-kill-ring'."
3341 (when org-export-copy-to-kill-ring
3342 (org-kill-new (buffer-string))
3343 (when (fboundp 'x-set-selection)
3344 (ignore-errors (x-set-selection 'PRIMARY (buffer-string)))
3345 (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string))))
3346 (message "%s export done, pushed to kill ring and clipboard" format)))
3347
3348(provide 'org-exp)
3349
3350;; Local variables:
3351;; generated-autoload-file: "org-loaddefs.el"
3352;; End:
3353
3354;;; org-exp.el ends here
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el
deleted file mode 100644
index 2ee58501ca1..00000000000
--- a/lisp/org/org-freemind.el
+++ /dev/null
@@ -1,1227 +0,0 @@
1;;; org-freemind.el --- Export Org files to freemind
2
3;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
4
5;; Author: Lennart Borgman (lennart O borgman A gmail O com)
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;; --------------------------------------------------------------------
25;; Features that might be required by this library:
26;;
27;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
28;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
29;; `org-list', `org-macs', `org-src', `outline', `syntax',
30;; `time-date', `xml'.
31;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33;;
34;;; Commentary:
35;;
36;; This file tries to implement some functions useful for
37;; transformation between org-mode and FreeMind files.
38;;
39;; Here are the commands you can use:
40;;
41;; M-x `org-freemind-from-org-mode'
42;; M-x `org-freemind-from-org-mode-node'
43;; M-x `org-freemind-from-org-sparse-tree'
44;;
45;; M-x `org-freemind-to-org-mode'
46;;
47;; M-x `org-freemind-show'
48;;
49;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50;;
51;;; Change log:
52;;
53;; 2009-02-15: Added check for next level=current+1
54;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
55;; 2009-10-25: Added support for `org-odd-levels-only'.
56;; Added y/n question before showing in FreeMind.
57;; 2009-11-04: Added support for #+BEGIN_HTML.
58;;
59;;; Code:
60
61(require 'xml)
62(require 'org)
63 ;(require 'rx)
64(require 'org-exp)
65(eval-when-compile (require 'cl))
66
67(defgroup org-freemind nil
68 "Customization group for org-freemind export/import."
69 :group 'org)
70
71;; Fix-me: I am not sure these are useful:
72;;
73;; (defcustom org-freemind-main-fgcolor "black"
74;; "Color of main node's text."
75;; :type 'color
76;; :group 'org-freemind)
77
78;; (defcustom org-freemind-main-color "black"
79;; "Background color of main node."
80;; :type 'color
81;; :group 'org-freemind)
82
83;; (defcustom org-freemind-child-fgcolor "black"
84;; "Color of child nodes' text."
85;; :type 'color
86;; :group 'org-freemind)
87
88;; (defcustom org-freemind-child-color "black"
89;; "Background color of child nodes."
90;; :type 'color
91;; :group 'org-freemind)
92
93(defvar org-freemind-node-style nil "Internal use.")
94
95(defcustom org-freemind-node-styles nil
96 "Styles to apply to node.
97NOT READY YET."
98 :type '(repeat
99 (list :tag "Node styles for file"
100 (regexp :tag "File name")
101 (repeat
102 (list :tag "Node"
103 (regexp :tag "Node name regexp")
104 (set :tag "Node properties"
105 (list :format "%v" (const :format "" node-style)
106 (choice :tag "Style"
107 :value bubble
108 (const bubble)
109 (const fork)))
110 (list :format "%v" (const :format "" color)
111 (color :tag "Color" :value "red"))
112 (list :format "%v" (const :format "" background-color)
113 (color :tag "Background color" :value "yellow"))
114 (list :format "%v" (const :format "" edge-color)
115 (color :tag "Edge color" :value "green"))
116 (list :format "%v" (const :format "" edge-style)
117 (choice :tag "Edge style" :value bezier
118 (const :tag "Linear" linear)
119 (const :tag "Bezier" bezier)
120 (const :tag "Sharp Linear" sharp-linear)
121 (const :tag "Sharp Bezier" sharp-bezier)))
122 (list :format "%v" (const :format "" edge-width)
123 (choice :tag "Edge width" :value thin
124 (const :tag "Parent" parent)
125 (const :tag "Thin" thin)
126 (const 1)
127 (const 2)
128 (const 4)
129 (const 8)))
130 (list :format "%v" (const :format "" italic)
131 (const :tag "Italic font" t))
132 (list :format "%v" (const :format "" bold)
133 (const :tag "Bold font" t))
134 (list :format "%v" (const :format "" font-name)
135 (string :tag "Font name" :value "SansSerif"))
136 (list :format "%v" (const :format "" font-size)
137 (integer :tag "Font size" :value 12)))))))
138 :group 'org-freemind)
139
140;;;###autoload
141(defun org-export-as-freemind (&optional hidden ext-plist
142 to-buffer body-only pub-dir)
143 "Export the current buffer as a Freemind file.
144If there is an active region, export only the region. HIDDEN is
145obsolete and does nothing. EXT-PLIST is a property list with
146external parameters overriding org-mode's default settings, but
147still inferior to file-local settings. When TO-BUFFER is
148non-nil, create a buffer with that name and export to that
149buffer. If TO-BUFFER is the symbol `string', don't leave any
150buffer behind but just return the resulting HTML as a string.
151When BODY-ONLY is set, don't produce the file header and footer,
152simply return the content of the document (all top level
153sections). When PUB-DIR is set, use this as the publishing
154directory.
155
156See `org-freemind-from-org-mode' for more information."
157 (interactive "P")
158 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
159 ext-plist
160 (org-infile-export-plist)))
161 (region-p (org-region-active-p))
162 (rbeg (and region-p (region-beginning)))
163 (rend (and region-p (region-end)))
164 (subtree-p
165 (if (plist-get opt-plist :ignore-subtree-p)
166 nil
167 (when region-p
168 (save-excursion
169 (goto-char rbeg)
170 (and (org-at-heading-p)
171 (>= (org-end-of-subtree t t) rend))))))
172 (opt-plist (setq org-export-opt-plist
173 (if subtree-p
174 (org-export-add-subtree-options opt-plist rbeg)
175 opt-plist)))
176 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
177 (filename (concat (file-name-as-directory
178 (or pub-dir
179 (org-export-directory :ascii opt-plist)))
180 (file-name-sans-extension
181 (or (and subtree-p
182 (org-entry-get (region-beginning)
183 "EXPORT_FILE_NAME" t))
184 (file-name-nondirectory bfname)))
185 ".mm")))
186 (when (file-exists-p filename)
187 (delete-file filename))
188 (cond
189 (subtree-p
190 (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
191 filename))
192 (t (org-freemind-from-org-mode bfname filename)))))
193
194;;;###autoload
195(defun org-freemind-show (mm-file)
196 "Show file MM-FILE in Freemind."
197 (interactive
198 (list
199 (save-match-data
200 (let ((name (read-file-name "FreeMind file: "
201 nil nil nil
202 (if (buffer-file-name)
203 (let* ((name-ext (file-name-nondirectory (buffer-file-name)))
204 (name (file-name-sans-extension name-ext))
205 (ext (file-name-extension name-ext)))
206 (cond
207 ((string= "mm" ext)
208 name-ext)
209 ((string= "org" ext)
210 (let ((name-mm (concat name ".mm")))
211 (if (file-exists-p name-mm)
212 name-mm
213 (message "Not exported to Freemind format yet")
214 "")))
215 (t
216 "")))
217 "")
218 ;; Fix-me: Is this an Emacs bug?
219 ;; This predicate function is never
220 ;; called.
221 (lambda (fn)
222 (string-match "^mm$" (file-name-extension fn))))))
223 (setq name (expand-file-name name))
224 name))))
225 (org-open-file mm-file))
226
227(defconst org-freemind-org-nfix "--org-mode: ")
228
229;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230;;; Format converters
231
232(defun org-freemind-escape-str-from-org (org-str)
233 "Do some html-escaping of ORG-STR and return the result.
234The characters \"&<> will be escaped."
235 (let ((chars (append org-str nil))
236 (fm-str ""))
237 (dolist (cc chars)
238 (setq fm-str
239 (concat fm-str
240 (if (< cc 160)
241 (cond
242 ((= cc ?\") "&quot;")
243 ((= cc ?\&) "&amp;")
244 ((= cc ?\<) "&lt;")
245 ((= cc ?\>) "&gt;")
246 (t (char-to-string cc)))
247 ;; Formatting as &#number; is maybe needed
248 ;; according to a bug report from kazuo
249 ;; fujimoto, but I have now instead added a xml
250 ;; processing instruction saying that the mm
251 ;; file is utf-8:
252 ;;
253 ;; (format "&#x%x;" (- cc ;; ?\x800))
254 (format "&#x%x;" (encode-char cc 'ucs))
255 ))))
256 fm-str))
257
258;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
259;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
260(defun org-freemind-unescape-str-to-org (fm-str)
261 "Do some html-unescaping of FM-STR and return the result.
262This is the opposite of `org-freemind-escape-str-from-org' but it
263will also unescape &#nn;."
264 (let ((org-str fm-str))
265 (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
266 (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
267 (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
268 (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
269 (setq org-str (replace-regexp-in-string
270 "&#x\\([a-f0-9]\\{2,4\\}\\);"
271 (lambda (m)
272 (char-to-string
273 (+ (string-to-number (match-string 1 m) 16)
274 0 ;?\x800 ;; What is this for? Encoding?
275 )))
276 org-str))))
277
278;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
279;; (str2 (org-freemind-escape-str-from-org str1))
280;; (str3 (org-freemind-unescape-str-to-org str2)))
281;; (unless (string= str1 str3)
282;; (error "Error str3=%s" str3)))
283
284(defun org-freemind-convert-links-helper (matched)
285 "Helper for `org-freemind-convert-links-from-org'.
286MATCHED is the link just matched."
287 (let* ((link (match-string 1 matched))
288 (text (match-string 2 matched))
289 (ext (file-name-extension link))
290 (col-pos (org-string-match-p ":" link))
291 (is-img (and (image-type-from-file-name link)
292 (let ((url-type (substring link 0 col-pos)))
293 (member url-type '("file" "http" "https")))))
294 )
295 (if is-img
296 ;; Fix-me: I can't find a way to get the border to "shrink
297 ;; wrap" around the image using <div>.
298 ;;
299 ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
300 ;; "<img src=\"" link "\" alt=\"" text "\" />"
301 ;; "<br />"
302 ;; "<i>" text "</i>"
303 ;; "</div>")
304 (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
305 "<img src=\"" link "\" alt=\"" text "\" />"
306 "<br />"
307 "<i>" text "</i>"
308 "</td></tr></table>")
309 (concat "<a href=\"" link "\">" text "</a>"))))
310
311(defun org-freemind-convert-links-from-org (org-str)
312 "Convert org links in ORG-STR to freemind links and return the result."
313 (let ((fm-str (replace-regexp-in-string
314 ;;(rx (not (any "[\""))
315 ;; (submatch
316 ;; "http"
317 ;; (opt ?\s)
318 ;; "://"
319 ;; (1+
320 ;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
321 "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
322 "[[\\1][\\1]]"
323 org-str
324 nil ;; fixedcase
325 nil ;; literal
326 1 ;; subexp
327 )))
328 (replace-regexp-in-string
329 ;;(rx "[["
330 ;; (submatch (*? nonl))
331 ;; "]["
332 ;; (submatch (*? nonl))
333 ;; "]]")
334 "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
335 ;;"<a href=\"\\1\">\\2</a>"
336 'org-freemind-convert-links-helper
337 fm-str t t)))
338
339;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
340(defun org-freemind-convert-links-to-org (fm-str)
341 "Convert freemind links in FM-STR to org links and return the result."
342 (let ((org-str (replace-regexp-in-string
343 ;;(rx "<a"
344 ;; space
345 ;; (0+
346 ;; (0+ (not (any ">")))
347 ;; space)
348 ;; "href=\""
349 ;; (submatch (0+ (not (any "\""))))
350 ;; "\""
351 ;; (0+ (not (any ">")))
352 ;; ">"
353 ;; (submatch (0+ (not (any "<"))))
354 ;; "</a>")
355 "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
356 "[[\\1][\\2]]"
357 fm-str)))
358 org-str))
359
360;; Fix-me:
361;;(defun org-freemind-convert-drawers-from-org (text)
362;; )
363
364;; (let* ((str1 "[[http://www.somewhere/][link-text]")
365;; (str2 (org-freemind-convert-links-from-org str1))
366;; (str3 (org-freemind-convert-links-to-org str2)))
367;; (unless (string= str1 str3)
368;; (error "Error str3=%s" str3)))
369
370;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
371;;; Org => FreeMind
372
373(defvar org-freemind-bol-helper-base-indent nil)
374
375(defun org-freemind-bol-helper (matched)
376 "Helper for `org-freemind-convert-text-p'.
377MATCHED is the link just matched."
378 (let ((res "")
379 (bi org-freemind-bol-helper-base-indent))
380 (dolist (cc (append matched nil))
381 (if (= 32 cc)
382 ;;(setq res (concat res "&nbsp;"))
383 ;; We need to use the numerical version. Otherwise Freemind
384 ;; ver 0.9.0 RC9 can not export to html/javascript.
385 (progn
386 (if (< 0 bi)
387 (setq bi (1- bi))
388 (setq res (concat res "&#160;"))))
389 (setq res (concat res (char-to-string cc)))))
390 res))
391;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
392
393(defun org-freemind-convert-text-p (text)
394 "Convert TEXT to html with <p> paragraphs."
395 ;; (string-match-p "[^ ]" " a")
396 (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
397 (setq text (org-freemind-escape-str-from-org text))
398
399 (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
400 (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text))
401
402 (setq text (concat "<p>" text))
403 (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text))
404 (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text))
405 (setq text (replace-regexp-in-string "\n" "<br />" text))
406 (setq text (concat text "</p>"))
407
408 (org-freemind-convert-links-from-org text))
409
410(defcustom org-freemind-node-css-style
411 "p { margin-top: 3px; margin-bottom: 3px; }"
412 "CSS style for Freemind nodes."
413 ;; Fix-me: I do not understand this. It worked to export from Freemind
414 ;; with this setting now, but not before??? Was this perhaps a java
415 ;; bug or is it a windows xp bug (some resource gets exhausted if you
416 ;; use sticky keys which I do).
417 :version "24.1"
418 :group 'org-freemind)
419
420(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
421 "Convert text part of org node to freemind subnode or note.
422Convert the text part of the org node named NODE-NAME. The text
423is in the current buffer between START and END. Drawers matching
424DRAWERS-REGEXP are converted to freemind notes."
425 ;; fix-me: doc
426 (let ((text (buffer-substring-no-properties start end))
427 (node-res "")
428 (note-res ""))
429 (save-match-data
430 ;;(setq text (org-freemind-escape-str-from-org text))
431 ;; First see if there is something that should be moved to the
432 ;; note part:
433 (let (drawers)
434 (while (string-match drawers-regexp text)
435 (setq drawers (cons (match-string 0 text) drawers))
436 (setq text
437 (concat (substring text 0 (match-beginning 0))
438 (substring text (match-end 0))))
439 )
440 (when drawers
441 (dolist (drawer drawers)
442 (let ((lines (split-string drawer "\n")))
443 (dolist (line lines)
444 (setq note-res (concat
445 note-res
446 org-freemind-org-nfix line "<br />\n")))
447 ))))
448
449 (when (> (length note-res) 0)
450 (setq note-res (concat
451 "<richcontent TYPE=\"NOTE\"><html>\n"
452 "<head>\n"
453 "</head>\n"
454 "<body>\n"
455 note-res
456 "</body>\n"
457 "</html>\n"
458 "</richcontent>\n")))
459
460 ;; There is always an LF char:
461 (when (> (length text) 1)
462 (setq node-res (concat
463 "<node style=\"bubble\" background_color=\"#eeee00\">\n"
464 "<richcontent TYPE=\"NODE\"><html>\n"
465 "<head>\n"
466 (if (= 0 (length org-freemind-node-css-style))
467 ""
468 (concat
469 "<style type=\"text/css\">\n"
470 "<!--\n"
471 org-freemind-node-css-style
472 "-->\n"
473 "</style>\n"))
474 "</head>\n"
475 "<body>\n"))
476 (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
477 (end-html-mark (regexp-quote "#+END_HTML"))
478 head
479 end-pos
480 end-pos-match
481 )
482 ;; Take care of #+BEGIN_HTML - #+END_HTML
483 (while (string-match begin-html-mark text)
484 (setq head (substring text 0 (match-beginning 0)))
485 (setq end-pos-match (match-end 0))
486 (setq node-res (concat node-res
487 (org-freemind-convert-text-p head)))
488 (setq text (substring text end-pos-match))
489 (setq end-pos (string-match end-html-mark text))
490 (if end-pos
491 (setq end-pos-match (match-end 0))
492 (message "org-freemind: Missing #+END_HTML")
493 (setq end-pos (length text))
494 (setq end-pos-match end-pos))
495 (setq node-res (concat node-res
496 (substring text 0 end-pos)))
497 (setq text (substring text end-pos-match)))
498 (setq node-res (concat node-res
499 (org-freemind-convert-text-p text))))
500 (setq node-res (concat
501 node-res
502 "</body>\n"
503 "</html>\n"
504 "</richcontent>\n"
505 ;; Put a note that this is for the parent node
506 ;; "<richcontent TYPE=\"NOTE\"><html>"
507 ;; "<head>"
508 ;; "</head>"
509 ;; "<body>"
510 ;; "<p>"
511 ;; "-- This is more about \"" node-name "\" --"
512 ;; "</p>"
513 ;; "</body>"
514 ;; "</html>"
515 ;; "</richcontent>\n"
516 note-res
517 "</node>\n" ;; ok
518 )))
519 (list node-res note-res))))
520
521(defun org-freemind-write-node (mm-buffer drawers-regexp
522 num-left-nodes base-level
523 current-level next-level this-m2
524 this-node-end
525 this-children-visible
526 next-node-start
527 next-has-some-visible-child)
528 (let* (this-icons
529 this-bg-color
530 this-m2-link
531 this-m2-escaped
532 this-rich-node
533 this-rich-note
534 )
535 (when (string-match "TODO" this-m2)
536 (setq this-m2 (replace-match "" nil nil this-m2))
537 (add-to-list 'this-icons "button_cancel")
538 (setq this-bg-color "#ffff88")
539 (when (string-match "\\[#\\(.\\)\\]" this-m2)
540 (let ((prior (string-to-char (match-string 1 this-m2))))
541 (setq this-m2 (replace-match "" nil nil this-m2))
542 (cond
543 ((= prior ?A)
544 (add-to-list 'this-icons "full-1")
545 (setq this-bg-color "#ff0000"))
546 ((= prior ?B)
547 (add-to-list 'this-icons "full-2")
548 (setq this-bg-color "#ffaa00"))
549 ((= prior ?C)
550 (add-to-list 'this-icons "full-3")
551 (setq this-bg-color "#ffdd00"))
552 ((= prior ?D)
553 (add-to-list 'this-icons "full-4")
554 (setq this-bg-color "#ffff00"))
555 ((= prior ?E)
556 (add-to-list 'this-icons "full-5"))
557 ((= prior ?F)
558 (add-to-list 'this-icons "full-6"))
559 ((= prior ?G)
560 (add-to-list 'this-icons "full-7"))
561 ))))
562 (setq this-m2 (org-trim this-m2))
563 (when (string-match org-bracket-link-analytic-regexp this-m2)
564 (setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
565 (match-string 3 this-m2) "\" ")
566 this-m2 (replace-match "\\5" nil nil this-m2 0)))
567 (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
568 (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
569 this-m2-escaped
570 this-node-end
571 (1- next-node-start)
572 drawers-regexp)))
573 (setq this-rich-node (nth 0 node-notes))
574 (setq this-rich-note (nth 1 node-notes)))
575 (with-current-buffer mm-buffer
576 (insert "<node " (if this-m2-link this-m2-link "")
577 "text=\"" this-m2-escaped "\"")
578 (org-freemind-get-node-style this-m2)
579 (when (> next-level current-level)
580 (unless (or this-children-visible
581 next-has-some-visible-child)
582 (insert " folded=\"true\"")))
583 (when (and (= current-level (1+ base-level))
584 (> num-left-nodes 0))
585 (setq num-left-nodes (1- num-left-nodes))
586 (insert " position=\"left\""))
587 (when this-bg-color
588 (insert " background_color=\"" this-bg-color "\""))
589 (insert ">\n")
590 (when this-icons
591 (dolist (icon this-icons)
592 (insert "<icon builtin=\"" icon "\"/>\n")))
593 )
594 (with-current-buffer mm-buffer
595 ;;(when this-rich-note (insert this-rich-note))
596 (when this-rich-node (insert this-rich-node))))
597 num-left-nodes)
598
599(defun org-freemind-check-overwrite (file interactively)
600 "Check if file FILE already exists.
601If FILE does not exist return t.
602
603If INTERACTIVELY is non-nil ask if the file should be replaced
604and return t/nil if it should/should not be replaced.
605
606Otherwise give an error say the file exists."
607 (if (file-exists-p file)
608 (if interactively
609 (y-or-n-p (format "File %s exists, replace it? " file))
610 (error "File %s already exists" file))
611 t))
612
613(defvar org-freemind-node-pattern
614 ;;(rx bol
615 ;; (submatch (1+ "*"))
616 ;; (1+ space)
617 ;; (submatch (*? nonl))
618 ;; eol)
619 "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
620
621(defun org-freemind-look-for-visible-child (node-level)
622 (save-excursion
623 (save-match-data
624 (let ((found-visible-child nil))
625 (while (and (not found-visible-child)
626 (re-search-forward org-freemind-node-pattern nil t))
627 (let* ((m1 (match-string-no-properties 1))
628 (level (length m1)))
629 (if (>= node-level level)
630 (setq found-visible-child 'none)
631 (unless (get-char-property (line-beginning-position) 'invisible)
632 (setq found-visible-child 'found)))))
633 (eq found-visible-child 'found)
634 ))))
635
636(defun org-freemind-goto-line (line)
637 "Go to line number LINE."
638 (save-restriction
639 (widen)
640 (goto-char (point-min))
641 (forward-line (1- line))))
642
643(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
644 (with-current-buffer org-buffer
645 (dolist (node-style org-freemind-node-styles)
646 (when (org-string-match-p (car node-style) buffer-file-name)
647 (setq org-freemind-node-style (cadr node-style))))
648 ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
649 (save-match-data
650 (let* ((drawers (copy-sequence org-drawers))
651 drawers-regexp
652 (num-top1-nodes 0)
653 (num-top2-nodes 0)
654 num-left-nodes
655 (unclosed-nodes 0)
656 (odd-only org-odd-levels-only)
657 (first-time t)
658 (current-level 1)
659 base-level
660 prev-node-end
661 rich-text
662 unfinished-tag
663 node-at-line-level
664 node-at-line-last)
665 (with-current-buffer mm-buffer
666 (erase-buffer)
667 (setq buffer-file-coding-system 'utf-8)
668 ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this:
669 ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
670 (insert "<map version=\"0.9.0\">\n")
671 (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
672 (save-excursion
673 ;; Get special buffer vars:
674 (goto-char (point-min))
675 (message "Writing Freemind file...")
676 (while (re-search-forward "^#\\+DRAWERS:" nil t)
677 (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
678 (setq drawers (append drawers (split-string dr-txt) nil))))
679 (setq drawers-regexp
680 (concat "^[[:blank:]]*:"
681 (regexp-opt drawers)
682 ;;(rx ":" (0+ blank)
683 ;; "\n"
684 ;; (*? anything)
685 ;; "\n"
686 ;; (0+ blank)
687 ;; ":END:"
688 ;; (0+ blank)
689 ;; eol)
690 ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
691 ))
692
693 (if node-at-line
694 ;; Get number of top nodes and last line for this node
695 (progn
696 (org-freemind-goto-line node-at-line)
697 (unless (looking-at org-freemind-node-pattern)
698 (error "No node at line %s" node-at-line))
699 (setq node-at-line-level (length (match-string-no-properties 1)))
700 (forward-line)
701 (setq node-at-line-last
702 (catch 'last-line
703 (while (re-search-forward org-freemind-node-pattern nil t)
704 (let* ((m1 (match-string-no-properties 1))
705 (level (length m1)))
706 (if (<= level node-at-line-level)
707 (progn
708 (beginning-of-line)
709 (throw 'last-line (1- (point))))
710 (if (= level (1+ node-at-line-level))
711 (setq num-top2-nodes (1+ num-top2-nodes))))))))
712 (setq current-level node-at-line-level)
713 (setq num-top1-nodes 1)
714 (org-freemind-goto-line node-at-line))
715
716 ;; First get number of top nodes
717 (goto-char (point-min))
718 (while (re-search-forward org-freemind-node-pattern nil t)
719 (let* ((m1 (match-string-no-properties 1))
720 (level (length m1)))
721 (if (= level 1)
722 (setq num-top1-nodes (1+ num-top1-nodes))
723 (if (= level 2)
724 (setq num-top2-nodes (1+ num-top2-nodes))))))
725 ;; If there is more than one top node we need to insert a node
726 ;; to keep them together.
727 (goto-char (point-min))
728 (when (> num-top1-nodes 1)
729 (setq num-top2-nodes num-top1-nodes)
730 (setq current-level 0)
731 (let ((orig-name (if buffer-file-name
732 (file-name-nondirectory (buffer-file-name))
733 (buffer-name))))
734 (with-current-buffer mm-buffer
735 (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n"
736 ;; Put a note that this is for the parent node
737 "<richcontent TYPE=\"NOTE\"><html>"
738 "<head>"
739 "</head>"
740 "<body>"
741 "<p>"
742 org-freemind-org-nfix "WHOLE FILE"
743 "</p>"
744 "</body>"
745 "</html>"
746 "</richcontent>\n")))))
747
748 (setq num-left-nodes (floor num-top2-nodes 2))
749 (setq base-level current-level)
750 (let (this-m2
751 this-node-end
752 this-children-visible
753 next-m2
754 next-node-start
755 next-level
756 next-has-some-visible-child
757 next-children-visible
758 )
759 (while (and
760 (re-search-forward org-freemind-node-pattern nil t)
761 (if node-at-line-last (<= (point) node-at-line-last) t)
762 )
763 (let* ((next-m1 (match-string-no-properties 1))
764 (next-node-end (match-end 0))
765 )
766 (setq next-node-start (match-beginning 0))
767 (setq next-m2 (match-string-no-properties 2))
768 (setq next-level (length next-m1))
769 (setq next-children-visible
770 (not (eq 'outline
771 (get-char-property (line-end-position) 'invisible))))
772 (setq next-has-some-visible-child
773 (if next-children-visible t
774 (org-freemind-look-for-visible-child next-level)))
775 (when this-m2
776 (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)))
777 (when (if (= num-top1-nodes 1) (> current-level base-level) t)
778 (while (>= current-level next-level)
779 (with-current-buffer mm-buffer
780 (insert "</node>\n")
781 (setq current-level
782 (- current-level (if odd-only 2 1))))))
783 (setq this-node-end (1+ next-node-end))
784 (setq this-m2 next-m2)
785 (setq current-level next-level)
786 (setq this-children-visible next-children-visible)
787 (forward-char)
788 ))
789;;; (unless (if node-at-line-last
790;;; (>= (point) node-at-line-last)
791;;; nil)
792 ;; Write last node:
793 (setq this-m2 next-m2)
794 (setq current-level next-level)
795 (setq next-node-start (if node-at-line-last
796 (1+ node-at-line-last)
797 (point-max)))
798 (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
799 (with-current-buffer mm-buffer (insert "</node>\n"))
800 ;)
801 )
802 (with-current-buffer mm-buffer
803 (while (> current-level base-level)
804 (insert "</node>\n")
805 (setq current-level
806 (- current-level (if odd-only 2 1)))
807 ))
808 (with-current-buffer mm-buffer
809 (insert "</map>")
810 (delete-trailing-whitespace)
811 (goto-char (point-min))
812 ))))))
813
814(defun org-freemind-get-node-style (node-name)
815 "NOT READY YET."
816 ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
817 ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
818 (let (node-styles
819 node-style)
820 (dolist (style-list org-freemind-node-style)
821 (let ((node-regexp (car style-list)))
822 (message "node-regexp=%s node-name=%s" node-regexp node-name)
823 (when (org-string-match-p node-regexp node-name)
824 ;;(setq node-style (org-freemind-do-apply-node-style style-list))
825 (setq node-style (cadr style-list))
826 (when node-style
827 (message "node-style=%s" node-style)
828 (setq node-styles (append node-styles node-style)))
829 )))))
830
831(defun org-freemind-do-apply-node-style (style-list)
832 (message "style-list=%S" style-list)
833 (let ((node-style 'fork)
834 (color "red")
835 (background-color "yellow")
836 (edge-color "green")
837 (edge-style 'bezier)
838 (edge-width 'thin)
839 (italic t)
840 (bold t)
841 (font-name "SansSerif")
842 (font-size 12))
843 (dolist (style (cadr style-list))
844 (message " style=%s" style)
845 (let ((what (car style)))
846 (cond
847 ((eq what 'node-style)
848 (setq node-style (cadr style)))
849 ((eq what 'color)
850 (setq color (cadr style)))
851 ((eq what 'background-color)
852 (setq background-color (cadr style)))
853
854 ((eq what 'edge-color)
855 (setq edge-color (cadr style)))
856
857 ((eq what 'edge-style)
858 (setq edge-style (cadr style)))
859
860 ((eq what 'edge-width)
861 (setq edge-width (cadr style)))
862
863 ((eq what 'italic)
864 (setq italic (cadr style)))
865
866 ((eq what 'bold)
867 (setq bold (cadr style)))
868
869 ((eq what 'font-name)
870 (setq font-name (cadr style)))
871
872 ((eq what 'font-size)
873 (setq font-size (cadr style)))
874 )
875 (insert (format " style=\"%s\"" node-style))
876 (insert (format " color=\"%s\"" color))
877 (insert (format " background_color=\"%s\"" background-color))
878 (insert ">\n")
879 (insert "<edge")
880 (insert (format " color=\"%s\"" edge-color))
881 (insert (format " style=\"%s\"" edge-style))
882 (insert (format " width=\"%s\"" edge-width))
883 (insert "/>\n")
884 (insert "<font")
885 (insert (format " italic=\"%s\"" italic))
886 (insert (format " bold=\"%s\"" bold))
887 (insert (format " name=\"%s\"" font-name))
888 (insert (format " size=\"%s\"" font-size))
889 ))))
890
891;;;###autoload
892(defun org-freemind-from-org-mode-node (node-line mm-file)
893 "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
894See `org-freemind-from-org-mode' for more information."
895 (interactive
896 (progn
897 (unless (org-back-to-heading nil)
898 (error "Can't find org-mode node start"))
899 (let* ((line (line-number-at-pos))
900 (default-mm-file (concat (if buffer-file-name
901 (file-name-nondirectory buffer-file-name)
902 "nofile")
903 "-line-" (number-to-string line)
904 ".mm"))
905 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
906 (list line mm-file))))
907 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
908 (let ((org-buffer (current-buffer))
909 (mm-buffer (find-file-noselect mm-file)))
910 (org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
911 (with-current-buffer mm-buffer
912 (basic-save-buffer)
913 (when (org-called-interactively-p 'any)
914 (switch-to-buffer-other-window mm-buffer)
915 (when (y-or-n-p "Show in FreeMind? ")
916 (org-freemind-show buffer-file-name)))))))
917
918;;;###autoload
919(defun org-freemind-from-org-mode (org-file mm-file)
920 "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
921All the nodes will be opened or closed in Freemind just as you
922have them in `org-mode'.
923
924Note that exporting to Freemind also gives you an alternative way
925to export from `org-mode' to html. You can create a dynamic html
926version of the your org file, by first exporting to Freemind and
927then exporting from Freemind to html. The 'As
928XHTML (JavaScript)' version in Freemind works very well \(and you
929can use a CSS stylesheet to style it)."
930 ;; Fix-me: better doc, include recommendations etc.
931 (interactive
932 (let* ((org-file buffer-file-name)
933 (default-mm-file (concat
934 (if org-file
935 (file-name-nondirectory org-file)
936 "nofile")
937 ".mm"))
938 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
939 (list org-file mm-file)))
940 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
941 (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
942 (mm-buffer (find-file-noselect mm-file)))
943 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
944 (with-current-buffer mm-buffer
945 (basic-save-buffer)
946 (when (org-called-interactively-p 'any)
947 (switch-to-buffer-other-window mm-buffer)
948 (when (y-or-n-p "Show in FreeMind? ")
949 (org-freemind-show buffer-file-name)))))))
950
951;;;###autoload
952(defun org-freemind-from-org-sparse-tree (org-buffer mm-file)
953 "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
954 (interactive
955 (let* ((org-file buffer-file-name)
956 (default-mm-file (concat
957 (if org-file
958 (file-name-nondirectory org-file)
959 "nofile")
960 "-sparse.mm"))
961 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
962 (list (current-buffer) mm-file)))
963 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
964 (let (org-buffer
965 (mm-buffer (find-file-noselect mm-file)))
966 (save-window-excursion
967 (org-export-visible ?\ nil)
968 (setq org-buffer (current-buffer)))
969 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
970 (with-current-buffer mm-buffer
971 (basic-save-buffer)
972 (when (org-called-interactively-p 'any)
973 (switch-to-buffer-other-window mm-buffer)
974 (when (y-or-n-p "Show in FreeMind? ")
975 (org-freemind-show buffer-file-name)))))))
976
977
978;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
979;;; FreeMind => Org
980
981;; (sort '(b a c) 'org-freemind-lt-symbols)
982(defun org-freemind-lt-symbols (sym-a sym-b)
983 (string< (symbol-name sym-a) (symbol-name sym-b)))
984;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
985(defun org-freemind-lt-xml-attrs (attr-a attr-b)
986 (string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
987
988;; xml-parse-region gives things like
989;; ((p nil "\n"
990;; (a
991;; ((href . "link"))
992;; "text")
993;; "\n"
994;; (b nil "hej")
995;; "\n"))
996
997;; '(a . nil)
998
999;; (org-freemind-symbols= 'a (car '(A B)))
1000(defsubst org-freemind-symbols= (sym-a sym-b)
1001 "Return t if downcased names of SYM-A and SYM-B are equal.
1002SYM-A and SYM-B should be symbols."
1003 (or (eq sym-a sym-b)
1004 (string= (downcase (symbol-name sym-a))
1005 (downcase (symbol-name sym-b)))))
1006
1007(defun org-freemind-get-children (parent path)
1008 "Find children node to PARENT from PATH.
1009PATH should be a list of steps, where each step has the form
1010
1011 '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
1012 ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
1013 ;; Fix-me: case insensitive version for children?
1014 (let* ((children (if (not (listp (car parent)))
1015 (cddr parent)
1016 (let (cs)
1017 (dolist (p parent)
1018 (dolist (c (cddr p))
1019 (add-to-list 'cs c)))
1020 cs)
1021 ))
1022 (step (car path))
1023 (step-node (if (listp step) (car step) step))
1024 (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
1025 (path-tail (cdr path))
1026 path-children)
1027 (dolist (child children)
1028 ;; skip xml.el formatting nodes
1029 (unless (stringp child)
1030 ;; compare node name
1031 (when (if (not step-node)
1032 t ;; any node name
1033 (org-freemind-symbols= step-node (car child)))
1034 (if (not step-attr-list)
1035 ;;(throw 'path-child child) ;; no attr to care about
1036 (add-to-list 'path-children child)
1037 (let* ((child-attr-list (cadr child))
1038 (step-attr-copy (copy-sequence step-attr-list)))
1039 (dolist (child-attr child-attr-list)
1040 ;; Compare attr names:
1041 (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
1042 ;; Compare values:
1043 (let ((step-val (cdar step-attr-copy))
1044 (child-val (cdr child-attr)))
1045 (when (if (not step-val)
1046 t ;; any value
1047 (string= step-val child-val))
1048 (setq step-attr-copy (cdr step-attr-copy))))))
1049 ;; Did we find all?
1050 (unless step-attr-copy
1051 ;;(throw 'path-child child)
1052 (add-to-list 'path-children child)
1053 ))))))
1054 (if path-tail
1055 (org-freemind-get-children path-children path-tail)
1056 path-children)))
1057
1058(defun org-freemind-get-richcontent-node (node)
1059 (let ((rc-nodes
1060 (org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
1061 (when (> (length rc-nodes) 1)
1062 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>"))
1063 (car rc-nodes)))
1064
1065(defun org-freemind-get-richcontent-note (node)
1066 (let ((rc-notes
1067 (org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
1068 (when (> (length rc-notes) 1)
1069 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
1070 (car rc-notes)))
1071
1072(defun org-freemind-test-get-tree-text ()
1073 (let ((node '(p nil "\n"
1074 (a
1075 ((href . "link"))
1076 "text")
1077 "\n"
1078 (b nil "hej")
1079 "\n")))
1080 (org-freemind-get-tree-text node)))
1081;; (org-freemind-test-get-tree-text)
1082
1083(defun org-freemind-get-tree-text (node)
1084 (when node
1085 (let ((ntxt "")
1086 (link nil)
1087 (lf-after nil))
1088 (dolist (n node)
1089 (case n
1090 ;;(a (setq is-link t) )
1091 ((h1 h2 h3 h4 h5 h6 p)
1092 ;;(setq ntxt (concat "\n" ntxt))
1093 (setq lf-after 2))
1094 (br
1095 (setq lf-after 1))
1096 (t
1097 (cond
1098 ((stringp n)
1099 (when (string= n "\n") (setq n ""))
1100 (if link
1101 (setq ntxt (concat ntxt
1102 "[[" link "][" n "]]"))
1103 (setq ntxt (concat ntxt n))))
1104 ((and n (listp n))
1105 (if (symbolp (car n))
1106 (setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
1107 ;; This should be the attributes:
1108 (dolist (att-val n)
1109 (let ((att (car att-val))
1110 (val (cdr att-val)))
1111 (when (eq att 'href)
1112 (setq link val))))))))))
1113 (if lf-after
1114 (setq ntxt (concat ntxt (make-string lf-after ?\n)))
1115 (setq ntxt (concat ntxt " ")))
1116 ;;(setq ntxt (concat ntxt (format "{%s}" n)))
1117 ntxt)))
1118
1119(defun org-freemind-get-richcontent-node-text (node)
1120 "Get the node text as from the richcontent node NODE."
1121 (save-match-data
1122 (let* ((rc (org-freemind-get-richcontent-node node))
1123 (txt (org-freemind-get-tree-text rc)))
1124 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1125 txt
1126 )))
1127
1128(defun org-freemind-get-richcontent-note-text (node)
1129 "Get the node text as from the richcontent note NODE."
1130 (save-match-data
1131 (let* ((rc (org-freemind-get-richcontent-note node))
1132 (txt (when rc (org-freemind-get-tree-text rc))))
1133 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1134 txt
1135 )))
1136
1137(defun org-freemind-get-icon-names (node)
1138 (let* ((icon-nodes (org-freemind-get-children node '((icon ))))
1139 names)
1140 (dolist (icn icon-nodes)
1141 (setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
1142 ;; (icon (builtin . "full-1"))
1143 names))
1144
1145(defun org-freemind-node-to-org (node level skip-levels)
1146 (let ((qname (car node))
1147 (attributes (cadr node))
1148 text
1149 ;; Fix-me: note is never inserted
1150 (note (org-freemind-get-richcontent-note-text node))
1151 (mark "-- This is more about ")
1152 (icons (org-freemind-get-icon-names node))
1153 (children (cddr node)))
1154 (when (< 0 (- level skip-levels))
1155 (dolist (attrib attributes)
1156 (case (car attrib)
1157 ('TEXT (setq text (cdr attrib)))
1158 ('text (setq text (cdr attrib)))))
1159 (unless text
1160 ;; There should be a richcontent node holding the text:
1161 (setq text (org-freemind-get-richcontent-node-text node)))
1162 (when icons
1163 (when (member "full-1" icons) (setq text (concat "[#A] " text)))
1164 (when (member "full-2" icons) (setq text (concat "[#B] " text)))
1165 (when (member "full-3" icons) (setq text (concat "[#C] " text)))
1166 (when (member "full-4" icons) (setq text (concat "[#D] " text)))
1167 (when (member "full-5" icons) (setq text (concat "[#E] " text)))
1168 (when (member "full-6" icons) (setq text (concat "[#F] " text)))
1169 (when (member "full-7" icons) (setq text (concat "[#G] " text)))
1170 (when (member "button_cancel" icons) (setq text (concat "TODO " text)))
1171 )
1172 (if (and note
1173 (string= mark (substring note 0 (length mark))))
1174 (progn
1175 (setq text (replace-regexp-in-string "\n $" "" text))
1176 (insert text))
1177 (case qname
1178 ('node
1179 (insert (make-string (- level skip-levels) ?*) " " text "\n")
1180 (when note
1181 (insert ":COMMENT:\n" note "\n:END:\n"))
1182 ))))
1183 (dolist (child children)
1184 (unless (or (null child)
1185 (stringp child))
1186 (org-freemind-node-to-org child (1+ level) skip-levels)))))
1187
1188;; Fix-me: put back special things, like drawers that are stored in
1189;; the notes. Should maybe all notes contents be put in drawers?
1190;;;###autoload
1191(defun org-freemind-to-org-mode (mm-file org-file)
1192 "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
1193 (interactive
1194 (save-match-data
1195 (let* ((mm-file (buffer-file-name))
1196 (default-org-file (concat (file-name-nondirectory mm-file) ".org"))
1197 (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
1198 (list mm-file org-file))))
1199 (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
1200 (let ((mm-buffer (find-file-noselect mm-file))
1201 (org-buffer (find-file-noselect org-file)))
1202 (with-current-buffer mm-buffer
1203 (let* ((xml-list (xml-parse-file mm-file))
1204 (top-node (cadr (cddar xml-list)))
1205 (note (org-freemind-get-richcontent-note-text top-node))
1206 (skip-levels
1207 (if (and note
1208 (string-match "^--org-mode: WHOLE FILE$" note))
1209 1
1210 0)))
1211 (with-current-buffer org-buffer
1212 (erase-buffer)
1213 (org-freemind-node-to-org top-node 1 skip-levels)
1214 (goto-char (point-min))
1215 (org-set-tags t t) ;; Align all tags
1216 )
1217 (switch-to-buffer-other-window org-buffer)
1218 )))))
1219
1220(provide 'org-freemind)
1221
1222;; Local variables:
1223;; generated-autoload-file: "org-loaddefs.el"
1224;; coding: utf-8
1225;; End:
1226
1227;;; org-freemind.el ends here
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el
deleted file mode 100644
index ca90f855aab..00000000000
--- a/lisp/org/org-html.el
+++ /dev/null
@@ -1,2761 +0,0 @@
1;;; org-html.el --- HTML export for Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;;; Code:
28
29(require 'org-exp)
30(require 'format-spec)
31
32(eval-when-compile (require 'cl))
33
34(declare-function org-id-find-id-file "org-id" (id))
35(declare-function htmlize-region "ext:htmlize" (beg end))
36(declare-function org-pop-to-buffer-same-window
37 "org-compat" (&optional buffer-or-name norecord label))
38
39(defgroup org-export-html nil
40 "Options specific for HTML export of Org-mode files."
41 :tag "Org Export HTML"
42 :group 'org-export)
43
44(defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
45<h2 class=\"footnotes\">%s: </h2>
46<div id=\"text-footnotes\">
47%s
48</div>
49</div>"
50 "Format for the footnotes section.
51Should contain a two instances of %s. The first will be replaced with the
52language-specific word for \"Footnotes\", the second one will be replaced
53by the footnotes themselves."
54 :group 'org-export-html
55 :type 'string)
56
57(defcustom org-export-html-footnote-format "<sup>%s</sup>"
58 "The format for the footnote reference.
59%s will be replaced by the footnote reference itself."
60 :group 'org-export-html
61 :type 'string)
62
63
64(defcustom org-export-html-footnote-separator "<sup>, </sup>"
65 "Text used to separate footnotes."
66 :group 'org-export-html
67 :version "24.1"
68 :type 'string)
69
70(defcustom org-export-html-coding-system nil
71 "Coding system for HTML export, defaults to `buffer-file-coding-system'."
72 :group 'org-export-html
73 :type 'coding-system)
74
75(defcustom org-export-html-extension "html"
76 "The extension for exported HTML files."
77 :group 'org-export-html
78 :type 'string)
79
80(defcustom org-export-html-xml-declaration
81 '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
82 ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
83 "The extension for exported HTML files.
84%s will be replaced with the charset of the exported file.
85This may be a string, or an alist with export extensions
86and corresponding declarations."
87 :group 'org-export-html
88 :type '(choice
89 (string :tag "Single declaration")
90 (repeat :tag "Dependent on extension"
91 (cons (string :tag "Extension")
92 (string :tag "Declaration")))))
93
94(defcustom org-export-html-style-include-scripts t
95 "Non-nil means include the JavaScript snippets in exported HTML files.
96The actual script is defined in `org-export-html-scripts' and should
97not be modified."
98 :group 'org-export-html
99 :type 'boolean)
100
101(defvar org-export-html-scripts
102 "<script type=\"text/javascript\">
103/*
104@licstart The following is the entire license notice for the
105JavaScript code in this tag.
106
107Copyright (C) 2012-2013 Free Software Foundation, Inc.
108
109The JavaScript code in this tag is free software: you can
110redistribute it and/or modify it under the terms of the GNU
111General Public License (GNU GPL) as published by the Free Software
112Foundation, either version 3 of the License, or (at your option)
113any later version. The code is distributed WITHOUT ANY WARRANTY;
114without even the implied warranty of MERCHANTABILITY or FITNESS
115FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
116
117As additional permission under GNU GPL version 3 section 7, you
118may distribute non-source (e.g., minimized or compacted) forms of
119that code without the copy of the GNU GPL normally required by
120section 4, provided you include this license notice and a URL
121through which recipients can access the Corresponding Source.
122
123
124@licend The above is the entire license notice
125for the JavaScript code in this tag.
126*/
127<!--/*--><![CDATA[/*><!--*/
128 function CodeHighlightOn(elem, id)
129 {
130 var target = document.getElementById(id);
131 if(null != target) {
132 elem.cacheClassElem = elem.className;
133 elem.cacheClassTarget = target.className;
134 target.className = \"code-highlighted\";
135 elem.className = \"code-highlighted\";
136 }
137 }
138 function CodeHighlightOff(elem, id)
139 {
140 var target = document.getElementById(id);
141 if(elem.cacheClassElem)
142 elem.className = elem.cacheClassElem;
143 if(elem.cacheClassTarget)
144 target.className = elem.cacheClassTarget;
145 }
146/*]]>*///-->
147</script>"
148 "Basic JavaScript that is needed by HTML files produced by Org-mode.")
149
150(defconst org-export-html-style-default
151 "<style type=\"text/css\">
152 <!--/*--><![CDATA[/*><!--*/
153 html { font-family: Times, serif; font-size: 12pt; }
154 .title { text-align: center; }
155 .todo { color: red; }
156 .done { color: green; }
157 .tag { background-color: #add8e6; font-weight:normal }
158 .target { }
159 .timestamp { color: #bebebe; }
160 .timestamp-kwd { color: #5f9ea0; }
161 .right {margin-left:auto; margin-right:0px; text-align:right;}
162 .left {margin-left:0px; margin-right:auto; text-align:left;}
163 .center {margin-left:auto; margin-right:auto; text-align:center;}
164 p.verse { margin-left: 3% }
165 pre {
166 border: 1pt solid #AEBDCC;
167 background-color: #F3F5F7;
168 padding: 5pt;
169 font-family: courier, monospace;
170 font-size: 90%;
171 overflow:auto;
172 }
173 table { border-collapse: collapse; }
174 td, th { vertical-align: top; }
175 th.right { text-align:center; }
176 th.left { text-align:center; }
177 th.center { text-align:center; }
178 td.right { text-align:right; }
179 td.left { text-align:left; }
180 td.center { text-align:center; }
181 dt { font-weight: bold; }
182 div.figure { padding: 0.5em; }
183 div.figure p { text-align: center; }
184 div.inlinetask {
185 padding:10px;
186 border:2px solid gray;
187 margin:10px;
188 background: #ffffcc;
189 }
190 textarea { overflow-x: auto; }
191 .linenr { font-size:smaller }
192 .code-highlighted {background-color:#ffff00;}
193 .org-info-js_info-navigation { border-style:none; }
194 #org-info-js_console-label { font-size:10px; font-weight:bold;
195 white-space:nowrap; }
196 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
197 font-weight:bold; }
198 /*]]>*/-->
199</style>"
200 "The default style specification for exported HTML files.
201Please use the variables `org-export-html-style' and
202`org-export-html-style-extra' to add to this style. If you wish to not
203have the default style included, customize the variable
204`org-export-html-style-include-default'.")
205
206(defcustom org-export-html-style-include-default t
207 "Non-nil means include the default style in exported HTML files.
208The actual style is defined in `org-export-html-style-default' and should
209not be modified. Use the variables `org-export-html-style' to add
210your own style information."
211 :group 'org-export-html
212 :type 'boolean)
213
214;;;###autoload
215(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
216
217(defcustom org-export-html-style ""
218 "Org-wide style definitions for exported HTML files.
219
220This variable needs to contain the full HTML structure to provide a style,
221including the surrounding HTML tags. If you set the value of this variable,
222you should consider to include definitions for the following classes:
223 title, todo, done, timestamp, timestamp-kwd, tag, target.
224
225For example, a valid value would be:
226
227 <style type=\"text/css\">
228 <![CDATA[
229 p { font-weight: normal; color: gray; }
230 h1 { color: black; }
231 .title { text-align: center; }
232 .todo, .timestamp-kwd { color: red; }
233 .done { color: green; }
234 ]]>
235 </style>
236
237If you'd like to refer to an external style file, use something like
238
239 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
240
241As the value of this option simply gets inserted into the HTML <head> header,
242you can \"misuse\" it to add arbitrary text to the header.
243See also the variable `org-export-html-style-extra'."
244 :group 'org-export-html
245 :type 'string)
246;;;###autoload
247(put 'org-export-html-style 'safe-local-variable 'stringp)
248
249(defcustom org-export-html-style-extra ""
250 "Additional style information for HTML export.
251The value of this variable is inserted into the HTML buffer right after
252the value of `org-export-html-style'. Use this variable for per-file
253settings of style information, and do not forget to surround the style
254settings with <style>...</style> tags."
255 :group 'org-export-html
256 :type 'string)
257;;;###autoload
258(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
259
260(defcustom org-export-html-mathjax-options
261 '((path "http://orgmode.org/mathjax/MathJax.js")
262 (scale "100")
263 (align "center")
264 (indent "2em")
265 (mathml nil))
266 "Options for MathJax setup.
267
268path The path where to find MathJax
269scale Scaling for the HTML-CSS backend, usually between 100 and 133
270align How to align display math: left, center, or right
271indent If align is not center, how far from the left/right side?
272mathml Should a MathML player be used if available?
273 This is faster and reduces bandwidth use, but currently
274 sometimes has lower spacing quality. Therefore, the default is
275 nil. When browsers get better, this switch can be flipped.
276
277You can also customize this for each buffer, using something like
278
279#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
280 :group 'org-export-html
281 :version "24.1"
282 :type '(list :greedy t
283 (list :tag "path (the path from where to load MathJax.js)"
284 (const :format " " path) (string))
285 (list :tag "scale (scaling for the displayed math)"
286 (const :format " " scale) (string))
287 (list :tag "align (alignment of displayed equations)"
288 (const :format " " align) (string))
289 (list :tag "indent (indentation with left or right alignment)"
290 (const :format " " indent) (string))
291 (list :tag "mathml (should MathML display be used is possible)"
292 (const :format " " mathml) (boolean))))
293
294(defun org-export-html-mathjax-config (template options in-buffer)
295 "Insert the user setup into the matchjax template."
296 (let (name val (yes " ") (no "// ") x)
297 (mapc
298 (lambda (e)
299 (setq name (car e) val (nth 1 e))
300 (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
301 (setq val (car (read-from-string
302 (substring in-buffer (match-end 0))))))
303 (if (not (stringp val)) (setq val (format "%s" val)))
304 (setq template
305 (replace-regexp-in-string
306 (concat "%" (upcase (symbol-name name))) val template t t)))
307 options)
308 (setq val (nth 1 (assq 'mathml options)))
309 (if (string-match (concat "\\<mathml:") in-buffer)
310 (setq val (car (read-from-string
311 (substring in-buffer (match-end 0))))))
312 ;; Exchange prefixes depending on mathml setting
313 (if (not val) (setq x yes yes no no x))
314 ;; Replace cookies to turn on or off the config/jax lines
315 (if (string-match ":MMLYES:" template)
316 (setq template (replace-match yes t t template)))
317 (if (string-match ":MMLNO:" template)
318 (setq template (replace-match no t t template)))
319 ;; Return the modified template
320 template))
321
322(defcustom org-export-html-mathjax-template
323 "<script type=\"text/javascript\" src=\"%PATH\">
324/**
325 *
326 * @source: %PATH
327 *
328 * @licstart The following is the entire license notice for the
329 * JavaScript code in %PATH.
330 *
331 * Copyright (C) 2012-2013 MathJax
332 *
333 * Licensed under the Apache License, Version 2.0 (the \"License\");
334 * you may not use this file except in compliance with the License.
335 * You may obtain a copy of the License at
336 *
337 * http://www.apache.org/licenses/LICENSE-2.0
338 *
339 * Unless required by applicable law or agreed to in writing, software
340 * distributed under the License is distributed on an \"AS IS\" BASIS,
341 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
342 * See the License for the specific language governing permissions and
343 * limitations under the License.
344 *
345 * @licend The above is the entire license notice
346 * for the JavaScript code in %PATH.
347 *
348 */
349
350/*
351@licstart The following is the entire license notice for the
352JavaScript code below.
353
354Copyright (C) 2012-2013 Free Software Foundation, Inc.
355
356The JavaScript code below is free software: you can
357redistribute it and/or modify it under the terms of the GNU
358General Public License (GNU GPL) as published by the Free Software
359Foundation, either version 3 of the License, or (at your option)
360any later version. The code is distributed WITHOUT ANY WARRANTY;
361without even the implied warranty of MERCHANTABILITY or FITNESS
362FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
363
364As additional permission under GNU GPL version 3 section 7, you
365may distribute non-source (e.g., minimized or compacted) forms of
366that code without the copy of the GNU GPL normally required by
367section 4, provided you include this license notice and a URL
368through which recipients can access the Corresponding Source.
369
370
371@licend The above is the entire license notice
372for the JavaScript code below.
373*/
374<!--/*--><![CDATA[/*><!--*/
375 MathJax.Hub.Config({
376 // Only one of the two following lines, depending on user settings
377 // First allows browser-native MathML display, second forces HTML/CSS
378 :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
379 :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
380 extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
381 \"TeX/noUndefined.js\"],
382 tex2jax: {
383 inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
384 displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
385 skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
386 ignoreClass: \"tex2jax_ignore\",
387 processEscapes: false,
388 processEnvironments: true,
389 preview: \"TeX\"
390 },
391 showProcessingMessages: true,
392 displayAlign: \"%ALIGN\",
393 displayIndent: \"%INDENT\",
394
395 \"HTML-CSS\": {
396 scale: %SCALE,
397 availableFonts: [\"STIX\",\"TeX\"],
398 preferredFont: \"TeX\",
399 webFont: \"TeX\",
400 imageFont: \"TeX\",
401 showMathMenu: true,
402 },
403 MMLorHTML: {
404 prefer: {
405 MSIE: \"MML\",
406 Firefox: \"MML\",
407 Opera: \"HTML\",
408 other: \"HTML\"
409 }
410 }
411 });
412/*]]>*///-->
413</script>"
414 "The MathJax setup for XHTML files."
415 :group 'org-export-html
416 :version "24.1"
417 :type 'string)
418
419(defcustom org-export-html-tag-class-prefix ""
420 "Prefix to class names for TODO keywords.
421Each tag gets a class given by the tag itself, with this prefix.
422The default prefix is empty because it is nice to just use the keyword
423as a class name. But if you get into conflicts with other, existing
424CSS classes, then this prefix can be very useful."
425 :group 'org-export-html
426 :type 'string)
427
428(defcustom org-export-html-todo-kwd-class-prefix ""
429 "Prefix to class names for TODO keywords.
430Each TODO keyword gets a class given by the keyword itself, with this prefix.
431The default prefix is empty because it is nice to just use the keyword
432as a class name. But if you get into conflicts with other, existing
433CSS classes, then this prefix can be very useful."
434 :group 'org-export-html
435 :type 'string)
436
437(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>"
438 "Format for anchors in HTML headlines.
439It requires to %s: both will be replaced by the anchor referring
440to the headline (e.g. \"sec-2\"). When set to `nil', don't insert
441HTML anchors in headlines."
442 :group 'org-export-html
443 :version "24.1"
444 :type 'string)
445
446(defcustom org-export-html-preamble t
447 "Non-nil means insert a preamble in HTML export.
448
449When `t', insert a string as defined by one of the formatting
450strings in `org-export-html-preamble-format'. When set to a
451string, this string overrides `org-export-html-preamble-format'.
452When set to a function, apply this function and insert the
453returned string. The function takes no argument, but you can
454use `opt-plist' to access the current export options.
455
456Setting :html-preamble in publishing projects will take
457precedence over this variable."
458 :group 'org-export-html
459 :type '(choice (const :tag "No preamble" nil)
460 (const :tag "Default preamble" t)
461 (string :tag "Custom format string")
462 (function :tag "Function (must return a string)")))
463
464(defcustom org-export-html-preamble-format '(("en" ""))
465 "Alist of languages and format strings for the HTML preamble.
466
467To enable the HTML exporter to use these formats, you need to set
468`org-export-html-preamble' to `t'.
469
470The first element of each list is the language code, as used for
471the #+LANGUAGE keyword.
472
473The second element of each list is a format string to format the
474preamble itself. This format string can contain these elements:
475
476%t stands for the title.
477%a stands for the author's name.
478%e stands for the author's email.
479%d stands for the date.
480
481If you need to use a \"%\" character, you need to escape it
482like that: \"%%\"."
483 :group 'org-export-html
484 :version "24.1"
485 :type 'string)
486
487(defcustom org-export-html-postamble 'auto
488 "Non-nil means insert a postamble in HTML export.
489
490When `t', insert a string as defined by the format string in
491`org-export-html-postamble-format'. When set to a string, this
492string overrides `org-export-html-postamble-format'. When set to
493'auto, discard `org-export-html-postamble-format' and honor
494`org-export-author/email/creator-info' variables. When set to a
495function, apply this function and insert the returned string.
496The function takes no argument, but you can use `opt-plist' to
497access the current export options.
498
499Setting :html-postamble in publishing projects will take
500precedence over this variable."
501 :group 'org-export-html
502 :type '(choice (const :tag "No postamble" nil)
503 (const :tag "Auto preamble" 'auto)
504 (const :tag "Default format string" t)
505 (string :tag "Custom format string")
506 (function :tag "Function (must return a string)")))
507
508(defcustom org-export-html-postamble-format
509 '(("en" "<p class=\"author\">Author: %a (%e)</p>
510<p class=\"date\">Date: %d</p>
511<p class=\"creator\">Generated by %c</p>
512<p class=\"xhtml-validation\">%v</p>
513"))
514 "Alist of languages and format strings for the HTML postamble.
515
516To enable the HTML exporter to use these formats, you need to set
517`org-export-html-postamble' to `t'.
518
519The first element of each list is the language code, as used for
520the #+LANGUAGE keyword.
521
522The second element of each list is a format string to format the
523postamble itself. This format string can contain these elements:
524
525%a stands for the author's name.
526%e stands for the author's email.
527%d stands for the date.
528%c will be replaced by information about Org/Emacs versions.
529%v will be replaced by `org-export-html-validation-link'.
530
531If you need to use a \"%\" character, you need to escape it
532like that: \"%%\"."
533 :group 'org-export-html
534 :version "24.1"
535 :type 'string)
536
537(defcustom org-export-html-home/up-format
538 "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
539 <a accesskey=\"h\" href=\"%s\"> UP </a>
540 |
541 <a accesskey=\"H\" href=\"%s\"> HOME </a>
542</div>"
543 "Snippet used to insert the HOME and UP links.
544This is a format string, the first %s will receive the UP link,
545the second the HOME link. If both `org-export-html-link-up' and
546`org-export-html-link-home' are empty, the entire snippet will be
547ignored."
548 :group 'org-export-html
549 :type 'string)
550
551(defcustom org-export-html-toplevel-hlevel 2
552 "The <H> level for level 1 headings in HTML export.
553This is also important for the classes that will be wrapped around headlines
554and outline structure. If this variable is 1, the top-level headlines will
555be <h1>, and the corresponding classes will be outline-1, section-number-1,
556and outline-text-1. If this is 2, all of these will get a 2 instead.
557The default for this variable is 2, because we use <h1> for formatting the
558document title."
559 :group 'org-export-html
560 :type 'string)
561
562(defcustom org-export-html-link-org-files-as-html t
563 "Non-nil means make file links to `file.org' point to `file.html'.
564When org-mode is exporting an org-mode file to HTML, links to
565non-html files are directly put into a href tag in HTML.
566However, links to other Org-mode files (recognized by the
567extension `.org.) should become links to the corresponding html
568file, assuming that the linked org-mode file will also be
569converted to HTML.
570When nil, the links still point to the plain `.org' file."
571 :group 'org-export-html
572 :type 'boolean)
573
574(defcustom org-export-html-inline-images 'maybe
575 "Non-nil means inline images into exported HTML pages.
576This is done using an <img> tag. When nil, an anchor with href is used to
577link to the image. If this option is `maybe', then images in links with
578an empty description will be inlined, while images with a description will
579be linked only."
580 :group 'org-export-html
581 :type '(choice (const :tag "Never" nil)
582 (const :tag "Always" t)
583 (const :tag "When there is no description" maybe)))
584
585(defcustom org-export-html-inline-image-extensions
586 '("png" "jpeg" "jpg" "gif" "svg")
587 "Extensions of image files that can be inlined into HTML."
588 :group 'org-export-html
589 :type '(repeat (string :tag "Extension")))
590
591(defcustom org-export-html-table-tag
592 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
593 "The HTML tag that is used to start a table.
594This must be a <table> tag, but you may change the options like
595borders and spacing."
596 :group 'org-export-html
597 :type 'string)
598
599(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
600 "The opening tag for table header fields.
601This is customizable so that alignment options can be specified.
602The first %s will be filled with the scope of the field, either row or col.
603The second %s will be replaced by a style entry to align the field.
604See also the variable `org-export-html-table-use-header-tags-for-first-column'.
605See also the variable `org-export-html-table-align-individual-fields'."
606 :group 'org-export-tables
607 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
608
609(defcustom org-export-table-data-tags '("<td%s>" . "</td>")
610 "The opening tag for table data fields.
611This is customizable so that alignment options can be specified.
612The first %s will be filled with the scope of the field, either row or col.
613The second %s will be replaced by a style entry to align the field.
614See also the variable `org-export-html-table-align-individual-fields'."
615 :group 'org-export-tables
616 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
617
618(defcustom org-export-table-row-tags '("<tr>" . "</tr>")
619 "The opening tag for table data fields.
620This is customizable so that alignment options can be specified.
621Instead of strings, these can be Lisp forms that will be evaluated
622for each row in order to construct the table row tags. During evaluation,
623the variable `head' will be true when this is a header line, nil when this
624is a body line. And the variable `nline' will contain the line number,
625starting from 1 in the first header line. For example
626
627 (setq org-export-table-row-tags
628 (cons '(if head
629 \"<tr>\"
630 (if (= (mod nline 2) 1)
631 \"<tr class=\\\"tr-odd\\\">\"
632 \"<tr class=\\\"tr-even\\\">\"))
633 \"</tr>\"))
634
635will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
636 :group 'org-export-tables
637 :type '(cons
638 (choice :tag "Opening tag"
639 (string :tag "Specify")
640 (sexp))
641 (choice :tag "Closing tag"
642 (string :tag "Specify")
643 (sexp))))
644
645(defcustom org-export-html-table-align-individual-fields t
646 "Non-nil means attach style attributes for alignment to each table field.
647When nil, alignment will only be specified in the column tags, but this
648is ignored by some browsers (like Firefox, Safari). Opera does it right
649though."
650 :group 'org-export-tables
651 :version "24.1"
652 :type 'boolean)
653
654(defcustom org-export-html-table-use-header-tags-for-first-column nil
655 "Non-nil means format column one in tables with header tags.
656When nil, also column one will use data tags."
657 :group 'org-export-tables
658 :type 'boolean)
659
660(defcustom org-export-html-validation-link
661 "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
662 "Link to HTML validation service."
663 :group 'org-export-html
664 :type 'string)
665
666;; FIXME Obsolete since Org 7.7
667;; Use the :timestamp option or `org-export-time-stamp-file' instead
668(defvar org-export-html-with-timestamp nil
669 "If non-nil, write container for HTML-helper-mode timestamp.")
670
671;; FIXME Obsolete since Org 7.7
672(defvar org-export-html-html-helper-timestamp
673 "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n"
674 "The HTML tag used as timestamp delimiter for HTML-helper-mode.")
675
676(defcustom org-export-html-protect-char-alist
677 '(("&" . "&amp;")
678 ("<" . "&lt;")
679 (">" . "&gt;"))
680 "Alist of characters to be converted by `org-html-protect'."
681 :group 'org-export-html
682 :version "24.1"
683 :type '(repeat (cons (string :tag "Character")
684 (string :tag "HTML equivalent"))))
685
686(defgroup org-export-htmlize nil
687 "Options for processing examples with htmlize.el."
688 :tag "Org Export Htmlize"
689 :group 'org-export-html)
690
691(defcustom org-export-htmlize-output-type 'inline-css
692 "Output type to be used by htmlize when formatting code snippets.
693Choices are `css', to export the CSS selectors only, or `inline-css', to
694export the CSS attribute values inline in the HTML. We use as default
695`inline-css', in order to make the resulting HTML self-containing.
696
697However, this will fail when using Emacs in batch mode for export, because
698then no rich font definitions are in place. It will also not be good if
699people with different Emacs setup contribute HTML files to a website,
700because the fonts will represent the individual setups. In these cases,
701it is much better to let Org/Htmlize assign classes only, and to use
702a style file to define the look of these classes.
703To get a start for your css file, start Emacs session and make sure that
704all the faces you are interested in are defined, for example by loading files
705in all modes you want. Then, use the command
706\\[org-export-htmlize-generate-css] to extract class definitions."
707 :group 'org-export-htmlize
708 :type '(choice (const css) (const inline-css)))
709
710(defcustom org-export-htmlize-css-font-prefix "org-"
711 "The prefix for CSS class names for htmlize font specifications."
712 :group 'org-export-htmlize
713 :type 'string)
714
715(defcustom org-export-htmlized-org-css-url nil
716 "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
717Normally when creating an htmlized version of an Org buffer, htmlize will
718create CSS to define the font colors. However, this does not work when
719converting in batch mode, and it also can look bad if different people
720with different fontification setup work on the same website.
721When this variable is non-nil, creating an htmlized version of an Org buffer
722using `org-export-as-org' will remove the internal CSS section and replace it
723with a link to this URL."
724 :group 'org-export-htmlize
725 :type '(choice
726 (const :tag "Keep internal css" nil)
727 (string :tag "URL or local href")))
728
729;; FIXME: The following variable is obsolete since Org 7.7 but is
730;; still declared and checked within code for compatibility reasons.
731;; Use the custom variables `org-export-html-divs' instead.
732(defvar org-export-html-content-div "content"
733 "The name of the container DIV that holds all the page contents.
734
735This variable is obsolete since Org version 7.7.
736Please set `org-export-html-divs' instead.")
737
738(defcustom org-export-html-divs '("preamble" "content" "postamble")
739 "The name of the main divs for HTML export.
740This is a list of three strings, the first one for the preamble
741DIV, the second one for the content DIV and the third one for the
742postamble DIV."
743 :group 'org-export-html
744 :version "24.1"
745 :type '(list
746 (string :tag " Div for the preamble:")
747 (string :tag " Div for the content:")
748 (string :tag "Div for the postamble:")))
749
750(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z"
751 "Format string to format the date and time.
752
753The default is an extended format of the ISO 8601 specification."
754 :group 'org-export-html
755 :version "24.1"
756 :type 'string)
757
758;;; Hooks
759
760(defvar org-export-html-after-blockquotes-hook nil
761 "Hook run during HTML export, after blockquote, verse, center are done.")
762
763(defvar org-export-html-final-hook nil
764 "Hook run at the end of HTML export, in the new buffer.")
765
766;;; HTML export
767
768(defun org-export-html-preprocess (parameters)
769 "Convert LaTeX fragments to images."
770 (when (and org-current-export-file
771 (plist-get parameters :LaTeX-fragments))
772 (org-format-latex
773 (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
774 (file-name-nondirectory
775 org-current-export-file)))
776 org-current-export-dir nil "Creating LaTeX image %s"
777 nil nil
778 (cond
779 ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
780 ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
781 ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
782 ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick)
783 ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng))))
784 (goto-char (point-min))
785 (let (label l1)
786 (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
787 (org-if-unprotected-at (match-beginning 1)
788 (setq label (match-string 1))
789 (save-match-data
790 (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label)
791 (setq l1 (substring label (match-beginning 1)))
792 (setq l1 label)))
793 (replace-match (format "[[#%s][%s]]" label l1) t t)))))
794
795;;;###autoload
796(defun org-export-as-html-and-open (arg)
797 "Export the outline as HTML and immediately open it with a browser.
798If there is an active region, export only the region.
799The prefix ARG specifies how many levels of the outline should become
800headlines. The default is 3. Lower levels will become bulleted lists."
801 (interactive "P")
802 (org-export-as-html arg)
803 (org-open-file buffer-file-name)
804 (when org-export-kill-product-buffer-when-displayed
805 (kill-buffer (current-buffer))))
806
807;;;###autoload
808(defun org-export-as-html-batch ()
809 "Call the function `org-export-as-html'.
810This function can be used in batch processing as:
811emacs --batch
812 --load=$HOME/lib/emacs/org.el
813 --eval \"(setq org-export-headline-levels 2)\"
814 --visit=MyFile --funcall org-export-as-html-batch"
815 (org-export-as-html org-export-headline-levels))
816
817;;;###autoload
818(defun org-export-as-html-to-buffer (arg)
819 "Call `org-export-as-html` with output to a temporary buffer.
820No file is created. The prefix ARG is passed through to `org-export-as-html'."
821 (interactive "P")
822 (org-export-as-html arg nil "*Org HTML Export*")
823 (when org-export-show-temporary-export-buffer
824 (switch-to-buffer-other-window "*Org HTML Export*")))
825
826;;;###autoload
827(defun org-replace-region-by-html (beg end)
828 "Assume the current region has org-mode syntax, and convert it to HTML.
829This can be used in any buffer. For example, you could write an
830itemized list in org-mode syntax in an HTML buffer and then use this
831command to convert it."
832 (interactive "r")
833 (let (reg html buf pop-up-frames)
834 (save-window-excursion
835 (if (derived-mode-p 'org-mode)
836 (setq html (org-export-region-as-html
837 beg end t 'string))
838 (setq reg (buffer-substring beg end)
839 buf (get-buffer-create "*Org tmp*"))
840 (with-current-buffer buf
841 (erase-buffer)
842 (insert reg)
843 (org-mode)
844 (setq html (org-export-region-as-html
845 (point-min) (point-max) t 'string)))
846 (kill-buffer buf)))
847 (delete-region beg end)
848 (insert html)))
849
850;;;###autoload
851(defun org-export-region-as-html (beg end &optional body-only buffer)
852 "Convert region from BEG to END in org-mode buffer to HTML.
853If prefix arg BODY-ONLY is set, omit file header, footer, and table of
854contents, and only produce the region of converted text, useful for
855cut-and-paste operations.
856If BUFFER is a buffer or a string, use/create that buffer as a target
857of the converted HTML. If BUFFER is the symbol `string', return the
858produced HTML as a string and leave not buffer behind. For example,
859a Lisp program could call this function in the following way:
860
861 (setq html (org-export-region-as-html beg end t 'string))
862
863When called interactively, the output buffer is selected, and shown
864in a window. A non-interactive call will only return the buffer."
865 (interactive "r\nP")
866 (when (org-called-interactively-p 'any)
867 (setq buffer "*Org HTML Export*"))
868 (let ((transient-mark-mode t) (zmacs-regions t)
869 ext-plist rtn)
870 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
871 (goto-char end)
872 (set-mark (point)) ;; to activate the region
873 (goto-char beg)
874 (setq rtn (org-export-as-html nil ext-plist buffer body-only))
875 (if (fboundp 'deactivate-mark) (deactivate-mark))
876 (if (and (org-called-interactively-p 'any) (bufferp rtn))
877 (switch-to-buffer-other-window rtn)
878 rtn)))
879
880(defvar html-table-tag nil) ; dynamically scoped into this.
881(defvar org-par-open nil)
882
883;;; org-html-cvt-link-fn
884(defconst org-html-cvt-link-fn
885 nil
886 "Function to convert link URLs to exportable URLs.
887Takes two arguments, TYPE and PATH.
888Returns exportable url as (TYPE PATH), or nil to signal that it
889didn't handle this case.
890Intended to be locally bound around a call to `org-export-as-html'." )
891
892(defun org-html-cvt-org-as-html (opt-plist type path)
893 "Convert an org filename to an equivalent html filename.
894If TYPE is not file, just return `nil'.
895See variable `org-export-html-link-org-files-as-html'"
896
897 (save-match-data
898 (and
899 org-export-html-link-org-files-as-html
900 (string= type "file")
901 (string-match "\\.org$" path)
902 (progn
903 (list
904 "file"
905 (concat
906 (substring path 0 (match-beginning 0))
907 "."
908 (plist-get opt-plist :html-extension)))))))
909
910
911;;; org-html-should-inline-p
912(defun org-html-should-inline-p (filename descp)
913 "Return non-nil if link FILENAME should be inlined.
914The decision to inline the FILENAME link is based on the current
915settings. DESCP is the boolean of whether there was a link
916description. See variables `org-export-html-inline-images' and
917`org-export-html-inline-image-extensions'."
918 (declare (special
919 org-export-html-inline-images
920 org-export-html-inline-image-extensions))
921 (and (or (eq t org-export-html-inline-images)
922 (and org-export-html-inline-images (not descp)))
923 (org-file-image-p
924 filename org-export-html-inline-image-extensions)))
925
926;;; org-html-make-link
927(defun org-html-make-link (opt-plist type path fragment desc attr
928 may-inline-p)
929 "Make an HTML link.
930OPT-PLIST is an options list.
931TYPE is the device-type of the link (THIS://foo.html).
932PATH is the path of the link (http://THIS#location).
933FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
934DESC is the link description, if any.
935ATTR is a string of other attributes of the \"a\" element.
936MAY-INLINE-P allows inlining it as an image."
937
938 (declare (special org-par-open))
939 (save-match-data
940 (let* ((filename path)
941 ;;First pass. Just sanity stuff.
942 (components-1
943 (cond
944 ((string= type "file")
945 (list
946 type
947 ;;Substitute just if original path was absolute.
948 ;;(Otherwise path must remain relative)
949 (if (file-name-absolute-p path)
950 (concat "file://" (expand-file-name path))
951 path)))
952 ((string= type "")
953 (list nil path))
954 (t (list type path))))
955
956 ;;Second pass. Components converted so they can refer
957 ;;to a remote site.
958 (components-2
959 (or
960 (and org-html-cvt-link-fn
961 (apply org-html-cvt-link-fn
962 opt-plist components-1))
963 (apply #'org-html-cvt-org-as-html
964 opt-plist components-1)
965 components-1))
966 (type (first components-2))
967 (thefile (second components-2)))
968
969
970 ;;Third pass. Build final link except for leading type
971 ;;spec.
972 (cond
973 ((or
974 (not type)
975 (string= type "http")
976 (string= type "https")
977 (string= type "file")
978 (string= type "coderef"))
979 (if fragment
980 (setq thefile (concat thefile "#" fragment))))
981
982 (t))
983
984 ;;Final URL-build, for all types.
985 (setq thefile
986 (let
987 ((str (org-export-html-format-href thefile)))
988 (if (and type (not (or (string= "file" type)
989 (string= "coderef" type))))
990 (concat type ":" str)
991 str)))
992
993 (if (and
994 may-inline-p
995 ;;Can't inline a URL with a fragment.
996 (not fragment))
997 (progn
998 (message "image %s %s" thefile org-par-open)
999 (org-export-html-format-image thefile org-par-open))
1000 (concat
1001 "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
1002 (org-export-html-format-desc desc)
1003 "</a>")))))
1004
1005(defun org-html-handle-links (org-line opt-plist)
1006 "Return ORG-LINE with markup of Org mode links.
1007OPT-PLIST is the export options list."
1008 (let ((start 0)
1009 (current-dir (if buffer-file-name
1010 (file-name-directory buffer-file-name)
1011 default-directory))
1012 (link-validate (plist-get opt-plist :link-validation-function))
1013 type id-file fnc
1014 rpl path attr desc descp desc1 desc2 link)
1015 (while (string-match org-bracket-link-analytic-regexp++ org-line start)
1016 (setq start (match-beginning 0))
1017 (setq path (save-match-data (org-link-unescape
1018 (match-string 3 org-line))))
1019 (setq type (cond
1020 ((match-end 2) (match-string 2 org-line))
1021 ((save-match-data
1022 (or (file-name-absolute-p path)
1023 (string-match "^\\.\\.?/" path)))
1024 "file")
1025 (t "internal")))
1026 (setq path (org-extract-attributes path))
1027 (setq attr (get-text-property 0 'org-attributes path))
1028 (setq desc1 (if (match-end 5) (match-string 5 org-line))
1029 desc2 (if (match-end 2) (concat type ":" path) path)
1030 descp (and desc1 (not (equal desc1 desc2)))
1031 desc (or desc1 desc2))
1032 ;; Make an image out of the description if that is so wanted
1033 (when (and descp (org-file-image-p
1034 desc org-export-html-inline-image-extensions))
1035 (save-match-data
1036 (if (string-match "^file:" desc)
1037 (setq desc (substring desc (match-end 0)))))
1038 (setq desc (org-add-props
1039 (concat "<img src=\"" desc "\" "
1040 (when (save-match-data (string-match "width=" attr))
1041 (prog1 (concat attr " ") (setq attr "")))
1042 "alt=\""
1043 (file-name-nondirectory desc) "\"/>")
1044 '(org-protected t))))
1045 (cond
1046 ((equal type "internal")
1047 (let
1048 ((frag-0
1049 (if (= (string-to-char path) ?#)
1050 (substring path 1)
1051 path)))
1052 (setq rpl
1053 (org-html-make-link
1054 opt-plist
1055 ""
1056 ""
1057 (org-solidify-link-text
1058 (save-match-data (org-link-unescape frag-0))
1059 nil)
1060 desc attr nil))))
1061 ((and (equal type "id")
1062 (setq id-file (org-id-find-id-file path)))
1063 ;; This is an id: link to another file (if it was the same file,
1064 ;; it would have become an internal link...)
1065 (save-match-data
1066 (setq id-file (file-relative-name
1067 id-file
1068 (file-name-directory org-current-export-file)))
1069 (setq rpl
1070 (org-html-make-link opt-plist
1071 "file" id-file
1072 (concat (if (org-uuidgen-p path) "ID-") path)
1073 desc
1074 attr
1075 nil))))
1076 ((member type '("http" "https"))
1077 ;; standard URL, can inline as image
1078 (setq rpl
1079 (org-html-make-link opt-plist
1080 type path nil
1081 desc
1082 attr
1083 (org-html-should-inline-p path descp))))
1084 ((member type '("ftp" "mailto" "news"))
1085 ;; standard URL, can't inline as image
1086 (setq rpl
1087 (org-html-make-link opt-plist
1088 type path nil
1089 desc
1090 attr
1091 nil)))
1092
1093 ((string= type "coderef")
1094 (let*
1095 ((coderef-str (format "coderef-%s" path))
1096 (attr-1
1097 (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
1098 coderef-str coderef-str)))
1099 (setq rpl
1100 (org-html-make-link opt-plist
1101 type "" coderef-str
1102 (format
1103 (org-export-get-coderef-format
1104 path
1105 (and descp desc))
1106 (cdr (assoc path org-export-code-refs)))
1107 attr-1
1108 nil))))
1109
1110 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
1111 ;; The link protocol has a function for format the link
1112 (setq rpl
1113 (save-match-data
1114 (funcall fnc (org-link-unescape path) desc1 'html))))
1115
1116 ((string= type "file")
1117 ;; FILE link
1118 (save-match-data
1119 (let*
1120 ((components
1121 (if
1122 (string-match "::\\(.*\\)" path)
1123 (list
1124 (replace-match "" t nil path)
1125 (match-string 1 path))
1126 (list path nil)))
1127
1128 ;;The proper path, without a fragment
1129 (path-1
1130 (first components))
1131
1132 ;;The raw fragment
1133 (fragment-0
1134 (second components))
1135
1136 ;;Check the fragment. If it can't be used as
1137 ;;target fragment we'll pass nil instead.
1138 (fragment-1
1139 (if
1140 (and fragment-0
1141 (not (string-match "^[0-9]*$" fragment-0))
1142 (not (string-match "^\\*" fragment-0))
1143 (not (string-match "^/.*/$" fragment-0)))
1144 (org-solidify-link-text
1145 (org-link-unescape fragment-0))
1146 nil))
1147 (desc-2
1148 ;;Description minus "file:" and ".org"
1149 (if (string-match "^file:" desc)
1150 (let
1151 ((desc-1 (replace-match "" t t desc)))
1152 (if (string-match "\\.org$" desc-1)
1153 (replace-match "" t t desc-1)
1154 desc-1))
1155 desc)))
1156
1157 (setq rpl
1158 (if
1159 (and
1160 (functionp link-validate)
1161 (not (funcall link-validate path-1 current-dir)))
1162 desc
1163 (org-html-make-link opt-plist
1164 "file" path-1 fragment-1 desc-2 attr
1165 (org-html-should-inline-p path-1 descp)))))))
1166
1167 (t
1168 ;; just publish the path, as default
1169 (setq rpl (concat "<i>&lt;" type ":"
1170 (save-match-data (org-link-unescape path))
1171 "&gt;</i>"))))
1172 (setq org-line (replace-match rpl t t org-line)
1173 start (+ start (length rpl))))
1174 org-line))
1175
1176;;; org-export-as-html
1177
1178(defvar org-heading-keyword-regexp-format) ; defined in org.el
1179
1180;;;###autoload
1181(defun org-export-as-html (arg &optional ext-plist to-buffer body-only pub-dir)
1182 "Export the outline as a pretty HTML file.
1183If there is an active region, export only the region. The prefix
1184ARG specifies how many levels of the outline should become
1185headlines. The default is 3. Lower levels will become bulleted
1186lists. EXT-PLIST is a property list with external parameters overriding
1187org-mode's default settings, but still inferior to file-local
1188settings. When TO-BUFFER is non-nil, create a buffer with that
1189name and export to that buffer. If TO-BUFFER is the symbol
1190`string', don't leave any buffer behind but just return the
1191resulting HTML as a string. When BODY-ONLY is set, don't produce
1192the file header and footer, simply return the content of
1193<body>...</body>, without even the body tags themselves. When
1194PUB-DIR is set, use this as the publishing directory."
1195 (interactive "P")
1196 (run-hooks 'org-export-first-hook)
1197
1198 ;; Make sure we have a file name when we need it.
1199 (when (and (not (or to-buffer body-only))
1200 (not buffer-file-name))
1201 (if (buffer-base-buffer)
1202 (org-set-local 'buffer-file-name
1203 (with-current-buffer (buffer-base-buffer)
1204 buffer-file-name))
1205 (error "Need a file name to be able to export")))
1206
1207 (message "Exporting...")
1208 (setq-default org-todo-line-regexp org-todo-line-regexp)
1209 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
1210 (setq-default org-done-keywords org-done-keywords)
1211 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
1212 (let* ((opt-plist
1213 (org-export-process-option-filters
1214 (org-combine-plists (org-default-export-plist)
1215 ext-plist
1216 (org-infile-export-plist))))
1217 (body-only (or body-only (plist-get opt-plist :body-only)))
1218 (style (concat (if (plist-get opt-plist :style-include-default)
1219 org-export-html-style-default)
1220 (plist-get opt-plist :style)
1221 (plist-get opt-plist :style-extra)
1222 "\n"
1223 (if (plist-get opt-plist :style-include-scripts)
1224 org-export-html-scripts)))
1225 (html-extension (plist-get opt-plist :html-extension))
1226 valid thetoc have-headings first-heading-pos
1227 (odd org-odd-levels-only)
1228 (region-p (org-region-active-p))
1229 (rbeg (and region-p (region-beginning)))
1230 (rend (and region-p (region-end)))
1231 (subtree-p
1232 (if (plist-get opt-plist :ignore-subtree-p)
1233 nil
1234 (when region-p
1235 (save-excursion
1236 (goto-char rbeg)
1237 (and (org-at-heading-p)
1238 (>= (org-end-of-subtree t t) rend))))))
1239 (level-offset (if subtree-p
1240 (save-excursion
1241 (goto-char rbeg)
1242 (+ (funcall outline-level)
1243 (if org-odd-levels-only 1 0)))
1244 0))
1245 (opt-plist (setq org-export-opt-plist
1246 (if subtree-p
1247 (org-export-add-subtree-options opt-plist rbeg)
1248 opt-plist)))
1249 ;; The following two are dynamically scoped into other
1250 ;; routines below.
1251 (org-current-export-dir
1252 (or pub-dir (org-export-directory :html opt-plist)))
1253 (org-current-export-file buffer-file-name)
1254 (level 0) (org-line "") (origline "") txt todo
1255 (umax nil)
1256 (umax-toc nil)
1257 (filename (if to-buffer nil
1258 (expand-file-name
1259 (concat
1260 (file-name-sans-extension
1261 (or (and subtree-p
1262 (org-entry-get (region-beginning)
1263 "EXPORT_FILE_NAME" t))
1264 (file-name-nondirectory buffer-file-name)))
1265 "." html-extension)
1266 (file-name-as-directory
1267 (or pub-dir (org-export-directory :html opt-plist))))))
1268 (current-dir (if buffer-file-name
1269 (file-name-directory buffer-file-name)
1270 default-directory))
1271 (auto-insert nil); Avoid any auto-insert stuff for the new file
1272 (buffer (if to-buffer
1273 (cond
1274 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
1275 (t (get-buffer-create to-buffer)))
1276 (find-file-noselect filename)))
1277 (org-levels-open (make-vector org-level-max nil))
1278 (date (org-html-expand (plist-get opt-plist :date)))
1279 (author (org-html-expand (plist-get opt-plist :author)))
1280 (html-validation-link (or org-export-html-validation-link ""))
1281 (title (org-html-expand
1282 (or (and subtree-p (org-export-get-title-from-subtree))
1283 (plist-get opt-plist :title)
1284 (and (not body-only)
1285 (not
1286 (plist-get opt-plist :skip-before-1st-heading))
1287 (org-export-grab-title-from-buffer))
1288 (and buffer-file-name
1289 (file-name-sans-extension
1290 (file-name-nondirectory buffer-file-name)))
1291 "UNTITLED")))
1292 (link-up (and (plist-get opt-plist :link-up)
1293 (string-match "\\S-" (plist-get opt-plist :link-up))
1294 (plist-get opt-plist :link-up)))
1295 (link-home (and (plist-get opt-plist :link-home)
1296 (string-match "\\S-" (plist-get opt-plist :link-home))
1297 (plist-get opt-plist :link-home)))
1298 (dummy (setq opt-plist (plist-put opt-plist :title title)))
1299 (html-table-tag (plist-get opt-plist :html-table-tag))
1300 (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
1301 (quote-re (format org-heading-keyword-regexp-format
1302 org-quote-string))
1303 (inquote nil)
1304 (infixed nil)
1305 (inverse nil)
1306 (email (plist-get opt-plist :email))
1307 (language (plist-get opt-plist :language))
1308 (keywords (org-html-expand (plist-get opt-plist :keywords)))
1309 (description (org-html-expand (plist-get opt-plist :description)))
1310 (num (plist-get opt-plist :section-numbers))
1311 (lang-words nil)
1312 (head-count 0) cnt
1313 (start 0)
1314 (coding-system (and (boundp 'buffer-file-coding-system)
1315 buffer-file-coding-system))
1316 (coding-system-for-write (or org-export-html-coding-system
1317 coding-system))
1318 (save-buffer-coding-system (or org-export-html-coding-system
1319 coding-system))
1320 (charset (and coding-system-for-write
1321 (fboundp 'coding-system-get)
1322 (coding-system-get coding-system-for-write
1323 'mime-charset)))
1324 (region
1325 (buffer-substring
1326 (if region-p (region-beginning) (point-min))
1327 (if region-p (region-end) (point-max))))
1328 (org-export-have-math nil)
1329 (org-export-footnotes-seen nil)
1330 (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
1331 (custom-id (or (org-entry-get nil "CUSTOM_ID" t) ""))
1332 (footnote-def-prefix (format "fn-%s" custom-id))
1333 (footnote-ref-prefix (format "fnr-%s" custom-id))
1334 (lines
1335 (org-split-string
1336 (org-export-preprocess-string
1337 region
1338 :emph-multiline t
1339 :for-backend 'html
1340 :skip-before-1st-heading
1341 (plist-get opt-plist :skip-before-1st-heading)
1342 :drawers (plist-get opt-plist :drawers)
1343 :todo-keywords (plist-get opt-plist :todo-keywords)
1344 :tasks (plist-get opt-plist :tasks)
1345 :tags (plist-get opt-plist :tags)
1346 :priority (plist-get opt-plist :priority)
1347 :footnotes (plist-get opt-plist :footnotes)
1348 :timestamps (plist-get opt-plist :timestamps)
1349 :archived-trees
1350 (plist-get opt-plist :archived-trees)
1351 :select-tags (plist-get opt-plist :select-tags)
1352 :exclude-tags (plist-get opt-plist :exclude-tags)
1353 :add-text
1354 (plist-get opt-plist :text)
1355 :LaTeX-fragments
1356 (plist-get opt-plist :LaTeX-fragments))
1357 "[\r\n]"))
1358 (mathjax
1359 (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax)
1360 (and org-export-have-math
1361 (eq (plist-get opt-plist :LaTeX-fragments) t)))
1362
1363 (org-export-html-mathjax-config
1364 org-export-html-mathjax-template
1365 org-export-html-mathjax-options
1366 (or (plist-get opt-plist :mathjax) ""))
1367 ""))
1368 table-open
1369 table-buffer table-orig-buffer
1370 ind
1371 rpl path attr desc descp desc1 desc2 link
1372 snumber fnc
1373 footnotes footref-seen
1374 href)
1375
1376 (let ((inhibit-read-only t))
1377 (org-unmodified
1378 (remove-text-properties (point-min) (point-max)
1379 '(:org-license-to-kill t))))
1380
1381 (message "Exporting...")
1382
1383 (setq org-min-level (org-get-min-level lines level-offset))
1384 (setq org-last-level org-min-level)
1385 (org-init-section-numbers)
1386
1387 (cond
1388 ((and date (string-match "%" date))
1389 (setq date (format-time-string date)))
1390 (date)
1391 (t (setq date (format-time-string org-export-html-date-format-string))))
1392
1393 ;; Get the language-dependent settings
1394 (setq lang-words (or (assoc language org-export-language-setup)
1395 (assoc "en" org-export-language-setup)))
1396
1397 ;; Switch to the output buffer
1398 (set-buffer buffer)
1399 (let ((inhibit-read-only t)) (erase-buffer))
1400 (fundamental-mode)
1401 (org-install-letbind)
1402
1403 (and (fboundp 'set-buffer-file-coding-system)
1404 (set-buffer-file-coding-system coding-system-for-write))
1405
1406 (let ((case-fold-search nil)
1407 (org-odd-levels-only odd))
1408 ;; create local variables for all options, to make sure all called
1409 ;; functions get the correct information
1410 (mapc (lambda (x)
1411 (set (make-local-variable (nth 2 x))
1412 (plist-get opt-plist (car x))))
1413 org-export-plist-vars)
1414 (setq umax (if arg (prefix-numeric-value arg)
1415 org-export-headline-levels))
1416 (setq umax-toc (if (integerp org-export-with-toc)
1417 (min org-export-with-toc umax)
1418 umax))
1419 (unless body-only
1420 ;; File header
1421 (insert (format
1422 "%s
1423<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
1424 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1425<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">
1426<head>
1427<title>%s</title>
1428<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
1429<meta name=\"title\" content=\"%s\"/>
1430<meta name=\"generator\" content=\"Org-mode\"/>
1431<meta name=\"generated\" content=\"%s\"/>
1432<meta name=\"author\" content=\"%s\"/>
1433<meta name=\"description\" content=\"%s\"/>
1434<meta name=\"keywords\" content=\"%s\"/>
1435%s
1436%s
1437</head>
1438<body>
1439%s
1440"
1441 (format
1442 (or (and (stringp org-export-html-xml-declaration)
1443 org-export-html-xml-declaration)
1444 (cdr (assoc html-extension org-export-html-xml-declaration))
1445 (cdr (assoc "html" org-export-html-xml-declaration))
1446
1447 "")
1448 (or charset "iso-8859-1"))
1449 language language
1450 title
1451 (or charset "iso-8859-1")
1452 title date author description keywords
1453 style
1454 mathjax
1455 (if (or link-up link-home)
1456 (concat
1457 (format org-export-html-home/up-format
1458 (or link-up link-home)
1459 (or link-home link-up))
1460 "\n")
1461 "")))
1462
1463 ;; insert html preamble
1464 (when (plist-get opt-plist :html-preamble)
1465 (let ((html-pre (plist-get opt-plist :html-preamble))
1466 (html-pre-real-contents ""))
1467 (cond ((stringp html-pre)
1468 (setq html-pre-real-contents
1469 (format-spec html-pre `((?t . ,title) (?a . ,author)
1470 (?d . ,date) (?e . ,email)))))
1471 ((functionp html-pre)
1472 (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
1473 (if (stringp (funcall html-pre)) (insert (funcall html-pre)))
1474 (insert "\n</div>\n"))
1475 (t
1476 (setq html-pre-real-contents
1477 (format-spec
1478 (or (cadr (assoc (nth 0 lang-words)
1479 org-export-html-preamble-format))
1480 (cadr (assoc "en" org-export-html-preamble-format)))
1481 `((?t . ,title) (?a . ,author)
1482 (?d . ,date) (?e . ,email))))))
1483 ;; don't output an empty preamble DIV
1484 (unless (and (functionp html-pre)
1485 (equal html-pre-real-contents ""))
1486 (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
1487 (insert html-pre-real-contents)
1488 (insert "\n</div>\n"))))
1489
1490 ;; begin wrap around body
1491 (insert (format "\n<div id=\"%s\">"
1492 ;; FIXME org-export-html-content-div is obsolete since 7.7
1493 (or org-export-html-content-div
1494 (nth 1 org-export-html-divs)))
1495 ;; FIXME this should go in the preamble but is here so
1496 ;; that org-infojs can still find it
1497 "\n<h1 class=\"title\">" title "</h1>\n"))
1498
1499 ;; insert body
1500 (if org-export-with-toc
1501 (progn
1502 (push (format "<h%d>%s</h%d>\n"
1503 org-export-html-toplevel-hlevel
1504 (nth 3 lang-words)
1505 org-export-html-toplevel-hlevel)
1506 thetoc)
1507 (push "<div id=\"text-table-of-contents\">\n" thetoc)
1508 (push "<ul>\n<li>" thetoc)
1509 (setq lines
1510 (mapcar
1511 #'(lambda (org-line)
1512 (if (and (string-match org-todo-line-regexp org-line)
1513 (not (get-text-property 0 'org-protected org-line)))
1514 ;; This is a headline
1515 (progn
1516 (setq have-headings t)
1517 (setq level (- (match-end 1) (match-beginning 1)
1518 level-offset)
1519 level (org-tr-level level)
1520 txt (save-match-data
1521 (org-html-expand
1522 (org-export-cleanup-toc-line
1523 (match-string 3 org-line))))
1524 todo
1525 (or (and org-export-mark-todo-in-toc
1526 (match-beginning 2)
1527 (not (member (match-string 2 org-line)
1528 org-done-keywords)))
1529 ; TODO, not DONE
1530 (and org-export-mark-todo-in-toc
1531 (= level umax-toc)
1532 (org-search-todo-below
1533 org-line lines level))))
1534 (if (string-match
1535 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
1536 (setq txt (replace-match
1537 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">\\1</span>" t nil txt)))
1538 (if (string-match quote-re0 txt)
1539 (setq txt (replace-match "" t t txt)))
1540 (setq snumber (org-section-number level))
1541 (if (and num (if (integerp num)
1542 (>= num level)
1543 num))
1544 (setq txt (concat snumber " " txt)))
1545 (if (<= level (max umax umax-toc))
1546 (setq head-count (+ head-count 1)))
1547 (if (<= level umax-toc)
1548 (progn
1549 (if (> level org-last-level)
1550 (progn
1551 (setq cnt (- level org-last-level))
1552 (while (>= (setq cnt (1- cnt)) 0)
1553 (push "\n<ul>\n<li>" thetoc))
1554 (push "\n" thetoc)))
1555 (if (< level org-last-level)
1556 (progn
1557 (setq cnt (- org-last-level level))
1558 (while (>= (setq cnt (1- cnt)) 0)
1559 (push "</li>\n</ul>" thetoc))
1560 (push "\n" thetoc)))
1561 ;; Check for targets
1562 (while (string-match org-any-target-regexp org-line)
1563 (setq org-line (replace-match
1564 (concat "@<span class=\"target\">"
1565 (match-string 1 org-line) "@</span> ")
1566 t t org-line)))
1567 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
1568 (setq txt (replace-match "" t t txt)))
1569 (setq href
1570 (replace-regexp-in-string
1571 "\\." "-" (format "sec-%s" snumber)))
1572 (setq href (org-solidify-link-text
1573 (or (cdr (assoc href
1574 org-export-preferred-target-alist)) href)))
1575 (push
1576 (format
1577 (if todo
1578 "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
1579 "</li>\n<li><a href=\"#%s\">%s</a>")
1580 href txt) thetoc)
1581
1582 (setq org-last-level level)))))
1583 org-line)
1584 lines))
1585 (while (> org-last-level (1- org-min-level))
1586 (setq org-last-level (1- org-last-level))
1587 (push "</li>\n</ul>\n" thetoc))
1588 (push "</div>\n" thetoc)
1589 (setq thetoc (if have-headings (nreverse thetoc) nil))))
1590
1591 (setq head-count 0)
1592 (org-init-section-numbers)
1593
1594 (org-open-par)
1595
1596 (while (setq org-line (pop lines) origline org-line)
1597 (catch 'nextline
1598
1599 ;; end of quote section?
1600 (when (and inquote (string-match org-outline-regexp-bol org-line))
1601 (insert "</pre>\n")
1602 (org-open-par)
1603 (setq inquote nil))
1604 ;; inside a quote section?
1605 (when inquote
1606 (insert (org-html-protect org-line) "\n")
1607 (throw 'nextline nil))
1608
1609 ;; Fixed-width, verbatim lines (examples)
1610 (when (and org-export-with-fixed-width
1611 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line))
1612 (when (not infixed)
1613 (setq infixed t)
1614 (org-close-par-maybe)
1615
1616 (insert "<pre class=\"example\">\n"))
1617 (insert (org-html-protect (match-string 3 org-line)) "\n")
1618 (when (or (not lines)
1619 (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
1620 (car lines))))
1621 (setq infixed nil)
1622 (insert "</pre>\n")
1623 (org-open-par))
1624 (throw 'nextline nil))
1625
1626 ;; Protected HTML
1627 (when (and (get-text-property 0 'org-protected org-line)
1628 ;; Make sure it is the entire line that is protected
1629 (not (< (or (next-single-property-change
1630 0 'org-protected org-line) 10000)
1631 (length org-line))))
1632 (let (par (ind (get-text-property 0 'original-indentation org-line)))
1633 (when (re-search-backward
1634 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
1635 (setq par (match-string 1))
1636 (replace-match "\\2\n"))
1637 (insert org-line "\n")
1638 (while (and lines
1639 (or (= (length (car lines)) 0)
1640 (not ind)
1641 (equal ind (get-text-property 0 'original-indentation (car lines))))
1642 (or (= (length (car lines)) 0)
1643 (get-text-property 0 'org-protected (car lines))))
1644 (insert (pop lines) "\n"))
1645 (and par (insert "<p>\n")))
1646 (throw 'nextline nil))
1647
1648 ;; Blockquotes, verse, and center
1649 (when (equal "ORG-BLOCKQUOTE-START" org-line)
1650 (org-close-par-maybe)
1651 (insert "<blockquote>\n")
1652 (org-open-par)
1653 (throw 'nextline nil))
1654 (when (equal "ORG-BLOCKQUOTE-END" org-line)
1655 (org-close-par-maybe)
1656 (insert "\n</blockquote>\n")
1657 (org-open-par)
1658 (throw 'nextline nil))
1659 (when (equal "ORG-VERSE-START" org-line)
1660 (org-close-par-maybe)
1661 (insert "\n<p class=\"verse\">\n")
1662 (setq org-par-open t)
1663 (setq inverse t)
1664 (throw 'nextline nil))
1665 (when (equal "ORG-VERSE-END" org-line)
1666 (insert "</p>\n")
1667 (setq org-par-open nil)
1668 (org-open-par)
1669 (setq inverse nil)
1670 (throw 'nextline nil))
1671 (when (equal "ORG-CENTER-START" org-line)
1672 (org-close-par-maybe)
1673 (insert "\n<div style=\"text-align: center\">")
1674 (org-open-par)
1675 (throw 'nextline nil))
1676 (when (equal "ORG-CENTER-END" org-line)
1677 (org-close-par-maybe)
1678 (insert "\n</div>")
1679 (org-open-par)
1680 (throw 'nextline nil))
1681 (run-hooks 'org-export-html-after-blockquotes-hook)
1682 (when inverse
1683 (let ((i (org-get-string-indentation org-line)))
1684 (if (> i 0)
1685 (setq org-line (concat (mapconcat 'identity
1686 (make-list (* 2 i) "\\nbsp") "")
1687 " " (org-trim org-line))))
1688 (unless (string-match "\\\\\\\\[ \t]*$" org-line)
1689 (setq org-line (concat org-line "\\\\")))))
1690
1691 ;; make targets to anchors
1692 (setq start 0)
1693 (while (string-match
1694 "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start)
1695 (cond
1696 ((get-text-property (match-beginning 1) 'org-protected org-line)
1697 (setq start (match-end 1)))
1698 ((match-end 2)
1699 (setq org-line (replace-match
1700 (format
1701 "@<a name=\"%s\" id=\"%s\">@</a>"
1702 (org-solidify-link-text (match-string 1 org-line))
1703 (org-solidify-link-text (match-string 1 org-line)))
1704 t t org-line)))
1705 ((and org-export-with-toc (equal (string-to-char org-line) ?*))
1706 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
1707 (setq org-line (replace-match
1708 (concat "@<span class=\"target\">"
1709 (match-string 1 org-line) "@</span> ")
1710 ;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
1711 t t org-line)))
1712 (t
1713 (setq org-line (replace-match
1714 (concat "@<a name=\""
1715 (org-solidify-link-text (match-string 1 org-line))
1716 "\" class=\"target\">" (match-string 1 org-line)
1717 "@</a> ")
1718 t t org-line)))))
1719
1720 (setq org-line (org-html-handle-time-stamps org-line))
1721
1722 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
1723 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
1724 ;; Also handle sub_superscripts and checkboxes
1725 (or (string-match org-table-hline-regexp org-line)
1726 (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line)
1727 (setq org-line (org-html-expand org-line)))
1728
1729 ;; Format the links
1730 (setq org-line (org-html-handle-links org-line opt-plist))
1731
1732 ;; TODO items
1733 (if (and org-todo-line-regexp
1734 (string-match org-todo-line-regexp org-line)
1735 (match-beginning 2))
1736
1737 (setq org-line
1738 (concat (substring org-line 0 (match-beginning 2))
1739 "<span class=\""
1740 (if (member (match-string 2 org-line)
1741 org-done-keywords)
1742 "done" "todo")
1743 " " (org-export-html-get-todo-kwd-class-name
1744 (match-string 2 org-line))
1745 "\">" (match-string 2 org-line)
1746 "</span>" (substring org-line (match-end 2)))))
1747
1748 ;; Does this contain a reference to a footnote?
1749 (when org-export-with-footnotes
1750 (setq start 0)
1751 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start)
1752 ;; Discard protected matches not clearly identified as
1753 ;; footnote markers.
1754 (if (or (get-text-property (match-beginning 2) 'org-protected org-line)
1755 (not (get-text-property (match-beginning 2) 'org-footnote org-line)))
1756 (setq start (match-end 2))
1757 (let ((n (match-string 2 org-line)) extra a)
1758 (if (setq a (assoc n footref-seen))
1759 (progn
1760 (setcdr a (1+ (cdr a)))
1761 (setq extra (format ".%d" (cdr a))))
1762 (setq extra "")
1763 (push (cons n 1) footref-seen))
1764 (setq org-line
1765 (replace-match
1766 (concat
1767 (format
1768 (concat "%s"
1769 (format org-export-html-footnote-format
1770 (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>")))
1771 (or (match-string 1 org-line) "") n extra n n)
1772 ;; If another footnote is following the
1773 ;; current one, add a separator.
1774 (if (save-match-data
1775 (string-match "\\`\\[[0-9]+\\]"
1776 (substring org-line (match-end 0))))
1777 org-export-html-footnote-separator
1778 ""))
1779 t t org-line))))))
1780
1781 (cond
1782 ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line)
1783 ;; This is a headline
1784 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1785 level-offset))
1786 txt (or (match-string 2 org-line) ""))
1787 (if (string-match quote-re0 txt)
1788 (setq txt (replace-match "" t t txt)))
1789 (if (<= level (max umax umax-toc))
1790 (setq head-count (+ head-count 1)))
1791 (setq first-heading-pos (or first-heading-pos (point)))
1792 (org-html-level-start level txt umax
1793 (and org-export-with-toc (<= level umax))
1794 head-count opt-plist)
1795
1796 ;; QUOTES
1797 (when (string-match quote-re org-line)
1798 (org-close-par-maybe)
1799 (insert "<pre>")
1800 (setq inquote t)))
1801
1802 ((and org-export-with-tables
1803 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
1804 (when (not table-open)
1805 ;; New table starts
1806 (setq table-open t table-buffer nil table-orig-buffer nil))
1807
1808 ;; Accumulate lines
1809 (setq table-buffer (cons org-line table-buffer)
1810 table-orig-buffer (cons origline table-orig-buffer))
1811 (when (or (not lines)
1812 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1813 (car lines))))
1814 (setq table-open nil
1815 table-buffer (nreverse table-buffer)
1816 table-orig-buffer (nreverse table-orig-buffer))
1817 (org-close-par-maybe)
1818 (insert (org-format-table-html table-buffer table-orig-buffer))))
1819
1820 ;; Normal lines
1821
1822 (t
1823 ;; This line either is list item or end a list.
1824 (when (get-text-property 0 'list-item org-line)
1825 (setq org-line (org-html-export-list-line
1826 org-line
1827 (get-text-property 0 'list-item org-line)
1828 (get-text-property 0 'list-struct org-line)
1829 (get-text-property 0 'list-prevs org-line))))
1830
1831 ;; Horizontal line
1832 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
1833 (if org-par-open
1834 (insert "\n</p>\n<hr/>\n<p>\n")
1835 (insert "\n<hr/>\n"))
1836 (throw 'nextline nil))
1837
1838 ;; Empty lines start a new paragraph. If hand-formatted lists
1839 ;; are not fully interpreted, lines starting with "-", "+", "*"
1840 ;; also start a new paragraph.
1841 (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par))
1842
1843 ;; Is this the start of a footnote?
1844 (when org-export-with-footnotes
1845 (when (and (boundp 'footnote-section-tag-regexp)
1846 (string-match (concat "^" footnote-section-tag-regexp)
1847 org-line))
1848 ;; ignore this line
1849 (throw 'nextline nil))
1850 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line)
1851 (org-close-par-maybe)
1852 (let ((n (match-string 1 org-line)))
1853 (setq org-par-open t
1854 org-line (replace-match
1855 (format
1856 (concat "<p class=\"footnote\">"
1857 (format org-export-html-footnote-format
1858 (concat
1859 "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
1860 n n n) t t org-line)))))
1861 ;; Check if the line break needs to be conserved
1862 (cond
1863 ((string-match "\\\\\\\\[ \t]*$" org-line)
1864 (setq org-line (replace-match "<br/>" t t org-line)))
1865 (org-export-preserve-breaks
1866 (setq org-line (concat org-line "<br/>"))))
1867
1868 ;; Check if a paragraph should be started
1869 (let ((start 0))
1870 (while (and org-par-open
1871 (string-match "\\\\par\\>" org-line start))
1872 ;; Leave a space in the </p> so that the footnote matcher
1873 ;; does not see this.
1874 (if (not (get-text-property (match-beginning 0)
1875 'org-protected org-line))
1876 (setq org-line (replace-match "</p ><p >" t t org-line)))
1877 (setq start (match-end 0))))
1878
1879 (insert org-line "\n")))))
1880
1881 ;; Properly close all local lists and other lists
1882 (when inquote
1883 (insert "</pre>\n")
1884 (org-open-par))
1885
1886 (org-html-level-start 1 nil umax
1887 (and org-export-with-toc (<= level umax))
1888 head-count opt-plist)
1889 ;; the </div> to close the last text-... div.
1890 (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
1891
1892 (save-excursion
1893 (goto-char (point-min))
1894 (while (re-search-forward
1895 "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
1896 nil t)
1897 (push (match-string 1) footnotes)
1898 (replace-match "\\4" t nil)
1899 (goto-char (match-beginning 0))))
1900 (when footnotes
1901 (insert (format org-export-html-footnotes-section
1902 (nth 4 lang-words)
1903 (mapconcat 'identity (nreverse footnotes) "\n"))
1904 "\n"))
1905 (let ((bib (org-export-html-get-bibliography)))
1906 (when bib
1907 (insert "\n" bib "\n")))
1908
1909 (unless body-only
1910 ;; end wrap around body
1911 (insert "</div>\n")
1912
1913 ;; export html postamble
1914 (let ((html-post (plist-get opt-plist :html-postamble))
1915 (email
1916 (mapconcat (lambda(e)
1917 (format "<a href=\"mailto:%s\">%s</a>" e e))
1918 (split-string email ",+ *")
1919 ", "))
1920 (creator-info
1921 (concat "<a href=\"http://orgmode.org\">Org</a> version "
1922 (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
1923 (number-to-string emacs-major-version))))
1924
1925 (when (plist-get opt-plist :html-postamble)
1926 (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n")
1927 (cond ((stringp html-post)
1928 (insert (format-spec html-post
1929 `((?a . ,author) (?e . ,email)
1930 (?d . ,date) (?c . ,creator-info)
1931 (?v . ,html-validation-link)))))
1932 ((functionp html-post)
1933 (if (stringp (funcall html-post)) (insert (funcall html-post))))
1934 ((eq html-post 'auto)
1935 ;; fall back on default postamble
1936 (when (plist-get opt-plist :time-stamp-file)
1937 (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
1938 (when (and (plist-get opt-plist :author-info) author)
1939 (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
1940 (when (and (plist-get opt-plist :email-info) email)
1941 (insert "<p class=\"email\">" email "</p>\n"))
1942 (when (plist-get opt-plist :creator-info)
1943 (insert "<p class=\"creator\">"
1944 (concat "<a href=\"http://orgmode.org\">Org</a> version "
1945 (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
1946 (number-to-string emacs-major-version) "</p>\n")))
1947 (insert html-validation-link "\n"))
1948 (t
1949 (insert (format-spec
1950 (or (cadr (assoc (nth 0 lang-words)
1951 org-export-html-postamble-format))
1952 (cadr (assoc "en" org-export-html-postamble-format)))
1953 `((?a . ,author) (?e . ,email)
1954 (?d . ,date) (?c . ,creator-info)
1955 (?v . ,html-validation-link))))))
1956 (insert "\n</div>"))))
1957
1958 ;; FIXME `org-export-html-with-timestamp' has been declared
1959 ;; obsolete since Org 7.7 -- don't forget to remove this.
1960 (if org-export-html-with-timestamp
1961 (insert org-export-html-html-helper-timestamp))
1962
1963 (unless body-only (insert "\n</body>\n</html>\n"))
1964
1965 (unless (plist-get opt-plist :buffer-will-be-killed)
1966 (normal-mode)
1967 (if (eq major-mode (default-value 'major-mode))
1968 (html-mode)))
1969
1970 ;; insert the table of contents
1971 (goto-char (point-min))
1972 (when thetoc
1973 (if (or (re-search-forward
1974 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1975 (re-search-forward
1976 "\\[TABLE-OF-CONTENTS\\]" nil t))
1977 (progn
1978 (goto-char (match-beginning 0))
1979 (replace-match ""))
1980 (goto-char first-heading-pos)
1981 (when (looking-at "\\s-*</p>")
1982 (goto-char (match-end 0))
1983 (insert "\n")))
1984 (insert "<div id=\"table-of-contents\">\n")
1985 (let ((beg (point)))
1986 (mapc 'insert thetoc)
1987 (insert "</div>\n")
1988 (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t)
1989 (replace-match ""))))
1990 ;; remove empty paragraphs
1991 (goto-char (point-min))
1992 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1993 (replace-match ""))
1994 (goto-char (point-min))
1995 ;; Convert whitespace place holders
1996 (goto-char (point-min))
1997 (let (beg end n)
1998 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1999 (setq n (get-text-property beg 'org-whitespace)
2000 end (next-single-property-change beg 'org-whitespace))
2001 (goto-char beg)
2002 (delete-region beg end)
2003 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
2004 (make-string n ?x)))))
2005 ;; Remove empty lines at the beginning of the file.
2006 (goto-char (point-min))
2007 (when (looking-at "\\s-+\n") (replace-match ""))
2008 ;; Remove display properties
2009 (remove-text-properties (point-min) (point-max) '(display t))
2010 ;; Run the hook
2011 (run-hooks 'org-export-html-final-hook)
2012 (or to-buffer (save-buffer))
2013 (goto-char (point-min))
2014 (or (org-export-push-to-kill-ring "HTML")
2015 (message "Exporting... done"))
2016 (if (eq to-buffer 'string)
2017 (prog1 (buffer-substring (point-min) (point-max))
2018 (kill-buffer (current-buffer)))
2019 (current-buffer)))))
2020
2021(defun org-export-html-format-href (s)
2022 "Make sure the S is valid as a href reference in an XHTML document."
2023 (save-match-data
2024 (let ((start 0))
2025 (while (string-match "&" s start)
2026 (setq start (+ (match-beginning 0) 3)
2027 s (replace-match "&amp;" t t s)))))
2028 s)
2029
2030(defun org-export-html-format-desc (s)
2031 "Make sure the S is valid as a description in a link."
2032 (if (and s (not (get-text-property 1 'org-protected s)))
2033 (save-match-data
2034 (org-html-do-expand s))
2035 s))
2036
2037(defun org-export-html-format-image (src par-open)
2038 "Create image tag with source and attributes."
2039 (save-match-data
2040 (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src)
2041 (format "<img src=\"%s\" alt=\"%s\"/>"
2042 src (org-find-text-property-in-string 'org-latex-src src))
2043 (let* ((caption (org-find-text-property-in-string 'org-caption src))
2044 (attr (org-find-text-property-in-string 'org-attributes src))
2045 (label (org-find-text-property-in-string 'org-label src)))
2046 (setq caption (and caption (org-html-do-expand caption)))
2047 (concat
2048 (if caption
2049 (format "%s<div %sclass=\"figure\">
2050<p>"
2051 (if org-par-open "</p>\n" "")
2052 (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
2053 (format "<img src=\"%s\"%s />"
2054 src
2055 (if (string-match "\\<alt=" (or attr ""))
2056 (concat " " attr )
2057 (concat " " attr " alt=\"" src "\"")))
2058 (if caption
2059 (format "</p>%s
2060</div>%s"
2061 (concat "\n<p>" caption "</p>")
2062 (if org-par-open "\n<p>" ""))))))))
2063
2064(defun org-export-html-get-bibliography ()
2065 "Find bibliography, cut it out and return it."
2066 (catch 'exit
2067 (let (beg end (cnt 1) bib)
2068 (save-excursion
2069 (goto-char (point-min))
2070 (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
2071 (setq beg (match-beginning 0))
2072 (while (re-search-forward "</?div\\>" nil t)
2073 (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
2074 (when (= cnt 0)
2075 (and (looking-at ">") (forward-char 1))
2076 (setq bib (buffer-substring beg (point)))
2077 (delete-region beg (point))
2078 (throw 'exit bib))))
2079 nil))))
2080
2081(defvar org-table-number-regexp) ; defined in org-table.el
2082(defun org-format-table-html (lines olines &optional no-css)
2083 "Find out which HTML converter to use and return the HTML code.
2084NO-CSS is passed to the exporter."
2085 (if (stringp lines)
2086 (setq lines (org-split-string lines "\n")))
2087 (if (string-match "^[ \t]*|" (car lines))
2088 ;; A normal org table
2089 (org-format-org-table-html lines nil no-css)
2090 ;; Table made by table.el
2091 (or (org-format-table-table-html-using-table-generate-source
2092 olines (not org-export-prefer-native-exporter-for-tables))
2093 ;; We are here only when table.el table has NO col or row
2094 ;; spanning and the user prefers using org's own converter for
2095 ;; exporting of such simple table.el tables.
2096 (org-format-table-table-html lines))))
2097
2098(defvar org-table-number-fraction) ; defined in org-table.el
2099(defun org-format-org-table-html (lines &optional splice no-css)
2100 "Format a table into HTML.
2101LINES is a list of lines. Optional argument SPLICE means, do not
2102insert header and surrounding <table> tags, just format the lines.
2103Optional argument NO-CSS means use XHTML attributes instead of CSS
2104for formatting. This is required for the DocBook exporter."
2105 (require 'org-table)
2106 ;; Get rid of hlines at beginning and end
2107 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
2108 (setq lines (nreverse lines))
2109 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
2110 (setq lines (nreverse lines))
2111 (when org-export-table-remove-special-lines
2112 ;; Check if the table has a marking column. If yes remove the
2113 ;; column and the special lines
2114 (setq lines (org-table-clean-before-export lines)))
2115
2116 (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
2117 (label (org-find-text-property-in-string 'org-label (car lines)))
2118 (col-cookies (org-find-text-property-in-string 'org-col-cookies
2119 (car lines)))
2120 (attributes (org-find-text-property-in-string 'org-attributes
2121 (car lines)))
2122 (html-table-tag (org-export-splice-attributes
2123 html-table-tag attributes))
2124 (head (and org-export-highlight-first-table-line
2125 (delq nil (mapcar
2126 (lambda (x) (string-match "^[ \t]*|-" x))
2127 (cdr lines)))))
2128 (nline 0) fnum nfields i (cnt 0)
2129 tbopen org-line fields html gr colgropen rowstart rowend
2130 ali align aligns n)
2131 (setq caption (and caption (org-html-do-expand caption)))
2132 (when (and col-cookies org-table-clean-did-remove-column)
2133 (setq col-cookies
2134 (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
2135 (if splice (setq head nil))
2136 (unless splice (push (if head "<thead>" "<tbody>") html))
2137 (setq tbopen t)
2138 (while (setq org-line (pop lines))
2139 (catch 'next-line
2140 (if (string-match "^[ \t]*|-" org-line)
2141 (progn
2142 (unless splice
2143 (push (if head "</thead>" "</tbody>") html)
2144 (if lines (push "<tbody>" html) (setq tbopen nil)))
2145 (setq head nil) ;; head ends here, first time around
2146 ;; ignore this line
2147 (throw 'next-line t)))
2148 ;; Break the line into fields
2149 (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
2150 (unless fnum (setq fnum (make-vector (length fields) 0)
2151 nfields (length fnum)))
2152 (setq nline (1+ nline) i -1
2153 rowstart (eval (car org-export-table-row-tags))
2154 rowend (eval (cdr org-export-table-row-tags)))
2155 (push (concat rowstart
2156 (mapconcat
2157 (lambda (x)
2158 (setq i (1+ i) ali (format "@@class%03d@@" i))
2159 (if (and (< i nfields) ; make sure no rogue line causes an error here
2160 (string-match org-table-number-regexp x))
2161 (incf (aref fnum i)))
2162 (cond
2163 (head
2164 (concat
2165 (format (car org-export-table-header-tags)
2166 "col" ali)
2167 x
2168 (cdr org-export-table-header-tags)))
2169 ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
2170 (concat
2171 (format (car org-export-table-header-tags)
2172 "row" ali)
2173 x
2174 (cdr org-export-table-header-tags)))
2175 (t
2176 (concat (format (car org-export-table-data-tags) ali)
2177 x
2178 (cdr org-export-table-data-tags)))))
2179 fields "")
2180 rowend)
2181 html)))
2182 (unless splice (if tbopen (push "</tbody>" html)))
2183 (unless splice (push "</table>\n" html))
2184 (setq html (nreverse html))
2185 (unless splice
2186 ;; Put in col tags with the alignment (unfortunately often ignored...)
2187 (unless (car org-table-colgroup-info)
2188 (setq org-table-colgroup-info
2189 (cons :start (cdr org-table-colgroup-info))))
2190 (setq i 0)
2191 (push (mapconcat
2192 (lambda (x)
2193 (setq gr (pop org-table-colgroup-info)
2194 i (1+ i)
2195 align (if (nth 1 (assoc i col-cookies))
2196 (cdr (assoc (nth 1 (assoc i col-cookies))
2197 '(("l" . "left") ("r" . "right")
2198 ("c" . "center"))))
2199 (if (> (/ (float x) nline)
2200 org-table-number-fraction)
2201 "right" "left")))
2202 (push align aligns)
2203 (format (if no-css
2204 "%s<col align=\"%s\" />%s"
2205 "%s<col class=\"%s\" />%s")
2206 (if (memq gr '(:start :startend))
2207 (prog1
2208 (if colgropen
2209 "</colgroup>\n<colgroup>"
2210 "<colgroup>")
2211 (setq colgropen t))
2212 "")
2213 align
2214 (if (memq gr '(:end :startend))
2215 (progn (setq colgropen nil) "</colgroup>")
2216 "")))
2217 fnum "")
2218 html)
2219 (setq aligns (nreverse aligns))
2220 (if colgropen (setq html (cons (car html)
2221 (cons "</colgroup>" (cdr html)))))
2222 ;; Since the output of HTML table formatter can also be used in
2223 ;; DocBook document, include empty captions for the DocBook
2224 ;; export only so that it produces valid XML.
2225 (when (or caption (eq org-export-current-backend 'docbook))
2226 (push (format "<caption>%s</caption>" (or caption "")) html))
2227 (when label
2228 (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
2229 (push html-table-tag html))
2230 (setq html (mapcar
2231 (lambda (x)
2232 (replace-regexp-in-string
2233 "@@class\\([0-9]+\\)@@"
2234 (lambda (txt)
2235 (if (not org-export-html-table-align-individual-fields)
2236 ""
2237 (setq n (string-to-number (match-string 1 txt)))
2238 (format (if no-css " align=\"%s\"" " class=\"%s\"")
2239 (or (nth n aligns) "left"))))
2240 x))
2241 html))
2242 (concat (mapconcat 'identity html "\n") "\n")))
2243
2244(defun org-export-splice-attributes (tag attributes)
2245 "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
2246 (if (not attributes)
2247 tag
2248 (let (oldatt newatt)
2249 (setq oldatt (org-extract-attributes-from-string tag)
2250 tag (pop oldatt)
2251 newatt (cdr (org-extract-attributes-from-string attributes)))
2252 (while newatt
2253 (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
2254 (if (string-match ">" tag)
2255 (setq tag
2256 (replace-match (concat (org-attributes-to-string oldatt) ">")
2257 t t tag)))
2258 tag)))
2259
2260(defun org-format-table-table-html (lines)
2261 "Format a table generated by table.el into HTML.
2262This conversion does *not* use `table-generate-source' from table.el.
2263This has the advantage that Org-mode's HTML conversions can be used.
2264But it has the disadvantage, that no cell- or row-spanning is allowed."
2265 (let (org-line field-buffer
2266 (head org-export-highlight-first-table-line)
2267 fields html empty i)
2268 (setq html (concat html-table-tag "\n"))
2269 (while (setq org-line (pop lines))
2270 (setq empty "&nbsp;")
2271 (catch 'next-line
2272 (if (string-match "^[ \t]*\\+-" org-line)
2273 (progn
2274 (if field-buffer
2275 (progn
2276 (setq
2277 html
2278 (concat
2279 html
2280 "<tr>"
2281 (mapconcat
2282 (lambda (x)
2283 (if (equal x "") (setq x empty))
2284 (if head
2285 (concat
2286 (format (car org-export-table-header-tags) "col" "")
2287 x
2288 (cdr org-export-table-header-tags))
2289 (concat (format (car org-export-table-data-tags) "") x
2290 (cdr org-export-table-data-tags))))
2291 field-buffer "\n")
2292 "</tr>\n"))
2293 (setq head nil)
2294 (setq field-buffer nil)))
2295 ;; Ignore this line
2296 (throw 'next-line t)))
2297 ;; Break the line into fields and store the fields
2298 (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
2299 (if field-buffer
2300 (setq field-buffer (mapcar
2301 (lambda (x)
2302 (concat x "<br/>" (pop fields)))
2303 field-buffer))
2304 (setq field-buffer fields))))
2305 (setq html (concat html "</table>\n"))
2306 html))
2307
2308(defun org-format-table-table-html-using-table-generate-source (lines
2309 &optional
2310 spanned-only)
2311 "Format a table into html, using `table-generate-source' from table.el.
2312Use SPANNED-ONLY to suppress exporting of simple table.el tables.
2313
2314When SPANNED-ONLY is nil, all table.el tables are exported. When
2315SPANNED-ONLY is non-nil, only tables with either row or column
2316spans are exported.
2317
2318This routine returns the generated source or nil as appropriate.
2319
2320Refer docstring of `org-export-prefer-native-exporter-for-tables'
2321for further information."
2322 (require 'table)
2323 (with-current-buffer (get-buffer-create " org-tmp1 ")
2324 (erase-buffer)
2325 (insert (mapconcat 'identity lines "\n"))
2326 (goto-char (point-min))
2327 (if (not (re-search-forward "|[^+]" nil t))
2328 (error "Error processing table"))
2329 (table-recognize-table)
2330 (when (or (not spanned-only)
2331 (let* ((dim (table-query-dimension))
2332 (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
2333 (not (= (* c r) cells))))
2334 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
2335 (table-generate-source 'html " org-tmp2 ")
2336 (set-buffer " org-tmp2 ")
2337 (buffer-substring (point-min) (point-max)))))
2338
2339(defun org-export-splice-style (style extra)
2340 "Splice EXTRA into STYLE, just before \"</style>\"."
2341 (if (and (stringp extra)
2342 (string-match "\\S-" extra)
2343 (string-match "</style>" style))
2344 (concat (substring style 0 (match-beginning 0))
2345 "\n" extra "\n"
2346 (substring style (match-beginning 0)))
2347 style))
2348
2349(defun org-html-handle-time-stamps (s)
2350 "Format time stamps in string S, or remove them."
2351 (catch 'exit
2352 (let (r b)
2353 (when org-maybe-keyword-time-regexp
2354 (while (string-match org-maybe-keyword-time-regexp s)
2355 (or b (setq b (substring s 0 (match-beginning 0))))
2356 (setq r (concat
2357 r (substring s 0 (match-beginning 0))
2358 " @<span class=\"timestamp-wrapper\">"
2359 (if (match-end 1)
2360 (format "@<span class=\"timestamp-kwd\">%s @</span>"
2361 (match-string 1 s)))
2362 (format " @<span class=\"timestamp\">%s@</span>"
2363 (substring
2364 (org-translate-time (match-string 3 s)) 1 -1))
2365 "@</span>")
2366 s (substring s (match-end 0)))))
2367 ;; Line break if line started and ended with time stamp stuff
2368 (if (not r)
2369 s
2370 (setq r (concat r s))
2371 (unless (string-match "\\S-" (concat b s))
2372 (setq r (concat r "@<br/>")))
2373 r))))
2374
2375(defvar htmlize-buffer-places) ; from htmlize.el
2376(defun org-export-htmlize-region-for-paste (beg end)
2377 "Convert the region to HTML, using htmlize.el.
2378This is much like `htmlize-region-for-paste', only that it uses
2379the settings define in the org-... variables."
2380 (let* ((htmlize-output-type org-export-htmlize-output-type)
2381 (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
2382 (htmlbuf (htmlize-region beg end)))
2383 (unwind-protect
2384 (with-current-buffer htmlbuf
2385 (buffer-substring (plist-get htmlize-buffer-places 'content-start)
2386 (plist-get htmlize-buffer-places 'content-end)))
2387 (kill-buffer htmlbuf))))
2388
2389(defun org-export-htmlize-generate-css ()
2390 "Create the CSS for all font definitions in the current Emacs session.
2391Use this to create face definitions in your CSS style file that can then
2392be used by code snippets transformed by htmlize.
2393This command just produces a buffer that contains class definitions for all
2394faces used in the current Emacs session. You can copy and paste the ones you
2395need into your CSS file.
2396
2397If you then set `org-export-htmlize-output-type' to `css', calls to
2398the function `org-export-htmlize-region-for-paste' will produce code
2399that uses these same face definitions."
2400 (interactive)
2401 (require 'htmlize)
2402 (and (get-buffer "*html*") (kill-buffer "*html*"))
2403 (with-temp-buffer
2404 (let ((fl (face-list))
2405 (htmlize-css-name-prefix "org-")
2406 (htmlize-output-type 'css)
2407 f i)
2408 (while (setq f (pop fl)
2409 i (and f (face-attribute f :inherit)))
2410 (when (and (symbolp f) (or (not i) (not (listp i))))
2411 (insert (org-add-props (copy-sequence "1") nil 'face f))))
2412 (htmlize-region (point-min) (point-max))))
2413 (org-pop-to-buffer-same-window "*html*")
2414 (goto-char (point-min))
2415 (if (re-search-forward "<style" nil t)
2416 (delete-region (point-min) (match-beginning 0)))
2417 (if (re-search-forward "</style>" nil t)
2418 (delete-region (1+ (match-end 0)) (point-max)))
2419 (beginning-of-line 1)
2420 (if (looking-at " +") (replace-match ""))
2421 (goto-char (point-min)))
2422
2423(defun org-html-protect (s)
2424 "Convert characters to HTML equivalent.
2425Possible conversions are set in `org-export-html-protect-char-alist'."
2426 (let ((cl org-export-html-protect-char-alist) c)
2427 (while (setq c (pop cl))
2428 (let ((start 0))
2429 (while (string-match (car c) s start)
2430 (setq s (replace-match (cdr c) t t s)
2431 start (1+ (match-beginning 0))))))
2432 s))
2433
2434(defun org-html-expand (string)
2435 "Prepare STRING for HTML export. Apply all active conversions.
2436If there are links in the string, don't modify these. If STRING
2437is nil, return nil."
2438 (when string
2439 (let* ((re (concat org-bracket-link-regexp "\\|"
2440 (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
2441 m s l res)
2442 (while (setq m (string-match re string))
2443 (setq s (substring string 0 m)
2444 l (match-string 0 string)
2445 string (substring string (match-end 0)))
2446 (push (org-html-do-expand s) res)
2447 (push l res))
2448 (push (org-html-do-expand string) res)
2449 (apply 'concat (nreverse res)))))
2450
2451(defun org-html-do-expand (s)
2452 "Apply all active conversions to translate special ASCII to HTML."
2453 (setq s (org-html-protect s))
2454 (if org-export-html-expand
2455 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
2456 (setq s (replace-match "<\\1>" t nil s))))
2457 (if org-export-with-emphasize
2458 (setq s (org-export-html-convert-emphasize s)))
2459 (if org-export-with-special-strings
2460 (setq s (org-export-html-convert-special-strings s)))
2461 (if org-export-with-sub-superscripts
2462 (setq s (org-export-html-convert-sub-super s)))
2463 (if org-export-with-TeX-macros
2464 (let ((start 0) wd rep)
2465 (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
2466 s start))
2467 (if (get-text-property (match-beginning 0) 'org-protected s)
2468 (setq start (match-end 0))
2469 (setq wd (match-string 1 s))
2470 (if (setq rep (org-entity-get-representation wd 'html))
2471 (setq s (replace-match rep t t s))
2472 (setq start (+ start (length wd))))))))
2473 s)
2474
2475(defun org-export-html-convert-special-strings (string)
2476 "Convert special characters in STRING to HTML."
2477 (let ((all org-export-html-special-string-regexps)
2478 e a re rpl start)
2479 (while (setq a (pop all))
2480 (setq re (car a) rpl (cdr a) start 0)
2481 (while (string-match re string start)
2482 (if (get-text-property (match-beginning 0) 'org-protected string)
2483 (setq start (match-end 0))
2484 (setq string (replace-match rpl t nil string)))))
2485 string))
2486
2487(defun org-export-html-convert-sub-super (string)
2488 "Convert sub- and superscripts in STRING to HTML."
2489 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
2490 (while (string-match org-match-substring-regexp string s)
2491 (cond
2492 ((and requireb (match-end 8)) (setq s (match-end 2)))
2493 ((get-text-property (match-beginning 2) 'org-protected string)
2494 (setq s (match-end 2)))
2495 (t
2496 (setq s (match-end 1)
2497 key (if (string= (match-string 2 string) "_") "sub" "sup")
2498 c (or (match-string 8 string)
2499 (match-string 6 string)
2500 (match-string 5 string))
2501 string (replace-match
2502 (concat (match-string 1 string)
2503 "<" key ">" c "</" key ">")
2504 t t string)))))
2505 (while (string-match "\\\\\\([_^]\\)" string)
2506 (setq string (replace-match (match-string 1 string) t t string)))
2507 string))
2508
2509(defun org-export-html-convert-emphasize (string)
2510 "Apply emphasis."
2511 (let ((s 0) rpl)
2512 (while (string-match org-emph-re string s)
2513 (if (not (equal
2514 (substring string (match-beginning 3) (1+ (match-beginning 3)))
2515 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
2516 (setq s (match-beginning 0)
2517 rpl
2518 (concat
2519 (match-string 1 string)
2520 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
2521 (match-string 4 string)
2522 (nth 3 (assoc (match-string 3 string)
2523 org-emphasis-alist))
2524 (match-string 5 string))
2525 string (replace-match rpl t t string)
2526 s (+ s (- (length rpl) 2)))
2527 (setq s (1+ s))))
2528 string))
2529
2530(defun org-open-par ()
2531 "Insert <p>, but first close previous paragraph if any."
2532 (org-close-par-maybe)
2533 (insert "\n<p>")
2534 (setq org-par-open t))
2535(defun org-close-par-maybe ()
2536 "Close paragraph if there is one open."
2537 (when org-par-open
2538 (insert "</p>")
2539 (setq org-par-open nil)))
2540(defun org-close-li (&optional type)
2541 "Close <li> if necessary."
2542 (org-close-par-maybe)
2543 (insert (if (equal type "d") "</dd>\n" "</li>\n")))
2544
2545(defvar body-only) ; dynamically scoped into this.
2546(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist)
2547 "Insert a new level in HTML export.
2548When TITLE is nil, just close all open levels."
2549 (org-close-par-maybe)
2550 (let* ((target (and title (org-get-text-property-any 0 'target title)))
2551 (extra-targets (and target
2552 (assoc target org-export-target-aliases)))
2553 (extra-class (and title (org-get-text-property-any 0 'html-container-class title)))
2554 (preferred (and target
2555 (cdr (assoc target org-export-preferred-target-alist))))
2556 (l org-level-max)
2557 (num (plist-get opt-plist :section-numbers))
2558 snumber snu href suffix)
2559 (setq extra-targets (remove (or preferred target) extra-targets))
2560 (setq extra-targets
2561 (mapconcat (lambda (x)
2562 (setq x (org-solidify-link-text
2563 (if (org-uuidgen-p x) (concat "ID-" x) x)))
2564 (if (stringp org-export-html-headline-anchor-format)
2565 (format org-export-html-headline-anchor-format x x)
2566 ""))
2567 extra-targets
2568 ""))
2569 (while (>= l level)
2570 (if (aref org-levels-open (1- l))
2571 (progn
2572 (org-html-level-close l umax)
2573 (aset org-levels-open (1- l) nil)))
2574 (setq l (1- l)))
2575 (when title
2576 ;; If title is nil, this means this function is called to close
2577 ;; all levels, so the rest is done only if title is given
2578 (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
2579 (setq title (replace-match
2580 (if org-export-with-tags
2581 (save-match-data
2582 (concat
2583 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
2584 (mapconcat
2585 (lambda (x)
2586 (format "<span class=\"%s\">%s</span>"
2587 (org-export-html-get-tag-class-name x)
2588 x))
2589 (org-split-string (match-string 1 title) ":")
2590 "&nbsp;")
2591 "</span>"))
2592 "")
2593 t t title)))
2594 (if (> level umax)
2595 (progn
2596 (if (aref org-levels-open (1- level))
2597 (progn
2598 (org-close-li)
2599 (if target
2600 (insert (format "<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
2601 extra-targets title "<br/>\n")
2602 (insert "<li>" title "<br/>\n")))
2603 (aset org-levels-open (1- level) t)
2604 (org-close-par-maybe)
2605 (if target
2606 (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
2607 extra-targets title "<br/>\n")
2608 (insert "<ul>\n<li>" title "<br/>\n"))))
2609 (aset org-levels-open (1- level) t)
2610 (setq snumber (org-section-number level)
2611 snu (replace-regexp-in-string "\\." "-" snumber))
2612 (setq level (+ level org-export-html-toplevel-hlevel -1))
2613 (if (and num (not body-only))
2614 (setq title (concat
2615 (format "<span class=\"section-number-%d\">%s</span>"
2616 level
2617 (if (and num
2618 (if (integerp num)
2619 ;; fix up num to take into
2620 ;; account the top-level
2621 ;; heading value
2622 (>= (+ num org-export-html-toplevel-hlevel -1)
2623 level)
2624 num))
2625 snumber
2626 ""))
2627 " " title)))
2628 (unless (= head-count 1) (insert "\n</div>\n"))
2629 (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist)))
2630 (setq suffix (org-solidify-link-text (or href snu)))
2631 (setq href (org-solidify-link-text (or href (concat "sec-" snu))))
2632 (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
2633 suffix level (if extra-class (concat " " extra-class) "")
2634 level href
2635 extra-targets
2636 title level level suffix))
2637 (org-open-par)))))
2638
2639(defun org-export-html-get-tag-class-name (tag)
2640 "Turn tag into a valid class name.
2641Replaces invalid characters with \"_\" and then prepends a prefix."
2642 (save-match-data
2643 (while (string-match "[^a-zA-Z0-9_]" tag)
2644 (setq tag (replace-match "_" t t tag))))
2645 (concat org-export-html-tag-class-prefix tag))
2646
2647(defun org-export-html-get-todo-kwd-class-name (kwd)
2648 "Turn todo keyword into a valid class name.
2649Replaces invalid characters with \"_\" and then prepends a prefix."
2650 (save-match-data
2651 (while (string-match "[^a-zA-Z0-9_]" kwd)
2652 (setq kwd (replace-match "_" t t kwd))))
2653 (concat org-export-html-todo-kwd-class-prefix kwd))
2654
2655(defun org-html-level-close (level max-outline-level)
2656 "Terminate one level in HTML export."
2657 (if (<= level max-outline-level)
2658 (insert "</div>\n")
2659 (org-close-li)
2660 (insert "</ul>\n")))
2661
2662(defun org-html-export-list-line (org-line pos struct prevs)
2663 "Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
2664
2665POS is the item position or org-line position the org-line had before
2666modifications to buffer. STRUCT is the list structure. PREVS is
2667the alist of previous items."
2668 (let* ((get-type
2669 (function
2670 ;; Translate type of list containing POS to "d", "o" or
2671 ;; "u".
2672 (lambda (pos struct prevs)
2673 (let ((type (org-list-get-list-type pos struct prevs)))
2674 (cond
2675 ((eq 'ordered type) "o")
2676 ((eq 'descriptive type) "d")
2677 (t "u"))))))
2678 (get-closings
2679 (function
2680 ;; Return list of all items and sublists ending at POS, in
2681 ;; reverse order.
2682 (lambda (pos)
2683 (let (out)
2684 (catch 'exit
2685 (mapc (lambda (e)
2686 (let ((end (nth 6 e))
2687 (item (car e)))
2688 (cond
2689 ((= end pos) (push item out))
2690 ((>= item pos) (throw 'exit nil)))))
2691 struct))
2692 out)))))
2693 ;; First close any previous item, or list, ending at POS.
2694 (mapc (lambda (e)
2695 (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
2696 (first-item (org-list-get-list-begin e struct prevs))
2697 (type (funcall get-type first-item struct prevs)))
2698 (org-close-par-maybe)
2699 ;; Ending for every item
2700 (org-close-li type)
2701 ;; We're ending last item of the list: end list.
2702 (when lastp
2703 (insert (format "</%sl>\n" type))
2704 (org-open-par))))
2705 (funcall get-closings pos))
2706 (cond
2707 ;; At an item: insert appropriate tags in export buffer.
2708 ((assq pos struct)
2709 (string-match
2710 (concat "[ \t]*\\(\\S-+[ \t]*\\)"
2711 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
2712 "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
2713 "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
2714 "\\(.*\\)") org-line)
2715 (let* ((checkbox (match-string 3 org-line))
2716 (desc-tag (or (match-string 4 org-line) "???"))
2717 (body (or (match-string 5 org-line) ""))
2718 (list-beg (org-list-get-list-begin pos struct prevs))
2719 (firstp (= list-beg pos))
2720 ;; Always refer to first item to determine list type, in
2721 ;; case list is ill-formed.
2722 (type (funcall get-type list-beg struct prevs))
2723 (counter (let ((count-tmp (org-list-get-counter pos struct)))
2724 (cond
2725 ((not count-tmp) nil)
2726 ((string-match "[A-Za-z]" count-tmp)
2727 (- (string-to-char (upcase count-tmp)) 64))
2728 ((string-match "[0-9]+" count-tmp)
2729 count-tmp)))))
2730 (when firstp
2731 (org-close-par-maybe)
2732 (insert (format "<%sl>\n" type)))
2733 (insert (cond
2734 ((equal type "d")
2735 (format "<dt>%s</dt><dd>" desc-tag))
2736 ((and (equal type "o") counter)
2737 (format "<li value=\"%s\">" counter))
2738 (t "<li>")))
2739 ;; If line had a checkbox, some additional modification is required.
2740 (when checkbox
2741 (setq body
2742 (concat
2743 (cond
2744 ((string-match "X" checkbox) "<code>[X]</code> ")
2745 ((string-match " " checkbox) "<code>[&nbsp;]</code> ")
2746 (t "<code>[-]</code> "))
2747 body)))
2748 ;; Return modified line
2749 body))
2750 ;; At a list ender: go to next line (side-effects only).
2751 ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil))
2752 ;; Not at an item: return line unchanged (side-effects only).
2753 (t org-line))))
2754
2755(provide 'org-html)
2756
2757;; Local variables:
2758;; generated-autoload-file: "org-loaddefs.el"
2759;; End:
2760
2761;;; org-html.el ends here
diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el
deleted file mode 100644
index 12cd0584fa0..00000000000
--- a/lisp/org/org-icalendar.el
+++ /dev/null
@@ -1,692 +0,0 @@
1;;; org-icalendar.el --- iCalendar export for Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;;; Code:
28
29(require 'org-exp)
30
31(eval-when-compile (require 'cl))
32
33(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
34
35(defgroup org-export-icalendar nil
36 "Options specific for iCalendar export of Org-mode files."
37 :tag "Org Export iCalendar"
38 :group 'org-export)
39
40(defcustom org-combined-agenda-icalendar-file "~/org.ics"
41 "The file name for the iCalendar file covering all agenda files.
42This file is created with the command \\[org-export-icalendar-all-agenda-files].
43The file name should be absolute, the file will be overwritten without warning."
44 :group 'org-export-icalendar
45 :type 'file)
46
47(defcustom org-icalendar-alarm-time 0
48 "Number of minutes for triggering an alarm for exported timed events.
49A zero value (the default) turns off the definition of an alarm trigger
50for timed events. If non-zero, alarms are created.
51
52- a single alarm per entry is defined
53- The alarm will go off N minutes before the event
54- only a DISPLAY action is defined."
55 :group 'org-export-icalendar
56 :version "24.1"
57 :type 'integer)
58
59(defcustom org-icalendar-combined-name "OrgMode"
60 "Calendar name for the combined iCalendar representing all agenda files."
61 :group 'org-export-icalendar
62 :type 'string)
63
64(defcustom org-icalendar-combined-description nil
65 "Calendar description for the combined iCalendar (all agenda files)."
66 :group 'org-export-icalendar
67 :version "24.1"
68 :type 'string)
69
70(defcustom org-icalendar-use-plain-timestamp t
71 "Non-nil means make an event from every plain time stamp."
72 :group 'org-export-icalendar
73 :type 'boolean)
74
75(defcustom org-icalendar-honor-noexport-tag nil
76 "Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
77 :group 'org-export-icalendar
78 :version "24.1"
79 :type 'boolean)
80
81(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
82 "Contexts where iCalendar export should use a deadline time stamp.
83This is a list with several symbols in it. Valid symbol are:
84
85event-if-todo Deadlines in TODO entries become calendar events.
86event-if-not-todo Deadlines in non-TODO entries become calendar events.
87todo-due Use deadlines in TODO entries as due-dates"
88 :group 'org-export-icalendar
89 :type '(set :greedy t
90 (const :tag "Deadlines in non-TODO entries become events"
91 event-if-not-todo)
92 (const :tag "Deadline in TODO entries become events"
93 event-if-todo)
94 (const :tag "Deadlines in TODO entries become due-dates"
95 todo-due)))
96
97(defcustom org-icalendar-use-scheduled '(todo-start)
98 "Contexts where iCalendar export should use a scheduling time stamp.
99This is a list with several symbols in it. Valid symbol are:
100
101event-if-todo Scheduling time stamps in TODO entries become an event.
102event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
103todo-start Scheduling time stamps in TODO entries become start date.
104 Some calendar applications show TODO entries only after
105 that date."
106 :group 'org-export-icalendar
107 :type '(set :greedy t
108 (const :tag
109 "SCHEDULED timestamps in non-TODO entries become events"
110 event-if-not-todo)
111 (const :tag "SCHEDULED timestamps in TODO entries become events"
112 event-if-todo)
113 (const :tag "SCHEDULED in TODO entries become start date"
114 todo-start)))
115
116(defcustom org-icalendar-categories '(local-tags category)
117 "Items that should be entered into the categories field.
118This is a list of symbols, the following are valid:
119
120category The Org-mode category of the current file or tree
121todo-state The todo state, if any
122local-tags The tags, defined in the current line
123all-tags All tags, including inherited ones."
124 :group 'org-export-icalendar
125 :type '(repeat
126 (choice
127 (const :tag "The file or tree category" category)
128 (const :tag "The TODO state" todo-state)
129 (const :tag "Tags defined in current line" local-tags)
130 (const :tag "All tags, including inherited ones" all-tags))))
131
132(defcustom org-icalendar-include-todo nil
133 "Non-nil means export to iCalendar files should also cover TODO items.
134Valid values are:
135nil don't include any TODO items
136t include all TODO items that are not in a DONE state
137unblocked include all TODO items that are not blocked
138all include both done and not done items."
139 :group 'org-export-icalendar
140 :type '(choice
141 (const :tag "None" nil)
142 (const :tag "Unfinished" t)
143 (const :tag "Unblocked" unblocked)
144 (const :tag "All" all)))
145
146(defvar org-icalendar-verify-function nil
147 "Function to verify entries for iCalendar export.
148This can be set to a function that will be called at each entry that
149is considered for export to iCalendar. When the function returns nil,
150the entry will be skipped. When it returns a non-nil value, the entry
151will be considered for export.
152This is used internally when an agenda buffer is exported to an ics file,
153to make sure that only entries currently listed in the agenda will end
154up in the ics file. But for normal iCalendar export, you can use this
155for whatever you need.")
156
157(defcustom org-icalendar-include-bbdb-anniversaries nil
158 "Non-nil means a combined iCalendar files should include anniversaries.
159The anniversaries are define in the BBDB database."
160 :group 'org-export-icalendar
161 :type 'boolean)
162
163(defcustom org-icalendar-include-sexps t
164 "Non-nil means export to iCalendar files should also cover sexp entries.
165These are entries like in the diary, but directly in an Org-mode file."
166 :group 'org-export-icalendar
167 :type 'boolean)
168
169(defcustom org-icalendar-include-body 100
170 "Amount of text below headline to be included in iCalendar export.
171This is a number of characters that should maximally be included.
172Properties, scheduling and clocking lines will always be removed.
173The text will be inserted into the DESCRIPTION field."
174 :group 'org-export-icalendar
175 :type '(choice
176 (const :tag "Nothing" nil)
177 (const :tag "Everything" t)
178 (integer :tag "Max characters")))
179
180(defcustom org-icalendar-store-UID nil
181 "Non-nil means store any created UIDs in properties.
182The iCalendar standard requires that all entries have a unique identifier.
183Org will create these identifiers as needed. When this variable is non-nil,
184the created UIDs will be stored in the ID property of the entry. Then the
185next time this entry is exported, it will be exported with the same UID,
186superseding the previous form of it. This is essential for
187synchronization services.
188This variable is not turned on by default because we want to avoid creating
189a property drawer in every entry if people are only playing with this feature,
190or if they are only using it locally."
191 :group 'org-export-icalendar
192 :type 'boolean)
193
194(defcustom org-icalendar-timezone (getenv "TZ")
195 "The time zone string for iCalendar export.
196When nil or the empty string, use output from \(current-time-zone\)."
197 :group 'org-export-icalendar
198 :type '(choice
199 (const :tag "Unspecified" nil)
200 (string :tag "Time zone")))
201
202;; Backward compatibility with previous variable
203(defvar org-icalendar-use-UTC-date-time nil)
204(defcustom org-icalendar-date-time-format
205 (if org-icalendar-use-UTC-date-time
206 ":%Y%m%dT%H%M%SZ"
207 ":%Y%m%dT%H%M%S")
208 "Format-string for exporting icalendar DATE-TIME.
209See `format-time-string' for a full documentation. The only
210difference is that `org-icalendar-timezone' is used for %Z.
211
212Interesting value are:
213 - \":%Y%m%dT%H%M%S\" for local time
214 - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
215 - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
216
217 :group 'org-export-icalendar
218 :version "24.1"
219 :type '(choice
220 (const :tag "Local time" ":%Y%m%dT%H%M%S")
221 (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
222 (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
223 (string :tag "Explicit format")))
224
225(defun org-icalendar-use-UTC-date-timep ()
226 (char-equal (elt org-icalendar-date-time-format
227 (1- (length org-icalendar-date-time-format))) ?Z))
228
229;;; iCalendar export
230
231;;;###autoload
232(defun org-export-icalendar-this-file ()
233 "Export current file as an iCalendar file.
234The iCalendar file will be located in the same directory as the Org-mode
235file, but with extension `.ics'."
236 (interactive)
237 (org-export-icalendar nil buffer-file-name))
238
239;;;###autoload
240(defun org-export-icalendar-all-agenda-files ()
241 "Export all files in the variable `org-agenda-files' to iCalendar .ics files.
242Each iCalendar file will be located in the same directory as the Org-mode
243file, but with extension `.ics'."
244 (interactive)
245 (apply 'org-export-icalendar nil (org-agenda-files t)))
246
247;;;###autoload
248(defun org-export-icalendar-combine-agenda-files ()
249 "Export all files in `org-agenda-files' to a single combined iCalendar file.
250The file is stored under the name `org-combined-agenda-icalendar-file'."
251 (interactive)
252 (apply 'org-export-icalendar t (org-agenda-files t)))
253
254(defun org-export-icalendar (combine &rest files)
255 "Create iCalendar files for all elements of FILES.
256If COMBINE is non-nil, combine all calendar entries into a single large
257file and store it under the name `org-combined-agenda-icalendar-file'."
258 (save-excursion
259 (org-agenda-prepare-buffers files)
260 (let* ((dir (org-export-directory
261 :ical (list :publishing-directory
262 org-export-publishing-directory)))
263 file ical-file ical-buffer category started org-agenda-new-buffers)
264 (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
265 (when combine
266 (setq ical-file
267 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
268 org-combined-agenda-icalendar-file
269 (expand-file-name org-combined-agenda-icalendar-file dir))
270 ical-buffer (org-get-agenda-file-buffer ical-file))
271 (set-buffer ical-buffer) (erase-buffer))
272 (while (setq file (pop files))
273 (catch 'nextfile
274 (org-check-agenda-file file)
275 (set-buffer (org-get-agenda-file-buffer file))
276 (unless combine
277 (setq ical-file (concat (file-name-as-directory dir)
278 (file-name-sans-extension
279 (file-name-nondirectory buffer-file-name))
280 ".ics"))
281 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
282 (with-current-buffer ical-buffer (erase-buffer)))
283 (setq category (or org-category
284 (file-name-sans-extension
285 (file-name-nondirectory buffer-file-name))))
286 (if (symbolp category) (setq category (symbol-name category)))
287 (let ((standard-output ical-buffer))
288 (if combine
289 (and (not started) (setq started t)
290 (org-icalendar-start-file org-icalendar-combined-name))
291 (org-icalendar-start-file category))
292 (org-icalendar-print-entries combine)
293 (when (or (and combine (not files)) (not combine))
294 (when (and combine org-icalendar-include-bbdb-anniversaries)
295 (require 'org-bbdb)
296 (org-bbdb-anniv-export-ical))
297 (org-icalendar-finish-file)
298 (set-buffer ical-buffer)
299 (run-hooks 'org-before-save-iCalendar-file-hook)
300 (save-buffer)
301 (run-hooks 'org-after-save-iCalendar-file-hook)
302 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))))
303 (org-release-buffers org-agenda-new-buffers))))
304
305(defvar org-before-save-iCalendar-file-hook nil
306 "Hook run before an iCalendar file has been saved.
307This can be used to modify the result of the export.")
308
309(defvar org-after-save-iCalendar-file-hook nil
310 "Hook run after an iCalendar file has been saved.
311The iCalendar buffer is still current when this hook is run.
312A good way to use this is to tell a desktop calendar application to re-read
313the iCalendar file.")
314
315(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
316(defun org-icalendar-print-entries (&optional combine)
317 "Print iCalendar entries for the current Org-mode file to `standard-output'.
318When COMBINE is non nil, add the category to each line."
319 (require 'org-agenda)
320 (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
321 (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
322 (dts (org-icalendar-ts-to-string
323 (format-time-string (cdr org-time-stamp-formats) (current-time))
324 "DTSTART"))
325 hd ts ts2 state status (inc t) pos b sexp rrule
326 scheduledp deadlinep todo prefix due start tags
327 tmp pri categories location summary desc uid alarm alarm-time
328 (sexp-buffer (get-buffer-create "*ical-tmp*")))
329 (org-refresh-category-properties)
330 (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
331 (save-excursion
332 (goto-char (point-min))
333 (while (re-search-forward re1 nil t)
334 (catch :skip
335 (org-agenda-skip)
336 (when org-icalendar-verify-function
337 (unless (save-match-data (funcall org-icalendar-verify-function))
338 (outline-next-heading)
339 (backward-char 1)
340 (throw :skip nil)))
341 (setq pos (match-beginning 0)
342 ts (match-string 0)
343 tags (org-get-tags-at)
344 inc t
345 hd (condition-case nil
346 (org-icalendar-cleanup-string
347 (org-get-heading t))
348 (error (throw :skip nil)))
349 summary (org-icalendar-cleanup-string
350 (org-entry-get nil "SUMMARY"))
351 desc (org-icalendar-cleanup-string
352 (or (org-entry-get nil "DESCRIPTION")
353 (and org-icalendar-include-body (org-get-entry)))
354 t org-icalendar-include-body)
355 location (org-icalendar-cleanup-string
356 (org-entry-get nil "LOCATION" 'selective))
357 uid (if org-icalendar-store-UID
358 (org-id-get-create)
359 (or (org-id-get) (org-id-new)))
360 categories (org-export-get-categories)
361 alarm-time (get-text-property (point) 'org-appt-warntime)
362 alarm-time (if alarm-time (string-to-number alarm-time) 0)
363 alarm ""
364 deadlinep nil scheduledp nil)
365 (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos)
366 deadlinep (string-match org-deadline-regexp tmp)
367 scheduledp (string-match org-scheduled-regexp tmp)
368 todo (org-get-todo-state))
369 ;; donep (org-entry-is-done-p)
370 (if (looking-at re2)
371 (progn
372 (goto-char (match-end 0))
373 (setq ts2 (match-string 1)
374 inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
375 (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
376 (progn
377 (setq inc nil)
378 (replace-match "\\1" t nil ts))
379 ts)))
380 (when (and (not org-icalendar-use-plain-timestamp)
381 (not deadlinep) (not scheduledp))
382 (throw :skip t))
383 ;; don't export entries with a :noexport: tag
384 (when (and org-icalendar-honor-noexport-tag
385 (delq nil (mapcar (lambda(x)
386 (member x org-export-exclude-tags)) tags)))
387 (throw :skip t))
388 (when (and
389 deadlinep
390 (if todo
391 (not (memq 'event-if-todo org-icalendar-use-deadline))
392 (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
393 (throw :skip t))
394 (when (and
395 scheduledp
396 (if todo
397 (not (memq 'event-if-todo org-icalendar-use-scheduled))
398 (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
399 (throw :skip t))
400 (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
401 (if (or (string-match org-tr-regexp hd)
402 (string-match org-ts-regexp hd))
403 (setq hd (replace-match "" t t hd)))
404 (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts)
405 (setq rrule
406 (concat "\nRRULE:FREQ="
407 (cdr (assoc
408 (match-string 2 ts)
409 '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY")
410 ("m" . "MONTHLY")("y" . "YEARLY"))))
411 ";INTERVAL=" (match-string 1 ts)))
412 (setq rrule ""))
413 (setq summary (or summary hd))
414 ;; create an alarm entry if the entry is timed. this is not very general in that:
415 ;; (a) only one alarm per entry is defined,
416 ;; (b) only minutes are allowed for the trigger period ahead of the start time, and
417 ;; (c) only a DISPLAY action is defined.
418 ;; [ESF]
419 (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
420 (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
421 (car t1) (nth 1 t1) (nth 2 t1))
422 (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM"
423 summary (or alarm-time org-icalendar-alarm-time)))
424 (setq alarm "")))
425 (if (string-match org-bracket-link-regexp summary)
426 (setq summary
427 (replace-match (if (match-end 3)
428 (match-string 3 summary)
429 (match-string 1 summary))
430 t t summary)))
431 (if deadlinep (setq summary (concat "DL: " summary)))
432 (if scheduledp (setq summary (concat "S: " summary)))
433 (if (string-match "\\`<%%" ts)
434 (with-current-buffer sexp-buffer
435 (let ((entry (substring ts 1 -1)))
436 (put-text-property 0 1 'uid
437 (concat " " prefix uid) entry)
438 (insert entry " " summary "\n")))
439 (princ (format "BEGIN:VEVENT
440UID: %s
441%s
442%s%s
443SUMMARY:%s%s%s
444CATEGORIES:%s%s
445END:VEVENT\n"
446 (concat prefix uid)
447 (org-icalendar-ts-to-string ts "DTSTART")
448 (org-icalendar-ts-to-string ts2 "DTEND" inc)
449 rrule summary
450 (if (and desc (string-match "\\S-" desc))
451 (concat "\nDESCRIPTION: " desc) "")
452 (if (and location (string-match "\\S-" location))
453 (concat "\nLOCATION: " location) "")
454 categories
455 alarm)))))
456 (when (and org-icalendar-include-sexps
457 (condition-case nil (require 'icalendar) (error nil))
458 (fboundp 'icalendar-export-region))
459 ;; Get all the literal sexps
460 (goto-char (point-min))
461 (while (re-search-forward "^&?%%(" nil t)
462 (catch :skip
463 (org-agenda-skip)
464 (when org-icalendar-verify-function
465 (unless (save-match-data (funcall org-icalendar-verify-function))
466 (outline-next-heading)
467 (backward-char 1)
468 (throw :skip nil)))
469 (setq b (match-beginning 0))
470 (goto-char (1- (match-end 0)))
471 (forward-sexp 1)
472 (end-of-line 1)
473 (setq sexp (buffer-substring b (point)))
474 (with-current-buffer sexp-buffer
475 (insert sexp "\n"))))
476 (princ (org-diary-to-ical-string sexp-buffer))
477 (kill-buffer sexp-buffer))
478
479 (when org-icalendar-include-todo
480 (setq prefix "TODO-")
481 (goto-char (point-min))
482 (while (re-search-forward org-complex-heading-regexp nil t)
483 (catch :skip
484 (org-agenda-skip)
485 (when org-icalendar-verify-function
486 (unless (save-match-data
487 (funcall org-icalendar-verify-function))
488 (outline-next-heading)
489 (backward-char 1)
490 (throw :skip nil)))
491 (setq state (match-string 2))
492 (setq status (if (member state org-done-keywords)
493 "COMPLETED" "NEEDS-ACTION"))
494 (when (and state
495 (cond
496 ;; check if the state is one we should use
497 ((eq org-icalendar-include-todo 'all)
498 ;; all should be included
499 t)
500 ((eq org-icalendar-include-todo 'unblocked)
501 ;; only undone entries that are not blocked
502 (and (member state org-not-done-keywords)
503 (or (not org-blocker-hook)
504 (save-match-data
505 (run-hook-with-args-until-failure
506 'org-blocker-hook
507 (list :type 'todo-state-change
508 :position (point-at-bol)
509 :from 'todo
510 :to 'done))))))
511 ((eq org-icalendar-include-todo t)
512 ;; include everything that is not done
513 (member state org-not-done-keywords))))
514 (setq hd (match-string 4)
515 summary (org-icalendar-cleanup-string
516 (org-entry-get nil "SUMMARY"))
517 desc (org-icalendar-cleanup-string
518 (or (org-entry-get nil "DESCRIPTION")
519 (and org-icalendar-include-body (org-get-entry)))
520 t org-icalendar-include-body)
521 location (org-icalendar-cleanup-string
522 (org-entry-get nil "LOCATION" 'selective))
523 due (and (member 'todo-due org-icalendar-use-deadline)
524 (org-entry-get nil "DEADLINE"))
525 start (and (member 'todo-start org-icalendar-use-scheduled)
526 (org-entry-get nil "SCHEDULED"))
527 categories (org-export-get-categories)
528 uid (if org-icalendar-store-UID
529 (org-id-get-create)
530 (or (org-id-get) (org-id-new))))
531 (and due (setq due (org-icalendar-ts-to-string due "DUE")))
532 (and start (setq start (org-icalendar-ts-to-string start "DTSTART")))
533
534 (if (string-match org-bracket-link-regexp hd)
535 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
536 (match-string 1 hd))
537 t t hd)))
538 (if (string-match org-priority-regexp hd)
539 (setq pri (string-to-char (match-string 2 hd))
540 hd (concat (substring hd 0 (match-beginning 1))
541 (substring hd (match-end 1))))
542 (setq pri org-default-priority))
543 (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
544 (- org-lowest-priority org-highest-priority))))))
545
546 (princ (format "BEGIN:VTODO
547UID: %s
548%s
549SUMMARY:%s%s%s%s
550CATEGORIES:%s
551SEQUENCE:1
552PRIORITY:%d
553STATUS:%s
554END:VTODO\n"
555 (concat prefix uid)
556 (or start dts)
557 (or summary hd)
558 (if (and location (string-match "\\S-" location))
559 (concat "\nLOCATION: " location) "")
560 (if (and desc (string-match "\\S-" desc))
561 (concat "\nDESCRIPTION: " desc) "")
562 (if due (concat "\n" due) "")
563 categories
564 pri status)))))))))
565
566(defun org-export-get-categories ()
567 "Get categories according to `org-icalendar-categories'."
568 (let ((cs org-icalendar-categories) c rtn tmp)
569 (while (setq c (pop cs))
570 (cond
571 ((eq c 'category) (push (org-get-category) rtn))
572 ((eq c 'todo-state)
573 (setq tmp (org-get-todo-state))
574 (and tmp (push tmp rtn)))
575 ((eq c 'local-tags)
576 (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
577 ((eq c 'all-tags)
578 (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
579 (mapconcat 'identity (nreverse rtn) ",")))
580
581(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
582 "Take out stuff and quote what needs to be quoted.
583When IS-BODY is non-nil, assume that this is the body of an item, clean up
584whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
585characters."
586 (if (not s)
587 nil
588 (if is-body
589 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
590 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
591 (while (string-match re s) (setq s (replace-match "" t t s)))
592 (while (string-match re2 s) (setq s (replace-match "" t t s))))
593 (setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
594 (let ((start 0))
595 (while (string-match "\\([,;]\\)" s start)
596 (setq start (+ (match-beginning 0) 2)
597 s (replace-match "\\\\\\1" nil nil s))))
598 (setq s (org-trim s))
599 (when is-body
600 (while (string-match "[ \t]*\n[ \t]*" s)
601 (setq s (replace-match "\\n" t t s))))
602 (if is-body
603 (if maxlength
604 (if (and (numberp maxlength)
605 (> (length s) maxlength))
606 (setq s (substring s 0 maxlength)))))
607 s))
608
609(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
610 "Take out stuff and quote what needs to be quoted.
611When IS-BODY is non-nil, assume that this is the body of an item, clean up
612whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
613characters.
614This seems to be more like RFC 2455, but it causes problems, so it is
615not used right now."
616 (if (not s)
617 nil
618 (if is-body
619 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
620 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
621 (while (string-match re s) (setq s (replace-match "" t t s)))
622 (while (string-match re2 s) (setq s (replace-match "" t t s)))
623 (setq s (org-trim s))
624 (while (string-match "[ \t]*\n[ \t]*" s)
625 (setq s (replace-match "\\n" t t s)))
626 (if maxlength
627 (if (and (numberp maxlength)
628 (> (length s) maxlength))
629 (setq s (substring s 0 maxlength)))))
630 (setq s (org-trim s)))
631 (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
632 (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
633 s))
634
635(defun org-icalendar-start-file (name)
636 "Start an iCalendar file by inserting the header."
637 (let ((user user-full-name)
638 (name (or name "unknown"))
639 (timezone (if (> (length org-icalendar-timezone) 0)
640 org-icalendar-timezone
641 (cadr (current-time-zone))))
642 (description org-icalendar-combined-description))
643 (princ
644 (format "BEGIN:VCALENDAR
645VERSION:2.0
646X-WR-CALNAME:%s
647PRODID:-//%s//Emacs with Org-mode//EN
648X-WR-TIMEZONE:%s
649X-WR-CALDESC:%s
650CALSCALE:GREGORIAN\n" name user timezone description))))
651
652(defun org-icalendar-finish-file ()
653 "Finish an iCalendar file by inserting the END statement."
654 (princ "END:VCALENDAR\n"))
655
656(defun org-icalendar-ts-to-string (s keyword &optional inc)
657 "Take a time string S and convert it to iCalendar format.
658KEYWORD is added in front, to make a complete line like DTSTART....
659When INC is non-nil, increase the hour by two (if time string contains
660a time), or the day by one (if it does not contain a time)."
661 (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault)))
662 t2 fmt have-time time)
663 (if (not t1)
664 ""
665 (if (and (car t1) (nth 1 t1) (nth 2 t1))
666 (setq t2 t1 have-time t)
667 (setq t2 (org-parse-time-string s)))
668 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
669 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
670 (when inc
671 (if have-time
672 (if org-agenda-default-appointment-duration
673 (setq mi (+ org-agenda-default-appointment-duration mi))
674 (setq h (+ 2 h)))
675 (setq d (1+ d))))
676 (setq time (encode-time s mi h d m y)))
677 (setq fmt (if have-time
678 (replace-regexp-in-string "%Z"
679 org-icalendar-timezone
680 org-icalendar-date-time-format t)
681 ";VALUE=DATE:%Y%m%d"))
682 (concat keyword (format-time-string fmt time
683 (and (org-icalendar-use-UTC-date-timep)
684 have-time))))))
685
686(provide 'org-icalendar)
687
688;; Local variables:
689;; generated-autoload-file: "org-loaddefs.el"
690;; End:
691
692;;; org-icalendar.el ends here
diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el
deleted file mode 100644
index 08c01108b98..00000000000
--- a/lisp/org/org-jsinfo.el
+++ /dev/null
@@ -1,262 +0,0 @@
1;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;; This file implements the support for Sebastian Rose's JavaScript
28;; org-info.js to display an org-mode file exported to HTML in an
29;; Info-like way, or using folding similar to the outline structure
30;; org org-mode itself.
31
32;; Documentation for using this module is in the Org manual. The script
33;; itself is documented by Sebastian Rose in a file distributed with
34;; the script. FIXME: Accurate pointers!
35
36;; Org-mode loads this module by default - if this is not what you want,
37;; configure the variable `org-modules'.
38
39;;; Code:
40
41(require 'org-exp)
42(require 'org-html)
43
44(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt))
45(add-hook 'org-export-options-filters 'org-infojs-handle-options)
46
47(defgroup org-infojs nil
48 "Options specific for using org-info.js in HTML export of Org-mode files."
49 :tag "Org Export HTML INFOJS"
50 :group 'org-export-html)
51
52(defcustom org-export-html-use-infojs 'when-configured
53 "Should Sebastian Rose's Java Script org-info.js be linked into HTML files?
54This option can be nil or t to never or always use the script. It can
55also be the symbol `when-configured', meaning that the script will be
56linked into the export file if and only if there is a \"#+INFOJS_OPT:\"
57line in the buffer. See also the variable `org-infojs-options'."
58 :group 'org-export-html
59 :group 'org-infojs
60 :type '(choice
61 (const :tag "Never" nil)
62 (const :tag "When configured in buffer" when-configured)
63 (const :tag "Always" t)))
64
65(defconst org-infojs-opts-table
66 '((path PATH "http://orgmode.org/org-info.js")
67 (view VIEW "info")
68 (toc TOC :table-of-contents)
69 (ftoc FIXED_TOC "0")
70 (tdepth TOC_DEPTH "max")
71 (sdepth SECTION_DEPTH "max")
72 (mouse MOUSE_HINT "underline")
73 (buttons VIEW_BUTTONS "0")
74 (ltoc LOCAL_TOC "1")
75 (up LINK_UP :link-up)
76 (home LINK_HOME :link-home))
77 "JavaScript options, long form for script, default values.")
78
79(defvar org-infojs-options)
80(when (and (boundp 'org-infojs-options)
81 (assq 'runs org-infojs-options))
82 (setq org-infojs-options (delq (assq 'runs org-infojs-options)
83 org-infojs-options)))
84
85(defcustom org-infojs-options
86 (mapcar (lambda (x) (cons (car x) (nth 2 x)))
87 org-infojs-opts-table)
88 "Options settings for the INFOJS JavaScript.
89Each of the options must have an entry in `org-export-html/infojs-opts-table'.
90The value can either be a string that will be passed to the script, or
91a property. This property is then assumed to be a property that is defined
92by the Export/Publishing setup of Org.
93The `sdepth' and `tdepth' parameters can also be set to \"max\", which
94means to use the maximum value consistent with other options."
95 :group 'org-infojs
96 :type
97 `(set :greedy t :inline t
98 ,@(mapcar
99 (lambda (x)
100 (list 'cons (list 'const (car x))
101 '(choice
102 (symbol :tag "Publishing/Export property")
103 (string :tag "Value"))))
104 org-infojs-opts-table)))
105
106(defcustom org-infojs-template
107 "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
108/**
109 *
110 * @source: %SCRIPT_PATH
111 *
112 * @licstart The following is the entire license notice for the
113 * JavaScript code in %SCRIPT_PATH.
114 *
115 * Copyright (C) 2012-2013 Sebastian Rose
116 *
117 *
118 * The JavaScript code in this tag is free software: you can
119 * redistribute it and/or modify it under the terms of the GNU
120 * General Public License (GNU GPL) as published by the Free Software
121 * Foundation, either version 3 of the License, or (at your option)
122 * any later version. The code is distributed WITHOUT ANY WARRANTY;
123 * without even the implied warranty of MERCHANTABILITY or FITNESS
124 * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
125 *
126 * As additional permission under GNU GPL version 3 section 7, you
127 * may distribute non-source (e.g., minimized or compacted) forms of
128 * that code without the copy of the GNU GPL normally required by
129 * section 4, provided you include this license notice and a URL
130 * through which recipients can access the Corresponding Source.
131 *
132 * @licend The above is the entire license notice
133 * for the JavaScript code in %SCRIPT_PATH.
134 *
135 */
136</script>
137
138<script type=\"text/javascript\">
139
140/*
141@licstart The following is the entire license notice for the
142JavaScript code in this tag.
143
144Copyright (C) 2012-2013 Free Software Foundation, Inc.
145
146The JavaScript code in this tag is free software: you can
147redistribute it and/or modify it under the terms of the GNU
148General Public License (GNU GPL) as published by the Free Software
149Foundation, either version 3 of the License, or (at your option)
150any later version. The code is distributed WITHOUT ANY WARRANTY;
151without even the implied warranty of MERCHANTABILITY or FITNESS
152FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
153
154As additional permission under GNU GPL version 3 section 7, you
155may distribute non-source (e.g., minimized or compacted) forms of
156that code without the copy of the GNU GPL normally required by
157section 4, provided you include this license notice and a URL
158through which recipients can access the Corresponding Source.
159
160
161@licend The above is the entire license notice
162for the JavaScript code in this tag.
163*/
164
165<!--/*--><![CDATA[/*><!--*/
166%MANAGER_OPTIONS
167org_html_manager.setup(); // activate after the parameters are set
168/*]]>*///-->
169</script>"
170 "The template for the export style additions when org-info.js is used.
171Option settings will replace the %MANAGER-OPTIONS cookie."
172 :group 'org-infojs
173 :type 'string)
174
175(defun org-infojs-handle-options (exp-plist)
176 "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly."
177 (if (or (not org-export-html-use-infojs)
178 (and (eq org-export-html-use-infojs 'when-configured)
179 (or (not (plist-get exp-plist :infojs-opt))
180 (string-match "\\<view:nil\\>"
181 (plist-get exp-plist :infojs-opt)))))
182 ;; We do not want to use the script
183 exp-plist
184 ;; We do want to use the script, set it up
185 (let ((template org-infojs-template)
186 (ptoc (plist-get exp-plist :table-of-contents))
187 (hlevels (plist-get exp-plist :headline-levels))
188 tdepth sdepth s v e opt var val table default)
189 (setq sdepth hlevels
190 tdepth hlevels)
191 (if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
192 (setq v (plist-get exp-plist :infojs-opt)
193 table org-infojs-opts-table)
194 (while (setq e (pop table))
195 (setq opt (car e) var (nth 1 e)
196 default (cdr (assoc opt org-infojs-options)))
197 (and (symbolp default) (not (memq default '(t nil)))
198 (setq default (plist-get exp-plist default)))
199 (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
200 (setq val (match-string 1 v))
201 (setq val default))
202 (cond
203 ((eq opt 'path)
204 (setq template
205 (replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
206 ((eq opt 'sdepth)
207 (if (integerp (read val))
208 (setq sdepth (min (read val) hlevels))))
209 ((eq opt 'tdepth)
210 (if (integerp (read val))
211 (setq tdepth (min (read val) hlevels))))
212 (t
213 (setq val
214 (cond
215 ((or (eq val t) (equal val "t")) "1")
216 ((or (eq val nil) (equal val "nil")) "0")
217 ((stringp val) val)
218 (t (format "%s" val))))
219 (push (cons var val) s))))
220
221 ;; Now we set the depth of the *generated* TOC to SDEPTH, because the
222 ;; toc will actually determine the splitting. How much of the toc will
223 ;; actually be displayed is governed by the TDEPTH option.
224 (setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
225
226 ;; The table of contents should not show more sections then we generate
227 (setq tdepth (min tdepth sdepth))
228 (push (cons "TOC_DEPTH" tdepth) s)
229
230 (setq s (mapconcat
231 (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
232 (car x) (cdr x)))
233 s "\n"))
234 (when (and s (> (length s) 0))
235 (and (string-match "%MANAGER_OPTIONS" template)
236 (setq s (replace-match s t t template))
237 (setq exp-plist
238 (plist-put
239 exp-plist :style-extra
240 (concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
241 ;; This script absolutely needs the table of contents, to we change that
242 ;; setting
243 (if (not (plist-get exp-plist :table-of-contents))
244 (setq exp-plist (plist-put exp-plist :table-of-contents t)))
245 ;; Return the modified property list
246 exp-plist)))
247
248(defun org-infojs-options-inbuffer-template ()
249 (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"
250 (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil)
251 (let ((a (cdr (assoc 'toc org-infojs-options))))
252 (cond ((memq a '(nil t)) a)
253 (t (plist-get (org-infile-export-plist) :table-of-contents))))
254 (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil)
255 (cdr (assoc 'mouse org-infojs-options))
256 (cdr (assoc 'buttons org-infojs-options))
257 (cdr (assoc 'path org-infojs-options))))
258
259(provide 'org-infojs)
260(provide 'org-jsinfo)
261
262;;; org-jsinfo.el ends here
diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el
deleted file mode 100644
index 609bcbee103..00000000000
--- a/lisp/org/org-latex.el
+++ /dev/null
@@ -1,2901 +0,0 @@
1;;; org-latex.el --- LaTeX exporter for org-mode
2;;
3;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
4;;
5;; Emacs Lisp Archive Entry
6;; Filename: org-latex.el
7;; Author: Bastien Guerry <bzg AT gnu DOT org>
8;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
9;; Keywords: org, wp, tex
10;; Description: Converts an org-mode buffer into LaTeX
11
12;; This file is part of GNU Emacs.
13
14;; GNU Emacs is free software: you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation, either version 3 of the License, or
17;; (at your option) any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27;;; Commentary:
28;;
29;; This library implements a LaTeX exporter for org-mode.
30;;
31;; It is part of Org and will be autoloaded
32;;
33;; The interactive functions are similar to those of the HTML exporter:
34;;
35;; M-x `org-export-as-latex'
36;; M-x `org-export-as-pdf'
37;; M-x `org-export-as-pdf-and-open'
38;; M-x `org-export-as-latex-batch'
39;; M-x `org-export-as-latex-to-buffer'
40;; M-x `org-export-region-as-latex'
41;; M-x `org-replace-region-by-latex'
42;;
43;;; Code:
44
45(eval-when-compile
46 (require 'cl))
47
48(require 'footnote)
49(require 'org)
50(require 'org-exp)
51(require 'org-macs)
52(require 'org-beamer)
53
54;;; Variables:
55(defvar org-export-latex-class nil)
56(defvar org-export-latex-class-options nil)
57(defvar org-export-latex-header nil)
58(defvar org-export-latex-append-header nil)
59(defvar org-export-latex-options-plist nil)
60(defvar org-export-latex-todo-keywords-1 nil)
61(defvar org-export-latex-complex-heading-re nil)
62(defvar org-export-latex-not-done-keywords nil)
63(defvar org-export-latex-done-keywords nil)
64(defvar org-export-latex-display-custom-times nil)
65(defvar org-export-latex-all-targets-re nil)
66(defvar org-export-latex-add-level 0)
67(defvar org-export-latex-footmark-seen nil
68 "List of footnotes markers seen so far by exporter.")
69(defvar org-export-latex-sectioning "")
70(defvar org-export-latex-sectioning-depth 0)
71(defvar org-export-latex-special-keyword-regexp
72 (concat "\\<\\(" org-scheduled-string "\\|"
73 org-deadline-string "\\|"
74 org-closed-string"\\)")
75 "Regexp matching special time planning keywords plus the time after it.")
76(defvar org-re-quote) ; dynamically scoped from org.el
77(defvar org-commentsp) ; dynamically scoped from org.el
78
79;;; User variables:
80
81(defgroup org-export-latex nil
82 "Options for exporting Org-mode files to LaTeX."
83 :tag "Org Export LaTeX"
84 :group 'org-export)
85
86(defcustom org-export-latex-default-class "article"
87 "The default LaTeX class."
88 :group 'org-export-latex
89 :type '(string :tag "LaTeX class"))
90
91(defcustom org-export-latex-classes
92 '(("article"
93 "\\documentclass[11pt]{article}"
94 ("\\section{%s}" . "\\section*{%s}")
95 ("\\subsection{%s}" . "\\subsection*{%s}")
96 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
97 ("\\paragraph{%s}" . "\\paragraph*{%s}")
98 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
99 ("report"
100 "\\documentclass[11pt]{report}"
101 ("\\part{%s}" . "\\part*{%s}")
102 ("\\chapter{%s}" . "\\chapter*{%s}")
103 ("\\section{%s}" . "\\section*{%s}")
104 ("\\subsection{%s}" . "\\subsection*{%s}")
105 ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
106 ("book"
107 "\\documentclass[11pt]{book}"
108 ("\\part{%s}" . "\\part*{%s}")
109 ("\\chapter{%s}" . "\\chapter*{%s}")
110 ("\\section{%s}" . "\\section*{%s}")
111 ("\\subsection{%s}" . "\\subsection*{%s}")
112 ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
113 ("beamer"
114 "\\documentclass{beamer}"
115 org-beamer-sectioning
116 ))
117 "Alist of LaTeX classes and associated header and structure.
118If #+LaTeX_CLASS is set in the buffer, use its value and the
119associated information. Here is the structure of each cell:
120
121 \(class-name
122 header-string
123 (numbered-section . unnumbered-section\)
124 ...\)
125
126The header string
127-----------------
128
129The HEADER-STRING is the header that will be inserted into the LaTeX file.
130It should contain the \\documentclass macro, and anything else that is needed
131for this setup. To this header, the following commands will be added:
132
133- Calls to \\usepackage for all packages mentioned in the variables
134 `org-export-latex-default-packages-alist' and
135 `org-export-latex-packages-alist'. Thus, your header definitions should
136 avoid to also request these packages.
137
138- Lines specified via \"#+LaTeX_HEADER:\"
139
140If you need more control about the sequence in which the header is built
141up, or if you want to exclude one of these building blocks for a particular
142class, you can use the following macro-like placeholders.
143
144 [DEFAULT-PACKAGES] \\usepackage statements for default packages
145 [NO-DEFAULT-PACKAGES] do not include any of the default packages
146 [PACKAGES] \\usepackage statements for packages
147 [NO-PACKAGES] do not include the packages
148 [EXTRA] the stuff from #+LaTeX_HEADER
149 [NO-EXTRA] do not include #+LaTeX_HEADER stuff
150 [BEAMER-HEADER-EXTRA] the beamer extra headers
151
152So a header like
153
154 \\documentclass{article}
155 [NO-DEFAULT-PACKAGES]
156 [EXTRA]
157 \\providecommand{\\alert}[1]{\\textbf{#1}}
158 [PACKAGES]
159
160will omit the default packages, and will include the #+LaTeX_HEADER lines,
161then have a call to \\providecommand, and then place \\usepackage commands
162based on the content of `org-export-latex-packages-alist'.
163
164If your header or `org-export-latex-default-packages-alist' inserts
165\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with
166a coding system derived from `buffer-file-coding-system'. See also the
167variable `org-export-latex-inputenc-alist' for a way to influence this
168mechanism.
169
170The sectioning structure
171------------------------
172
173The sectioning structure of the class is given by the elements following
174the header string. For each sectioning level, a number of strings is
175specified. A %s formatter is mandatory in each section string and will
176be replaced by the title of the section.
177
178Instead of a cons cell (numbered . unnumbered), you can also provide a list
179of 2 or 4 elements,
180
181 (numbered-open numbered-close)
182
183or
184
185 (numbered-open numbered-close unnumbered-open unnumbered-close)
186
187providing opening and closing strings for a LaTeX environment that should
188represent the document section. The opening clause should have a %s
189to represent the section title.
190
191Instead of a list of sectioning commands, you can also specify a
192function name. That function will be called with two parameters,
193the (reduced) level of the headline, and the headline text. The function
194must return a cons cell with the (possibly modified) headline text, and the
195sectioning list in the cdr."
196 :group 'org-export-latex
197 :type '(repeat
198 (list (string :tag "LaTeX class")
199 (string :tag "LaTeX header")
200 (repeat :tag "Levels" :inline t
201 (choice
202 (cons :tag "Heading"
203 (string :tag " numbered")
204 (string :tag "unnumbered"))
205 (list :tag "Environment"
206 (string :tag "Opening (numbered)")
207 (string :tag "Closing (numbered)")
208 (string :tag "Opening (unnumbered)")
209 (string :tag "Closing (unnumbered)"))
210 (function :tag "Hook computing sectioning"))))))
211
212(defcustom org-export-latex-inputenc-alist nil
213 "Alist of inputenc coding system names, and what should really be used.
214For example, adding an entry
215
216 (\"utf8\" . \"utf8x\")
217
218will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
219are written as utf8 files."
220 :group 'org-export-latex
221 :version "24.1"
222 :type '(repeat
223 (cons
224 (string :tag "Derived from buffer")
225 (string :tag "Use this instead"))))
226
227
228(defcustom org-export-latex-emphasis-alist
229 '(("*" "\\textbf{%s}" nil)
230 ("/" "\\emph{%s}" nil)
231 ("_" "\\underline{%s}" nil)
232 ("+" "\\st{%s}" nil)
233 ("=" "\\protectedtexttt" t)
234 ("~" "\\verb" t))
235 "Alist of LaTeX expressions to convert emphasis fontifiers.
236Each element of the list is a list of three elements.
237The first element is the character used as a marker for fontification.
238The second element is a format string to wrap fontified text with.
239If it is \"\\verb\", Org will automatically select a delimiter
240character that is not in the string. \"\\protectedtexttt\" will use \\texttt
241to typeset and try to protect special characters.
242The third element decides whether to protect converted text from other
243conversions."
244 :group 'org-export-latex
245 :type 'alist)
246
247(defcustom org-export-latex-title-command "\\maketitle"
248 "The command used to insert the title just after \\begin{document}.
249If this string contains the formatting specification \"%s\" then
250it will be used as a format string, passing the title as an
251argument."
252 :group 'org-export-latex
253 :type 'string)
254
255(defcustom org-export-latex-import-inbuffer-stuff nil
256 "Non-nil means define TeX macros for Org's inbuffer definitions.
257For example \orgTITLE for #+TITLE."
258 :group 'org-export-latex
259 :type 'boolean)
260
261(defcustom org-export-latex-date-format
262 "\\today"
263 "Format string for \\date{...}."
264 :group 'org-export-latex
265 :type 'string)
266
267(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}"
268 "Markup for TODO keywords, as a printf format.
269This can be a single format for all keywords, a cons cell with separate
270formats for not-done and done states, or an association list with setup
271for individual keywords. If a keyword shows up for which there is no
272markup defined, the first one in the association list will be used."
273 :group 'org-export-latex
274 :type '(choice
275 (string :tag "Default")
276 (cons :tag "Distinguish undone and done"
277 (string :tag "Not-DONE states")
278 (string :tag "DONE states"))
279 (repeat :tag "Per keyword markup"
280 (cons
281 (string :tag "Keyword")
282 (string :tag "Markup")))))
283
284(defcustom org-export-latex-tag-markup "\\textbf{%s}"
285 "Markup for tags, as a printf format."
286 :group 'org-export-latex
287 :version "24.1"
288 :type 'string)
289
290(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
291 "A printf format string to be applied to time stamps."
292 :group 'org-export-latex
293 :type 'string)
294
295(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}"
296 "A printf format string to be applied to inactive time stamps."
297 :group 'org-export-latex
298 :version "24.1"
299 :type 'string)
300
301(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
302 "A printf format string to be applied to time stamps."
303 :group 'org-export-latex
304 :type 'string)
305
306(defcustom org-export-latex-href-format "\\href{%s}{%s}"
307 "A printf format string to be applied to href links.
308The format must contain either two %s instances or just one.
309If it contains two %s instances, the first will be filled with
310the link, the second with the link description. If it contains
311only one, the %s will be filled with the link."
312 :group 'org-export-latex
313 :version "24.1"
314 :type 'string)
315
316(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
317 "A printf format string to be applied to hyperref links.
318The format must contain one or two %s instances. The first one
319will be filled with the link, the second with its description."
320 :group 'org-export-latex
321 :version "24.1"
322 :type 'string)
323
324(defcustom org-export-latex-hyperref-options-format
325 "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n"
326 "A format string for hyperref options.
327When non-nil, it must contain three %s format specifications
328which will respectively be replaced by the document's keywords,
329its description and the Org's version number, as a string. Set
330this option to the empty string if you don't want to include
331hyperref options altogether."
332 :type 'string
333 :version "24.3"
334 :group 'org-export-latex)
335
336(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
337 "Text used to separate footnotes."
338 :group 'org-export-latex
339 :version "24.1"
340 :type 'string)
341
342(defcustom org-export-latex-quotes
343 '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'"))
344 ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`")))
345 "Alist for quotes to use when converting english double-quotes.
346
347The CAR of each item in this alist is the language code.
348The CDR of each item in this alist is a list of three CONS:
349- the first CONS defines the opening quote;
350- the second CONS defines the closing quote;
351- the last CONS defines single quotes.
352
353For each item in a CONS, the first string is a regexp
354for allowed characters before/after the quote, the second
355string defines the replacement string for this quote."
356 :group 'org-export-latex
357 :version "24.1"
358 :type '(list
359 (cons :tag "Opening quote"
360 (string :tag "Regexp for char before")
361 (string :tag "Replacement quote "))
362 (cons :tag "Closing quote"
363 (string :tag "Regexp for char after ")
364 (string :tag "Replacement quote "))
365 (cons :tag "Single quote"
366 (string :tag "Regexp for char before")
367 (string :tag "Replacement quote "))))
368
369(defcustom org-export-latex-tables-verbatim nil
370 "When non-nil, tables are exported verbatim."
371 :group 'org-export-latex
372 :type 'boolean)
373
374(defcustom org-export-latex-tables-centered t
375 "When non-nil, tables are exported in a center environment."
376 :group 'org-export-latex
377 :type 'boolean)
378
379(defcustom org-export-latex-table-caption-above t
380 "When non-nil, the caption is set above the table. When nil,
381the caption is set below the table."
382 :group 'org-export-latex
383 :version "24.1"
384 :type 'boolean)
385
386(defcustom org-export-latex-tables-column-borders nil
387 "When non-nil, grouping columns can cause outer vertical lines in tables.
388When nil, grouping causes only separation lines between groups."
389 :group 'org-export-latex
390 :type 'boolean)
391
392(defcustom org-export-latex-tables-tstart nil
393 "LaTeX command for top rule for tables."
394 :group 'org-export-latex
395 :version "24.1"
396 :type '(choice
397 (const :tag "Nothing" nil)
398 (string :tag "String")
399 (const :tag "Booktabs default: \\toprule" "\\toprule")))
400
401(defcustom org-export-latex-tables-hline "\\hline"
402 "LaTeX command to use for a rule somewhere in the middle of a table."
403 :group 'org-export-latex
404 :version "24.1"
405 :type '(choice
406 (string :tag "String")
407 (const :tag "Standard: \\hline" "\\hline")
408 (const :tag "Booktabs default: \\midrule" "\\midrule")))
409
410(defcustom org-export-latex-tables-tend nil
411 "LaTeX command for bottom rule for tables."
412 :group 'org-export-latex
413 :version "24.1"
414 :type '(choice
415 (const :tag "Nothing" nil)
416 (string :tag "String")
417 (const :tag "Booktabs default: \\bottomrule" "\\bottomrule")))
418
419(defcustom org-export-latex-low-levels 'itemize
420 "How to convert sections below the current level of sectioning.
421This is specified by the `org-export-headline-levels' option or the
422value of \"H:\" in Org's #+OPTION line.
423
424This can be either nil (skip the sections), `description', `itemize',
425or `enumerate' (convert the sections as the corresponding list type), or
426a string to be used instead of \\section{%s}. In this latter case,
427the %s stands here for the inserted headline and is mandatory.
428
429It may also be a list of three string to define a user-defined environment
430that should be used. The first string should be the like
431\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up
432to two occurrences of %s for the title and a label, respectively. The third
433string should be like \"\\end{itemize\"."
434 :group 'org-export-latex
435 :type '(choice (const :tag "Ignore" nil)
436 (const :tag "Convert as descriptive list" description)
437 (const :tag "Convert as itemized list" itemize)
438 (const :tag "Convert as enumerated list" enumerate)
439 (list :tag "User-defined environment"
440 :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s")
441 (string :tag "Start")
442 (string :tag "End")
443 (string :tag "item"))
444 (string :tag "Use a section string" :value "\\subparagraph{%s}")))
445
446(defcustom org-export-latex-list-parameters
447 '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
448 "Parameters for the LaTeX list exporter.
449These parameters will be passed on to `org-list-to-latex', which in turn
450will pass them (combined with the LaTeX default list parameters) to
451`org-list-to-generic'."
452 :group 'org-export-latex
453 :type 'plist)
454
455(defcustom org-export-latex-verbatim-wrap
456 '("\\begin{verbatim}\n" . "\\end{verbatim}")
457 "Environment to be wrapped around a fixed-width section in LaTeX export.
458This is a cons with two strings, to be added before and after the
459fixed-with text.
460
461Defaults to \\begin{verbatim} and \\end{verbatim}."
462 :group 'org-export-translation
463 :group 'org-export-latex
464 :type '(cons (string :tag "Open")
465 (string :tag "Close")))
466
467(defcustom org-export-latex-listings nil
468 "Non-nil means export source code using the listings package.
469This package will fontify source code, possibly even with color.
470If you want to use this, you also need to make LaTeX use the
471listings package, and if you want to have color, the color
472package. Just add these to `org-export-latex-packages-alist',
473for example using customize, or with something like
474
475 (require 'org-latex)
476 (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\"))
477 (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))
478
479Alternatively,
480
481 (setq org-export-latex-listings 'minted)
482
483causes source code to be exported using the minted package as
484opposed to listings. If you want to use minted, you need to add
485the minted package to `org-export-latex-packages-alist', for
486example using customize, or with
487
488 (require 'org-latex)
489 (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\"))
490
491In addition, it is necessary to install
492pygments (http://pygments.org), and to configure the variable
493`org-latex-to-pdf-process' so that the -shell-escape option is
494passed to pdflatex.
495"
496 :group 'org-export-latex
497 :type 'boolean)
498
499(defcustom org-export-latex-listings-langs
500 '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
501 (c "C") (cc "C++")
502 (fortran "fortran")
503 (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
504 (html "HTML") (xml "XML")
505 (tex "TeX") (latex "TeX")
506 (shell-script "bash")
507 (gnuplot "Gnuplot")
508 (ocaml "Caml") (caml "Caml")
509 (sql "SQL") (sqlite "sql"))
510 "Alist mapping languages to their listing language counterpart.
511The key is a symbol, the major mode symbol without the \"-mode\".
512The value is the string that should be inserted as the language parameter
513for the listings package. If the mode name and the listings name are
514the same, the language does not need an entry in this list - but it does not
515hurt if it is present."
516 :group 'org-export-latex
517 :type '(repeat
518 (list
519 (symbol :tag "Major mode ")
520 (string :tag "Listings language"))))
521
522(defcustom org-export-latex-listings-w-names t
523 "Non-nil means export names of named code blocks.
524Code blocks exported with the listings package (controlled by the
525`org-export-latex-listings' variable) can be named in the style
526of noweb."
527 :group 'org-export-latex
528 :version "24.1"
529 :type 'boolean)
530
531(defcustom org-export-latex-minted-langs
532 '((emacs-lisp "common-lisp")
533 (cc "c++")
534 (cperl "perl")
535 (shell-script "bash")
536 (caml "ocaml"))
537 "Alist mapping languages to their minted language counterpart.
538The key is a symbol, the major mode symbol without the \"-mode\".
539The value is the string that should be inserted as the language parameter
540for the minted package. If the mode name and the listings name are
541the same, the language does not need an entry in this list - but it does not
542hurt if it is present.
543
544Note that minted uses all lower case for language identifiers,
545and that the full list of language identifiers can be obtained
546with:
547pygmentize -L lexers
548"
549 :group 'org-export-latex
550 :version "24.1"
551 :type '(repeat
552 (list
553 (symbol :tag "Major mode ")
554 (string :tag "Listings language"))))
555
556(defcustom org-export-latex-listings-options nil
557 "Association list of options for the latex listings package.
558
559These options are supplied as a comma-separated list to the
560\\lstset command. Each element of the association list should be
561a list containing two strings: the name of the option, and the
562value. For example,
563
564 (setq org-export-latex-listings-options
565 '((\"basicstyle\" \"\\small\")
566 (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
567
568will typeset the code in a small size font with underlined, bold
569black keywords.
570
571Note that the same options will be applied to blocks of all
572languages."
573 :group 'org-export-latex
574 :version "24.1"
575 :type '(repeat
576 (list
577 (string :tag "Listings option name ")
578 (string :tag "Listings option value"))))
579
580(defcustom org-export-latex-minted-options nil
581 "Association list of options for the latex minted package.
582
583These options are supplied within square brackets in
584\\begin{minted} environments. Each element of the alist should be
585a list containing two strings: the name of the option, and the
586value. For example,
587
588 (setq org-export-latex-minted-options
589 '((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
590
591will result in src blocks being exported with
592
593\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
594
595as the start of the minted environment. Note that the same
596options will be applied to blocks of all languages."
597 :group 'org-export-latex
598 :version "24.1"
599 :type '(repeat
600 (list
601 (string :tag "Minted option name ")
602 (string :tag "Minted option value"))))
603
604(defvar org-export-latex-custom-lang-environments nil
605 "Association list mapping languages to language-specific latex
606 environments used during export of src blocks by the listings
607 and minted latex packages. For example,
608
609 (setq org-export-latex-custom-lang-environments
610 '((python \"pythoncode\")))
611
612 would have the effect that if org encounters begin_src python
613 during latex export it will output
614
615 \\begin{pythoncode}
616 <src block body>
617 \\end{pythoncode}")
618
619(defcustom org-export-latex-remove-from-headlines
620 '(:todo nil :priority nil :tags nil)
621 "A plist of keywords to remove from headlines. OBSOLETE.
622Non-nil means remove this keyword type from the headline.
623
624Don't remove the keys, just change their values.
625
626Obsolete, this variable is no longer used. Use the separate
627variables `org-export-with-todo-keywords', `org-export-with-priority',
628and `org-export-with-tags' instead."
629 :type 'plist
630 :group 'org-export-latex)
631
632(defcustom org-export-latex-image-default-option "width=.9\\linewidth"
633 "Default option for images."
634 :group 'org-export-latex
635 :type 'string)
636
637(defcustom org-latex-default-figure-position "htb"
638 "Default position for latex figures."
639 :group 'org-export-latex
640 :version "24.1"
641 :type 'string)
642
643(defcustom org-export-latex-tabular-environment "tabular"
644 "Default environment used to build tables."
645 :group 'org-export-latex
646 :version "24.1"
647 :type 'string)
648
649(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}"
650 "Format string for links with unknown path type."
651 :group 'org-export-latex
652 :version "24.3"
653 :type 'string)
654
655(defcustom org-export-latex-inline-image-extensions
656 '("pdf" "jpeg" "jpg" "png" "ps" "eps")
657 "Extensions of image files that can be inlined into LaTeX.
658Note that the image extension *actually* allowed depend on the way the
659LaTeX file is processed. When used with pdflatex, pdf, jpg and png images
660are OK. When processing through dvi to Postscript, only ps and eps are
661allowed. The default we use here encompasses both."
662 :group 'org-export-latex
663 :type '(repeat (string :tag "Extension")))
664
665(defcustom org-export-latex-coding-system nil
666 "Coding system for the exported LaTeX file."
667 :group 'org-export-latex
668 :type 'coding-system)
669
670(defgroup org-export-pdf nil
671 "Options for exporting Org-mode files to PDF, via LaTeX."
672 :tag "Org Export PDF"
673 :group 'org-export-latex
674 :group 'org-export)
675
676(defcustom org-latex-to-pdf-process
677 '("pdflatex -interaction nonstopmode -output-directory %o %f"
678 "pdflatex -interaction nonstopmode -output-directory %o %f"
679 "pdflatex -interaction nonstopmode -output-directory %o %f")
680 "Commands to process a LaTeX file to a PDF file and process latex
681fragments to pdf files.By default,this is a list of strings,and each of
682strings will be given to the shell as a command. %f in the command will
683be replaced by the full file name, %b by the file base name (i.e. without
684extension) and %o by the base directory of the file.
685
686If you set `org-create-formula-image-program'
687`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a
688sublist which contains your own command(s) for LaTeX fragments
689previewing, like this:
690
691 '(\"xelatex -interaction nonstopmode -output-directory %o %f\"
692 \"xelatex -interaction nonstopmode -output-directory %o %f\"
693 ;; use below command(s) to convert latex fragments
694 (\"xelatex %f\"))
695
696With no such sublist, the default command used to convert LaTeX
697fragments will be the first string in the list.
698
699The reason why this is a list is that it usually takes several runs of
700`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever
701mechanism to detect which of these commands have to be run to get to a stable
702result, and it also does not do any error checking.
703
704By default, Org uses 3 runs of `pdflatex' to do the processing. If you
705have texi2dvi on your system and if that does not cause the infamous
706egrep/locale bug:
707
708 http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
709
710then `texi2dvi' is the superior choice. Org does offer it as one
711of the customize options.
712
713Alternatively, this may be a Lisp function that does the processing, so you
714could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
715This function should accept the file name as its single argument."
716 :group 'org-export-pdf
717 :type '(choice
718 (repeat :tag "Shell command sequence"
719 (string :tag "Shell command"))
720 (const :tag "2 runs of pdflatex"
721 ("pdflatex -interaction nonstopmode -output-directory %o %f"
722 "pdflatex -interaction nonstopmode -output-directory %o %f"))
723 (const :tag "3 runs of pdflatex"
724 ("pdflatex -interaction nonstopmode -output-directory %o %f"
725 "pdflatex -interaction nonstopmode -output-directory %o %f"
726 "pdflatex -interaction nonstopmode -output-directory %o %f"))
727 (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
728 ("pdflatex -interaction nonstopmode -output-directory %o %f"
729 "bibtex %b"
730 "pdflatex -interaction nonstopmode -output-directory %o %f"
731 "pdflatex -interaction nonstopmode -output-directory %o %f"))
732 (const :tag "2 runs of xelatex"
733 ("xelatex -interaction nonstopmode -output-directory %o %f"
734 "xelatex -interaction nonstopmode -output-directory %o %f"))
735 (const :tag "3 runs of xelatex"
736 ("xelatex -interaction nonstopmode -output-directory %o %f"
737 "xelatex -interaction nonstopmode -output-directory %o %f"
738 "xelatex -interaction nonstopmode -output-directory %o %f"))
739 (const :tag "xelatex,bibtex,xelatex,xelatex"
740 ("xelatex -interaction nonstopmode -output-directory %o %f"
741 "bibtex %b"
742 "xelatex -interaction nonstopmode -output-directory %o %f"
743 "xelatex -interaction nonstopmode -output-directory %o %f"))
744 (const :tag "texi2dvi"
745 ("texi2dvi -p -b -c -V %f"))
746 (const :tag "rubber"
747 ("rubber -d --into %o %f"))
748 (function)))
749
750(defcustom org-export-pdf-logfiles
751 '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
752 "The list of file extensions to consider as LaTeX logfiles."
753 :group 'org-export-pdf
754 :version "24.1"
755 :type '(repeat (string :tag "Extension")))
756
757(defcustom org-export-pdf-remove-logfiles t
758 "Non-nil means remove the logfiles produced by PDF production.
759These are the .aux, .log, .out, and .toc files."
760 :group 'org-export-pdf
761 :type 'boolean)
762
763;;; Hooks
764
765(defvar org-export-latex-after-initial-vars-hook nil
766 "Hook run before LaTeX export.
767The exact moment is after the initial variables like org-export-latex-class
768have been determined from the environment.")
769
770(defvar org-export-latex-after-blockquotes-hook nil
771 "Hook run during LaTeX export, after blockquote, verse, center are done.")
772
773(defvar org-export-latex-final-hook nil
774 "Hook run in the finalized LaTeX buffer.")
775
776(defvar org-export-latex-after-save-hook nil
777 "Hook run in the finalized LaTeX buffer, after it has been saved.")
778
779;;; Autoload functions:
780
781;;;###autoload
782(defun org-export-as-latex-batch ()
783 "Call `org-export-as-latex', may be used in batch processing.
784For example:
785
786emacs --batch
787 --load=$HOME/lib/emacs/org.el
788 --eval \"(setq org-export-headline-levels 2)\"
789 --visit=MyFile --funcall org-export-as-latex-batch"
790 (org-export-as-latex org-export-headline-levels))
791
792;;;###autoload
793(defun org-export-as-latex-to-buffer (arg)
794 "Call `org-export-as-latex` with output to a temporary buffer.
795No file is created. The prefix ARG is passed through to `org-export-as-latex'."
796 (interactive "P")
797 (org-export-as-latex arg nil "*Org LaTeX Export*")
798 (when org-export-show-temporary-export-buffer
799 (switch-to-buffer-other-window "*Org LaTeX Export*")))
800
801;;;###autoload
802(defun org-replace-region-by-latex (beg end)
803 "Replace the region from BEG to END with its LaTeX export.
804It assumes the region has `org-mode' syntax, and then convert it to
805LaTeX. This can be used in any buffer. For example, you could
806write an itemized list in `org-mode' syntax in an LaTeX buffer and
807then use this command to convert it."
808 (interactive "r")
809 (let (reg latex buf)
810 (save-window-excursion
811 (if (derived-mode-p 'org-mode)
812 (setq latex (org-export-region-as-latex
813 beg end t 'string))
814 (setq reg (buffer-substring beg end)
815 buf (get-buffer-create "*Org tmp*"))
816 (with-current-buffer buf
817 (erase-buffer)
818 (insert reg)
819 (org-mode)
820 (setq latex (org-export-region-as-latex
821 (point-min) (point-max) t 'string)))
822 (kill-buffer buf)))
823 (delete-region beg end)
824 (insert latex)))
825
826;;;###autoload
827(defun org-export-region-as-latex (beg end &optional body-only buffer)
828 "Convert region from BEG to END in `org-mode' buffer to LaTeX.
829If prefix arg BODY-ONLY is set, omit file header, footer, and table of
830contents, and only produce the region of converted text, useful for
831cut-and-paste operations.
832If BUFFER is a buffer or a string, use/create that buffer as a target
833of the converted LaTeX. If BUFFER is the symbol `string', return the
834produced LaTeX as a string and leave no buffer behind. For example,
835a Lisp program could call this function in the following way:
836
837 (setq latex (org-export-region-as-latex beg end t 'string))
838
839When called interactively, the output buffer is selected, and shown
840in a window. A non-interactive call will only return the buffer."
841 (interactive "r\nP")
842 (when (org-called-interactively-p 'any)
843 (setq buffer "*Org LaTeX Export*"))
844 (let ((transient-mark-mode t) (zmacs-regions t)
845 ext-plist rtn)
846 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
847 (goto-char end)
848 (set-mark (point)) ;; to activate the region
849 (goto-char beg)
850 (setq rtn (org-export-as-latex
851 nil ext-plist
852 buffer body-only))
853 (if (fboundp 'deactivate-mark) (deactivate-mark))
854 (if (and (org-called-interactively-p 'any) (bufferp rtn))
855 (switch-to-buffer-other-window rtn)
856 rtn)))
857
858;;;###autoload
859(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir)
860 "Export current buffer to a LaTeX file.
861If there is an active region, export only the region. The prefix
862ARG specifies how many levels of the outline should become
863headlines. The default is 3. Lower levels will be exported
864depending on `org-export-latex-low-levels'. The default is to
865convert them as description lists.
866EXT-PLIST is a property list with external parameters overriding
867org-mode's default settings, but still inferior to file-local settings.
868When TO-BUFFER is non-nil, create a buffer with that name and export
869to that buffer. If TO-BUFFER is the symbol `string', don't leave any
870buffer behind and just return the resulting LaTeX as a string, with
871no LaTeX header.
872When BODY-ONLY is set, don't produce the file header and footer,
873simply return the content of \\begin{document}...\\end{document},
874without even the \\begin{document} and \\end{document} commands.
875When PUB-DIR is set, use this as the publishing directory."
876 (interactive "P")
877 (when (and (not body-only) arg (listp arg)) (setq body-only t))
878 (run-hooks 'org-export-first-hook)
879
880 ;; Make sure we have a file name when we need it.
881 (when (and (not (or to-buffer body-only))
882 (not buffer-file-name))
883 (if (buffer-base-buffer)
884 (org-set-local 'buffer-file-name
885 (with-current-buffer (buffer-base-buffer)
886 buffer-file-name))
887 (error "Need a file name to be able to export")))
888
889 (message "Exporting to LaTeX...")
890 (org-unmodified
891 (let ((inhibit-read-only t))
892 (remove-text-properties (point-min) (point-max)
893 '(:org-license-to-kill nil))))
894 (org-update-radio-target-regexp)
895 (org-export-latex-set-initial-vars ext-plist arg)
896 (setq org-export-opt-plist org-export-latex-options-plist
897 org-export-footnotes-data (org-footnote-all-labels 'with-defs)
898 org-export-footnotes-seen nil
899 org-export-latex-footmark-seen nil)
900 (org-install-letbind)
901 (run-hooks 'org-export-latex-after-initial-vars-hook)
902 (let* ((wcf (current-window-configuration))
903 (opt-plist
904 (org-export-process-option-filters org-export-latex-options-plist))
905 (region-p (org-region-active-p))
906 (rbeg (and region-p (region-beginning)))
907 (rend (and region-p (region-end)))
908 (subtree-p
909 (if (plist-get opt-plist :ignore-subtree-p)
910 nil
911 (when region-p
912 (save-excursion
913 (goto-char rbeg)
914 (and (org-at-heading-p)
915 (>= (org-end-of-subtree t t) rend))))))
916 (opt-plist (setq org-export-opt-plist
917 (if subtree-p
918 (org-export-add-subtree-options opt-plist rbeg)
919 opt-plist)))
920 ;; Make sure the variable contains the updated values.
921 (org-export-latex-options-plist (setq org-export-opt-plist opt-plist))
922 ;; The following two are dynamically scoped into other
923 ;; routines below.
924 (org-current-export-dir
925 (or pub-dir (org-export-directory :html opt-plist)))
926 (org-current-export-file buffer-file-name)
927 (title (or (and subtree-p (org-export-get-title-from-subtree))
928 (plist-get opt-plist :title)
929 (and (not
930 (plist-get opt-plist :skip-before-1st-heading))
931 (org-export-grab-title-from-buffer))
932 (and buffer-file-name
933 (file-name-sans-extension
934 (file-name-nondirectory buffer-file-name)))
935 "No Title"))
936 (filename
937 (and (not to-buffer)
938 (concat
939 (file-name-as-directory
940 (or pub-dir
941 (org-export-directory :LaTeX org-export-latex-options-plist)))
942 (file-name-sans-extension
943 (or (and subtree-p
944 (org-entry-get rbeg "EXPORT_FILE_NAME" t))
945 (file-name-nondirectory ;sans-extension
946 (or buffer-file-name
947 (error "Don't know which export file to use")))))
948 ".tex")))
949 (filename
950 (and filename
951 (if (equal (file-truename filename)
952 (file-truename (or buffer-file-name "dummy.org")))
953 (concat filename ".tex")
954 filename)))
955 (auto-insert nil); Avoid any auto-insert stuff for the new file
956 (TeX-master (boundp 'TeX-master))
957 (buffer (if to-buffer
958 (if (eq to-buffer 'string)
959 (get-buffer-create "*Org LaTeX Export*")
960 (get-buffer-create to-buffer))
961 (find-file-noselect filename)))
962 (odd org-odd-levels-only)
963 (header (org-export-latex-make-header title opt-plist))
964 (skip (cond (subtree-p nil)
965 (region-p nil)
966 (t (plist-get opt-plist :skip-before-1st-heading))))
967 (text (plist-get opt-plist :text))
968 (org-export-preprocess-hook
969 (cons
970 `(lambda () (org-set-local 'org-complex-heading-regexp
971 ,org-export-latex-complex-heading-re))
972 org-export-preprocess-hook))
973 (first-lines (if skip "" (org-export-latex-first-lines
974 opt-plist
975 (if subtree-p
976 (save-excursion
977 (goto-char rbeg)
978 (point-at-bol 2))
979 rbeg)
980 (if region-p rend))))
981 (coding-system (and (boundp 'buffer-file-coding-system)
982 buffer-file-coding-system))
983 (coding-system-for-write (or org-export-latex-coding-system
984 coding-system))
985 (save-buffer-coding-system (or org-export-latex-coding-system
986 coding-system))
987 (region (buffer-substring
988 (if region-p (region-beginning) (point-min))
989 (if region-p (region-end) (point-max))))
990 (text
991 (and text (string-match "\\S-" text)
992 (org-export-preprocess-string
993 text
994 :emph-multiline t
995 :for-backend 'latex
996 :comments nil
997 :tags (plist-get opt-plist :tags)
998 :priority (plist-get opt-plist :priority)
999 :footnotes (plist-get opt-plist :footnotes)
1000 :drawers (plist-get opt-plist :drawers)
1001 :timestamps (plist-get opt-plist :timestamps)
1002 :todo-keywords (plist-get opt-plist :todo-keywords)
1003 :tasks (plist-get opt-plist :tasks)
1004 :add-text nil
1005 :skip-before-1st-heading skip
1006 :select-tags nil
1007 :exclude-tags nil
1008 :LaTeX-fragments nil)))
1009 (string-for-export
1010 (org-export-preprocess-string
1011 region
1012 :emph-multiline t
1013 :for-backend 'latex
1014 :comments nil
1015 :tags (plist-get opt-plist :tags)
1016 :priority (plist-get opt-plist :priority)
1017 :footnotes (plist-get opt-plist :footnotes)
1018 :drawers (plist-get opt-plist :drawers)
1019 :timestamps (plist-get opt-plist :timestamps)
1020 :todo-keywords (plist-get opt-plist :todo-keywords)
1021 :tasks (plist-get opt-plist :tasks)
1022 :add-text (if (eq to-buffer 'string) nil text)
1023 :skip-before-1st-heading skip
1024 :select-tags (plist-get opt-plist :select-tags)
1025 :exclude-tags (plist-get opt-plist :exclude-tags)
1026 :LaTeX-fragments nil)))
1027
1028 (set-buffer buffer)
1029 (erase-buffer)
1030 (org-install-letbind)
1031
1032 (and (fboundp 'set-buffer-file-coding-system)
1033 (set-buffer-file-coding-system coding-system-for-write))
1034
1035 ;; insert the header and initial document commands
1036 (unless (or (eq to-buffer 'string) body-only)
1037 (insert header))
1038
1039 ;; insert text found in #+TEXT
1040 (when (and text (not (eq to-buffer 'string)))
1041 (insert (org-export-latex-content
1042 text '(lists tables fixed-width keywords))
1043 "\n\n"))
1044
1045 ;; insert lines before the first headline
1046 (unless (or skip (string-match "^\\*" first-lines))
1047 (insert first-lines))
1048
1049 ;; export the content of headlines
1050 (org-export-latex-global
1051 (with-temp-buffer
1052 (insert string-for-export)
1053 (goto-char (point-min))
1054 (when (re-search-forward "^\\(\\*+\\) " nil t)
1055 (let* ((asters (length (match-string 1)))
1056 (level (if odd (- asters 2) (- asters 1))))
1057 (setq org-export-latex-add-level
1058 (if odd (1- (/ (1+ asters) 2)) (1- asters)))
1059 (org-export-latex-parse-global level odd)))))
1060
1061 ;; finalization
1062 (unless body-only (insert "\n\\end{document}"))
1063
1064 ;; Attach description terms to the \item macro
1065 (goto-char (point-min))
1066 (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t)
1067 (delete-region (match-beginning 1) (match-end 1)))
1068
1069 ;; Relocate the table of contents
1070 (goto-char (point-min))
1071 (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
1072 (goto-char (point-min))
1073 (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t)
1074 (replace-match ""))
1075 (goto-char (point-min))
1076 (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
1077 (replace-match "\\tableofcontents" t t)))
1078
1079 ;; Cleanup forced line ends in items where they are not needed
1080 (goto-char (point-min))
1081 (while (re-search-forward
1082 "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin"
1083 nil t)
1084 (delete-region (match-beginning 1) (match-end 1)))
1085 (goto-char (point-min))
1086 (while (re-search-forward
1087 "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*"
1088 nil t)
1089 (if (looking-at "[\n \t]+")
1090 (replace-match "\n")))
1091
1092 ;; Ensure we have a final newline
1093 (goto-char (point-max))
1094 (or (eq (char-before) ?\n)
1095 (insert ?\n))
1096
1097 (run-hooks 'org-export-latex-final-hook)
1098 (if to-buffer
1099 (unless (eq major-mode 'latex-mode) (latex-mode))
1100 (save-buffer))
1101 (org-export-latex-fix-inputenc)
1102 (run-hooks 'org-export-latex-after-save-hook)
1103 (goto-char (point-min))
1104 (or (org-export-push-to-kill-ring "LaTeX")
1105 (message "Exporting to LaTeX...done"))
1106 (prog1
1107 (if (eq to-buffer 'string)
1108 (prog1 (buffer-substring (point-min) (point-max))
1109 (kill-buffer (current-buffer)))
1110 (current-buffer))
1111 (set-window-configuration wcf))))
1112
1113;;;###autoload
1114(defun org-export-as-pdf (arg &optional hidden ext-plist
1115 to-buffer body-only pub-dir)
1116 "Export as LaTeX, then process through to PDF."
1117 (interactive "P")
1118 (message "Exporting to PDF...")
1119 (let* ((wconfig (current-window-configuration))
1120 (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir))
1121 (file (buffer-file-name lbuf))
1122 (base (file-name-sans-extension (buffer-file-name lbuf)))
1123 (pdffile (concat base ".pdf"))
1124 (cmds (if (eq org-export-latex-listings 'minted)
1125 ;; automatically add -shell-escape when needed
1126 (mapcar (lambda (cmd)
1127 (replace-regexp-in-string
1128 "pdflatex " "pdflatex -shell-escape " cmd))
1129 org-latex-to-pdf-process)
1130 org-latex-to-pdf-process))
1131 (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
1132 (bibtex-p (with-current-buffer lbuf
1133 (save-excursion
1134 (goto-char (point-min))
1135 (re-search-forward "\\\\bibliography{" nil t))))
1136 cmd output-dir errors)
1137 (with-current-buffer outbuf (erase-buffer))
1138 (message (concat "Processing LaTeX file " file "..."))
1139 (setq output-dir (file-name-directory file))
1140 (with-current-buffer lbuf
1141 (save-excursion
1142 (if (and cmds (symbolp cmds))
1143 (funcall cmds (shell-quote-argument file))
1144 (while cmds
1145 (setq cmd (pop cmds))
1146 (cond
1147 ((not (listp cmd))
1148 (while (string-match "%b" cmd)
1149 (setq cmd (replace-match
1150 (save-match-data
1151 (shell-quote-argument base))
1152 t t cmd)))
1153 (while (string-match "%f" cmd)
1154 (setq cmd (replace-match
1155 (save-match-data
1156 (shell-quote-argument file))
1157 t t cmd)))
1158 (while (string-match "%o" cmd)
1159 (setq cmd (replace-match
1160 (save-match-data
1161 (shell-quote-argument output-dir))
1162 t t cmd)))
1163 (shell-command cmd outbuf)))))))
1164 (message (concat "Processing LaTeX file " file "...done"))
1165 (setq errors (org-export-latex-get-error outbuf))
1166 (if (not (file-exists-p pdffile))
1167 (error (concat "PDF file " pdffile " was not produced"
1168 (if errors (concat ":" errors "") "")))
1169 (set-window-configuration wconfig)
1170 (when org-export-pdf-remove-logfiles
1171 (dolist (ext org-export-pdf-logfiles)
1172 (setq file (concat base "." ext))
1173 (and (file-exists-p file) (delete-file file))))
1174 (message (concat
1175 "Exporting to PDF...done"
1176 (if errors
1177 (concat ", with some errors:" errors)
1178 "")))
1179 pdffile)))
1180
1181(defun org-export-latex-get-error (buf)
1182 "Collect the kinds of errors that remain in pdflatex processing."
1183 (with-current-buffer buf
1184 (save-excursion
1185 (goto-char (point-max))
1186 (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
1187 ;; OK, we are at the location of the final run
1188 (let ((pos (point)) (errors "") (case-fold-search t))
1189 (if (re-search-forward "Reference.*?undefined" nil t)
1190 (setq errors (concat errors " [undefined reference]")))
1191 (goto-char pos)
1192 (if (re-search-forward "Citation.*?undefined" nil t)
1193 (setq errors (concat errors " [undefined citation]")))
1194 (goto-char pos)
1195 (if (re-search-forward "Undefined control sequence" nil t)
1196 (setq errors (concat errors " [undefined control sequence]")))
1197 (and (org-string-nw-p errors) errors))))))
1198
1199;;;###autoload
1200(defun org-export-as-pdf-and-open (arg)
1201 "Export as LaTeX, then process through to PDF, and open."
1202 (interactive "P")
1203 (let ((pdffile (org-export-as-pdf arg)))
1204 (if pdffile
1205 (progn
1206 (org-open-file pdffile)
1207 (when org-export-kill-product-buffer-when-displayed
1208 (kill-buffer (find-buffer-visiting
1209 (concat (file-name-sans-extension (buffer-file-name))
1210 ".tex")))))
1211 (error "PDF file was not produced"))))
1212
1213;;; Parsing functions:
1214
1215(defun org-export-latex-parse-global (level odd)
1216 "Parse the current buffer recursively, starting at LEVEL.
1217If ODD is non-nil, assume the buffer only contains odd sections.
1218Return a list reflecting the document structure."
1219 (save-excursion
1220 (goto-char (point-min))
1221 (let* ((cnt 0) output
1222 (depth org-export-latex-sectioning-depth))
1223 (while (org-re-search-forward-unprotected
1224 (concat "^\\(\\(?:\\*\\)\\{"
1225 (number-to-string (+ (if odd 2 1) level))
1226 "\\}\\) \\(.*\\)$")
1227 ;; make sure that there is no upper heading
1228 (when (> level 0)
1229 (save-excursion
1230 (save-match-data
1231 (org-re-search-forward-unprotected
1232 (concat "^\\(\\(?:\\*\\)\\{"
1233 (number-to-string level)
1234 "\\}\\) \\(.*\\)$") nil t)))) t)
1235 (setq cnt (1+ cnt))
1236 (let* ((pos (match-beginning 0))
1237 (heading (match-string 2))
1238 (nlevel (if odd (/ (+ 3 level) 2) (1+ level))))
1239 (save-excursion
1240 (narrow-to-region
1241 (point)
1242 (save-match-data
1243 (if (org-re-search-forward-unprotected
1244 (concat "^\\(\\(?:\\*\\)\\{"
1245 (number-to-string (+ (if odd 2 1) level))
1246 "\\}\\) \\(.*\\)$") nil t)
1247 (match-beginning 0)
1248 (point-max))))
1249 (goto-char (point-min))
1250 (setq output
1251 (append output
1252 (list
1253 (list
1254 `(pos . ,pos)
1255 `(level . ,nlevel)
1256 `(occur . ,cnt)
1257 `(heading . ,heading)
1258 `(content . ,(org-export-latex-parse-content))
1259 `(subcontent . ,(org-export-latex-parse-subcontent
1260 level odd)))))))
1261 (widen)))
1262 (list output))))
1263
1264(defun org-export-latex-parse-content ()
1265 "Extract the content of a section."
1266 (let ((beg (point))
1267 (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t)
1268 (progn (beginning-of-line) (point))
1269 (point-max))))
1270 (buffer-substring beg end)))
1271
1272(defun org-export-latex-parse-subcontent (level odd)
1273 "Extract the subcontent of a section at LEVEL.
1274If ODD Is non-nil, assume subcontent only contains odd sections."
1275 (if (not (org-re-search-forward-unprotected
1276 (concat "^\\(\\(?:\\*\\)\\{"
1277 (number-to-string (+ (if odd 4 2) level))
1278 "\\}\\) \\(.*\\)$")
1279 nil t))
1280 nil ; subcontent is nil
1281 (org-export-latex-parse-global (+ (if odd 2 1) level) odd)))
1282
1283;;; Rendering functions:
1284(defun org-export-latex-global (content)
1285 "Export CONTENT to LaTeX.
1286CONTENT is an element of the list produced by
1287`org-export-latex-parse-global'."
1288 (if (eq (car content) 'subcontent)
1289 (mapc 'org-export-latex-sub (cdr content))
1290 (org-export-latex-sub (car content))))
1291
1292(defun org-export-latex-sub (subcontent)
1293 "Export the list SUBCONTENT to LaTeX.
1294SUBCONTENT is an alist containing information about the headline
1295and its content."
1296 (let ((num (plist-get org-export-latex-options-plist :section-numbers)))
1297 (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent)))
1298
1299(defun org-export-latex-subcontent (subcontent num)
1300 "Export each cell of SUBCONTENT to LaTeX.
1301If NUM is non-nil export numbered sections, otherwise use unnumbered
1302sections. If NUM is an integer, export the highest NUM levels as
1303numbered sections and lower levels as unnumbered sections."
1304 (let* ((heading (cdr (assoc 'heading subcontent)))
1305 (level (- (cdr (assoc 'level subcontent))
1306 org-export-latex-add-level))
1307 (occur (number-to-string (cdr (assoc 'occur subcontent))))
1308 (content (cdr (assoc 'content subcontent)))
1309 (subcontent (cadr (assoc 'subcontent subcontent)))
1310 (label (org-get-text-property-any 0 'target heading))
1311 (label-list (cons label (cdr (assoc label
1312 org-export-target-aliases))))
1313 (sectioning org-export-latex-sectioning)
1314 (depth org-export-latex-sectioning-depth)
1315 main-heading sub-heading ctnt)
1316 (when (symbolp (car sectioning))
1317 (setq sectioning (funcall (car sectioning) level heading))
1318 (when sectioning
1319 (setq heading (car sectioning)
1320 sectioning (cdr sectioning)
1321 ;; target property migh have changed...
1322 label (org-get-text-property-any 0 'target heading)
1323 label-list (cons label (cdr (assoc label
1324 org-export-target-aliases)))))
1325 (if sectioning (setq sectioning (make-list 10 sectioning)))
1326 (setq depth (if sectioning 10000 0)))
1327 (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading)
1328 (setq main-heading (substring heading 0 (match-beginning 0))
1329 sub-heading (substring heading (match-end 0))))
1330 (setq heading (org-export-latex-fontify-headline heading)
1331 sub-heading (and sub-heading
1332 (org-export-latex-fontify-headline sub-heading))
1333 main-heading (and main-heading
1334 (org-export-latex-fontify-headline main-heading)))
1335 (cond
1336 ;; Normal conversion
1337 ((<= level depth)
1338 (let* ((sec (nth (1- level) sectioning))
1339 (num (if (integerp num)
1340 (>= num level)
1341 num))
1342 start end)
1343 (if (consp (cdr sec))
1344 (setq start (nth (if num 0 2) sec)
1345 end (nth (if num 1 3) sec))
1346 (setq start (if num (car sec) (cdr sec))))
1347 (insert (format start (if main-heading main-heading heading)
1348 (or sub-heading "")))
1349 (insert "\n")
1350 (when label
1351 (insert (mapconcat (lambda (l) (format "\\label{%s}" l))
1352 label-list "\n") "\n"))
1353 (insert (org-export-latex-content content))
1354 (cond ((stringp subcontent) (insert subcontent))
1355 ((listp subcontent)
1356 (while (org-looking-back "\n\n") (backward-delete-char 1))
1357 (org-export-latex-sub subcontent)))
1358 (when (and end (string-match "[^ \t]" end))
1359 (let ((hook (org-get-text-property-any 0 'org-insert-hook end)))
1360 (and (functionp hook) (funcall hook)))
1361 (insert end "\n"))))
1362 ;; At a level under the hl option: we can drop this subsection
1363 ((> level depth)
1364 (cond ((eq org-export-latex-low-levels 'description)
1365 (if (string-match "% ends low level$"
1366 (buffer-substring (point-at-bol 0) (point)))
1367 (delete-region (point-at-bol 0) (point))
1368 (insert "\\begin{description}\n"))
1369 (insert (format "\n\\item[%s]%s~\n"
1370 heading
1371 (if label (format "\\label{%s}" label) "")))
1372 (insert (org-export-latex-content content))
1373 (cond ((stringp subcontent) (insert subcontent))
1374 ((listp subcontent) (org-export-latex-sub subcontent)))
1375 (insert "\\end{description} % ends low level\n"))
1376 ((memq org-export-latex-low-levels '(itemize enumerate))
1377 (if (string-match "% ends low level$"
1378 (buffer-substring (point-at-bol 0) (point)))
1379 (delete-region (point-at-bol 0) (point))
1380 (insert (format "\\begin{%s}\n"
1381 (symbol-name org-export-latex-low-levels))))
1382 (let ((ctnt (org-export-latex-content content)))
1383 (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) ""))
1384 "\n\\item %s\\\\\n%s%%"
1385 "\n\\item %s\n%s%%")
1386 heading
1387 (if label (format "\\label{%s}" label) "")))
1388 (insert ctnt))
1389 (cond ((stringp subcontent) (insert subcontent))
1390 ((listp subcontent) (org-export-latex-sub subcontent)))
1391 (insert (format "\\end{%s} %% ends low level\n"
1392 (symbol-name org-export-latex-low-levels))))
1393
1394 ((and (listp org-export-latex-low-levels)
1395 org-export-latex-low-levels)
1396 (if (string-match "% ends low level$"
1397 (buffer-substring (point-at-bol 0) (point)))
1398 (delete-region (point-at-bol 0) (point))
1399 (insert (car org-export-latex-low-levels) "\n"))
1400 (insert (format (nth 2 org-export-latex-low-levels)
1401 heading
1402 (if label (format "\\label{%s}" label) "")))
1403 (insert (org-export-latex-content content))
1404 (cond ((stringp subcontent) (insert subcontent))
1405 ((listp subcontent) (org-export-latex-sub subcontent)))
1406 (insert (nth 1 org-export-latex-low-levels)
1407 " %% ends low level\n"))
1408
1409 ((stringp org-export-latex-low-levels)
1410 (insert (format org-export-latex-low-levels heading) "\n")
1411 (when label (insert (format "\\label{%s}\n" label)))
1412 (insert (org-export-latex-content content))
1413 (cond ((stringp subcontent) (insert subcontent))
1414 ((listp subcontent) (org-export-latex-sub subcontent)))))))))
1415
1416;;; Exporting internals:
1417(defun org-export-latex-set-initial-vars (ext-plist level)
1418 "Store org local variables required for LaTeX export.
1419EXT-PLIST is an optional additional plist.
1420LEVEL indicates the default depth for export."
1421 (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
1422 org-export-latex-done-keywords org-done-keywords
1423 org-export-latex-not-done-keywords org-not-done-keywords
1424 org-export-latex-complex-heading-re org-complex-heading-regexp
1425 org-export-latex-display-custom-times org-display-custom-times
1426 org-export-latex-all-targets-re
1427 (org-make-target-link-regexp (org-all-targets))
1428 org-export-latex-options-plist
1429 (org-combine-plists (org-default-export-plist) ext-plist
1430 (org-infile-export-plist))
1431 org-export-latex-class
1432 (or (and (org-region-active-p)
1433 (save-excursion
1434 (goto-char (region-beginning))
1435 (and (looking-at org-complex-heading-regexp)
1436 (org-entry-get nil "LaTeX_CLASS" 'selective))))
1437 (save-excursion
1438 (save-restriction
1439 (widen)
1440 (goto-char (point-min))
1441 (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t)
1442 (match-string 1))))
1443 (plist-get org-export-latex-options-plist :latex-class)
1444 org-export-latex-default-class)
1445 org-export-latex-class-options
1446 (or (and (org-region-active-p)
1447 (save-excursion
1448 (goto-char (region-beginning))
1449 (and (looking-at org-complex-heading-regexp)
1450 (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective))))
1451 (save-excursion
1452 (save-restriction
1453 (widen)
1454 (goto-char (point-min))
1455 (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t)
1456 (match-string 1))))
1457 (plist-get org-export-latex-options-plist :latex-class-options))
1458 org-export-latex-class
1459 (or (car (assoc org-export-latex-class org-export-latex-classes))
1460 (error "No definition for class `%s' in `org-export-latex-classes'"
1461 org-export-latex-class))
1462 org-export-latex-header
1463 (cadr (assoc org-export-latex-class org-export-latex-classes))
1464 org-export-latex-sectioning
1465 (cddr (assoc org-export-latex-class org-export-latex-classes))
1466 org-export-latex-sectioning-depth
1467 (or level
1468 (let ((hl-levels
1469 (plist-get org-export-latex-options-plist :headline-levels))
1470 (sec-depth (length org-export-latex-sectioning)))
1471 (if (> hl-levels sec-depth) sec-depth hl-levels))))
1472 (when (and org-export-latex-class-options
1473 (string-match "\\S-" org-export-latex-class-options)
1474 (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?"
1475 org-export-latex-header))
1476 (setq org-export-latex-header
1477 (concat (substring org-export-latex-header 0 (match-end 1))
1478 org-export-latex-class-options
1479 (substring org-export-latex-header (match-end 0))))))
1480
1481(defvar org-export-latex-format-toc-function
1482 'org-export-latex-format-toc-default
1483 "The function formatting returning the string to create the table of contents.
1484The function mus take one parameter, the depth of the table of contents.")
1485
1486(defun org-export-latex-make-header (title opt-plist)
1487 "Make the LaTeX header and return it as a string.
1488TITLE is the current title from the buffer or region.
1489OPT-PLIST is the options plist for current buffer."
1490 (let ((toc (plist-get opt-plist :table-of-contents))
1491 (author (org-export-apply-macros-in-string
1492 (plist-get opt-plist :author)))
1493 (email (replace-regexp-in-string
1494 "_" "\\\\_"
1495 (org-export-apply-macros-in-string
1496 (plist-get opt-plist :email))))
1497 (description (org-export-apply-macros-in-string
1498 (plist-get opt-plist :description)))
1499 (keywords (org-export-apply-macros-in-string
1500 (plist-get opt-plist :keywords))))
1501 (concat
1502 (if (plist-get opt-plist :time-stamp-file)
1503 (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
1504 ;; insert LaTeX custom header and packages from the list
1505 (org-splice-latex-header
1506 (org-export-apply-macros-in-string org-export-latex-header)
1507 org-export-latex-default-packages-alist
1508 org-export-latex-packages-alist nil
1509 (org-export-apply-macros-in-string
1510 (plist-get opt-plist :latex-header-extra)))
1511 ;; append another special variable
1512 (org-export-apply-macros-in-string org-export-latex-append-header)
1513 ;; define alert if not yet defined
1514 "\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
1515 ;; insert the title
1516 (format
1517 "\n\n\\title{%s}\n"
1518 (org-export-latex-fontify-headline title))
1519 ;; insert author info
1520 (if (plist-get opt-plist :author-info)
1521 (format "\\author{%s%s}\n"
1522 (org-export-latex-fontify-headline (or author user-full-name))
1523 (if (and (plist-get opt-plist :email-info) email
1524 (string-match "\\S-" email))
1525 (format "\\thanks{%s}" email)
1526 ""))
1527 (format "%%\\author{%s}\n"
1528 (org-export-latex-fontify-headline (or author user-full-name))))
1529 ;; insert the date
1530 (format "\\date{%s}\n"
1531 (format-time-string
1532 (or (plist-get opt-plist :date)
1533 org-export-latex-date-format)))
1534 ;; add some hyperref options
1535 (format org-export-latex-hyperref-options-format
1536 (org-export-latex-fontify-headline keywords)
1537 (org-export-latex-fontify-headline description)
1538 (org-version))
1539 ;; beginning of the document
1540 "\n\\begin{document}\n\n"
1541 ;; insert the title command
1542 (when (string-match "\\S-" title)
1543 (if (string-match "%s" org-export-latex-title-command)
1544 (format org-export-latex-title-command title)
1545 org-export-latex-title-command))
1546 "\n\n"
1547 ;; table of contents
1548 (when (and org-export-with-toc
1549 (plist-get opt-plist :section-numbers))
1550 (funcall org-export-latex-format-toc-function
1551 (cond ((numberp toc)
1552 (min toc (plist-get opt-plist :headline-levels)))
1553 (toc (plist-get opt-plist :headline-levels))))))))
1554
1555(defun org-export-latex-format-toc-default (depth)
1556 (when depth
1557 (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n"
1558 depth)))
1559
1560(defun org-export-latex-first-lines (opt-plist &optional beg end)
1561 "Export the first lines before first headline.
1562If BEG is non-nil, it is the beginning of the region.
1563If END is non-nil, it is the end of the region."
1564 (save-excursion
1565 (goto-char (or beg (point-min)))
1566 (let* ((pt (point))
1567 (end (if (re-search-forward
1568 (concat "^" (org-get-limited-outline-regexp)) end t)
1569 (goto-char (match-beginning 0))
1570 (goto-char (or end (point-max))))))
1571 (prog1
1572 (org-export-latex-content
1573 (org-export-preprocess-string
1574 (buffer-substring pt end)
1575 :for-backend 'latex
1576 :emph-multiline t
1577 :add-text nil
1578 :comments nil
1579 :skip-before-1st-heading nil
1580 :LaTeX-fragments nil
1581 :timestamps (plist-get opt-plist :timestamps)
1582 :footnotes (plist-get opt-plist :footnotes)))
1583 (org-unmodified
1584 (let ((inhibit-read-only t)
1585 (limit (max pt (1- end))))
1586 (add-text-properties pt limit
1587 '(:org-license-to-kill t))
1588 (save-excursion
1589 (goto-char pt)
1590 (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t)
1591 (let ((case-fold-search t))
1592 (unless (org-string-match-p
1593 "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)"
1594 (match-string 0))
1595 (remove-text-properties (match-beginning 0) (match-end 0)
1596 '(:org-license-to-kill t))))))))))))
1597
1598
1599(defvar org-export-latex-header-defs nil
1600 "The header definitions that might be used in the LaTeX body.")
1601
1602(defun org-export-latex-content (content &optional exclude-list)
1603 "Convert CONTENT string to LaTeX.
1604Don't perform conversions that are in EXCLUDE-LIST. Recognized
1605conversion types are: quotation-marks, emphasis, sub-superscript,
1606links, keywords, lists, tables, fixed-width"
1607 (with-temp-buffer
1608 (org-install-letbind)
1609 (insert content)
1610 (unless (memq 'timestamps exclude-list)
1611 (org-export-latex-time-stamps))
1612 (unless (memq 'quotation-marks exclude-list)
1613 (org-export-latex-quotation-marks))
1614 (unless (memq 'emphasis exclude-list)
1615 (when (plist-get org-export-latex-options-plist :emphasize)
1616 (org-export-latex-fontify)))
1617 (unless (memq 'sub-superscript exclude-list)
1618 (org-export-latex-special-chars
1619 (plist-get org-export-latex-options-plist :sub-superscript)))
1620 (unless (memq 'links exclude-list)
1621 (org-export-latex-links))
1622 (unless (memq 'keywords exclude-list)
1623 (org-export-latex-keywords))
1624 (unless (memq 'lists exclude-list)
1625 (org-export-latex-lists))
1626 (unless (memq 'tables exclude-list)
1627 (org-export-latex-tables
1628 (plist-get org-export-latex-options-plist :tables)))
1629 (unless (memq 'fixed-width exclude-list)
1630 (org-export-latex-fixed-width
1631 (plist-get org-export-latex-options-plist :fixed-width)))
1632 ;; return string
1633 (buffer-substring (point-min) (point-max))))
1634
1635(defun org-export-latex-protect-string (s)
1636 "Add the org-protected property to string S."
1637 (add-text-properties 0 (length s) '(org-protected t) s) s)
1638
1639(defun org-export-latex-protect-char-in-string (char-list string)
1640 "Add org-protected text-property to char from CHAR-LIST in STRING."
1641 (with-temp-buffer
1642 (save-match-data
1643 (insert string)
1644 (goto-char (point-min))
1645 (while (re-search-forward (regexp-opt char-list) nil t)
1646 (add-text-properties (match-beginning 0)
1647 (match-end 0) '(org-protected t)))
1648 (buffer-string))))
1649
1650(defun org-export-latex-keywords-maybe (&optional remove-list)
1651 "Maybe remove keywords depending on rules in REMOVE-LIST."
1652 (goto-char (point-min))
1653 (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
1654 (case-fold-search nil)
1655 (todo-markup org-export-latex-todo-keyword-markup)
1656 fmt)
1657 ;; convert TODO keywords
1658 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
1659 (if (plist-get remove-list :todo)
1660 (replace-match "")
1661 (setq fmt (cond
1662 ((stringp todo-markup) todo-markup)
1663 ((and (consp todo-markup) (stringp (car todo-markup)))
1664 (if (member (match-string 1) org-export-latex-done-keywords)
1665 (cdr todo-markup) (car todo-markup)))
1666 (t (cdr (or (assoc (match-string 1) todo-markup)
1667 (car todo-markup))))))
1668 (replace-match (org-export-latex-protect-string
1669 (format fmt (match-string 1))) t t)))
1670 ;; convert priority string
1671 (when (re-search-forward "\\[\\\\#.\\]" nil t)
1672 (if (plist-get remove-list :priority)
1673 (replace-match "")
1674 (replace-match (format "\\textbf{%s}" (match-string 0)) t t)))
1675 ;; convert tags
1676 (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t)
1677 (if (or (not org-export-with-tags)
1678 (plist-get remove-list :tags))
1679 (replace-match "")
1680 (replace-match
1681 (org-export-latex-protect-string
1682 (format org-export-latex-tag-markup
1683 (save-match-data
1684 (replace-regexp-in-string
1685 "\\([_#]\\)" "\\\\\\1" (match-string 0)))))
1686 t t)))))
1687
1688(defun org-export-latex-fontify-headline (string)
1689 "Fontify special words in STRING."
1690 (with-temp-buffer
1691 ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
1692 ;; the beginning of the buffer - inserting "\n" is safe here though.
1693 (insert "\n" string)
1694
1695 ;; Preserve math snippets
1696
1697 (let* ((matchers (plist-get org-format-latex-options :matchers))
1698 (re-list org-latex-regexps)
1699 beg end re e m n block off)
1700 ;; Check the different regular expressions
1701 (while (setq e (pop re-list))
1702 (setq m (car e) re (nth 1 e) n (nth 2 e)
1703 block (if (nth 3 e) "\n\n" ""))
1704 (setq off (if (member m '("$" "$1")) 1 0))
1705 (when (and (member m matchers) (not (equal m "begin")))
1706 (goto-char (point-min))
1707 (while (re-search-forward re nil t)
1708 (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
1709 (add-text-properties beg end
1710 '(org-protected t org-latex-math t))))))
1711
1712 ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
1713 (goto-char (point-min))
1714 (let ((case-fold-search nil))
1715 (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
1716 (unless (eq (char-before (match-beginning 1)) ?\\)
1717 (org-if-unprotected-1
1718 (replace-match (org-export-latex-protect-string
1719 (concat "\\" (match-string 1)
1720 "{}")) t t)))))
1721 (goto-char (point-min))
1722 (let ((re (concat "\\\\\\([a-zA-Z]+\\)"
1723 "\\(?:<[^<>\n]*>\\)*"
1724 "\\(?:\\[[^][\n]*?\\]\\)*"
1725 "\\(?:<[^<>\n]*>\\)*"
1726 "\\("
1727 (org-create-multibrace-regexp "{" "}" 3)
1728 "\\)\\{1,3\\}")))
1729 (while (re-search-forward re nil t)
1730 (unless (or
1731 ;; check for comment line
1732 (save-excursion (goto-char (match-beginning 0))
1733 (org-in-indented-comment-line))
1734 ;; Check if this is a defined entity, so that is may need conversion
1735 (org-entity-get (match-string 1)))
1736 (add-text-properties (match-beginning 0) (match-end 0)
1737 '(org-protected t)))))
1738 (when (plist-get org-export-latex-options-plist :emphasize)
1739 (org-export-latex-fontify))
1740 (org-export-latex-time-stamps)
1741 (org-export-latex-quotation-marks)
1742 (org-export-latex-keywords-maybe)
1743 (org-export-latex-special-chars
1744 (plist-get org-export-latex-options-plist :sub-superscript))
1745 (org-export-latex-links)
1746 (org-trim (buffer-string))))
1747
1748(defun org-export-latex-time-stamps ()
1749 "Format time stamps."
1750 (goto-char (point-min))
1751 (let ((org-display-custom-times org-export-latex-display-custom-times))
1752 (while (re-search-forward org-ts-regexp-both nil t)
1753 (org-if-unprotected-at (1- (point))
1754 (replace-match
1755 (org-export-latex-protect-string
1756 (format (if (string= "<" (substring (match-string 0) 0 1))
1757 org-export-latex-timestamp-markup
1758 org-export-latex-timestamp-inactive-markup)
1759 (substring (org-translate-time (match-string 0)) 1 -1)))
1760 t t)))))
1761
1762(defun org-export-latex-quotation-marks ()
1763 "Export quotation marks depending on language conventions."
1764 (mapc (lambda(l)
1765 (goto-char (point-min))
1766 (while (re-search-forward (car l) nil t)
1767 (let ((rpl (concat (match-string 1)
1768 (org-export-latex-protect-string
1769 (copy-sequence (cdr l))))))
1770 (org-if-unprotected-1
1771 (replace-match rpl t t)))))
1772 (cdr (or (assoc (plist-get org-export-latex-options-plist :language)
1773 org-export-latex-quotes)
1774 ;; falls back on english
1775 (assoc "en" org-export-latex-quotes)))))
1776
1777(defun org-export-latex-special-chars (sub-superscript)
1778 "Export special characters to LaTeX.
1779If SUB-SUPERSCRIPT is non-nil, convert \\ and ^.
1780See the `org-export-latex.el' code for a complete conversion table."
1781 (goto-char (point-min))
1782 (mapc (lambda(c)
1783 (goto-char (point-min))
1784 (while (re-search-forward c nil t)
1785 ;; Put the point where to check for org-protected
1786 (unless (get-text-property (match-beginning 2) 'org-protected)
1787 (cond ((member (match-string 2) '("\\$" "$"))
1788 (if (equal (match-string 2) "\\$")
1789 nil
1790 (replace-match "\\$" t t)))
1791 ((member (match-string 2) '("&" "%" "#"))
1792 (if (equal (match-string 1) "\\")
1793 (replace-match (match-string 2) t t)
1794 (replace-match (concat (match-string 1) "\\"
1795 (match-string 2)) t t)
1796 (backward-char 1)))
1797 ((equal (match-string 2) "...")
1798 (replace-match
1799 (concat (match-string 1)
1800 (org-export-latex-protect-string "\\ldots{}")) t t))
1801 ((equal (match-string 2) "~")
1802 (cond ((equal (match-string 1) "\\") nil)
1803 ((eq 'org-link (get-text-property 0 'face (match-string 2)))
1804 (replace-match (concat (match-string 1) "\\~") t t))
1805 (t (replace-match
1806 (org-export-latex-protect-string
1807 (concat (match-string 1) "\\~{}")) t t))))
1808 ((member (match-string 2) '("{" "}"))
1809 (unless (save-match-data (org-inside-latex-math-p))
1810 (if (equal (match-string 1) "\\")
1811 (replace-match (match-string 2) t t)
1812 (replace-match (concat (match-string 1) "\\"
1813 (match-string 2)) t t)))))
1814 (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p)))
1815 (cond ((equal (match-string 2) "\\")
1816 (replace-match (or (save-match-data
1817 (org-export-latex-treat-backslash-char
1818 (match-string 1)
1819 (or (match-string 3) "")))
1820 "") t t)
1821 (when (and (get-text-property (1- (point)) 'org-entity)
1822 (looking-at "{}"))
1823 ;; OK, this was an entity replacement, and the user
1824 ;; had terminated the entity with {}. Make sure
1825 ;; {} is protected as well, and remove the extra {}
1826 ;; inserted by the conversion.
1827 (put-text-property (point) (+ 2 (point)) 'org-protected t)
1828 (if (save-excursion (goto-char (max (- (point) 2) (point-min)))
1829 (looking-at "{}"))
1830 (replace-match ""))
1831 (forward-char 2))
1832 (backward-char 1))
1833 ((member (match-string 2) '("_" "^"))
1834 (replace-match (or (save-match-data
1835 (org-export-latex-treat-sub-super-char
1836 sub-superscript
1837 (match-string 2)
1838 (match-string 1)
1839 (match-string 3))) "") t t)
1840 (backward-char 1)))))))
1841 '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$"
1842 "\\(\\(\\\\?\\$\\)\\)"
1843 "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)"
1844 "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)"
1845 "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)"
1846 ;; (?\< . "\\textless{}")
1847 ;; (?\> . "\\textgreater{}")
1848 )))
1849
1850(defun org-inside-latex-math-p ()
1851 (get-text-property (point) 'org-latex-math))
1852
1853(defun org-export-latex-treat-sub-super-char
1854 (subsup char string-before string-after)
1855 "Convert the \"_\" and \"^\" characters to LaTeX.
1856SUBSUP corresponds to the ^: option in the #+OPTIONS line.
1857Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
1858 (cond ((equal string-before "\\")
1859 (concat string-before char string-after))
1860 ((and (string-match "\\S-+" string-after))
1861 ;; this is part of a math formula
1862 (cond ((eq 'org-link (get-text-property 0 'face char))
1863 (concat string-before "\\" char string-after))
1864 ((save-match-data (org-inside-latex-math-p))
1865 (if subsup
1866 (cond ((eq 1 (length string-after))
1867 (concat string-before char string-after))
1868 ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after)
1869 (format "%s%s{%s}" string-before char
1870 (match-string 1 string-after))))))
1871 ((and (> (length string-after) 1)
1872 (or (eq subsup t)
1873 (and (equal subsup '{}) (eq (string-to-char string-after) ?\{)))
1874 (or (string-match "[{]?\\([^}]+\\)[}]?" string-after)
1875 (string-match "[(]?\\([^)]+\\)[)]?" string-after)))
1876
1877 (org-export-latex-protect-string
1878 (format "%s$%s{%s}$" string-before char
1879 (if (and (> (match-end 1) (1+ (match-beginning 1)))
1880 (not (equal (substring string-after 0 2) "{\\")))
1881 (concat "\\mathrm{" (match-string 1 string-after) "}")
1882 (match-string 1 string-after)))))
1883 ((eq subsup t) (concat string-before "$" char string-after "$"))
1884 (t (org-export-latex-protect-string
1885 (concat string-before "\\" char "{}" string-after)))))
1886 (t (org-export-latex-protect-string
1887 (concat string-before "\\" char "{}" string-after)))))
1888
1889(defun org-export-latex-treat-backslash-char (string-before string-after)
1890 "Convert the \"$\" special character to LaTeX.
1891The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1892 (let ((ass (org-entity-get string-after)))
1893 (cond
1894 (ass (org-add-props
1895 (if (nth 2 ass)
1896 (concat string-before
1897 (org-export-latex-protect-string
1898 (concat "$" (nth 1 ass) "$")))
1899 (concat string-before (org-export-latex-protect-string
1900 (nth 1 ass))))
1901 nil 'org-entity t))
1902 ((and (not (string-match "^[ \n\t]" string-after))
1903 (not (string-match "[ \t]\\'\\|^" string-before)))
1904 ;; backslash is inside a word
1905 (concat string-before
1906 (org-export-latex-protect-string
1907 (concat "\\textbackslash{}" string-after))))
1908 ((not (or (equal string-after "")
1909 (string-match "^[ \t\n]" string-after)))
1910 ;; backslash might escape a character (like \#) or a user TeX
1911 ;; macro (like \setcounter)
1912 (concat string-before
1913 (org-export-latex-protect-string (concat "\\" string-after))))
1914 ((and (string-match "^[ \t\n]" string-after)
1915 (string-match "[ \t\n]\\'" string-before))
1916 ;; backslash is alone, convert it to $\backslash$
1917 (org-export-latex-protect-string
1918 (concat string-before "\\textbackslash{}" string-after)))
1919 (t (org-export-latex-protect-string
1920 (concat string-before "\\textbackslash{}" string-after))))))
1921
1922(defun org-export-latex-keywords ()
1923 "Convert special keywords to LaTeX."
1924 (goto-char (point-min))
1925 (while (re-search-forward org-export-latex-special-keyword-regexp nil t)
1926 (replace-match (format org-export-latex-timestamp-keyword-markup
1927 (match-string 0)) t t)
1928 (save-excursion
1929 (beginning-of-line 1)
1930 (unless (looking-at ".*\n[ \t]*\n")
1931 (end-of-line 1)
1932 (insert "\n")))))
1933
1934(defun org-export-latex-fixed-width (opt)
1935 "When OPT is non-nil convert fixed-width sections to LaTeX."
1936 (goto-char (point-min))
1937 (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
1938 (unless (get-text-property (point) 'org-example)
1939 (if opt
1940 (progn (goto-char (match-beginning 0))
1941 (insert "\\begin{verbatim}\n")
1942 (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
1943 (replace-match (concat (match-string 1)
1944 (match-string 2)) t t)
1945 (forward-line))
1946 (insert "\\end{verbatim}\n"))
1947 (progn (goto-char (match-beginning 0))
1948 (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
1949 (replace-match (concat "%" (match-string 1)
1950 (match-string 2)) t t)
1951 (forward-line)))))))
1952
1953(defvar org-table-last-alignment) ; defined in org-table.el
1954(defvar org-table-last-column-widths) ; defined in org-table.el
1955(declare-function orgtbl-to-latex "org-table" (table params) t)
1956(defun org-export-latex-tables (insert)
1957 "Convert tables to LaTeX and INSERT it."
1958 ;; First, get the table.el tables
1959 (goto-char (point-min))
1960 (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t)
1961 (org-if-unprotected
1962 (require 'table)
1963 (org-export-latex-convert-table.el-table)))
1964
1965 ;; And now the Org-mode tables
1966 (goto-char (point-min))
1967 (while (re-search-forward "^\\([ \t]*\\)|" nil t)
1968 (org-if-unprotected-at (1- (point))
1969 (org-table-align)
1970 (let* ((beg (org-table-begin))
1971 (end (org-table-end))
1972 (raw-table (buffer-substring beg end))
1973 (org-table-last-alignment (copy-sequence org-table-last-alignment))
1974 (org-table-last-column-widths (copy-sequence
1975 org-table-last-column-widths))
1976 fnum fields line lines olines gr colgropen line-fmt align
1977 caption width shortn label attr hfmt floatp placement
1978 longtblp tblenv tabular-env)
1979 (if org-export-latex-tables-verbatim
1980 (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
1981 "\\end{verbatim}\n")))
1982 (apply 'delete-region (list beg end))
1983 (insert (org-export-latex-protect-string tbl)))
1984 (progn
1985 (setq caption (org-find-text-property-in-string
1986 'org-caption raw-table)
1987 shortn (org-find-text-property-in-string
1988 'org-caption-shortn raw-table)
1989 attr (org-find-text-property-in-string
1990 'org-attributes raw-table)
1991 label (org-find-text-property-in-string
1992 'org-label raw-table)
1993 longtblp (and attr (stringp attr)
1994 (string-match "\\<longtable\\>" attr))
1995 tblenv (if (and attr (stringp attr))
1996 (cond ((string-match "\\<sidewaystable\\>" attr)
1997 "sidewaystable")
1998 ((or (string-match (regexp-quote "table*") attr)
1999 (string-match "\\<multicolumn\\>" attr))
2000 "table*")
2001 (t "table"))
2002 "table")
2003 tabular-env
2004 (if (and attr (stringp attr)
2005 (string-match "\\(tabular.\\)" attr))
2006 (match-string 1 attr)
2007 org-export-latex-tabular-environment)
2008 width (and attr (stringp attr)
2009 (string-match "\\<width=\\([^ \t\n\r]+\\)" attr)
2010 (match-string 1 attr))
2011 align (and attr (stringp attr)
2012 (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
2013 (match-string 1 attr))
2014 hfmt (and attr (stringp attr)
2015 (string-match "\\<hfmt=\\(\\S-+\\)" attr)
2016 (match-string 1 attr))
2017 floatp (or caption label (string= "table*" tblenv))
2018 placement (if (and attr
2019 (stringp attr)
2020 (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
2021 (match-string 1 attr)
2022 (concat
2023 "[" org-latex-default-figure-position "]")))
2024 (setq caption (and caption (org-export-latex-fontify-headline caption)))
2025 (setq lines (org-split-string raw-table "\n"))
2026 (apply 'delete-region (list beg end))
2027 (when org-export-table-remove-special-lines
2028 (setq lines (org-table-clean-before-export lines 'maybe-quoted)))
2029 (when org-table-clean-did-remove-column
2030 (pop org-table-last-alignment)
2031 (pop org-table-last-column-widths))
2032 ;; make a format string to reflect alignment
2033 (setq olines lines)
2034 (while (and (not line-fmt) (setq line (pop olines)))
2035 (unless (string-match "^[ \t]*|-" line)
2036 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
2037 (setq fnum (make-vector (length fields) 0))
2038 (setq line-fmt
2039 (mapconcat
2040 (lambda (x)
2041 (setq gr (pop org-table-colgroup-info))
2042 (format "%s%%s%s"
2043 (cond ((eq gr :start)
2044 (prog1 (if colgropen "|" "|")
2045 (setq colgropen t)))
2046 ((eq gr :startend)
2047 (prog1 (if colgropen "|" "|")
2048 (setq colgropen nil)))
2049 (t ""))
2050 (if (memq gr '(:end :startend))
2051 (progn (setq colgropen nil) "|")
2052 "")))
2053 fnum ""))))
2054 ;; fix double || in line-fmt
2055 (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt))
2056 ;; maybe remove the first and last "|"
2057 (when (and (not org-export-latex-tables-column-borders)
2058 (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt))
2059 (setq line-fmt (match-string 2 line-fmt)))
2060 ;; format alignment
2061 (unless align
2062 (setq align (apply 'format
2063 (cons line-fmt
2064 (mapcar (lambda (x) (if x "r" "l"))
2065 org-table-last-alignment)))))
2066 ;; prepare the table to send to orgtbl-to-latex
2067 (setq lines
2068 (mapcar
2069 (lambda(elem)
2070 (or (and (string-match "[ \t]*|-+" elem) 'hline)
2071 (org-split-string
2072 (progn (set-text-properties 0 (length elem) nil elem)
2073 (org-trim elem)) "|")))
2074 lines))
2075 (when insert
2076 (insert (org-export-latex-protect-string
2077 (concat
2078 (if longtblp
2079 (concat "\\begin{longtable}{" align "}\n")
2080 (if floatp
2081 (format "\\begin{%s}%s\n" tblenv placement)))
2082 (if (and floatp org-export-latex-table-caption-above)
2083 (format
2084 "\\caption%s{%s} %s"
2085 (if shortn (concat "[" shortn "]") "")
2086 (or caption "")
2087 (if label (format "\\label{%s}" label) "")))
2088 (if (and longtblp caption org-export-latex-table-caption-above)
2089 "\\\\\n" "\n")
2090 (if (and org-export-latex-tables-centered (not longtblp))
2091 "\\begin{center}\n")
2092 (if (not longtblp)
2093 (format "\\begin{%s}%s{%s}\n"
2094 tabular-env
2095 (if width (format "{%s}" width) "")
2096 align))
2097 (orgtbl-to-latex
2098 lines
2099 `(:tstart ,org-export-latex-tables-tstart
2100 :tend ,org-export-latex-tables-tend
2101 :hline ,org-export-latex-tables-hline
2102 :skipheadrule ,longtblp
2103 :hfmt ,hfmt
2104 :hlend ,(if longtblp
2105 (format "\\\\
2106%s
2107\\endhead
2108%s\\multicolumn{%d}{r}{Continued on next page}\\
2109\\endfoot
2110\\endlastfoot"
2111 org-export-latex-tables-hline
2112 org-export-latex-tables-hline
2113 (length org-table-last-alignment))
2114 nil)))
2115 (if (not longtblp) (format "\n\\end{%s}" tabular-env))
2116 (if longtblp "\n" (if org-export-latex-tables-centered
2117 "\n\\end{center}\n" "\n"))
2118 (if (and floatp (not org-export-latex-table-caption-above))
2119 (format
2120 "\\caption%s{%s} %s"
2121 (if shortn (concat "[" shortn "]") "")
2122 (or caption "")
2123 (if label (format "\\label{%s}" label) "")))
2124 (if longtblp
2125 "\\end{longtable}"
2126 (if floatp (format "\\end{%s}" tblenv)))))
2127 "\n\n"))))))))
2128
2129(defun org-export-latex-convert-table.el-table ()
2130 "Replace table.el table at point with LaTeX code."
2131 (let (tbl caption shortn label line floatp attr align rmlines)
2132 (setq line (buffer-substring (point-at-bol) (point-at-eol))
2133 label (org-get-text-property-any 0 'org-label line)
2134 caption (org-get-text-property-any 0 'org-caption line)
2135 shortn (org-get-text-property-any 0 'org-caption-shortn line)
2136 attr (org-get-text-property-any 0 'org-attributes line)
2137 align (and attr (stringp attr)
2138 (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr)
2139 (match-string 1 attr))
2140 rmlines (and attr (stringp attr)
2141 (string-match "\\<rmlines\\>" attr))
2142 floatp (or label caption))
2143 (and (get-buffer "*org-export-table*")
2144 (kill-buffer (get-buffer "*org-export-table*")))
2145 (table-generate-source 'latex "*org-export-table*" "caption")
2146 (setq tbl (with-current-buffer "*org-export-table*"
2147 (buffer-string)))
2148 (while (string-match "^%.*\n" tbl)
2149 (setq tbl (replace-match "" t t tbl)))
2150 ;; fix the hlines
2151 (when rmlines
2152 (let ((n 0) lines)
2153 (setq lines (mapcar (lambda (x)
2154 (if (string-match "^\\\\hline$" x)
2155 (progn
2156 (setq n (1+ n))
2157 (if (= n 2) x nil))
2158 x))
2159 (org-split-string tbl "\n")))
2160 (setq tbl (mapconcat 'identity (delq nil lines) "\n"))))
2161 (when (and align (string-match "\\\\begin{tabular}{.*}" tbl))
2162 (setq tbl (replace-match (concat "\\begin{tabular}{" align "}")
2163 t t tbl)))
2164 (and (get-buffer "*org-export-table*")
2165 (kill-buffer (get-buffer "*org-export-table*")))
2166 (beginning-of-line 0)
2167 (while (looking-at "[ \t]*\\(|\\|\\+-\\)")
2168 (delete-region (point) (1+ (point-at-eol))))
2169 (when org-export-latex-tables-centered
2170 (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}")))
2171 (when floatp
2172 (setq tbl (concat "\\begin{table}\n"
2173 (if (not org-export-latex-table-caption-above) tbl)
2174 (format "\\caption%s{%s%s}\n"
2175 (if shortn (format "[%s]" shortn) "")
2176 (if label (format "\\label{%s}" label) "")
2177 (or caption ""))
2178 (if org-export-latex-table-caption-above tbl)
2179 "\n\\end{table}\n")))
2180 (insert (org-export-latex-protect-string tbl))))
2181
2182(defun org-export-latex-fontify ()
2183 "Convert fontification to LaTeX."
2184 (goto-char (point-min))
2185 (while (re-search-forward org-emph-re nil t)
2186 ;; The match goes one char after the *string*, except at the end of a line
2187 (let ((emph (assoc (match-string 3)
2188 org-export-latex-emphasis-alist))
2189 (beg (match-beginning 0))
2190 (end (match-end 0))
2191 rpl s)
2192 (unless emph
2193 (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\""
2194 (match-string 3)))
2195 (unless (or (and (get-text-property (- (point) 2) 'org-protected)
2196 (not (get-text-property
2197 (- (point) 2) 'org-verbatim-emph)))
2198 (equal (char-after (match-beginning 3))
2199 (char-after (1+ (match-beginning 3))))
2200 (save-excursion
2201 (goto-char (match-beginning 1))
2202 (save-match-data
2203 (and (org-at-table-p)
2204 (string-match
2205 "[|\n]" (buffer-substring beg end)))))
2206 (and (equal (match-string 3) "+")
2207 (save-match-data
2208 (string-match "\\`-+\\'" (match-string 4)))))
2209 (setq s (match-string 4))
2210 (setq rpl (concat (match-string 1)
2211 (org-export-latex-emph-format (cadr emph)
2212 (match-string 4))
2213 (match-string 5)))
2214 (if (caddr emph)
2215 (setq rpl (org-export-latex-protect-string rpl))
2216 (save-match-data
2217 (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl)
2218 (progn
2219 (add-text-properties (match-beginning 1) (match-end 1)
2220 '(org-protected t) rpl)
2221 (add-text-properties (match-beginning 3) (match-end 3)
2222 '(org-protected t) rpl)))))
2223 (replace-match rpl t t)))
2224 (backward-char)))
2225
2226(defun org-export-latex-emph-format (format string)
2227 "Format an emphasis string and handle the \\verb special case."
2228 (when (member format '("\\verb" "\\protectedtexttt"))
2229 (save-match-data
2230 (if (equal format "\\verb")
2231 (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
2232 (catch 'exit
2233 (loop for i from 0 to (1- (length ll)) do
2234 (if (not (string-match (regexp-quote (substring ll i (1+ i)))
2235 string))
2236 (progn
2237 (setq format (concat "\\verb" (substring ll i (1+ i))
2238 "%s" (substring ll i (1+ i))))
2239 (throw 'exit nil))))))
2240 (let ((start 0)
2241 (trans '(("\\" . "\\textbackslash{}")
2242 ("~" . "\\textasciitilde{}")
2243 ("^" . "\\textasciicircum{}")))
2244 (rtn "") char)
2245 (while (string-match "[\\{}$%&_#~^]" string)
2246 (setq char (match-string 0 string))
2247 (if (> (match-beginning 0) 0)
2248 (setq rtn (concat rtn (substring string
2249 0 (match-beginning 0)))))
2250 (setq string (substring string (1+ (match-beginning 0))))
2251 (setq char (or (cdr (assoc char trans)) (concat "\\" char))
2252 rtn (concat rtn char)))
2253 (setq string (concat rtn string) format "\\texttt{%s}")
2254 (while (string-match "--" string)
2255 (setq string (replace-match "-{}-" t t string)))))))
2256 (format format string))
2257
2258(defun org-export-latex-links ()
2259 ;; Make sure to use the LaTeX hyperref and graphicx package
2260 ;; or send some warnings.
2261 "Convert links to LaTeX."
2262 (goto-char (point-min))
2263 (while (re-search-forward org-bracket-link-analytic-regexp++ nil t)
2264 (org-if-unprotected-1
2265 (goto-char (match-beginning 0))
2266 (let* ((re-radio org-export-latex-all-targets-re)
2267 (remove (list (match-beginning 0) (match-end 0)))
2268 (raw-path (org-extract-attributes (match-string 3)))
2269 (full-raw-path (concat (match-string 1) raw-path))
2270 (desc (match-string 5))
2271 (type (or (match-string 2)
2272 (if (or (file-name-absolute-p raw-path)
2273 (string-match "^\\.\\.?/" raw-path))
2274 "file")))
2275 (coderefp (equal type "coderef"))
2276 (caption (org-find-text-property-in-string 'org-caption raw-path))
2277 (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path))
2278 (attr (or (org-find-text-property-in-string 'org-attributes raw-path)
2279 (plist-get org-export-latex-options-plist :latex-image-options)))
2280 (label (org-find-text-property-in-string 'org-label raw-path))
2281 imgp radiop fnc
2282 ;; define the path of the link
2283 (path (cond
2284 ((member type '("coderef"))
2285 raw-path)
2286 ((member type '("http" "https" "ftp"))
2287 (concat type ":" raw-path))
2288 ((and re-radio (string-match re-radio raw-path))
2289 (setq radiop t))
2290 ((equal type "mailto")
2291 (concat type ":" raw-path))
2292 ((equal type "file")
2293 (if (and (org-file-image-p
2294 (expand-file-name (org-link-unescape raw-path))
2295 org-export-latex-inline-image-extensions)
2296 (or (get-text-property 0 'org-no-description raw-path)
2297 (equal desc full-raw-path)))
2298 (setq imgp t)
2299 (progn (setq raw-path (org-link-unescape raw-path))
2300 (when (string-match "\\(.+\\)::.+" raw-path)
2301 (setq raw-path (match-string 1 raw-path)))
2302 (if (file-exists-p raw-path)
2303 (concat type "://" (expand-file-name raw-path))
2304 (concat type "://" (org-export-directory
2305 :LaTeX org-export-latex-options-plist)
2306 raw-path))))))))
2307 ;; process with link inserting
2308 (apply 'delete-region remove)
2309 (setq caption (and caption (org-export-latex-fontify-headline caption)))
2310 (cond ((and imgp
2311 (plist-get org-export-latex-options-plist :inline-images))
2312 ;; OK, we need to inline an image
2313 (insert
2314 (org-export-latex-format-image raw-path caption label attr shortn)))
2315 (coderefp
2316 (insert (format
2317 (org-export-get-coderef-format path desc)
2318 (cdr (assoc path org-export-code-refs)))))
2319 (radiop (insert (format org-export-latex-hyperref-format
2320 (org-solidify-link-text raw-path) desc)))
2321 ((not type)
2322 (insert (format org-export-latex-hyperref-format
2323 (org-remove-initial-hash
2324 (org-solidify-link-text raw-path))
2325 desc)))
2326 (path
2327 (when (org-at-table-p)
2328 ;; There is a strange problem when we have a link in a table,
2329 ;; ampersands then cause a problem. I think this must be
2330 ;; a LaTeX issue, but we here implement a work-around anyway.
2331 (setq path (org-export-latex-protect-amp path)
2332 desc (org-export-latex-protect-amp desc)))
2333 (insert
2334 (if (string-match "%s.*%s" org-export-latex-href-format)
2335 (format org-export-latex-href-format path desc)
2336 (format org-export-latex-href-format path))))
2337
2338 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
2339 ;; The link protocol has a function for formatting the link
2340 (insert
2341 (save-match-data
2342 (funcall fnc (org-link-unescape raw-path) desc 'latex))))
2343 ;; Unrecognized path type
2344 (t (insert (format org-export-latex-link-with-unknown-path-format desc))))))))
2345
2346
2347(defun org-export-latex-format-image (path caption label attr &optional shortn)
2348 "Format the image element, depending on user settings."
2349 (let (ind floatp wrapp multicolumnp placement figenv)
2350 (setq floatp (or caption label))
2351 (setq ind (org-get-text-property-any 0 'original-indentation path))
2352 (when (and attr (stringp attr))
2353 (if (string-match "[ \t]*\\<wrap\\>" attr)
2354 (setq wrapp t floatp nil attr (replace-match "" t t attr)))
2355 (if (string-match "[ \t]*\\<float\\>" attr)
2356 (setq wrapp nil floatp t attr (replace-match "" t t attr)))
2357 (if (string-match "[ \t]*\\<multicolumn\\>" attr)
2358 (setq multicolumnp t attr (replace-match "" t t attr))))
2359
2360 (setq placement
2361 (cond
2362 (wrapp "{l}{0.5\\textwidth}")
2363 (floatp (concat "[" org-latex-default-figure-position "]"))
2364 (t "")))
2365
2366 (when (and attr (stringp attr)
2367 (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
2368 (setq placement (match-string 1 attr)
2369 attr (replace-match "" t t attr)))
2370 (setq attr (and attr (org-trim attr)))
2371 (when (or (not attr) (= (length attr) 0))
2372 (setq attr (cond (floatp "width=0.7\\textwidth")
2373 (wrapp "width=0.48\\textwidth")
2374 (t attr))))
2375 (setq figenv
2376 (cond
2377 (wrapp "\\begin{wrapfigure}%placement
2378\\centering
2379\\includegraphics[%attr]{%path}
2380\\caption%shortn{%labelcmd%caption}
2381\\end{wrapfigure}")
2382 (multicolumnp "\\begin{figure*}%placement
2383\\centering
2384\\includegraphics[%attr]{%path}
2385\\caption%shortn{%labelcmd%caption}
2386\\end{figure*}")
2387 (floatp "\\begin{figure}%placement
2388\\centering
2389\\includegraphics[%attr]{%path}
2390\\caption%shortn{%labelcmd%caption}
2391\\end{figure}")
2392 (t "\\includegraphics[%attr]{%path}")))
2393
2394
2395 (setq figenv (mapconcat 'identity (split-string figenv "\n")
2396 (save-excursion (beginning-of-line 1)
2397 (looking-at "[ \t]*")
2398 (concat "\n" (match-string 0)))))
2399
2400 (if (and (not label) (not caption)
2401 (string-match "^\\\\caption{.*\n" figenv))
2402 (setq figenv (replace-match "" t t figenv)))
2403 (org-add-props
2404 (org-fill-template
2405 figenv
2406 (list (cons "path"
2407 (if (file-name-absolute-p path)
2408 (expand-file-name path)
2409 path))
2410 (cons "attr" attr)
2411 (cons "shortn" (if shortn (format "[%s]" shortn) ""))
2412 (cons "labelcmd" (if label (format "\\label{%s}"
2413 label)""))
2414 (cons "caption" (or caption ""))
2415 (cons "placement" (or placement ""))))
2416 nil 'original-indentation ind)))
2417
2418(defun org-export-latex-protect-amp (s)
2419 (while (string-match "\\([^\\\\]\\)\\(&\\)" s)
2420 (setq s (replace-match (concat (match-string 1 s) "\\" (match-string 2 s))
2421 t t s)))
2422 s)
2423
2424(defun org-remove-initial-hash (s)
2425 (if (string-match "\\`#" s)
2426 (substring s 1)
2427 s))
2428(defvar org-latex-entities) ; defined below
2429(defvar org-latex-entities-regexp) ; defined below
2430
2431(defun org-export-latex-preprocess (parameters)
2432 "Clean stuff in the LaTeX export."
2433 ;; Replace footnotes.
2434 (when (plist-get parameters :footnotes)
2435 (goto-char (point-min))
2436 (let (ref)
2437 (while (setq ref (org-footnote-get-next-reference))
2438 (let* ((beg (nth 1 ref))
2439 (lbl (car ref))
2440 (def (nth 1 (assoc (string-to-number lbl)
2441 (mapcar (lambda (e) (cdr e))
2442 org-export-footnotes-seen)))))
2443 ;; Fix body for footnotes ending on a link or a list and
2444 ;; remove definition from buffer.
2445 (setq def
2446 (concat def
2447 (if (string-match "ORG-LIST-END-MARKER\\'" def)
2448 "\n" " ")))
2449 (org-footnote-delete-definitions lbl)
2450 ;; Compute string to insert (FNOTE), and protect the outside
2451 ;; macro from further transformation. When footnote at
2452 ;; point is referring to a previously defined footnote, use
2453 ;; \footnotemark. Otherwise, use \footnote.
2454 (let ((fnote (if (member lbl org-export-latex-footmark-seen)
2455 (org-export-latex-protect-string
2456 (format "\\footnotemark[%s]" lbl))
2457 (push lbl org-export-latex-footmark-seen)
2458 (concat (org-export-latex-protect-string "\\footnote{")
2459 def
2460 (org-export-latex-protect-string "}"))))
2461 ;; Check if another footnote is immediately following.
2462 ;; If so, add a separator in-between.
2463 (sep (org-export-latex-protect-string
2464 (if (save-excursion (goto-char (1- (nth 2 ref)))
2465 (let ((next (org-footnote-get-next-reference)))
2466 (and next (= (nth 1 next) (nth 2 ref)))))
2467 org-export-latex-footnote-separator ""))))
2468 (when (org-at-heading-p)
2469 (setq fnote (concat (org-export-latex-protect-string "\\protect")
2470 fnote)))
2471 ;; Ensure a footnote at column 0 cannot end a list
2472 ;; containing it.
2473 (put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
2474 ;; Replace footnote reference with FNOTE and, maybe, SEP.
2475 ;; `save-excursion' is required if there are two footnotes
2476 ;; in a row. In that case, point would be left at the
2477 ;; beginning of the second one, and
2478 ;; `org-footnote-get-next-reference' would then skip it.
2479 (goto-char beg)
2480 (delete-region beg (nth 2 ref))
2481 (save-excursion (insert fnote sep)))))))
2482
2483 ;; Remove footnote section tag for LaTeX
2484 (goto-char (point-min))
2485 (while (re-search-forward
2486 (concat "^" footnote-section-tag-regexp) nil t)
2487 (org-if-unprotected
2488 (replace-match "")))
2489 ;; Remove any left-over footnote definition.
2490 (mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
2491 org-export-footnotes-data)
2492 (mapc (lambda (fn) (org-footnote-delete-definitions fn))
2493 org-export-latex-footmark-seen)
2494
2495 ;; Preserve line breaks
2496 (goto-char (point-min))
2497 (while (re-search-forward "\\\\\\\\" nil t)
2498 (add-text-properties (match-beginning 0) (match-end 0)
2499 '(org-protected t)))
2500
2501 ;; Preserve latex environments
2502 (goto-char (point-min))
2503 (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
2504 (org-if-unprotected
2505 (let* ((start (progn (beginning-of-line) (point)))
2506 (end (and (re-search-forward
2507 (concat "^[ \t]*\\\\end{"
2508 (regexp-quote (match-string 1))
2509 "}") nil t)
2510 (point-at-eol))))
2511 (if end
2512 (add-text-properties start end '(org-protected t))
2513 (goto-char (point-at-eol))))))
2514
2515 ;; Preserve math snippets
2516 (let* ((matchers (plist-get org-format-latex-options :matchers))
2517 (re-list org-latex-regexps)
2518 beg end re e m n block off)
2519 ;; Check the different regular expressions
2520 (while (setq e (pop re-list))
2521 (setq m (car e) re (nth 1 e) n (nth 2 e)
2522 block (if (nth 3 e) "\n\n" ""))
2523 (setq off (if (member m '("$" "$1")) 1 0))
2524 (when (and (member m matchers) (not (equal m "begin")))
2525 (goto-char (point-min))
2526 (while (re-search-forward re nil t)
2527 (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
2528 (add-text-properties beg end '(org-protected t org-latex-math t))))))
2529
2530 ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
2531 (goto-char (point-min))
2532 (let ((case-fold-search nil))
2533 (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
2534 (unless (eq (char-before (match-beginning 1)) ?\\)
2535 (org-if-unprotected-1
2536 (replace-match (org-export-latex-protect-string
2537 (concat "\\" (match-string 1)
2538 "{}")) t t)))))
2539
2540 ;; Convert blockquotes
2541 (goto-char (point-min))
2542 (while (search-forward "ORG-BLOCKQUOTE-START" nil t)
2543 (org-replace-match-keep-properties "\\begin{quote}" t t))
2544 (goto-char (point-min))
2545 (while (search-forward "ORG-BLOCKQUOTE-END" nil t)
2546 (org-replace-match-keep-properties "\\end{quote}" t t))
2547
2548 ;; Convert verse
2549 (goto-char (point-min))
2550 (while (search-forward "ORG-VERSE-START" nil t)
2551 (org-replace-match-keep-properties "\\begin{verse}" t t)
2552 (beginning-of-line 2)
2553 (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp)))
2554 (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)")
2555 (goto-char (match-end 1))
2556 (org-replace-match-keep-properties
2557 (org-export-latex-protect-string
2558 (concat "\\hspace*{1cm}" (match-string 2))) t t)
2559 (beginning-of-line 1))
2560 (if (looking-at "[ \t]*$")
2561 (insert (org-export-latex-protect-string "\\vspace*{1em}"))
2562 (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$")
2563 (end-of-line 1)
2564 (insert "\\\\")))
2565 (beginning-of-line 2))
2566 (and (looking-at "[ \t]*ORG-VERSE-END.*")
2567 (org-replace-match-keep-properties "\\end{verse}" t t)))
2568
2569 ;; Convert #+INDEX to LaTeX \\index.
2570 (goto-char (point-min))
2571 (let ((case-fold-search t) entry)
2572 (while (re-search-forward
2573 "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$"
2574 nil t)
2575 (setq entry
2576 (save-match-data
2577 (org-export-latex-protect-string
2578 (org-export-latex-fontify-headline (match-string 1)))))
2579 (replace-match (format "\\index{%s}" entry) t t)))
2580
2581 ;; Convert center
2582 (goto-char (point-min))
2583 (while (search-forward "ORG-CENTER-START" nil t)
2584 (org-replace-match-keep-properties "\\begin{center}" t t))
2585 (goto-char (point-min))
2586 (while (search-forward "ORG-CENTER-END" nil t)
2587 (org-replace-match-keep-properties "\\end{center}" t t))
2588
2589 (run-hooks 'org-export-latex-after-blockquotes-hook)
2590
2591 ;; Convert horizontal rules
2592 (goto-char (point-min))
2593 (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
2594 (org-if-unprotected
2595 (replace-match (org-export-latex-protect-string "\\hrule") t t)))
2596
2597 ;; Protect LaTeX commands like \command[...]{...} or \command{...}
2598 (goto-char (point-min))
2599 (let ((re (concat
2600 "\\\\\\([a-zA-Z]+\\*?\\)"
2601 "\\(?:<[^<>\n]*>\\)*"
2602 "\\(?:\\[[^][\n]*?\\]\\)*"
2603 "\\(?:<[^<>\n]*>\\)*"
2604 "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
2605 (while (re-search-forward re nil t)
2606 (unless (or
2607 ;; Check for comment line.
2608 (save-excursion (goto-char (match-beginning 0))
2609 (org-in-indented-comment-line))
2610 ;; Check if this is a defined entity, so that is may
2611 ;; need conversion.
2612 (org-entity-get (match-string 1))
2613 ;; Do not protect interior of footnotes. Those have
2614 ;; already been taken care of earlier in the function.
2615 ;; Yet, keep looking inside them for more commands.
2616 (and (equal (match-string 1) "footnote")
2617 (goto-char (match-end 1))))
2618 (add-text-properties (match-beginning 0) (match-end 0)
2619 '(org-protected t)))))
2620
2621 ;; Special case for \nbsp
2622 (goto-char (point-min))
2623 (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t)
2624 (org-if-unprotected
2625 (replace-match (org-export-latex-protect-string "~"))))
2626
2627 ;; Protect LaTeX entities
2628 (goto-char (point-min))
2629 (while (re-search-forward org-latex-entities-regexp nil t)
2630 (org-if-unprotected
2631 (add-text-properties (match-beginning 0) (match-end 0)
2632 '(org-protected t))))
2633
2634 ;; Replace radio links
2635 (goto-char (point-min))
2636 (while (re-search-forward
2637 (concat "<<<?" org-export-latex-all-targets-re
2638 ">>>?\\((INVISIBLE)\\)?") nil t)
2639 (org-if-unprotected-at (+ (match-beginning 0) 2)
2640 (replace-match
2641 (concat
2642 (org-export-latex-protect-string
2643 (format "\\label{%s}" (save-match-data (org-solidify-link-text
2644 (match-string 1)))))
2645 (if (match-string 2) "" (match-string 1)))
2646 t t)))
2647
2648 ;; Delete @<...> constructs
2649 ;; Thanks to Daniel Clemente for this regexp
2650 (goto-char (point-min))
2651 (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
2652 (org-if-unprotected
2653 (replace-match ""))))
2654
2655(defun org-export-latex-fix-inputenc ()
2656 "Set the coding system in inputenc to what the buffer is."
2657 (let* ((cs buffer-file-coding-system)
2658 (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs))
2659 "utf8")))
2660 (when opt
2661 ;; Translate if that is requested
2662 (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt))
2663 ;; find the \usepackage statement and replace the option
2664 (goto-char (point-min))
2665 (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
2666 nil t)
2667 (goto-char (match-beginning 1))
2668 (delete-region (match-beginning 1) (match-end 1))
2669 (insert opt))
2670 (and buffer-file-name
2671 (save-buffer)))))
2672
2673;;; List handling:
2674
2675(defun org-export-latex-lists ()
2676 "Convert plain text lists in current buffer into LaTeX lists."
2677 ;; `org-list-end-re' output has changed since preprocess from
2678 ;; org-exp.el. Make sure it is taken into account.
2679 (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
2680 (mapc
2681 (lambda (e)
2682 ;; For each type of context allowed for list export (E), find
2683 ;; every list, parse it, delete it and insert resulting
2684 ;; conversion to latex (RES), while keeping the same
2685 ;; `original-indentation' property.
2686 (let (res)
2687 (goto-char (point-min))
2688 (while (re-search-forward (org-item-beginning-re) nil t)
2689 (when (and (eq (get-text-property (point) 'list-context) e)
2690 (not (get-text-property (point) 'org-example)))
2691 (beginning-of-line)
2692 (setq res
2693 (org-list-to-latex
2694 ;; Narrowing is needed because we're converting
2695 ;; from inner functions to outer ones.
2696 (save-restriction
2697 (narrow-to-region (point) (point-max))
2698 (org-list-parse-list t))
2699 org-export-latex-list-parameters))
2700 ;; Extend previous value of original-indentation to the
2701 ;; whole string
2702 (insert (org-add-props res nil 'original-indentation
2703 (org-find-text-property-in-string
2704 'original-indentation res)))))))
2705 ;; List of allowed contexts for export, and the default one.
2706 (append org-list-export-context '(nil)))))
2707
2708(defconst org-latex-entities
2709 '("\\!"
2710 "\\'"
2711 "\\+"
2712 "\\,"
2713 "\\-"
2714 "\\:"
2715 "\\;"
2716 "\\<"
2717 "\\="
2718 "\\>"
2719 "\\Huge"
2720 "\\LARGE"
2721 "\\Large"
2722 "\\Styles"
2723 "\\\\"
2724 "\\`"
2725 "\\\""
2726 "\\addcontentsline"
2727 "\\address"
2728 "\\addtocontents"
2729 "\\addtocounter"
2730 "\\addtolength"
2731 "\\addvspace"
2732 "\\alph"
2733 "\\appendix"
2734 "\\arabic"
2735 "\\author"
2736 "\\begin{array}"
2737 "\\begin{center}"
2738 "\\begin{description}"
2739 "\\begin{enumerate}"
2740 "\\begin{eqnarray}"
2741 "\\begin{equation}"
2742 "\\begin{figure}"
2743 "\\begin{flushleft}"
2744 "\\begin{flushright}"
2745 "\\begin{itemize}"
2746 "\\begin{list}"
2747 "\\begin{minipage}"
2748 "\\begin{picture}"
2749 "\\begin{quotation}"
2750 "\\begin{quote}"
2751 "\\begin{tabbing}"
2752 "\\begin{table}"
2753 "\\begin{tabular}"
2754 "\\begin{thebibliography}"
2755 "\\begin{theorem}"
2756 "\\begin{titlepage}"
2757 "\\begin{verbatim}"
2758 "\\begin{verse}"
2759 "\\bf"
2760 "\\bf"
2761 "\\bibitem"
2762 "\\bigskip"
2763 "\\cdots"
2764 "\\centering"
2765 "\\circle"
2766 "\\cite"
2767 "\\cleardoublepage"
2768 "\\clearpage"
2769 "\\cline"
2770 "\\closing"
2771 "\\dashbox"
2772 "\\date"
2773 "\\ddots"
2774 "\\dotfill"
2775 "\\em"
2776 "\\fbox"
2777 "\\flushbottom"
2778 "\\fnsymbol"
2779 "\\footnote"
2780 "\\footnotemark"
2781 "\\footnotesize"
2782 "\\footnotetext"
2783 "\\frac"
2784 "\\frame"
2785 "\\framebox"
2786 "\\hfill"
2787 "\\hline"
2788 "\\hrulespace"
2789 "\\hspace"
2790 "\\huge"
2791 "\\hyphenation"
2792 "\\include"
2793 "\\includeonly"
2794 "\\indent"
2795 "\\input"
2796 "\\it"
2797 "\\kill"
2798 "\\label"
2799 "\\large"
2800 "\\ldots"
2801 "\\line"
2802 "\\linebreak"
2803 "\\linethickness"
2804 "\\listoffigures"
2805 "\\listoftables"
2806 "\\location"
2807 "\\makebox"
2808 "\\maketitle"
2809 "\\mark"
2810 "\\mbox"
2811 "\\medskip"
2812 "\\multicolumn"
2813 "\\multiput"
2814 "\\newcommand"
2815 "\\newcounter"
2816 "\\newenvironment"
2817 "\\newfont"
2818 "\\newlength"
2819 "\\newline"
2820 "\\newpage"
2821 "\\newsavebox"
2822 "\\newtheorem"
2823 "\\nocite"
2824 "\\nofiles"
2825 "\\noindent"
2826 "\\nolinebreak"
2827 "\\nopagebreak"
2828 "\\normalsize"
2829 "\\onecolumn"
2830 "\\opening"
2831 "\\oval"
2832 "\\overbrace"
2833 "\\overline"
2834 "\\pagebreak"
2835 "\\pagenumbering"
2836 "\\pageref"
2837 "\\pagestyle"
2838 "\\par"
2839 "\\parbox"
2840 "\\put"
2841 "\\raggedbottom"
2842 "\\raggedleft"
2843 "\\raggedright"
2844 "\\raisebox"
2845 "\\ref"
2846 "\\rm"
2847 "\\roman"
2848 "\\rule"
2849 "\\savebox"
2850 "\\sc"
2851 "\\scriptsize"
2852 "\\setcounter"
2853 "\\setlength"
2854 "\\settowidth"
2855 "\\sf"
2856 "\\shortstack"
2857 "\\signature"
2858 "\\sl"
2859 "\\small"
2860 "\\smallskip"
2861 "\\sqrt"
2862 "\\tableofcontents"
2863 "\\telephone"
2864 "\\thanks"
2865 "\\thispagestyle"
2866 "\\tiny"
2867 "\\title"
2868 "\\tt"
2869 "\\twocolumn"
2870 "\\typein"
2871 "\\typeout"
2872 "\\underbrace"
2873 "\\underline"
2874 "\\usebox"
2875 "\\usecounter"
2876 "\\value"
2877 "\\vdots"
2878 "\\vector"
2879 "\\verb"
2880 "\\vfill"
2881 "\\vline"
2882 "\\vspace")
2883 "A list of LaTeX commands to be protected when performing conversion.")
2884
2885(defconst org-latex-entities-regexp
2886 (let (names rest)
2887 (dolist (x org-latex-entities)
2888 (if (string-match "[a-zA-Z]$" x)
2889 (push x names)
2890 (push x rest)))
2891 (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)"
2892 "\\|\\(" (regexp-opt (nreverse rest)) "\\)")))
2893
2894(provide 'org-export-latex)
2895(provide 'org-latex)
2896
2897;; Local variables:
2898;; generated-autoload-file: "org-loaddefs.el"
2899;; End:
2900
2901;;; org-latex.el ends here
diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el
deleted file mode 100644
index 11711353ff7..00000000000
--- a/lisp/org/org-lparse.el
+++ /dev/null
@@ -1,2303 +0,0 @@
1;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
2
3;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
4
5;; Author: Jambunathan K <kjambunathan at gmail dot com>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; `org-lparse' is the entry point for the generic line-oriented
27;; exporter. `org-do-lparse' is the genericized version of the
28;; original `org-export-as-html' routine.
29
30;; `org-lparse-native-backends' is a good starting point for
31;; exploring the generic exporter.
32
33;; Following new interactive commands are provided by this library.
34;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
35;; `org-replace-region-by', `org-lparse-region'.
36
37;; Note that the above routines correspond to the following routines
38;; in the html exporter `org-export-as-html',
39;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
40;; `org-replace-region-by-html' and `org-export-region-as-html'.
41
42;; The new interactive command `org-lparse-convert' can be used to
43;; convert documents between various formats. Use this to command,
44;; for example, to convert odt file to doc or pdf format.
45
46;;; Code:
47(eval-when-compile
48 (require 'cl))
49(require 'org-exp)
50(require 'org-list)
51(require 'format-spec)
52
53(defun org-lparse-and-open (target-backend native-backend arg
54 &optional file-or-buf)
55 "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
56If there is an active region, export only the region. The prefix
57ARG specifies how many levels of the outline should become
58headlines. The default is 3. Lower levels will become bulleted
59lists."
60 (let (f (file-or-buf (or file-or-buf
61 (org-lparse target-backend native-backend
62 arg 'hidden))))
63 (when file-or-buf
64 (setq f (cond
65 ((bufferp file-or-buf) buffer-file-name)
66 ((file-exists-p file-or-buf) file-or-buf)
67 (t (error "org-lparse-and-open: This shouldn't happen"))))
68 (message "Opening file %s" f)
69 (org-open-file f 'system)
70 (when org-export-kill-product-buffer-when-displayed
71 (kill-buffer (current-buffer))))))
72
73(defun org-lparse-batch (target-backend &optional native-backend)
74 "Call the function `org-lparse'.
75This function can be used in batch processing as:
76emacs --batch
77 --load=$HOME/lib/emacs/org.el
78 --eval \"(setq org-export-headline-levels 2)\"
79 --visit=MyFile --funcall org-lparse-batch"
80 (setq native-backend (or native-backend target-backend))
81 (org-lparse target-backend native-backend
82 org-export-headline-levels 'hidden))
83
84(defun org-lparse-to-buffer (backend arg)
85 "Call `org-lparse' with output to a temporary buffer.
86No file is created. The prefix ARG is passed through to
87`org-lparse'."
88 (let ((tempbuf (format "*Org %s Export*" (upcase backend))))
89 (org-lparse backend backend arg nil nil tempbuf)
90 (when org-export-show-temporary-export-buffer
91 (switch-to-buffer-other-window tempbuf))))
92
93(defun org-replace-region-by (backend beg end)
94 "Assume the current region has org-mode syntax, and convert it to HTML.
95This can be used in any buffer. For example, you could write an
96itemized list in org-mode syntax in an HTML buffer and then use
97this command to convert it."
98 (let (reg backend-string buf pop-up-frames)
99 (save-window-excursion
100 (if (derived-mode-p 'org-mode)
101 (setq backend-string (org-lparse-region backend beg end t 'string))
102 (setq reg (buffer-substring beg end)
103 buf (get-buffer-create "*Org tmp*"))
104 (with-current-buffer buf
105 (erase-buffer)
106 (insert reg)
107 (org-mode)
108 (setq backend-string (org-lparse-region backend (point-min)
109 (point-max) t 'string)))
110 (kill-buffer buf)))
111 (delete-region beg end)
112 (insert backend-string)))
113
114(defun org-lparse-region (backend beg end &optional body-only buffer)
115 "Convert region from BEG to END in org-mode buffer to HTML.
116If prefix arg BODY-ONLY is set, omit file header, footer, and table of
117contents, and only produce the region of converted text, useful for
118cut-and-paste operations.
119If BUFFER is a buffer or a string, use/create that buffer as a target
120of the converted HTML. If BUFFER is the symbol `string', return the
121produced HTML as a string and leave not buffer behind. For example,
122a Lisp program could call this function in the following way:
123
124 (setq html (org-lparse-region \"html\" beg end t 'string))
125
126When called interactively, the output buffer is selected, and shown
127in a window. A non-interactive call will only return the buffer."
128 (let ((transient-mark-mode t) (zmacs-regions t)
129 ext-plist rtn)
130 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
131 (goto-char end)
132 (set-mark (point)) ;; to activate the region
133 (goto-char beg)
134 (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
135 (if (fboundp 'deactivate-mark) (deactivate-mark))
136 (if (and (org-called-interactively-p 'any) (bufferp rtn))
137 (switch-to-buffer-other-window rtn)
138 rtn)))
139
140(defvar org-lparse-par-open nil)
141
142(defun org-lparse-should-inline-p (filename descp)
143 "Return non-nil if link FILENAME should be inlined.
144The decision to inline the FILENAME link is based on the current
145settings. DESCP is the boolean of whether there was a link
146description. See variables `org-export-html-inline-images' and
147`org-export-html-inline-image-extensions'."
148 (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
149 (inline-image-extensions
150 (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
151 (and (or (eq t inline-images) (and inline-images (not descp)))
152 (org-file-image-p filename inline-image-extensions))))
153
154(defun org-lparse-format-org-link (line opt-plist)
155 "Return LINE with markup of Org mode links.
156OPT-PLIST is the export options list."
157 (let ((start 0)
158 (current-dir (if buffer-file-name
159 (file-name-directory buffer-file-name)
160 default-directory))
161 (link-validate (plist-get opt-plist :link-validation-function))
162 type id-file fnc
163 rpl path attr desc descp desc1 desc2 link
164 org-lparse-link-description-is-image)
165 (while (string-match org-bracket-link-analytic-regexp++ line start)
166 (setq org-lparse-link-description-is-image nil)
167 (setq start (match-beginning 0))
168 (setq path (save-match-data (org-link-unescape
169 (match-string 3 line))))
170 (setq type (cond
171 ((match-end 2) (match-string 2 line))
172 ((save-match-data
173 (or (file-name-absolute-p path)
174 (string-match "^\\.\\.?/" path)))
175 "file")
176 (t "internal")))
177 (setq path (org-extract-attributes path))
178 (setq attr (get-text-property 0 'org-attributes path))
179 (setq desc1 (if (match-end 5) (match-string 5 line))
180 desc2 (if (match-end 2) (concat type ":" path) path)
181 descp (and desc1 (not (equal desc1 desc2)))
182 desc (or desc1 desc2))
183 ;; Make an image out of the description if that is so wanted
184 (when (and descp (org-file-image-p
185 desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
186 (setq org-lparse-link-description-is-image t)
187 (save-match-data
188 (if (string-match "^file:" desc)
189 (setq desc (substring desc (match-end 0)))))
190 (save-match-data
191 (setq desc (org-add-props
192 (org-lparse-format 'INLINE-IMAGE desc)
193 '(org-protected t)))))
194 (cond
195 ((equal type "internal")
196 (let
197 ((frag-0
198 (if (= (string-to-char path) ?#)
199 (substring path 1)
200 path)))
201 (setq rpl
202 (org-lparse-format
203 'ORG-LINK opt-plist "" "" (org-solidify-link-text
204 (save-match-data
205 (org-link-unescape frag-0))
206 nil) desc attr descp))))
207 ((and (equal type "id")
208 (setq id-file (org-id-find-id-file path)))
209 ;; This is an id: link to another file (if it was the same file,
210 ;; it would have become an internal link...)
211 (save-match-data
212 (setq id-file (file-relative-name
213 id-file
214 (file-name-directory org-current-export-file)))
215 (setq rpl
216 (org-lparse-format
217 'ORG-LINK opt-plist type id-file
218 (concat (if (org-uuidgen-p path) "ID-") path)
219 desc attr descp))))
220 ((member type '("http" "https"))
221 ;; standard URL, can inline as image
222 (setq rpl
223 (org-lparse-format
224 'ORG-LINK opt-plist type path nil desc attr descp)))
225 ((member type '("ftp" "mailto" "news"))
226 ;; standard URL, can't inline as image
227 (setq rpl
228 (org-lparse-format
229 'ORG-LINK opt-plist type path nil desc attr descp)))
230
231 ((string= type "coderef")
232 (setq rpl (org-lparse-format
233 'ORG-LINK opt-plist type "" path desc nil descp)))
234
235 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
236 ;; The link protocol has a function for format the link
237 (setq rpl (save-match-data
238 (funcall fnc (org-link-unescape path)
239 desc1 (and (boundp 'org-lparse-backend)
240 (case org-lparse-backend
241 (xhtml 'html)
242 (t org-lparse-backend)))))))
243 ((string= type "file")
244 ;; FILE link
245 (save-match-data
246 (let*
247 ((components
248 (if
249 (string-match "::\\(.*\\)" path)
250 (list
251 (replace-match "" t nil path)
252 (match-string 1 path))
253 (list path nil)))
254
255 ;;The proper path, without a fragment
256 (path-1
257 (first components))
258
259 ;;The raw fragment
260 (fragment-0
261 (second components))
262
263 ;;Check the fragment. If it can't be used as
264 ;;target fragment we'll pass nil instead.
265 (fragment-1
266 (if
267 (and fragment-0
268 (not (string-match "^[0-9]*$" fragment-0))
269 (not (string-match "^\\*" fragment-0))
270 (not (string-match "^/.*/$" fragment-0)))
271 (org-solidify-link-text
272 (org-link-unescape fragment-0))
273 nil))
274 (desc-2
275 ;;Description minus "file:" and ".org"
276 (if (string-match "^file:" desc)
277 (let
278 ((desc-1 (replace-match "" t t desc)))
279 (if (string-match "\\.org$" desc-1)
280 (replace-match "" t t desc-1)
281 desc-1))
282 desc)))
283
284 (setq rpl
285 (if
286 (and
287 (functionp link-validate)
288 (not (funcall link-validate path-1 current-dir)))
289 desc
290 (org-lparse-format
291 'ORG-LINK opt-plist "file" path-1 fragment-1
292 desc-2 attr descp))))))
293
294 (t
295 ;; just publish the path, as default
296 (setq rpl (concat "<i>&lt;" type ":"
297 (save-match-data (org-link-unescape path))
298 "&gt;</i>"))))
299 (setq line (replace-match rpl t t line)
300 start (+ start (length rpl))))
301 line))
302
303(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse'
304(defun org-lparse-stash-save-paragraph-state ()
305 (assert (zerop org-lparse-par-open-stashed))
306 (setq org-lparse-par-open-stashed org-lparse-par-open)
307 (setq org-lparse-par-open nil))
308
309(defun org-lparse-stash-pop-paragraph-state ()
310 (setq org-lparse-par-open org-lparse-par-open-stashed)
311 (setq org-lparse-par-open-stashed 0))
312
313(defmacro with-org-lparse-preserve-paragraph-state (&rest body)
314 `(let ((org-lparse-do-open-par org-lparse-par-open))
315 (org-lparse-end-paragraph)
316 ,@body
317 (when org-lparse-do-open-par
318 (org-lparse-begin-paragraph))))
319(def-edebug-spec with-org-lparse-preserve-paragraph-state (body))
320
321(defvar org-lparse-native-backends nil
322 "List of native backends registered with `org-lparse'.
323A backend can use `org-lparse-register-backend' to add itself to
324this list.
325
326All native backends must implement a get routine and a mandatory
327set of callback routines.
328
329The get routine must be named as org-<backend>-get where backend
330is the name of the backend. The exporter uses `org-lparse-get'
331and retrieves the backend-specific callback by querying for
332ENTITY-CONTROL and ENTITY-FORMAT variables.
333
334For the sake of illustration, the html backend implements
335`org-xhtml-get'. It returns
336`org-xhtml-entity-control-callbacks-alist' and
337`org-xhtml-entity-format-callbacks-alist' as the values of
338ENTITY-CONTROL and ENTITY-FORMAT settings.")
339
340(defun org-lparse-register-backend (backend)
341 "Make BACKEND known to `org-lparse' library.
342Add BACKEND to `org-lparse-native-backends'."
343 (when backend
344 (setq backend (cond
345 ((symbolp backend) (symbol-name backend))
346 ((stringp backend) backend)
347 (t (error "Error while registering backend: %S" backend))))
348 (add-to-list 'org-lparse-native-backends backend)))
349
350(defun org-lparse-unregister-backend (backend)
351 (setq org-lparse-native-backends
352 (remove (cond
353 ((symbolp backend) (symbol-name backend))
354 ((stringp backend) backend))
355 org-lparse-native-backends))
356 (message "Unregistered backend %S" backend))
357
358(defun org-lparse-do-reachable-formats (in-fmt)
359 "Return verbose info about formats to which IN-FMT can be converted.
360Return a list where each element is of the
361form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
362`org-export-odt-convert-processes' for CONVERTER-PROCESS and see
363`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
364 (let (reachable-formats)
365 (dolist (backend org-lparse-native-backends reachable-formats)
366 (let* ((converter (org-lparse-backend-get
367 backend 'CONVERT-METHOD))
368 (capabilities (org-lparse-backend-get
369 backend 'CONVERT-CAPABILITIES)))
370 (when converter
371 (dolist (c capabilities)
372 (when (member in-fmt (nth 1 c))
373 (push (cons converter (nth 2 c)) reachable-formats))))))))
374
375(defun org-lparse-reachable-formats (in-fmt)
376 "Return list of formats to which IN-FMT can be converted.
377The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
378 (let (l)
379 (mapc (lambda (e) (add-to-list 'l e))
380 (apply 'append (mapcar
381 (lambda (e) (mapcar 'car (cdr e)))
382 (org-lparse-do-reachable-formats in-fmt))))
383 l))
384
385(defun org-lparse-reachable-p (in-fmt out-fmt)
386 "Return non-nil if IN-FMT can be converted to OUT-FMT."
387 (catch 'done
388 (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt)))
389 (dolist (e reachable-formats)
390 (let ((out-fmt-spec (assoc out-fmt (cdr e))))
391 (when out-fmt-spec
392 (throw 'done (cons (car e) out-fmt-spec))))))))
393
394(defun org-lparse-backend-is-native-p (backend)
395 (member backend org-lparse-native-backends))
396
397(defun org-lparse (target-backend native-backend arg
398 &optional hidden ext-plist
399 to-buffer body-only pub-dir)
400 "Export the outline to various formats.
401If there is an active region, export only the region. The
402outline is first exported to NATIVE-BACKEND and optionally
403converted to TARGET-BACKEND. See `org-lparse-native-backends'
404for list of known native backends. Each native backend can
405specify a converter and list of target backends it exports to
406using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
407method. See `org-xhtml-get' for an illustrative example.
408
409ARG is a prefix argument that specifies how many levels of
410outline should become headlines. The default is 3. Lower levels
411will become bulleted lists.
412
413HIDDEN is obsolete and does nothing.
414
415EXT-PLIST is a property list that controls various aspects of
416export. The settings here override org-mode's default settings
417and but are inferior to file-local settings.
418
419TO-BUFFER dumps the exported lines to a buffer or a string
420instead of a file. If TO-BUFFER is the symbol `string' return the
421exported lines as a string. If TO-BUFFER is non-nil, create a
422buffer with that name and export to that buffer.
423
424BODY-ONLY controls the presence of header and footer lines in
425exported text. If BODY-ONLY is non-nil, don't produce the file
426header and footer, simply return the content of <body>...</body>,
427without even the body tags themselves.
428
429PUB-DIR specifies the publishing directory."
430 (let* ((org-lparse-backend (intern native-backend))
431 (org-lparse-other-backend (and target-backend
432 (intern target-backend))))
433 (add-hook 'org-export-preprocess-hook
434 'org-lparse-strip-experimental-blocks-maybe)
435 (add-hook 'org-export-preprocess-after-blockquote-hook
436 'org-lparse-preprocess-after-blockquote)
437 (unless (org-lparse-backend-is-native-p native-backend)
438 (error "Don't know how to export natively to backend %s" native-backend))
439
440 (unless (or (equal native-backend target-backend)
441 (org-lparse-reachable-p native-backend target-backend))
442 (error "Don't know how to export to backend %s %s" target-backend
443 (format "via %s" native-backend)))
444 (run-hooks 'org-export-first-hook)
445 (prog1
446 (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)
447 (remove-hook 'org-export-preprocess-hook
448 'org-lparse-strip-experimental-blocks-maybe)
449 (remove-hook 'org-export-preprocess-after-blockquote-hook
450 'org-lparse-preprocess-after-blockquote))))
451
452(defcustom org-lparse-use-flashy-warning nil
453 "Control flashing of messages logged with `org-lparse-warn'.
454When non-nil, messages are fontified with warning face and the
455exporter lingers for a while to catch user's attention."
456 :type 'boolean
457 :group 'org-lparse)
458
459(defun org-lparse-convert-read-params ()
460 "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'.
461This is a helper routine for interactive use."
462 (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
463 (in-file (read-file-name "File to be converted: "
464 nil buffer-file-name t))
465 (in-fmt (file-name-extension in-file))
466 (out-fmt-choices (org-lparse-reachable-formats in-fmt))
467 (out-fmt
468 (or (and out-fmt-choices
469 (funcall input "Output format: "
470 out-fmt-choices nil nil nil))
471 (error
472 "No known converter or no known output formats for %s files"
473 in-fmt))))
474 (list in-file out-fmt)))
475
476(eval-when-compile
477 (require 'browse-url))
478
479(declare-function browse-url-file-url "browse-url" (file))
480
481(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg)
482 "Workhorse routine for `org-export-odt-convert'."
483 (require 'browse-url)
484 (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
485 (dummy (or (file-readable-p in-file)
486 (error "Cannot read %s" in-file)))
487 (in-fmt (file-name-extension in-file))
488 (out-fmt (or out-fmt (error "Output format unspecified")))
489 (how (or (org-lparse-reachable-p in-fmt out-fmt)
490 (error "Cannot convert from %s format to %s format?"
491 in-fmt out-fmt)))
492 (convert-process (car how))
493 (out-file (concat (file-name-sans-extension in-file) "."
494 (nth 1 (or (cdr how) out-fmt))))
495 (extra-options (or (nth 2 (cdr how)) ""))
496 (out-dir (file-name-directory in-file))
497 (cmd (format-spec convert-process
498 `((?i . ,(shell-quote-argument in-file))
499 (?I . ,(browse-url-file-url in-file))
500 (?f . ,out-fmt)
501 (?o . ,out-file)
502 (?O . ,(browse-url-file-url out-file))
503 (?d . , (shell-quote-argument out-dir))
504 (?D . ,(browse-url-file-url out-dir))
505 (?x . ,extra-options)))))
506 (when (file-exists-p out-file)
507 (delete-file out-file))
508
509 (message "Executing %s" cmd)
510 (let ((cmd-output (shell-command-to-string cmd)))
511 (message "%s" cmd-output))
512
513 (cond
514 ((file-exists-p out-file)
515 (message "Exported to %s" out-file)
516 (when prefix-arg
517 (message "Opening %s..." out-file)
518 (org-open-file out-file 'system))
519 out-file)
520 (t
521 (message "Export to %s failed" out-file)
522 nil))))
523
524(defvar org-lparse-insert-tag-with-newlines 'both)
525
526;; Following variables are let-bound during `org-lparse'
527(defvar org-lparse-dyn-first-heading-pos)
528(defvar org-lparse-toc)
529(defvar org-lparse-entity-control-callbacks-alist)
530(defvar org-lparse-entity-format-callbacks-alist)
531(defvar org-lparse-backend nil
532 "The native backend to which the document is currently exported.
533This variable is let bound during `org-lparse'. Valid values are
534one of the symbols corresponding to `org-lparse-native-backends'.
535
536Compare this variable with `org-export-current-backend' which is
537bound only during `org-export-preprocess-string' stage of the
538export process.
539
540See also `org-lparse-other-backend'.")
541
542(defvar org-lparse-other-backend nil
543 "The target backend to which the document is currently exported.
544This variable is let bound during `org-lparse'. This variable is
545set to either `org-lparse-backend' or one of the symbols
546corresponding to OTHER-BACKENDS specification of the
547org-lparse-backend.
548
549For example, if a document is exported to \"odt\" then both
550org-lparse-backend and org-lparse-other-backend are bound to
551'odt. On the other hand, if a document is exported to \"odt\"
552and then converted to \"doc\" then org-lparse-backend is set to
553'odt and org-lparse-other-backend is set to 'doc.")
554
555(defvar org-lparse-body-only nil
556 "Bind this to BODY-ONLY arg of `org-lparse'.")
557
558(defvar org-lparse-to-buffer nil
559 "Bind this to TO-BUFFER arg of `org-lparse'.")
560
561(defun org-lparse-get-block-params (params)
562 (save-match-data
563 (when params
564 (setq params (org-trim params))
565 (unless (string-match "\\`(.*)\\'" params)
566 (setq params (format "(%s)" params)))
567 (ignore-errors (read params)))))
568
569(defvar org-heading-keyword-regexp-format) ; defined in org.el
570(defvar org-lparse-special-blocks '("list-table" "annotation"))
571(defun org-do-lparse (arg &optional hidden ext-plist
572 to-buffer body-only pub-dir)
573 "Export the outline to various formats.
574See `org-lparse' for more information. This function is a
575html-agnostic version of the `org-export-as-html' function in 7.5
576version."
577 ;; Make sure we have a file name when we need it.
578 (when (and (not (or to-buffer body-only))
579 (not buffer-file-name))
580 (if (buffer-base-buffer)
581 (org-set-local 'buffer-file-name
582 (with-current-buffer (buffer-base-buffer)
583 buffer-file-name))
584 (error "Need a file name to be able to export")))
585
586 (org-lparse-warn
587 (format "Exporting to %s using org-lparse..."
588 (upcase (symbol-name
589 (or org-lparse-backend org-lparse-other-backend)))))
590
591 (setq-default org-todo-line-regexp org-todo-line-regexp)
592 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
593 (setq-default org-done-keywords org-done-keywords)
594 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
595 (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that
596 ; we are interested in
597 ; collecting styles
598 org-lparse-encode-pending
599 org-lparse-par-open
600 (org-lparse-par-open-stashed 0)
601
602 ;; list related vars
603 (org-lparse-list-stack '())
604
605 ;; list-table related vars
606 org-lparse-list-table-p
607 org-lparse-list-table:table-cell-open
608 org-lparse-list-table:table-row
609 org-lparse-list-table:lines
610
611 org-lparse-outline-text-open
612 (org-lparse-latex-fragment-fallback ; currently used only by
613 ; odt exporter
614 (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
615 (if (and (org-check-external-command "latex" "" t)
616 (org-check-external-command "dvipng" "" t))
617 'dvipng
618 'verbatim)))
619 (org-lparse-insert-tag-with-newlines 'both)
620 (org-lparse-to-buffer to-buffer)
621 (org-lparse-body-only body-only)
622 (org-lparse-entity-control-callbacks-alist
623 (org-lparse-get 'ENTITY-CONTROL))
624 (org-lparse-entity-format-callbacks-alist
625 (org-lparse-get 'ENTITY-FORMAT))
626 (opt-plist
627 (org-export-process-option-filters
628 (org-combine-plists (org-default-export-plist)
629 ext-plist
630 (org-infile-export-plist))))
631 (body-only (or body-only (plist-get opt-plist :body-only)))
632 valid org-lparse-dyn-first-heading-pos
633 (odd org-odd-levels-only)
634 (region-p (org-region-active-p))
635 (rbeg (and region-p (region-beginning)))
636 (rend (and region-p (region-end)))
637 (subtree-p
638 (if (plist-get opt-plist :ignore-subtree-p)
639 nil
640 (when region-p
641 (save-excursion
642 (goto-char rbeg)
643 (and (org-at-heading-p)
644 (>= (org-end-of-subtree t t) rend))))))
645 (level-offset (if subtree-p
646 (save-excursion
647 (goto-char rbeg)
648 (+ (funcall outline-level)
649 (if org-odd-levels-only 1 0)))
650 0))
651 (opt-plist (setq org-export-opt-plist
652 (if subtree-p
653 (org-export-add-subtree-options opt-plist rbeg)
654 opt-plist)))
655 ;; The following two are dynamically scoped into other
656 ;; routines below.
657 (org-current-export-dir
658 (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
659 (org-current-export-file buffer-file-name)
660 (level 0) (line "") (origline "") txt todo
661 (umax nil)
662 (umax-toc nil)
663 (filename (if to-buffer nil
664 (expand-file-name
665 (concat
666 (file-name-sans-extension
667 (or (and subtree-p
668 (org-entry-get (region-beginning)
669 "EXPORT_FILE_NAME" t))
670 (file-name-nondirectory buffer-file-name)))
671 "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
672 (file-name-as-directory
673 (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
674 (current-dir (if buffer-file-name
675 (file-name-directory buffer-file-name)
676 default-directory))
677 (auto-insert nil) ; Avoid any auto-insert stuff for the new file
678 (buffer (if to-buffer
679 (cond
680 ((eq to-buffer 'string)
681 (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
682 (t (get-buffer-create to-buffer)))
683 (find-file-noselect
684 (or (let ((f (org-lparse-get 'INIT-METHOD)))
685 (and f (functionp f) (funcall f filename)))
686 filename))))
687 (org-levels-open (make-vector org-level-max nil))
688 (dummy (mapc
689 (lambda(p)
690 (let* ((val (plist-get opt-plist p))
691 (val (org-xml-encode-org-text-skip-links val)))
692 (setq opt-plist (plist-put opt-plist p val))))
693 '(:date :author :keywords :description)))
694 (date (plist-get opt-plist :date))
695 (date (cond
696 ((and date (string-match "%" date))
697 (format-time-string date))
698 (date date)
699 (t (format-time-string "%Y-%m-%d %T %Z"))))
700 (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
701 (title (org-xml-encode-org-text-skip-links
702 (or (and subtree-p (org-export-get-title-from-subtree))
703 (plist-get opt-plist :title)
704 (and (not body-only)
705 (not
706 (plist-get opt-plist :skip-before-1st-heading))
707 (org-export-grab-title-from-buffer))
708 (and buffer-file-name
709 (file-name-sans-extension
710 (file-name-nondirectory buffer-file-name)))
711 "UNTITLED")))
712 (dummy (setq opt-plist (plist-put opt-plist :title title)))
713 (html-table-tag (plist-get opt-plist :html-table-tag))
714 (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
715 (quote-re (format org-heading-keyword-regexp-format
716 org-quote-string))
717 (org-lparse-dyn-current-environment nil)
718 ;; Get the language-dependent settings
719 (lang-words (or (assoc (plist-get opt-plist :language)
720 org-export-language-setup)
721 (assoc "en" org-export-language-setup)))
722 (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
723 (head-count 0) cnt
724 (start 0)
725 (coding-system-for-write
726 (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
727 (and (boundp 'buffer-file-coding-system)
728 buffer-file-coding-system)))
729 (save-buffer-coding-system
730 (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
731 (and (boundp 'buffer-file-coding-system)
732 buffer-file-coding-system)))
733 (region
734 (buffer-substring
735 (if region-p (region-beginning) (point-min))
736 (if region-p (region-end) (point-max))))
737 (org-export-have-math nil)
738 (org-export-footnotes-seen nil)
739 (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
740 (org-footnote-insert-pos-for-preprocessor 'point-min)
741 (org-lparse-opt-plist opt-plist)
742 (lines
743 (org-split-string
744 (org-export-preprocess-string
745 region
746 :emph-multiline t
747 :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
748 'html
749 org-lparse-backend)
750 :skip-before-1st-heading
751 (plist-get opt-plist :skip-before-1st-heading)
752 :drawers (plist-get opt-plist :drawers)
753 :todo-keywords (plist-get opt-plist :todo-keywords)
754 :tasks (plist-get opt-plist :tasks)
755 :tags (plist-get opt-plist :tags)
756 :priority (plist-get opt-plist :priority)
757 :footnotes (plist-get opt-plist :footnotes)
758 :timestamps (plist-get opt-plist :timestamps)
759 :archived-trees
760 (plist-get opt-plist :archived-trees)
761 :select-tags (plist-get opt-plist :select-tags)
762 :exclude-tags (plist-get opt-plist :exclude-tags)
763 :add-text
764 (plist-get opt-plist :text)
765 :LaTeX-fragments
766 (plist-get opt-plist :LaTeX-fragments))
767 "[\r\n]"))
768 table-open
769 table-buffer table-orig-buffer
770 ind
771 rpl path attr desc descp desc1 desc2 link
772 snumber fnc
773 footnotes footref-seen
774 org-lparse-output-buffer
775 org-lparse-footnote-definitions
776 org-lparse-footnote-number
777 ;; collection
778 org-lparse-collect-buffer
779 (org-lparse-collect-count 0) ; things will get haywire if
780 ; collections are chained. Use
781 ; this variable to assert this
782 ; pre-requisite
783 org-lparse-toc
784 href
785 )
786
787 (let ((inhibit-read-only t))
788 (org-unmodified
789 (remove-text-properties (point-min) (point-max)
790 '(:org-license-to-kill t))))
791
792 (message "Exporting...")
793 (org-init-section-numbers)
794
795 ;; Switch to the output buffer
796 (setq org-lparse-output-buffer buffer)
797 (set-buffer org-lparse-output-buffer)
798 (let ((inhibit-read-only t)) (erase-buffer))
799 (fundamental-mode)
800 (org-install-letbind)
801
802 (and (fboundp 'set-buffer-file-coding-system)
803 (set-buffer-file-coding-system coding-system-for-write))
804
805 (let ((case-fold-search nil)
806 (org-odd-levels-only odd))
807 ;; create local variables for all options, to make sure all called
808 ;; functions get the correct information
809 (mapc (lambda (x)
810 (set (make-local-variable (nth 2 x))
811 (plist-get opt-plist (car x))))
812 org-export-plist-vars)
813 (setq umax (if arg (prefix-numeric-value arg)
814 org-export-headline-levels))
815 (setq umax-toc (if (integerp org-export-with-toc)
816 (min org-export-with-toc umax)
817 umax))
818 (setq org-lparse-opt-plist
819 (plist-put org-lparse-opt-plist :headline-levels umax))
820
821 (when (and org-export-with-toc (not body-only))
822 (setq lines (org-lparse-prepare-toc
823 lines level-offset opt-plist umax-toc)))
824
825 (unless body-only
826 (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
827 (org-lparse-begin 'DOCUMENT-BODY opt-plist))
828
829 (setq head-count 0)
830 (org-init-section-numbers)
831
832 (org-lparse-begin-paragraph)
833
834 (while (setq line (pop lines) origline line)
835 (catch 'nextline
836 (when (and (org-lparse-current-environment-p 'quote)
837 (string-match org-outline-regexp-bol line))
838 (org-lparse-end-environment 'quote))
839
840 (when (org-lparse-current-environment-p 'quote)
841 (org-lparse-insert 'LINE line)
842 (throw 'nextline nil))
843
844 ;; Fixed-width, verbatim lines (examples)
845 (when (and org-export-with-fixed-width
846 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
847 (when (not (org-lparse-current-environment-p 'fixedwidth))
848 (org-lparse-begin-environment 'fixedwidth))
849 (org-lparse-insert 'LINE (match-string 3 line))
850 (when (or (not lines)
851 (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
852 (car lines))))
853 (org-lparse-end-environment 'fixedwidth))
854 (throw 'nextline nil))
855
856 ;; Native Text
857 (when (and (get-text-property 0 'org-native-text line)
858 ;; Make sure it is the entire line that is protected
859 (not (< (or (next-single-property-change
860 0 'org-native-text line) 10000)
861 (length line))))
862 (let ((ind (get-text-property 0 'original-indentation line)))
863 (org-lparse-begin-environment 'native)
864 (org-lparse-insert 'LINE line)
865 (while (and lines
866 (or (= (length (car lines)) 0)
867 (not ind)
868 (equal ind (get-text-property
869 0 'original-indentation (car lines))))
870 (or (= (length (car lines)) 0)
871 (get-text-property 0 'org-native-text (car lines))))
872 (org-lparse-insert 'LINE (pop lines)))
873 (org-lparse-end-environment 'native))
874 (throw 'nextline nil))
875
876 ;; Protected HTML
877 (when (and (get-text-property 0 'org-protected line)
878 ;; Make sure it is the entire line that is protected
879 (not (< (or (next-single-property-change
880 0 'org-protected line) 10000)
881 (length line))))
882 (let ((ind (get-text-property 0 'original-indentation line)))
883 (org-lparse-insert 'LINE line)
884 (while (and lines
885 (or (= (length (car lines)) 0)
886 (not ind)
887 (equal ind (get-text-property
888 0 'original-indentation (car lines))))
889 (or (= (length (car lines)) 0)
890 (get-text-property 0 'org-protected (car lines))))
891 (org-lparse-insert 'LINE (pop lines))))
892 (throw 'nextline nil))
893
894 ;; Blockquotes, verse, and center
895 (when (string-match
896 "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line)
897 (let* ((style (intern (downcase (match-string 1 line))))
898 (env-options-plist (org-lparse-get-block-params
899 (match-string 3 line)))
900 (f (cdr (assoc (match-string 2 line)
901 '(("START" . org-lparse-begin-environment)
902 ("END" . org-lparse-end-environment))))))
903 (when (memq style
904 (append
905 '(blockquote verse center)
906 (mapcar 'intern org-lparse-special-blocks)))
907 (funcall f style env-options-plist)
908 (throw 'nextline nil))))
909
910 (when (org-lparse-current-environment-p 'verse)
911 (let ((i (org-get-string-indentation line)))
912 (if (> i 0)
913 (setq line (concat
914 (let ((org-lparse-encode-pending t))
915 (org-lparse-format 'SPACES (* 2 i)))
916 " " (org-trim line))))
917 (unless (string-match "\\\\\\\\[ \t]*$" line)
918 (setq line (concat line "\\\\")))))
919
920 ;; make targets to anchors
921 (setq start 0)
922 (while (string-match
923 "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
924 (cond
925 ((get-text-property (match-beginning 1) 'org-protected line)
926 (setq start (match-end 1)))
927 ((match-end 2)
928 (setq line (replace-match
929 (let ((org-lparse-encode-pending t))
930 (org-lparse-format
931 'ANCHOR "" (org-solidify-link-text
932 (match-string 1 line))))
933 t t line)))
934 ((and org-export-with-toc (equal (string-to-char line) ?*))
935 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
936 (setq line (replace-match
937 (let ((org-lparse-encode-pending t))
938 (org-lparse-format
939 'FONTIFY (match-string 1 line) "target"))
940 ;; (concat "@<i>" (match-string 1 line) "@</i> ")
941 t t line)))
942 (t
943 (setq line (replace-match
944 (concat
945 (let ((org-lparse-encode-pending t))
946 (org-lparse-format
947 'ANCHOR (match-string 1 line)
948 (org-solidify-link-text (match-string 1 line))
949 "target")) " ")
950 t t line)))))
951
952 (let ((org-lparse-encode-pending t))
953 (setq line (org-lparse-handle-time-stamps line)))
954
955 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
956 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
957 ;; Also handle sub_superscripts and checkboxes
958 (or (string-match org-table-hline-regexp line)
959 (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
960 (setq line (org-xml-encode-org-text-skip-links line)))
961
962 (setq line (org-lparse-format-org-link line opt-plist))
963
964 ;; TODO items
965 (if (and org-todo-line-regexp
966 (string-match org-todo-line-regexp line)
967 (match-beginning 2))
968 (setq line (concat
969 (substring line 0 (match-beginning 2))
970 (org-lparse-format 'TODO (match-string 2 line))
971 (substring line (match-end 2)))))
972
973 ;; Does this contain a reference to a footnote?
974 (when org-export-with-footnotes
975 (setq start 0)
976 (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
977 ;; Discard protected matches not clearly identified as
978 ;; footnote markers.
979 (if (or (get-text-property (match-beginning 2) 'org-protected line)
980 (not (get-text-property (match-beginning 2) 'org-footnote line)))
981 (setq start (match-end 2))
982 (let ((n (match-string 2 line)) refcnt a)
983 (if (setq a (assoc n footref-seen))
984 (progn
985 (setcdr a (1+ (cdr a)))
986 (setq refcnt (cdr a)))
987 (setq refcnt 1)
988 (push (cons n 1) footref-seen))
989 (setq line
990 (replace-match
991 (concat
992 (or (match-string 1 line) "")
993 (org-lparse-format
994 'FOOTNOTE-REFERENCE
995 n (cdr (assoc n org-lparse-footnote-definitions))
996 refcnt)
997 ;; If another footnote is following the
998 ;; current one, add a separator.
999 (if (save-match-data
1000 (string-match "\\`\\[[0-9]+\\]"
1001 (substring line (match-end 0))))
1002 (ignore-errors
1003 (org-lparse-get 'FOOTNOTE-SEPARATOR))
1004 ""))
1005 t t line))))))
1006
1007 (cond
1008 ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
1009 ;; This is a headline
1010 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1011 level-offset))
1012 txt (match-string 2 line))
1013 (if (string-match quote-re0 txt)
1014 (setq txt (replace-match "" t t txt)))
1015 (if (<= level (max umax umax-toc))
1016 (setq head-count (+ head-count 1)))
1017 (unless org-lparse-dyn-first-heading-pos
1018 (setq org-lparse-dyn-first-heading-pos (point)))
1019 (org-lparse-begin-level level txt umax head-count)
1020
1021 ;; QUOTES
1022 (when (string-match quote-re line)
1023 (org-lparse-begin-environment 'quote)))
1024
1025 ((and org-export-with-tables
1026 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1027 (when (not table-open)
1028 ;; New table starts
1029 (setq table-open t table-buffer nil table-orig-buffer nil))
1030
1031 ;; Accumulate lines
1032 (setq table-buffer (cons line table-buffer)
1033 table-orig-buffer (cons origline table-orig-buffer))
1034 (when (or (not lines)
1035 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1036 (car lines))))
1037 (setq table-open nil
1038 table-buffer (nreverse table-buffer)
1039 table-orig-buffer (nreverse table-orig-buffer))
1040 (org-lparse-end-paragraph)
1041 (when org-lparse-list-table-p
1042 (error "Regular tables are not allowed in a list-table block"))
1043 (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
1044
1045 ;; Normal lines
1046 (t
1047 ;; This line either is list item or end a list.
1048 (when (get-text-property 0 'list-item line)
1049 (setq line (org-lparse-export-list-line
1050 line
1051 (get-text-property 0 'list-item line)
1052 (get-text-property 0 'list-struct line)
1053 (get-text-property 0 'list-prevs line))))
1054
1055 ;; Horizontal line
1056 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1057 (with-org-lparse-preserve-paragraph-state
1058 (org-lparse-insert 'HORIZONTAL-LINE))
1059 (throw 'nextline nil))
1060
1061 ;; Empty lines start a new paragraph. If hand-formatted lists
1062 ;; are not fully interpreted, lines starting with "-", "+", "*"
1063 ;; also start a new paragraph.
1064 (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
1065 (when org-lparse-footnote-number
1066 (org-lparse-end-footnote-definition org-lparse-footnote-number)
1067 (setq org-lparse-footnote-number nil))
1068 (org-lparse-begin-paragraph))
1069
1070 ;; Is this the start of a footnote?
1071 (when org-export-with-footnotes
1072 (when (and (boundp 'footnote-section-tag-regexp)
1073 (string-match (concat "^" footnote-section-tag-regexp)
1074 line))
1075 ;; ignore this line
1076 (throw 'nextline nil))
1077 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1078 (org-lparse-end-paragraph)
1079 (setq org-lparse-footnote-number (match-string 1 line))
1080 (setq line (replace-match "" t t line))
1081 (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
1082 ;; Check if the line break needs to be conserved
1083 (cond
1084 ((string-match "\\\\\\\\[ \t]*$" line)
1085 (setq line (replace-match
1086 (org-lparse-format 'LINE-BREAK)
1087 t t line)))
1088 (org-export-preserve-breaks
1089 (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
1090
1091 ;; Check if a paragraph should be started
1092 (let ((start 0))
1093 (while (and org-lparse-par-open
1094 (string-match "\\\\par\\>" line start))
1095 (error "FIXME")
1096 ;; Leave a space in the </p> so that the footnote matcher
1097 ;; does not see this.
1098 (if (not (get-text-property (match-beginning 0)
1099 'org-protected line))
1100 (setq line (replace-match "</p ><p >" t t line)))
1101 (setq start (match-end 0))))
1102
1103 (org-lparse-insert 'LINE line)))))
1104
1105 ;; Properly close all local lists and other lists
1106 (when (org-lparse-current-environment-p 'quote)
1107 (org-lparse-end-environment 'quote))
1108
1109 (org-lparse-end-level 1 umax)
1110
1111 ;; the </div> to close the last text-... div.
1112 (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
1113 (org-lparse-end-outline-text-or-outline))
1114
1115 (org-lparse-end 'DOCUMENT-BODY opt-plist)
1116 (unless body-only
1117 (org-lparse-end 'DOCUMENT-CONTENT))
1118
1119 (org-lparse-end 'EXPORT)
1120
1121 ;; kill collection buffer
1122 (when org-lparse-collect-buffer
1123 (kill-buffer org-lparse-collect-buffer))
1124
1125 (goto-char (point-min))
1126 (or (org-export-push-to-kill-ring
1127 (upcase (symbol-name org-lparse-backend)))
1128 (message "Exporting... done"))
1129
1130 (cond
1131 ((not to-buffer)
1132 (let ((f (org-lparse-get 'SAVE-METHOD)))
1133 (or (and f (functionp f) (funcall f filename opt-plist))
1134 (save-buffer)))
1135 (or (and (boundp 'org-lparse-other-backend)
1136 org-lparse-other-backend
1137 (not (equal org-lparse-backend org-lparse-other-backend))
1138 (org-lparse-do-convert
1139 buffer-file-name (symbol-name org-lparse-other-backend)))
1140 (current-buffer)))
1141 ((eq to-buffer 'string)
1142 (prog1 (buffer-substring (point-min) (point-max))
1143 (kill-buffer (current-buffer))))
1144 (t (current-buffer))))))
1145
1146(defun org-lparse-format-table (lines olines)
1147 "Returns backend-specific code for org-type and table-type tables."
1148 (if (stringp lines)
1149 (setq lines (org-split-string lines "\n")))
1150 (if (string-match "^[ \t]*|" (car lines))
1151 ;; A normal org table
1152 (org-lparse-format-org-table lines nil)
1153 ;; Table made by table.el
1154 (or (org-lparse-format-table-table-using-table-generate-source
1155 ;; FIXME: Need to take care of this during merge
1156 (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend)
1157 olines
1158 (not org-export-prefer-native-exporter-for-tables))
1159 ;; We are here only when table.el table has NO col or row
1160 ;; spanning and the user prefers using org's own converter for
1161 ;; exporting of such simple table.el tables.
1162 (org-lparse-format-table-table lines))))
1163
1164(defun org-lparse-table-get-colalign-info (lines)
1165 (let ((col-cookies (org-find-text-property-in-string
1166 'org-col-cookies (car lines))))
1167 (when (and col-cookies org-table-clean-did-remove-column)
1168 (setq col-cookies
1169 (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
1170 col-cookies))
1171
1172(defvar org-lparse-table-style)
1173(defvar org-lparse-table-ncols)
1174(defvar org-lparse-table-rownum)
1175(defvar org-lparse-table-is-styled)
1176(defvar org-lparse-table-begin-marker)
1177(defvar org-lparse-table-num-numeric-items-per-column)
1178(defvar org-lparse-table-colalign-info)
1179(defvar org-lparse-table-colalign-vector)
1180
1181;; Following variables are defined in org-table.el
1182(defvar org-table-number-fraction)
1183(defvar org-table-number-regexp)
1184(defun org-lparse-org-table-to-list-table (lines &optional splice)
1185 "Convert org-table to list-table.
1186LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
1187element is a `string' representing a single row of org-table.
1188Thus each ROW has vertical separators \"|\" separating the table
1189fields. A ROW could also be a row-group separator of the form
1190\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
1191...). ROW could either be symbol `:hrule' or a list of the
1192form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
1193 (let (line lines-1)
1194 (cond
1195 (splice
1196 (while (setq line (pop lines))
1197 (unless (string-match "^[ \t]*|-" line)
1198 (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))
1199 (t
1200 (while (setq line (pop lines))
1201 (cond
1202 ((string-match "^[ \t]*|-" line)
1203 (when lines
1204 (push :hrule lines-1)))
1205 (t
1206 (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))))
1207 (nreverse lines-1)))
1208
1209(defun org-lparse-insert-org-table (lines &optional splice)
1210 "Format a org-type table into backend-specific code.
1211LINES is a list of lines. Optional argument SPLICE means, do not
1212insert header and surrounding <table> tags, just format the lines.
1213Optional argument NO-CSS means use XHTML attributes instead of CSS
1214for formatting. This is required for the DocBook exporter."
1215 (require 'org-table)
1216 ;; Get rid of hlines at beginning and end
1217 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1218 (setq lines (nreverse lines))
1219 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1220 (setq lines (nreverse lines))
1221 (when org-export-table-remove-special-lines
1222 ;; Check if the table has a marking column. If yes remove the
1223 ;; column and the special lines
1224 (setq lines (org-table-clean-before-export lines)))
1225 (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
1226 (short-caption (or (org-find-text-property-in-string
1227 'org-caption-shortn (car lines)) caption))
1228 (caption (and caption (org-xml-encode-org-text caption)))
1229 (short-caption (and short-caption
1230 (org-xml-encode-plain-text short-caption)))
1231 (label (org-find-text-property-in-string 'org-label (car lines)))
1232 (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
1233 (attributes (org-find-text-property-in-string 'org-attributes
1234 (car lines)))
1235 (head (and org-export-highlight-first-table-line
1236 (delq nil (mapcar
1237 (lambda (x) (string-match "^[ \t]*|-" x))
1238 (cdr lines))))))
1239 (setq lines (org-lparse-org-table-to-list-table lines splice))
1240 (org-lparse-insert-list-table
1241 lines splice caption label attributes head org-lparse-table-colalign-info
1242 short-caption)))
1243
1244(defun org-lparse-insert-list-table (lines &optional splice
1245 caption label attributes head
1246 org-lparse-table-colalign-info
1247 short-caption)
1248 (or (featurep 'org-table) ; required for
1249 (require 'org-table)) ; `org-table-number-regexp'
1250 (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
1251 tbopen fields line
1252 org-lparse-table-cur-rowgrp-is-hdr
1253 org-lparse-table-rowgrp-open
1254 org-lparse-table-num-numeric-items-per-column
1255 org-lparse-table-colalign-vector n
1256 org-lparse-table-rowgrp-info
1257 org-lparse-table-begin-marker
1258 (org-lparse-table-style 'org-table)
1259 org-lparse-table-is-styled)
1260 (cond
1261 (splice
1262 (setq org-lparse-table-is-styled nil)
1263 (while (setq line (pop lines))
1264 (insert (org-lparse-format-table-row line) "\n")))
1265 (t
1266 (setq org-lparse-table-is-styled t)
1267 (org-lparse-begin 'TABLE caption label attributes short-caption)
1268 (setq org-lparse-table-begin-marker (point))
1269 (org-lparse-begin-table-rowgroup head)
1270 (while (setq line (pop lines))
1271 (cond
1272 ((equal line :hrule)
1273 (org-lparse-begin-table-rowgroup))
1274 (t
1275 (insert (org-lparse-format-table-row line) "\n"))))
1276 (org-lparse-end 'TABLE-ROWGROUP)
1277 (org-lparse-end-table)))))
1278
1279(defun org-lparse-format-org-table (lines &optional splice)
1280 (with-temp-buffer
1281 (org-lparse-insert-org-table lines splice)
1282 (buffer-substring-no-properties (point-min) (point-max))))
1283
1284(defun org-lparse-format-list-table (lines &optional splice)
1285 (with-temp-buffer
1286 (org-lparse-insert-list-table lines splice)
1287 (buffer-substring-no-properties (point-min) (point-max))))
1288
1289(defun org-lparse-insert-table-table (lines)
1290 "Format a table generated by table.el into backend-specific code.
1291This conversion does *not* use `table-generate-source' from table.el.
1292This has the advantage that Org-mode's HTML conversions can be used.
1293But it has the disadvantage, that no cell- or row-spanning is allowed."
1294 (let (line field-buffer
1295 (org-lparse-table-cur-rowgrp-is-hdr
1296 org-export-highlight-first-table-line)
1297 (caption nil)
1298 (short-caption nil)
1299 (attributes nil)
1300 (label nil)
1301 (org-lparse-table-style 'table-table)
1302 (org-lparse-table-is-styled nil)
1303 fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
1304 (empty (org-lparse-format 'SPACES 1)))
1305 (org-lparse-begin 'TABLE caption label attributes short-caption)
1306 (while (setq line (pop lines))
1307 (cond
1308 ((string-match "^[ \t]*\\+-" line)
1309 (when field-buffer
1310 (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
1311 ;; (org-export-html-table-use-header-tags-for-first-column nil)
1312 )
1313 (insert (org-lparse-format-table-row field-buffer empty)))
1314 (setq org-lparse-table-cur-rowgrp-is-hdr nil)
1315 (setq field-buffer nil)))
1316 (t
1317 ;; Break the line into fields and store the fields
1318 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1319 (if field-buffer
1320 (setq field-buffer (mapcar
1321 (lambda (x)
1322 (concat x (org-lparse-format 'LINE-BREAK)
1323 (pop fields)))
1324 field-buffer))
1325 (setq field-buffer fields)))))
1326 (org-lparse-end-table)))
1327
1328(defun org-lparse-format-table-table (lines)
1329 (with-temp-buffer
1330 (org-lparse-insert-table-table lines)
1331 (buffer-substring-no-properties (point-min) (point-max))))
1332
1333(defvar table-source-languages) ; defined in table.el
1334(defun org-lparse-format-table-table-using-table-generate-source (backend
1335 lines
1336 &optional
1337 spanned-only)
1338 "Format a table into BACKEND, using `table-generate-source' from table.el.
1339Use SPANNED-ONLY to suppress exporting of simple table.el tables.
1340
1341When SPANNED-ONLY is nil, all table.el tables are exported. When
1342SPANNED-ONLY is non-nil, only tables with either row or column
1343spans are exported.
1344
1345This routine returns the generated source or nil as appropriate.
1346
1347Refer docstring of `org-export-prefer-native-exporter-for-tables'
1348for further information."
1349 (require 'table)
1350 (with-current-buffer (get-buffer-create " org-tmp1 ")
1351 (erase-buffer)
1352 (insert (mapconcat 'identity lines "\n"))
1353 (goto-char (point-min))
1354 (if (not (re-search-forward "|[^+]" nil t))
1355 (error "Error processing table"))
1356 (table-recognize-table)
1357 (when (or (not spanned-only)
1358 (let* ((dim (table-query-dimension))
1359 (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
1360 (not (= (* c r) cells))))
1361 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1362 (cond
1363 ((member backend table-source-languages)
1364 (table-generate-source backend " org-tmp2 ")
1365 (set-buffer " org-tmp2 ")
1366 (buffer-substring (point-min) (point-max)))
1367 (t
1368 ;; table.el doesn't support the given backend. Currently this
1369 ;; happens in case of odt export. Strip the table from the
1370 ;; generated document. A better alternative would be to embed
1371 ;; the table as ascii text in the output document.
1372 (org-lparse-warn
1373 (concat
1374 "Found table.el-type table in the source org file. "
1375 (format "table.el doesn't support %s backend. "
1376 (upcase (symbol-name backend)))
1377 "Skipping ahead ..."))
1378 "")))))
1379
1380(defun org-lparse-handle-time-stamps (s)
1381 "Format time stamps in string S, or remove them."
1382 (catch 'exit
1383 (let (r b)
1384 (when org-maybe-keyword-time-regexp
1385 (while (string-match org-maybe-keyword-time-regexp s)
1386 (or b (setq b (substring s 0 (match-beginning 0))))
1387 (setq r (concat
1388 r (substring s 0 (match-beginning 0)) " "
1389 (org-lparse-format
1390 'FONTIFY
1391 (concat
1392 (if (match-end 1)
1393 (org-lparse-format
1394 'FONTIFY
1395 (match-string 1 s) "timestamp-kwd"))
1396 " "
1397 (org-lparse-format
1398 'FONTIFY
1399 (substring (org-translate-time (match-string 3 s)) 1 -1)
1400 "timestamp"))
1401 "timestamp-wrapper"))
1402 s (substring s (match-end 0)))))
1403
1404 ;; Line break if line started and ended with time stamp stuff
1405 (if (not r)
1406 s
1407 (setq r (concat r s))
1408 (unless (string-match "\\S-" (concat b s))
1409 (setq r (concat r (org-lparse-format 'LINE-BREAK))))
1410 r))))
1411
1412(defun org-xml-encode-plain-text (s)
1413 "Convert plain text characters to HTML equivalent.
1414Possible conversions are set in `org-export-html-protect-char-alist'."
1415 (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
1416 (while (setq c (pop cl))
1417 (let ((start 0))
1418 (while (string-match (car c) s start)
1419 (setq s (replace-match (cdr c) t t s)
1420 start (1+ (match-beginning 0))))))
1421 s))
1422
1423(defun org-xml-encode-org-text-skip-links (string)
1424 "Prepare STRING for HTML export. Apply all active conversions.
1425If there are links in the string, don't modify these. If STRING
1426is nil, return nil."
1427 (when string
1428 (let* ((re (concat org-bracket-link-regexp "\\|"
1429 (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
1430 m s l res)
1431 (while (setq m (string-match re string))
1432 (setq s (substring string 0 m)
1433 l (match-string 0 string)
1434 string (substring string (match-end 0)))
1435 (push (org-xml-encode-org-text s) res)
1436 (push l res))
1437 (push (org-xml-encode-org-text string) res)
1438 (apply 'concat (nreverse res)))))
1439
1440(defun org-xml-encode-org-text (s)
1441 "Apply all active conversions to translate special ASCII to HTML."
1442 (setq s (org-xml-encode-plain-text s))
1443 (if org-export-html-expand
1444 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1445 (setq s (replace-match "<\\1>" t nil s))))
1446 (if org-export-with-emphasize
1447 (setq s (org-lparse-apply-char-styles s)))
1448 (if org-export-with-special-strings
1449 (setq s (org-lparse-convert-special-strings s)))
1450 (if org-export-with-sub-superscripts
1451 (setq s (org-lparse-apply-sub-superscript-styles s)))
1452 (if org-export-with-TeX-macros
1453 (let ((start 0) wd rep)
1454 (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
1455 s start))
1456 (if (get-text-property (match-beginning 0) 'org-protected s)
1457 (setq start (match-end 0))
1458 (setq wd (match-string 1 s))
1459 (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
1460 (setq s (replace-match rep t t s))
1461 (setq start (+ start (length wd))))))))
1462 s)
1463
1464(defun org-lparse-convert-special-strings (string)
1465 "Convert special characters in STRING to HTML."
1466 (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
1467 e a re rpl start)
1468 (while (setq a (pop all))
1469 (setq re (car a) rpl (cdr a) start 0)
1470 (while (string-match re string start)
1471 (if (get-text-property (match-beginning 0) 'org-protected string)
1472 (setq start (match-end 0))
1473 (setq string (replace-match rpl t nil string)))))
1474 string))
1475
1476(defun org-lparse-apply-sub-superscript-styles (string)
1477 "Apply subscript and superscript styles to STRING.
1478Use `org-export-with-sub-superscripts' to control application of
1479sub and superscript styles."
1480 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1481 (while (string-match org-match-substring-regexp string s)
1482 (cond
1483 ((and requireb (match-end 8)) (setq s (match-end 2)))
1484 ((get-text-property (match-beginning 2) 'org-protected string)
1485 (setq s (match-end 2)))
1486 (t
1487 (setq s (match-end 1)
1488 key (if (string= (match-string 2 string) "_")
1489 'subscript 'superscript)
1490 c (or (match-string 8 string)
1491 (match-string 6 string)
1492 (match-string 5 string))
1493 string (replace-match
1494 (concat (match-string 1 string)
1495 (org-lparse-format 'FONTIFY c key))
1496 t t string)))))
1497 (while (string-match "\\\\\\([_^]\\)" string)
1498 (setq string (replace-match (match-string 1 string) t t string)))
1499 string))
1500
1501(defvar org-lparse-char-styles
1502 `(("*" bold)
1503 ("/" emphasis)
1504 ("_" underline)
1505 ("=" code)
1506 ("~" verbatim)
1507 ("+" strike))
1508 "Map Org emphasis markers to char styles.
1509This is an alist where each element is of the
1510form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
1511
1512(defun org-lparse-apply-char-styles (string)
1513 "Apply char styles to STRING.
1514The variable `org-lparse-char-styles' controls how the Org
1515emphasis markers are interpreted."
1516 (let ((s 0) rpl)
1517 (while (string-match org-emph-re string s)
1518 (if (not (equal
1519 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1520 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1521 (setq s (match-beginning 0)
1522 rpl
1523 (concat
1524 (match-string 1 string)
1525 (org-lparse-format
1526 'FONTIFY (match-string 4 string)
1527 (nth 1 (assoc (match-string 3 string)
1528 org-lparse-char-styles)))
1529 (match-string 5 string))
1530 string (replace-match rpl t t string)
1531 s (+ s (- (length rpl) 2)))
1532 (setq s (1+ s))))
1533 string))
1534
1535(defun org-lparse-export-list-line (line pos struct prevs)
1536 "Insert list syntax in export buffer. Return LINE, maybe modified.
1537
1538POS is the item position or line position the line had before
1539modifications to buffer. STRUCT is the list structure. PREVS is
1540the alist of previous items."
1541 (let* ((get-type
1542 (function
1543 ;; Translate type of list containing POS to "d", "o" or
1544 ;; "u".
1545 (lambda (pos struct prevs)
1546 (let ((type (org-list-get-list-type pos struct prevs)))
1547 (cond
1548 ((eq 'ordered type) "o")
1549 ((eq 'descriptive type) "d")
1550 (t "u"))))))
1551 (get-closings
1552 (function
1553 ;; Return list of all items and sublists ending at POS, in
1554 ;; reverse order.
1555 (lambda (pos)
1556 (let (out)
1557 (catch 'exit
1558 (mapc (lambda (e)
1559 (let ((end (nth 6 e))
1560 (item (car e)))
1561 (cond
1562 ((= end pos) (push item out))
1563 ((>= item pos) (throw 'exit nil)))))
1564 struct))
1565 out)))))
1566 ;; First close any previous item, or list, ending at POS.
1567 (mapc (lambda (e)
1568 (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
1569 (first-item (org-list-get-list-begin e struct prevs))
1570 (type (funcall get-type first-item struct prevs)))
1571 (org-lparse-end-paragraph)
1572 ;; Ending for every item
1573 (org-lparse-end-list-item-1 type)
1574 ;; We're ending last item of the list: end list.
1575 (when lastp
1576 (org-lparse-end-list type)
1577 (org-lparse-begin-paragraph))))
1578 (funcall get-closings pos))
1579 (cond
1580 ;; At an item: insert appropriate tags in export buffer.
1581 ((assq pos struct)
1582 (string-match
1583 (concat "[ \t]*\\(\\S-+[ \t]*\\)"
1584 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
1585 "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
1586 "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
1587 "\\(.*\\)") line)
1588 (let* ((checkbox (match-string 3 line))
1589 (desc-tag (or (match-string 4 line) "???"))
1590 (body (or (match-string 5 line) ""))
1591 (list-beg (org-list-get-list-begin pos struct prevs))
1592 (firstp (= list-beg pos))
1593 ;; Always refer to first item to determine list type, in
1594 ;; case list is ill-formed.
1595 (type (funcall get-type list-beg struct prevs))
1596 (counter (let ((count-tmp (org-list-get-counter pos struct)))
1597 (cond
1598 ((not count-tmp) nil)
1599 ((string-match "[A-Za-z]" count-tmp)
1600 (- (string-to-char (upcase count-tmp)) 64))
1601 ((string-match "[0-9]+" count-tmp)
1602 count-tmp)))))
1603 (when firstp
1604 (org-lparse-end-paragraph)
1605 (org-lparse-begin-list type))
1606
1607 (let ((arg (cond ((equal type "d") desc-tag)
1608 ((equal type "o") counter))))
1609 (org-lparse-begin-list-item type arg))
1610
1611 ;; If line had a checkbox, some additional modification is required.
1612 (when checkbox
1613 (setq body
1614 (concat
1615 (org-lparse-format
1616 'FONTIFY (concat
1617 "["
1618 (cond
1619 ((string-match "X" checkbox) "X")
1620 ((string-match " " checkbox)
1621 (org-lparse-format 'SPACES 1))
1622 (t "-"))
1623 "]")
1624 'code)
1625 " "
1626 body)))
1627 ;; Return modified line
1628 body))
1629 ;; At a list ender: go to next line (side-effects only).
1630 ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
1631 ;; Not at an item: return line unchanged (side-effects only).
1632 (t line))))
1633
1634(defun org-lparse-bind-local-variables (opt-plist)
1635 (mapc (lambda (x)
1636 (set (make-local-variable (nth 2 x))
1637 (plist-get opt-plist (car x))))
1638 org-export-plist-vars))
1639
1640(defvar org-lparse-table-rowgrp-open)
1641(defvar org-lparse-table-cur-rowgrp-is-hdr)
1642(defvar org-lparse-footnote-number)
1643(defvar org-lparse-footnote-definitions)
1644(defvar org-lparse-output-buffer nil
1645 "Buffer to which `org-do-lparse' writes to.
1646This buffer contains the contents of the to-be-created exported
1647document.")
1648
1649(defcustom org-lparse-debug nil
1650 "Enable or Disable logging of `org-lparse' callbacks.
1651The parameters passed to the backend-registered ENTITY-CONTROL
1652and ENTITY-FORMAT callbacks are logged as comment strings in the
1653exported buffer. (org-lparse-format 'COMMENT fmt args) is used
1654for logging. Customize this variable only if you are an expert
1655user. Valid values of this variable are:
1656nil : Disable logging
1657control : Log all invocations of `org-lparse-begin' and
1658 `org-lparse-end' callbacks.
1659format : Log invocations of `org-lparse-format' callbacks.
1660t : Log all invocations of `org-lparse-begin', `org-lparse-end'
1661 and `org-lparse-format' callbacks,"
1662 :group 'org-lparse
1663 :type '(choice
1664 (const :tag "Disable" nil)
1665 (const :tag "Format callbacks" format)
1666 (const :tag "Control callbacks" control)
1667 (const :tag "Format and Control callbacks" t)))
1668
1669(defun org-lparse-begin (entity &rest args)
1670 "Begin ENTITY in current buffer. ARGS is entity specific.
1671ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
1672
1673Use (org-lparse-begin 'LIST \"o\") to begin a list in current
1674buffer.
1675
1676See `org-xhtml-entity-control-callbacks-alist' for more
1677information."
1678 (when (and (member org-lparse-debug '(t control))
1679 (not (eq entity 'DOCUMENT-CONTENT)))
1680 (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
1681
1682 (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
1683 (unless f (error "Unknown entity: %s" entity))
1684 (apply f args)))
1685
1686(defun org-lparse-end (entity &rest args)
1687 "Close ENTITY in current buffer. ARGS is entity specific.
1688ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
1689etc.
1690
1691Use (org-lparse-end 'LIST \"o\") to close a list in current
1692buffer.
1693
1694See `org-xhtml-entity-control-callbacks-alist' for more
1695information."
1696 (when (and (member org-lparse-debug '(t control))
1697 (not (eq entity 'DOCUMENT-CONTENT)))
1698 (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
1699
1700 (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
1701 (unless f (error "Unknown entity: %s" entity))
1702 (apply f args)))
1703
1704(defun org-lparse-begin-paragraph (&optional style)
1705 "Insert <p>, but first close previous paragraph if any."
1706 (org-lparse-end-paragraph)
1707 (org-lparse-begin 'PARAGRAPH style)
1708 (setq org-lparse-par-open t))
1709
1710(defun org-lparse-end-paragraph ()
1711 "Close paragraph if there is one open."
1712 (when org-lparse-par-open
1713 (org-lparse-end 'PARAGRAPH)
1714 (setq org-lparse-par-open nil)))
1715
1716(defun org-lparse-end-list-item-1 (&optional type)
1717 "Close <li> if necessary."
1718 (org-lparse-end-paragraph)
1719 (org-lparse-end-list-item (or type "u")))
1720
1721(define-obsolete-function-alias
1722 'org-lparse-preprocess-after-blockquote-hook
1723 'org-lparse-preprocess-after-blockquote
1724 "24.3")
1725
1726(defun org-lparse-preprocess-after-blockquote ()
1727 "Treat `org-lparse-special-blocks' specially."
1728 (goto-char (point-min))
1729 (while (re-search-forward
1730 "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t)
1731 (when (member (downcase (match-string 2)) org-lparse-special-blocks)
1732 (replace-match
1733 (if (equal (downcase (match-string 1)) "begin")
1734 (format "ORG-%s-START %s" (upcase (match-string 2))
1735 (match-string 3))
1736 (format "ORG-%s-END %s" (upcase (match-string 2))
1737 (match-string 3))) t t))))
1738
1739(define-obsolete-function-alias
1740 'org-lparse-strip-experimental-blocks-maybe-hook
1741 'org-lparse-strip-experimental-blocks-maybe
1742 "24.3")
1743
1744(defun org-lparse-strip-experimental-blocks-maybe ()
1745 "Strip \"list-table\" and \"annotation\" blocks.
1746Stripping happens only when the exported backend is not one of
1747\"odt\" or \"xhtml\"."
1748 (when (not org-lparse-backend)
1749 (message "Stripping following blocks - %S" org-lparse-special-blocks)
1750 (goto-char (point-min))
1751 (let ((case-fold-search t))
1752 (while
1753 (re-search-forward
1754 "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*"
1755 nil t)
1756 (when (member (match-string 1) org-lparse-special-blocks)
1757 (replace-match "" t t))))))
1758
1759(defvar org-lparse-list-table-p nil
1760 "Non-nil if `org-do-lparse' is within a list-table.")
1761
1762(defvar org-lparse-dyn-current-environment nil)
1763(defun org-lparse-begin-environment (style &optional env-options-plist)
1764 (case style
1765 (list-table
1766 (setq org-lparse-list-table-p t))
1767 (t (setq org-lparse-dyn-current-environment style)
1768 (org-lparse-begin 'ENVIRONMENT style env-options-plist))))
1769
1770(defun org-lparse-end-environment (style &optional env-options-plist)
1771 (case style
1772 (list-table
1773 (setq org-lparse-list-table-p nil))
1774 (t (org-lparse-end 'ENVIRONMENT style env-options-plist)
1775 (setq org-lparse-dyn-current-environment nil))))
1776
1777(defun org-lparse-current-environment-p (style)
1778 (eq org-lparse-dyn-current-environment style))
1779
1780(defun org-lparse-begin-footnote-definition (n)
1781 (org-lparse-begin-collect)
1782 (setq org-lparse-insert-tag-with-newlines nil)
1783 (org-lparse-begin 'FOOTNOTE-DEFINITION n))
1784
1785(defun org-lparse-end-footnote-definition (n)
1786 (org-lparse-end 'FOOTNOTE-DEFINITION n)
1787 (setq org-lparse-insert-tag-with-newlines 'both)
1788 (let ((footnote-def (org-lparse-end-collect)))
1789 ;; Cleanup newlines in footnote definition. This ensures that a
1790 ;; transcoded line is never (wrongly) broken in to multiple lines.
1791 (let ((pos 0))
1792 (while (string-match "[\r\n]+" footnote-def pos)
1793 (setq pos (1+ (match-beginning 0)))
1794 (setq footnote-def (replace-match " " t t footnote-def))))
1795 (push (cons n footnote-def) org-lparse-footnote-definitions)))
1796
1797(defvar org-lparse-collect-buffer nil
1798 "An auxiliary buffer named \"*Org Lparse Collect*\".
1799`org-do-lparse' uses this as output buffer while collecting
1800footnote definitions and table-cell contents of list-tables. See
1801`org-lparse-begin-collect' and `org-lparse-end-collect'.")
1802
1803(defvar org-lparse-collect-count nil
1804 "Count number of calls to `org-lparse-begin-collect'.
1805Use this counter to catch chained collections if they ever
1806happen.")
1807
1808(defun org-lparse-begin-collect ()
1809 "Temporarily switch to `org-lparse-collect-buffer'.
1810Also erase it's contents."
1811 (unless (zerop org-lparse-collect-count)
1812 (error "FIXME (org-lparse.el): Encountered chained collections"))
1813 (incf org-lparse-collect-count)
1814 (unless org-lparse-collect-buffer
1815 (setq org-lparse-collect-buffer
1816 (get-buffer-create "*Org Lparse Collect*")))
1817 (set-buffer org-lparse-collect-buffer)
1818 (erase-buffer))
1819
1820(defun org-lparse-end-collect ()
1821 "Switch to `org-lparse-output-buffer'.
1822Return contents of `org-lparse-collect-buffer' as a `string'."
1823 (assert (> org-lparse-collect-count 0))
1824 (decf org-lparse-collect-count)
1825 (prog1 (buffer-string)
1826 (erase-buffer)
1827 (set-buffer org-lparse-output-buffer)))
1828
1829(defun org-lparse-format (entity &rest args)
1830 "Format ENTITY in backend-specific way and return it.
1831ARGS is specific to entity being formatted.
1832
1833Use (org-lparse-format 'HEADING \"text\" 1) to format text as
1834level 1 heading.
1835
1836See `org-xhtml-entity-format-callbacks-alist' for more information."
1837 (when (and (member org-lparse-debug '(t format))
1838 (not (equal entity 'COMMENT)))
1839 (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
1840 (cond
1841 ((consp entity)
1842 (let ((text (pop args)))
1843 (apply 'org-lparse-format 'TAGS entity text args)))
1844 (t
1845 (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
1846 (unless f (error "Unknown entity: %s" entity))
1847 (apply f args)))))
1848
1849(defun org-lparse-insert (entity &rest args)
1850 (insert (apply 'org-lparse-format entity args)))
1851
1852(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
1853 (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
1854 (org-min-level (org-get-min-level lines level-offset))
1855 (org-last-level org-min-level)
1856 level)
1857 (with-temp-buffer
1858 (org-lparse-bind-local-variables opt-plist)
1859 (erase-buffer)
1860 (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc)
1861 (setq
1862 lines
1863 (mapcar
1864 #'(lambda (line)
1865 (when (and (string-match org-todo-line-regexp line)
1866 (not (get-text-property 0 'org-protected line))
1867 (<= (setq level (org-tr-level
1868 (- (match-end 1) (match-beginning 1)
1869 level-offset)))
1870 umax-toc))
1871 (let ((txt (save-match-data
1872 (org-xml-encode-org-text-skip-links
1873 (org-export-cleanup-toc-line
1874 (match-string 3 line)))))
1875 (todo (and
1876 org-export-mark-todo-in-toc
1877 (or (and (match-beginning 2)
1878 (not (member (match-string 2 line)
1879 org-done-keywords)))
1880 (and (= level umax-toc)
1881 (org-search-todo-below
1882 line lines level)))))
1883 tags)
1884 ;; Check for targets
1885 (while (string-match org-any-target-regexp line)
1886 (setq line
1887 (replace-match
1888 (let ((org-lparse-encode-pending t))
1889 (org-lparse-format 'FONTIFY
1890 (match-string 1 line) "target"))
1891 t t line)))
1892 (when (string-match
1893 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
1894 (setq tags (match-string 1 txt)
1895 txt (replace-match "" t nil txt)))
1896 (when (string-match quote-re0 txt)
1897 (setq txt (replace-match "" t t txt)))
1898 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
1899 (setq txt (replace-match "" t t txt)))
1900 (org-lparse-format
1901 'TOC-ITEM
1902 (let* ((snumber (org-section-number level))
1903 (href (replace-regexp-in-string
1904 "\\." "-" (format "sec-%s" snumber)))
1905 (href
1906 (or
1907 (cdr (assoc
1908 href org-export-preferred-target-alist))
1909 href))
1910 (href (org-solidify-link-text href)))
1911 (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
1912 level org-last-level)
1913 (setq org-last-level level)))
1914 line)
1915 lines))
1916 (org-lparse-end 'TOC)
1917 (setq org-lparse-toc (buffer-string))))
1918 lines)
1919
1920(defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
1921 (if org-lparse-table-ncols
1922 ;; second and subsequent rows of the table
1923 (when (and org-lparse-list-table-p
1924 (> (length fields) org-lparse-table-ncols))
1925 (error "Table row has %d columns but header row claims %d columns"
1926 (length fields) org-lparse-table-ncols))
1927 ;; first row of the table
1928 (setq org-lparse-table-ncols (length fields))
1929 (when org-lparse-table-is-styled
1930 (setq org-lparse-table-num-numeric-items-per-column
1931 (make-vector org-lparse-table-ncols 0))
1932 (setq org-lparse-table-colalign-vector
1933 (make-vector org-lparse-table-ncols nil))
1934 (let ((c -1))
1935 (while (< (incf c) org-lparse-table-ncols)
1936 (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info)))
1937 (align (nth 0 col-cookie)))
1938 (setf (aref org-lparse-table-colalign-vector c)
1939 (cond
1940 ((string= align "l") "left")
1941 ((string= align "r") "right")
1942 ((string= align "c") "center"))))))))
1943 (incf org-lparse-table-rownum)
1944 (let ((i -1))
1945 (org-lparse-format
1946 'TABLE-ROW
1947 (mapconcat
1948 (lambda (x)
1949 (when (and (string= x "") text-for-empty-fields)
1950 (setq x text-for-empty-fields))
1951 (incf i)
1952 (let (col-cookie horiz-span)
1953 (when org-lparse-table-is-styled
1954 (when (and (< i org-lparse-table-ncols)
1955 (string-match org-table-number-regexp x))
1956 (incf (aref org-lparse-table-num-numeric-items-per-column i)))
1957 (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info))
1958 horiz-span (nth 1 col-cookie)))
1959 (org-lparse-format
1960 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0))))
1961 fields "\n"))))
1962
1963(defun org-lparse-get (what &optional opt-plist)
1964 "Query for value of WHAT for the current backend `org-lparse-backend'.
1965See also `org-lparse-backend-get'."
1966 (if (boundp 'org-lparse-backend)
1967 (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
1968 (error "org-lparse-backend is not bound yet")))
1969
1970(defun org-lparse-backend-get (backend what &optional opt-plist)
1971 "Query BACKEND for value of WHAT.
1972Dispatch the call to `org-<backend>-user-get'. If that throws an
1973error, dispatch the call to `org-<backend>-get'. See
1974`org-xhtml-get' for all known settings queried for by
1975`org-lparse' during the course of export."
1976 (assert (stringp backend) t)
1977 (unless (org-lparse-backend-is-native-p backend)
1978 (error "Unknown native backend %s" backend))
1979 (let ((backend-get-method (intern (format "org-%s-get" backend)))
1980 (backend-user-get-method (intern (format "org-%s-user-get" backend))))
1981 (cond
1982 ((functionp backend-get-method)
1983 (condition-case nil
1984 (funcall backend-user-get-method what opt-plist)
1985 (error (funcall backend-get-method what opt-plist))))
1986 (t
1987 (error "Native backend %s doesn't define %s" backend backend-get-method)))))
1988
1989(defun org-lparse-insert-tag (tag &rest args)
1990 (when (member org-lparse-insert-tag-with-newlines '(lead both))
1991 (insert "\n"))
1992 (insert (apply 'format tag args))
1993 (when (member org-lparse-insert-tag-with-newlines '(trail both))
1994 (insert "\n")))
1995
1996(defun org-lparse-get-targets-from-title (title)
1997 (let* ((target (org-get-text-property-any 0 'target title))
1998 (extra-targets (assoc target org-export-target-aliases))
1999 (target (or (cdr (assoc target org-export-preferred-target-alist))
2000 target)))
2001 (cons target (remove target extra-targets))))
2002
2003(defun org-lparse-suffix-from-snumber (snumber)
2004 (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
2005 (href (cdr (assoc (concat "sec-" snu)
2006 org-export-preferred-target-alist))))
2007 (org-solidify-link-text (or href snu))))
2008
2009(defun org-lparse-begin-level (level title umax head-count)
2010 "Insert a new LEVEL in HTML export.
2011When TITLE is nil, just close all open levels."
2012 (org-lparse-end-level level umax)
2013 (unless title (error "Why is heading nil"))
2014 (let* ((targets (org-lparse-get-targets-from-title title))
2015 (target (car targets)) (extra-targets (cdr targets))
2016 (target (and target (org-solidify-link-text target)))
2017 (extra-class (org-get-text-property-any 0 'html-container-class title))
2018 snumber tags level1 class)
2019 (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
2020 (setq tags (and org-export-with-tags (match-string 1 title)))
2021 (setq title (replace-match "" t t title)))
2022 (if (> level umax)
2023 (progn
2024 (if (aref org-levels-open (1- level))
2025 (org-lparse-end-list-item-1)
2026 (aset org-levels-open (1- level) t)
2027 (org-lparse-end-paragraph)
2028 (org-lparse-begin-list 'unordered))
2029 (org-lparse-begin-list-item
2030 'unordered target (org-lparse-format
2031 'HEADLINE title extra-targets tags)))
2032 (aset org-levels-open (1- level) t)
2033 (setq snumber (org-section-number level))
2034 (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
2035 (unless (= head-count 1)
2036 (org-lparse-end-outline-text-or-outline))
2037 (org-lparse-begin-outline-and-outline-text
2038 level1 snumber title tags target extra-targets extra-class)
2039 (org-lparse-begin-paragraph))))
2040
2041(defun org-lparse-end-level (level umax)
2042 (org-lparse-end-paragraph)
2043 (loop for l from org-level-max downto level
2044 do (when (aref org-levels-open (1- l))
2045 ;; Terminate one level in HTML export
2046 (if (<= l umax)
2047 (org-lparse-end-outline-text-or-outline)
2048 (org-lparse-end-list-item-1)
2049 (org-lparse-end-list 'unordered))
2050 (aset org-levels-open (1- l) nil))))
2051
2052(defvar org-lparse-outline-text-open)
2053(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
2054 target extra-targets
2055 extra-class)
2056 (org-lparse-begin
2057 'OUTLINE level1 snumber title tags target extra-targets extra-class)
2058 (org-lparse-begin-outline-text level1 snumber extra-class))
2059
2060(defun org-lparse-end-outline-text-or-outline ()
2061 (cond
2062 (org-lparse-outline-text-open
2063 (org-lparse-end 'OUTLINE-TEXT)
2064 (setq org-lparse-outline-text-open nil))
2065 (t (org-lparse-end 'OUTLINE))))
2066
2067(defun org-lparse-begin-outline-text (level1 snumber extra-class)
2068 (assert (not org-lparse-outline-text-open) t)
2069 (setq org-lparse-outline-text-open t)
2070 (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
2071
2072(defun org-lparse-html-list-type-to-canonical-list-type (ltype)
2073 (cdr (assoc ltype '(("o" . ordered)
2074 ("u" . unordered)
2075 ("d" . description)))))
2076
2077;; following vars are bound during `org-do-lparse'
2078(defvar org-lparse-list-stack)
2079(defvar org-lparse-list-table:table-row)
2080(defvar org-lparse-list-table:lines)
2081
2082;; Notes on LIST-TABLES
2083;; ====================
2084;; Lists withing "list-table" blocks (as shown below)
2085;;
2086;; #+begin_list-table
2087;; - Row 1
2088;; - 1.1
2089;; - 1.2
2090;; - 1.3
2091;; - Row 2
2092;; - 2.1
2093;; - 2.2
2094;; - 2.3
2095;; #+end_list-table
2096;;
2097;; will be exported as though it were a table as shown below.
2098;;
2099;; | Row 1 | 1.1 | 1.2 | 1.3 |
2100;; | Row 2 | 2.1 | 2.2 | 2.3 |
2101;;
2102;; Note that org-tables are NOT multi-line and each line is mapped to
2103;; a unique row in the exported document. So if an exported table
2104;; needs to contain a single paragraph (with copious text) it needs to
2105;; be typed up in a single line. Editing such long lines using the
2106;; table editor will be a cumbersome task. Furthermore inclusion of
2107;; multi-paragraph text in a table cell is well-nigh impossible.
2108;;
2109;; LIST-TABLEs are meant to circumvent the above problems with
2110;; org-tables.
2111;;
2112;; Note that in the example above the list items could be paragraphs
2113;; themselves and the list can be arbitrarily deep.
2114;;
2115;; Inspired by following thread:
2116;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
2117
2118(defun org-lparse-begin-list (ltype)
2119 (push ltype org-lparse-list-stack)
2120 (let ((list-level (length org-lparse-list-stack)))
2121 (cond
2122 ((not org-lparse-list-table-p)
2123 (org-lparse-begin 'LIST ltype))
2124 ;; process LIST-TABLE
2125 ((= 1 list-level)
2126 ;; begin LIST-TABLE
2127 (setq org-lparse-list-table:lines nil)
2128 (setq org-lparse-list-table:table-row nil))
2129 ((= 2 list-level)
2130 (ignore))
2131 (t
2132 (org-lparse-begin 'LIST ltype)))))
2133
2134(defun org-lparse-end-list (ltype)
2135 (pop org-lparse-list-stack)
2136 (let ((list-level (length org-lparse-list-stack)))
2137 (cond
2138 ((not org-lparse-list-table-p)
2139 (org-lparse-end 'LIST ltype))
2140 ;; process LIST-TABLE
2141 ((= 0 list-level)
2142 ;; end LIST-TABLE
2143 (insert (org-lparse-format-list-table
2144 (nreverse org-lparse-list-table:lines))))
2145 ((= 1 list-level)
2146 (ignore))
2147 (t
2148 (org-lparse-end 'LIST ltype)))))
2149
2150(defun org-lparse-begin-list-item (ltype &optional arg headline)
2151 (let ((list-level (length org-lparse-list-stack)))
2152 (cond
2153 ((not org-lparse-list-table-p)
2154 (org-lparse-begin 'LIST-ITEM ltype arg headline))
2155 ;; process LIST-TABLE
2156 ((= 1 list-level)
2157 ;; begin TABLE-ROW for LIST-TABLE
2158 (setq org-lparse-list-table:table-row nil)
2159 (org-lparse-begin-list-table:table-cell))
2160 ((= 2 list-level)
2161 ;; begin TABLE-CELL for LIST-TABLE
2162 (org-lparse-begin-list-table:table-cell))
2163 (t
2164 (org-lparse-begin 'LIST-ITEM ltype arg headline)))))
2165
2166(defun org-lparse-end-list-item (ltype)
2167 (let ((list-level (length org-lparse-list-stack)))
2168 (cond
2169 ((not org-lparse-list-table-p)
2170 (org-lparse-end 'LIST-ITEM ltype))
2171 ;; process LIST-TABLE
2172 ((= 1 list-level)
2173 ;; end TABLE-ROW for LIST-TABLE
2174 (org-lparse-end-list-table:table-cell)
2175 (push (nreverse org-lparse-list-table:table-row)
2176 org-lparse-list-table:lines))
2177 ((= 2 list-level)
2178 ;; end TABLE-CELL for LIST-TABLE
2179 (org-lparse-end-list-table:table-cell))
2180 (t
2181 (org-lparse-end 'LIST-ITEM ltype)))))
2182
2183(defvar org-lparse-list-table:table-cell-open)
2184(defun org-lparse-begin-list-table:table-cell ()
2185 (org-lparse-end-list-table:table-cell)
2186 (setq org-lparse-list-table:table-cell-open t)
2187 (org-lparse-begin-collect)
2188 (org-lparse-begin-paragraph))
2189
2190(defun org-lparse-end-list-table:table-cell ()
2191 (when org-lparse-list-table:table-cell-open
2192 (setq org-lparse-list-table:table-cell-open nil)
2193 (org-lparse-end-paragraph)
2194 (push (org-lparse-end-collect)
2195 org-lparse-list-table:table-row)))
2196
2197(defvar org-lparse-table-rowgrp-info)
2198(defun org-lparse-begin-table-rowgroup (&optional is-header-row)
2199 (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
2200 (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
2201
2202(defun org-lparse-end-table ()
2203 (when org-lparse-table-is-styled
2204 ;; column groups
2205 (unless (car org-table-colgroup-info)
2206 (setq org-table-colgroup-info
2207 (cons :start (cdr org-table-colgroup-info))))
2208
2209 ;; column alignment
2210 (let ((c -1))
2211 (mapc
2212 (lambda (x)
2213 (incf c)
2214 (setf (aref org-lparse-table-colalign-vector c)
2215 (or (aref org-lparse-table-colalign-vector c)
2216 (if (> (/ (float x) (1+ org-lparse-table-rownum))
2217 org-table-number-fraction)
2218 "right" "left"))))
2219 org-lparse-table-num-numeric-items-per-column)))
2220 (org-lparse-end 'TABLE))
2221
2222(defvar org-lparse-encode-pending nil)
2223
2224(defun org-lparse-format-tags (tag text prefix suffix &rest args)
2225 (cond
2226 ((consp tag)
2227 (concat prefix (apply 'format (car tag) args) text suffix
2228 (format (cdr tag))))
2229 ((stringp tag) ; singleton tag
2230 (concat prefix (apply 'format tag args) text))))
2231
2232(defun org-xml-fix-class-name (kwd) ; audit callers of this function
2233 "Turn todo keyword into a valid class name.
2234Replaces invalid characters with \"_\"."
2235 (save-match-data
2236 (while (string-match "[^a-zA-Z0-9_]" kwd)
2237 (setq kwd (replace-match "_" t t kwd))))
2238 kwd)
2239
2240(defun org-lparse-format-todo (todo)
2241 (org-lparse-format 'FONTIFY
2242 (concat
2243 (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
2244 (org-xml-fix-class-name todo))
2245 (list (if (member todo org-done-keywords) "done" "todo")
2246 todo)))
2247
2248(defun org-lparse-format-extra-targets (extra-targets)
2249 (if (not extra-targets) ""
2250 (mapconcat (lambda (x)
2251 (setq x (org-solidify-link-text
2252 (if (org-uuidgen-p x) (concat "ID-" x) x)))
2253 (org-lparse-format 'ANCHOR "" x))
2254 extra-targets "")))
2255
2256(defun org-lparse-format-org-tags (tags)
2257 (if (not tags) ""
2258 (org-lparse-format
2259 'FONTIFY (mapconcat
2260 (lambda (x)
2261 (org-lparse-format
2262 'FONTIFY x
2263 (concat
2264 (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
2265 (org-xml-fix-class-name x))))
2266 (org-split-string tags ":")
2267 (org-lparse-format 'SPACES 1)) "tag")))
2268
2269(defun org-lparse-format-section-number (&optional snumber level)
2270 (and org-export-with-section-numbers
2271 (not org-lparse-body-only) snumber level
2272 (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
2273
2274(defun org-lparse-warn (msg)
2275 (if (not org-lparse-use-flashy-warning)
2276 (message msg)
2277 (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
2278 (message msg)
2279 (sleep-for 3)))
2280
2281(defun org-xml-format-href (s)
2282 "Make sure the S is valid as a href reference in an XHTML document."
2283 (save-match-data
2284 (let ((start 0))
2285 (while (string-match "&" s start)
2286 (setq start (+ (match-beginning 0) 3)
2287 s (replace-match "&amp;" t t s)))))
2288 s)
2289
2290(defun org-xml-format-desc (s)
2291 "Make sure the S is valid as a description in a link."
2292 (if (and s (not (get-text-property 1 'org-protected s)))
2293 (save-match-data
2294 (org-xml-encode-org-text s))
2295 s))
2296
2297(provide 'org-lparse)
2298
2299;; Local variables:
2300;; generated-autoload-file: "org-loaddefs.el"
2301;; End:
2302
2303;;; org-lparse.el ends here
diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el
deleted file mode 100644
index 5df68f56a05..00000000000
--- a/lisp/org/org-mac-message.el
+++ /dev/null
@@ -1,216 +0,0 @@
1;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
2
3;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
4
5;; Authors: John Wiegley <johnw@gnu.org>
6;; Christopher Suckling <suckling at gmail dot com>
7
8;; Keywords: outlines, hypermedia, calendar, wp
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26;; This file implements links to Apple Mail.app messages from within Org-mode.
27;; Org-mode does not load this module by default - if you would actually like
28;; this to happen then configure the variable `org-modules'.
29
30;; If you would like to create links to all flagged messages in an
31;; Apple Mail.app account, please customize the variable
32;; `org-mac-mail-account' and then call one of the following functions:
33
34;; (org-mac-message-insert-selected) copies a formatted list of links to
35;; the kill ring.
36
37;; (org-mac-message-insert-selected) inserts at point links to any
38;; messages selected in Mail.app.
39
40;; (org-mac-message-insert-flagged) searches within an org-mode buffer
41;; for a specific heading, creating it if it doesn't exist. Any
42;; message:// links within the first level of the heading are deleted
43;; and replaced with links to flagged messages.
44
45;;; Code:
46
47(require 'org)
48
49(defgroup org-mac-flagged-mail nil
50 "Options concerning linking to flagged Mail.app messages."
51 :tag "Org Mail.app"
52 :group 'org-link)
53
54(defcustom org-mac-mail-account "customize"
55 "The Mail.app account in which to search for flagged messages."
56 :group 'org-mac-flagged-mail
57 :type 'string)
58
59(org-add-link-type "message" 'org-mac-message-open)
60
61;; In mac.c, removed in Emacs 23.
62(declare-function do-applescript "org-mac-message" (script))
63(unless (fboundp 'do-applescript)
64 ;; Need to fake this using shell-command-to-string
65 (defun do-applescript (script)
66 (let (start cmd return)
67 (while (string-match "\n" script)
68 (setq script (replace-match "\r" t t script)))
69 (while (string-match "'" script start)
70 (setq start (+ 2 (match-beginning 0))
71 script (replace-match "\\'" t t script)))
72 (setq cmd (concat "osascript -e '" script "'"))
73 (setq return (shell-command-to-string cmd))
74 (concat "\"" (org-trim return) "\""))))
75
76(defun org-mac-message-open (message-id)
77 "Visit the message with the given MESSAGE-ID.
78This will use the command `open' with the message URL."
79 (start-process (concat "open message:" message-id) nil
80 "open" (concat "message://<" (substring message-id 2) ">")))
81
82(defun as-get-selected-mail ()
83 "AppleScript to create links to selected messages in Mail.app."
84 (do-applescript
85 (concat
86 "tell application \"Mail\"\n"
87 "set theLinkList to {}\n"
88 "set theSelection to selection\n"
89 "repeat with theMessage in theSelection\n"
90 "set theID to message id of theMessage\n"
91 "set theSubject to subject of theMessage\n"
92 "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
93 "copy theLink to end of theLinkList\n"
94 "end repeat\n"
95 "return theLinkList as string\n"
96 "end tell")))
97
98(defun as-get-flagged-mail ()
99 "AppleScript to create links to flagged messages in Mail.app."
100 (do-applescript
101 (concat
102 ;; Is Growl installed?
103 "tell application \"System Events\"\n"
104 "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
105 "if (count of growlHelpers) > 0 then\n"
106 "set growlHelperApp to item 1 of growlHelpers\n"
107 "else\n"
108 "set growlHelperApp to \"\"\n"
109 "end if\n"
110 "end tell\n"
111
112 ;; Get links
113 "tell application \"Mail\"\n"
114 "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
115 "set theLinkList to {}\n"
116 "repeat with aMailbox in theMailboxes\n"
117 "set theSelection to (every message in aMailbox whose flagged status = true)\n"
118 "repeat with theMessage in theSelection\n"
119 "set theID to message id of theMessage\n"
120 "set theSubject to subject of theMessage\n"
121 "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
122 "copy theLink to end of theLinkList\n"
123
124 ;; Report progress through Growl
125 ;; This "double tell" idiom is described in detail at
126 ;; http://macscripter.net/viewtopic.php?id=24570 The
127 ;; script compiler needs static knowledge of the
128 ;; growlHelperApp. Hmm, since we're compiling
129 ;; on-the-fly here, this is likely to be way less
130 ;; portable than I'd hoped. It'll work when the name
131 ;; is still "GrowlHelperApp", though.
132 "if growlHelperApp is not \"\" then\n"
133 "tell application \"GrowlHelperApp\"\n"
134 "tell application growlHelperApp\n"
135 "set the allNotificationsList to {\"FlaggedMail\"}\n"
136 "set the enabledNotificationsList to allNotificationsList\n"
137 "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
138 "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
139 "end tell\n"
140 "end tell\n"
141 "end if\n"
142 "end repeat\n"
143 "end repeat\n"
144 "return theLinkList as string\n"
145 "end tell")))
146
147(defun org-mac-message-get-links (&optional select-or-flag)
148 "Create links to the messages currently selected or flagged in Mail.app.
149This will use AppleScript to get the message-id and the subject of the
150messages in Mail.app and make a link out of it.
151When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
152the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
153The Org-syntax text will be pushed to the kill ring, and also returned."
154 (interactive "sLink to (s)elected or (f)lagged messages: ")
155 (setq select-or-flag (or select-or-flag "s"))
156 (message "AppleScript: searching mailboxes...")
157 (let* ((as-link-list
158 (if (string= select-or-flag "s")
159 (as-get-selected-mail)
160 (if (string= select-or-flag "f")
161 (as-get-flagged-mail)
162 (error "Please select \"s\" or \"f\""))))
163 (link-list
164 (mapcar
165 (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
166 (split-string as-link-list "[\r\n]+")))
167 split-link URL description orglink orglink-insert rtn orglink-list)
168 (while link-list
169 (setq split-link (split-string (pop link-list) "::split::"))
170 (setq URL (car split-link))
171 (setq description (cadr split-link))
172 (when (not (string= URL ""))
173 (setq orglink (org-make-link-string URL description))
174 (push orglink orglink-list)))
175 (setq rtn (mapconcat 'identity orglink-list "\n"))
176 (kill-new rtn)
177 rtn))
178
179(defun org-mac-message-insert-selected ()
180 "Insert a link to the messages currently selected in Mail.app.
181This will use AppleScript to get the message-id and the subject of the
182active mail in Mail.app and make a link out of it."
183 (interactive)
184 (insert (org-mac-message-get-links "s")))
185
186;; The following line is for backward compatibility
187(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
188
189(defun org-mac-message-insert-flagged (org-buffer org-heading)
190 "Asks for an org buffer and a heading within it, and replace message links.
191If heading exists, delete all message:// links within heading's first
192level. If heading doesn't exist, create it at point-max. Insert
193list of message:// links to flagged mail after heading."
194 (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
195 (with-current-buffer org-buffer
196 (goto-char (point-min))
197 (let ((isearch-forward t)
198 (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
199 (if (org-goto-local-search-headings org-heading nil t)
200 (if (not (eobp))
201 (progn
202 (save-excursion
203 (while (re-search-forward
204 message-re (save-excursion (outline-next-heading)) t)
205 (delete-region (match-beginning 0) (match-end 0)))
206 (insert "\n" (org-mac-message-get-links "f")))
207 (flush-lines "^$" (point) (outline-next-heading)))
208 (insert "\n" (org-mac-message-get-links "f")))
209 (goto-char (point-max))
210 (insert "\n")
211 (org-insert-heading nil t)
212 (insert org-heading "\n" (org-mac-message-get-links "f"))))))
213
214(provide 'org-mac-message)
215
216;;; org-mac-message.el ends here
diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el
deleted file mode 100644
index 820988bdbb4..00000000000
--- a/lisp/org/org-mew.el
+++ /dev/null
@@ -1,136 +0,0 @@
1;;; org-mew.el --- Support for links to Mew messages from within Org-mode
2
3;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
4
5;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;; This file implements links to Mew messages from within Org-mode.
28;; Org-mode loads this module by default - if this is not what you want,
29;; configure the variable `org-modules'.
30
31;;; Code:
32
33(require 'org)
34
35(defgroup org-mew nil
36 "Options concerning the Mew link."
37 :tag "Org Startup"
38 :group 'org-link)
39
40(defcustom org-mew-link-to-refile-destination t
41 "Create a link to the refile destination if the message is marked as refile."
42 :group 'org-mew
43 :type 'boolean)
44
45;; Declare external functions and variables
46(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
47(declare-function mew-case-folder "ext:mew-func" (case folder))
48(declare-function mew-header-get-value "ext:mew-header"
49 (field &optional as-list))
50(declare-function mew-init "ext:mew" ())
51(declare-function mew-refile-get "ext:mew-refile" (msg))
52(declare-function mew-sinfo-get-case "ext:mew-summary" ())
53(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
54(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
55(declare-function mew-summary-get-mark "ext:mew-mark" ())
56(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
57(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
58 (pattern folder src-msgs))
59(declare-function mew-summary-search-msg "ext:mew-const" (msg))
60(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
61(declare-function mew-summary-visit-folder "ext:mew-summary4"
62 (folder &optional goend no-ls))
63(declare-function mew-window-push "ext:mew" ())
64(defvar mew-init-p)
65(defvar mew-summary-goto-line-then-display)
66
67;; Install the link type
68(org-add-link-type "mew" 'org-mew-open)
69(add-hook 'org-store-link-functions 'org-mew-store-link)
70
71;; Implementation
72(defun org-mew-store-link ()
73 "Store a link to a Mew folder or message."
74 (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
75 (let* ((msgnum (mew-summary-message-number2))
76 (mark-info (mew-summary-get-mark))
77 (folder-name
78 (if (and org-mew-link-to-refile-destination
79 (eq mark-info ?o)) ; marked as refile
80 (mew-case-folder (mew-sinfo-get-case)
81 (nth 1 (mew-refile-get msgnum)))
82 (mew-summary-folder-name)))
83 message-id from to subject desc link date date-ts date-ts-ia)
84 (save-window-excursion
85 (if (fboundp 'mew-summary-set-message-buffer)
86 (mew-summary-set-message-buffer folder-name msgnum)
87 (set-buffer (mew-cache-hit folder-name msgnum t)))
88 (setq message-id (mew-header-get-value "Message-Id:"))
89 (setq from (mew-header-get-value "From:"))
90 (setq to (mew-header-get-value "To:"))
91 (setq date (mew-header-get-value "Date:"))
92 (setq date-ts (and date (format-time-string
93 (org-time-stamp-format t)
94 (date-to-time date))))
95 (setq date-ts-ia (and date (format-time-string
96 (org-time-stamp-format t t)
97 (date-to-time date))))
98 (setq subject (mew-header-get-value "Subject:")))
99 (org-store-link-props :type "mew" :from from :to to
100 :subject subject :message-id message-id)
101 (when date
102 (org-add-link-props :date date :date-timestamp date-ts
103 :date-timestamp-inactive date-ts-ia))
104 (setq message-id (org-remove-angle-brackets message-id))
105 (setq desc (org-email-link-description))
106 (setq link (concat "mew:" folder-name "#" message-id))
107 (org-add-link-props :link link :description desc)
108 link)))
109
110(defun org-mew-open (path)
111 "Follow the Mew message link specified by PATH."
112 (let (folder msgnum)
113 (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
114 (setq folder (match-string 1 path))
115 (setq msgnum (match-string 2 path)))
116 ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
117 (setq folder (match-string 1 path))
118 (setq msgnum (match-string 4 path)))
119 (t (error "Error in Mew link")))
120 (require 'mew)
121 (mew-window-push)
122 (unless mew-init-p (mew-init))
123 (mew-summary-visit-folder folder)
124 (when msgnum
125 (if (not (string-match "\\`[0-9]+\\'" msgnum))
126 (let* ((pattern (concat "message-id=" msgnum))
127 (msgs (mew-summary-pick-with-mewl pattern folder nil)))
128 (setq msgnum (car msgs))))
129 (if (mew-summary-search-msg msgnum)
130 (if mew-summary-goto-line-then-display
131 (mew-summary-display))
132 (error "Message not found")))))
133
134(provide 'org-mew)
135
136;;; org-mew.el ends here
diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el
deleted file mode 100644
index c614799db82..00000000000
--- a/lisp/org/org-mks.el
+++ /dev/null
@@ -1,134 +0,0 @@
1;;; org-mks.el --- Multi-key-selection for Org-mode
2
3;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24
25
26;;; Commentary:
27;;
28
29;;; Code:
30
31(require 'org)
32(eval-when-compile
33 (require 'cl))
34
35(defun org-mks (table title &optional prompt specials)
36 "Select a member of an alist with multiple keys.
37TABLE is the alist which should contain entries where the car is a string.
38There should be two types of entries.
39
401. prefix descriptions like (\"a\" \"Description\")
41 This indicates that `a' is a prefix key for multi-letter selection, and
42 that there are entries following with keys like \"ab\", \"ax\"...
43
442. Selectable members must have more than two elements, with the first
45 being the string of keys that lead to selecting it, and the second a
46 short description string of the item.
47
48The command will then make a temporary buffer listing all entries
49that can be selected with a single key, and all the single key
50prefixes. When you press the key for a single-letter entry, it is selected.
51When you press a prefix key, the commands (and maybe further prefixes)
52under this key will be shown and offered for selection.
53
54TITLE will be placed over the selection in the temporary buffer,
55PROMPT will be used when prompting for a key. SPECIAL is an alist with
56also (\"key\" \"description\") entries. When one of these is selection,
57only the bare key is returned."
58 (setq prompt (or prompt "Select: "))
59 (let (tbl orig-table dkey ddesc des-keys allowed-keys
60 current prefix rtn re pressed buffer (inhibit-quit t))
61 (save-window-excursion
62 (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
63 (setq orig-table table)
64 (catch 'exit
65 (while t
66 (erase-buffer)
67 (insert title "\n\n")
68 (setq tbl table
69 des-keys nil
70 allowed-keys nil)
71 (setq prefix (if current (concat current " ") ""))
72 (while tbl
73 (cond
74 ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
75 ;; This is a description on this level
76 (setq dkey (caar tbl) ddesc (cadar tbl))
77 (pop tbl)
78 (push dkey des-keys)
79 (push dkey allowed-keys)
80 (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n")
81 ;; Skip keys which are below this prefix
82 (setq re (concat "\\`" (regexp-quote dkey)))
83 (while (and tbl (string-match re (caar tbl))) (pop tbl)))
84 ((= 2 (length (car tbl)))
85 ;; Not yet a usable description, skip it
86 )
87 (t
88 ;; usable entry on this level
89 (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n")
90 (push (caar tbl) allowed-keys)
91 (pop tbl))))
92 (when specials
93 (insert "-------------------------------------------------------------------------------\n")
94 (let ((sp specials))
95 (while sp
96 (insert (format "[%s] %s\n"
97 (caar sp) (nth 1 (car sp))))
98 (push (caar sp) allowed-keys)
99 (pop sp))))
100 (push "\C-g" allowed-keys)
101 (goto-char (point-min))
102 (if (not (pos-visible-in-window-p (point-max)))
103 (org-fit-window-to-buffer))
104 (message prompt)
105 (setq pressed (char-to-string (read-char-exclusive)))
106 (while (not (member pressed allowed-keys))
107 (message "Invalid key `%s'" pressed) (sit-for 1)
108 (message prompt)
109 (setq pressed (char-to-string (read-char-exclusive))))
110 (when (equal pressed "\C-g")
111 (kill-buffer buffer)
112 (error "Abort"))
113 (when (and (not (assoc pressed table))
114 (not (member pressed des-keys))
115 (assoc pressed specials))
116 (throw 'exit (setq rtn pressed)))
117 (unless (member pressed des-keys)
118 (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
119 orig-table))))
120 (setq current (concat current pressed))
121 (setq table (mapcar
122 (lambda (x)
123 (if (and (> (length (car x)) 1)
124 (equal (substring (car x) 0 1) pressed))
125 (cons (substring (car x) 1) (cdr x))
126 nil))
127 table))
128 (setq table (remove nil table)))))
129 (when buffer (kill-buffer buffer))
130 rtn))
131
132(provide 'org-mks)
133
134;;; org-mks.el ends here
diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el
deleted file mode 100644
index 92228f37eb8..00000000000
--- a/lisp/org/org-odt.el
+++ /dev/null
@@ -1,2859 +0,0 @@
1;;; org-odt.el --- OpenDocument Text exporter for Org-mode
2
3;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
4
5;; Author: Jambunathan K <kjambunathan at gmail dot com>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;;; Code:
27(eval-when-compile
28 (require 'cl))
29(require 'org-lparse)
30
31(defgroup org-export-odt nil
32 "Options specific for ODT export of Org-mode files."
33 :tag "Org Export ODT"
34 :group 'org-export
35 :version "24.1")
36
37(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse
38(defun org-odt-insert-toc ()
39 (goto-char (point-min))
40 (cond
41 ((re-search-forward
42 "\\(<text:p [^>]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(</text:p>\\)?"
43 nil t)
44 (replace-match ""))
45 (t
46 (goto-char org-lparse-dyn-first-heading-pos)))
47 (insert (org-odt-format-toc)))
48
49(defun org-odt-end-export ()
50 (org-odt-insert-toc)
51 (org-odt-fixup-label-references)
52
53 ;; remove empty paragraphs
54 (goto-char (point-min))
55 (while (re-search-forward
56 "<text:p\\( text:style-name=\"Text_20_body\"\\)?>[ \r\n\t]*</text:p>"
57 nil t)
58 (replace-match ""))
59 (goto-char (point-min))
60
61 ;; Convert whitespace place holders
62 (goto-char (point-min))
63 (let (beg end n)
64 (while (setq beg (next-single-property-change (point) 'org-whitespace))
65 (setq n (get-text-property beg 'org-whitespace)
66 end (next-single-property-change beg 'org-whitespace))
67 (goto-char beg)
68 (delete-region beg end)
69 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
70 (make-string n ?x)))))
71
72 ;; Remove empty lines at the beginning of the file.
73 (goto-char (point-min))
74 (when (looking-at "\\s-+\n") (replace-match ""))
75
76 ;; Remove display properties
77 (remove-text-properties (point-min) (point-max) '(display t)))
78
79(defvar org-odt-suppress-xref nil)
80(defconst org-export-odt-special-string-regexps
81 '(("\\\\-" . "&#x00ad;\\1") ; shy
82 ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
83 ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
84 ("\\.\\.\\." . "&#x2026;")) ; hellip
85 "Regular expressions for special string conversion.")
86
87(defconst org-odt-lib-dir (file-name-directory load-file-name)
88 "Location of ODT exporter.
89Use this to infer values of `org-odt-styles-dir' and
90`org-export-odt-schema-dir'.")
91
92(defvar org-odt-data-dir nil
93 "Data directory for ODT exporter.
94Use this to infer values of `org-odt-styles-dir' and
95`org-export-odt-schema-dir'.")
96
97(defconst org-odt-schema-dir-list
98 (list
99 (and org-odt-data-dir
100 (expand-file-name "./schema/" org-odt-data-dir)) ; bail out
101 (eval-when-compile
102 (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
103 (expand-file-name "./schema/" org-odt-data-dir))))
104 "List of directories to search for OpenDocument schema files.
105Use this list to set the default value of
106`org-export-odt-schema-dir'. The entries in this list are
107populated heuristically based on the values of `org-odt-lib-dir'
108and `org-odt-data-dir'.")
109
110(defcustom org-export-odt-schema-dir
111 (let* ((schema-dir
112 (catch 'schema-dir
113 (message "Debug (org-odt): Searching for OpenDocument schema files...")
114 (mapc
115 (lambda (schema-dir)
116 (when schema-dir
117 (message "Debug (org-odt): Trying %s..." schema-dir)
118 (when (and (file-readable-p
119 (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
120 schema-dir))
121 (file-readable-p
122 (expand-file-name "od-schema-v1.2-cs01.rnc"
123 schema-dir))
124 (file-readable-p
125 (expand-file-name "schemas.xml" schema-dir)))
126 (message "Debug (org-odt): Using schema files under %s"
127 schema-dir)
128 (throw 'schema-dir schema-dir))))
129 org-odt-schema-dir-list)
130 (message "Debug (org-odt): No OpenDocument schema files installed")
131 nil)))
132 schema-dir)
133 "Directory that contains OpenDocument schema files.
134
135This directory contains:
1361. rnc files for OpenDocument schema
1372. a \"schemas.xml\" file that specifies locating rules needed
138 for auto validation of OpenDocument XML files.
139
140Use the customize interface to set this variable. This ensures
141that `rng-schema-locating-files' is updated and auto-validation
142of OpenDocument XML takes place based on the value
143`rng-nxml-auto-validate-flag'.
144
145The default value of this variable varies depending on the
146version of org in use and is initialized from
147`org-odt-schema-dir-list'. The OASIS schema files are available
148only in the org's private git repository. It is *not* bundled
149with GNU ELPA tar or standard Emacs distribution."
150 :type '(choice
151 (const :tag "Not set" nil)
152 (directory :tag "Schema directory"))
153 :group 'org-export-odt
154 :version "24.1"
155 :set
156 (lambda (var value)
157 "Set `org-export-odt-schema-dir'.
158Also add it to `rng-schema-locating-files'."
159 (let ((schema-dir value))
160 (set var
161 (if (and
162 (file-readable-p
163 (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
164 (file-readable-p
165 (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
166 (file-readable-p
167 (expand-file-name "schemas.xml" schema-dir)))
168 schema-dir
169 (when value
170 (message "Error (org-odt): %s has no OpenDocument schema files"
171 value))
172 nil)))
173 (when org-export-odt-schema-dir
174 (eval-after-load 'rng-loc
175 '(add-to-list 'rng-schema-locating-files
176 (expand-file-name "schemas.xml"
177 org-export-odt-schema-dir))))))
178
179(defconst org-odt-styles-dir-list
180 (list
181 (and org-odt-data-dir
182 (expand-file-name "./styles/" org-odt-data-dir)) ; bail out
183 (eval-when-compile
184 (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
185 (expand-file-name "./styles/" org-odt-data-dir)))
186 (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
187 (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
188 (expand-file-name "./org/" data-directory) ; system
189 )
190 "List of directories to search for OpenDocument styles files.
191See `org-odt-styles-dir'. The entries in this list are populated
192heuristically based on the values of `org-odt-lib-dir' and
193`org-odt-data-dir'.")
194
195(defconst org-odt-styles-dir
196 (let* ((styles-dir
197 (catch 'styles-dir
198 (message "Debug (org-odt): Searching for OpenDocument styles files...")
199 (mapc (lambda (styles-dir)
200 (when styles-dir
201 (message "Debug (org-odt): Trying %s..." styles-dir)
202 (when (and (file-readable-p
203 (expand-file-name
204 "OrgOdtContentTemplate.xml" styles-dir))
205 (file-readable-p
206 (expand-file-name
207 "OrgOdtStyles.xml" styles-dir)))
208 (message "Debug (org-odt): Using styles under %s"
209 styles-dir)
210 (throw 'styles-dir styles-dir))))
211 org-odt-styles-dir-list)
212 nil)))
213 (unless styles-dir
214 (error "Error (org-odt): Cannot find factory styles files, aborting"))
215 styles-dir)
216 "Directory that holds auxiliary XML files used by the ODT exporter.
217
218This directory contains the following XML files -
219 \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
220 XML files are used as the default values of
221 `org-export-odt-styles-file' and
222 `org-export-odt-content-template-file'.
223
224The default value of this variable varies depending on the
225version of org in use and is initialized from
226`org-odt-styles-dir-list'. Note that the user could be using org
227from one of: org's own private git repository, GNU ELPA tar or
228standard Emacs.")
229
230(defvar org-odt-file-extensions
231 '(("odt" . "OpenDocument Text")
232 ("ott" . "OpenDocument Text Template")
233 ("odm" . "OpenDocument Master Document")
234 ("ods" . "OpenDocument Spreadsheet")
235 ("ots" . "OpenDocument Spreadsheet Template")
236 ("odg" . "OpenDocument Drawing (Graphics)")
237 ("otg" . "OpenDocument Drawing Template")
238 ("odp" . "OpenDocument Presentation")
239 ("otp" . "OpenDocument Presentation Template")
240 ("odi" . "OpenDocument Image")
241 ("odf" . "OpenDocument Formula")
242 ("odc" . "OpenDocument Chart")))
243
244(mapc
245 (lambda (desc)
246 ;; Let Emacs open all OpenDocument files in archive mode
247 (add-to-list 'auto-mode-alist
248 (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
249 org-odt-file-extensions)
250
251;; register the odt exporter with the pre-processor
252(add-to-list 'org-export-backends 'odt)
253
254;; register the odt exporter with org-lparse library
255(org-lparse-register-backend 'odt)
256
257(defun org-odt-unload-function ()
258 (org-lparse-unregister-backend 'odt)
259 (remove-hook 'org-export-preprocess-after-blockquote-hook
260 'org-export-odt-preprocess-latex-fragments)
261 nil)
262
263(defcustom org-export-odt-content-template-file nil
264 "Template file for \"content.xml\".
265The exporter embeds the exported content just before
266\"</office:text>\" element.
267
268If unspecified, the file named \"OrgOdtContentTemplate.xml\"
269under `org-odt-styles-dir' is used."
270 :type 'file
271 :group 'org-export-odt
272 :version "24.1")
273
274(defcustom org-export-odt-styles-file nil
275 "Default styles file for use with ODT export.
276Valid values are one of:
2771. nil
2782. path to a styles.xml file
2793. path to a *.odt or a *.ott file
2804. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
281...))
282
283In case of option 1, an in-built styles.xml is used. See
284`org-odt-styles-dir' for more information.
285
286In case of option 3, the specified file is unzipped and the
287styles.xml embedded therein is used.
288
289In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
290and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
291generated odt file. Use relative path for specifying the
292FILE-MEMBERS. styles.xml must be specified as one of the
293FILE-MEMBERS.
294
295Use options 1, 2 or 3 only if styles.xml alone suffices for
296achieving the desired formatting. Use option 4, if the styles.xml
297references additional files like header and footer images for
298achieving the desired formatting.
299
300Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
301a per-file basis. For example,
302
303#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
304#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
305 :group 'org-export-odt
306 :version "24.1"
307 :type
308 '(choice
309 (const :tag "Factory settings" nil)
310 (file :must-match t :tag "styles.xml")
311 (file :must-match t :tag "ODT or OTT file")
312 (list :tag "ODT or OTT file + Members"
313 (file :must-match t :tag "ODF Text or Text Template file")
314 (cons :tag "Members"
315 (file :tag " Member" "styles.xml")
316 (repeat (file :tag "Member"))))))
317
318(eval-after-load 'org-exp
319 '(add-to-list 'org-export-inbuffer-options-extra
320 '("ODT_STYLES_FILE" :odt-styles-file)))
321
322(defconst org-export-odt-tmpdir-prefix "%s-")
323(defconst org-export-odt-bookmark-prefix "OrgXref.")
324(defvar org-odt-zip-dir nil
325 "Temporary directory that holds XML files during export.")
326
327(defvar org-export-odt-embed-images t
328 "Should the images be copied in to the odt file or just linked?")
329
330(defvar org-export-odt-inline-images 'maybe)
331(defcustom org-export-odt-inline-image-extensions
332 '("png" "jpeg" "jpg" "gif")
333 "Extensions of image files that can be inlined into HTML."
334 :type '(repeat (string :tag "Extension"))
335 :group 'org-export-odt
336 :version "24.1")
337
338(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
339 "Scaling factor for converting images pixels to inches.
340Use this for sizing of embedded images. See Info node `(org)
341Images in ODT export' for more information."
342 :type 'float
343 :group 'org-export-odt
344 :version "24.1")
345
346(defcustom org-export-odt-create-custom-styles-for-srcblocks t
347 "Whether custom styles for colorized source blocks be automatically created.
348When this option is turned on, the exporter creates custom styles
349for source blocks based on the advice of `htmlfontify'. Creation
350of custom styles happen as part of `org-odt-hfy-face-to-css'.
351
352When this option is turned off exporter does not create such
353styles.
354
355Use the latter option if you do not want the custom styles to be
356based on your current display settings. It is necessary that the
357styles.xml already contains needed styles for colorizing to work.
358
359This variable is effective only if
360`org-export-odt-fontify-srcblocks' is turned on."
361 :group 'org-export-odt
362 :version "24.1"
363 :type 'boolean)
364
365(defvar org-export-odt-default-org-styles-alist
366 '((paragraph . ((default . "Text_20_body")
367 (fixedwidth . "OrgFixedWidthBlock")
368 (verse . "OrgVerse")
369 (quote . "Quotations")
370 (blockquote . "Quotations")
371 (center . "OrgCenter")
372 (left . "OrgLeft")
373 (right . "OrgRight")
374 (title . "OrgTitle")
375 (subtitle . "OrgSubtitle")
376 (footnote . "Footnote")
377 (src . "OrgSrcBlock")
378 (illustration . "Illustration")
379 (table . "Table")
380 (definition-term . "Text_20_body_20_bold")
381 (horizontal-line . "Horizontal_20_Line")))
382 (character . ((default . "Default")
383 (bold . "Bold")
384 (emphasis . "Emphasis")
385 (code . "OrgCode")
386 (verbatim . "OrgCode")
387 (strike . "Strikethrough")
388 (underline . "Underline")
389 (subscript . "OrgSubscript")
390 (superscript . "OrgSuperscript")))
391 (list . ((ordered . "OrgNumberedList")
392 (unordered . "OrgBulletedList")
393 (description . "OrgDescriptionList"))))
394 "Default styles for various entities.")
395
396(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist)
397(defun org-odt-get-style-name-for-entity (category &optional entity)
398 (let ((entity (or entity 'default)))
399 (or
400 (cdr (assoc entity (cdr (assoc category
401 org-export-odt-org-styles-alist))))
402 (cdr (assoc entity (cdr (assoc category
403 org-export-odt-default-org-styles-alist))))
404 (error "Cannot determine style name for entity %s of type %s"
405 entity category))))
406
407(defcustom org-export-odt-preferred-output-format nil
408 "Automatically post-process to this format after exporting to \"odt\".
409Interactive commands `org-export-as-odt' and
410`org-export-as-odt-and-open' export first to \"odt\" format and
411then use `org-export-odt-convert-process' to convert the
412resulting document to this format. During customization of this
413variable, the list of valid values are populated based on
414`org-export-odt-convert-capabilities'.
415
416You can set this option on per-file basis using file local
417values. See Info node `(emacs) File Variables'."
418 :group 'org-export-odt
419 :version "24.1"
420 :type '(choice :convert-widget
421 (lambda (w)
422 (apply 'widget-convert (widget-type w)
423 (eval (car (widget-get w :args)))))
424 `((const :tag "None" nil)
425 ,@(mapcar (lambda (c)
426 `(const :tag ,c ,c))
427 (org-lparse-reachable-formats "odt")))))
428;;;###autoload
429(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
430
431(defmacro org-odt-cleanup-xml-buffers (&rest body)
432 `(let ((org-odt-zip-dir
433 (make-temp-file
434 (format org-export-odt-tmpdir-prefix "odf") t))
435 (--cleanup-xml-buffers
436 (function
437 (lambda nil
438 (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
439 "meta.xml" "styles.xml")))
440 ;; kill all xml buffers
441 (mapc (lambda (file)
442 (with-current-buffer
443 (find-file-noselect
444 (expand-file-name file org-odt-zip-dir) t)
445 (set-buffer-modified-p nil)
446 (kill-buffer)))
447 xml-files))
448 ;; delete temporary directory.
449 (org-delete-directory org-odt-zip-dir t)))))
450 (condition-case err
451 (prog1 (progn ,@body)
452 (funcall --cleanup-xml-buffers))
453 ((quit error)
454 (funcall --cleanup-xml-buffers)
455 (message "OpenDocument export failed: %s"
456 (error-message-string err))))))
457
458;;;###autoload
459(defun org-export-as-odt-and-open (arg)
460 "Export the outline as ODT and immediately open it with a browser.
461If there is an active region, export only the region.
462The prefix ARG specifies how many levels of the outline should become
463headlines. The default is 3. Lower levels will become bulleted lists."
464 (interactive "P")
465 (org-odt-cleanup-xml-buffers
466 (org-lparse-and-open
467 (or org-export-odt-preferred-output-format "odt") "odt" arg)))
468
469;;;###autoload
470(defun org-export-as-odt-batch ()
471 "Call the function `org-lparse-batch'.
472This function can be used in batch processing as:
473emacs --batch
474 --load=$HOME/lib/emacs/org.el
475 --eval \"(setq org-export-headline-levels 2)\"
476 --visit=MyFile --funcall org-export-as-odt-batch"
477 (org-odt-cleanup-xml-buffers (org-lparse-batch "odt")))
478
479;;; org-export-as-odt
480;;;###autoload
481(defun org-export-as-odt (arg &optional hidden ext-plist
482 to-buffer body-only pub-dir)
483 "Export the outline as a OpenDocumentText file.
484If there is an active region, export only the region. The prefix
485ARG specifies how many levels of the outline should become
486headlines. The default is 3. Lower levels will become bulleted
487lists. HIDDEN is obsolete and does nothing.
488EXT-PLIST is a property list with external parameters overriding
489org-mode's default settings, but still inferior to file-local
490settings. When TO-BUFFER is non-nil, create a buffer with that
491name and export to that buffer. If TO-BUFFER is the symbol
492`string', don't leave any buffer behind but just return the
493resulting XML as a string. When BODY-ONLY is set, don't produce
494the file header and footer, simply return the content of
495<body>...</body>, without even the body tags themselves. When
496PUB-DIR is set, use this as the publishing directory."
497 (interactive "P")
498 (org-odt-cleanup-xml-buffers
499 (org-lparse (or org-export-odt-preferred-output-format "odt")
500 "odt" arg hidden ext-plist to-buffer body-only pub-dir)))
501
502(defvar org-odt-entity-control-callbacks-alist
503 `((EXPORT
504 . (org-odt-begin-export org-odt-end-export))
505 (DOCUMENT-CONTENT
506 . (org-odt-begin-document-content org-odt-end-document-content))
507 (DOCUMENT-BODY
508 . (org-odt-begin-document-body org-odt-end-document-body))
509 (TOC
510 . (org-odt-begin-toc org-odt-end-toc))
511 (ENVIRONMENT
512 . (org-odt-begin-environment org-odt-end-environment))
513 (FOOTNOTE-DEFINITION
514 . (org-odt-begin-footnote-definition org-odt-end-footnote-definition))
515 (TABLE
516 . (org-odt-begin-table org-odt-end-table))
517 (TABLE-ROWGROUP
518 . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup))
519 (LIST
520 . (org-odt-begin-list org-odt-end-list))
521 (LIST-ITEM
522 . (org-odt-begin-list-item org-odt-end-list-item))
523 (OUTLINE
524 . (org-odt-begin-outline org-odt-end-outline))
525 (OUTLINE-TEXT
526 . (org-odt-begin-outline-text org-odt-end-outline-text))
527 (PARAGRAPH
528 . (org-odt-begin-paragraph org-odt-end-paragraph)))
529 "")
530
531(defvar org-odt-entity-format-callbacks-alist
532 `((EXTRA-TARGETS . org-lparse-format-extra-targets)
533 (ORG-TAGS . org-lparse-format-org-tags)
534 (SECTION-NUMBER . org-lparse-format-section-number)
535 (HEADLINE . org-odt-format-headline)
536 (TOC-ENTRY . org-odt-format-toc-entry)
537 (TOC-ITEM . org-odt-format-toc-item)
538 (TAGS . org-odt-format-tags)
539 (SPACES . org-odt-format-spaces)
540 (TABS . org-odt-format-tabs)
541 (LINE-BREAK . org-odt-format-line-break)
542 (FONTIFY . org-odt-format-fontify)
543 (TODO . org-lparse-format-todo)
544 (LINK . org-odt-format-link)
545 (INLINE-IMAGE . org-odt-format-inline-image)
546 (ORG-LINK . org-odt-format-org-link)
547 (HEADING . org-odt-format-heading)
548 (ANCHOR . org-odt-format-anchor)
549 (TABLE . org-lparse-format-table)
550 (TABLE-ROW . org-odt-format-table-row)
551 (TABLE-CELL . org-odt-format-table-cell)
552 (FOOTNOTES-SECTION . ignore)
553 (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference)
554 (HORIZONTAL-LINE . org-odt-format-horizontal-line)
555 (COMMENT . org-odt-format-comment)
556 (LINE . org-odt-format-line)
557 (ORG-ENTITY . org-odt-format-org-entity))
558 "")
559
560;;;_. callbacks
561;;;_. control callbacks
562;;;_ , document body
563(defun org-odt-begin-office-body ()
564 ;; automatic styles
565 (insert-file-contents
566 (or org-export-odt-content-template-file
567 (expand-file-name "OrgOdtContentTemplate.xml"
568 org-odt-styles-dir)))
569 (goto-char (point-min))
570 (re-search-forward "</office:text>" nil nil)
571 (delete-region (match-beginning 0) (point-max)))
572
573;; Following variable is let bound when `org-do-lparse' is in
574;; progress. See org-html.el.
575(defvar org-lparse-toc)
576(defun org-odt-format-toc ()
577 (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
578
579(defun org-odt-format-preamble (opt-plist)
580 (let* ((title (plist-get opt-plist :title))
581 (author (plist-get opt-plist :author))
582 (date (plist-get opt-plist :date))
583 (iso-date (org-odt-format-date date))
584 (date (org-odt-format-date date "%d %b %Y"))
585 (email (plist-get opt-plist :email))
586 ;; switch on or off above vars based on user settings
587 (author (and (plist-get opt-plist :author-info) (or author email)))
588 (email (and (plist-get opt-plist :email-info) email))
589 (date (and (plist-get opt-plist :time-stamp-file) date)))
590 (concat
591 ;; title
592 (when title
593 (concat
594 (org-odt-format-stylized-paragraph
595 'title (org-odt-format-tags
596 '("<text:title>" . "</text:title>") title))
597 ;; separator
598 "<text:p text:style-name=\"OrgTitle\"/>"))
599 (cond
600 ((and author (not email))
601 ;; author only
602 (concat
603 (org-odt-format-stylized-paragraph
604 'subtitle
605 (org-odt-format-tags
606 '("<text:initial-creator>" . "</text:initial-creator>")
607 author))
608 ;; separator
609 "<text:p text:style-name=\"OrgSubtitle\"/>"))
610 ((and author email)
611 ;; author and email
612 (concat
613 (org-odt-format-stylized-paragraph
614 'subtitle
615 (org-odt-format-link
616 (org-odt-format-tags
617 '("<text:initial-creator>" . "</text:initial-creator>")
618 author) (concat "mailto:" email)))
619 ;; separator
620 "<text:p text:style-name=\"OrgSubtitle\"/>")))
621 ;; date
622 (when date
623 (concat
624 (org-odt-format-stylized-paragraph
625 'subtitle
626 (org-odt-format-tags
627 '("<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">"
628 . "</text:date>") date "N75" iso-date))
629 ;; separator
630 "<text:p text:style-name=\"OrgSubtitle\"/>")))))
631
632(defun org-odt-begin-document-body (opt-plist)
633 (org-odt-begin-office-body)
634 (insert (org-odt-format-preamble opt-plist))
635 (setq org-lparse-dyn-first-heading-pos (point)))
636
637(defvar org-lparse-body-only) ; let bound during org-do-lparse
638(defvar org-lparse-to-buffer) ; let bound during org-do-lparse
639(defun org-odt-end-document-body (opt-plist)
640 (unless org-lparse-body-only
641 (org-lparse-insert-tag "</office:text>")
642 (org-lparse-insert-tag "</office:body>")))
643
644(defun org-odt-begin-document-content (opt-plist)
645 (ignore))
646
647(defun org-odt-end-document-content ()
648 (org-lparse-insert-tag "</office:document-content>"))
649
650(defun org-odt-begin-outline (level1 snumber title tags
651 target extra-targets class)
652 (org-lparse-insert
653 'HEADING (org-lparse-format
654 'HEADLINE title extra-targets tags snumber level1)
655 level1 target))
656
657(defun org-odt-end-outline ()
658 (ignore))
659
660(defun org-odt-begin-outline-text (level1 snumber class)
661 (ignore))
662
663(defun org-odt-end-outline-text ()
664 (ignore))
665
666(defun org-odt-begin-section (style &optional name)
667 (let ((default-name (car (org-odt-add-automatic-style "Section"))))
668 (org-lparse-insert-tag
669 "<text:section text:style-name=\"%s\" text:name=\"%s\">"
670 style (or name default-name))))
671
672(defun org-odt-end-section ()
673 (org-lparse-insert-tag "</text:section>"))
674
675(defun org-odt-begin-paragraph (&optional style)
676 (org-lparse-insert-tag
677 "<text:p%s>" (org-odt-get-extra-attrs-for-paragraph-style style)))
678
679(defun org-odt-end-paragraph ()
680 (org-lparse-insert-tag "</text:p>"))
681
682(defun org-odt-get-extra-attrs-for-paragraph-style (style)
683 (let (style-name)
684 (setq style-name
685 (cond
686 ((stringp style) style)
687 ((symbolp style) (org-odt-get-style-name-for-entity
688 'paragraph style))))
689 (unless style-name
690 (error "Don't know how to handle paragraph style %s" style))
691 (format " text:style-name=\"%s\"" style-name)))
692
693(defun org-odt-format-stylized-paragraph (style text)
694 (org-odt-format-tags
695 '("<text:p%s>" . "</text:p>") text
696 (org-odt-get-extra-attrs-for-paragraph-style style)))
697
698(defvar org-lparse-opt-plist) ; bound during org-do-lparse
699(defun org-odt-format-author (&optional author)
700 (when (setq author (or author (plist-get org-lparse-opt-plist :author)))
701 (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)))
702
703(defun org-odt-format-date (&optional org-ts fmt)
704 (save-match-data
705 (let* ((time
706 (and (stringp org-ts)
707 (string-match org-ts-regexp0 org-ts)
708 (apply 'encode-time
709 (org-fix-decoded-time
710 (org-parse-time-string (match-string 0 org-ts) t)))))
711 date)
712 (cond
713 (fmt (format-time-string fmt time))
714 (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time))
715 (format "%s:%s" (substring date 0 -2) (substring date -2)))))))
716
717(defun org-odt-begin-annotation (&optional author date)
718 (org-lparse-insert-tag "<office:annotation>")
719 (when (setq author (org-odt-format-author author))
720 (insert author))
721 (insert (org-odt-format-tags
722 '("<dc:date>" . "</dc:date>")
723 (org-odt-format-date
724 (or date (plist-get org-lparse-opt-plist :date)))))
725 (org-lparse-begin-paragraph))
726
727(defun org-odt-end-annotation ()
728 (org-lparse-insert-tag "</office:annotation>"))
729
730(defun org-odt-begin-environment (style env-options-plist)
731 (case style
732 (annotation
733 (org-lparse-stash-save-paragraph-state)
734 (org-odt-begin-annotation (plist-get env-options-plist 'author)
735 (plist-get env-options-plist 'date)))
736 ((blockquote verse center quote)
737 (org-lparse-begin-paragraph style)
738 (list))
739 ((fixedwidth native)
740 (org-lparse-end-paragraph)
741 (list))
742 (t (error "Unknown environment %s" style))))
743
744(defun org-odt-end-environment (style env-options-plist)
745 (case style
746 (annotation
747 (org-lparse-end-paragraph)
748 (org-odt-end-annotation)
749 (org-lparse-stash-pop-paragraph-state))
750 ((blockquote verse center quote)
751 (org-lparse-end-paragraph)
752 (list))
753 ((fixedwidth native)
754 (org-lparse-begin-paragraph)
755 (list))
756 (t (error "Unknown environment %s" style))))
757
758(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse
759(defvar org-odt-list-stack-stashed)
760(defun org-odt-begin-list (ltype)
761 (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
762 ltype))
763 (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype))
764 (extra (concat (if (or org-lparse-list-table-p
765 (and (= 1 (length org-lparse-list-stack))
766 (null org-odt-list-stack-stashed)))
767 " text:continue-numbering=\"false\""
768 " text:continue-numbering=\"true\"")
769 (when style-name
770 (format " text:style-name=\"%s\"" style-name)))))
771 (case ltype
772 ((ordered unordered description)
773 (org-lparse-end-paragraph)
774 (org-lparse-insert-tag "<text:list%s>" extra))
775 (t (error "Unknown list type: %s" ltype)))))
776
777(defun org-odt-end-list (ltype)
778 (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
779 ltype))
780 (if ltype
781 (org-lparse-insert-tag "</text:list>")
782 (error "Unknown list type: %s" ltype)))
783
784(defun org-odt-begin-list-item (ltype &optional arg headline)
785 (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
786 ltype))
787 (case ltype
788 (ordered
789 (assert (not headline) t)
790 (let* ((counter arg) (extra ""))
791 (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
792 (length org-odt-list-stack-stashed))
793 "<text:list-header>" "<text:list-item>"))
794 (org-lparse-begin-paragraph)))
795 (unordered
796 (let* ((id arg) (extra ""))
797 (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
798 (length org-odt-list-stack-stashed))
799 "<text:list-header>" "<text:list-item>"))
800 (org-lparse-begin-paragraph)
801 (insert (if headline (org-odt-format-target headline id)
802 (org-odt-format-bookmark "" id)))))
803 (description
804 (assert (not headline) t)
805 (let ((term (or arg "(no term)")))
806 (insert
807 (org-odt-format-tags
808 '("<text:list-item>" . "</text:list-item>")
809 (org-odt-format-stylized-paragraph 'definition-term term)))
810 (org-lparse-begin-list-item 'unordered)
811 (org-lparse-begin-list 'description)
812 (org-lparse-begin-list-item 'unordered)))
813 (t (error "Unknown list type"))))
814
815(defun org-odt-end-list-item (ltype)
816 (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
817 ltype))
818 (case ltype
819 ((ordered unordered)
820 (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
821 (length org-odt-list-stack-stashed))
822 (prog1 "</text:list-header>"
823 (setq org-odt-list-stack-stashed nil))
824 "</text:list-item>")))
825 (description
826 (org-lparse-end-list-item-1)
827 (org-lparse-end-list 'description)
828 (org-lparse-end-list-item-1))
829 (t (error "Unknown list type"))))
830
831(defun org-odt-discontinue-list ()
832 (let ((stashed-stack org-lparse-list-stack))
833 (loop for list-type in stashed-stack
834 do (org-lparse-end-list-item-1 list-type)
835 (org-lparse-end-list list-type))
836 (setq org-odt-list-stack-stashed stashed-stack)))
837
838(defun org-odt-continue-list ()
839 (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed))
840 (loop for list-type in org-odt-list-stack-stashed
841 do (org-lparse-begin-list list-type)
842 (org-lparse-begin-list-item list-type)))
843
844;; Following variables are let bound when table emission is in
845;; progress. See org-lparse.el.
846(defvar org-lparse-table-begin-marker)
847(defvar org-lparse-table-ncols)
848(defvar org-lparse-table-rowgrp-open)
849(defvar org-lparse-table-rownum)
850(defvar org-lparse-table-cur-rowgrp-is-hdr)
851(defvar org-lparse-table-is-styled)
852(defvar org-lparse-table-rowgrp-info)
853(defvar org-lparse-table-colalign-vector)
854
855(defvar org-odt-table-style nil
856 "Table style specified by \"#+ATTR_ODT: <style-name>\" line.
857This is set during `org-odt-begin-table'.")
858
859(defvar org-odt-table-style-spec nil
860 "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.")
861
862(defcustom org-export-odt-table-styles
863 '(("OrgEquation" "OrgEquation"
864 ((use-first-column-styles . t)
865 (use-last-column-styles . t))))
866 "Specify how Table Styles should be derived from a Table Template.
867This is a list where each element is of the
868form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
869
870TABLE-STYLE-NAME is the style associated with the table through
871`org-odt-table-style'.
872
873TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
874TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
875below) that is included in
876`org-export-odt-content-template-file'.
877
878TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
879 \"TableCell\"
880PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
881 \"TableParagraph\"
882TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
883 \"FirstRow\" | \"LastRow\" |
884 \"EvenRow\" | \"OddRow\" |
885 \"EvenColumn\" | \"OddColumn\" | \"\"
886where \"+\" above denotes string concatenation.
887
888TABLE-CELL-OPTIONS is an alist where each element is of the
889form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
890TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
891 `use-last-row-styles' |
892 `use-first-column-styles' |
893 `use-last-column-styles' |
894 `use-banding-rows-styles' |
895 `use-banding-columns-styles' |
896 `use-first-row-styles'
897ON-OR-OFF := `t' | `nil'
898
899For example, with the following configuration
900
901\(setq org-export-odt-table-styles
902 '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\"
903 \(\(use-first-row-styles . t\)
904 \(use-first-column-styles . t\)\)\)
905 \(\"TableWithHeaderColumns\" \"Custom\"
906 \(\(use-first-column-styles . t\)\)\)\)\)
907
9081. A table associated with \"TableWithHeaderRowsAndColumns\"
909 style will use the following table-cell styles -
910 \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
911 \"CustomTableCell\" and the following paragraph styles
912 \"CustomFirstRowTableParagraph\",
913 \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
914 as appropriate.
915
9162. A table associated with \"TableWithHeaderColumns\" style will
917 use the following table-cell styles -
918 \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
919 following paragraph styles
920 \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
921 as appropriate..
922
923Note that TABLE-TEMPLATE-NAME corresponds to the
924\"<table:table-template>\" elements contained within
925\"<office:styles>\". The entries (TABLE-STYLE-NAME
926TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
927\"table:template-name\" and \"table:use-first-row-styles\" etc
928attributes of \"<table:table>\" element. Refer ODF-1.2
929specification for more information. Also consult the
930implementation filed under `org-odt-get-table-cell-styles'.
931
932The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
933formatting of numbered display equations. Do not delete this
934style from the list."
935 :group 'org-export-odt
936 :version "24.1"
937 :type '(choice
938 (const :tag "None" nil)
939 (repeat :tag "Table Styles"
940 (list :tag "Table Style Specification"
941 (string :tag "Table Style Name")
942 (string :tag "Table Template Name")
943 (alist :options (use-first-row-styles
944 use-last-row-styles
945 use-first-column-styles
946 use-last-column-styles
947 use-banding-rows-styles
948 use-banding-columns-styles)
949 :key-type symbol
950 :value-type (const :tag "True" t))))))
951
952(defvar org-odt-table-style-format
953 "
954<style:style style:name=\"%s\" style:family=\"table\">
955 <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
956</style:style>
957"
958 "Template for auto-generated Table styles.")
959
960(defvar org-odt-automatic-styles '()
961 "Registry of automatic styles for various OBJECT-TYPEs.
962The variable has the following form:
963\(\(OBJECT-TYPE-A
964 \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\)
965 \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\)
966 \(OBJECT-TYPE-B
967 \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\)
968 \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\)
969 ...\).
970
971OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
972OBJECT-PROPS is (typically) a plist created by passing
973\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'.
974
975Use `org-odt-add-automatic-style' to add update this variable.'")
976
977(defvar org-odt-object-counters nil
978 "Running counters for various OBJECT-TYPEs.
979Use this to generate automatic names and style-names. See
980`org-odt-add-automatic-style'.")
981
982(defun org-odt-write-automatic-styles ()
983 "Write automatic styles to \"content.xml\"."
984 (with-current-buffer
985 (find-file-noselect (expand-file-name "content.xml") t)
986 ;; position the cursor
987 (goto-char (point-min))
988 (re-search-forward " </office:automatic-styles>" nil t)
989 (goto-char (match-beginning 0))
990 ;; write automatic table styles
991 (loop for (style-name props) in
992 (plist-get org-odt-automatic-styles 'Table) do
993 (when (setq props (or (plist-get props :rel-width) 96))
994 (insert (format org-odt-table-style-format style-name props))))))
995
996(defun org-odt-add-automatic-style (object-type &optional object-props)
997 "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
998OBJECT-PROPS is (typically) a plist created by passing
999\"#+ATTR_ODT: \" option of the object in question to
1000`org-lparse-get-block-params'.
1001
1002Use `org-odt-object-counters' to generate an automatic
1003OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
1004new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
1005. STYLE-NAME)."
1006 (assert (stringp object-type))
1007 (let* ((object (intern object-type))
1008 (seqvar object)
1009 (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
1010 (object-name (format "%s%d" object-type seqno)) style-name)
1011 (setq org-odt-object-counters
1012 (plist-put org-odt-object-counters seqvar seqno))
1013 (when object-props
1014 (setq style-name (format "Org%s" object-name))
1015 (setq org-odt-automatic-styles
1016 (plist-put org-odt-automatic-styles object
1017 (append (list (list style-name object-props))
1018 (plist-get org-odt-automatic-styles object)))))
1019 (cons object-name style-name)))
1020
1021(defvar org-odt-table-indentedp nil)
1022(defun org-odt-begin-table (caption label attributes short-caption)
1023 (setq org-odt-table-indentedp (not (null org-lparse-list-stack)))
1024 (when org-odt-table-indentedp
1025 ;; Within the Org file, the table is appearing within a list item.
1026 ;; OpenDocument doesn't allow table to appear within list items.
1027 ;; Temporarily terminate the list, emit the table and then
1028 ;; re-continue the list.
1029 (org-odt-discontinue-list)
1030 ;; Put the Table in an indented section.
1031 (let ((level (length org-odt-list-stack-stashed)))
1032 (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
1033 (setq attributes (org-lparse-get-block-params attributes))
1034 (setq org-odt-table-style (plist-get attributes :style))
1035 (setq org-odt-table-style-spec
1036 (assoc org-odt-table-style org-export-odt-table-styles))
1037 (when (or label caption)
1038 (insert
1039 (org-odt-format-stylized-paragraph
1040 'table (org-odt-format-entity-caption label caption "__Table__"))))
1041 (let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
1042 (org-lparse-insert-tag
1043 "<table:table table:name=\"%s\" table:style-name=\"%s\">"
1044 (or short-caption (car automatic-name))
1045 (or (nth 1 org-odt-table-style-spec)
1046 (cdr automatic-name) "OrgTable")))
1047 (setq org-lparse-table-begin-marker (point)))
1048
1049(defvar org-lparse-table-colalign-info)
1050(defun org-odt-end-table ()
1051 (goto-char org-lparse-table-begin-marker)
1052 (loop for level from 0 below org-lparse-table-ncols
1053 do (let* ((col-cookie (and org-lparse-table-is-styled
1054 (cdr (assoc (1+ level)
1055 org-lparse-table-colalign-info))))
1056 (extra-columns (or (nth 1 col-cookie) 0)))
1057 (dotimes (i (1+ extra-columns))
1058 (insert
1059 (org-odt-format-tags
1060 "<table:table-column table:style-name=\"%sColumn\"/>"
1061 "" (or (nth 1 org-odt-table-style-spec) "OrgTable"))))
1062 (insert "\n")))
1063 ;; fill style attributes for table cells
1064 (when org-lparse-table-is-styled
1065 (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t)
1066 (let* ((spec (match-string 1))
1067 (r (string-to-number (match-string 2)))
1068 (c (string-to-number (match-string 3)))
1069 (cell-styles (org-odt-get-table-cell-styles
1070 r c org-odt-table-style-spec))
1071 (table-cell-style (car cell-styles))
1072 (table-cell-paragraph-style (cdr cell-styles)))
1073 (cond
1074 ((equal spec "table-cell:p")
1075 (replace-match table-cell-paragraph-style t t))
1076 ((equal spec "table-cell:style-name")
1077 (replace-match table-cell-style t t))))))
1078 (goto-char (point-max))
1079 (org-lparse-insert-tag "</table:table>")
1080 (when org-odt-table-indentedp
1081 (org-odt-end-section)
1082 (org-odt-continue-list)))
1083
1084(defun org-odt-begin-table-rowgroup (&optional is-header-row)
1085 (when org-lparse-table-rowgrp-open
1086 (org-lparse-end 'TABLE-ROWGROUP))
1087 (org-lparse-insert-tag (if is-header-row
1088 "<table:table-header-rows>"
1089 "<table:table-rows>"))
1090 (setq org-lparse-table-rowgrp-open t)
1091 (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row))
1092
1093(defun org-odt-end-table-rowgroup ()
1094 (when org-lparse-table-rowgrp-open
1095 (setq org-lparse-table-rowgrp-open nil)
1096 (org-lparse-insert-tag
1097 (if org-lparse-table-cur-rowgrp-is-hdr
1098 "</table:table-header-rows>" "</table:table-rows>"))))
1099
1100(defun org-odt-format-table-row (row)
1101 (org-odt-format-tags
1102 '("<table:table-row>" . "</table:table-row>") row))
1103
1104(defun org-odt-get-table-cell-styles (r c &optional style-spec)
1105 "Retrieve styles applicable to a table cell.
1106R and C are (zero-based) row and column numbers of the table
1107cell. STYLE-SPEC is an entry in `org-export-odt-table-styles'
1108applicable to the current table. It is `nil' if the table is not
1109associated with any style attributes.
1110
1111Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
1112
1113When STYLE-SPEC is nil, style the table cell the conventional way
1114- choose cell borders based on row and column groupings and
1115choose paragraph alignment based on `org-col-cookies' text
1116property. See also
1117`org-odt-get-paragraph-style-cookie-for-table-cell'.
1118
1119When STYLE-SPEC is non-nil, ignore the above cookie and return
1120styles congruent with the ODF-1.2 specification."
1121 (cond
1122 (style-spec
1123
1124 ;; LibreOffice - particularly the Writer - honors neither table
1125 ;; templates nor custom table-cell styles. Inorder to retain
1126 ;; inter-operability with LibreOffice, only automatic styles are
1127 ;; used for styling of table-cells. The current implementation is
1128 ;; congruent with ODF-1.2 specification and hence is
1129 ;; future-compatible.
1130
1131 ;; Additional Note: LibreOffice's AutoFormat facility for tables -
1132 ;; which recognizes as many as 16 different cell types - is much
1133 ;; richer. Unfortunately it is NOT amenable to easy configuration
1134 ;; by hand.
1135
1136 (let* ((template-name (nth 1 style-spec))
1137 (cell-style-selectors (nth 2 style-spec))
1138 (cell-type
1139 (cond
1140 ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
1141 (= c 0)) "FirstColumn")
1142 ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
1143 (= c (1- org-lparse-table-ncols))) "LastColumn")
1144 ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
1145 (= r 0)) "FirstRow")
1146 ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
1147 (= r org-lparse-table-rownum))
1148 "LastRow")
1149 ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
1150 (= (% r 2) 1)) "EvenRow")
1151 ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
1152 (= (% r 2) 0)) "OddRow")
1153 ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
1154 (= (% c 2) 1)) "EvenColumn")
1155 ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
1156 (= (% c 2) 0)) "OddColumn")
1157 (t ""))))
1158 (cons
1159 (concat template-name cell-type "TableCell")
1160 (concat template-name cell-type "TableParagraph"))))
1161 (t
1162 (cons
1163 (concat
1164 "OrgTblCell"
1165 (cond
1166 ((= r 0) "T")
1167 ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T")
1168 (t ""))
1169 (when (= r org-lparse-table-rownum) "B")
1170 (cond
1171 ((= c 0) "")
1172 ((or (memq (nth c org-table-colgroup-info) '(:start :startend))
1173 (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
1174 (t "")))
1175 (capitalize (aref org-lparse-table-colalign-vector c))))))
1176
1177(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c)
1178 (concat
1179 (and (not org-odt-table-style-spec)
1180 (cond
1181 (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
1182 ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
1183 "OrgTableHeading")
1184 (t "OrgTableContents")))
1185 (and org-lparse-table-is-styled
1186 (format "@@table-cell:p@@%03d@@%03d@@" r c))))
1187
1188(defun org-odt-get-style-name-cookie-for-table-cell (r c)
1189 (when org-lparse-table-is-styled
1190 (format "@@table-cell:style-name@@%03d@@%03d@@" r c)))
1191
1192(defun org-odt-format-table-cell (data r c horiz-span)
1193 (concat
1194 (let* ((paragraph-style-cookie
1195 (org-odt-get-paragraph-style-cookie-for-table-cell r c))
1196 (style-name-cookie
1197 (org-odt-get-style-name-cookie-for-table-cell r c))
1198 (extra (and style-name-cookie
1199 (format " table:style-name=\"%s\"" style-name-cookie)))
1200 (extra (concat extra
1201 (and (> horiz-span 0)
1202 (format " table:number-columns-spanned=\"%d\""
1203 (1+ horiz-span))))))
1204 (org-odt-format-tags
1205 '("<table:table-cell%s>" . "</table:table-cell>")
1206 (if org-lparse-list-table-p data
1207 (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra))
1208 (let (s)
1209 (dotimes (i horiz-span)
1210 (setq s (concat s "\n<table:covered-table-cell/>"))) s)
1211 "\n"))
1212
1213(defun org-odt-begin-footnote-definition (n)
1214 (org-lparse-begin-paragraph 'footnote))
1215
1216(defun org-odt-end-footnote-definition (n)
1217 (org-lparse-end-paragraph))
1218
1219(defun org-odt-begin-toc (lang-specific-heading max-level)
1220 ;; Strings in `org-export-language-setup' can contain named html
1221 ;; entities. Replace those with utf-8 equivalents.
1222 (let ((i 0) entity rpl)
1223 (while (string-match "&\\([^#].*?\\);" lang-specific-heading i)
1224 (setq entity (match-string 1 lang-specific-heading))
1225 (if (not (setq rpl (org-entity-get-representation entity 'utf8)))
1226 (setq i (match-end 0))
1227 (setq i (+ (match-beginning 0) (length rpl)))
1228 (setq lang-specific-heading
1229 (replace-match rpl t t lang-specific-heading)))))
1230 (insert
1231 (format "
1232 <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\">
1233 <text:table-of-content-source text:outline-level=\"%d\">
1234 <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
1235" max-level lang-specific-heading))
1236 (loop for level from 1 upto 10
1237 do (insert (format
1238 "
1239 <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
1240 <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
1241 <text:index-entry-chapter/>
1242 <text:index-entry-text/>
1243 <text:index-entry-link-end/>
1244 </text:table-of-content-entry-template>
1245" level level)))
1246
1247 (insert
1248 (format "
1249 </text:table-of-content-source>
1250
1251 <text:index-body>
1252 <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
1253 <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
1254 </text:index-title>
1255" lang-specific-heading)))
1256
1257(defun org-odt-end-toc ()
1258 (insert "
1259 </text:index-body>
1260 </text:table-of-content>
1261"))
1262
1263(defun org-odt-format-toc-entry (snumber todo headline tags href)
1264 (setq headline (concat
1265 (and org-export-with-section-numbers
1266 (concat snumber ". "))
1267 headline
1268 (and tags
1269 (concat
1270 (org-lparse-format 'SPACES 3)
1271 (org-lparse-format 'FONTIFY tags "tag")))))
1272 (when todo
1273 (setq headline (org-lparse-format 'FONTIFY headline "todo")))
1274
1275 (let ((org-odt-suppress-xref t))
1276 (org-odt-format-link headline (concat "#" href))))
1277
1278(defun org-odt-format-toc-item (toc-entry level org-last-level)
1279 (let ((style (format "Contents_20_%d"
1280 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
1281 (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
1282
1283;; Following variable is let bound during 'ORG-LINK callback. See
1284;; org-html.el
1285(defvar org-lparse-link-description-is-image nil)
1286(defun org-odt-format-link (desc href &optional attr)
1287 (cond
1288 ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref))
1289 (setq href (substring href 1))
1290 (let ((xref-format "text"))
1291 (when (numberp desc)
1292 (setq desc (format "%d" desc) xref-format "number"))
1293 (when (listp desc)
1294 (setq desc (mapconcat 'identity desc ".") xref-format "chapter"))
1295 (setq href (concat org-export-odt-bookmark-prefix href))
1296 (org-odt-format-tags
1297 '("<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" .
1298 "</text:bookmark-ref>")
1299 desc xref-format href)))
1300 (org-lparse-link-description-is-image
1301 (org-odt-format-tags
1302 '("<draw:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</draw:a>")
1303 desc href (or attr "")))
1304 (t
1305 (org-odt-format-tags
1306 '("<text:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</text:a>")
1307 desc href (or attr "")))))
1308
1309(defun org-odt-format-spaces (n)
1310 (cond
1311 ((= n 1) " ")
1312 ((> n 1) (concat
1313 " " (org-odt-format-tags "<text:s text:c=\"%d\"/>" "" (1- n))))
1314 (t "")))
1315
1316(defun org-odt-format-tabs (&optional n)
1317 (let ((tab "<text:tab/>")
1318 (n (or n 1)))
1319 (insert tab)))
1320
1321(defun org-odt-format-line-break ()
1322 (org-odt-format-tags "<text:line-break/>" ""))
1323
1324(defun org-odt-format-horizontal-line ()
1325 (org-odt-format-stylized-paragraph 'horizontal-line ""))
1326
1327(defun org-odt-encode-plain-text (line &optional no-whitespace-filling)
1328 (setq line (org-xml-encode-plain-text line))
1329 (if no-whitespace-filling line
1330 (org-odt-fill-tabs-and-spaces line)))
1331
1332(defun org-odt-format-line (line)
1333 (case org-lparse-dyn-current-environment
1334 (fixedwidth (concat
1335 (org-odt-format-stylized-paragraph
1336 'fixedwidth (org-odt-encode-plain-text line)) "\n"))
1337 (t (concat line "\n"))))
1338
1339(defun org-odt-format-comment (fmt &rest args)
1340 (let ((comment (apply 'format fmt args)))
1341 (format "\n<!-- %s -->\n" comment)))
1342
1343(defun org-odt-format-org-entity (wd)
1344 (org-entity-get-representation wd 'utf8))
1345
1346(defun org-odt-fill-tabs-and-spaces (line)
1347 (replace-regexp-in-string
1348 "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s)
1349 (cond
1350 ((string= s "\t") (org-odt-format-tabs))
1351 (t (org-odt-format-spaces (length s))))) line))
1352
1353(defcustom org-export-odt-fontify-srcblocks t
1354 "Specify whether or not source blocks need to be fontified.
1355Turn this option on if you want to colorize the source code
1356blocks in the exported file. For colorization to work, you need
1357to make available an enhanced version of `htmlfontify' library."
1358 :type 'boolean
1359 :group 'org-export-odt
1360 :version "24.1")
1361
1362(defun org-odt-format-source-line-with-line-number-and-label
1363 (line rpllbl num fontifier par-style)
1364
1365 (let ((keep-label (not (numberp rpllbl)))
1366 (ref (org-find-text-property-in-string 'org-coderef line)))
1367 (setq line (concat line (and keep-label ref (format "(%s)" ref))))
1368 (setq line (funcall fontifier line))
1369 (when ref
1370 (setq line (org-odt-format-target line (concat "coderef-" ref))))
1371 (setq line (org-odt-format-stylized-paragraph par-style line))
1372 (if (not num) line
1373 (org-odt-format-tags '("<text:list-item>" . "</text:list-item>") line))))
1374
1375(defun org-odt-format-source-code-or-example-plain
1376 (lines lang caption textareap cols rows num cont rpllbl fmt)
1377 "Format source or example blocks much like fixedwidth blocks.
1378Use this when `org-export-odt-fontify-srcblocks' option is turned
1379off."
1380 (let* ((lines (org-split-string lines "[\r\n]"))
1381 (line-count (length lines))
1382 (i 0))
1383 (mapconcat
1384 (lambda (line)
1385 (incf i)
1386 (org-odt-format-source-line-with-line-number-and-label
1387 line rpllbl num 'org-odt-encode-plain-text
1388 (if (= i line-count) "OrgFixedWidthBlockLastLine"
1389 "OrgFixedWidthBlock")))
1390 lines "\n")))
1391
1392(defvar org-src-block-paragraph-format
1393 "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
1394 <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
1395 <style:background-image/>
1396 </style:paragraph-properties>
1397 <style:text-properties fo:color=\"%s\"/>
1398 </style:style>"
1399 "Custom paragraph style for colorized source and example blocks.
1400This style is much the same as that of \"OrgFixedWidthBlock\"
1401except that the foreground and background colors are set
1402according to the default face identified by the `htmlfontify'.")
1403
1404(defvar hfy-optimisations)
1405(declare-function hfy-face-to-style "htmlfontify" (fn))
1406(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
1407
1408(defun org-odt-hfy-face-to-css (fn)
1409 "Create custom style for face FN.
1410When FN is the default face, use it's foreground and background
1411properties to create \"OrgSrcBlock\" paragraph style. Otherwise
1412use it's color attribute to create a character style whose name
1413is obtained from FN. Currently all attributes of FN other than
1414color are ignored.
1415
1416The style name for a face FN is derived using the following
1417operations on the face name in that order - de-dash, CamelCase
1418and prefix with \"OrgSrc\". For example,
1419`font-lock-function-name-face' is associated with
1420\"OrgSrcFontLockFunctionNameFace\"."
1421 (let* ((css-list (hfy-face-to-style fn))
1422 (style-name ((lambda (fn)
1423 (concat "OrgSrc"
1424 (mapconcat
1425 'capitalize (split-string
1426 (hfy-face-or-def-to-name fn) "-")
1427 ""))) fn))
1428 (color-val (cdr (assoc "color" css-list)))
1429 (background-color-val (cdr (assoc "background" css-list)))
1430 (style (and org-export-odt-create-custom-styles-for-srcblocks
1431 (cond
1432 ((eq fn 'default)
1433 (format org-src-block-paragraph-format
1434 background-color-val color-val))
1435 (t
1436 (format
1437 "
1438<style:style style:name=\"%s\" style:family=\"text\">
1439 <style:text-properties fo:color=\"%s\"/>
1440 </style:style>" style-name color-val))))))
1441 (cons style-name style)))
1442
1443(defun org-odt-insert-custom-styles-for-srcblocks (styles)
1444 "Save STYLES used for colorizing of source blocks.
1445Update styles.xml with styles that were collected as part of
1446`org-odt-hfy-face-to-css' callbacks."
1447 (when styles
1448 (with-current-buffer
1449 (find-file-noselect (expand-file-name "styles.xml") t)
1450 (goto-char (point-min))
1451 (when (re-search-forward "</office:styles>" nil t)
1452 (goto-char (match-beginning 0))
1453 (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n")))))
1454
1455(defun org-odt-format-source-code-or-example-colored
1456 (lines lang caption textareap cols rows num cont rpllbl fmt)
1457 "Format source or example blocks using `htmlfontify-string'.
1458Use this routine when `org-export-odt-fontify-srcblocks' option
1459is turned on."
1460 (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
1461 (mode (and lang-m (intern (concat (if (symbolp lang-m)
1462 (symbol-name lang-m)
1463 lang-m) "-mode"))))
1464 (org-inhibit-startup t)
1465 (org-startup-folded nil)
1466 (lines (with-temp-buffer
1467 (insert lines)
1468 (if (functionp mode) (funcall mode) (fundamental-mode))
1469 (font-lock-fontify-buffer)
1470 (buffer-string)))
1471 (hfy-html-quote-regex "\\([<\"&> ]\\)")
1472 (hfy-html-quote-map '(("\"" "&quot;")
1473 ("<" "&lt;")
1474 ("&" "&amp;")
1475 (">" "&gt;")
1476 (" " "<text:s/>")
1477 (" " "<text:tab/>")))
1478 (hfy-face-to-css 'org-odt-hfy-face-to-css)
1479 (hfy-optimisations-1 (copy-sequence hfy-optimisations))
1480 (hfy-optimisations (add-to-list 'hfy-optimisations-1
1481 'body-text-only))
1482 (hfy-begin-span-handler
1483 (lambda (style text-block text-id text-begins-block-p)
1484 (insert (format "<text:span text:style-name=\"%s\">" style))))
1485 (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
1486 (when (fboundp 'htmlfontify-string)
1487 (let* ((lines (org-split-string lines "[\r\n]"))
1488 (line-count (length lines))
1489 (i 0))
1490 (mapconcat
1491 (lambda (line)
1492 (incf i)
1493 (org-odt-format-source-line-with-line-number-and-label
1494 line rpllbl num 'htmlfontify-string
1495 (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock")))
1496 lines "\n")))))
1497
1498(defun org-odt-format-source-code-or-example (lines lang caption textareap
1499 cols rows num cont
1500 rpllbl fmt)
1501 "Format source or example blocks for export.
1502Use `org-odt-format-source-code-or-example-plain' or
1503`org-odt-format-source-code-or-example-colored' depending on the
1504value of `org-export-odt-fontify-srcblocks."
1505 (setq lines (org-export-number-lines
1506 lines 0 0 num cont rpllbl fmt 'preprocess)
1507 lines (funcall
1508 (or (and org-export-odt-fontify-srcblocks
1509 (or (featurep 'htmlfontify)
1510 ;; htmlfontify.el was introduced in Emacs 23.2
1511 ;; So load it with some caution
1512 (require 'htmlfontify nil t))
1513 (fboundp 'htmlfontify-string)
1514 'org-odt-format-source-code-or-example-colored)
1515 'org-odt-format-source-code-or-example-plain)
1516 lines lang caption textareap cols rows num cont rpllbl fmt))
1517 (if (not num) lines
1518 (let ((extra (format " text:continue-numbering=\"%s\""
1519 (if cont "true" "false"))))
1520 (org-odt-format-tags
1521 '("<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>"
1522 . "</text:list>") lines extra))))
1523
1524(defun org-odt-remap-stylenames (style-name)
1525 (or
1526 (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper")
1527 ("timestamp" . "OrgTimestamp")
1528 ("timestamp-kwd" . "OrgTimestampKeyword")
1529 ("tag" . "OrgTag")
1530 ("todo" . "OrgTodo")
1531 ("done" . "OrgDone")
1532 ("target" . "OrgTarget"))))
1533 style-name))
1534
1535(defun org-odt-format-fontify (text style &optional id)
1536 (let* ((style-name
1537 (cond
1538 ((stringp style)
1539 (org-odt-remap-stylenames style))
1540 ((symbolp style)
1541 (org-odt-get-style-name-for-entity 'character style))
1542 ((listp style)
1543 (assert (< 1 (length style)))
1544 (let ((parent-style (pop style)))
1545 (mapconcat (lambda (s)
1546 ;; (assert (stringp s) t)
1547 (org-odt-remap-stylenames s)) style "")
1548 (org-odt-remap-stylenames parent-style)))
1549 (t (error "Don't how to handle style %s" style)))))
1550 (org-odt-format-tags
1551 '("<text:span text:style-name=\"%s\">" . "</text:span>")
1552 text style-name)))
1553
1554(defun org-odt-relocate-relative-path (path dir)
1555 (if (file-name-absolute-p path) path
1556 (file-relative-name (expand-file-name path dir)
1557 (expand-file-name "eyecandy" dir))))
1558
1559(defun org-odt-format-inline-image (thefile)
1560 (let* ((thelink (if (file-name-absolute-p thefile) thefile
1561 (org-xml-format-href
1562 (org-odt-relocate-relative-path
1563 thefile org-current-export-file))))
1564 (href
1565 (org-odt-format-tags
1566 "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
1567 (if org-export-odt-embed-images
1568 (org-odt-copy-image-file thefile) thelink))))
1569 (org-export-odt-format-image thefile href)))
1570
1571(defvar org-odt-entity-labels-alist nil
1572 "Associate Labels with the Labeled entities.
1573Each element of the alist is of the form (LABEL-NAME
1574CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as
1575that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the
1576type of the entity that LABEL-NAME is attached to. CATEGORY-NAME
1577can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is
1578the unique number assigned to the referenced entity on a
1579per-CATEGORY basis. It is generated sequentially and is 1-based.
1580LABEL-STYLE-NAME is a key `org-odt-label-styles'.
1581
1582See `org-odt-add-label-definition' and
1583`org-odt-fixup-label-references'.")
1584
1585(defun org-export-odt-format-formula (src href)
1586 (save-match-data
1587 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1588 (short-caption
1589 (or (org-find-text-property-in-string 'org-caption-shortn src)
1590 caption))
1591 (caption (and caption (org-xml-format-desc caption)))
1592 (short-caption (and short-caption
1593 (org-xml-encode-plain-text short-caption)))
1594 (label (org-find-text-property-in-string 'org-label src))
1595 (latex-frag (org-find-text-property-in-string 'org-latex-src src))
1596 (embed-as (or (and latex-frag
1597 (org-find-text-property-in-string
1598 'org-latex-src-embed-type src))
1599 (if (or caption label) 'paragraph 'character)))
1600 width height)
1601 (when latex-frag
1602 (setq href (org-propertize href :title "LaTeX Fragment"
1603 :description latex-frag)))
1604 (cond
1605 ((eq embed-as 'character)
1606 (org-odt-format-entity "InlineFormula" href width height))
1607 (t
1608 (org-lparse-end-paragraph)
1609 (org-lparse-insert-list-table
1610 `((,(org-odt-format-entity
1611 (if (not (or caption label)) "DisplayFormula"
1612 "CaptionedDisplayFormula")
1613 href width height :caption caption :label label
1614 :short-caption short-caption)
1615 ,(if (not (or caption label)) ""
1616 (let* ((label-props (car org-odt-entity-labels-alist)))
1617 (setcar (last label-props) "math-label")
1618 (apply 'org-odt-format-label-definition
1619 caption label-props)))))
1620 nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1)))
1621 (throw 'nextline nil))))))
1622
1623(defvar org-odt-embedded-formulas-count 0)
1624(defun org-odt-copy-formula-file (path)
1625 "Returns the internal name of the file"
1626 (let* ((src-file (expand-file-name
1627 path (file-name-directory org-current-export-file)))
1628 (target-dir (format "Formula-%04d/"
1629 (incf org-odt-embedded-formulas-count)))
1630 (target-file (concat target-dir "content.xml")))
1631 (when (not org-lparse-to-buffer)
1632 (message "Embedding %s as %s ..."
1633 (substring-no-properties path) target-file)
1634
1635 (make-directory target-dir)
1636 (org-odt-create-manifest-file-entry
1637 "application/vnd.oasis.opendocument.formula" target-dir "1.2")
1638
1639 (case (org-odt-is-formula-link-p src-file)
1640 (mathml
1641 (copy-file src-file target-file 'overwrite))
1642 (odf
1643 (org-odt-zip-extract-one src-file "content.xml" target-dir))
1644 (t
1645 (error "%s is not a formula file" src-file)))
1646
1647 (org-odt-create-manifest-file-entry "text/xml" target-file))
1648 target-file))
1649
1650(defun org-odt-format-inline-formula (thefile)
1651 (let* ((thelink (if (file-name-absolute-p thefile) thefile
1652 (org-xml-format-href
1653 (org-odt-relocate-relative-path
1654 thefile org-current-export-file))))
1655 (href
1656 (org-odt-format-tags
1657 "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
1658 (file-name-directory (org-odt-copy-formula-file thefile)))))
1659 (org-export-odt-format-formula thefile href)))
1660
1661(defun org-odt-is-formula-link-p (file)
1662 (let ((case-fold-search nil))
1663 (cond
1664 ((string-match "\\.\\(mathml\\|mml\\)\\'" file)
1665 'mathml)
1666 ((string-match "\\.odf\\'" file)
1667 'odf))))
1668
1669(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr
1670 descp)
1671 "Make a OpenDocument link.
1672OPT-PLIST is an options list.
1673TYPE-1 is the device-type of the link (THIS://foo.html).
1674PATH is the path of the link (http://THIS#location).
1675FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
1676DESC is the link description, if any.
1677ATTR is a string of other attributes of the a element."
1678 (declare (special org-lparse-par-open))
1679 (save-match-data
1680 (let* ((may-inline-p
1681 (and (member type-1 '("http" "https" "file"))
1682 (org-lparse-should-inline-p path descp)
1683 (not fragment)))
1684 (type (if (equal type-1 "id") "file" type-1))
1685 (filename path)
1686 (thefile path)
1687 sec-frag sec-nos)
1688 (cond
1689 ;; check for inlined images
1690 ((and (member type '("file"))
1691 (not fragment)
1692 (org-file-image-p
1693 filename org-export-odt-inline-image-extensions)
1694 (or (eq t org-export-odt-inline-images)
1695 (and org-export-odt-inline-images (not descp))))
1696 (org-odt-format-inline-image thefile))
1697 ;; check for embedded formulas
1698 ((and (member type '("file"))
1699 (not fragment)
1700 (org-odt-is-formula-link-p filename)
1701 (or (not descp)))
1702 (org-odt-format-inline-formula thefile))
1703 ;; code references
1704 ((string= type "coderef")
1705 (let* ((ref fragment)
1706 (lineno-or-ref (cdr (assoc ref org-export-code-refs)))
1707 (desc (and descp desc))
1708 (org-odt-suppress-xref nil)
1709 (href (org-xml-format-href (concat "#coderef-" ref))))
1710 (cond
1711 ((and (numberp lineno-or-ref) (not desc))
1712 (org-odt-format-link lineno-or-ref href))
1713 ((and (numberp lineno-or-ref) desc
1714 (string-match (regexp-quote (concat "(" ref ")")) desc))
1715 (format (replace-match "%s" t t desc)
1716 (org-odt-format-link lineno-or-ref href)))
1717 (t
1718 (setq desc (format
1719 (if (and desc (string-match
1720 (regexp-quote (concat "(" ref ")"))
1721 desc))
1722 (replace-match "%s" t t desc)
1723 (or desc "%s"))
1724 lineno-or-ref))
1725 (org-odt-format-link (org-xml-format-desc desc) href)))))
1726 ;; links to headlines
1727 ((and (string= type "")
1728 (or (not thefile) (string= thefile ""))
1729 (plist-get org-lparse-opt-plist :section-numbers)
1730 (get-text-property 0 'org-no-description fragment)
1731 (setq sec-frag fragment)
1732 (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)
1733 (and (setq sec-frag
1734 (loop for alias in org-export-target-aliases do
1735 (when (member fragment (cdr alias))
1736 (return (car alias)))))
1737 (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)))
1738 (setq sec-nos (org-split-string (match-string 1 sec-frag) "-"))
1739 (<= (length sec-nos) (plist-get org-lparse-opt-plist
1740 :headline-levels)))
1741 (let ((org-odt-suppress-xref nil))
1742 (org-odt-format-link sec-nos (concat "#" sec-frag) attr)))
1743 (t
1744 (when (string= type "file")
1745 (setq thefile
1746 (cond
1747 ((file-name-absolute-p path)
1748 (concat "file://" (expand-file-name path)))
1749 (t (org-odt-relocate-relative-path
1750 thefile org-current-export-file)))))
1751
1752 (when (and (member type '("" "http" "https" "file")) fragment)
1753 (setq thefile (concat thefile "#" fragment)))
1754
1755 (setq thefile (org-xml-format-href thefile))
1756
1757 (when (not (member type '("" "file")))
1758 (setq thefile (concat type ":" thefile)))
1759
1760 (let ((org-odt-suppress-xref
1761 ;; Typeset link to headlines with description, as a
1762 ;; regular hyperlink.
1763 (and (string= type "")
1764 (not (get-text-property 0 'org-no-description fragment)))))
1765 (org-odt-format-link
1766 (org-xml-format-desc desc) thefile attr)))))))
1767
1768(defun org-odt-format-heading (text level &optional id)
1769 (let* ((text (if id (org-odt-format-target text id) text)))
1770 (org-odt-format-tags
1771 '("<text:h text:style-name=\"Heading_20_%s\" text:outline-level=\"%s\">" .
1772 "</text:h>") text level level)))
1773
1774(defun org-odt-format-headline (title extra-targets tags
1775 &optional snumber level)
1776 (concat
1777 (org-lparse-format 'EXTRA-TARGETS extra-targets)
1778
1779 ;; No need to generate section numbers. They are auto-generated by
1780 ;; the application
1781
1782 ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
1783 title
1784 (and tags (concat (org-lparse-format 'SPACES 3)
1785 (org-lparse-format 'ORG-TAGS tags)))))
1786
1787(defun org-odt-format-anchor (text name &optional class)
1788 (org-odt-format-target text name))
1789
1790(defun org-odt-format-bookmark (text id)
1791 (if id
1792 (org-odt-format-tags "<text:bookmark text:name=\"%s\"/>" text id)
1793 text))
1794
1795(defun org-odt-format-target (text id)
1796 (let ((name (concat org-export-odt-bookmark-prefix id)))
1797 (concat
1798 (and id (org-odt-format-tags
1799 "<text:bookmark-start text:name=\"%s\"/>" "" name))
1800 (org-odt-format-bookmark text id)
1801 (and id (org-odt-format-tags
1802 "<text:bookmark-end text:name=\"%s\"/>" "" name)))))
1803
1804(defun org-odt-format-footnote (n def)
1805 (let ((id (concat "fn" n))
1806 (note-class "footnote")
1807 (par-style "Footnote"))
1808 (org-odt-format-tags
1809 '("<text:note text:id=\"%s\" text:note-class=\"%s\">" .
1810 "</text:note>")
1811 (concat
1812 (org-odt-format-tags
1813 '("<text:note-citation>" . "</text:note-citation>")
1814 n)
1815 (org-odt-format-tags
1816 '("<text:note-body>" . "</text:note-body>")
1817 def))
1818 id note-class)))
1819
1820(defun org-odt-format-footnote-reference (n def refcnt)
1821 (if (= refcnt 1)
1822 (org-odt-format-footnote n def)
1823 (org-odt-format-footnote-ref n)))
1824
1825(defun org-odt-format-footnote-ref (n)
1826 (let ((note-class "footnote")
1827 (ref-format "text")
1828 (ref-name (concat "fn" n)))
1829 (org-odt-format-tags
1830 '("<text:span text:style-name=\"%s\">" . "</text:span>")
1831 (org-odt-format-tags
1832 '("<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">" . "</text:note-ref>")
1833 n note-class ref-format ref-name)
1834 "OrgSuperscript")))
1835
1836(defun org-odt-get-image-name (file-name)
1837 (require 'sha1)
1838 (file-relative-name
1839 (expand-file-name
1840 (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
1841
1842(defun org-export-odt-format-image (src href)
1843 "Create image tag with source and attributes."
1844 (save-match-data
1845 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1846 (short-caption
1847 (or (org-find-text-property-in-string 'org-caption-shortn src)
1848 caption))
1849 (caption (and caption (org-xml-format-desc caption)))
1850 (short-caption (and short-caption
1851 (org-xml-encode-plain-text short-caption)))
1852 (attr (org-find-text-property-in-string 'org-attributes src))
1853 (label (org-find-text-property-in-string 'org-label src))
1854 (latex-frag (org-find-text-property-in-string
1855 'org-latex-src src))
1856 (category (and latex-frag "__DvipngImage__"))
1857 (attr-plist (org-lparse-get-block-params attr))
1858 (user-frame-anchor
1859 (car (assoc-string (plist-get attr-plist :anchor)
1860 '(("as-char") ("paragraph") ("page")) t)))
1861 (user-frame-style
1862 (and user-frame-anchor (plist-get attr-plist :style)))
1863 (user-frame-attrs
1864 (and user-frame-anchor (plist-get attr-plist :attributes)))
1865 (user-frame-params
1866 (list user-frame-style user-frame-attrs user-frame-anchor))
1867 (embed-as (cond
1868 (latex-frag
1869 (symbol-name
1870 (case (org-find-text-property-in-string
1871 'org-latex-src-embed-type src)
1872 (paragraph 'paragraph)
1873 (t 'as-char))))
1874 (user-frame-anchor)
1875 (t "paragraph")))
1876 (size (org-odt-image-size-from-file
1877 src (plist-get attr-plist :width)
1878 (plist-get attr-plist :height)
1879 (plist-get attr-plist :scale) nil embed-as))
1880 (width (car size)) (height (cdr size)))
1881 (when latex-frag
1882 (setq href (org-propertize href :title "LaTeX Fragment"
1883 :description latex-frag)))
1884 (let ((frame-style-handle (concat (and (or caption label) "Captioned")
1885 embed-as "Image")))
1886 (org-odt-format-entity
1887 frame-style-handle href width height
1888 :caption caption :label label :category category
1889 :short-caption short-caption
1890 :user-frame-params user-frame-params)))))
1891
1892(defun org-odt-format-object-description (title description)
1893 (concat (and title (org-odt-format-tags
1894 '("<svg:title>" . "</svg:title>")
1895 (org-odt-encode-plain-text title t)))
1896 (and description (org-odt-format-tags
1897 '("<svg:desc>" . "</svg:desc>")
1898 (org-odt-encode-plain-text description t)))))
1899
1900(defun org-odt-format-frame (text width height style &optional
1901 extra anchor-type)
1902 (let ((frame-attrs
1903 (concat
1904 (if width (format " svg:width=\"%0.2fcm\"" width) "")
1905 (if height (format " svg:height=\"%0.2fcm\"" height) "")
1906 extra
1907 (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")))))
1908 (org-odt-format-tags
1909 '("<draw:frame draw:style-name=\"%s\"%s>" . "</draw:frame>")
1910 (concat text (org-odt-format-object-description
1911 (get-text-property 0 :title text)
1912 (get-text-property 0 :description text)))
1913 style frame-attrs)))
1914
1915(defun org-odt-format-textbox (text width height style &optional
1916 extra anchor-type)
1917 (org-odt-format-frame
1918 (org-odt-format-tags
1919 '("<draw:text-box %s>" . "</draw:text-box>")
1920 text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
1921 (unless width
1922 (format " fo:min-width=\"%0.2fcm\"" (or width .2)))))
1923 width nil style extra anchor-type))
1924
1925(defun org-odt-format-inlinetask (heading content
1926 &optional todo priority tags)
1927 (org-odt-format-stylized-paragraph
1928 nil (org-odt-format-textbox
1929 (concat (org-odt-format-stylized-paragraph
1930 "OrgInlineTaskHeading"
1931 (org-lparse-format
1932 'HEADLINE (concat (org-lparse-format-todo todo) " " heading)
1933 nil tags))
1934 content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
1935
1936(defvar org-odt-entity-frame-styles
1937 '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
1938 ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
1939 ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
1940 ("CaptionedAs-CharImage" "__Figure__"
1941 ("OrgCaptionedImage"
1942 " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
1943 ("OrgInlineImage" nil "as-char"))
1944 ("CaptionedParagraphImage" "__Figure__"
1945 ("OrgCaptionedImage"
1946 " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
1947 ("OrgImageCaptionFrame" nil "paragraph"))
1948 ("CaptionedPageImage" "__Figure__"
1949 ("OrgCaptionedImage"
1950 " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
1951 ("OrgPageImageCaptionFrame" nil "page"))
1952 ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
1953 ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
1954 ("CaptionedDisplayFormula" "__MathFormula__"
1955 ("OrgCaptionedFormula" nil "paragraph")
1956 ("OrgFormulaCaptionFrame" nil "as-char"))))
1957
1958(defun org-odt-merge-frame-params(default-frame-params user-frame-params)
1959 (if (not user-frame-params) default-frame-params
1960 (assert (= (length default-frame-params) 3))
1961 (assert (= (length user-frame-params) 3))
1962 (loop for user-frame-param in user-frame-params
1963 for default-frame-param in default-frame-params
1964 collect (or user-frame-param default-frame-param))))
1965
1966(defun* org-odt-format-entity (entity href width height
1967 &key caption label category
1968 user-frame-params short-caption)
1969 (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
1970 default-frame-params frame-params)
1971 (cond
1972 ((not (or caption label))
1973 (setq default-frame-params (nth 2 entity-style))
1974 (setq frame-params (org-odt-merge-frame-params
1975 default-frame-params user-frame-params))
1976 (apply 'org-odt-format-frame href width height frame-params))
1977 (t
1978 (setq default-frame-params (nth 3 entity-style))
1979 (setq frame-params (org-odt-merge-frame-params
1980 default-frame-params user-frame-params))
1981 (apply 'org-odt-format-textbox
1982 (org-odt-format-stylized-paragraph
1983 'illustration
1984 (concat
1985 (apply 'org-odt-format-frame href width height
1986 (let ((entity-style-1 (copy-sequence
1987 (nth 2 entity-style))))
1988 (setcar (cdr entity-style-1)
1989 (concat
1990 (cadr entity-style-1)
1991 (and short-caption
1992 (format " draw:name=\"%s\" "
1993 short-caption))))
1994
1995 entity-style-1))
1996 (org-odt-format-entity-caption
1997 label caption (or category (nth 1 entity-style)))))
1998 width height frame-params)))))
1999
2000(defvar org-odt-embedded-images-count 0)
2001(defun org-odt-copy-image-file (path)
2002 "Returns the internal name of the file"
2003 (let* ((image-type (file-name-extension path))
2004 (media-type (format "image/%s" image-type))
2005 (src-file (expand-file-name
2006 path (file-name-directory org-current-export-file)))
2007 (target-dir "Images/")
2008 (target-file
2009 (format "%s%04d.%s" target-dir
2010 (incf org-odt-embedded-images-count) image-type)))
2011 (when (not org-lparse-to-buffer)
2012 (message "Embedding %s as %s ..."
2013 (substring-no-properties path) target-file)
2014
2015 (when (= 1 org-odt-embedded-images-count)
2016 (make-directory target-dir)
2017 (org-odt-create-manifest-file-entry "" target-dir))
2018
2019 (copy-file src-file target-file 'overwrite)
2020 (org-odt-create-manifest-file-entry media-type target-file))
2021 target-file))
2022
2023(defvar org-export-odt-image-size-probe-method
2024 (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
2025 '(emacs fixed))
2026 "Ordered list of methods for determining image sizes.")
2027
2028(defvar org-export-odt-default-image-sizes-alist
2029 '(("as-char" . (5 . 0.4))
2030 ("paragraph" . (5 . 5)))
2031 "Hardcoded image dimensions one for each of the anchor
2032 methods.")
2033
2034;; A4 page size is 21.0 by 29.7 cms
2035;; The default page settings has 2cm margin on each of the sides. So
2036;; the effective text area is 17.0 by 25.7 cm
2037(defvar org-export-odt-max-image-size '(17.0 . 20.0)
2038 "Limiting dimensions for an embedded image.")
2039
2040(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
2041 (let* ((dpi (or dpi org-export-odt-pixels-per-inch))
2042 (anchor-type (or anchor-type "paragraph"))
2043 (--pixels-to-cms
2044 (function
2045 (lambda (pixels dpi)
2046 (let* ((cms-per-inch 2.54)
2047 (inches (/ pixels dpi)))
2048 (* cms-per-inch inches)))))
2049 (--size-in-cms
2050 (function
2051 (lambda (size-in-pixels dpi)
2052 (and size-in-pixels
2053 (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
2054 (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))))
2055 (case probe-method
2056 (emacs
2057 (let ((size-in-pixels
2058 (ignore-errors ; Emacs could be in batch mode
2059 (clear-image-cache)
2060 (image-size (create-image file) 'pixels))))
2061 (funcall --size-in-cms size-in-pixels dpi)))
2062 (imagemagick
2063 (let ((size-in-pixels
2064 (let ((dim (shell-command-to-string
2065 (format "identify -format \"%%w:%%h\" \"%s\"" file))))
2066 (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
2067 (cons (string-to-number (match-string 1 dim))
2068 (string-to-number (match-string 2 dim)))))))
2069 (funcall --size-in-cms size-in-pixels dpi)))
2070 (t (cdr (assoc-string anchor-type
2071 org-export-odt-default-image-sizes-alist))))))
2072
2073(defun org-odt-image-size-from-file (file &optional user-width
2074 user-height scale dpi embed-as)
2075 (unless (file-name-absolute-p file)
2076 (setq file (expand-file-name
2077 file (file-name-directory org-current-export-file))))
2078 (let* (size width height)
2079 (unless (and user-height user-width)
2080 (loop for probe-method in org-export-odt-image-size-probe-method
2081 until size
2082 do (setq size (org-odt-do-image-size
2083 probe-method file dpi embed-as)))
2084 (or size (error "Cannot determine image size, aborting"))
2085 (setq width (car size) height (cdr size)))
2086 (cond
2087 (scale
2088 (setq width (* width scale) height (* height scale)))
2089 ((and user-height user-width)
2090 (setq width user-width height user-height))
2091 (user-height
2092 (setq width (* user-height (/ width height)) height user-height))
2093 (user-width
2094 (setq height (* user-width (/ height width)) width user-width))
2095 (t (ignore)))
2096 ;; ensure that an embedded image fits comfortably within a page
2097 (let ((max-width (car org-export-odt-max-image-size))
2098 (max-height (cdr org-export-odt-max-image-size)))
2099 (when (or (> width max-width) (> height max-height))
2100 (let* ((scale1 (/ max-width width))
2101 (scale2 (/ max-height height))
2102 (scale (min scale1 scale2)))
2103 (setq width (* scale width) height (* scale height)))))
2104 (cons width height)))
2105
2106(defvar org-odt-entity-counts-plist nil
2107 "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs.
2108See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.")
2109
2110(defvar org-odt-label-styles
2111 '(("math-formula" "%c" "text" "(%n)")
2112 ("math-label" "(%n)" "text" "(%n)")
2113 ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
2114 ("value" "%e %n: %c" "value" "%n"))
2115 "Specify how labels are applied and referenced.
2116This is an alist where each element is of the
2117form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
2118LABEL-REF-FMT).
2119
2120LABEL-ATTACH-FMT controls how labels and captions are attached to
2121an entity. It may contain following specifiers - %e, %n and %c.
2122%e is replaced with the CATEGORY-NAME. %n is replaced with
2123\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
2124with CAPTION. See `org-odt-format-label-definition'.
2125
2126LABEL-REF-MODE and LABEL-REF-FMT controls how label references
2127are generated. The following XML is generated for a label
2128reference - \"<text:sequence-ref
2129text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
2130</text:sequence-ref>\". LABEL-REF-FMT may contain following
2131specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
2132%n is replaced with SEQNO. See
2133`org-odt-format-label-reference'.")
2134
2135(defcustom org-export-odt-category-strings
2136 '(("en" "Table" "Figure" "Equation" "Equation"))
2137 "Specify category strings for various captionable entities.
2138Captionable entity can be one of a Table, an Embedded Image, a
2139LaTeX fragment (generated with dvipng) or a Math Formula.
2140
2141For example, when `org-export-default-language' is \"en\", an
2142embedded image will be captioned as \"Figure 1: Orgmode Logo\".
2143If you want the images to be captioned instead as \"Illustration
21441: Orgmode Logo\", then modify the entry for \"en\" as shown
2145below.
2146
2147 \(setq org-export-odt-category-strings
2148 '\(\(\"en\" \"Table\" \"Illustration\"
2149 \"Equation\" \"Equation\"\)\)\)"
2150 :group 'org-export-odt
2151 :version "24.1"
2152 :type '(repeat (list (string :tag "Language tag")
2153 (choice :tag "Table"
2154 (const :tag "Use Default" nil)
2155 (string :tag "Category string"))
2156 (choice :tag "Figure"
2157 (const :tag "Use Default" nil)
2158 (string :tag "Category string"))
2159 (choice :tag "Math Formula"
2160 (const :tag "Use Default" nil)
2161 (string :tag "Category string"))
2162 (choice :tag "Dvipng Image"
2163 (const :tag "Use Default" nil)
2164 (string :tag "Category string")))))
2165
2166(defvar org-odt-category-map-alist
2167 '(("__Table__" "Table" "value")
2168 ("__Figure__" "Illustration" "value")
2169 ("__MathFormula__" "Text" "math-formula")
2170 ("__DvipngImage__" "Equation" "value")
2171 ;; ("__Table__" "Table" "category-and-value")
2172 ;; ("__Figure__" "Figure" "category-and-value")
2173 ;; ("__DvipngImage__" "Equation" "category-and-value")
2174 )
2175 "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
2176This is a list where each entry is of the form \\(CATEGORY-HANDLE
2177OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the
2178captionable entity in question. OD-VARIABLE is the OpenDocument
2179sequence counter associated with the entity. These counters are
2180declared within
2181\"<text:sequence-decls>...</text:sequence-decls>\" block of
2182`org-export-odt-content-template-file'. LABEL-STYLE is a key
2183into `org-odt-label-styles' and specifies how a given entity
2184should be captioned and referenced.
2185
2186The position of a CATEGORY-HANDLE in this list is used as an
2187index in to per-language entry for
2188`org-export-odt-category-strings' to retrieve a CATEGORY-NAME.
2189This CATEGORY-NAME is then used for qualifying the user-specified
2190captions on export.")
2191
2192(defun org-odt-add-label-definition (label default-category)
2193 "Create an entry in `org-odt-entity-labels-alist' and return it."
2194 (let* ((label-props (assoc default-category org-odt-category-map-alist))
2195 ;; identify the sequence number
2196 (counter (nth 1 label-props))
2197 (sequence-var (intern counter))
2198 (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var)
2199 0)))
2200 ;; assign an internal label, if user has not provided one
2201 (label (if label (substring-no-properties label)
2202 (format "%s-%s" default-category seqno)))
2203 ;; identify label style
2204 (label-style (nth 2 label-props))
2205 ;; grok language setting
2206 (en-strings (assoc-default "en" org-export-odt-category-strings))
2207 (lang (plist-get org-lparse-opt-plist :language))
2208 (lang-strings (assoc-default lang org-export-odt-category-strings))
2209 ;; retrieve localized category sting
2210 (pos (- (length org-odt-category-map-alist)
2211 (length (memq label-props org-odt-category-map-alist))))
2212 (category (or (nth pos lang-strings) (nth pos en-strings)))
2213 (label-props (list label category counter seqno label-style)))
2214 ;; synchronize internal counters
2215 (setq org-odt-entity-counts-plist
2216 (plist-put org-odt-entity-counts-plist sequence-var seqno))
2217 ;; stash label properties for later retrieval
2218 (push label-props org-odt-entity-labels-alist)
2219 label-props))
2220
2221(defun org-odt-format-label-definition (caption label category counter
2222 seqno label-style)
2223 (assert label)
2224 (format-spec
2225 (cadr (assoc-string label-style org-odt-label-styles t))
2226 `((?e . ,category)
2227 (?n . ,(org-odt-format-tags
2228 '("<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">" . "</text:sequence>")
2229 (format "%d" seqno) label counter counter))
2230 (?c . ,(or caption "")))))
2231
2232(defun org-odt-format-label-reference (label category counter
2233 seqno label-style)
2234 (assert label)
2235 (save-match-data
2236 (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
2237 (fmt1 (car fmt))
2238 (fmt2 (cadr fmt)))
2239 (org-odt-format-tags
2240 '("<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">"
2241 . "</text:sequence-ref>")
2242 (format-spec fmt2 `((?e . ,category)
2243 (?n . ,(format "%d" seqno)))) fmt1 label))))
2244
2245(defun org-odt-fixup-label-references ()
2246 (goto-char (point-min))
2247 (while (re-search-forward
2248 "<text:sequence-ref text:ref-name=\"\\([^\"]+\\)\">[ \t\n]*</text:sequence-ref>"
2249 nil t)
2250 (let* ((label (match-string 1))
2251 (label-def (assoc label org-odt-entity-labels-alist))
2252 (rpl (and label-def
2253 (apply 'org-odt-format-label-reference label-def))))
2254 (if rpl (replace-match rpl t t)
2255 (org-lparse-warn
2256 (format "Unable to resolve reference to label \"%s\"" label))))))
2257
2258(defun org-odt-format-entity-caption (label caption category)
2259 (if (not (or label caption)) ""
2260 (apply 'org-odt-format-label-definition caption
2261 (org-odt-add-label-definition label category))))
2262
2263(defun org-odt-format-tags (tag text &rest args)
2264 (let ((prefix (when org-lparse-encode-pending "@"))
2265 (suffix (when org-lparse-encode-pending "@")))
2266 (apply 'org-lparse-format-tags tag text prefix suffix args)))
2267
2268(defvar org-odt-manifest-file-entries nil)
2269(defun org-odt-init-outfile (filename)
2270 (unless (executable-find "zip")
2271 ;; Not at all OSes ship with zip by default
2272 (error "Executable \"zip\" needed for creating OpenDocument files"))
2273
2274 (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir)))
2275 ;; init conten.xml
2276 (require 'nxml-mode)
2277 (let ((nxml-auto-insert-xml-declaration-flag nil))
2278 (find-file-noselect content-file t))
2279
2280 ;; reset variables
2281 (setq org-odt-manifest-file-entries nil
2282 org-odt-embedded-images-count 0
2283 org-odt-embedded-formulas-count 0
2284 org-odt-entity-labels-alist nil
2285 org-odt-list-stack-stashed nil
2286 org-odt-automatic-styles nil
2287 org-odt-object-counters nil
2288 org-odt-entity-counts-plist nil)
2289 content-file))
2290
2291(defcustom org-export-odt-prettify-xml nil
2292 "Specify whether or not the xml output should be prettified.
2293When this option is turned on, `indent-region' is run on all
2294component xml buffers before they are saved. Turn this off for
2295regular use. Turn this on if you need to examine the xml
2296visually."
2297 :group 'org-export-odt
2298 :version "24.1"
2299 :type 'boolean)
2300
2301(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse
2302(defun org-odt-save-as-outfile (target opt-plist)
2303 ;; write automatic styles
2304 (org-odt-write-automatic-styles)
2305
2306 ;; write meta file
2307 (org-odt-update-meta-file opt-plist)
2308
2309 ;; write styles file
2310 (when (equal org-lparse-backend 'odt)
2311 (org-odt-update-styles-file opt-plist))
2312
2313 ;; create mimetype file
2314 (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend)))
2315 (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
2316
2317 ;; create a manifest entry for content.xml
2318 (org-odt-create-manifest-file-entry "text/xml" "content.xml")
2319
2320 ;; write out the manifest entries before zipping
2321 (org-odt-write-manifest-file)
2322
2323 (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
2324 "meta.xml")))
2325 (when (equal org-lparse-backend 'odt)
2326 (push "styles.xml" xml-files))
2327
2328 ;; save all xml files
2329 (mapc (lambda (file)
2330 (with-current-buffer
2331 (find-file-noselect (expand-file-name file) t)
2332 ;; prettify output if needed
2333 (when org-export-odt-prettify-xml
2334 (indent-region (point-min) (point-max)))
2335 (save-buffer 0)))
2336 xml-files)
2337
2338 (let* ((target-name (file-name-nondirectory target))
2339 (target-dir (file-name-directory target))
2340 (cmds `(("zip" "-mX0" ,target-name "mimetype")
2341 ("zip" "-rmTq" ,target-name "."))))
2342 (when (file-exists-p target)
2343 ;; FIXME: If the file is locked this throws a cryptic error
2344 (delete-file target))
2345
2346 (let ((coding-system-for-write 'no-conversion) exitcode err-string)
2347 (message "Creating odt file...")
2348 (mapc
2349 (lambda (cmd)
2350 (message "Running %s" (mapconcat 'identity cmd " "))
2351 (setq err-string
2352 (with-output-to-string
2353 (setq exitcode
2354 (apply 'call-process (car cmd)
2355 nil standard-output nil (cdr cmd)))))
2356 (or (zerop exitcode)
2357 (ignore (message "%s" err-string))
2358 (error "Unable to create odt file (%S)" exitcode)))
2359 cmds))
2360
2361 ;; move the file from outdir to target-dir
2362 (rename-file target-name target-dir)))
2363
2364 (message "Created %s" target)
2365 (set-buffer (find-file-noselect target t)))
2366
2367(defconst org-odt-manifest-file-entry-tag
2368 "
2369<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
2370
2371(defun org-odt-create-manifest-file-entry (&rest args)
2372 (push args org-odt-manifest-file-entries))
2373
2374(defun org-odt-write-manifest-file ()
2375 (make-directory "META-INF")
2376 (let ((manifest-file (expand-file-name "META-INF/manifest.xml")))
2377 (with-current-buffer
2378 (let ((nxml-auto-insert-xml-declaration-flag nil))
2379 (find-file-noselect manifest-file t))
2380 (insert
2381 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
2382 <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
2383 (mapc
2384 (lambda (file-entry)
2385 (let* ((version (nth 2 file-entry))
2386 (extra (if version
2387 (format " manifest:version=\"%s\"" version)
2388 "")))
2389 (insert
2390 (format org-odt-manifest-file-entry-tag
2391 (nth 0 file-entry) (nth 1 file-entry) extra))))
2392 org-odt-manifest-file-entries)
2393 (insert "\n</manifest:manifest>"))))
2394
2395(defun org-odt-update-meta-file (opt-plist)
2396 (let ((date (org-odt-format-date (plist-get opt-plist :date)))
2397 (author (or (plist-get opt-plist :author) ""))
2398 (email (plist-get opt-plist :email))
2399 (keywords (plist-get opt-plist :keywords))
2400 (description (plist-get opt-plist :description))
2401 (title (plist-get opt-plist :title)))
2402 (write-region
2403 (concat
2404 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
2405 <office:document-meta
2406 xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
2407 xmlns:xlink=\"http://www.w3.org/1999/xlink\"
2408 xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
2409 xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
2410 xmlns:ooo=\"http://openoffice.org/2004/office\"
2411 office:version=\"1.2\">
2412 <office:meta>" "\n"
2413 (org-odt-format-author)
2414 (org-odt-format-tags
2415 '("\n<meta:initial-creator>" . "</meta:initial-creator>") author)
2416 (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date)
2417 (org-odt-format-tags
2418 '("\n<meta:creation-date>" . "</meta:creation-date>") date)
2419 (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
2420 (when org-export-creator-info
2421 (format "Org-%s/Emacs-%s"
2422 (org-version)
2423 emacs-version)))
2424 (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
2425 (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)
2426 (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title)
2427 "\n"
2428 " </office:meta>" "</office:document-meta>")
2429 nil (expand-file-name "meta.xml")))
2430
2431 ;; create a manifest entry for meta.xml
2432 (org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
2433
2434(defun org-odt-update-styles-file (opt-plist)
2435 ;; write styles file
2436 (let ((styles-file (plist-get opt-plist :odt-styles-file)))
2437 (org-odt-copy-styles-file (and styles-file
2438 (read (org-trim styles-file)))))
2439
2440 ;; Update styles.xml - take care of outline numbering
2441 (with-current-buffer
2442 (find-file-noselect (expand-file-name "styles.xml") t)
2443 ;; Don't make automatic backup of styles.xml file. This setting
2444 ;; prevents the backed-up styles.xml file from being zipped in to
2445 ;; odt file. This is more of a hackish fix. Better alternative
2446 ;; would be to fix the zip command so that the output odt file
2447 ;; includes only the needed files and excludes any auto-generated
2448 ;; extra files like backups and auto-saves etc etc. Note that
2449 ;; currently the zip command zips up the entire temp directory so
2450 ;; that any auto-generated files created under the hood ends up in
2451 ;; the resulting odt file.
2452 (set (make-local-variable 'backup-inhibited) t)
2453
2454 ;; Import local setting of `org-export-with-section-numbers'
2455 (org-lparse-bind-local-variables opt-plist)
2456 (org-odt-configure-outline-numbering
2457 (if org-export-with-section-numbers org-export-headline-levels 0)))
2458
2459 ;; Write custom styles for source blocks
2460 (org-odt-insert-custom-styles-for-srcblocks
2461 (mapconcat
2462 (lambda (style)
2463 (format " %s\n" (cddr style)))
2464 hfy-user-sheet-assoc "")))
2465
2466(defun org-odt-write-mimetype-file (format)
2467 ;; create mimetype file
2468 (let ((mimetype
2469 (case format
2470 (odt "application/vnd.oasis.opendocument.text")
2471 (odf "application/vnd.oasis.opendocument.formula")
2472 (t (error "Unknown OpenDocument backend %S" org-lparse-backend)))))
2473 (write-region mimetype nil (expand-file-name "mimetype"))
2474 mimetype))
2475
2476(defun org-odt-finalize-outfile ()
2477 (org-odt-delete-empty-paragraphs))
2478
2479(defun org-odt-delete-empty-paragraphs ()
2480 (goto-char (point-min))
2481 (let ((open "<text:p[^>]*>")
2482 (close "</text:p>"))
2483 (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
2484 (replace-match ""))))
2485
2486(defcustom org-export-odt-convert-processes
2487 '(("LibreOffice"
2488 "soffice --headless --convert-to %f%x --outdir %d %i")
2489 ("unoconv"
2490 "unoconv -f %f -o %d %i"))
2491 "Specify a list of document converters and their usage.
2492The converters in this list are offered as choices while
2493customizing `org-export-odt-convert-process'.
2494
2495This variable is a list where each element is of the
2496form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
2497of the converter. CONVERTER-CMD is the shell command for the
2498converter and can contain format specifiers. These format
2499specifiers are interpreted as below:
2500
2501%i input file name in full
2502%I input file name as a URL
2503%f format of the output file
2504%o output file name in full
2505%O output file name as a URL
2506%d output dir in full
2507%D output dir as a URL.
2508%x extra options as set in `org-export-odt-convert-capabilities'."
2509 :group 'org-export-odt
2510 :version "24.1"
2511 :type
2512 '(choice
2513 (const :tag "None" nil)
2514 (alist :tag "Converters"
2515 :key-type (string :tag "Converter Name")
2516 :value-type (group (string :tag "Command line")))))
2517
2518(defcustom org-export-odt-convert-process "LibreOffice"
2519 "Use this converter to convert from \"odt\" format to other formats.
2520During customization, the list of converter names are populated
2521from `org-export-odt-convert-processes'."
2522 :group 'org-export-odt
2523 :version "24.1"
2524 :type '(choice :convert-widget
2525 (lambda (w)
2526 (apply 'widget-convert (widget-type w)
2527 (eval (car (widget-get w :args)))))
2528 `((const :tag "None" nil)
2529 ,@(mapcar (lambda (c)
2530 `(const :tag ,(car c) ,(car c)))
2531 org-export-odt-convert-processes))))
2532
2533(defcustom org-export-odt-convert-capabilities
2534 '(("Text"
2535 ("odt" "ott" "doc" "rtf" "docx")
2536 (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
2537 ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
2538 ("Web"
2539 ("html")
2540 (("pdf" "pdf") ("odt" "odt") ("html" "html")))
2541 ("Spreadsheet"
2542 ("ods" "ots" "xls" "csv" "xlsx")
2543 (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
2544 ("xls" "xls") ("xlsx" "xlsx")))
2545 ("Presentation"
2546 ("odp" "otp" "ppt" "pptx")
2547 (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
2548 ("pptx" "pptx") ("odg" "odg"))))
2549 "Specify input and output formats of `org-export-odt-convert-process'.
2550More correctly, specify the set of input and output formats that
2551the user is actually interested in.
2552
2553This variable is an alist where each element is of the
2554form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
2555INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
2556alist where each element is of the form (OUTPUT-FMT
2557OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
2558
2559The variable is interpreted as follows:
2560`org-export-odt-convert-process' can take any document that is in
2561INPUT-FMT-LIST and produce any document that is in the
2562OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
2563OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
2564serves dual purposes:
2565- It is used for populating completion candidates during
2566 `org-export-odt-convert' commands.
2567- It is used as the value of \"%f\" specifier in
2568 `org-export-odt-convert-process'.
2569
2570EXTRA-OPTIONS is used as the value of \"%x\" specifier in
2571`org-export-odt-convert-process'.
2572
2573DOCUMENT-CLASS is used to group a set of file formats in
2574INPUT-FMT-LIST in to a single class.
2575
2576Note that this variable inherently captures how LibreOffice based
2577converters work. LibreOffice maps documents of various formats
2578to classes like Text, Web, Spreadsheet, Presentation etc and
2579allow document of a given class (irrespective of it's source
2580format) to be converted to any of the export formats associated
2581with that class.
2582
2583See default setting of this variable for an typical
2584configuration."
2585 :group 'org-export-odt
2586 :version "24.1"
2587 :type
2588 '(choice
2589 (const :tag "None" nil)
2590 (alist :tag "Capabilities"
2591 :key-type (string :tag "Document Class")
2592 :value-type
2593 (group (repeat :tag "Input formats" (string :tag "Input format"))
2594 (alist :tag "Output formats"
2595 :key-type (string :tag "Output format")
2596 :value-type
2597 (group (string :tag "Output file extension")
2598 (choice
2599 (const :tag "None" nil)
2600 (string :tag "Extra options"))))))))
2601
2602(declare-function org-create-math-formula "org"
2603 (latex-frag &optional mathml-file))
2604
2605;;;###autoload
2606(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg)
2607 "Convert IN-FILE to format OUT-FMT using a command line converter.
2608IN-FILE is the file to be converted. If unspecified, it defaults
2609to variable `buffer-file-name'. OUT-FMT is the desired output
2610format. Use `org-export-odt-convert-process' as the converter.
2611If PREFIX-ARG is non-nil then the newly converted file is opened
2612using `org-open-file'."
2613 (interactive
2614 (append (org-lparse-convert-read-params) current-prefix-arg))
2615 (org-lparse-do-convert in-file out-fmt prefix-arg))
2616
2617(defun org-odt-get (what &optional opt-plist)
2618 (case what
2619 (BACKEND 'odt)
2620 (EXPORT-DIR (org-export-directory :html opt-plist))
2621 (FILE-NAME-EXTENSION "odt")
2622 (EXPORT-BUFFER-NAME "*Org ODT Export*")
2623 (ENTITY-CONTROL org-odt-entity-control-callbacks-alist)
2624 (ENTITY-FORMAT org-odt-entity-format-callbacks-alist)
2625 (INIT-METHOD 'org-odt-init-outfile)
2626 (FINAL-METHOD 'org-odt-finalize-outfile)
2627 (SAVE-METHOD 'org-odt-save-as-outfile)
2628 (CONVERT-METHOD
2629 (and org-export-odt-convert-process
2630 (cadr (assoc-string org-export-odt-convert-process
2631 org-export-odt-convert-processes t))))
2632 (CONVERT-CAPABILITIES
2633 (and org-export-odt-convert-process
2634 (cadr (assoc-string org-export-odt-convert-process
2635 org-export-odt-convert-processes t))
2636 org-export-odt-convert-capabilities))
2637 (TOPLEVEL-HLEVEL 1)
2638 (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
2639 (INLINE-IMAGES 'maybe)
2640 (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg"))
2641 (PLAIN-TEXT-MAP '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
2642 (TABLE-FIRST-COLUMN-AS-LABELS nil)
2643 (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
2644 (CODING-SYSTEM-FOR-WRITE 'utf-8)
2645 (CODING-SYSTEM-FOR-SAVE 'utf-8)
2646 (t (error "Unknown property: %s" what))))
2647
2648(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
2649(defun org-export-odt-do-preprocess-latex-fragments ()
2650 "Convert LaTeX fragments to images."
2651 (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments))
2652 (latex-frag-opt ; massage the options
2653 (or (and (member latex-frag-opt '(mathjax t))
2654 (not (and (fboundp 'org-format-latex-mathml-available-p)
2655 (org-format-latex-mathml-available-p)))
2656 (prog1 org-lparse-latex-fragment-fallback
2657 (org-lparse-warn
2658 (concat
2659 "LaTeX to MathML converter not available. "
2660 (format "Using %S instead."
2661 org-lparse-latex-fragment-fallback)))))
2662 latex-frag-opt))
2663 cache-dir display-msg)
2664 (cond
2665 ((eq latex-frag-opt 'dvipng)
2666 (setq cache-dir org-latex-preview-ltxpng-directory)
2667 (setq display-msg "Creating LaTeX image %s"))
2668 ((member latex-frag-opt '(mathjax t))
2669 (setq latex-frag-opt 'mathml)
2670 (setq cache-dir "ltxmathml/")
2671 (setq display-msg "Creating MathML formula %s")))
2672 (when (and org-current-export-file)
2673 (org-format-latex
2674 (concat cache-dir (file-name-sans-extension
2675 (file-name-nondirectory org-current-export-file)))
2676 org-current-export-dir nil display-msg
2677 nil nil latex-frag-opt))))
2678
2679(defadvice org-format-latex-as-mathml
2680 (after org-odt-protect-latex-fragment activate)
2681 "Encode LaTeX fragment as XML.
2682Do this when translation to MathML fails."
2683 (when (or (not (> (length ad-return-value) 0))
2684 (get-text-property 0 'org-protected ad-return-value))
2685 (setq ad-return-value
2686 (org-propertize (org-odt-encode-plain-text (ad-get-arg 0))
2687 'org-protected t))))
2688
2689(defun org-export-odt-preprocess-latex-fragments ()
2690 (when (equal org-export-current-backend 'odt)
2691 (org-export-odt-do-preprocess-latex-fragments)))
2692
2693(defun org-export-odt-preprocess-label-references ()
2694 (goto-char (point-min))
2695 (let (label label-components category value pretty-label)
2696 (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
2697 (org-if-unprotected-at (match-beginning 1)
2698 (replace-match
2699 (let ((org-lparse-encode-pending t)
2700 (label (match-string 1)))
2701 ;; markup generated below is mostly an eye-candy. At
2702 ;; pre-processing stage, there is no information on which
2703 ;; entity a label reference points to. The actual markup
2704 ;; is generated as part of `org-odt-fixup-label-references'
2705 ;; which gets called at the fag end of export. By this
2706 ;; time we would have seen and collected all the label
2707 ;; definitions in `org-odt-entity-labels-alist'.
2708 (org-odt-format-tags
2709 '("<text:sequence-ref text:ref-name=\"%s\">" .
2710 "</text:sequence-ref>")
2711 "" (org-add-props label '(org-protected t)))) t t)))))
2712
2713;; process latex fragments as part of
2714;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
2715;; is the one that is closest and well before the call to
2716;; `org-export-attach-captions-and-attributes' in
2717;; `org-export-preprocess-string'. The above arrangement permits
2718;; captions, labels and attributes to be attached to png images
2719;; generated out of latex equations.
2720(add-hook 'org-export-preprocess-after-blockquote-hook
2721 'org-export-odt-preprocess-latex-fragments)
2722
2723(defun org-export-odt-preprocess (parameters)
2724 (org-export-odt-preprocess-label-references))
2725
2726(declare-function archive-zip-extract "arc-mode" (archive name))
2727(defun org-odt-zip-extract-one (archive member &optional target)
2728 (require 'arc-mode)
2729 (let* ((target (or target default-directory))
2730 (archive (expand-file-name archive))
2731 (archive-zip-extract
2732 (list "unzip" "-qq" "-o" "-d" target))
2733 exit-code command-output)
2734 (setq command-output
2735 (with-temp-buffer
2736 (setq exit-code (archive-zip-extract archive member))
2737 (buffer-string)))
2738 (unless (zerop exit-code)
2739 (message command-output)
2740 (error "Extraction failed"))))
2741
2742(defun org-odt-zip-extract (archive members &optional target)
2743 (when (atom members) (setq members (list members)))
2744 (mapc (lambda (member)
2745 (org-odt-zip-extract-one archive member target))
2746 members))
2747
2748(defun org-odt-copy-styles-file (&optional styles-file)
2749 ;; Non-availability of styles.xml is not a critical error. For now
2750 ;; throw an error purely for aesthetic reasons.
2751 (setq styles-file (or styles-file
2752 org-export-odt-styles-file
2753 (expand-file-name "OrgOdtStyles.xml"
2754 org-odt-styles-dir)
2755 (error "org-odt: Missing styles file?")))
2756 (cond
2757 ((listp styles-file)
2758 (let ((archive (nth 0 styles-file))
2759 (members (nth 1 styles-file)))
2760 (org-odt-zip-extract archive members)
2761 (mapc
2762 (lambda (member)
2763 (when (org-file-image-p member)
2764 (let* ((image-type (file-name-extension member))
2765 (media-type (format "image/%s" image-type)))
2766 (org-odt-create-manifest-file-entry media-type member))))
2767 members)))
2768 ((and (stringp styles-file) (file-exists-p styles-file))
2769 (let ((styles-file-type (file-name-extension styles-file)))
2770 (cond
2771 ((string= styles-file-type "xml")
2772 (copy-file styles-file "styles.xml" t))
2773 ((member styles-file-type '("odt" "ott"))
2774 (org-odt-zip-extract styles-file "styles.xml")))))
2775 (t
2776 (error (format "Invalid specification of styles.xml file: %S"
2777 org-export-odt-styles-file))))
2778
2779 ;; create a manifest entry for styles.xml
2780 (org-odt-create-manifest-file-entry "text/xml" "styles.xml"))
2781
2782(defun org-odt-configure-outline-numbering (level)
2783 "Outline numbering is retained only upto LEVEL.
2784To disable outline numbering pass a LEVEL of 0."
2785 (goto-char (point-min))
2786 (let ((regex
2787 "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
2788 (replacement
2789 "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
2790 (while (re-search-forward regex nil t)
2791 (when (> (string-to-number (match-string 2)) level)
2792 (replace-match replacement t nil))))
2793 (save-buffer 0))
2794
2795;;;###autoload
2796(defun org-export-as-odf (latex-frag &optional odf-file)
2797 "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
2798Use `org-create-math-formula' to convert LATEX-FRAG first to
2799MathML. When invoked as an interactive command, use
2800`org-latex-regexps' to infer LATEX-FRAG from currently active
2801region. If no LaTeX fragments are found, prompt for it. Push
2802MathML source to kill ring, if `org-export-copy-to-kill-ring' is
2803non-nil."
2804 (interactive
2805 `(,(let (frag)
2806 (setq frag (and (setq frag (and (org-region-active-p)
2807 (buffer-substring (region-beginning)
2808 (region-end))))
2809 (loop for e in org-latex-regexps
2810 thereis (when (string-match (nth 1 e) frag)
2811 (match-string (nth 2 e) frag)))))
2812 (read-string "LaTeX Fragment: " frag nil frag))
2813 ,(let ((odf-filename (expand-file-name
2814 (concat
2815 (file-name-sans-extension
2816 (or (file-name-nondirectory buffer-file-name)))
2817 "." "odf")
2818 (file-name-directory buffer-file-name))))
2819 (read-file-name "ODF filename: " nil odf-filename nil
2820 (file-name-nondirectory odf-filename)))))
2821 (org-odt-cleanup-xml-buffers
2822 (let* ((org-lparse-backend 'odf)
2823 org-lparse-opt-plist
2824 (filename (or odf-file
2825 (expand-file-name
2826 (concat
2827 (file-name-sans-extension
2828 (or (file-name-nondirectory buffer-file-name)))
2829 "." "odf")
2830 (file-name-directory buffer-file-name))))
2831 (buffer (find-file-noselect (org-odt-init-outfile filename)))
2832 (coding-system-for-write 'utf-8)
2833 (save-buffer-coding-system 'utf-8))
2834 (set-buffer buffer)
2835 (set-buffer-file-coding-system coding-system-for-write)
2836 (let ((mathml (org-create-math-formula latex-frag)))
2837 (unless mathml (error "No Math formula created"))
2838 (insert mathml)
2839 (or (org-export-push-to-kill-ring
2840 (upcase (symbol-name org-lparse-backend)))
2841 (message "Exporting... done")))
2842 (org-odt-save-as-outfile filename nil))))
2843
2844;;;###autoload
2845(defun org-export-as-odf-and-open ()
2846 "Export LaTeX fragment as OpenDocument formula and immediately open it.
2847Use `org-export-as-odf' to read LaTeX fragment and OpenDocument
2848formula file."
2849 (interactive)
2850 (org-lparse-and-open
2851 nil nil nil (call-interactively 'org-export-as-odf)))
2852
2853(provide 'org-odt)
2854
2855;; Local variables:
2856;; generated-autoload-file: "org-loaddefs.el"
2857;; End:
2858
2859;;; org-odt.el ends here
diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el
deleted file mode 100644
index 20c6a6860aa..00000000000
--- a/lisp/org/org-publish.el
+++ /dev/null
@@ -1,1198 +0,0 @@
1;;; org-publish.el --- publish related org-mode files as a website
2;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
3
4;; Author: David O'Toole <dto@gnu.org>
5;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
6;; Keywords: hypermedia, outlines, wp
7
8;; This file is part of GNU Emacs.
9;;
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; This program allow configurable publishing of related sets of
26;; Org-mode files as a complete website.
27;;
28;; org-publish.el can do the following:
29;;
30;; + Publish all one's org-files to HTML or PDF
31;; + Upload HTML, images, attachments and other files to a web server
32;; + Exclude selected private pages from publishing
33;; + Publish a clickable sitemap of pages
34;; + Manage local timestamps for publishing only changed files
35;; + Accept plugin functions to extend range of publishable content
36;;
37;; Documentation for publishing is in the manual.
38
39;;; Code:
40
41
42(eval-when-compile
43 (require 'cl))
44(require 'org)
45(require 'org-exp)
46(require 'format-spec)
47
48(eval-and-compile
49 (unless (fboundp 'declare-function)
50 (defmacro declare-function (fn file &optional arglist fileonly))))
51
52(defvar org-publish-initial-buffer nil
53 "The buffer `org-publish' has been called from.")
54
55(defvar org-publish-temp-files nil
56 "Temporary list of files to be published.")
57
58;; Here, so you find the variable right before it's used the first time:
59(defvar org-publish-cache nil
60 "This will cache timestamps and titles for files in publishing projects.
61Blocks could hash sha1 values here.")
62
63(defgroup org-publish nil
64 "Options for publishing a set of Org-mode and related files."
65 :tag "Org Publishing"
66 :group 'org)
67
68(defcustom org-publish-project-alist nil
69 "Association list to control publishing behavior.
70Each element of the alist is a publishing 'project.' The CAR of
71each element is a string, uniquely identifying the project. The
72CDR of each element is in one of the following forms:
73
741. A well-formed property list with an even number of elements, alternating
75 keys and values, specifying parameters for the publishing process.
76
77 (:property value :property value ... )
78
792. A meta-project definition, specifying of a list of sub-projects:
80
81 (:components (\"project-1\" \"project-2\" ...))
82
83When the CDR of an element of org-publish-project-alist is in
84this second form, the elements of the list after :components are
85taken to be components of the project, which group together files
86requiring different publishing options. When you publish such a
87project with \\[org-publish], the components all publish.
88
89When a property is given a value in org-publish-project-alist, its
90setting overrides the value of the corresponding user variable
91\(if any) during publishing. However, options set within a file
92override everything.
93
94Most properties are optional, but some should always be set:
95
96 :base-directory Directory containing publishing source files
97 :base-extension Extension (without the dot!) of source files.
98 This can be a regular expression. If not given,
99 \"org\" will be used as default extension.
100 :publishing-directory Directory (possibly remote) where output
101 files will be published
102
103The :exclude property may be used to prevent certain files from
104being published. Its value may be a string or regexp matching
105file names you don't want to be published.
106
107The :include property may be used to include extra files. Its
108value may be a list of filenames to include. The filenames are
109considered relative to the base directory.
110
111When both :include and :exclude properties are given values, the
112exclusion step happens first.
113
114One special property controls which back-end function to use for
115publishing files in the project. This can be used to extend the
116set of file types publishable by org-publish, as well as the set
117of output formats.
118
119 :publishing-function Function to publish file. The default is
120 `org-publish-org-to-html', but other
121 values are possible. May also be a
122 list of functions, in which case
123 each function in the list is invoked
124 in turn.
125
126Another property allows you to insert code that prepares a
127project for publishing. For example, you could call GNU Make on a
128certain makefile, to ensure published files are built up to date.
129
130 :preparation-function Function to be called before publishing
131 this project. This may also be a list
132 of functions.
133 :completion-function Function to be called after publishing
134 this project. This may also be a list
135 of functions.
136
137Some properties control details of the Org publishing process,
138and are equivalent to the corresponding user variables listed in
139the right column. See the documentation for those variables to
140learn more about their use and default values.
141
142 :language `org-export-default-language'
143 :headline-levels `org-export-headline-levels'
144 :section-numbers `org-export-with-section-numbers'
145 :table-of-contents `org-export-with-toc'
146 :emphasize `org-export-with-emphasize'
147 :sub-superscript `org-export-with-sub-superscripts'
148 :TeX-macros `org-export-with-TeX-macros'
149 :fixed-width `org-export-with-fixed-width'
150 :tables `org-export-with-tables'
151 :table-auto-headline `org-export-highlight-first-table-line'
152 :style `org-export-html-style'
153 :convert-org-links `org-export-html-link-org-files-as-html'
154 :inline-images `org-export-html-inline-images'
155 :expand-quoted-html `org-export-html-expand'
156 :timestamp `org-export-html-with-timestamp'
157 :publishing-directory `org-export-publishing-directory'
158 :html-preamble `org-export-html-preamble'
159 :html-postamble `org-export-html-postamble'
160 :author `user-full-name'
161 :email `user-mail-address'
162
163The following properties may be used to control publishing of a
164sitemap of files or summary page for a given project.
165
166 :auto-sitemap Whether to publish a sitemap during
167 `org-publish-current-project' or `org-publish-all'.
168 :sitemap-filename Filename for output of sitemap. Defaults
169 to 'sitemap.org' (which becomes 'sitemap.html').
170 :sitemap-title Title of sitemap page. Defaults to name of file.
171 :sitemap-function Plugin function to use for generation of sitemap.
172 Defaults to `org-publish-org-sitemap', which
173 generates a plain list of links to all files
174 in the project.
175 :sitemap-style Can be `list' (sitemap is just an itemized list
176 of the titles of the files involved) or
177 `tree' (the directory structure of the source
178 files is reflected in the sitemap). Defaults to
179 `tree'.
180 :sitemap-sans-extension Remove extension from sitemap's
181 filenames. Useful to have cool
182 URIs (see
183 http://www.w3.org/Provider/Style/URI).
184 Defaults to nil.
185
186 If you create a sitemap file, adjust the sorting like this:
187
188 :sitemap-sort-folders Where folders should appear in the sitemap.
189 Set this to `first' (default) or `last' to
190 display folders first or last, respectively.
191 Any other value will mix files and folders.
192 :sitemap-sort-files The site map is normally sorted alphabetically.
193 You can change this behaviour setting this to
194 `chronologically', `anti-chronologically' or nil.
195 :sitemap-ignore-case Should sorting be case-sensitive? Default nil.
196
197The following properties control the creation of a concept index.
198
199 :makeindex Create a concept index.
200
201Other properties affecting publication.
202
203 :body-only Set this to 't' to publish only the body of the
204 documents, excluding everything outside and
205 including the <body> tags in HTML, or
206 \begin{document}..\end{document} in LaTeX."
207 :group 'org-publish
208 :type 'alist)
209
210(defcustom org-publish-use-timestamps-flag t
211 "Non-nil means use timestamp checking to publish only changed files.
212When nil, do no timestamp checking and always publish all files."
213 :group 'org-publish
214 :type 'boolean)
215
216(defcustom org-publish-timestamp-directory (convert-standard-filename
217 "~/.org-timestamps/")
218 "Name of directory in which to store publishing timestamps."
219 :group 'org-publish
220 :type 'directory)
221
222(defcustom org-publish-list-skipped-files t
223 "Non-nil means show message about files *not* published."
224 :group 'org-publish
225 :type 'boolean)
226
227(defcustom org-publish-before-export-hook nil
228 "Hook run before export on the Org file.
229The hook may modify the file in arbitrary ways before publishing happens.
230The original version of the buffer will be restored after publishing."
231 :group 'org-publish
232 :type 'hook)
233
234(defcustom org-publish-after-export-hook nil
235 "Hook run after export on the exported buffer.
236Any changes made by this hook will be saved."
237 :group 'org-publish
238 :type 'hook)
239
240(defcustom org-publish-sitemap-sort-files 'alphabetically
241 "How sitemaps files should be sorted by default?
242Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil.
243If `alphabetically', files will be sorted alphabetically.
244If `chronologically', files will be sorted with older modification time first.
245If `anti-chronologically', files will be sorted with newer modification time first.
246nil won't sort files.
247
248You can overwrite this default per project in your
249`org-publish-project-alist', using `:sitemap-sort-files'."
250 :group 'org-publish
251 :version "24.1"
252 :type 'symbol)
253
254(defcustom org-publish-sitemap-sort-folders 'first
255 "A symbol, denoting if folders are sorted first in sitemaps.
256Possible values are `first', `last', and nil.
257If `first', folders will be sorted before files.
258If `last', folders are sorted to the end after the files.
259Any other value will not mix files and folders.
260
261You can overwrite this default per project in your
262`org-publish-project-alist', using `:sitemap-sort-folders'."
263 :group 'org-publish
264 :version "24.1"
265 :type 'symbol)
266
267(defcustom org-publish-sitemap-sort-ignore-case nil
268 "Sort sitemaps case insensitively by default?
269
270You can overwrite this default per project in your
271`org-publish-project-alist', using `:sitemap-ignore-case'."
272 :group 'org-publish
273 :version "24.1"
274 :type 'boolean)
275
276(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
277 "Format for `format-time-string' which is used to print a date
278in the sitemap."
279 :group 'org-publish
280 :version "24.1"
281 :type 'string)
282
283(defcustom org-publish-sitemap-file-entry-format "%t"
284 "How a sitemap file entry is formatted.
285You could use brackets to delimit on what part the link will be.
286
287%t is the title.
288%a is the author.
289%d is the date formatted using `org-publish-sitemap-date-format'."
290 :group 'org-publish
291 :version "24.1"
292 :type 'string)
293
294
295;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
296;;; Sanitize-plist (FIXME why?)
297
298(defun org-publish-sanitize-plist (plist)
299 ;; FIXME document
300 (mapcar (lambda (x)
301 (or (cdr (assq x '((:index-filename . :sitemap-filename)
302 (:index-title . :sitemap-title)
303 (:index-function . :sitemap-function)
304 (:index-style . :sitemap-style)
305 (:auto-index . :auto-sitemap))))
306 x))
307 plist))
308
309;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
310;;; Timestamp-related functions
311
312(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
313 "Return path to timestamp file for filename FILENAME."
314 (setq filename (concat filename "::" (or pub-dir "") "::"
315 (format "%s" (or pub-func ""))))
316 (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
317
318(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
319 "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
320TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
321this - maybe it can eventually be used to check if the file is present at
322the target location, and how old it is. Right now we cannot do this, because
323we do not know under what file name the file will be stored - the publishing
324function can still decide about that independently."
325 (let ((rtn
326 (if org-publish-use-timestamps-flag
327 (org-publish-cache-file-needs-publishing
328 filename pub-dir pub-func base-dir)
329 ;; don't use timestamps, always return t
330 t)))
331 (if rtn
332 (message "Publishing file %s using `%s'" filename pub-func)
333 (when org-publish-list-skipped-files
334 (message "Skipping unmodified file %s" filename)))
335 rtn))
336
337(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir)
338 "Update publishing timestamp for file FILENAME.
339If there is no timestamp, create one."
340 (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
341 (stamp (org-publish-cache-ctime-of-src filename)))
342 (org-publish-cache-set key stamp)))
343
344(defun org-publish-remove-all-timestamps ()
345 "Remove all files in the timestamp directory."
346 (let ((dir org-publish-timestamp-directory)
347 files)
348 (when (and (file-exists-p dir)
349 (file-directory-p dir))
350 (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
351 (org-publish-reset-cache))))
352
353
354;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
355;;; Compatibility aliases
356
357;; Delete-dups is not in Emacs <22
358(if (fboundp 'delete-dups)
359 (defalias 'org-publish-delete-dups 'delete-dups)
360 (defun org-publish-delete-dups (list)
361 "Destructively remove `equal' duplicates from LIST.
362Store the result in LIST and return it. LIST must be a proper list.
363Of several `equal' occurrences of an element in LIST, the first
364one is kept.
365
366This is a compatibility function for Emacsen without `delete-dups'."
367 ;; Code from `subr.el' in Emacs 22:
368 (let ((tail list))
369 (while tail
370 (setcdr tail (delete (car tail) (cdr tail)))
371 (setq tail (cdr tail))))
372 list))
373
374(declare-function org-publish-delete-dups "org-publish" (list))
375(declare-function find-lisp-find-files "find-lisp" (directory regexp))
376(declare-function org-pop-to-buffer-same-window
377 "org-compat" (&optional buffer-or-name norecord label))
378
379;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
380;;; Getting project information out of org-publish-project-alist
381
382(defun org-publish-expand-projects (projects-alist)
383 "Expand projects in PROJECTS-ALIST.
384This splices all the components into the list."
385 (let ((rest projects-alist) rtn p components)
386 (while (setq p (pop rest))
387 (if (setq components (plist-get (cdr p) :components))
388 (setq rest (append
389 (mapcar (lambda (x) (assoc x org-publish-project-alist))
390 components)
391 rest))
392 (push p rtn)))
393 (nreverse (org-publish-delete-dups (delq nil rtn)))))
394
395(defvar org-sitemap-sort-files)
396(defvar org-sitemap-sort-folders)
397(defvar org-sitemap-ignore-case)
398(defvar org-sitemap-requested)
399(defvar org-sitemap-date-format)
400(defvar org-sitemap-file-entry-format)
401(defun org-publish-compare-directory-files (a b)
402 "Predicate for `sort', that sorts folders and files for sitemap."
403 (let ((retval t))
404 (when (or org-sitemap-sort-files org-sitemap-sort-folders)
405 ;; First we sort files:
406 (when org-sitemap-sort-files
407 (cond ((equal org-sitemap-sort-files 'alphabetically)
408 (let* ((adir (file-directory-p a))
409 (aorg (and (string-match "\\.org$" a) (not adir)))
410 (bdir (file-directory-p b))
411 (borg (and (string-match "\\.org$" b) (not bdir)))
412 (A (if aorg
413 (concat (file-name-directory a)
414 (org-publish-find-title a)) a))
415 (B (if borg
416 (concat (file-name-directory b)
417 (org-publish-find-title b)) b)))
418 (setq retval (if org-sitemap-ignore-case
419 (not (string-lessp (upcase B) (upcase A)))
420 (not (string-lessp B A))))))
421 ((or (equal org-sitemap-sort-files 'chronologically)
422 (equal org-sitemap-sort-files 'anti-chronologically))
423 (let* ((adate (org-publish-find-date a))
424 (bdate (org-publish-find-date b))
425 (A (+ (lsh (car adate) 16) (cadr adate)))
426 (B (+ (lsh (car bdate) 16) (cadr bdate))))
427 (setq retval (if (equal org-sitemap-sort-files 'chronologically)
428 (<= A B)
429 (>= A B)))))))
430 ;; Directory-wise wins:
431 (when org-sitemap-sort-folders
432 ;; a is directory, b not:
433 (cond
434 ((and (file-directory-p a) (not (file-directory-p b)))
435 (setq retval (equal org-sitemap-sort-folders 'first)))
436 ;; a is not a directory, but b is:
437 ((and (not (file-directory-p a)) (file-directory-p b))
438 (setq retval (equal org-sitemap-sort-folders 'last))))))
439 retval))
440
441(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
442 "Set `org-publish-temp-files' with files from BASE-DIR directory.
443If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
444non-nil, restrict this list to the files matching the regexp
445MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
446SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
447matching the regexp SKIP-DIR when recursing through BASE-DIR."
448 (mapc (lambda (f)
449 (let ((fd-p (file-directory-p f))
450 (fnd (file-name-nondirectory f)))
451 (if (and fd-p recurse
452 (not (string-match "^\\.+$" fnd))
453 (if skip-dir (not (string-match skip-dir fnd)) t))
454 (org-publish-get-base-files-1 f recurse match skip-file skip-dir)
455 (unless (or fd-p ;; this is a directory
456 (and skip-file (string-match skip-file fnd))
457 (not (file-exists-p (file-truename f)))
458 (not (string-match match fnd)))
459
460 (pushnew f org-publish-temp-files)))))
461 (if org-sitemap-requested
462 (sort (directory-files base-dir t (unless recurse match))
463 'org-publish-compare-directory-files)
464 (directory-files base-dir t (unless recurse match)))))
465
466(defun org-publish-get-base-files (project &optional exclude-regexp)
467 "Return a list of all files in PROJECT.
468If EXCLUDE-REGEXP is set, this will be used to filter out
469matching filenames."
470 (let* ((project-plist (cdr project))
471 (base-dir (file-name-as-directory
472 (plist-get project-plist :base-directory)))
473 (include-list (plist-get project-plist :include))
474 (recurse (plist-get project-plist :recursive))
475 (extension (or (plist-get project-plist :base-extension) "org"))
476 ;; sitemap-... variables are dynamically scoped for
477 ;; org-publish-compare-directory-files:
478 (org-sitemap-requested
479 (plist-get project-plist :auto-sitemap))
480 (sitemap-filename
481 (or (plist-get project-plist :sitemap-filename)
482 "sitemap.org"))
483 (org-sitemap-sort-folders
484 (if (plist-member project-plist :sitemap-sort-folders)
485 (plist-get project-plist :sitemap-sort-folders)
486 org-publish-sitemap-sort-folders))
487 (org-sitemap-sort-files
488 (cond ((plist-member project-plist :sitemap-sort-files)
489 (plist-get project-plist :sitemap-sort-files))
490 ;; For backward compatibility:
491 ((plist-member project-plist :sitemap-alphabetically)
492 (if (plist-get project-plist :sitemap-alphabetically)
493 'alphabetically nil))
494 (t org-publish-sitemap-sort-files)))
495 (org-sitemap-ignore-case
496 (if (plist-member project-plist :sitemap-ignore-case)
497 (plist-get project-plist :sitemap-ignore-case)
498 org-publish-sitemap-sort-ignore-case))
499 (match (if (eq extension 'any)
500 "^[^\\.]"
501 (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
502 ;; Make sure `org-sitemap-sort-folders' has an accepted value
503 (unless (memq org-sitemap-sort-folders '(first last))
504 (setq org-sitemap-sort-folders nil))
505
506 (setq org-publish-temp-files nil)
507 (if org-sitemap-requested
508 (pushnew (expand-file-name (concat base-dir sitemap-filename))
509 org-publish-temp-files))
510 (org-publish-get-base-files-1 base-dir recurse match
511 ;; FIXME distinguish exclude regexp
512 ;; for skip-file and skip-dir?
513 exclude-regexp exclude-regexp)
514 (mapc (lambda (f)
515 (pushnew
516 (expand-file-name (concat base-dir f))
517 org-publish-temp-files))
518 include-list)
519 org-publish-temp-files))
520
521(defun org-publish-get-project-from-filename (filename &optional up)
522 "Return the project that FILENAME belongs to."
523 (let* ((filename (expand-file-name filename))
524 project-name)
525
526 (catch 'p-found
527 (dolist (prj org-publish-project-alist)
528 (unless (plist-get (cdr prj) :components)
529 ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
530 (let* ((r (plist-get (cdr prj) :recursive))
531 (b (expand-file-name (file-name-as-directory
532 (plist-get (cdr prj) :base-directory))))
533 (x (or (plist-get (cdr prj) :base-extension) "org"))
534 (e (plist-get (cdr prj) :exclude))
535 (i (plist-get (cdr prj) :include))
536 (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
537 (when
538 (or
539 (and
540 i (member filename
541 (mapcar
542 (lambda (file) (expand-file-name file b))
543 i)))
544 (and
545 (not (and e (string-match e filename)))
546 (string-match xm filename)))
547 (setq project-name (car prj))
548 (throw 'p-found project-name))))))
549 (when up
550 (dolist (prj org-publish-project-alist)
551 (if (member project-name (plist-get (cdr prj) :components))
552 (setq project-name (car prj)))))
553 (assoc project-name org-publish-project-alist)))
554
555;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
556;;; Pluggable publishing back-end functions
557
558(defun org-publish-org-to (format plist filename pub-dir)
559 "Publish an org file to FORMAT.
560PLIST is the property list for the given project.
561FILENAME is the filename of the org file to be published.
562PUB-DIR is the publishing directory."
563 (require 'org)
564 (unless (file-exists-p pub-dir)
565 (make-directory pub-dir t))
566 (let ((visiting (find-buffer-visiting filename)))
567 (save-excursion
568 (org-pop-to-buffer-same-window (or visiting (find-file filename)))
569 (let* ((plist (cons :buffer-will-be-killed (cons t plist)))
570 (init-buf (current-buffer))
571 (init-point (point))
572 (init-buf-string (buffer-string))
573 export-buf-or-file)
574 ;; run hooks before exporting
575 (run-hooks 'org-publish-before-export-hook)
576 ;; export the possibly modified buffer
577 (setq export-buf-or-file
578 (funcall (intern (concat "org-export-as-" format))
579 (plist-get plist :headline-levels)
580 plist nil
581 (plist-get plist :body-only)
582 pub-dir))
583 (when (and (bufferp export-buf-or-file)
584 (buffer-live-p export-buf-or-file))
585 (set-buffer export-buf-or-file)
586 ;; run hooks after export and save export
587 (progn (run-hooks 'org-publish-after-export-hook)
588 (if (buffer-modified-p) (save-buffer)))
589 (kill-buffer export-buf-or-file))
590 ;; maybe restore buffer's content
591 (set-buffer init-buf)
592 (when (buffer-modified-p init-buf)
593 (erase-buffer)
594 (insert init-buf-string)
595 (save-buffer)
596 (goto-char init-point))
597 (unless visiting
598 (kill-buffer init-buf))))))
599
600(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
601 "Execute BODY with a modified hook to preprocess for index."
602 `(let ((org-export-preprocess-after-headline-targets-hook
603 (if (plist-get project-plist :makeindex)
604 (cons 'org-publish-aux-preprocess
605 org-export-preprocess-after-headline-targets-hook)
606 org-export-preprocess-after-headline-targets-hook)))
607 ,@body))
608(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
609
610(defvar project-plist)
611(defun org-publish-org-to-latex (plist filename pub-dir)
612 "Publish an org file to LaTeX.
613See `org-publish-org-to' to the list of arguments."
614 (org-publish-with-aux-preprocess-maybe
615 (org-publish-org-to "latex" plist filename pub-dir)))
616
617(defun org-publish-org-to-pdf (plist filename pub-dir)
618 "Publish an org file to PDF (via LaTeX).
619See `org-publish-org-to' to the list of arguments."
620 (org-publish-with-aux-preprocess-maybe
621 (org-publish-org-to "pdf" plist filename pub-dir)))
622
623(defun org-publish-org-to-html (plist filename pub-dir)
624 "Publish an org file to HTML.
625See `org-publish-org-to' to the list of arguments."
626 (org-publish-with-aux-preprocess-maybe
627 (org-publish-org-to "html" plist filename pub-dir)))
628
629(defun org-publish-org-to-org (plist filename pub-dir)
630 "Publish an org file to HTML.
631See `org-publish-org-to' to the list of arguments."
632 (org-publish-org-to "org" plist filename pub-dir))
633
634(defun org-publish-org-to-ascii (plist filename pub-dir)
635 "Publish an org file to ASCII.
636See `org-publish-org-to' to the list of arguments."
637 (org-publish-with-aux-preprocess-maybe
638 (org-publish-org-to "ascii" plist filename pub-dir)))
639
640(defun org-publish-org-to-latin1 (plist filename pub-dir)
641 "Publish an org file to Latin-1.
642See `org-publish-org-to' to the list of arguments."
643 (org-publish-with-aux-preprocess-maybe
644 (org-publish-org-to "latin1" plist filename pub-dir)))
645
646(defun org-publish-org-to-utf8 (plist filename pub-dir)
647 "Publish an org file to UTF-8.
648See `org-publish-org-to' to the list of arguments."
649 (org-publish-with-aux-preprocess-maybe
650 (org-publish-org-to "utf8" plist filename pub-dir)))
651
652(defun org-publish-attachment (plist filename pub-dir)
653 "Publish a file with no transformation of any kind.
654See `org-publish-org-to' to the list of arguments."
655 ;; make sure eshell/cp code is loaded
656 (unless (file-directory-p pub-dir)
657 (make-directory pub-dir t))
658 (or (equal (expand-file-name (file-name-directory filename))
659 (file-name-as-directory (expand-file-name pub-dir)))
660 (copy-file filename
661 (expand-file-name (file-name-nondirectory filename) pub-dir)
662 t)))
663
664;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
665;;; Publishing files, sets of files, and indices
666
667(defun org-publish-file (filename &optional project no-cache)
668 "Publish file FILENAME from PROJECT.
669If NO-CACHE is not nil, do not initialize org-publish-cache and
670write it to disk. This is needed, since this function is used to
671publish single files, when entire projects are published.
672See `org-publish-projects'."
673 (let* ((project
674 (or project
675 (or (org-publish-get-project-from-filename filename)
676 (error "File %s not part of any known project"
677 (abbreviate-file-name filename)))))
678 (project-plist (cdr project))
679 (ftname (expand-file-name filename))
680 (publishing-function
681 (or (plist-get project-plist :publishing-function)
682 'org-publish-org-to-html))
683 (base-dir
684 (file-name-as-directory
685 (expand-file-name
686 (or (plist-get project-plist :base-directory)
687 (error "Project %s does not have :base-directory defined"
688 (car project))))))
689 (pub-dir
690 (file-name-as-directory
691 (file-truename
692 (or (eval (plist-get project-plist :publishing-directory))
693 (error "Project %s does not have :publishing-directory defined"
694 (car project))))))
695 tmp-pub-dir)
696
697 (unless no-cache
698 (org-publish-initialize-cache (car project)))
699
700 (setq tmp-pub-dir
701 (file-name-directory
702 (concat pub-dir
703 (and (string-match (regexp-quote base-dir) ftname)
704 (substring ftname (match-end 0))))))
705 (if (listp publishing-function)
706 ;; allow chain of publishing functions
707 (mapc (lambda (f)
708 (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
709 (funcall f project-plist filename tmp-pub-dir)
710 (org-publish-update-timestamp filename pub-dir f base-dir)))
711 publishing-function)
712 (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir)
713 (funcall publishing-function project-plist filename tmp-pub-dir)
714 (org-publish-update-timestamp
715 filename pub-dir publishing-function base-dir)))
716 (unless no-cache (org-publish-write-cache-file))))
717
718(defun org-publish-projects (projects)
719 "Publish all files belonging to the PROJECTS alist.
720If :auto-sitemap is set, publish the sitemap too.
721If :makeindex is set, also produce a file theindex.org."
722 (mapc
723 (lambda (project)
724 ;; Each project uses its own cache file:
725 (org-publish-initialize-cache (car project))
726 (let*
727 ((project-plist (cdr project))
728 (exclude-regexp (plist-get project-plist :exclude))
729 (sitemap-p (plist-get project-plist :auto-sitemap))
730 (sitemap-filename (or (plist-get project-plist :sitemap-filename)
731 "sitemap.org"))
732 (sitemap-function (or (plist-get project-plist :sitemap-function)
733 'org-publish-org-sitemap))
734 (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
735 org-publish-sitemap-date-format))
736 (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
737 org-publish-sitemap-file-entry-format))
738 (preparation-function (plist-get project-plist :preparation-function))
739 (completion-function (plist-get project-plist :completion-function))
740 (files (org-publish-get-base-files project exclude-regexp)) file)
741 (when preparation-function (run-hooks 'preparation-function))
742 (if sitemap-p (funcall sitemap-function project sitemap-filename))
743 (while (setq file (pop files))
744 (org-publish-file file project t))
745 (when (plist-get project-plist :makeindex)
746 (org-publish-index-generate-theindex
747 (plist-get project-plist :base-directory))
748 (org-publish-file (expand-file-name
749 "theindex.org"
750 (plist-get project-plist :base-directory))
751 project t))
752 (when completion-function (run-hooks 'completion-function))
753 (org-publish-write-cache-file)))
754 (org-publish-expand-projects projects)))
755
756(defun org-publish-org-sitemap (project &optional sitemap-filename)
757 "Create a sitemap of pages in set defined by PROJECT.
758Optionally set the filename of the sitemap with SITEMAP-FILENAME.
759Default for SITEMAP-FILENAME is 'sitemap.org'."
760 (let* ((project-plist (cdr project))
761 (dir (file-name-as-directory
762 (plist-get project-plist :base-directory)))
763 (localdir (file-name-directory dir))
764 (indent-str (make-string 2 ?\ ))
765 (exclude-regexp (plist-get project-plist :exclude))
766 (files (nreverse (org-publish-get-base-files project exclude-regexp)))
767 (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
768 (sitemap-title (or (plist-get project-plist :sitemap-title)
769 (concat "Sitemap for project " (car project))))
770 (sitemap-style (or (plist-get project-plist :sitemap-style)
771 'tree))
772 (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
773 (visiting (find-buffer-visiting sitemap-filename))
774 (ifn (file-name-nondirectory sitemap-filename))
775 file sitemap-buffer)
776 (with-current-buffer (setq sitemap-buffer
777 (or visiting (find-file sitemap-filename)))
778 (erase-buffer)
779 (insert (concat "#+TITLE: " sitemap-title "\n\n"))
780 (while (setq file (pop files))
781 (let ((fn (file-name-nondirectory file))
782 (link (file-relative-name file dir))
783 (oldlocal localdir))
784 (when sitemap-sans-extension
785 (setq link (file-name-sans-extension link)))
786 ;; sitemap shouldn't list itself
787 (unless (equal (file-truename sitemap-filename)
788 (file-truename file))
789 (if (eq sitemap-style 'list)
790 (message "Generating list-style sitemap for %s" sitemap-title)
791 (message "Generating tree-style sitemap for %s" sitemap-title)
792 (setq localdir (concat (file-name-as-directory dir)
793 (file-name-directory link)))
794 (unless (string= localdir oldlocal)
795 (if (string= localdir dir)
796 (setq indent-str (make-string 2 ?\ ))
797 (let ((subdirs
798 (split-string
799 (directory-file-name
800 (file-name-directory
801 (file-relative-name localdir dir))) "/"))
802 (subdir "")
803 (old-subdirs (split-string
804 (file-relative-name oldlocal dir) "/")))
805 (setq indent-str (make-string 2 ?\ ))
806 (while (string= (car old-subdirs) (car subdirs))
807 (setq indent-str (concat indent-str (make-string 2 ?\ )))
808 (pop old-subdirs)
809 (pop subdirs))
810 (dolist (d subdirs)
811 (setq subdir (concat subdir d "/"))
812 (insert (concat indent-str " + " d "\n"))
813 (setq indent-str (make-string
814 (+ (length indent-str) 2) ?\ )))))))
815 ;; This is common to 'flat and 'tree
816 (let ((entry
817 (org-publish-format-file-entry org-sitemap-file-entry-format
818 file project-plist))
819 (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
820 (cond ((string-match-p regexp entry)
821 (string-match regexp entry)
822 (insert (concat indent-str " + " (match-string 1 entry)
823 "[[file:" link "]["
824 (match-string 2 entry)
825 "]]" (match-string 3 entry) "\n")))
826 (t
827 (insert (concat indent-str " + [[file:" link "]["
828 entry
829 "]]\n"))))))))
830 (save-buffer))
831 (or visiting (kill-buffer sitemap-buffer))))
832
833(defun org-publish-format-file-entry (fmt file project-plist)
834 (format-spec fmt
835 `((?t . ,(org-publish-find-title file t))
836 (?d . ,(format-time-string org-sitemap-date-format
837 (org-publish-find-date file)))
838 (?a . ,(or (plist-get project-plist :author) user-full-name)))))
839
840(defun org-publish-find-title (file &optional reset)
841 "Find the title of FILE in project."
842 (or
843 (and (not reset) (org-publish-cache-get-file-property file :title nil t))
844 (let* ((visiting (find-buffer-visiting file))
845 (buffer (or visiting (find-file-noselect file)))
846 title)
847 (with-current-buffer buffer
848 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
849 (org-infile-export-plist))))
850 (setq title
851 (or (plist-get opt-plist :title)
852 (and (not
853 (plist-get opt-plist :skip-before-1st-heading))
854 (org-export-grab-title-from-buffer))
855 (file-name-nondirectory (file-name-sans-extension file))))))
856 (unless visiting
857 (kill-buffer buffer))
858 (org-publish-cache-set-file-property file :title title)
859 title)))
860
861(defun org-publish-find-date (file)
862 "Find the date of FILE in project.
863If FILE provides a #+date keyword use it else use the file
864system's modification time.
865
866It returns time in `current-time' format."
867 (let ((visiting (find-buffer-visiting file)))
868 (save-excursion
869 (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
870 (let* ((plist (org-infile-export-plist))
871 (date (plist-get plist :date)))
872 (unless visiting
873 (kill-buffer (current-buffer)))
874 (if date
875 (org-time-string-to-time date)
876 (when (file-exists-p file)
877 (nth 5 (file-attributes file))))))))
878
879;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
880;;; Interactive publishing functions
881
882;;;###autoload
883(defalias 'org-publish-project 'org-publish)
884
885;;;###autoload
886(defun org-publish (project &optional force)
887 "Publish PROJECT."
888 (interactive
889 (list
890 (assoc (org-icompleting-read
891 "Publish project: "
892 org-publish-project-alist nil t)
893 org-publish-project-alist)
894 current-prefix-arg))
895 (setq org-publish-initial-buffer (current-buffer))
896 (save-window-excursion
897 (let* ((org-publish-use-timestamps-flag
898 (if force nil org-publish-use-timestamps-flag)))
899 (org-publish-projects
900 (if (stringp project)
901 ;; If this function is called in batch mode,
902 ;; project is still a string here.
903 (list (assoc project org-publish-project-alist))
904 (list project))))))
905
906;;;###autoload
907(defun org-publish-all (&optional force)
908 "Publish all projects.
909With prefix argument, remove all files in the timestamp
910directory and force publishing all files."
911 (interactive "P")
912 (when force
913 (org-publish-remove-all-timestamps))
914 (save-window-excursion
915 (let ((org-publish-use-timestamps-flag
916 (if force nil org-publish-use-timestamps-flag)))
917 (org-publish-projects org-publish-project-alist))))
918
919;;;###autoload
920(defun org-publish-current-file (&optional force)
921 "Publish the current file.
922With prefix argument, force publish the file."
923 (interactive "P")
924 (save-window-excursion
925 (let ((org-publish-use-timestamps-flag
926 (if force nil org-publish-use-timestamps-flag)))
927 (org-publish-file (buffer-file-name)))))
928
929;;;###autoload
930(defun org-publish-current-project (&optional force)
931 "Publish the project associated with the current file.
932With a prefix argument, force publishing of all files in
933the project."
934 (interactive "P")
935 (save-window-excursion
936 (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
937 (org-publish-use-timestamps-flag
938 (if force nil org-publish-use-timestamps-flag)))
939 (if (not project)
940 (error "File %s is not part of any known project" (buffer-file-name)))
941 ;; FIXME: force is not used here?
942 (org-publish project))))
943
944
945;;; Index generation
946
947(defun org-publish-aux-preprocess ()
948 "Find index entries and write them to an .orgx file."
949 (let ((case-fold-search t)
950 entry index target)
951 (goto-char (point-min))
952 (while
953 (and
954 (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
955 (> (match-end 1) (match-beginning 1)))
956 (setq entry (match-string 1))
957 (when (eq org-export-current-backend 'latex)
958 (replace-match (format "\\index{%s}" entry) t t))
959 (save-excursion
960 (ignore-errors (org-back-to-heading t))
961 (setq target (get-text-property (point) 'target))
962 (setq target (or (cdr (assoc target org-export-preferred-target-alist))
963 (cdr (assoc target org-export-id-target-alist))
964 target ""))
965 (push (cons entry target) index)))
966 (with-temp-file
967 (concat
968 (file-name-directory org-current-export-file) "."
969 (file-name-sans-extension
970 (file-name-nondirectory org-current-export-file)) ".orgx")
971 (dolist (entry (nreverse index))
972 (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
973
974(defun org-publish-index-generate-theindex (directory)
975 "Generate the index from all .orgx files in DIRECTORY."
976 (require 'find-lisp)
977 (let* ((fulldir (file-name-as-directory
978 (expand-file-name directory)))
979 (full-files (find-lisp-find-files directory "\\.orgx\\'"))
980 (re (concat "\\`" fulldir))
981 (files (mapcar (lambda (f) (if (string-match re f)
982 (substring f (match-end 0))
983 f))
984 full-files))
985 (default-directory directory)
986 index origfile buf target entry ibuffer
987 main last-main letter last-letter file sub link tgext)
988 ;; `files' contains the list of relative file names
989 (dolist (file files)
990 (setq origfile
991 (concat (file-name-directory file)
992 (substring (file-name-nondirectory file) 1 -1)))
993 (setq buf (find-file-noselect file))
994 (with-current-buffer buf
995 (goto-char (point-min))
996 (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t)
997 (setq target (match-string 1)
998 entry (match-string 2))
999 (push (list entry origfile target) index)))
1000 (kill-buffer buf))
1001 (setq index (sort index (lambda (a b) (string< (downcase (car a))
1002 (downcase (car b))))))
1003 (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
1004 (with-current-buffer ibuffer
1005 (erase-buffer)
1006 (insert "* Index\n")
1007 (setq last-letter nil)
1008 (dolist (idx index)
1009 (setq entry (car idx) file (nth 1 idx) target (nth 2 idx))
1010 (if (and (stringp target) (string-match "\\S-" target))
1011 (setq tgext (concat "::#" target))
1012 (setq tgext ""))
1013 (setq letter (upcase (substring entry 0 1)))
1014 (when (not (equal letter last-letter))
1015 (insert "** " letter "\n")
1016 (setq last-letter letter))
1017 (if (string-match "!" entry)
1018 (setq main (substring entry 0 (match-beginning 0))
1019 sub (substring entry (match-end 0)))
1020 (setq main nil sub nil last-main nil))
1021 (when (and main (not (equal main last-main)))
1022 (insert " - " main "\n")
1023 (setq last-main main))
1024 (setq link (concat "[[file:" file tgext "]"
1025 "[" (or sub entry) "]]"))
1026 (if (and main sub)
1027 (insert " - " link "\n")
1028 (insert " - " link "\n")))
1029 (save-buffer))
1030 (kill-buffer ibuffer)
1031 ;; Create theindex.org if it doesn't exist already
1032 (let ((index-file (expand-file-name "theindex.org" directory)))
1033 (unless (file-exists-p index-file)
1034 (setq ibuffer (find-file-noselect index-file))
1035 (with-current-buffer ibuffer
1036 (erase-buffer)
1037 (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
1038 (save-buffer))
1039 (kill-buffer ibuffer)))))
1040
1041;; Caching functions:
1042
1043(defun org-publish-write-cache-file (&optional free-cache)
1044 "Write `org-publish-cache' to file.
1045If FREE-CACHE, empty the cache."
1046 (or org-publish-cache
1047 (error "`org-publish-write-cache-file' called, but no cache present"))
1048
1049 (let ((cache-file (org-publish-cache-get ":cache-file:")))
1050 (or cache-file
1051 (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
1052 (with-temp-file cache-file
1053 (let ((print-level nil)
1054 (print-length nil))
1055 (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
1056 (maphash (lambda (k v)
1057 (insert
1058 (format (concat "(puthash %S "
1059 (if (or (listp v) (symbolp v))
1060 "'" "")
1061 "%S org-publish-cache)\n") k v)))
1062 org-publish-cache)))
1063 (when free-cache (org-publish-reset-cache))))
1064
1065(defun org-publish-initialize-cache (project-name)
1066 "Initialize the projects cache if not initialized yet and return it."
1067
1068 (or project-name
1069 (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
1070
1071 (unless (file-exists-p org-publish-timestamp-directory)
1072 (make-directory org-publish-timestamp-directory t))
1073 (if (not (file-directory-p org-publish-timestamp-directory))
1074 (error "Org publish timestamp: %s is not a directory"
1075 org-publish-timestamp-directory))
1076
1077 (unless (and org-publish-cache
1078 (string= (org-publish-cache-get ":project:") project-name))
1079 (let* ((cache-file (concat
1080 (expand-file-name org-publish-timestamp-directory)
1081 project-name
1082 ".cache"))
1083 (cexists (file-exists-p cache-file)))
1084
1085 (when org-publish-cache
1086 (org-publish-reset-cache))
1087
1088 (if cexists
1089 (load-file cache-file)
1090 (setq org-publish-cache
1091 (make-hash-table :test 'equal :weakness nil :size 100))
1092 (org-publish-cache-set ":project:" project-name)
1093 (org-publish-cache-set ":cache-file:" cache-file))
1094 (unless cexists (org-publish-write-cache-file nil))))
1095 org-publish-cache)
1096
1097(defun org-publish-reset-cache ()
1098 "Empty org-publish-cache and reset it nil."
1099 (message "%s" "Resetting org-publish-cache")
1100 (if (hash-table-p org-publish-cache)
1101 (clrhash org-publish-cache))
1102 (setq org-publish-cache nil))
1103
1104(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir)
1105 "Check the timestamp of the last publishing of FILENAME.
1106Return `t', if the file needs publishing. The function also
1107checks if any included files have been more recently published,
1108so that the file including them will be republished as well."
1109 (or org-publish-cache
1110 (error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
1111 (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
1112 (pstamp (org-publish-cache-get key))
1113 (visiting (find-buffer-visiting filename))
1114 (case-fold-search t)
1115 included-files-ctime buf)
1116
1117 (when (equal (file-name-extension filename) "org")
1118 (setq buf (find-file (expand-file-name filename)))
1119 (with-current-buffer buf
1120 (goto-char (point-min))
1121 (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
1122 (let* ((included-file (expand-file-name (match-string 1))))
1123 (add-to-list 'included-files-ctime
1124 (org-publish-cache-ctime-of-src included-file) t))))
1125 ;; FIXME don't kill current buffer
1126 (unless visiting (kill-buffer buf)))
1127 (if (null pstamp)
1128 t
1129 (let ((ctime (org-publish-cache-ctime-of-src filename)))
1130 (or (< pstamp ctime)
1131 (when included-files-ctime
1132 (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
1133 included-files-ctime))))))))))
1134
1135(defun org-publish-cache-set-file-property (filename property value &optional project-name)
1136 "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
1137Use cache file of PROJECT-NAME. If the entry does not exist, it will be
1138created. Return VALUE."
1139 ;; Evtl. load the requested cache file:
1140 (if project-name (org-publish-initialize-cache project-name))
1141 (let ((pl (org-publish-cache-get filename)))
1142 (if pl
1143 (progn
1144 (plist-put pl property value)
1145 value)
1146 (org-publish-cache-get-file-property
1147 filename property value nil project-name))))
1148
1149(defun org-publish-cache-get-file-property
1150 (filename property &optional default no-create project-name)
1151 "Return the value for a PROPERTY of file FILENAME in publishing cache.
1152Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
1153DEFAULT, if the value does not yet exist.
1154If the entry will be created, unless NO-CREATE is not nil."
1155 ;; Evtl. load the requested cache file:
1156 (if project-name (org-publish-initialize-cache project-name))
1157 (let ((pl (org-publish-cache-get filename))
1158 (retval nil))
1159 (if pl
1160 (if (plist-member pl property)
1161 (setq retval (plist-get pl property))
1162 (setq retval default))
1163 ;; no pl yet:
1164 (unless no-create
1165 (org-publish-cache-set filename (list property default)))
1166 (setq retval default))
1167 retval))
1168
1169(defun org-publish-cache-get (key)
1170 "Return the value stored in `org-publish-cache' for key KEY.
1171Returns nil, if no value or nil is found, or the cache does not
1172exist."
1173 (or org-publish-cache
1174 (error "`org-publish-cache-get' called, but no cache present"))
1175 (gethash key org-publish-cache))
1176
1177(defun org-publish-cache-set (key value)
1178 "Store KEY VALUE pair in `org-publish-cache'.
1179Returns value on success, else nil."
1180 (or org-publish-cache
1181 (error "`org-publish-cache-set' called, but no cache present"))
1182 (puthash key value org-publish-cache))
1183
1184(defun org-publish-cache-ctime-of-src (file)
1185 "Get the ctime of filename F as an integer."
1186 (let ((attr (file-attributes
1187 (expand-file-name (or (file-symlink-p file) file)
1188 (file-name-directory file)))))
1189 (+ (lsh (car (nth 5 attr)) 16)
1190 (cadr (nth 5 attr)))))
1191
1192(provide 'org-publish)
1193
1194;; Local variables:
1195;; generated-autoload-file: "org-loaddefs.el"
1196;; End:
1197
1198;;; org-publish.el ends here
diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el
deleted file mode 100644
index cb1fdbbb933..00000000000
--- a/lisp/org/org-remember.el
+++ /dev/null
@@ -1,1156 +0,0 @@
1;;; org-remember.el --- Fast note taking in Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;; This file contains the system to take fast notes with Org-mode.
28;; This system is used together with John Wiegley's `remember.el'.
29
30;;; Code:
31
32(eval-when-compile
33 (require 'cl))
34(require 'org)
35(require 'org-compat)
36(require 'org-datetree)
37
38(declare-function remember-mode "remember" ())
39(declare-function remember "remember" (&optional initial))
40(declare-function remember-buffer-desc "remember" ())
41(declare-function remember-finalize "remember" ())
42(declare-function org-pop-to-buffer-same-window
43 "org-compat" (&optional buffer-or-name norecord label))
44
45(defvar remember-save-after-remembering)
46(defvar remember-register)
47(defvar remember-buffer)
48(defvar remember-handler-functions)
49(defvar remember-annotation-functions)
50(defvar org-clock-heading)
51(defvar org-clock-heading-for-remember)
52
53(defgroup org-remember nil
54 "Options concerning interaction with remember.el."
55 :tag "Org Remember"
56 :group 'org)
57
58(defcustom org-remember-store-without-prompt t
59 "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \
60stores the remember note without further prompts.
61It then uses the file and headline specified by the template or (if the
62template does not specify them) by the variables `org-default-notes-file'
63and `org-remember-default-headline'. To force prompting anyway, use
64\\[universal-argument] \\[org-remember-finalize] to file the note.
65
66When this variable is nil, \\[org-remember-finalize] gives you the prompts, and
67\\[universal-argument] \\[org-remember-finalize] triggers the fast track."
68 :group 'org-remember
69 :type 'boolean)
70
71(defcustom org-remember-interactive-interface 'refile
72 "The interface to be used for interactive filing of remember notes.
73This is only used when the interactive mode for selecting a filing
74location is used (see the variable `org-remember-store-without-prompt').
75Allowed values are:
76outline The interface shows an outline of the relevant file
77 and the correct heading is found by moving through
78 the outline or by searching with incremental search.
79outline-path-completion Headlines in the current buffer are offered via
80 completion.
81refile Use the refile interface, and offer headlines,
82 possibly from different buffers."
83 :group 'org-remember
84 :type '(choice
85 (const :tag "Refile" refile)
86 (const :tag "Outline" outline)
87 (const :tag "Outline-path-completion" outline-path-completion)))
88
89(defcustom org-remember-default-headline ""
90 "The headline that should be the default location in the notes file.
91When filing remember notes, the cursor will start at that position.
92You can set this on a per-template basis with the variable
93`org-remember-templates'."
94 :group 'org-remember
95 :type 'string)
96
97(defcustom org-remember-templates nil
98 "Templates for the creation of remember buffers.
99When nil, just let remember make the buffer.
100When non-nil, this is a list of (up to) 6-element lists. In each entry,
101the first element is the name of the template, which should be a single
102short word. The second element is a character, a unique key to select
103this template. The third element is the template.
104
105The fourth element is optional and can specify a destination file for
106remember items created with this template. The default file is given
107by `org-default-notes-file'. If the file name is not an absolute path,
108it will be interpreted relative to `org-directory'.
109
110An optional fifth element can specify the headline in that file that should
111be offered first when the user is asked to file the entry. The default
112headline is given in the variable `org-remember-default-headline'. When
113this element is `top' or `bottom', the note will be placed as a level-1
114entry at the beginning or end of the file, respectively.
115
116An optional sixth element specifies the contexts in which the template
117will be offered to the user. This element can be a list of major modes
118or a function, and the template will only be offered if `org-remember'
119is called from a mode in the list, or if the function returns t.
120Templates that specify t or nil for the context will always be added
121to the list of selectable templates.
122
123The template specifies the structure of the remember buffer. It should have
124a first line starting with a star, to act as the org-mode headline.
125Furthermore, the following %-escapes will be replaced with content:
126
127 %^{PROMPT} prompt the user for a string and replace this sequence with it.
128 A default value and a completion table can be specified like this:
129 %^{prompt|default|completion2|completion3|...}
130 The arrow keys access a prompt-specific history.
131 %a annotation, normally the link created with `org-store-link'
132 %A like %a, but prompt for the description part
133 %i initial content, copied from the active region. If %i is
134 indented, the entire inserted text will be indented as well.
135 %t time stamp, date only
136 %T time stamp with date and time
137 %u, %U like the above, but inactive time stamps
138 %^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
139 You may define a prompt like %^{Please specify birthday}t
140 %n user name (taken from `user-full-name')
141 %c current kill ring head
142 %x content of the X clipboard
143 %:keyword specific information for certain link types, see below
144 %^C interactive selection of which kill or clip to use
145 %^L like %^C, but insert as link
146 %k title of the currently clocked task
147 %K link to the currently clocked task
148 %^g prompt for tags, completing tags in the target file
149 %^G prompt for tags, completing all tags in all agenda files
150 %^{PROP}p Prompt the user for a value for property PROP
151 %[PATHNAME] insert the contents of the file given by PATHNAME
152 %(SEXP) evaluate elisp `(SEXP)' and replace with the result
153 %! store this note immediately after completing the template\
154 \\<org-remember-mode-map>
155 (skipping the \\[org-remember-finalize] that normally triggers storing)
156 %& jump to target location immediately after storing note
157 %? after completing the template, position cursor here.
158
159Apart from these general escapes, you can access information specific to the
160link type that is created. For example, calling `remember' in emails or gnus
161will record the author and the subject of the message, which you can access
162with %:fromname and %:subject, respectively. Here is a complete list of what
163is recorded for each link type.
164
165Link type | Available information
166-------------------+------------------------------------------------------
167bbdb | %:type %:name %:company
168vm, wl, mh, rmail | %:type %:subject %:message-id
169 | %:from %:fromname %:fromaddress
170 | %:to %:toname %:toaddress
171 | %:fromto (either \"to NAME\" or \"from NAME\")
172gnus | %:group, for messages also all email fields and
173 | %:org-date (the Date: header in Org format)
174w3, w3m | %:type %:url
175info | %:type %:file %:node
176calendar | %:type %:date"
177 :group 'org-remember
178 :get (lambda (var) ; Make sure all entries have at least 5 elements
179 (mapcar (lambda (x)
180 (if (not (stringp (car x))) (setq x (cons "" x)))
181 (cond ((= (length x) 4) (append x '(nil)))
182 ((= (length x) 3) (append x '(nil nil)))
183 (t x)))
184 (default-value var)))
185 :type '(repeat
186 :tag "enabled"
187 (list :value ("" ?a "\n" nil nil nil)
188 (string :tag "Name")
189 (character :tag "Selection Key")
190 (string :tag "Template")
191 (choice :tag "Destination file"
192 (file :tag "Specify")
193 (function :tag "Function")
194 (const :tag "Use `org-default-notes-file'" nil))
195 (choice :tag "Destin. headline"
196 (string :tag "Specify")
197 (function :tag "Function")
198 (const :tag "Use `org-remember-default-headline'" nil)
199 (const :tag "At beginning of file" top)
200 (const :tag "At end of file" bottom)
201 (const :tag "In a date tree" date-tree))
202 (choice :tag "Context"
203 (const :tag "Use in all contexts" nil)
204 (const :tag "Use in all contexts" t)
205 (repeat :tag "Use only if in major mode"
206 (symbol :tag "Major mode"))
207 (function :tag "Perform a check against function")))))
208
209(defcustom org-remember-delete-empty-lines-at-end t
210 "Non-nil means clean up final empty lines in remember buffer."
211 :group 'org-remember
212 :type 'boolean)
213
214(defcustom org-remember-before-finalize-hook nil
215 "Hook that is run right before a remember process is finalized.
216The remember buffer is still current when this hook runs."
217 :group 'org-remember
218 :type 'hook)
219
220(defvar org-remember-mode-map (make-sparse-keymap)
221 "Keymap for `org-remember-mode', a minor mode.
222Use this map to set additional keybindings for when Org-mode is used
223for a Remember buffer.")
224(defvar org-remember-mode-hook nil
225 "Hook for the minor `org-remember-mode'.")
226
227(define-minor-mode org-remember-mode
228 "Minor mode for special key bindings in a remember buffer."
229 nil " Rem" org-remember-mode-map
230 (run-hooks 'org-remember-mode-hook))
231(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize)
232(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill)
233
234(defcustom org-remember-clock-out-on-exit 'query
235 "Non-nil means stop the clock when exiting a clocking remember buffer.
236This only applies if the clock is running in the remember buffer. If the
237clock is not stopped, it continues to run in the storage location.
238Instead of nil or t, this may also be the symbol `query' to prompt the
239user each time a remember buffer with a running clock is filed away."
240 :group 'org-remember
241 :type '(choice
242 (const :tag "Never" nil)
243 (const :tag "Always" t)
244 (const :tag "Query user" query)))
245
246(defcustom org-remember-backup-directory nil
247 "Directory where to store all remember buffers, for backup purposes.
248After a remember buffer has been stored successfully, the backup file
249will be removed. However, if you forget to finish the remember process,
250the file will remain there.
251See also `org-remember-auto-remove-backup-files'."
252 :group 'org-remember
253 :type '(choice
254 (const :tag "No backups" nil)
255 (directory :tag "Directory")))
256
257(defcustom org-remember-auto-remove-backup-files t
258 "Non-nil means remove remember backup files after successfully storage.
259When remember is finished successfully, with storing the note at the
260desired target, remove the backup files related to this remember process
261and show a message about remaining backup files, from previous, unfinished
262remember sessions.
263Backup files will only be made at all, when `org-remember-backup-directory'
264is set."
265 :group 'org-remember
266 :type 'boolean)
267
268(defcustom org-remember-warn-about-backups t
269 "Non-nil means warn about backup files in `org-remember-backup-directory'.
270
271Set this to nil if you find that you don't need the warning.
272
273If you cancel remember calls frequently and know when they
274contain useful information (because you know that you made an
275error or Emacs crashed, for example) nil is more useful. In the
276opposite case, the default, t, is more useful."
277 :group 'org-remember
278 :type 'boolean)
279
280;;;###autoload
281(defun org-remember-insinuate ()
282 "Setup remember.el for use with Org-mode."
283 (org-require-remember)
284 (setq remember-annotation-functions '(org-remember-annotation))
285 (setq remember-handler-functions '(org-remember-handler))
286 (add-hook 'remember-mode-hook 'org-remember-apply-template))
287
288;;;###autoload
289(defun org-remember-annotation ()
290 "Return a link to the current location as an annotation for remember.el.
291If you are using Org-mode files as target for data storage with
292remember.el, then the annotations should include a link compatible with the
293conventions in Org-mode. This function returns such a link."
294 (org-store-link nil))
295
296(defconst org-remember-help
297 "Select a destination location for the note.
298UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
299RET on headline -> Store as sublevel entry to current headline
300RET at beg-of-buf -> Append to file as level 2 headline
301<left>/<right> -> before/after current headline, same headings level")
302
303(defvar org-jump-to-target-location nil)
304(defvar org-remember-previous-location nil)
305(defvar org-remember-reference-date nil)
306(defvar org-force-remember-template-char) ;; dynamically scoped
307
308;; Save the major mode of the buffer we called remember from
309(defvar org-select-template-temp-major-mode nil)
310
311;; Temporary store the buffer where remember was called from
312(defvar org-select-template-original-buffer nil)
313
314(defun org-select-remember-template (&optional use-char)
315 (when org-remember-templates
316 (let* ((pre-selected-templates
317 (mapcar
318 (lambda (tpl)
319 (let ((ctxt (nth 5 tpl))
320 (mode org-select-template-temp-major-mode)
321 (buf org-select-template-original-buffer))
322 (and (or (not ctxt) (eq ctxt t)
323 (and (listp ctxt) (memq mode ctxt))
324 (and (functionp ctxt)
325 (with-current-buffer buf
326 ;; Protect the user-defined function from error
327 (condition-case nil (funcall ctxt) (error nil)))))
328 tpl)))
329 org-remember-templates))
330 ;; If no template at this point, add the default templates:
331 (pre-selected-templates1
332 (if (not (delq nil pre-selected-templates))
333 (mapcar (lambda(x) (if (not (nth 5 x)) x))
334 org-remember-templates)
335 pre-selected-templates))
336 ;; Then unconditionally add template for any contexts
337 (pre-selected-templates2
338 (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x))
339 org-remember-templates)
340 (delq nil pre-selected-templates1)))
341 (templates (mapcar (lambda (x)
342 (if (stringp (car x))
343 (append (list (nth 1 x) (car x)) (cddr x))
344 (append (list (car x) "") (cdr x))))
345 (delq nil pre-selected-templates2)))
346 msg
347 (char (or use-char
348 (cond
349 ((= (length templates) 1)
350 (caar templates))
351 ((and (boundp 'org-force-remember-template-char)
352 org-force-remember-template-char)
353 (if (stringp org-force-remember-template-char)
354 (string-to-char org-force-remember-template-char)
355 org-force-remember-template-char))
356 (t
357 (setq msg (format
358 "Select template: %s%s"
359 (mapconcat
360 (lambda (x)
361 (cond
362 ((not (string-match "\\S-" (nth 1 x)))
363 (format "[%c]" (car x)))
364 ((equal (downcase (car x))
365 (downcase (aref (nth 1 x) 0)))
366 (format "[%c]%s" (car x)
367 (substring (nth 1 x) 1)))
368 (t (format "[%c]%s" (car x) (nth 1 x)))))
369 templates " ")
370 (if (assoc ?C templates)
371 ""
372 " [C]customize templates")))
373 (let ((inhibit-quit t) char0)
374 (while (not char0)
375 (message msg)
376 (setq char0 (read-char-exclusive))
377 (when (and (not (assoc char0 templates))
378 (not (equal char0 ?\C-g))
379 (not (equal char0 ?C)))
380 (message "No such template \"%c\"" char0)
381 (ding) (sit-for 1)
382 (setq char0 nil)))
383 (when (equal char0 ?\C-g)
384 (jump-to-register remember-register)
385 (kill-buffer remember-buffer)
386 (error "Abort"))
387 (when (not (assoc char0 templates))
388 (jump-to-register remember-register)
389 (kill-buffer remember-buffer)
390 (customize-variable 'org-remember-templates)
391 (error "Customize templates"))
392 char0))))))
393 (cddr (assoc char templates)))))
394
395;;;###autoload
396(defun org-remember-apply-template (&optional use-char skip-interactive)
397 "Initialize *remember* buffer with template, invoke `org-mode'.
398This function should be placed into `remember-mode-hook' and in fact requires
399to be run from that hook to function properly."
400 (when (and (boundp 'initial) (stringp initial))
401 (setq initial (org-no-properties initial)))
402 (if org-remember-templates
403 (let* ((entry (org-select-remember-template use-char))
404 (ct (or org-overriding-default-time (org-current-time)))
405 (dct (decode-time ct))
406 (ct1
407 (if (< (nth 2 dct) org-extend-today-until)
408 (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
409 ct))
410 (tpl (car entry))
411 (plist-p (if org-store-link-plist t nil))
412 (file (if (and (nth 1 entry)
413 (or (and (stringp (nth 1 entry))
414 (string-match "\\S-" (nth 1 entry)))
415 (functionp (nth 1 entry))))
416 (nth 1 entry)
417 org-default-notes-file))
418 (headline (nth 2 entry))
419 (v-c (and (> (length kill-ring) 0) (current-kill 0)))
420 (v-x (or (org-get-x-clipboard 'PRIMARY)
421 (org-get-x-clipboard 'CLIPBOARD)
422 (org-get-x-clipboard 'SECONDARY)))
423 (v-t (format-time-string (car org-time-stamp-formats) ct))
424 (v-T (format-time-string (cdr org-time-stamp-formats) ct))
425 (v-u (concat "[" (substring v-t 1 -1) "]"))
426 (v-U (concat "[" (substring v-T 1 -1) "]"))
427 ;; `initial' and `annotation' are bound in `remember'.
428 ;; But if the property list has them, we prefer those values
429 (v-i (or (plist-get org-store-link-plist :initial)
430 (and (boundp 'initial) (symbol-value 'initial))
431 ""))
432 (v-a (or (plist-get org-store-link-plist :annotation)
433 (and (boundp 'annotation) (symbol-value 'annotation))
434 ""))
435 ;; Is the link empty? Then we do not want it...
436 (v-a (if (equal v-a "[[]]") "" v-a))
437 (clipboards (remove nil (list v-i
438 (org-get-x-clipboard 'PRIMARY)
439 (org-get-x-clipboard 'CLIPBOARD)
440 (org-get-x-clipboard 'SECONDARY)
441 v-c)))
442 (v-A (if (and v-a
443 (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
444 (replace-match "[\\1[%^{Link description}]]" nil nil v-a)
445 v-a))
446 (v-n user-full-name)
447 (v-k (if (marker-buffer org-clock-marker)
448 (org-no-properties org-clock-heading)))
449 (v-K (if (marker-buffer org-clock-marker)
450 (org-make-link-string
451 (buffer-file-name (marker-buffer org-clock-marker))
452 org-clock-heading)))
453 v-I
454 (org-startup-folded nil)
455 (org-inhibit-startup t)
456 org-time-was-given org-end-time-was-given x
457 prompt completions char time pos default histvar)
458
459 (when (functionp file)
460 (setq file (funcall file)))
461 (when (functionp headline)
462 (setq headline (funcall headline)))
463 (when (and file (not (file-name-absolute-p file)))
464 (setq file (expand-file-name file org-directory)))
465
466 (setq org-store-link-plist
467 (plist-put org-store-link-plist :annotation v-a)
468 org-store-link-plist
469 (plist-put org-store-link-plist :initial v-i))
470
471 (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
472 (erase-buffer)
473 (insert (substitute-command-keys
474 (format
475 "# %s \"%s\" -> \"* %s\"
476# C-u C-c C-c like C-c C-c, and immediately visit note at target location
477# C-0 C-c C-c \"%s\" -> \"* %s\"
478# %s to select file and header location interactively.
479# C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item
480# To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n"
481 (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c")
482 (abbreviate-file-name (or file org-default-notes-file))
483 (or headline "")
484 (or (car org-remember-previous-location) "???")
485 (or (cdr org-remember-previous-location) "???")
486 (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c"))))
487 (insert tpl)
488
489 ;; %[] Insert contents of a file.
490 (goto-char (point-min))
491 (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
492 (unless (org-remember-escaped-%)
493 (let ((start (match-beginning 0))
494 (end (match-end 0))
495 (filename (expand-file-name (match-string 1))))
496 (goto-char start)
497 (delete-region start end)
498 (condition-case error
499 (insert-file-contents filename)
500 (error (insert (format "%%![Couldn't insert %s: %s]"
501 filename error)))))))
502 ;; Simple %-escapes
503 (goto-char (point-min))
504 (let ((init (and (boundp 'initial)
505 (symbol-value 'initial))))
506 (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
507 (unless (org-remember-escaped-%)
508 (when (and init (equal (match-string 0) "%i"))
509 (save-match-data
510 (let* ((lead (buffer-substring
511 (point-at-bol) (match-beginning 0))))
512 (setq v-i (mapconcat 'identity
513 (org-split-string init "\n")
514 (concat "\n" lead))))))
515 (replace-match
516 (or (eval (intern (concat "v-" (match-string 1)))) "")
517 t t))))
518
519 ;; %() embedded elisp
520 (goto-char (point-min))
521 (while (re-search-forward "%\\((.+)\\)" nil t)
522 (unless (org-remember-escaped-%)
523 (goto-char (match-beginning 0))
524 (let ((template-start (point)))
525 (forward-char 1)
526 (let ((result
527 (condition-case error
528 (eval (read (current-buffer)))
529 (error (format "%%![Error: %s]" error)))))
530 (delete-region template-start (point))
531 (insert result)))))
532
533 ;; From the property list
534 (when plist-p
535 (goto-char (point-min))
536 (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
537 (unless (org-remember-escaped-%)
538 (and (setq x (or (plist-get org-store-link-plist
539 (intern (match-string 1))) ""))
540 (replace-match x t t)))))
541
542 ;; Turn on org-mode in the remember buffer, set local variables
543 (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))
544 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
545 (org-set-local 'org-default-notes-file file))
546 (if headline
547 (org-set-local 'org-remember-default-headline headline))
548 (org-set-local 'org-remember-reference-date
549 (list (nth 4 dct) (nth 3 dct) (nth 5 dct)))
550 ;; Interactive template entries
551 (goto-char (point-min))
552 (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
553 (unless (org-remember-escaped-%)
554 (setq char (if (match-end 3) (match-string 3))
555 prompt (if (match-end 2) (match-string 2)))
556 (goto-char (match-beginning 0))
557 (replace-match "")
558 (setq completions nil default nil)
559 (when prompt
560 (setq completions (org-split-string prompt "|")
561 prompt (pop completions)
562 default (car completions)
563 histvar (intern (concat
564 "org-remember-template-prompt-history::"
565 (or prompt "")))
566 completions (mapcar 'list completions)))
567 (cond
568 ((member char '("G" "g"))
569 (let* ((org-last-tags-completion-table
570 (org-global-tags-completion-table
571 (if (equal char "G") (org-agenda-files) (and file (list file)))))
572 (org-add-colon-after-tag-completion t)
573 (ins (org-icompleting-read
574 (if prompt (concat prompt ": ") "Tags: ")
575 'org-tags-completion-function nil nil nil
576 'org-tags-history)))
577 (setq ins (mapconcat 'identity
578 (org-split-string ins (org-re "[^[:alnum:]_@#%]+"))
579 ":"))
580 (when (string-match "\\S-" ins)
581 (or (equal (char-before) ?:) (insert ":"))
582 (insert ins)
583 (or (equal (char-after) ?:) (insert ":")))))
584 ((equal char "C")
585 (cond ((= (length clipboards) 1) (insert (car clipboards)))
586 ((> (length clipboards) 1)
587 (insert (read-string "Clipboard/kill value: "
588 (car clipboards) '(clipboards . 1)
589 (car clipboards))))))
590 ((equal char "L")
591 (cond ((= (length clipboards) 1)
592 (org-insert-link 0 (car clipboards)))
593 ((> (length clipboards) 1)
594 (org-insert-link 0 (read-string "Clipboard/kill value: "
595 (car clipboards)
596 '(clipboards . 1)
597 (car clipboards))))))
598 ((equal char "p")
599 (let*
600 ((prop (org-no-properties prompt))
601 (pall (concat prop "_ALL"))
602 (allowed
603 (with-current-buffer
604 (or (find-buffer-visiting file)
605 (find-file-noselect file))
606 (or (cdr (assoc pall org-file-properties))
607 (cdr (assoc pall org-global-properties))
608 (cdr (assoc pall org-global-properties-fixed)))))
609 (existing (with-current-buffer
610 (or (find-buffer-visiting file)
611 (find-file-noselect file))
612 (mapcar 'list (org-property-values prop))))
613 (propprompt (concat "Value for " prop ": "))
614 (val (if allowed
615 (org-completing-read
616 propprompt
617 (mapcar 'list (org-split-string allowed "[ \t]+"))
618 nil 'req-match)
619 (org-completing-read-no-i propprompt existing nil nil
620 "" nil ""))))
621 (org-set-property prop val)))
622 (char
623 ;; These are the date/time related ones
624 (setq org-time-was-given (equal (upcase char) char))
625 (setq time (org-read-date (equal (upcase char) "U") t nil
626 prompt))
627 (org-insert-time-stamp time org-time-was-given
628 (member char '("u" "U"))
629 nil nil (list org-end-time-was-given)))
630 (t
631 (let (org-completion-use-ido)
632 (insert (org-without-partial-completion
633 (org-completing-read-no-i
634 (concat (if prompt prompt "Enter string")
635 (if default (concat " [" default "]"))
636 ": ")
637 completions nil nil nil histvar default))))))))
638
639 (goto-char (point-min))
640 (if (re-search-forward "%\\?" nil t)
641 (replace-match "")
642 (and (re-search-forward "^[^#\n]" nil t) (backward-char 1))))
643 (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)))
644 (when (save-excursion
645 (goto-char (point-min))
646 (re-search-forward "%&" nil t))
647 (replace-match "")
648 (org-set-local 'org-jump-to-target-location t))
649 (when org-remember-backup-directory
650 (unless (file-directory-p org-remember-backup-directory)
651 (make-directory org-remember-backup-directory))
652 (org-set-local 'auto-save-file-name-transforms nil)
653 (setq buffer-file-name
654 (expand-file-name
655 (format-time-string "remember-%Y-%m-%d-%H-%M-%S")
656 org-remember-backup-directory))
657 (save-buffer)
658 (org-set-local 'auto-save-visited-file-name t)
659 (auto-save-mode 1))
660 (when (save-excursion
661 (goto-char (point-min))
662 (re-search-forward "%!" nil t))
663 (replace-match "")
664 (add-hook 'post-command-hook 'org-remember-finish-immediately 'append)))
665
666(defun org-remember-escaped-% ()
667 (if (equal (char-before (match-beginning 0)) ?\\)
668 (progn
669 (delete-region (1- (match-beginning 0)) (match-beginning 0))
670 t)
671 nil))
672
673
674(defun org-remember-finish-immediately ()
675 "File remember note immediately.
676This should be run in `post-command-hook' and will remove itself
677from that hook."
678 (remove-hook 'post-command-hook 'org-remember-finish-immediately)
679 (org-remember-finalize))
680
681(defun org-remember-visit-immediately ()
682 "File remember note immediately.
683This should be run in `post-command-hook' and will remove itself
684from that hook."
685 (org-remember '(16))
686 (goto-char (or (text-property-any
687 (point) (save-excursion (org-end-of-subtree t t))
688 'org-position-cursor t)
689 (point)))
690 (message "%s"
691 (format
692 (substitute-command-keys
693 "Restore window configuration with \\[jump-to-register] %c")
694 remember-register)))
695
696(defvar org-clock-marker) ; Defined in org.el
697(defun org-remember-finalize ()
698 "Finalize the remember process."
699 (interactive)
700 (unless org-remember-mode
701 (error "This does not seem to be a remember buffer for Org-mode"))
702 (run-hooks 'org-remember-before-finalize-hook)
703 (unless (fboundp 'remember-finalize)
704 (defalias 'remember-finalize 'remember-buffer))
705 (when (and org-clock-marker
706 (equal (marker-buffer org-clock-marker) (current-buffer)))
707 ;; the clock is running in this buffer.
708 (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
709 (or (eq org-remember-clock-out-on-exit t)
710 (and org-remember-clock-out-on-exit
711 (y-or-n-p "The clock is running in this buffer. Clock out now? "))))
712 (let (org-log-note-clock-out) (org-clock-out))))
713 (when buffer-file-name
714 (do-auto-save))
715 (remember-finalize))
716
717(defun org-remember-kill ()
718 "Abort the current remember process."
719 (interactive)
720 (let ((org-note-abort t))
721 (org-remember-finalize)))
722
723;;;###autoload
724(defun org-remember (&optional goto org-force-remember-template-char)
725 "Call `remember'. If this is already a remember buffer, re-apply template.
726If there is an active region, make sure remember uses it as initial content
727of the remember buffer.
728
729When called interactively with a \\[universal-argument] \
730prefix argument GOTO, don't remember
731anything, just go to the file/headline where the selected template usually
732stores its notes. With a double prefix argument \
733\\[universal-argument] \\[universal-argument], go to the last
734note stored by remember.
735
736Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
737associated with a template in `org-remember-templates'."
738 (interactive "P")
739 (org-require-remember)
740 (cond
741 ((equal goto '(4)) (org-go-to-remember-target))
742 ((equal goto '(16)) (org-remember-goto-last-stored))
743 (t
744 ;; set temporary variables that will be needed in
745 ;; `org-select-remember-template'
746 (setq org-select-template-temp-major-mode major-mode)
747 (setq org-select-template-original-buffer (current-buffer))
748 (if org-remember-mode
749 (progn
750 (when (< (length org-remember-templates) 2)
751 (error "No other template available"))
752 (erase-buffer)
753 (let ((annotation (plist-get org-store-link-plist :annotation))
754 (initial (plist-get org-store-link-plist :initial)))
755 (org-remember-apply-template))
756 (message "Press C-c C-c to remember data"))
757 (if (org-region-active-p)
758 (org-do-remember (buffer-substring (point) (mark)))
759 (org-do-remember))))))
760
761(defvar org-remember-last-stored-marker (make-marker)
762 "Marker pointing to the entry most recently stored with `org-remember'.")
763
764(defun org-remember-goto-last-stored ()
765 "Go to the location where the last remember note was stored."
766 (interactive)
767 (org-goto-marker-or-bmk org-remember-last-stored-marker
768 "org-remember-last-stored")
769 (message "This is the last note stored by remember"))
770
771(defun org-go-to-remember-target (&optional template-key)
772 "Go to the target location of a remember template.
773The user is queried for the template."
774 (interactive)
775 (let* (org-select-template-temp-major-mode
776 (entry (org-select-remember-template template-key))
777 (file (nth 1 entry))
778 (heading (nth 2 entry))
779 visiting)
780 (unless (and file (stringp file) (string-match "\\S-" file))
781 (setq file org-default-notes-file))
782 (when (and file (not (file-name-absolute-p file)))
783 (setq file (expand-file-name file org-directory)))
784 (unless (and heading (stringp heading) (string-match "\\S-" heading))
785 (setq heading org-remember-default-headline))
786 (setq visiting (org-find-base-buffer-visiting file))
787 (if (not visiting) (find-file-noselect file))
788 (org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
789 (widen)
790 (goto-char (point-min))
791 (if (re-search-forward
792 (format org-complex-heading-regexp-format (regexp-quote heading))
793 nil t)
794 (goto-char (match-beginning 0))
795 (error "Target headline not found: %s" heading))))
796
797;; FIXME (bzg): let's clean up of final empty lines happen only once
798;; (see the org-remember-delete-empty-lines-at-end option below)
799;;;###autoload
800(defun org-remember-handler ()
801 "Store stuff from remember.el into an org file.
802When the template has specified a file and a headline, the entry is filed
803there, or in the location defined by `org-default-notes-file' and
804`org-remember-default-headline'.
805\\<org-remember-mode-map>
806If no defaults have been defined, or if the current prefix argument
807is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive
808process is used to select the target location.
809
810When the prefix is 0 (i.e. when remember is exited with \
811C-0 \\[org-remember-finalize]),
812the entry is filed to the same location as the previous note.
813
814When the prefix is 2 (i.e. when remember is exited with \
815C-2 \\[org-remember-finalize]),
816the entry is filed as a subentry of the entry where the clock is
817currently running.
818
819When \\[universal-argument] has been used as prefix argument, the
820note is stored and Emacs moves point to the new location of the
821note, so that editing can be continued there (similar to
822inserting \"%&\" into the template).
823
824Before storing the note, the function ensures that the text has an
825org-mode-style headline, i.e. a first line that starts with
826a \"*\". If not, a headline is constructed from the current date and
827some additional data.
828
829If the variable `org-adapt-indentation' is non-nil, the entire text is
830also indented so that it starts in the same column as the headline
831\(i.e. after the stars).
832
833See also the variable `org-reverse-note-order'."
834 (when (and (equal current-prefix-arg 2)
835 (not (marker-buffer org-clock-marker)))
836 (error "No running clock"))
837 (when (org-bound-and-true-p org-jump-to-target-location)
838 (let* ((end (min (point-max) (1+ (point))))
839 (beg (point)))
840 (if (= end beg) (setq beg (1- beg)))
841 (put-text-property beg end 'org-position-cursor t)))
842 (goto-char (point-min))
843 (while (looking-at "^[ \t]*\n\\|^# .*\n")
844 (replace-match ""))
845 (when org-remember-delete-empty-lines-at-end
846 (goto-char (point-max))
847 (beginning-of-line 1)
848 (while (and (looking-at "[ \t]*$\\|[ \t]*# .*") (> (point) 1))
849 (delete-region (1- (point)) (point-max))
850 (beginning-of-line 1)))
851 (catch 'quit
852 (if org-note-abort (throw 'quit t))
853 (let* ((visitp (org-bound-and-true-p org-jump-to-target-location))
854 (backup-file
855 (and buffer-file-name
856 (equal (file-name-directory buffer-file-name)
857 (file-name-as-directory
858 (expand-file-name org-remember-backup-directory)))
859 (string-match "^remember-[0-9]\\{4\\}"
860 (file-name-nondirectory buffer-file-name))
861 buffer-file-name))
862
863 (dummy
864 (unless (string-match "\\S-" (buffer-string))
865 (message "Nothing to remember")
866 (and backup-file
867 (ignore-errors
868 (delete-file backup-file)
869 (delete-file (concat backup-file "~"))))
870 (set-buffer-modified-p nil)
871 (throw 'quit t)))
872 (reference-date org-remember-reference-date)
873 (previousp (and (member current-prefix-arg '((16) 0))
874 org-remember-previous-location))
875 (clockp (equal current-prefix-arg 2))
876 (clocksp (equal current-prefix-arg 3))
877 (fastp (org-xor (equal current-prefix-arg 1)
878 org-remember-store-without-prompt))
879 (file (cond
880 (fastp org-default-notes-file)
881 ((and (eq org-remember-interactive-interface 'refile)
882 org-refile-targets)
883 org-default-notes-file)
884 ((not previousp)
885 (org-get-org-file))))
886 (heading org-remember-default-headline)
887 (visiting (and file (org-find-base-buffer-visiting file)))
888 (org-startup-folded nil)
889 (org-startup-align-all-tables nil)
890 (org-goto-start-pos 1)
891 spos exitcmd level reversed txt text-before-node-creation)
892 (when (equal current-prefix-arg '(4))
893 (setq visitp t))
894 (when previousp
895 (setq file (car org-remember-previous-location)
896 visiting (and file (org-find-base-buffer-visiting file))
897 heading (cdr org-remember-previous-location)
898 fastp t))
899 (when (or clockp clocksp)
900 (setq file (buffer-file-name (marker-buffer org-clock-marker))
901 visiting (and file (org-find-base-buffer-visiting file))
902 heading org-clock-heading-for-remember
903 fastp t))
904 (setq current-prefix-arg nil)
905 ;; Modify text so that it becomes a nice subtree which can be inserted
906 ;; into an org tree.
907 (when org-remember-delete-empty-lines-at-end
908 (goto-char (point-min))
909 (if (re-search-forward "[ \t\n]+\\'" nil t)
910 ;; remove empty lines at end
911 (replace-match "")))
912 (goto-char (point-min))
913 (setq text-before-node-creation (buffer-string))
914 (unless (looking-at org-outline-regexp)
915 ;; add a headline
916 (insert (concat "* " (current-time-string)
917 " (" (remember-buffer-desc) ")\n"))
918 (backward-char 1)
919 (when org-adapt-indentation
920 (while (re-search-forward "^" nil t)
921 (insert " "))))
922 ;; Delete final empty lines
923 (when org-remember-delete-empty-lines-at-end
924 (goto-char (point-min))
925 (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t)
926 (replace-match "\n\n")
927 (if (re-search-forward "[ \t\n]*\\'")
928 (replace-match "\n"))))
929 (goto-char (point-min))
930 (setq txt (buffer-string))
931 (org-save-markers-in-region (point-min) (point-max))
932 (set-buffer-modified-p nil)
933 (when (and (eq org-remember-interactive-interface 'refile)
934 (not fastp))
935 (org-refile nil (or visiting (find-file-noselect file)))
936 (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
937 (save-excursion
938 (bookmark-jump "org-refile-last-stored")
939 (bookmark-set "org-remember-last-stored")
940 (move-marker org-remember-last-stored-marker (point)))
941 (throw 'quit t))
942 ;; Find the file
943 (with-current-buffer (or visiting (find-file-noselect file))
944 (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom)))
945 (error "Target files for notes must be in Org-mode if not filing to top/bottom"))
946 (save-excursion
947 (save-restriction
948 (widen)
949 (setq reversed (org-notes-order-reversed-p))
950
951 ;; Find the default location
952 (when heading
953 (cond
954 ((not (derived-mode-p 'org-mode))
955 (if (eq heading 'top)
956 (goto-char (point-min))
957 (goto-char (point-max))
958 (or (bolp) (newline)))
959 (insert text-before-node-creation)
960 (when remember-save-after-remembering
961 (save-buffer)
962 (if (not visiting) (kill-buffer (current-buffer))))
963 (throw 'quit t))
964 ((eq heading 'top)
965 (goto-char (point-min))
966 (or (looking-at org-outline-regexp)
967 (re-search-forward org-outline-regexp nil t))
968 (setq org-goto-start-pos (or (match-beginning 0) (point-min))))
969 ((eq heading 'bottom)
970 (goto-char (point-max))
971 (or (bolp) (newline))
972 (setq org-goto-start-pos (point)))
973 ((eq heading 'date-tree)
974 (org-datetree-find-date-create reference-date)
975 (setq reversed nil)
976 (setq org-goto-start-pos (point)))
977 ((and (stringp heading) (string-match "\\S-" heading))
978 (goto-char (point-min))
979 (if (re-search-forward
980 (format org-complex-heading-regexp-format
981 (regexp-quote heading))
982 nil t)
983 (setq org-goto-start-pos (match-beginning 0))
984 (when fastp
985 (goto-char (point-max))
986 (unless (bolp) (newline))
987 (insert "* " heading "\n")
988 (setq org-goto-start-pos (point-at-bol 0)))))
989 (t (goto-char (point-min)) (setq org-goto-start-pos (point)
990 heading 'top))))
991
992 ;; Ask the User for a location, using the appropriate interface
993 (cond
994 ((and fastp (memq heading '(top bottom)))
995 (setq spos org-goto-start-pos
996 exitcmd (if (eq heading 'top) 'left nil)))
997 (fastp (setq spos org-goto-start-pos
998 exitcmd 'return))
999 ((eq org-remember-interactive-interface 'outline)
1000 (setq spos (org-get-location (current-buffer)
1001 org-remember-help)
1002 exitcmd (cdr spos)
1003 spos (car spos)))
1004 ((eq org-remember-interactive-interface 'outline-path-completion)
1005 (let ((org-refile-targets '((nil . (:maxlevel . 10))))
1006 (org-refile-use-outline-path t))
1007 (setq spos (org-refile-get-location "Heading")
1008 exitcmd 'return
1009 spos (nth 3 spos))))
1010 (t (error "This should not happen")))
1011 (if (not spos) (throw 'quit nil)) ; return nil to show we did
1012 ; not handle this note
1013 (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
1014 (goto-char spos)
1015 (cond ((org-at-heading-p t)
1016 (org-back-to-heading t)
1017 (setq level (funcall outline-level))
1018 (cond
1019 ((eq exitcmd 'return)
1020 ;; sublevel of current
1021 (setq org-remember-previous-location
1022 (cons (abbreviate-file-name file)
1023 (org-get-heading 'notags)))
1024 (if reversed
1025 (outline-next-heading)
1026 (org-end-of-subtree t)
1027 (if (not (bolp))
1028 (if (looking-at "[ \t]*\n")
1029 (beginning-of-line 2)
1030 (end-of-line 1)
1031 (insert "\n"))))
1032 (org-paste-subtree (if clocksp
1033 level
1034 (org-get-valid-level level 1)) txt)
1035 (and org-auto-align-tags (org-set-tags nil t))
1036 (bookmark-set "org-remember-last-stored")
1037 (move-marker org-remember-last-stored-marker (point)))
1038 ((eq exitcmd 'left)
1039 ;; before current
1040 (org-paste-subtree level txt)
1041 (and org-auto-align-tags (org-set-tags nil t))
1042 (bookmark-set "org-remember-last-stored")
1043 (move-marker org-remember-last-stored-marker (point)))
1044 ((eq exitcmd 'right)
1045 ;; after current
1046 (org-end-of-subtree t)
1047 (org-paste-subtree level txt)
1048 (and org-auto-align-tags (org-set-tags nil t))
1049 (bookmark-set "org-remember-last-stored")
1050 (move-marker org-remember-last-stored-marker (point)))
1051 (t (error "This should not happen"))))
1052
1053 ((eq heading 'bottom)
1054 (org-paste-subtree 1 txt)
1055 (and org-auto-align-tags (org-set-tags nil t))
1056 (bookmark-set "org-remember-last-stored")
1057 (move-marker org-remember-last-stored-marker (point)))
1058
1059 ((and (bobp) (not reversed))
1060 ;; Put it at the end, one level below level 1
1061 (save-restriction
1062 (widen)
1063 (goto-char (point-max))
1064 (if (not (bolp)) (newline))
1065 (org-paste-subtree (org-get-valid-level 1 1) txt)
1066 (and org-auto-align-tags (org-set-tags nil t))
1067 (bookmark-set "org-remember-last-stored")
1068 (move-marker org-remember-last-stored-marker (point))))
1069
1070 ((and (bobp) reversed)
1071 ;; Put it at the start, as level 1
1072 (save-restriction
1073 (widen)
1074 (goto-char (point-min))
1075 (re-search-forward org-outline-regexp-bol nil t)
1076 (beginning-of-line 1)
1077 (org-paste-subtree 1 txt)
1078 (and org-auto-align-tags (org-set-tags nil t))
1079 (bookmark-set "org-remember-last-stored")
1080 (move-marker org-remember-last-stored-marker (point))))
1081 (t
1082 ;; Put it right there, with automatic level determined by
1083 ;; org-paste-subtree or from prefix arg
1084 (org-paste-subtree
1085 (if (numberp current-prefix-arg) current-prefix-arg)
1086 txt)
1087 (and org-auto-align-tags (org-set-tags nil t))
1088 (bookmark-set "org-remember-last-stored")
1089 (move-marker org-remember-last-stored-marker (point))))
1090
1091 (when remember-save-after-remembering
1092 (save-buffer)
1093 (if (and (not visiting)
1094 (not (equal (marker-buffer org-clock-marker)
1095 (current-buffer))))
1096 (kill-buffer (current-buffer))))
1097 (when org-remember-auto-remove-backup-files
1098 (when backup-file
1099 (ignore-errors
1100 (delete-file backup-file)
1101 (delete-file (concat backup-file "~"))))
1102 (when org-remember-backup-directory
1103 (let ((n (length
1104 (directory-files
1105 org-remember-backup-directory nil
1106 "^remember-.*[0-9]$"))))
1107 (when (and org-remember-warn-about-backups
1108 (> n 0))
1109 (message
1110 "%d backup files (unfinished remember calls) in %s"
1111 n org-remember-backup-directory))))))))))
1112
1113 t) ;; return t to indicate that we took care of this note.
1114
1115(defun org-do-remember (&optional initial)
1116 "Call remember."
1117 (remember initial))
1118
1119(defun org-require-remember ()
1120 "Make sure remember is loaded, or install our own emergency version of it."
1121 (condition-case nil
1122 (require 'remember)
1123 (error
1124 ;; Lets install our own micro version of remember
1125 (defvar remember-register ?R)
1126 (defvar remember-mode-hook nil)
1127 (defvar remember-handler-functions nil)
1128 (defvar remember-buffer "*Remember*")
1129 (defvar remember-save-after-remembering t)
1130 (defvar remember-annotation-functions '(buffer-file-name))
1131 (defun remember-finalize ()
1132 (run-hook-with-args-until-success 'remember-handler-functions)
1133 (when (equal remember-buffer (buffer-name))
1134 (kill-buffer (current-buffer))
1135 (jump-to-register remember-register)))
1136 (defun remember-mode ()
1137 (fundamental-mode)
1138 (setq mode-name "Remember")
1139 (run-hooks 'remember-mode-hook))
1140 (defun remember (&optional initial)
1141 (window-configuration-to-register remember-register)
1142 (let* ((annotation (run-hook-with-args-until-success
1143 'remember-annotation-functions)))
1144 (switch-to-buffer-other-window (get-buffer-create remember-buffer))
1145 (remember-mode)))
1146 (defun remember-buffer-desc ()
1147 (buffer-substring (point-min) (save-excursion (goto-char (point-min))
1148 (point-at-eol)))))))
1149
1150(provide 'org-remember)
1151
1152;; Local variables:
1153;; generated-autoload-file: "org-loaddefs.el"
1154;; End:
1155
1156;;; org-remember.el ends here
diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el
deleted file mode 100644
index bbf5fef4bc1..00000000000
--- a/lisp/org/org-special-blocks.el
+++ /dev/null
@@ -1,104 +0,0 @@
1;;; org-special-blocks.el --- handle Org special blocks
2;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
3
4;; Author: Chris Gray <chrismgray@gmail.com>
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22;;
23
24;; This package generalizes the #+begin_foo and #+end_foo tokens.
25
26;; To use, put the following in your init file:
27;;
28;; (require 'org-special-blocks)
29
30;; The tokens #+begin_center, #+begin_verse, etc. existed previously.
31;; This package generalizes them (at least for the LaTeX and html
32;; exporters). When a #+begin_foo token is encountered by the LaTeX
33;; exporter, it is expanded into \begin{foo}. The text inside the
34;; environment is not protected, as text inside environments generally
35;; is. When #+begin_foo is encountered by the html exporter, a div
36;; with class foo is inserted into the HTML file. It is up to the
37;; user to add this class to his or her stylesheet if this div is to
38;; mean anything.
39
40(require 'org-html)
41(require 'org-compat)
42
43(declare-function org-open-par "org-html" ())
44(declare-function org-close-par-maybe "org-html" ())
45
46(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
47 "A regexp indicating the names of blocks that should be ignored
48by org-special-blocks. These blocks will presumably be
49interpreted by other mechanisms.")
50
51(defvar org-export-current-backend) ; dynamically bound in org-exp.el
52(defun org-special-blocks-make-special-cookies ()
53 "Adds special cookies when #+begin_foo and #+end_foo tokens are
54seen. This is run after a few special cases are taken care of."
55 (when (or (eq org-export-current-backend 'html)
56 (eq org-export-current-backend 'latex))
57 (goto-char (point-min))
58 (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
59 (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2))
60 (replace-match
61 (if (equal (downcase (match-string 1)) "begin")
62 (concat "ORG-" (match-string 2) "-START")
63 (concat "ORG-" (match-string 2) "-END"))
64 t t)))))
65
66(add-hook 'org-export-preprocess-after-blockquote-hook
67 'org-special-blocks-make-special-cookies)
68
69(defun org-special-blocks-convert-latex-special-cookies ()
70 "Converts the special cookies into LaTeX blocks."
71 (goto-char (point-min))
72 (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t)
73 (replace-match
74 (if (equal (match-string 3) "START")
75 (concat "\\begin{" (match-string 1) "}" (match-string 2))
76 (concat "\\end{" (match-string 1) "}"))
77 t t)))
78
79
80(add-hook 'org-export-latex-after-blockquotes-hook
81 'org-special-blocks-convert-latex-special-cookies)
82
83(defvar org-line)
84(defun org-special-blocks-convert-html-special-cookies ()
85 "Converts the special cookies into div blocks."
86 ;; Uses the dynamically-bound variable `org-line'.
87 (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line))
88 (message "%s" (match-string 1))
89 (when (equal (match-string 2 org-line) "START")
90 (org-close-par-maybe)
91 (insert "\n<div class=\"" (match-string 1 org-line) "\">")
92 (org-open-par))
93 (when (equal (match-string 2 org-line) "END")
94 (org-close-par-maybe)
95 (insert "\n</div>")
96 (org-open-par))
97 (throw 'nextline nil)))
98
99(add-hook 'org-export-html-after-blockquotes-hook
100 'org-special-blocks-convert-html-special-cookies)
101
102(provide 'org-special-blocks)
103
104;;; org-special-blocks.el ends here
diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el
deleted file mode 100644
index fc2a34b8fe5..00000000000
--- a/lisp/org/org-vm.el
+++ /dev/null
@@ -1,180 +0,0 @@
1;;; org-vm.el --- Support for links to VM messages from within Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; Support for IMAP folders added
10;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
11;; Requires VM 8.2.0a or later.
12;;
13;; This file is part of GNU Emacs.
14;;
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28;;
29;;; Commentary:
30;; This file implements links to VM messages and folders from within Org-mode.
31;; Org-mode loads this module by default - if this is not what you want,
32;; configure the variable `org-modules'.
33
34;;; Code:
35
36(require 'org)
37
38;; Declare external functions and variables
39(declare-function vm-preview-current-message "ext:vm-page" ())
40(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
41(declare-function vm-get-header-contents "ext:vm-summary"
42 (message header-name-regexp &optional clump-sep))
43(declare-function vm-isearch-narrow "ext:vm-search" ())
44(declare-function vm-isearch-update "ext:vm-search" ())
45(declare-function vm-select-folder-buffer "ext:vm-macro" ())
46(declare-function vm-su-message-id "ext:vm-summary" (m))
47(declare-function vm-su-subject "ext:vm-summary" (m))
48(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
49(declare-function vm-imap-folder-p "ext:vm-save" ())
50(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
51(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
52(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
53(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
54(defvar vm-message-pointer)
55(defvar vm-folder-directory)
56
57;; Install the link type
58(org-add-link-type "vm" 'org-vm-open)
59(org-add-link-type "vm-imap" 'org-vm-imap-open)
60(add-hook 'org-store-link-functions 'org-vm-store-link)
61
62;; Implementation
63(defun org-vm-store-link ()
64 "Store a link to a VM folder or message."
65 (when (and (or (eq major-mode 'vm-summary-mode)
66 (eq major-mode 'vm-presentation-mode))
67 (save-window-excursion
68 (vm-select-folder-buffer) buffer-file-name))
69 (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
70 (vm-follow-summary-cursor)
71 (save-excursion
72 (vm-select-folder-buffer)
73 (let* ((message (car vm-message-pointer))
74 (subject (vm-su-subject message))
75 (to (vm-get-header-contents message "To"))
76 (from (vm-get-header-contents message "From"))
77 (message-id (vm-su-message-id message))
78 (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
79 (date (vm-get-header-contents message "Date"))
80 (date-ts (and date (format-time-string
81 (org-time-stamp-format t)
82 (date-to-time date))))
83 (date-ts-ia (and date (format-time-string
84 (org-time-stamp-format t t)
85 (date-to-time date))))
86 folder desc link)
87 (if (vm-imap-folder-p)
88 (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
89 (setq folder (vm-imap-folder-for-spec spec)))
90 (progn
91 (setq folder (abbreviate-file-name buffer-file-name))
92 (if (and vm-folder-directory
93 (string-match (concat "^" (regexp-quote vm-folder-directory))
94 folder))
95 (setq folder (replace-match "" t t folder)))))
96 (setq message-id (org-remove-angle-brackets message-id))
97 (org-store-link-props :type link-type :from from :to to :subject subject
98 :message-id message-id)
99 (when date
100 (org-add-link-props :date date :date-timestamp date-ts
101 :date-timestamp-inactive date-ts-ia))
102 (setq desc (org-email-link-description))
103 (setq link (concat (concat link-type ":") folder "#" message-id))
104 (org-add-link-props :link link :description desc)
105 link))))
106
107(defun org-vm-open (path)
108 "Follow a VM message link specified by PATH."
109 (let (folder article)
110 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
111 (error "Error in VM link"))
112 (setq folder (match-string 1 path)
113 article (match-string 3 path))
114 ;; The prefix argument will be interpreted as read-only
115 (org-vm-follow-link folder article current-prefix-arg)))
116
117(defun org-vm-follow-link (&optional folder article readonly)
118 "Follow a VM link to FOLDER and ARTICLE."
119 (require 'vm)
120 (setq article (org-add-angle-brackets article))
121 (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
122 ;; ange-ftp or efs or tramp access
123 (let ((user (or (match-string 1 folder) (user-login-name)))
124 (host (match-string 2 folder))
125 (file (match-string 3 folder)))
126 (cond
127 ((featurep 'tramp)
128 ;; use tramp to access the file
129 (if (featurep 'xemacs)
130 (setq folder (format "[%s@%s]%s" user host file))
131 (setq folder (format "/%s@%s:%s" user host file))))
132 (t
133 ;; use ange-ftp or efs
134 (require (if (featurep 'xemacs) 'efs 'ange-ftp))
135 (setq folder (format "/%s@%s:%s" user host file))))))
136 (when folder
137 (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
138 (when article
139 (org-vm-select-message (org-add-angle-brackets article)))))
140
141(defun org-vm-imap-open (path)
142 "Follow a VM link to an IMAP folder."
143 (require 'vm-imap)
144 (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
145 (let* ((account-name (match-string 1 path))
146 (mailbox-name (match-string 2 path))
147 (message-id (match-string 3 path))
148 (account-spec (vm-imap-parse-spec-to-list
149 (vm-imap-spec-for-account account-name)))
150 (mailbox-spec (mapconcat 'identity
151 (append (butlast account-spec 4)
152 (cons mailbox-name
153 (last account-spec 3)))
154 ":")))
155 (funcall (cdr (assq 'vm-imap org-link-frame-setup))
156 mailbox-spec)
157 (when message-id
158 (org-vm-select-message (org-add-angle-brackets message-id))))))
159
160(defun org-vm-select-message (message-id)
161 "Go to the message with message-id in the current folder."
162 (require 'vm-search)
163 (sit-for 0.1)
164 (vm-select-folder-buffer)
165 (widen)
166 (let ((case-fold-search t))
167 (goto-char (point-min))
168 (if (not (re-search-forward
169 (concat "^" "message-id: *" (regexp-quote message-id))))
170 (error "Could not find the specified message in this folder"))
171 (vm-isearch-update)
172 (vm-isearch-narrow)
173 (vm-preview-current-message)
174 (vm-summarize)))
175
176(provide 'org-vm)
177
178
179
180;;; org-vm.el ends here
diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el
deleted file mode 100644
index b755c023e78..00000000000
--- a/lisp/org/org-wl.el
+++ /dev/null
@@ -1,316 +0,0 @@
1;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
6;; David Maus <dmaus at ictsoc dot de>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;;
10;; This file is part of GNU Emacs.
11;;
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25;;
26;;; Commentary:
27
28;; This file implements links to Wanderlust messages from within Org-mode.
29;; Org-mode loads this module by default - if this is not what you want,
30;; configure the variable `org-modules'.
31
32;;; Code:
33
34(require 'org)
35
36(defgroup org-wl nil
37 "Options concerning the Wanderlust link."
38 :tag "Org Startup"
39 :group 'org-link)
40
41(defcustom org-wl-link-to-refile-destination t
42 "Create a link to the refile destination if the message is marked as refile."
43 :group 'org-wl
44 :type 'boolean)
45
46(defcustom org-wl-link-remove-filter nil
47 "Remove filter condition if message is filter folder."
48 :group 'org-wl
49 :version "24.1"
50 :type 'boolean)
51
52(defcustom org-wl-shimbun-prefer-web-links nil
53 "If non-nil create web links for shimbun messages."
54 :group 'org-wl
55 :version "24.1"
56 :type 'boolean)
57
58(defcustom org-wl-nntp-prefer-web-links nil
59 "If non-nil create web links for nntp messages.
60When folder name contains string \"gmane\" link to gmane,
61googlegroups otherwise."
62 :type 'boolean
63 :version "24.1"
64 :group 'org-wl)
65
66(defcustom org-wl-disable-folder-check t
67 "Disable check for new messages when open a link."
68 :type 'boolean
69 :version "24.1"
70 :group 'org-wl)
71
72(defcustom org-wl-namazu-default-index nil
73 "Default namazu search index."
74 :type 'directory
75 :version "24.1"
76 :group 'org-wl)
77
78;; Declare external functions and variables
79(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
80(declare-function elmo-message-entity-field "ext:elmo-msgdb"
81 (entity field &optional type))
82(declare-function elmo-message-field "ext:elmo"
83 (folder number field &optional type) t)
84(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t)
85;; Backward compatibility to old version of wl
86(declare-function wl "ext:wl" () t)
87(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
88(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
89 (&optional id))
90(declare-function wl-summary-jump-to-msg "ext:wl-summary"
91 (&optional number beg end))
92(declare-function wl-summary-line-from "ext:wl-summary" ())
93(declare-function wl-summary-line-subject "ext:wl-summary" ())
94(declare-function wl-summary-message-number "ext:wl-summary" ())
95(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
96(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
97(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
98 (&optional folder sticky))
99(declare-function wl-folder-get-petname "ext:wl-folder" (name))
100(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
101 (&optional getid))
102(declare-function wl-folder-buffer-group-p "ext:wl-folder")
103(defvar wl-init)
104(defvar wl-summary-buffer-elmo-folder)
105(defvar wl-summary-buffer-folder-name)
106(defvar wl-folder-group-regexp)
107(defvar wl-auto-check-folder-name)
108(defvar elmo-nntp-default-server)
109
110(defconst org-wl-folder-types
111 '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
112 ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search)
113 ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal))
114 "List of folder indicators. See Wanderlust manual, section 3.")
115
116;; Install the link type
117(org-add-link-type "wl" 'org-wl-open)
118(add-hook 'org-store-link-functions 'org-wl-store-link)
119
120;; Implementation
121
122(defun org-wl-folder-type (folder)
123 "Return symbol that indicates the type of FOLDER.
124FOLDER is the wanderlust folder name. The first character of the
125folder name determines the folder type."
126 (let* ((indicator (substring folder 0 1))
127 (type (cdr (assoc indicator org-wl-folder-types))))
128 ;; maybe access or file folder
129 (when (not type)
130 (setq type
131 (cond
132 ((and (>= (length folder) 5)
133 (string= (substring folder 0 5) "file:"))
134 'file)
135 ((and (>= (length folder) 7)
136 (string= (substring folder 0 7) "access:"))
137 'access)
138 (t
139 nil))))
140 type))
141
142(defun org-wl-message-field (field entity)
143 "Return content of FIELD in ENTITY.
144FIELD is a symbol of a rfc822 message header field.
145ENTITY is a message entity."
146 (let ((content (elmo-message-entity-field entity field 'string)))
147 (if (listp content) (car content) content)))
148
149(defun org-wl-store-link ()
150 "Store a link to a WL message or folder."
151 (unless (eobp)
152 (cond
153 ((memq major-mode '(wl-summary-mode mime-view-mode))
154 (org-wl-store-link-message))
155 ((eq major-mode 'wl-folder-mode)
156 (org-wl-store-link-folder))
157 (t
158 nil))))
159
160(defun org-wl-store-link-folder ()
161 "Store a link to a WL folder."
162 (let* ((folder (wl-folder-get-entity-from-buffer))
163 (petname (wl-folder-get-petname folder))
164 (link (concat "wl:" folder)))
165 (save-excursion
166 (beginning-of-line)
167 (unless (and (wl-folder-buffer-group-p)
168 (looking-at wl-folder-group-regexp))
169 (org-store-link-props :type "wl" :description petname
170 :link link)
171 link))))
172
173(defun org-wl-store-link-message ()
174 "Store a link to a WL message."
175 (save-excursion
176 (let ((buf (if (eq major-mode 'wl-summary-mode)
177 (current-buffer)
178 (and (boundp 'wl-message-buffer-cur-summary-buffer)
179 wl-message-buffer-cur-summary-buffer))))
180 (when buf
181 (with-current-buffer buf
182 (let* ((msgnum (wl-summary-message-number))
183 (mark-info (wl-summary-registered-temp-mark msgnum))
184 (folder-name
185 (if (and org-wl-link-to-refile-destination
186 mark-info
187 (equal (nth 1 mark-info) "o")) ; marked as refile
188 (nth 2 mark-info)
189 wl-summary-buffer-folder-name))
190 (folder-type (org-wl-folder-type folder-name))
191 (wl-message-entity
192 (if (fboundp 'elmo-message-entity)
193 (elmo-message-entity
194 wl-summary-buffer-elmo-folder msgnum)
195 (elmo-msgdb-overview-get-entity
196 msgnum (wl-summary-buffer-msgdb))))
197 (message-id
198 (org-wl-message-field 'message-id wl-message-entity))
199 (message-id-no-brackets
200 (org-remove-angle-brackets message-id))
201 (from (org-wl-message-field 'from wl-message-entity))
202 (to (org-wl-message-field 'to wl-message-entity))
203 (xref (org-wl-message-field 'xref wl-message-entity))
204 (subject (org-wl-message-field 'subject wl-message-entity))
205 (date (org-wl-message-field 'date wl-message-entity))
206 (date-ts (and date (format-time-string
207 (org-time-stamp-format t)
208 (date-to-time date))))
209 (date-ts-ia (and date (format-time-string
210 (org-time-stamp-format t t)
211 (date-to-time date))))
212 desc link)
213
214 ;; remove text properties of subject string to avoid possible bug
215 ;; when formatting the subject
216 ;; (Emacs bug #5306, fixed)
217 (set-text-properties 0 (length subject) nil subject)
218
219 ;; maybe remove filter condition
220 (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
221 (while (eq (org-wl-folder-type folder-name) 'filter)
222 (setq folder-name
223 (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
224
225 ;; maybe create http link
226 (cond
227 ((and (eq folder-type 'shimbun)
228 org-wl-shimbun-prefer-web-links xref)
229 (org-store-link-props :type "http" :link xref :description subject
230 :from from :to to :message-id message-id
231 :message-id-no-brackets message-id-no-brackets
232 :subject subject))
233 ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
234 (setq link
235 (format
236 (if (string-match "gmane\\." folder-name)
237 "http://mid.gmane.org/%s"
238 "http://groups.google.com/groups/search?as_umsgid=%s")
239 (org-fixup-message-id-for-http message-id)))
240 (org-store-link-props :type "http" :link link :description subject
241 :from from :to to :message-id message-id
242 :message-id-no-brackets message-id-no-brackets
243 :subject subject))
244 (t
245 (org-store-link-props :type "wl" :from from :to to
246 :subject subject :message-id message-id
247 :message-id-no-brackets message-id-no-brackets)
248 (setq desc (org-email-link-description))
249 (setq link (concat "wl:" folder-name "#" message-id-no-brackets))
250 (org-add-link-props :link link :description desc)))
251 (when date
252 (org-add-link-props :date date :date-timestamp date-ts
253 :date-timestamp-inactive date-ts-ia))
254 (or link xref)))))))
255
256(defun org-wl-open-nntp (path)
257 "Follow the nntp: link specified by PATH."
258 (let* ((spec (split-string path "/"))
259 (server (split-string (nth 2 spec) "@"))
260 (group (nth 3 spec))
261 (article (nth 4 spec)))
262 (org-wl-open
263 (concat "-" group ":" (if (cdr server)
264 (car (split-string (car server) ":"))
265 "")
266 (if (string= elmo-nntp-default-server (nth 2 spec))
267 ""
268 (concat "@" (or (cdr server) (car server))))
269 (if article (concat "#" article) "")))))
270
271(defun org-wl-open (path)
272 "Follow the WL message link specified by PATH.
273When called with one prefix, open message in namazu search folder
274with `org-wl-namazu-default-index' as search index. When called
275with two prefixes or `org-wl-namazu-default-index' is nil, ask
276for namazu index."
277 (require 'wl)
278 (let ((wl-auto-check-folder-name
279 (if org-wl-disable-folder-check
280 'none
281 wl-auto-check-folder-name)))
282 (unless wl-init (wl))
283 ;; XXX: The imap-uw's MH folder names start with "%#".
284 (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path))
285 (error "Error in Wanderlust link"))
286 (let ((folder (match-string 1 path))
287 (article (match-string 3 path)))
288 ;; maybe open message in namazu search folder
289 (when current-prefix-arg
290 (setq folder (concat "[" article "]"
291 (if (and (equal current-prefix-arg '(4))
292 org-wl-namazu-default-index)
293 org-wl-namazu-default-index
294 (read-directory-name "Namazu index: ")))))
295 (if (not (elmo-folder-exists-p (org-no-warnings
296 (wl-folder-get-elmo-folder folder))))
297 (error "No such folder: %s" folder))
298 (let ((old-buf (current-buffer))
299 (old-point (point-marker)))
300 (wl-folder-goto-folder-subr folder)
301 (with-current-buffer old-buf
302 ;; XXX: `wl-folder-goto-folder-subr' moves point to the
303 ;; beginning of the current line. So, restore the point
304 ;; in the old buffer.
305 (goto-char old-point))
306 (when article
307 (if (org-string-match-p "@" article)
308 (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
309 article))
310 (or (wl-summary-jump-to-msg (string-to-number article))
311 (error "No such message: %s" article)))
312 (wl-summary-redisplay))))))
313
314(provide 'org-wl)
315
316;;; org-wl.el ends here
diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el
deleted file mode 100644
index 1083fe16c53..00000000000
--- a/lisp/org/org-xoxo.el
+++ /dev/null
@@ -1,129 +0,0 @@
1;;; org-xoxo.el --- XOXO export for Org-mode
2
3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
4
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26;; XOXO export
27
28;;; Code:
29
30(require 'org-exp)
31
32(defvar org-export-xoxo-final-hook nil
33 "Hook run after XOXO export, in the new buffer.")
34
35(defun org-export-as-xoxo-insert-into (buffer &rest output)
36 (with-current-buffer buffer
37 (apply 'insert output)))
38(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
39
40;;;###autoload
41(defun org-export-as-xoxo (&optional buffer)
42 "Export the org buffer as XOXO.
43The XOXO buffer is named *xoxo-<source buffer name>*"
44 (interactive (list (current-buffer)))
45 (run-hooks 'org-export-first-hook)
46 ;; A quickie abstraction
47
48 ;; Output everything as XOXO
49 (with-current-buffer (get-buffer buffer)
50 (let* ((pos (point))
51 (opt-plist (org-combine-plists (org-default-export-plist)
52 (org-infile-export-plist)))
53 (filename (concat (file-name-as-directory
54 (org-export-directory :xoxo opt-plist))
55 (file-name-sans-extension
56 (file-name-nondirectory buffer-file-name))
57 ".html"))
58 (out (find-file-noselect filename))
59 (last-level 1)
60 (hanging-li nil))
61 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
62 ;; Check the output buffer is empty.
63 (with-current-buffer out (erase-buffer))
64 ;; Kick off the output
65 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
66 (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
67 (let* ((hd (match-string-no-properties 1))
68 (level (length hd))
69 (text (concat
70 (match-string-no-properties 2)
71 (save-excursion
72 (goto-char (match-end 0))
73 (let ((str ""))
74 (catch 'loop
75 (while 't
76 (forward-line)
77 (if (looking-at "^[ \t]\\(.*\\)")
78 (setq str (concat str (match-string-no-properties 1)))
79 (throw 'loop str)))))))))
80
81 ;; Handle level rendering
82 (cond
83 ((> level last-level)
84 (org-export-as-xoxo-insert-into out "\n<ol>\n"))
85
86 ((< level last-level)
87 (dotimes (- (- last-level level) 1)
88 (if hanging-li
89 (org-export-as-xoxo-insert-into out "</li>\n"))
90 (org-export-as-xoxo-insert-into out "</ol>\n"))
91 (when hanging-li
92 (org-export-as-xoxo-insert-into out "</li>\n")
93 (setq hanging-li nil)))
94
95 ((equal level last-level)
96 (if hanging-li
97 (org-export-as-xoxo-insert-into out "</li>\n")))
98 )
99
100 (setq last-level level)
101
102 ;; And output the new li
103 (setq hanging-li 't)
104 (if (equal ?+ (elt text 0))
105 (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
106 (org-export-as-xoxo-insert-into out "<li>" text))))
107
108 ;; Finally finish off the ol
109 (dotimes (- last-level 1)
110 (if hanging-li
111 (org-export-as-xoxo-insert-into out "</li>\n"))
112 (org-export-as-xoxo-insert-into out "</ol>\n"))
113
114 (goto-char pos)
115 ;; Finish the buffer off and clean it up.
116 (switch-to-buffer-other-window out)
117 (indent-region (point-min) (point-max) nil)
118 (run-hooks 'org-export-xoxo-final-hook)
119 (save-buffer)
120 (goto-char (point-min))
121 )))
122
123(provide 'org-xoxo)
124
125;; Local variables:
126;; generated-autoload-file: "org-loaddefs.el"
127;; End:
128
129;;; org-xoxo.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-28 13:48:06 +0000