From 63b8ecb4eaecc293a322e53f6654ccbc9276a037 Mon Sep 17 00:00:00 2001
From: Bastien Guerry
Date: Fri, 1 Jul 2011 11:12:19 +0200
Subject: [PATCH] Add Jambunathan's odt exporter in contrib/.
This adds these new files:
contrib/lisp/org-lparse.el
contrib/lisp/org-odt.el
contrib/lisp/org-xhtml.el
contrib/odt/BasicODConverter/BasicODConverter-0.8.0.oxt
contrib/odt/BasicODConverter/Filters.bas
contrib/odt/BasicODConverter/Main.bas
contrib/odt/OASIS/OpenDocument-schema-v1.1.rng
contrib/odt/OASIS/OpenDocument-v1.2-cs01-manifest-schema.rng
contrib/odt/OASIS/OpenDocument-v1.2-cs01-schema.rng
contrib/odt/README.org
contrib/odt/etc/schema/od-manifest-schema-v1.2-cs01.rnc
contrib/odt/etc/schema/od-schema-v1.1.rnc
contrib/odt/etc/schema/od-schema-v1.2-cs01.rnc
contrib/odt/etc/schema/schemas.xml
contrib/odt/styles/OrgOdtAutomaticStyles.xml
contrib/odt/styles/OrgOdtStyles.xml
Notes:
contrib/lisp/org-xhtml.el is meant to be merged at some point with
lisp/org-html.el, to avoid code redundancies.
The feature as a whole is meant to move to Org's core when things
are tested and stable enough.
Thanks a lot to Jambunathan for this great contribution and for
his patience!
---
contrib/lisp/org-lparse.el | 1977 ++
contrib/lisp/org-odt.el | 1513 ++
contrib/lisp/org-xhtml.el | 1797 ++
.../BasicODConverter/BasicODConverter-0.8.0.oxt | Bin 0 -> 8009 bytes
contrib/odt/BasicODConverter/Filters.bas | 213 +
contrib/odt/BasicODConverter/Main.bas | 201 +
contrib/odt/OASIS/OpenDocument-schema-v1.1.rng | 17891 ++++++++++++++++++
.../OpenDocument-v1.2-cs01-manifest-schema.rng | 224 +
.../odt/OASIS/OpenDocument-v1.2-cs01-schema.rng | 18127 +++++++++++++++++++
contrib/odt/README.org | 298 +
.../etc/schema/od-manifest-schema-v1.2-cs01.rnc | 88 +
contrib/odt/etc/schema/od-schema-v1.1.rnc | 6444 +++++++
contrib/odt/etc/schema/od-schema-v1.2-cs01.rnc | 6280 +++++++
contrib/odt/etc/schema/schemas.xml | 7 +
contrib/odt/styles/OrgOdtAutomaticStyles.xml | 152 +
contrib/odt/styles/OrgOdtStyles.xml | 668 +
16 files changed, 55880 insertions(+)
create mode 100755 contrib/lisp/org-lparse.el
create mode 100644 contrib/lisp/org-odt.el
create mode 100644 contrib/lisp/org-xhtml.el
create mode 100644 contrib/odt/BasicODConverter/BasicODConverter-0.8.0.oxt
create mode 100644 contrib/odt/BasicODConverter/Filters.bas
create mode 100644 contrib/odt/BasicODConverter/Main.bas
create mode 100644 contrib/odt/OASIS/OpenDocument-schema-v1.1.rng
create mode 100644 contrib/odt/OASIS/OpenDocument-v1.2-cs01-manifest-schema.rng
create mode 100644 contrib/odt/OASIS/OpenDocument-v1.2-cs01-schema.rng
create mode 100644 contrib/odt/README.org
create mode 100644 contrib/odt/etc/schema/od-manifest-schema-v1.2-cs01.rnc
create mode 100644 contrib/odt/etc/schema/od-schema-v1.1.rnc
create mode 100644 contrib/odt/etc/schema/od-schema-v1.2-cs01.rnc
create mode 100644 contrib/odt/etc/schema/schemas.xml
create mode 100644 contrib/odt/styles/OrgOdtAutomaticStyles.xml
create mode 100644 contrib/odt/styles/OrgOdtStyles.xml
diff --git a/contrib/lisp/org-lparse.el b/contrib/lisp/org-lparse.el
new file mode 100755
index 000000000..cff8fd65e
--- /dev/null
+++ b/contrib/lisp/org-lparse.el
@@ -0,0 +1,1977 @@
+;;; org-lparse.el --- Line-oriented exporter for Org-mode
+
+;; Copyright (C) 2010, 2011
+;; Jambunathan
+
+;; Author: Jambunathan K
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.8
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see .
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; `org-lparse' is the entry point for the generic line-oriented
+;;; exporter. `org-do-lparse' is the genericized version of the
+;;; original `org-export-as-html' routine.
+
+;;; `org-lparse-native-backends' is a good starting point for
+;;; exploring the generic exporter.
+
+;;; Following new interactive commands are provided by this library.
+;;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
+;;; `org-replace-region-by', `org-lparse-region'.
+
+;;; Note that the above routines correspond to the following routines
+;;; in the html exporter `org-export-as-html',
+;;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
+;;; `org-replace-region-by-html' and `org-export-region-as-html'.
+
+;;; The all new interactive command `org-export-convert' can be used
+;;; to convert documents between various formats. Use this to
+;;; command, for example, to convert odt file to doc or pdf format.
+
+;;; See README.org file that comes with this library for answers to
+;;; FAQs and more information on using this library.
+
+;;; Use M-x `org-odt-unit-test' for test driving the odt exporter
+
+;;; Code:
+
+(require 'org-exp)
+(require 'org-list)
+
+;;;###autoload
+(defun org-lparse-and-open (target-backend native-backend arg)
+ "Export the outline as HTML and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists."
+ ;; (interactive "Mbackend: \nP")
+ (interactive
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (all-backends (org-lparse-all-backends))
+ (target-backend
+ (funcall input "Export to: " all-backends nil t nil))
+ (native-backend
+ (or
+ ;; (and (org-lparse-backend-is-native-p target-backend)
+ ;; target-backend)
+ (funcall input "Use Native backend: "
+ (cdr (assoc target-backend all-backends)) nil t nil))))
+ (list target-backend native-backend current-prefix-arg)))
+ (let (f (file-or-buf (org-lparse target-backend native-backend
+ arg 'hidden)))
+ (when file-or-buf
+ (setq f (cond
+ ((bufferp file-or-buf) buffer-file-name)
+ ((file-exists-p file-or-buf) file-or-buf)
+ (t (error "org-lparse-and-open: This shouldn't happen"))))
+ (message "Opening file %s" f)
+ (org-open-file f)
+ (when org-export-kill-product-buffer-when-displayed
+ (kill-buffer (current-buffer))))))
+
+;;;###autoload
+(defun org-lparse-batch (target-backend &optional native-backend)
+ "Call the function `org-lparse'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-lparse-batch"
+ (setq native-backend (or native-backend target-backend))
+ (org-lparse target-backend native-backend
+ org-export-headline-levels 'hidden))
+
+;;;###autoload
+(defun org-lparse-to-buffer (backend arg)
+ "Call `org-lparse` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-lparse'."
+ (interactive "Mbackend: \nP")
+ (let ((tempbuf (format "*Org %s Export*" (upcase backend))))
+ (org-lparse backend backend arg nil nil tempbuf)
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window tempbuf))))
+
+;;;###autoload
+(defun org-replace-region-by (backend beg end)
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use this
+command to convert it."
+ (interactive "Mbackend: \nr")
+ (let (reg backend-string buf pop-up-frames)
+ (save-window-excursion
+ (if (org-mode-p)
+ (setq backend-string (org-lparse-region backend beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq backend-string (org-lparse-region backend (point-min)
+ (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert backend-string)))
+
+;;;###autoload
+(defun org-lparse-region (backend beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-lparse-region \"html\" beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "Mbackend: \nr\nP")
+ (when (org-called-interactively-p 'any)
+ (setq buffer (format "*Org %s Export*" (upcase backend))))
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+(defvar org-lparse-par-open nil)
+
+(defun org-lparse-should-inline-p (filename descp)
+ "Return non-nil if link FILENAME should be inlined.
+The decision to inline the FILENAME link is based on the current
+settings. DESCP is the boolean of whether there was a link
+description. See variables `org-export-html-inline-images' and
+`org-export-html-inline-image-extensions'."
+ (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
+ (inline-image-extensions
+ (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (and (or (eq t inline-images) (and inline-images (not descp)))
+ (org-file-image-p filename inline-image-extensions))))
+
+(defun org-lparse-format-org-link (line opt-plist)
+ "Return LINE with markup of Org mode links.
+OPT-PLIST is the export options list."
+ (let ((start 0)
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (link-validate (plist-get opt-plist :link-validation-function))
+ type id-file fnc
+ rpl path attr desc descp desc1 desc2 link
+ org-lparse-link-description-is-image)
+ (while (string-match org-bracket-link-analytic-regexp++ line start)
+ (setq org-lparse-link-description-is-image nil)
+ (setq start (match-beginning 0))
+ (setq path (save-match-data (org-link-unescape
+ (match-string 3 line))))
+ (setq type (cond
+ ((match-end 2) (match-string 2 line))
+ ((save-match-data
+ (or (file-name-absolute-p path)
+ (string-match "^\\.\\.?/" path)))
+ "file")
+ (t "internal")))
+ (setq path (org-extract-attributes (org-link-unescape path)))
+ (setq attr (get-text-property 0 'org-attributes path))
+ (setq desc1 (if (match-end 5) (match-string 5 line))
+ desc2 (if (match-end 2) (concat type ":" path) path)
+ descp (and desc1 (not (equal desc1 desc2)))
+ desc (or desc1 desc2))
+ ;; Make an image out of the description if that is so wanted
+ (when (and descp (org-file-image-p
+ desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (setq org-lparse-link-description-is-image t)
+ (save-match-data
+ (if (string-match "^file:" desc)
+ (setq desc (substring desc (match-end 0)))))
+ (save-match-data
+ (setq desc (org-add-props
+ (org-lparse-format 'INLINE-IMAGE desc)
+ '(org-protected t)))))
+ (cond
+ ((equal type "internal")
+ (let
+ ((frag-0
+ (if (= (string-to-char path) ?#)
+ (substring path 1)
+ path)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist "" "" (org-solidify-link-text
+ (save-match-data
+ (org-link-unescape frag-0))
+ nil) desc attr descp))))
+ ((and (equal type "id")
+ (setq id-file (org-id-find-id-file path)))
+ ;; This is an id: link to another file (if it was the same file,
+ ;; it would have become an internal link...)
+ (save-match-data
+ (setq id-file (file-relative-name
+ id-file
+ (file-name-directory org-current-export-file)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type id-file
+ (concat (if (org-uuidgen-p path) "ID-") path)
+ desc attr descp))))
+ ((member type '("http" "https"))
+ ;; standard URL, can inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+ ((member type '("ftp" "mailto" "news"))
+ ;; standard URL, can't inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+
+ ((string= type "coderef")
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type "" (format "coderef-%s" path)
+ (format
+ (org-export-get-coderef-format
+ path
+ (and descp desc))
+ (cdr (assoc path org-export-code-refs))) nil descp)))
+
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for format the link
+ (setq rpl
+ (save-match-data
+ (funcall fnc (org-link-unescape path) desc1 'html))))
+
+ ((string= type "file")
+ ;; FILE link
+ (save-match-data
+ (let*
+ ((components
+ (if
+ (string-match "::\\(.*\\)" path)
+ (list
+ (replace-match "" t nil path)
+ (match-string 1 path))
+ (list path nil)))
+
+ ;;The proper path, without a fragment
+ (path-1
+ (first components))
+
+ ;;The raw fragment
+ (fragment-0
+ (second components))
+
+ ;;Check the fragment. If it can't be used as
+ ;;target fragment we'll pass nil instead.
+ (fragment-1
+ (if
+ (and fragment-0
+ (not (string-match "^[0-9]*$" fragment-0))
+ (not (string-match "^\\*" fragment-0))
+ (not (string-match "^/.*/$" fragment-0)))
+ (org-solidify-link-text
+ (org-link-unescape fragment-0))
+ nil))
+ (desc-2
+ ;;Description minus "file:" and ".org"
+ (if (string-match "^file:" desc)
+ (let
+ ((desc-1 (replace-match "" t t desc)))
+ (if (string-match "\\.org$" desc-1)
+ (replace-match "" t t desc-1)
+ desc-1))
+ desc)))
+
+ (setq rpl
+ (if
+ (and
+ (functionp link-validate)
+ (not (funcall link-validate path-1 current-dir)))
+ desc
+ (org-lparse-format
+ 'ORG-LINK opt-plist "file" path-1 fragment-1
+ desc-2 attr descp))))))
+
+ (t
+ ;; just publish the path, as default
+ (setq rpl (concat "<" type ":"
+ (save-match-data (org-link-unescape path))
+ ">"))))
+ (setq line (replace-match rpl t t line)
+ start (+ start (length rpl))))
+ line))
+
+(defmacro with-org-lparse-preserve-paragraph-state (&rest body)
+ `(let ((org-lparse-do-open-par org-lparse-par-open))
+ (org-lparse-end-paragraph)
+ ,@body
+ (when org-lparse-do-open-par
+ (org-lparse-begin-paragraph))))
+
+(defvar org-lparse-native-backends
+ '("xhtml" "odt")
+ "List of native backends registered with `org-lparse'.
+All native backends must implement a get routine and a mandatory
+set of callback routines.
+
+The get routine must be named as org--get where backend
+is the name of the backend. The exporter uses `org-lparse-get'
+and retrieves the backend-specific callback by querying for
+ENTITY-CONTROL and ENTITY-FORMAT variables.
+
+For the sake of illustration, the html backend implements
+`org-xhtml-get'. It returns
+`org-xhtml-entity-control-callbacks-alist' and
+`org-xhtml-entity-format-callbacks-alist' as the values of
+ENTITY-CONTROL and ENTITY-FORMAT settings.")
+
+(defun org-lparse-get-other-backends (native-backend)
+ (org-lparse-backend-get native-backend 'OTHER-BACKENDS))
+
+(defun org-lparse-all-backends ()
+ (let (all-backends)
+ (flet ((add (other native)
+ (let ((val (assoc-string other all-backends t)))
+ (if val (setcdr val (nconc (list native) (cdr val)))
+ (push (cons other (list native)) all-backends)))))
+ (loop for backend in org-lparse-native-backends
+ do (loop for other in (org-lparse-get-other-backends backend)
+ do (add other backend))))
+ all-backends))
+
+(defun org-lparse-backend-is-native-p (backend)
+ (member backend org-lparse-native-backends))
+
+(defun org-lparse (target-backend native-backend arg
+ &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline to various formats.
+If there is an active region, export only the region. The outline
+is first exported to NATIVE-BACKEND and optionally converted to
+TARGET-BACKEND. See `org-lparse-native-backends' for list of
+known native backends. Each native backend can specify a
+converter and list of target backends it exports to using the
+CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
+method. See `org-xhtml-get' for an illustrative example.
+
+ARG is a prefix argument that specifies how many levels of
+outline should become headlines. The default is 3. Lower levels
+will become bulleted lists.
+
+HIDDEN is obsolete and does nothing.
+
+EXT-PLIST is a property list that controls various aspects of
+export. The settings here override org-mode's default settings
+and but are inferior to file-local settings.
+
+TO-BUFFER dumps the exported lines to a buffer or a string
+instead of a file. If TO-BUFFER is the symbol `string' return the
+exported lines as a string. If TO-BUFFER is non-nil, create a
+buffer with that name and export to that buffer.
+
+BODY-ONLY controls the presence of header and footer lines in
+exported text. If BODY-ONLY is non-nil, don't produce the file
+header and footer, simply return the content of ...,
+without even the body tags themselves.
+
+PUB-DIR specifies the publishing directory."
+ (interactive
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (all-backends (org-lparse-all-backends))
+ (target-backend
+ (funcall input "Export to: " all-backends nil t nil))
+ (native-backend
+ (or
+ ;; (and (org-lparse-backend-is-native-p target-backend)
+ ;; target-backend)
+ (funcall input "Use Native backend: "
+ (cdr (assoc target-backend all-backends)) nil t nil))))
+ (list target-backend native-backend current-prefix-arg)))
+ (let* ((org-lparse-backend (intern native-backend))
+ (org-lparse-other-backend (intern target-backend)))
+ (unless (org-lparse-backend-is-native-p native-backend)
+ (error "Don't know how to export natively to backend %s" native-backend))
+ (unless (or (not target-backend)
+ (equal target-backend native-backend)
+ (member target-backend (org-lparse-get 'OTHER-BACKENDS)))
+ (error "Don't know how to export to backend %s %s" target-backend
+ (format "via %s" native-backend)))
+ (run-hooks 'org-export-first-hook)
+ (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
+
+(defcustom org-export-convert-process
+ '("soffice" "-norestore" "-invisible" "-headless" "\"macro:///BasicODConverter.Main.Convert(%I,%f,%O)\"")
+ "Command to covert a Org exported format to other formats.
+The variable is an list of the form (PROCESS ARG1 ARG2 ARG3
+...). Format specifiers used in the ARGs are replaced as below.
+%i input file name in full
+%I input file name as a URL
+%f format of the output file
+%o output file name in full
+%O output file name as a URL
+%d output dir in full
+%D output dir as a URL"
+ :group 'org-export)
+
+(defun org-export-convert (&optional in-file fmt)
+ "Convert file from one format to another using a converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. FMT is the desired output format. If the
+backend has registered a CONVERT-METHOD via it's get function
+then that converter is used. Otherwise
+`org-export-conver-process' is used."
+ (interactive
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (in-file (read-file-name "File to be converted: "
+ nil buffer-file-name t))
+ (fmt (funcall input "Output format: "
+ (or (ignore-errors
+ (org-lparse-get-other-backends
+ (file-name-extension in-file)))
+ (org-lparse-all-backends))
+ nil nil nil)))
+ (list in-file fmt)))
+ (require 'browse-url)
+ (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
+ (fmt (or fmt "doc") )
+ (out-file (concat (file-name-sans-extension in-file) "." fmt))
+ (out-dir (file-name-directory in-file))
+ (backend (when (boundp 'org-lparse-backend) org-lparse-backend))
+ (convert-process
+ (or (ignore-errors (org-lparse-backend-get backend 'CONVERT-METHOD))
+ org-export-convert-process))
+ program arglist)
+
+ (setq program (and convert-process (consp convert-process)
+ (car convert-process)))
+ (unless (executable-find program)
+ (error "Unable to locate the converter %s" program))
+
+ (setq arglist
+ (mapcar (lambda (arg)
+ (format-spec arg `((?i . ,in-file)
+ (?I . ,(browse-url-file-url in-file))
+ (?f . ,fmt)
+ (?o . ,out-file)
+ (?O . ,(browse-url-file-url out-file))
+ (?d . ,out-dir)
+ (?D . ,(browse-url-file-url out-dir)))))
+ (cdr convert-process)))
+ (ignore-errors (delete-file out-file))
+
+ (message "Executing %s %s" program (mapconcat 'identity arglist " "))
+ (apply 'call-process program nil nil nil arglist)
+
+ (cond
+ ((file-exists-p out-file)
+ (message "Exported to %s using %s" out-file program)
+ out-file
+ ;; (set-buffer (find-file-noselect out-file))
+ )
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defvar org-lparse-insert-tag-with-newlines 'both)
+
+;; Following variables are let-bound during `org-lparse'
+(defvar org-lparse-dyn-first-heading-pos)
+(defvar org-lparse-toc)
+(defvar org-lparse-entity-control-callbacks-alist)
+(defvar org-lparse-entity-format-callbacks-alist)
+(defvar org-lparse-backend)
+(defvar org-lparse-body-only)
+(defvar org-lparse-to-buffer)
+(defun org-do-lparse (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline to various formats.
+See `org-lparse' for more information. This function is a
+html-agnostic version of the `org-export-as-html' function in 7.5
+version."
+ ;; Make sure we have a file name when we need it.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (org-lparse-warn
+ (format "Exporting to %s using org-lparse..."
+ (upcase (symbol-name
+ (or org-lparse-backend org-lparse-other-backend)))))
+
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (setq-default org-deadline-line-regexp org-deadline-line-regexp)
+ (setq-default org-done-keywords org-done-keywords)
+ (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
+ (let* (org-lparse-encode-pending
+ org-lparse-par-open
+ org-lparse-outline-text-open
+ (org-lparse-latex-fragment-fallback ; currently used only by
+ ; odt exporter
+ (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
+ (if (and (org-check-external-command "latex" "" t)
+ (org-check-external-command "dvipng" "" t))
+ 'dvipng
+ 'verbatim)))
+ (org-lparse-insert-tag-with-newlines 'both)
+ (org-lparse-to-buffer to-buffer)
+ (org-lparse-body-only body-only)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT))
+ (opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (body-only (or body-only (plist-get opt-plist :body-only)))
+ valid org-lparse-dyn-first-heading-pos
+ (odd org-odd-levels-only)
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (level 0) (line "") (origline "") txt todo
+ (umax nil)
+ (umax-toc nil)
+ (filename (if to-buffer nil
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory buffer-file-name)))
+ "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
+ (file-name-as-directory
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string)
+ (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect
+ (or (let ((f (org-lparse-get 'INIT-METHOD)))
+ (and f (functionp f) (funcall f filename)))
+ filename))))
+ (org-levels-open (make-vector org-level-max nil))
+ (date (plist-get opt-plist :date))
+ (date (cond
+ ((and date (string-match "%" date))
+ (format-time-string date))
+ (date date)
+ (t (format-time-string "%Y-%m-%d %T %Z"))))
+ (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
+ (title (org-xml-encode-org-text-skip-links
+ (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not body-only)
+ (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED")))
+ (dummy (setq opt-plist (plist-put opt-plist :title title)))
+ (html-table-tag (plist-get opt-plist :html-table-tag))
+ (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+ (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
+ (org-lparse-dyn-current-environment nil)
+ ;; Get the language-dependent settings
+ (lang-words (or (assoc (plist-get opt-plist :language)
+ org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+ (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
+ (head-count 0) cnt
+ (start 0)
+ (coding-system-for-write
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (save-buffer-coding-system
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (region
+ (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (org-export-have-math nil)
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (org-footnote-insert-pos-for-preprocessor 'point-min)
+ (lines
+ (org-split-string
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
+ 'html
+ org-lparse-backend)
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :add-text
+ (plist-get opt-plist :text)
+ :LaTeX-fragments
+ (plist-get opt-plist :LaTeX-fragments))
+ "[\r\n]"))
+ table-open
+ table-buffer table-orig-buffer
+ ind
+ rpl path attr desc descp desc1 desc2 link
+ snumber fnc
+ footnotes footref-seen
+ org-lparse-output-buffer
+ org-lparse-footnote-definitions
+ org-lparse-footnote-number
+ org-lparse-footnote-buffer
+ org-lparse-toc
+ href
+ )
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (message "Exporting...")
+ (org-init-section-numbers)
+
+ ;; Switch to the output buffer
+ (setq org-lparse-output-buffer buffer)
+ (set-buffer org-lparse-output-buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ (let ((case-fold-search nil)
+ (org-odd-levels-only odd))
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc (if (integerp org-export-with-toc)
+ (min org-export-with-toc umax)
+ umax))
+
+ (when (and org-export-with-toc (not body-only))
+ (setq lines (org-lparse-prepare-toc
+ lines level-offset opt-plist umax-toc)))
+
+ (unless body-only
+ (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
+ (org-lparse-begin 'DOCUMENT-BODY opt-plist))
+
+ (setq head-count 0)
+ (org-init-section-numbers)
+
+ (org-lparse-begin-paragraph)
+
+ (while (setq line (pop lines) origline line)
+ (catch 'nextline
+ (when (and (org-lparse-current-environment-p 'quote)
+ (string-match "^\\*+ " line))
+ (org-lparse-end-environment 'quote))
+
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-insert 'LINE line)
+ (throw 'nextline nil))
+
+ ;; Fixed-width, verbatim lines (examples)
+ (when (and org-export-with-fixed-width
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
+ (when (not (org-lparse-current-environment-p 'fixedwidth))
+ (org-lparse-begin-environment 'fixedwidth))
+ (org-lparse-insert 'LINE (match-string 3 line))
+ (when (or (not lines)
+ (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
+ (car lines))))
+ (org-lparse-end-environment 'fixedwidth))
+ (throw 'nextline nil))
+
+ ;; Notes: The baseline version of org-html.el (git commit
+ ;; 3d802e), while encoutering a *line-long* protected text,
+ ;; does one of the following two things based on the state
+ ;; of the export buffer.
+
+ ;; 1. If a paragraph element has just been opened and
+ ;; contains only whitespace as content, insert the
+ ;; protected text as part of the previous paragraph.
+
+ ;; 2. If the paragraph element has already been opened and
+ ;; contains some valid content insert the protected text
+ ;; as part of the current paragraph.
+
+ ;; I think --->
+
+ ;; Scenario 1 mentioned above kicks in when a block of
+ ;; protected text has to be inserted enbloc. For example,
+ ;; this happens, when inserting an source or example block
+ ;; or preformatted content enclosed in #+backend,
+ ;; #+begin_bakend ... #+end_backend)
+
+ ;; Scenario 2 mentioned above kicks in when the protected
+ ;; text is part of a running sentence. For example this
+ ;; happens in the case of an *multiline* LaTeX equation that
+ ;; needs to be inserted verbatim.
+
+ ;; org-html.el in the master branch seems to do some
+ ;; jugglery by moving paragraphs around. Inorder to make
+ ;; these changes backend-agnostic introduce a new text
+ ;; property org-native-text and impose the added semantics
+ ;; that these protected blocks appear outside of a
+ ;; conventional paragraph element.
+ ;;
+ ;; Extra Note: Check whether org-example and org-native-text
+ ;; are entirely equivalent.
+
+ ;; Fixes bug reported by Christian Moe concerning verbatim
+ ;; LaTeX fragments.
+ ;; on git commit 533ba3f90250a1f25f494c390d639ea6274f235c
+ ;; http://repo.or.cz/w/org-mode/org-jambu.git/shortlog/refs/heads/staging
+ ;; See http://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01379.html
+
+ ;; Native Text
+ (when (and (get-text-property 0 'org-native-text line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-native-text line) 10000)
+ (length line))))
+ (let ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-begin-environment 'native)
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-native-text (car lines))))
+ (org-lparse-insert 'LINE (pop lines)))
+ (org-lparse-end-environment 'native))
+ (throw 'nextline nil))
+
+ ;; Protected HTML
+ (when (and (get-text-property 0 'org-protected line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-protected line) 10000)
+ (length line))))
+ (let ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-protected (car lines))))
+ (org-lparse-insert 'LINE (pop lines))))
+ (throw 'nextline nil))
+
+ ;; Blockquotes, verse, and center
+ (when (string-match "^ORG-\\(.+\\)-\\(START\\|END\\)$" line)
+ (let* ((style (intern (downcase (match-string 1 line))))
+ (f (cdr (assoc (match-string 2 line)
+ '(("START" . org-lparse-begin-environment)
+ ("END" . org-lparse-end-environment))))))
+ (when (memq style '(blockquote verse center))
+ (funcall f style)
+ (throw 'nextline nil))))
+
+ (run-hooks 'org-export-html-after-blockquotes-hook)
+ (when (org-lparse-current-environment-p 'verse)
+ (let ((i (org-get-string-indentation line)))
+ (if (> i 0)
+ (setq line (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'SPACES (* 2 i)))
+ " " (org-trim line))))
+ (unless (string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (concat line "\\\\")))))
+
+ ;; make targets to anchors
+ (setq start 0)
+ (while (string-match
+ "<<\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
+ (cond
+ ((get-text-property (match-beginning 1) 'org-protected line)
+ (setq start (match-end 1)))
+ ((match-end 2)
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR "" (org-solidify-link-text
+ (match-string 1 line))))
+ t t line)))
+ ((and org-export-with-toc (equal (string-to-char line) ?*))
+ ;; FIXME: NOT DEPENDENT on TOC?????????????????????
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'FONTIFY (match-string 1 line) "target"))
+ ;; (concat "@" (match-string 1 line) "@ ")
+ t t line)))
+ (t
+ (setq line (replace-match
+ (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR (match-string 1 line)
+ (org-solidify-link-text (match-string 1 line))
+ "target")) " ")
+ t t line)))))
+
+ (let ((org-lparse-encode-pending t))
+ (setq line (org-lparse-handle-time-stamps line)))
+
+ ;; replace "&" by "&", "<" and ">" by "<" and ">"
+ ;; handle @<..> HTML tags (replace "@>..<" by "<..>")
+ ;; Also handle sub_superscripts and checkboxes
+ (or (string-match org-table-hline-regexp line)
+ (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
+ (setq line (org-xml-encode-org-text-skip-links line)))
+
+ (setq line (org-lparse-format-org-link line opt-plist))
+
+ ;; TODO items
+ (if (and (string-match org-todo-line-regexp line)
+ (match-beginning 2))
+ (setq line (concat
+ (substring line 0 (match-beginning 2))
+ (org-lparse-format 'TODO (match-string 2 line))
+ (substring line (match-end 2)))))
+
+ ;; Does this contain a reference to a footnote?
+ (when org-export-with-footnotes
+ (setq start 0)
+ (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
+ ;; Discard protected matches not clearly identified as
+ ;; footnote markers.
+ (if (or (get-text-property (match-beginning 2) 'org-protected line)
+ (not (get-text-property (match-beginning 2) 'org-footnote line)))
+ (setq start (match-end 2))
+ (let ((n (match-string 2 line)) refcnt a)
+ (if (setq a (assoc n footref-seen))
+ (progn
+ (setcdr a (1+ (cdr a)))
+ (setq refcnt (cdr a)))
+ (setq refcnt 1)
+ (push (cons n 1) footref-seen))
+ (setq line
+ (replace-match
+ (concat
+ (or (match-string 1 line) "")
+ (org-lparse-format
+ 'FOOTNOTE-REFERENCE
+ n (cdr (assoc n org-lparse-footnote-definitions))
+ refcnt)
+ ;; If another footnote is following the
+ ;; current one, add a separator.
+ (if (save-match-data
+ (string-match "\\`\\[[0-9]+\\]"
+ (substring line (match-end 0))))
+ (ignore-errors
+ (org-lparse-get 'FOOTNOTE-SEPARATOR))
+ ""))
+ t t line))))))
+
+ (cond
+ ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
+ ;; This is a headline
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (unless org-lparse-dyn-first-heading-pos
+ (setq org-lparse-dyn-first-heading-pos (point)))
+ (org-lparse-begin-level level txt umax head-count)
+
+ ;; QUOTES
+ (when (string-match quote-re line)
+ (org-lparse-begin-environment 'quote)))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ (when (not table-open)
+ ;; New table starts
+ (setq table-open t table-buffer nil table-orig-buffer nil))
+
+ ;; Accumulate lines
+ (setq table-buffer (cons line table-buffer)
+ table-orig-buffer (cons origline table-orig-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer)
+ table-orig-buffer (nreverse table-orig-buffer))
+ (org-lparse-end-paragraph)
+ (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
+
+ ;; Normal lines
+
+ (t
+ ;; This line either is list item or end a list.
+ (when (get-text-property 0 'list-item line)
+ (setq line (org-lparse-export-list-line
+ line
+ (get-text-property 0 'list-item line)
+ (get-text-property 0 'list-struct line)
+ (get-text-property 0 'list-prevs line))))
+
+ ;; Horizontal line
+ (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
+ (with-org-lparse-preserve-paragraph-state
+ (org-lparse-insert 'HORIZONTAL-LINE))
+ (throw 'nextline nil))
+
+ ;; Empty lines start a new paragraph. If hand-formatted lists
+ ;; are not fully interpreted, lines starting with "-", "+", "*"
+ ;; also start a new paragraph.
+ (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
+ (when org-lparse-footnote-number
+ (org-lparse-end-footnote-definition org-lparse-footnote-number)
+ (setq org-lparse-footnote-number nil))
+ (org-lparse-begin-paragraph))
+
+ ;; Is this the start of a footnote?
+ (when org-export-with-footnotes
+ (when (and (boundp 'footnote-section-tag-regexp)
+ (string-match (concat "^" footnote-section-tag-regexp)
+ line))
+ ;; ignore this line
+ (throw 'nextline nil))
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
+ (org-lparse-end-paragraph)
+ (setq org-lparse-footnote-number (match-string 1 line))
+ (setq line (replace-match "" t t line))
+ (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
+ ;; Check if the line break needs to be conserved
+ (cond
+ ((string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (replace-match
+ (org-lparse-format 'LINE-BREAK)
+ t t line)))
+ (org-export-preserve-breaks
+ (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
+
+ ;; Check if a paragraph should be started
+ (let ((start 0))
+ (while (and org-lparse-par-open
+ (string-match "\\\\par\\>" line start))
+ (error "FIXME")
+ ;; Leave a space in the
so that the footnote matcher
+ ;; does not see this.
+ (if (not (get-text-property (match-beginning 0)
+ 'org-protected line))
+ (setq line (replace-match "
" t t line)))
+ (setq start (match-end 0))))
+
+ (org-lparse-insert 'LINE line)))))
+
+ ;; Properly close all local lists and other lists
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-end-environment 'quote))
+
+ (org-lparse-end-level 1 umax)
+
+ ;; the to close the last text-... div.
+ (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
+ (org-lparse-end-outline-text-or-outline))
+
+ (org-lparse-end 'DOCUMENT-BODY opt-plist)
+ (unless body-only
+ (org-lparse-end 'DOCUMENT-CONTENT))
+
+ (unless (plist-get opt-plist :buffer-will-be-killed)
+ (set-auto-mode t))
+
+ (org-lparse-end 'EXPORT)
+
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring
+ (upcase (symbol-name org-lparse-backend)))
+ (message "Exporting... done"))
+
+ (cond
+ ((not to-buffer)
+ (let ((f (org-lparse-get 'SAVE-METHOD)))
+ (or (and f (functionp f) (funcall f filename opt-plist))
+ (save-buffer)))
+ (or (when (and (boundp 'org-lparse-other-backend)
+ org-lparse-other-backend
+ (not (equal org-lparse-backend org-lparse-other-backend)))
+ (let ((org-export-convert-process (org-lparse-get 'CONVERT-METHOD)))
+ (when org-export-convert-process
+ (org-export-convert buffer-file-name
+ (symbol-name org-lparse-other-backend)))))
+ (current-buffer)))
+ ((eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer))))
+ (t (current-buffer))))))
+
+(defun org-lparse-format-table (lines olines)
+ "Retuns backend-specific code for org-type and table-type
+tables."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (string-match "^[ \t]*|" (car lines))
+ ;; A normal org table
+ (org-lparse-format-org-table lines nil)
+ ;; Table made by table.el
+ (or (org-lparse-format-table-table-using-table-generate-source
+ org-lparse-backend olines
+ (not org-export-prefer-native-exporter-for-tables))
+ ;; We are here only when table.el table has NO col or row
+ ;; spanning and the user prefers using org's own converter for
+ ;; exporting of such simple table.el tables.
+ (org-lparse-format-table-table lines))))
+
+(defun org-lparse-table-get-colalign-info (lines)
+ (let ((forced-aligns (org-find-text-property-in-string
+ 'org-forced-aligns (car lines))))
+ (when (and forced-aligns org-table-clean-did-remove-column)
+ (setq forced-aligns
+ (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
+
+ forced-aligns))
+
+(defvar org-lparse-table-style)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-num-numeric-items-per-column)
+(defvar org-lparse-table-colalign-info)
+(defvar org-lparse-table-colalign-vector)
+
+;; Following variables are defined in org-table.el
+(defvar org-table-number-fraction)
+(defvar org-table-number-regexp)
+
+(defun org-lparse-do-format-org-table (lines &optional splice)
+ "Format a org-type table into backend-specific code.
+LINES is a list of lines. Optional argument SPLICE means, do not
+insert header and surrounding
tags, just format the lines.
+Optional argument NO-CSS means use XHTML attributes instead of CSS
+for formatting. This is required for the DocBook exporter."
+ (require 'org-table)
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; column and the special lines
+ (setq lines (org-table-clean-before-export lines)))
+
+ (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
+ (caption (and caption (org-xml-encode-org-text caption)))
+ (label (org-find-text-property-in-string 'org-label (car lines)))
+ (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
+ (attributes (org-find-text-property-in-string 'org-attributes
+ (car lines)))
+ (head (and org-export-highlight-first-table-line
+ (delq nil (mapcar
+ (lambda (x) (string-match "^[ \t]*|-" x))
+ (cdr lines)))))
+ (org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
+ tbopen line fields
+ org-lparse-table-cur-rowgrp-is-hdr
+ org-lparse-table-rowgrp-open
+ org-lparse-table-num-numeric-items-per-column
+ org-lparse-table-colalign-vector n
+ org-lparse-table-rowgrp-info
+ org-lparse-table-begin-marker
+ (org-lparse-table-style 'org-table)
+ org-lparse-table-is-styled)
+ (cond
+ (splice
+ (setq org-lparse-table-is-styled nil)
+ (while (setq line (pop lines))
+ (unless (string-match "^[ \t]*|-" line)
+ (insert
+ (org-lparse-format-table-row
+ (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
+ (t
+ (setq org-lparse-table-is-styled t)
+ (org-lparse-begin 'TABLE caption label attributes)
+ (setq org-lparse-table-begin-marker (point))
+ (org-lparse-begin-table-rowgroup head)
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*|-" line)
+ (when lines (org-lparse-begin-table-rowgroup)))
+ (t
+ (insert
+ (org-lparse-format-table-row
+ (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
+ (org-lparse-end 'TABLE-ROWGROUP)
+ (org-lparse-end-table)))))
+
+(defun org-lparse-format-org-table (lines &optional splice)
+ (with-temp-buffer
+ (org-lparse-do-format-org-table lines splice)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-do-format-table-table (lines)
+ "Format a table generated by table.el into backend-specific code.
+This conversion does *not* use `table-generate-source' from table.el.
+This has the advantage that Org-mode's HTML conversions can be used.
+But it has the disadvantage, that no cell- or row-spanning is allowed."
+ (let (line field-buffer
+ (org-lparse-table-cur-rowgrp-is-hdr
+ org-export-highlight-first-table-line)
+ (caption nil)
+ (attributes nil)
+ (label nil)
+ (org-lparse-table-style 'table-table)
+ (org-lparse-table-is-styled nil)
+ fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
+ (empty (org-lparse-format 'SPACES 1)))
+ (org-lparse-begin 'TABLE caption label attributes)
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*\\+-" line)
+ (when field-buffer
+ (let ((org-export-table-row-tags '("
" . "
"))
+ ;; (org-export-html-table-use-header-tags-for-first-column nil)
+ )
+ (insert (org-lparse-format-table-row field-buffer empty)))
+ (setq org-lparse-table-cur-rowgrp-is-hdr nil)
+ (setq field-buffer nil)))
+ (t
+ ;; Break the line into fields and store the fields
+ (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (if field-buffer
+ (setq field-buffer (mapcar
+ (lambda (x)
+ (concat x (org-lparse-format 'LINE-BREAK)
+ (pop fields)))
+ field-buffer))
+ (setq field-buffer fields)))))
+ (org-lparse-end-table)))
+
+(defun org-lparse-format-table-table (lines)
+ (with-temp-buffer
+ (org-lparse-do-format-table-table lines)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-format-table-table-using-table-generate-source (backend
+ lines
+ &optional
+ spanned-only)
+ "Format a table into BACKEND, using `table-generate-source' from table.el.
+Use SPANNED-ONLY to suppress exporting of simple table.el tables.
+
+When SPANNED-ONLY is nil, all table.el tables are exported. When
+SPANNED-ONLY is non-nil, only tables with either row or column
+spans are exported.
+
+This routine returns the generated source or nil as appropriate.
+
+Refer docstring of `org-export-prefer-native-exporter-for-tables'
+for further information."
+ (require 'table)
+ (with-current-buffer (get-buffer-create " org-tmp1 ")
+ (erase-buffer)
+ (insert (mapconcat 'identity lines "\n"))
+ (goto-char (point-min))
+ (if (not (re-search-forward "|[^+]" nil t))
+ (error "Error processing table"))
+ (table-recognize-table)
+ (when (or (not spanned-only)
+ (let* ((dim (table-query-dimension))
+ (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
+ (not (= (* c r) cells))))
+ (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
+ (cond
+ ((member backend table-source-languages)
+ (table-generate-source backend " org-tmp2 ")
+ (set-buffer " org-tmp2 ")
+ (buffer-substring (point-min) (point-max)))
+ (t
+ ;; table.el doesn't support the given backend. Currently this
+ ;; happens in case of odt export. Strip the table from the
+ ;; generated document. A better alternative would be to embed
+ ;; the table as ascii text in the output document.
+ (org-lparse-warn
+ (concat
+ "Found table.el-type table in the source org file. "
+ (format "table.el doesn't support %s backend. "
+ (upcase (symbol-name backend)))
+ "Skipping ahead ..."))
+ "")))))
+
+(defun org-lparse-handle-time-stamps (s)
+ "Format time stamps in string S, or remove them."
+ (catch 'exit
+ (let (r b)
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (or b (setq b (substring s 0 (match-beginning 0))))
+ (setq r (concat
+ r (substring s 0 (match-beginning 0))
+ (org-lparse-format
+ 'FONTIFY
+ (concat
+ (if (match-end 1)
+ (org-lparse-format
+ 'FONTIFY
+ (match-string 1 s) "timestamp-kwd"))
+ (org-lparse-format
+ 'FONTIFY
+ (substring (org-translate-time (match-string 3 s)) 1 -1)
+ "timestamp"))
+ "timestamp-wrapper"))
+ s (substring s (match-end 0))))
+ ;; Line break if line started and ended with time stamp stuff
+ (if (not r)
+ s
+ (setq r (concat r s))
+ (unless (string-match "\\S-" (concat b s))
+ (setq r (concat r (org-lparse-format 'LINE-BREAK))))
+ r))))
+
+(defun org-xml-encode-plain-text (s)
+ "Convert plain text characters to HTML equivalent.
+Possible conversions are set in `org-export-html-protect-char-alist'."
+ (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
+ (while (setq c (pop cl))
+ (let ((start 0))
+ (while (string-match (car c) s start)
+ (setq s (replace-match (cdr c) t t s)
+ start (1+ (match-beginning 0))))))
+ s))
+
+(defun org-xml-encode-org-text-skip-links (string)
+ "Prepare STRING for HTML export. Apply all active conversions.
+If there are links in the string, don't modify these."
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-xml-encode-org-text s) res)
+ (push l res))
+ (push (org-xml-encode-org-text string) res)
+ (apply 'concat (nreverse res))))
+
+(defun org-xml-encode-org-text (s)
+ "Apply all active conversions to translate special ASCII to HTML."
+ (setq s (org-xml-encode-plain-text s))
+ (if org-export-html-expand
+ (while (string-match "@<\\([^&]*\\)>" s)
+ (setq s (replace-match "<\\1>" t nil s))))
+ (if org-export-with-emphasize
+ (setq s (org-lparse-apply-char-styles s)))
+ (if org-export-with-special-strings
+ (setq s (org-lparse-convert-special-strings s)))
+ (if org-export-with-sub-superscripts
+ (setq s (org-lparse-apply-sub-superscript-styles s)))
+ (if org-export-with-TeX-macros
+ (let ((start 0) wd rep)
+ (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
+ s start))
+ (if (get-text-property (match-beginning 0) 'org-protected s)
+ (setq start (match-end 0))
+ (setq wd (match-string 1 s))
+ (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
+ (setq s (replace-match rep t t s))
+ (setq start (+ start (length wd))))))))
+ s)
+
+(defun org-lparse-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (if (get-text-property (match-beginning 0) 'org-protected string)
+ (setq start (match-end 0))
+ (setq string (replace-match rpl t nil string)))))
+ string))
+
+(defun org-lparse-apply-sub-superscript-styles (string)
+ "Apply subscript and superscript styles to STRING.
+Use `org-export-with-sub-superscripts' to control application of
+sub and superscript styles."
+ (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
+ (while (string-match org-match-substring-regexp string s)
+ (cond
+ ((and requireb (match-end 8)) (setq s (match-end 2)))
+ ((get-text-property (match-beginning 2) 'org-protected string)
+ (setq s (match-end 2)))
+ (t
+ (setq s (match-end 1)
+ key (if (string= (match-string 2 string) "_")
+ 'subscript 'superscript)
+ c (or (match-string 8 string)
+ (match-string 6 string)
+ (match-string 5 string))
+ string (replace-match
+ (concat (match-string 1 string)
+ (org-lparse-format 'FONTIFY c key))
+ t t string)))))
+ (while (string-match "\\\\\\([_^]\\)" string)
+ (setq string (replace-match (match-string 1 string) t t string)))
+ string))
+
+(defvar org-lparse-char-styles
+ `(("*" bold)
+ ("/" emphasis)
+ ("_" underline)
+ ("=" code)
+ ("~" verbatim)
+ ("+" strike))
+ "Map Org emphasis markers to char styles.
+This is an alist where each element is of the
+form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
+
+(defun org-lparse-apply-char-styles (string)
+ "Apply char styles to STRING.
+The variable `org-lparse-char-styles' controls how the Org
+emphasis markers are interpreted."
+ (let ((s 0) rpl)
+ (while (string-match org-emph-re string s)
+ (if (not (equal
+ (substring string (match-beginning 3) (1+ (match-beginning 3)))
+ (substring string (match-beginning 4) (1+ (match-beginning 4)))))
+ (setq s (match-beginning 0)
+ rpl
+ (concat
+ (match-string 1 string)
+ (org-lparse-format
+ 'FONTIFY (match-string 4 string)
+ (nth 1 (assoc (match-string 3 string)
+ org-lparse-char-styles)))
+ (match-string 5 string))
+ string (replace-match rpl t t string)
+ s (+ s (- (length rpl) 2)))
+ (setq s (1+ s))))
+ string))
+
+(defun org-lparse-export-list-line (line pos struct prevs)
+ "Insert list syntax in export buffer. Return LINE, maybe modified.
+
+POS is the item position or line position the line had before
+modifications to buffer. STRUCT is the list structure. PREVS is
+the alist of previous items."
+ (let* ((get-type
+ (function
+ ;; Translate type of list containing POS to "d", "o" or
+ ;; "u".
+ (lambda (pos struct prevs)
+ (let ((type (org-list-get-list-type pos struct prevs)))
+ (cond
+ ((eq 'ordered type) "o")
+ ((eq 'descriptive type) "d")
+ (t "u"))))))
+ (get-closings
+ (function
+ ;; Return list of all items and sublists ending at POS, in
+ ;; reverse order.
+ (lambda (pos)
+ (let (out)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((end (nth 6 e))
+ (item (car e)))
+ (cond
+ ((= end pos) (push item out))
+ ((>= item pos) (throw 'exit nil)))))
+ struct))
+ out)))))
+ ;; First close any previous item, or list, ending at POS.
+ (mapc (lambda (e)
+ (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
+ (first-item (org-list-get-list-begin e struct prevs))
+ (type (funcall get-type first-item struct prevs)))
+ (org-lparse-end-paragraph)
+ ;; Ending for every item
+ (org-lparse-end-list-item type)
+ ;; We're ending last item of the list: end list.
+ (when lastp
+ (org-lparse-end 'LIST type)
+ (org-lparse-begin-paragraph))))
+ (funcall get-closings pos))
+ (cond
+ ;; At an item: insert appropriate tags in export buffer.
+ ((assq pos struct)
+ (string-match
+ (concat "[ \t]*\\(\\S-+[ \t]*\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?"
+ "\\(.*\\)") line)
+ (let* ((checkbox (match-string 3 line))
+ (desc-tag (or (match-string 4 line) "???"))
+ (body (or (match-string 5 line) ""))
+ (list-beg (org-list-get-list-begin pos struct prevs))
+ (firstp (= list-beg pos))
+ ;; Always refer to first item to determine list type, in
+ ;; case list is ill-formed.
+ (type (funcall get-type list-beg struct prevs))
+ (counter (let ((count-tmp (org-list-get-counter pos struct)))
+ (cond
+ ((not count-tmp) nil)
+ ((string-match "[A-Za-z]" count-tmp)
+ (- (string-to-char (upcase count-tmp)) 64))
+ ((string-match "[0-9]+" count-tmp)
+ count-tmp)))))
+ (when firstp
+ (org-lparse-end-paragraph)
+ (org-lparse-begin 'LIST type))
+
+ (let ((arg (cond ((equal type "d") desc-tag)
+ ((equal type "o") counter))))
+ (org-lparse-begin 'LIST-ITEM type arg))
+
+ ;; If line had a checkbox, some additional modification is required.
+ (when checkbox
+ (setq body
+ (concat
+ (org-lparse-format
+ 'FONTIFY (concat
+ "["
+ (cond
+ ((string-match "X" checkbox) "X")
+ ((string-match " " checkbox)
+ (org-lparse-format 'SPACES 1))
+ (t "-"))
+ "]")
+ 'code)
+ " "
+ body)))
+ ;; Return modified line
+ body))
+ ;; At a list ender: go to next line (side-effects only).
+ ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
+ ;; Not at an item: return line unchanged (side-effects only).
+ (t line))))
+
+(defun org-lparse-bind-local-variables (opt-plist)
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars))
+
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-footnote-number)
+(defvar org-lparse-footnote-definitions)
+(defvar org-lparse-footnote-buffer)
+(defvar org-lparse-output-buffer)
+
+(defcustom org-lparse-debug nil
+ "."
+ :group 'org-lparse
+ :type 'boolean)
+
+(defun org-lparse-begin (entity &rest args)
+ "Begin ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
+
+Use (org-lparse-begin 'LIST \"o\") to begin a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
+
+ (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-end (entity &rest args)
+ "Close ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
+etc.
+
+Use (org-lparse-end 'LIST \"o\") to close a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
+
+ (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-begin-paragraph (&optional style)
+ "Insert
, but first close previous paragraph if any."
+ (org-lparse-end-paragraph)
+ (org-lparse-begin 'PARAGRAPH style)
+ (setq org-lparse-par-open t))
+
+(defun org-lparse-end-paragraph ()
+ "Close paragraph if there is one open."
+ (when org-lparse-par-open
+ (org-lparse-end 'PARAGRAPH)
+ (setq org-lparse-par-open nil)))
+
+(defun org-lparse-end-list-item (&optional type)
+ "Close
if necessary."
+ (org-lparse-end-paragraph)
+ (org-lparse-end 'LIST-ITEM (or type "u")))
+
+(defvar org-lparse-dyn-current-environment nil)
+(defun org-lparse-begin-environment (style)
+ (assert (not org-lparse-dyn-current-environment) t)
+ (setq org-lparse-dyn-current-environment style)
+ (org-lparse-begin 'ENVIRONMENT style))
+
+(defun org-lparse-end-environment (style)
+ (org-lparse-end 'ENVIRONMENT style)
+
+ (assert (eq org-lparse-dyn-current-environment style) t)
+ (setq org-lparse-dyn-current-environment nil))
+
+(defun org-lparse-current-environment-p (style)
+ (eq org-lparse-dyn-current-environment style))
+
+(defun org-lparse-begin-footnote-definition (n)
+ (unless org-lparse-footnote-buffer
+ (setq org-lparse-footnote-buffer
+ (get-buffer-create "*Org HTML Export Footnotes*")))
+ (set-buffer org-lparse-footnote-buffer)
+ (erase-buffer)
+ (setq org-lparse-insert-tag-with-newlines nil)
+ (org-lparse-begin 'FOOTNOTE-DEFINITION n))
+
+(defun org-lparse-end-footnote-definition (n)
+ (org-lparse-end 'FOOTNOTE-DEFINITION n)
+ (setq org-lparse-insert-tag-with-newlines 'both)
+ (push (cons n (buffer-string)) org-lparse-footnote-definitions)
+ (set-buffer org-lparse-output-buffer))
+
+(defun org-lparse-format (entity &rest args)
+ "Format ENTITY in backend-specific way and return it.
+ARGS is specific to entity being formatted.
+
+Use (org-lparse-format 'HEADING \"text\" 1) to format text as
+level 1 heading.
+
+See `org-xhtml-entity-format-callbacks-alist' for more information."
+ (when (and (member org-lparse-debug '(t format))
+ (not (equal entity 'COMMENT)))
+ (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
+ (cond
+ ((consp entity)
+ (let ((text (pop args)))
+ (apply 'org-lparse-format 'TAGS entity text args)))
+ (t
+ (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))))
+
+(defun org-lparse-insert (entity &rest args)
+ (insert (apply 'org-lparse-format entity args)))
+
+(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
+ (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+ (org-min-level (org-get-min-level lines level-offset))
+ (org-last-level org-min-level)
+ level)
+ (with-temp-buffer
+ (org-lparse-bind-local-variables opt-plist)
+ (erase-buffer)
+ (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)))
+ (setq
+ lines
+ (mapcar
+ #'(lambda (line)
+ (when (and (string-match org-todo-line-regexp line)
+ (not (get-text-property 0 'org-protected line))
+ (<= (setq level (org-tr-level
+ (- (match-end 1) (match-beginning 1)
+ level-offset)))
+ umax-toc))
+ (let ((txt (save-match-data
+ (org-xml-encode-org-text-skip-links
+ (org-export-cleanup-toc-line
+ (match-string 3 line)))))
+ (todo (and
+ org-export-mark-todo-in-toc
+ (or (and (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
+ (and (= level umax-toc)
+ (org-search-todo-below
+ line lines level)))))
+ tags)
+ ;; Check for targets
+ (while (string-match org-any-target-regexp line)
+ (setq line
+ (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'FONTIFY
+ (match-string 1 line) "target"))
+ t t line)))
+ (when (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq tags (match-string 1 txt)
+ txt (replace-match "" t nil txt)))
+ (when (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt)
+ (setq txt (replace-match "" t t txt)))
+ (org-lparse-format
+ 'TOC-ITEM
+ (let* ((snumber (org-section-number level))
+ (href (replace-regexp-in-string
+ "\\." "-" (format "sec-%s" snumber)))
+ (href
+ (or
+ (cdr (assoc
+ href org-export-preferred-target-alist))
+ href))
+ (href (org-solidify-link-text href)))
+ (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
+ level org-last-level)
+ (setq org-last-level level)))
+ line)
+ lines))
+ (org-lparse-end 'TOC)
+ (setq org-lparse-toc (buffer-string))))
+ lines)
+
+(defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
+ (unless org-lparse-table-ncols
+ ;; first row of the table
+ (setq org-lparse-table-ncols (length fields))
+ (when org-lparse-table-is-styled
+ (setq org-lparse-table-num-numeric-items-per-column
+ (make-vector org-lparse-table-ncols 0))
+ (setq org-lparse-table-colalign-vector
+ (make-vector org-lparse-table-ncols nil))
+ (let ((c -1))
+ (while (< (incf c) org-lparse-table-ncols)
+ (let ((cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))))
+ (setf (aref org-lparse-table-colalign-vector c)
+ (cond
+ ((string= cookie "l") "left")
+ ((string= cookie "r") "right")
+ ((string= cookie "c") "center")
+ (t nil))))))))
+ (incf org-lparse-table-rownum)
+ (let ((i -1))
+ (org-lparse-format
+ 'TABLE-ROW
+ (mapconcat
+ (lambda (x)
+ (when (and (string= x "") text-for-empty-fields)
+ (setq x text-for-empty-fields))
+ (incf i)
+ (and org-lparse-table-is-styled
+ (< i org-lparse-table-ncols)
+ (string-match org-table-number-regexp x)
+ (incf (aref org-lparse-table-num-numeric-items-per-column i)))
+ (org-lparse-format 'TABLE-CELL x org-lparse-table-rownum i))
+ fields "\n"))))
+
+(defun org-lparse-get (what &optional opt-plist)
+ "Query for value of WHAT for the current backend `org-lparse-backend'.
+See also `org-lparse-backend-get'."
+ (if (boundp 'org-lparse-backend)
+ (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
+ (error "org-lparse-backend is not bound yet")))
+
+(defun org-lparse-backend-get (backend what &optional opt-plist)
+ "Query BACKEND for value of WHAT.
+Dispatch the call to `org--user-get'. If that throws an
+error, dispatch the call to `org--get'. See
+`org-xhtml-get' for all known settings queried for by
+`org-lparse' during the course of export."
+ (assert (stringp backend) t)
+ (unless (org-lparse-backend-is-native-p backend)
+ (error "Unknown native backend %s" backend))
+ (let ((backend-get-method (intern (format "org-%s-get" backend)))
+ (backend-user-get-method (intern (format "org-%s-user-get" backend))))
+ (cond
+ ((functionp backend-get-method)
+ (condition-case nil
+ (funcall backend-user-get-method what opt-plist)
+ (error (funcall backend-get-method what opt-plist))))
+ (t
+ (error "Native backend %s doesn't define %s" backend backend-get-method)))))
+
+(defun org-lparse-insert-tag (tag &rest args)
+ (when (member org-lparse-insert-tag-with-newlines '(lead both))
+ (insert "\n"))
+ (insert (apply 'format tag args))
+ (when (member org-lparse-insert-tag-with-newlines '(trail both))
+ (insert "\n")))
+
+(defun org-lparse-get-targets-from-title (title)
+ (let* ((target (org-get-text-property-any 0 'target title))
+ (extra-targets (assoc target org-export-target-aliases))
+ (target (or (cdr (assoc target org-export-preferred-target-alist))
+ target)))
+ (cons target (remove target extra-targets))))
+
+(defun org-lparse-suffix-from-snumber (snumber)
+ (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
+ (href (cdr (assoc (concat "sec-" snu)
+ org-export-preferred-target-alist))))
+ (org-solidify-link-text (or href snu))))
+
+(defun org-lparse-begin-level (level title umax head-count)
+ "Insert a new LEVEL in HTML export.
+When TITLE is nil, just close all open levels."
+ (org-lparse-end-level level umax)
+ (unless title (error "Why is heading nil"))
+ (let* ((targets (org-lparse-get-targets-from-title title))
+ (target (car targets)) (extra-targets (cdr targets))
+ (target (and target (org-solidify-link-text target)))
+ (extra-class (org-get-text-property-any 0 'html-container-class title))
+ snumber tags level1 class)
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq tags (and org-export-with-tags (match-string 1 title)))
+ (setq title (replace-match "" t t title)))
+ (if (> level umax)
+ (progn
+ (if (aref org-levels-open (1- level))
+ (org-lparse-end-list-item)
+ (aset org-levels-open (1- level) t)
+ (org-lparse-end-paragraph)
+ (org-lparse-begin 'LIST 'unordered))
+ (org-lparse-begin
+ 'LIST-ITEM 'unordered target
+ (org-lparse-format 'HEADLINE title extra-targets tags)))
+ (aset org-levels-open (1- level) t)
+ (setq snumber (org-section-number level))
+ (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
+ (unless (= head-count 1)
+ (org-lparse-end-outline-text-or-outline))
+ (org-lparse-begin-outline-and-outline-text
+ level1 snumber title tags target extra-targets extra-class)
+ (org-lparse-begin-paragraph))))
+
+(defun org-lparse-end-level (level umax)
+ (org-lparse-end-paragraph)
+ (loop for l from org-level-max downto level
+ do (when (aref org-levels-open (1- l))
+ ;; Terminate one level in HTML export
+ (if (<= l umax)
+ (org-lparse-end-outline-text-or-outline)
+ (org-lparse-end-list-item)
+ (org-lparse-end 'LIST 'unordered))
+ (aset org-levels-open (1- l) nil))))
+
+(defvar org-lparse-outline-text-open)
+(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
+ target extra-targets
+ extra-class)
+ (org-lparse-begin
+ 'OUTLINE level1 snumber title tags target extra-targets extra-class)
+ (org-lparse-begin-outline-text level1 snumber extra-class))
+
+(defun org-lparse-end-outline-text-or-outline ()
+ (cond
+ (org-lparse-outline-text-open
+ (org-lparse-end 'OUTLINE-TEXT)
+ (setq org-lparse-outline-text-open nil))
+ (t (org-lparse-end 'OUTLINE))))
+
+(defun org-lparse-begin-outline-text (level1 snumber extra-class)
+ (assert (not org-lparse-outline-text-open) t)
+ (setq org-lparse-outline-text-open t)
+ (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
+
+(defun org-lparse-html-list-type-to-canonical-list-type (ltype)
+ (cdr (assoc ltype '(("o" . ordered)
+ ("u" . unordered)
+ ("d" . description)))))
+
+(defvar org-lparse-table-rowgrp-info)
+(defun org-lparse-begin-table-rowgroup (&optional is-header-row)
+ (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
+ (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
+
+(defun org-lparse-end-table ()
+ (when org-lparse-table-is-styled
+ ;; column groups
+ (unless (car org-table-colgroup-info)
+ (setq org-table-colgroup-info
+ (cons :start (cdr org-table-colgroup-info))))
+
+ ;; column alignment
+ (let ((c -1))
+ (mapc
+ (lambda (x)
+ (incf c)
+ (setf (aref org-lparse-table-colalign-vector c)
+ (or (aref org-lparse-table-colalign-vector c)
+ (if (> (/ (float x) (1+ org-lparse-table-rownum))
+ org-table-number-fraction)
+ "right" "left"))))
+ org-lparse-table-num-numeric-items-per-column)))
+ (org-lparse-end 'TABLE))
+
+(defvar org-lparse-encode-pending nil)
+
+(defun org-lparse-format-tags (tag text prefix suffix &rest args)
+ (cond
+ ((consp tag)
+ (concat prefix (apply 'format (car tag) args) text suffix
+ (format (cdr tag))))
+ ((stringp tag) ; singleton tag
+ (concat prefix (apply 'format tag args) text))))
+
+(defun org-xml-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword into a valid class name.
+Replaces invalid characters with \"_\"."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ kwd)
+
+(defun org-lparse-format-todo (todo)
+ (org-lparse-format 'FONTIFY
+ (concat
+ (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
+ (org-xml-fix-class-name todo))
+ (list (if (member todo org-done-keywords) "done" "todo")
+ todo)))
+
+(defun org-lparse-format-extra-targets (extra-targets)
+ (if (not extra-targets) ""
+ (mapconcat (lambda (x)
+ (setq x (org-solidify-link-text
+ (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-lparse-format 'ANCHOR "" x))
+ extra-targets "")))
+
+(defun org-lparse-format-org-tags (tags)
+ (if (not tags) ""
+ (org-lparse-format
+ 'FONTIFY (mapconcat
+ (lambda (x)
+ (org-lparse-format
+ 'FONTIFY x
+ (concat
+ (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
+ (org-xml-fix-class-name x))))
+ (org-split-string tags ":")
+ (org-lparse-format 'SPACES 1)) "tag")))
+
+(defun org-lparse-format-section-number (&optional snumber level)
+ (and org-export-with-section-numbers
+ (not body-only) snumber level
+ (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
+
+(defun org-lparse-warn (msg)
+ (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
+ (message msg)
+ (sleep-for 3))
+
+(defun org-xml-format-href (s)
+ "Make sure the S is valid as a href reference in an XHTML document."
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "&" s start)
+ (setq start (+ (match-beginning 0) 3)
+ s (replace-match "&" t t s)))))
+ s)
+
+(defun org-xml-format-desc (s)
+ "Make sure the S is valid as a description in a link."
+ (if (and s (not (get-text-property 1 'org-protected s)))
+ (save-match-data
+ (org-xml-encode-org-text s))
+ s))
+
+(provide 'org-lparse)
+
+;;; org-lparse.el ends here
diff --git a/contrib/lisp/org-odt.el b/contrib/lisp/org-odt.el
new file mode 100644
index 000000000..ad5320411
--- /dev/null
+++ b/contrib/lisp/org-odt.el
@@ -0,0 +1,1513 @@
+;;; org-odt.el --- OpenDocumentText export for Org-mode
+
+;; Copyright (C) 2010-2011
+;; Jambunathan
+
+;; Author: Jambunathan K
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.8
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see .
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Use M-x `org-odt-unit-test' to test drive the exporter
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(require 'org-lparse)
+
+(defun org-odt-end-export ()
+ ;; remove empty paragraphs
+ (goto-char (point-min))
+ (while (re-search-forward
+ "[ \r\n\t]*"
+ nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "%s"
+ (make-string n ?x)))))
+
+ ;; Remove empty lines at the beginning of the file.
+ (goto-char (point-min))
+ (when (looking-at "\\s-+\n") (replace-match ""))
+
+ ;; Remove display properties
+ (remove-text-properties (point-min) (point-max) '(display t)))
+
+(defvar org-odt-suppress-xref nil)
+(defconst org-export-odt-special-string-regexps
+ '(("\\\\-" . "\\1") ; shy
+ ("---\\([^-]\\)" . "—\\1") ; mdash
+ ("--\\([^-]\\)" . "–\\1") ; ndash
+ ("\\.\\.\\." . "…")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-odt-lib-dir (file-name-directory load-file-name))
+(defconst org-odt-data-dir
+ (let ((dir1 (expand-file-name ".." org-odt-lib-dir)) ; git
+ (dir2 (expand-file-name "./contrib/odt" org-odt-lib-dir))) ; elpa
+ (cond
+ ((file-directory-p dir1) dir1)
+ ((file-directory-p dir2) dir2)
+ (t (error "Cannot find factory styles file. Check package dir layout")))))
+
+(defvar org-odt-file-extensions
+ '(("odt" . "OpenDocument Text")
+ ("ott" . "OpenDocument Text Template")
+ ("odm" . "OpenDocument Master Document")
+ ("ods" . "OpenDocument Spreadsheet")
+ ("ots" . "OpenDocument Spreadsheet Template")
+ ("odg" . "OpenDocument Drawing (Graphics)")
+ ("otg" . "OpenDocument Drawing Template")
+ ("odp" . "OpenDocument Presentation")
+ ("otp" . "OpenDocument Presentation Template")
+ ("odi" . "OpenDocument Image")
+ ("odf" . "OpenDocument Formula")
+ ("odc" . "OpenDocument Chart")
+ ("doc" . "Microsoft Text")
+ ("docx" . "Microsoft Text")
+ ("xls" . "Microsoft Spreadsheet")
+ ("xlsx" . "Microsoft Spreadsheet")
+ ("ppt" . "Microsoft Presentation")
+ ("pptx" . "Microsoft Presentation")))
+
+(defvar org-odt-ms-file-extensions
+ '(("doc" . "Microsoft Text")
+ ("docx" . "Microsoft Text")
+ ("xls" . "Microsoft Spreadsheet")
+ ("xlsx" . "Microsoft Spreadsheet")
+ ("ppt" . "Microsoft Presentation")
+ ("pptx" . "Microsoft Presentation")))
+
+;; RelaxNG validation of OpenDocument xml files
+(eval-after-load 'rng-nxml
+ '(setq rng-nxml-auto-validate-flag t))
+
+(eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "etc/schema/schemas.xml" org-odt-data-dir)))
+
+(mapc
+ (lambda (desc)
+ ;; Let Org open all OpenDocument files using system-registered app
+ (add-to-list 'org-file-apps
+ (cons (concat "\\." (car desc) "\\'") 'system))
+ ;; Let Emacs open all OpenDocument files in archive mode
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
+ org-odt-file-extensions)
+
+(mapc
+ (lambda (desc)
+ ;; Let Org open all Microsoft files using system-registered app
+ (add-to-list 'org-file-apps
+ (cons (concat "\\." (car desc) "\\'") 'system)))
+ org-odt-ms-file-extensions)
+
+;; register the odt exporter
+(add-to-list 'org-export-backends 'odt)
+
+(defcustom org-export-odt-automatic-styles-file nil
+ "Default style file for use with ODT exporter."
+ :group 'org-export-odt
+ :type 'file)
+
+;; TODO: Make configuration user-friendly.
+(defcustom org-export-odt-styles-file nil
+ "Default style file for use with ODT exporter.
+Valid values are path to an styles.xml file or a path to a valid
+*.odt or a *.ott file or a list of the form (FILE (MEMBER1
+MEMBER2 ...)). In the last case, the specified FILE is unzipped
+and MEMBER1, MEMBER2 etc are copied in to the generated odt
+file. The last form is particularly useful if the styles.xml has
+reference to additional files like header and footer images.
+"
+ :group 'org-export-odt
+ :type 'file)
+(defconst org-export-odt-tmpdir-prefix "odt-")
+(defconst org-export-odt-bookmark-prefix "OrgXref.")
+(defcustom org-export-odt-use-bookmarks-for-internal-links t
+ "Export Internal links as bookmarks?."
+ :group 'org-export-odt
+ :type 'boolean)
+
+(defcustom org-export-odt-embed-images t
+ "Should the images be copied in to the odt file or just linked?"
+ :group 'org-export-odt
+ :type 'boolean)
+
+(defcustom org-odt-export-inline-images 'maybe
+ "Non-nil means inline images into exported HTML pages.
+This is done using an tag. When nil, an anchor with href is used to
+link to the image. If this option is `maybe', then images in links with
+an empty description will be inlined, while images with a description will
+be linked only."
+ :group 'org-odt-export
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When there is no description" maybe)))
+
+(defcustom org-odt-export-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif")
+ "Extensions of image files that can be inlined into HTML."
+ :group 'org-odt-export
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
+ ""
+ :group 'org-export-odt
+ :type 'float)
+
+(defvar org-export-odt-default-org-styles-alist
+ '((paragraph . ((default . "Text_20_body")
+ (fixedwidth . "OrgSourceBlock")
+ (verse . "OrgVerse")
+ (quote . "Quotations")
+ (blockquote . "Quotations")
+ (center . "OrgCenter")
+ (left . "OrgLeft")
+ (right . "OrgRight")
+ (title . "Heading_20_1.title")
+ (footnote . "Footnote")
+ (src . "OrgSourceBlock")
+ (illustration . "Illustration")
+ (table . "Table")
+ (definition-term . "Text_20_body_20_bold")
+ (horizontal-line . "Horizontal_20_Line")))
+ (character . ((bold . "Bold")
+ (emphasis . "Emphasis")
+ (code . "OrgCode")
+ (verbatim . "OrgCode")
+ (strike . "Strikethrough")
+ (underline . "Underline")
+ (subscript . "OrgSubscript")
+ (superscript . "OrgSuperscript")))
+ (list . ((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (description . "OrgDescriptionList"))))
+ "Default styles for various entities.")
+
+(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist)
+(defun org-odt-get-style-name-for-entity (category &optional entity)
+ (let ((entity (or entity 'default)))
+ (or
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-org-styles-alist))))
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-default-org-styles-alist))))
+ (error "Cannot determine style name for entity %s of type %s"
+ entity category))))
+
+;;;###autoload
+(defun org-export-as-odt-and-open (arg)
+ "Export the outline as ODT and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists."
+ (interactive "P")
+ (org-lparse-and-open "odt" "odt" arg))
+
+;;;###autoload
+(defun org-export-as-odt-batch ()
+ "Call the function `org-lparse-batch'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-odt-batch"
+ (org-lparse-batch "odt"))
+
+;;;###autoload
+(defun org-export-as-odt-to-buffer (arg)
+ "Call `org-lparse-odt` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-lparse-to-buffer'."
+ (interactive "P")
+ (org-lparse-to-buffer "odt" arg))
+
+;;;###autoload
+(defun org-replace-region-by-odt (beg end)
+ "Assume the current region has org-mode syntax, and convert it to ODT.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an ODT buffer and then use this
+command to convert it."
+ (interactive "r")
+ (org-replace-region-by "odt" beg end))
+
+;;;###autoload
+(defun org-export-region-as-odt (beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to ODT.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted ODT. If BUFFER is the symbol `string', return the
+produced ODT as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq odt (org-export-region-as-odt beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "r\nP")
+ (org-lparse-region "odt" beg end body-only buffer))
+
+;;; org-export-as-odt
+;;;###autoload
+(defun org-export-as-odt (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline as a OpenDocumentText file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting XML as a string. When BODY-ONLY is set, don't produce
+the file header and footer, simply return the content of
+..., without even the body tags themselves. When
+PUB-DIR is set, use this as the publishing directory."
+ (interactive "P")
+ (org-lparse "odt" "odt" arg hidden ext-plist to-buffer body-only pub-dir))
+
+(defvar org-odt-entity-control-callbacks-alist
+ `((EXPORT
+ . (org-odt-begin-export org-odt-end-export))
+ (DOCUMENT-CONTENT
+ . (org-odt-begin-document-content org-odt-end-document-content))
+ (DOCUMENT-BODY
+ . (org-odt-begin-document-body org-odt-end-document-body))
+ (TOC
+ . (org-odt-begin-toc org-odt-end-toc))
+ (ENVIRONMENT
+ . (org-odt-begin-environment org-odt-end-environment))
+ (FOOTNOTE-DEFINITION
+ . (org-odt-begin-footnote-definition org-odt-end-footnote-definition))
+ (TABLE
+ . (org-odt-begin-table org-odt-end-table))
+ (TABLE-ROWGROUP
+ . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup))
+ (LIST
+ . (org-odt-begin-list org-odt-end-list))
+ (LIST-ITEM
+ . (org-odt-begin-list-item org-odt-end-list-item))
+ (OUTLINE
+ . (org-odt-begin-outline org-odt-end-outline))
+ (OUTLINE-TEXT
+ . (org-odt-begin-outline-text org-odt-end-outline-text))
+ (PARAGRAPH
+ . (org-odt-begin-paragraph org-odt-end-paragraph)))
+ "")
+
+(defvar org-odt-entity-format-callbacks-alist
+ `((EXTRA-TARGETS . org-lparse-format-extra-targets)
+ (ORG-TAGS . org-lparse-format-org-tags)
+ (SECTION-NUMBER . org-lparse-format-section-number)
+ (HEADLINE . org-odt-format-headline)
+ (TOC-ENTRY . org-odt-format-toc-entry)
+ (TOC-ITEM . org-odt-format-toc-item)
+ (TAGS . org-odt-format-tags)
+ (SPACES . org-odt-format-spaces)
+ (TABS . org-odt-format-tabs)
+ (LINE-BREAK . org-odt-format-line-break)
+ (FONTIFY . org-odt-format-fontify)
+ (TODO . org-lparse-format-todo)
+ (LINK . org-odt-format-link)
+ (INLINE-IMAGE . org-odt-format-inline-image)
+ (ORG-LINK . org-odt-format-org-link)
+ (HEADING . org-odt-format-heading)
+ (ANCHOR . org-odt-format-anchor)
+ (TABLE . org-lparse-format-table)
+ (TABLE-ROW . org-odt-format-table-row)
+ (TABLE-CELL . org-odt-format-table-cell)
+ (FOOTNOTES-SECTION . ignore)
+ (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference)
+ (HORIZONTAL-LINE . org-odt-format-horizontal-line)
+ (COMMENT . org-odt-format-comment)
+ (LINE . org-odt-format-line)
+ (ORG-ENTITY . org-odt-format-org-entity))
+ "")
+
+;;;_. callbacks
+;;;_. control callbacks
+;;;_ , document body
+(defun org-odt-begin-office-body ()
+ (insert "
+
+
+
+
+
+
+
+ "))
+
+;; Following variable is let bound when `org-do-lparse' is in
+;; progress. See org-html.el.
+(defvar org-lparse-toc)
+(defun org-odt-begin-document-body (opt-plist)
+ (org-odt-begin-office-body)
+ (let ((title (plist-get opt-plist :title)))
+ (when title
+ (insert
+ (org-odt-format-stylized-paragraph 'title title))))
+
+ ;; insert toc
+ (when org-lparse-toc
+ (insert "\n" org-lparse-toc "\n")))
+
+(defvar org-lparse-body-only) ; let bound during org-do-lparse
+(defvar org-lparse-to-buffer) ; let bound during org-do-lparse
+(defun org-odt-end-document-body (opt-plist)
+ (unless org-lparse-body-only
+ (org-lparse-insert-tag "")
+ (org-lparse-insert-tag "")))
+
+(defconst org-odt-document-content-header
+ "
+
+")
+
+(defun org-odt-begin-document-content (opt-plist)
+ ;; document header
+ (insert org-odt-document-content-header)
+
+ ;; automatic styles
+ (insert-file-contents
+ (or org-export-odt-automatic-styles-file
+ (expand-file-name "styles/OrgOdtAutomaticStyles.xml"
+ org-odt-data-dir)))
+ (goto-char (point-max)))
+
+(defun org-odt-end-document-content ()
+ (org-lparse-insert-tag ""))
+
+(defun org-odt-begin-outline (level1 snumber title tags
+ target extra-targets class)
+ (org-lparse-insert
+ 'HEADING (org-lparse-format
+ 'HEADLINE title extra-targets tags snumber level1)
+ level1 target))
+
+(defun org-odt-end-outline ()
+ (ignore))
+
+(defun org-odt-begin-outline-text (level1 snumber class)
+ (ignore))
+
+(defun org-odt-end-outline-text ()
+ (ignore))
+
+(defun org-odt-begin-paragraph (&optional style)
+ (org-lparse-insert-tag
+ "" (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defun org-odt-end-paragraph ()
+ (org-lparse-insert-tag ""))
+
+(defun org-odt-get-extra-attrs-for-paragraph-style (style)
+ (let (style-name)
+ (setq style-name
+ (cond
+ ((stringp style) style)
+ ((symbolp style) (org-odt-get-style-name-for-entity
+ 'paragraph style))))
+ (unless style-name
+ (error "Don't know how to handle paragraph style %s" style))
+ (format " text:style-name=\"%s\"" style-name)))
+
+(defun org-odt-format-stylized-paragraph (style text)
+ (org-odt-format-tags
+ '("" . "") text
+ (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defun org-odt-begin-environment (style)
+ (case style
+ ((blockquote verse center quote)
+ (org-lparse-begin-paragraph style)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-end-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defun org-odt-end-environment (style)
+ (case style
+ ((blockquote verse center quote)
+ (org-lparse-end-paragraph)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-begin-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defun org-odt-begin-list (ltype &optional arg1)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype))
+ (extra (if style-name
+ (format " text:style-name=\"%s\"" style-name) "")))
+
+ ;; FIXME: Handle arg1 incase of ordered lists.
+ (case ltype
+ ((ordered unordered description)
+ (org-lparse-end-paragraph)
+ (org-lparse-insert-tag "" extra))
+ (t (error "Unknown list type: %s" ltype)))))
+
+(defun org-odt-end-list (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (if ltype
+ (org-lparse-insert-tag "")
+ (error "Unknown list type: %s" ltype)))
+
+(defun org-odt-begin-list-item (ltype &optional arg headline)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ (ordered
+ (assert (not headline) t)
+ (let* ((counter arg) (extra ""))
+ (org-lparse-insert-tag "")
+ (org-lparse-begin-paragraph)))
+ (unordered
+ (let* ((id arg) (extra ""))
+ (org-lparse-insert-tag "")
+ (org-lparse-begin-paragraph)
+ (insert (if headline (org-odt-format-target headline id)
+ (org-odt-format-bookmark "" id)))))
+ (description
+ (assert (not headline) t)
+ (let ((term (or arg "(no term)")))
+ (insert
+ (org-odt-format-tags
+ '("" . "")
+ (org-odt-format-stylized-paragraph 'definition-term term)))
+ (org-lparse-begin 'LIST-ITEM 'unordered)
+ (org-lparse-begin 'LIST 'description)
+ (org-lparse-begin 'LIST-ITEM 'unordered)))
+ (t (error "Unknown list type"))))
+
+(defun org-odt-end-list-item (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ ((ordered unordered)
+ (org-lparse-insert-tag ""))
+ (description
+ (org-lparse-end-list-item)
+ (org-lparse-end 'LIST 'description)
+ (org-lparse-end-list-item))
+ (t (error "Unknown list type"))))
+
+;; Following variables are let bound when table emission is in
+;; progress. See org-lparse.el.
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-rowgrp-info)
+(defvar org-lparse-table-colalign-vector)
+(defun org-odt-begin-table (caption label attributes)
+ (when label
+ (insert
+ (org-odt-format-stylized-paragraph
+ 'table (org-odt-format-entity-caption label caption "Table"))))
+
+ (org-lparse-insert-tag
+ ""
+ (or label "") "OrgTable")
+ (setq org-lparse-table-begin-marker (point)))
+
+(defun org-odt-end-table ()
+ (goto-char org-lparse-table-begin-marker)
+ (loop for level from 0 below org-lparse-table-ncols
+ do (insert (org-odt-format-tags "" "")))
+
+ ;; fill style attributes for table cells
+ (when org-lparse-table-is-styled
+ (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t)
+ (let ((spec (match-string 1))
+ (r (string-to-number (match-string 2)))
+ (c (string-to-number (match-string 3))))
+ (cond
+ ((equal spec "table-cell:p")
+ (let ((style-name (org-odt-get-paragraph-style-for-table-cell r c)))
+ (replace-match style-name t t)))
+ ((equal spec "table-cell:style-name")
+ (let ((style-name (org-odt-get-style-name-for-table-cell r c)))
+ (replace-match style-name t t)))))))
+
+ (goto-char (point-max))
+ (org-lparse-insert-tag ""))
+
+(defun org-odt-begin-table-rowgroup (&optional is-header-row)
+ (when org-lparse-table-rowgrp-open
+ (org-lparse-end 'TABLE-ROWGROUP))
+ (org-lparse-insert-tag (if is-header-row
+ ""
+ ""))
+ (setq org-lparse-table-rowgrp-open t)
+ (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row))
+
+(defun org-odt-end-table-rowgroup ()
+ (when org-lparse-table-rowgrp-open
+ (setq org-lparse-table-rowgrp-open nil)
+ (org-lparse-insert-tag
+ (if org-lparse-table-cur-rowgrp-is-hdr
+ "" ""))))
+
+(defun org-odt-format-table-row (row)
+ (org-odt-format-tags
+ '("" . "") row))
+
+(defun org-odt-get-style-name-for-table-cell (r c)
+ (concat
+ "OrgTblCell"
+ (cond
+ ((= r 0) "T")
+ ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T")
+ (t ""))
+ (when (= r org-lparse-table-rownum) "B")
+ (cond
+ ((= c 0) "")
+ ((or (memq (nth c org-table-colgroup-info) '(:start :startend))
+ (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
+ (t ""))))
+
+(defun org-odt-get-paragraph-style-for-table-cell (r c)
+ (capitalize (aref org-lparse-table-colalign-vector c)))
+
+(defun org-odt-format-table-cell (data r c)
+ (if (not org-lparse-table-is-styled)
+ (org-odt-format-tags
+ '("" . "")
+ (org-odt-format-stylized-paragraph
+ (cond
+ (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
+ ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
+ "OrgTableHeading")
+ (t "OrgTableContents"))
+ data))
+ (let* ((style-name-cookie
+ (format "@@table-cell:style-name@@%03d@@%03d@@" r c))
+ (paragraph-style-cookie
+ (concat
+ (cond
+ (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
+ ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
+ "OrgTableHeading")
+ (t "OrgTableContents"))
+ (format "@@table-cell:p@@%03d@@%03d@@" r c))))
+ (org-odt-format-tags
+ '("" .
+ "")
+ (org-odt-format-stylized-paragraph paragraph-style-cookie data)
+ style-name-cookie))))
+
+(defun org-odt-begin-footnote-definition (n)
+ (org-lparse-begin-paragraph 'footnote))
+
+(defun org-odt-end-footnote-definition (n)
+ (org-lparse-end-paragraph))
+
+(defun org-odt-begin-toc (lang-specific-heading)
+ (insert
+ (format "
+
+
+ %s
+" lang-specific-heading))
+
+ (loop for level from 1 upto 10
+ do (insert (format
+ "
+
+
+
+
+
+
+" level level)))
+
+ (insert "
+
+
+
+
+ Table of Contents
+
+"))
+
+(defun org-odt-end-toc ()
+ (insert "
+
+
+"))
+
+(defun org-odt-format-toc-entry (snumber todo headline tags href)
+ (setq headline (concat
+ (and org-export-with-section-numbers
+ (concat snumber ". "))
+ headline
+ (and tags
+ (concat
+ (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'FONTIFY tags "tag")))))
+ (when todo
+ (setq headline (org-lparse-format 'FONTIFY headline "todo")))
+
+ (let ((org-odt-suppress-xref t))
+ (org-odt-format-link headline (concat "#" href))))
+
+(defun org-odt-format-toc-item (toc-entry level org-last-level)
+ (let ((style (format "Contents_20_%d"
+ (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
+ (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
+
+;; Following variable is let bound during 'ORG-LINK callback. See
+;; org-html.el
+(defvar org-lparse-link-description-is-image nil)
+(defun org-odt-format-link (desc href &optional attr)
+ (cond
+ ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref))
+ (setq href (concat org-export-odt-bookmark-prefix (substring href 1)))
+ (org-odt-format-tags
+ '("" .
+ "")
+ desc href))
+ (org-lparse-link-description-is-image
+ (org-odt-format-tags
+ '("" . "")
+ desc href (or attr "")))
+ (t
+ (org-odt-format-tags
+ '("" . "")
+ desc href (or attr "")))))
+
+(defun org-odt-format-spaces (n)
+ (org-odt-format-tags "" "" n))
+
+(defun org-odt-format-tabs (&optional n)
+ (let ((tab "")
+ (n (or n 1)))
+ (insert tab)))
+
+(defun org-odt-format-line-break ()
+ (org-odt-format-tags "" ""))
+
+(defun org-odt-format-horizontal-line ()
+ (org-odt-format-stylized-paragraph 'horizontal-line ""))
+
+(defun org-odt-format-line (line)
+ (case org-lparse-dyn-current-environment
+ (fixedwidth (concat (org-odt-format-source-code-or-example-line
+ (org-xml-encode-plain-text line)) "\n"))
+ (t (concat line "\n"))))
+
+(defun org-odt-format-comment (fmt &rest args)
+ (let ((comment (apply 'format fmt args)))
+ (format "\n\n" comment)))
+
+(defun org-odt-format-org-entity (wd)
+ ;; FIXME: Seems to work. But is this correct?
+ (let ((s (org-entity-get-representation wd 'utf8)))
+ (and s (format "%x;" (string-to-char s)))))
+
+(defun org-odt-fill-tabs-and-spaces (line)
+ (replace-regexp-in-string
+ "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s)
+ (cond
+ ((string= s "\t") (org-odt-format-tabs))
+ ((> (length s) 1)
+ (org-odt-format-spaces (length s)))
+ (t " "))) line))
+
+(defun org-odt-format-source-code-or-example-line (line)
+ (org-odt-format-stylized-paragraph 'src (org-odt-fill-tabs-and-spaces line)))
+
+(defun org-odt-format-example (lines)
+ (mapconcat
+ (lambda (line)
+ (org-odt-format-source-code-or-example-line line))
+ (org-split-string lines "[\r\n]") "\n"))
+
+(defun org-odt-format-source-code-or-example (lines lang caption textareap
+ cols rows num cont
+ rpllbl fmt)
+ (org-odt-format-example (org-export-number-lines
+ (org-xml-encode-plain-text-lines lines)
+ 0 0 num cont rpllbl fmt)))
+
+(defun org-xml-encode-plain-text-lines (rtn)
+ (mapconcat 'org-xml-encode-plain-text (org-split-string rtn "[\r\n]") "\n"))
+
+(defun org-odt-remap-stylenames (style-name)
+ (or
+ (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper")
+ ("timestamp" . "OrgTimestamp")
+ ("timestamp-kwd" . "OrgTimestampKeyword")
+ ("tag" . "OrgTag")
+ ("todo" . "OrgTodo")
+ ("done" . "OrgDone")
+ ("target" . "OrgTarget"))))
+ style-name))
+
+(defun org-odt-format-fontify (text style &optional id)
+ (let* ((style-name
+ (cond
+ ((stringp style)
+ (org-odt-remap-stylenames style))
+ ((symbolp style)
+ (org-odt-get-style-name-for-entity 'character style))
+ ((listp style)
+ (assert (< 1 (length style)))
+ (let ((parent-style (pop style)))
+ (mapconcat (lambda (s)
+ ;; (assert (stringp s) t)
+ (org-odt-remap-stylenames s)) style "")
+ (org-odt-remap-stylenames parent-style)))
+ (t (error "Don't how to handle style %s" style)))))
+ (org-odt-format-tags
+ '("" . "")
+ text style-name)))
+
+(defun org-odt-relocate-relative-path (path dir)
+ (if (file-name-absolute-p path) path
+ (file-relative-name (expand-file-name path dir)
+ (expand-file-name "eyecandy" dir))))
+
+(defun org-odt-format-inline-image (thefile)
+ (let* ((thelink (if (file-name-absolute-p thefile) thefile
+ (org-xml-format-href
+ (org-odt-relocate-relative-path
+ thefile org-current-export-file))))
+ (href
+ (org-odt-format-tags
+ "" ""
+ (if org-export-odt-embed-images
+ (org-odt-copy-image-file thefile) thelink))))
+ (org-export-odt-format-image thefile href)))
+
+(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr
+ descp)
+ "Make an HTML link.
+OPT-PLIST is an options list.
+TYPE is the device-type of the link (THIS://foo.html)
+PATH is the path of the link (http://THIS#locationx)
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS)
+DESC is the link description, if any.
+ATTR is a string of other attributes of the a element.
+MAY-INLINE-P allows inlining it as an image."
+
+ (declare (special org-lparse-par-open))
+ (save-match-data
+ (let* ((may-inline-p
+ (and (member type-1 '("http" "https" "file"))
+ (org-lparse-should-inline-p path descp)
+ (not fragment)))
+ (type (if (equal type-1 "id") "file" type-1))
+ (filename path)
+ (thefile path))
+
+ (cond
+ ;; check for inlined images
+ ((and (member type '("file"))
+ (not fragment)
+ (org-file-image-p
+ filename org-odt-export-inline-image-extensions)
+ (or (eq t org-odt-export-inline-images)
+ (and org-odt-export-inline-images (not descp))))
+
+ ;; (when (and (string= type "file") (file-name-absolute-p path))
+ ;; (setq thefile (concat "file://" (expand-file-name path))))
+ ;; (setq thefile (org-xml-format-href thefile))
+ ;; (org-export-html-format-image thefile)
+ (org-odt-format-inline-image thefile))
+ (t
+ (when (string= type "file")
+ (setq thefile
+ (cond
+ ((file-name-absolute-p path)
+ (concat "file://" (expand-file-name path)))
+ (t (org-odt-relocate-relative-path
+ thefile org-current-export-file)))))
+
+ (when (and (member type '("" "http" "https" "file" "coderef"))
+ fragment)
+ (setq thefile (concat thefile "#" fragment)))
+
+ (setq thefile (org-xml-format-href thefile))
+
+ (when (not (member type '("" "file" "coderef")))
+ (setq thefile (concat type ":" thefile)))
+
+ (let ((org-odt-suppress-xref (string= type "coderef")))
+ (org-odt-format-link
+ (org-xml-format-desc desc) thefile attr)))))))
+
+(defun org-odt-format-heading (text level &optional id)
+ (let* ((text (if id (org-odt-format-target text id) text)))
+ (org-odt-format-tags
+ '("" .
+ "") text level level)))
+
+(defun org-odt-format-headline (title extra-targets tags
+ &optional snumber level)
+ (concat
+ (org-lparse-format 'EXTRA-TARGETS extra-targets)
+
+ ;; No need to generate section numbers. They are auto-generated by
+ ;; the application
+
+ ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
+ title
+ (and tags (concat (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'ORG-TAGS tags)))))
+
+(defun org-odt-format-anchor (text name &optional class)
+ (org-odt-format-target text name))
+
+(defun org-odt-format-bookmark (text id)
+ (if id
+ (org-odt-format-tags "" text id)
+ text))
+
+(defun org-odt-format-target (text id)
+ (let ((name (concat org-export-odt-bookmark-prefix id)))
+ (concat
+ (and id (org-odt-format-tags
+ "" "" name))
+ (org-odt-format-bookmark text id)
+ (and id (org-odt-format-tags
+ "" "" name)))))
+
+(defun org-odt-format-footnote (n def)
+ (let ((id (concat "fn" n))
+ (note-class "footnote")
+ (par-style "Footnote"))
+ (org-odt-format-tags
+ '("" .
+ "")
+ (concat
+ (org-odt-format-tags
+ '("" . "")
+ n)
+ (org-odt-format-tags
+ '("" . "")
+ def))
+ id note-class)))
+
+(defun org-odt-format-footnote-reference (n def refcnt)
+ (if (= refcnt 1)
+ (org-odt-format-footnote n def)
+ (org-odt-format-footnote-ref n)))
+
+(defun org-odt-format-footnote-ref (n)
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (org-odt-format-tags
+ '("" . "")
+ (org-odt-format-tags
+ '("" . "")
+ n note-class ref-format ref-name)
+ "OrgSuperscript")))
+
+(defun org-odt-get-image-name (file-name)
+ (require 'sha1)
+ (file-relative-name
+ (expand-file-name
+ (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
+
+(defun org-export-odt-format-image (src href
+ ;; par-open
+ )
+ "Create image tag with source and attributes."
+ (save-match-data
+
+ (let (embed-as caption attr label attr-plist size width height)
+
+ (cond
+ ((string-match "^ltxpng/" src)
+ ;; FIXME: Anyway the latex src can be embedded as an
+ ;; annotation
+
+ ;; (org-find-text-property-in-string 'org-latex-src src)
+ (setq caption nil attr nil label nil embed-as 'character))
+
+ (t
+ (setq caption (org-find-text-property-in-string 'org-caption src)
+ caption (and caption (org-xml-format-desc caption))
+ attr (org-find-text-property-in-string 'org-attributes src)
+ label (org-find-text-property-in-string 'org-label src)
+ embed-as 'paragraph)))
+
+ (setq attr-plist (when attr (read attr)))
+ (setq size (org-odt-image-size-from-file
+ src (plist-get attr-plist :width)
+ (plist-get attr-plist :height)
+ (plist-get attr-plist :scale) nil embed-as))
+
+ (org-export-odt-do-format-image embed-as caption attr label
+ size href))))
+
+(defun org-export-odt-do-format-image (embed-as caption attr label
+ size href)
+ "Create image tag with source and attributes."
+ (save-match-data
+ (let ((width (car size)) (height (cdr size))
+ (draw-frame-pair
+ '("" . "")))
+ (cond
+ ((and (not caption) (not label))
+ (let (style-name anchor-type)
+ (cond
+ ((eq embed-as 'paragraph)
+ (setq style-name "OrgGraphicsParagraph" anchor-type "paragraph"))
+ ((eq embed-as 'character)
+ (setq style-name "OrgGraphicsBaseline" anchor-type "as-char")))
+ (org-odt-format-tags
+ draw-frame-pair href style-name anchor-type 0
+ (org-odt-image-attrs-from-size width height))))
+
+ (t
+ (concat
+ ;; (when par-open (org-odt-close-par))
+ (org-odt-format-tags
+ draw-frame-pair
+ (org-odt-format-tags
+ '("" . "")
+ (org-odt-format-stylized-paragraph
+ 'illustration
+ (concat
+ (let ((extra " style:rel-width=\"100%\" style:rel-height=\"scale\""))
+ (org-odt-format-tags
+ draw-frame-pair href "OrgGraphicsParagraphContent" "paragraph" 2
+ (concat (org-odt-image-attrs-from-size width height) extra)))
+ (org-odt-format-entity-caption label caption)))
+ height)
+ "OrgFrame" "paragraph" 1
+ (org-odt-image-attrs-from-size width))
+
+ ;; (when par-open (org-odt-open-par))
+ ))))))
+
+;; xml files generated on-the-fly
+(defconst org-export-odt-save-list
+ '("META-INF/manifest.xml" "content.xml" "meta.xml" "styles.xml"))
+
+;; xml files that are copied
+(defconst org-export-odt-nosave-list '())
+
+;; xml files that contribute to the final odt file
+(defvar org-export-odt-file-list nil)
+
+(defconst org-export-odt-manifest-lines
+ '((""
+ ""
+ ""
+ ""
+ ""
+ ""
+ "") . ("")))
+
+(defconst org-export-odt-meta-lines
+ '((""
+ ""
+ " ") . (" " "")))
+
+(defun org-odt-copy-image-file (path &optional target-file)
+ "Returns the internal name of the file"
+ (let* ((image-type (file-name-extension path))
+ (media-type (format "image/%s" image-type))
+ (src-file (expand-file-name
+ path (file-name-directory org-current-export-file)))
+ (target-file (or target-file (org-odt-get-image-name src-file)))
+ ;; FIXME
+ (body-only nil))
+
+ (when (not org-lparse-to-buffer)
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+ (copy-file src-file target-file 'overwrite)
+ (org-odt-update-manifest-file media-type target-file)
+ (push target-file org-export-odt-file-list)) target-file))
+
+(defun org-odt-image-attrs-from-size (&optional width height)
+ (concat
+ (when width (format "svg:width=\"%0.2fcm\"" width))
+ " "
+ (when height (format "svg:height=\"%0.2fcm\"" height))))
+
+(defvar org-export-odt-image-size-probe-method
+ '(emacs imagemagick force)
+ "Ordered list of methods by for determining size of an embedded
+ image.")
+
+(defvar org-export-odt-default-image-sizes-alist
+ '(("character" . (5 . 0.4))
+ ("paragraph" . (5 . 5)))
+ "Hardcoded image dimensions one for each of the anchor
+ methods.")
+
+(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
+ (setq dpi (or dpi org-export-odt-pixels-per-inch))
+ (setq anchor-type (or anchor-type "paragraph"))
+ (flet ((size-in-cms (size-in-pixels)
+ (flet ((pixels-to-cms (pixels)
+ (let* ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches))))
+ (and size-in-pixels
+ (cons (pixels-to-cms (car size-in-pixels))
+ (pixels-to-cms (cdr size-in-pixels)))))))
+ (case probe-method
+ (emacs
+ (size-in-cms (ignore-errors (image-size (create-image file) 'pixels))))
+ (imagemagick
+ (size-in-cms
+ (let ((dim (shell-command-to-string
+ (format "identify -format \"%%w:%%h\" \"%s\"" file))))
+ (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
+ (cons (string-to-number (match-string 1 dim))
+ (string-to-number (match-string 2 dim)))))))
+ (t
+ (cdr (assoc-string anchor-type
+ org-export-odt-default-image-sizes-alist))))))
+
+(defun org-odt-image-size-from-file (file &optional user-width
+ user-height scale dpi embed-as)
+ (unless (file-name-absolute-p file)
+ (setq file (expand-file-name
+ file (file-name-directory org-current-export-file))))
+ (let* (size width height)
+ (unless (and user-height user-width)
+ (loop for probe-method in org-export-odt-image-size-probe-method
+ until size
+ do (setq size (org-odt-do-image-size
+ probe-method file dpi embed-as)))
+ (or size (error "Cannot determine Image size. Aborting ..."))
+ (setq width (car size) height (cdr size)))
+ (cond
+ (scale
+ (setq width (* width scale) height (* height scale)))
+ ((and user-height user-width)
+ (setq width user-width height user-height))
+ (user-height
+ (setq width (* user-height (/ width height)) height user-height))
+ (user-width
+ (setq height (* user-width (/ height width)) width user-width))
+ (t (ignore)))
+ (cons width height)))
+
+(defvar org-odt-default-entity "Illustration")
+(defun org-odt-format-entity-caption (label caption &optional default-entity)
+ (if (not label) (or caption "")
+ (let* ((label-components (org-odt-parse-label label))
+ (entity (car label-components))
+ (seqno (cdr label-components))
+ (caption (and caption (concat ": " caption))))
+ (unless seqno
+ (setq seqno label
+ entity (or default-entity org-odt-default-entity)))
+ (concat
+ entity " "
+ (org-odt-format-tags
+ '("" . "")
+ seqno label entity entity)
+ caption))))
+
+(defun org-odt-format-tags (tag text &rest args)
+ (let ((prefix (when org-lparse-encode-pending "@"))
+ (suffix (when org-lparse-encode-pending "@")))
+ (apply 'org-lparse-format-tags tag text prefix suffix args)))
+
+(defun org-odt-init-outfile (filename)
+ (let* ((outdir (make-temp-file org-export-odt-tmpdir-prefix t))
+ (mimetype-file (expand-file-name "mimetype" outdir))
+ (content-file (expand-file-name "content.xml" outdir))
+ (manifest-file (expand-file-name "META-INF/manifest.xml" outdir))
+ (meta-file (expand-file-name "meta.xml" outdir))
+ (styles-file (expand-file-name "styles.xml" outdir))
+ (pictures-dir (expand-file-name "Pictures" outdir))
+ (body-only nil))
+
+ ;; content file
+ (with-current-buffer (find-file-noselect content-file t)
+ (erase-buffer))
+
+ ;; FIXME: How to factor in body-only here
+ (unless body-only
+ ;; manifest file
+ (make-directory (file-name-directory manifest-file))
+ (with-current-buffer (find-file-noselect manifest-file t)
+ (erase-buffer)
+ (insert (mapconcat 'identity (car org-export-odt-manifest-lines) "\n"))
+ (insert "\n")
+ (save-excursion
+ (insert (mapconcat 'identity (cdr org-export-odt-manifest-lines) "\n"))))
+
+ ;; meta file
+ (with-current-buffer (find-file-noselect meta-file t)
+ (erase-buffer)
+ (insert (mapconcat 'identity (car org-export-odt-meta-lines) "\n"))
+ (insert "\n")
+ (save-excursion
+ (insert (mapconcat 'identity (cdr org-export-odt-meta-lines) "\n"))))
+
+ ;; styles file
+ ;; (copy-file org-export-odt-styles-file styles-file t)
+
+ ;; Pictures dir
+ (make-directory pictures-dir)
+
+ ;; initialize list of files that contribute to the odt file
+ (setq org-export-odt-file-list
+ (append org-export-odt-save-list org-export-odt-nosave-list)))
+ content-file))
+
+(defconst org-export-odt-mimetype-lines
+ '("application/vnd.oasis.opendocument.text"))
+
+(defconst org-odt-manifest-file-entry-tag
+ "")
+
+(defun org-odt-save-as-outfile (target opt-plist)
+ ;; write meta file
+ (org-odt-update-meta-file opt-plist)
+
+ ;; write styles file
+ (org-odt-copy-styles-file)
+
+ ;; Update styles.xml - take care of outline numbering
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "styles.xml") t)
+ ;; Don't make automatic backup of styles.xml file. This setting
+ ;; prevents the backedup styles.xml file from being zipped in to
+ ;; odt file. This is more of a hackish fix. Better alternative
+ ;; would be to fix the zip command so that the output odt file
+ ;; includes only the needed files and excludes any auto-generated
+ ;; extra files like backups and auto-saves etc etc. Note that
+ ;; currently the zip command zips up the entire temp directory so
+ ;; that any auto-generated files created under the hood ends up in
+ ;; the resulting odt file.
+ (set (make-local-variable 'backup-inhibited) t)
+
+ ;; Import local setting of `org-export-with-section-numbers'
+ (org-lparse-bind-local-variables opt-plist)
+ (org-odt-configure-outline-numbering
+ (if org-export-with-section-numbers org-export-headline-levels 0)))
+
+ (let ((zipdir default-directory))
+ (message "Switching to directory %s" (expand-file-name zipdir))
+
+ ;; save all xml files
+ (mapc (lambda (file)
+ (with-current-buffer
+ (find-file-noselect (expand-file-name file) t)
+ ;; prettify output
+ (indent-region (point-min) (point-max))
+ (save-buffer)))
+ org-export-odt-save-list)
+
+ (let* ((target-name (file-name-nondirectory target))
+ (target-dir (file-name-directory target))
+ (cmd (format "zip -rmTq %s %s" target-name ".")))
+ (when (file-exists-p target)
+ ;; FIXME: If the file is locked this throws a cryptic error
+ (delete-file target))
+
+ (let ((coding-system-for-write 'no-conversion) exitcode)
+ (message "Creating odt file using \"%s\"" cmd)
+ (setq exitcode
+ (apply 'call-process
+ "zip"
+ nil
+ nil
+ nil
+ (append (list "-rmTq") (list target-name "."))))
+
+ (or (zerop exitcode)
+ (error "Unable to create odt file (%S)" exitcode)))
+
+ ;; move the file from outdir to target-dir
+ (rename-file target-name target-dir)
+
+ ;; kill all xml buffers
+ (mapc (lambda (file)
+ (kill-buffer
+ (find-file-noselect (expand-file-name file zipdir) t)))
+ org-export-odt-save-list)
+
+ (delete-directory zipdir)))
+
+ (message "Created %s" target)
+ (set-buffer (find-file-noselect target t)))
+
+(defun org-odt-update-meta-file (opt-plist)
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "meta.xml") t)
+ (let ((date (or (plist-get opt-plist :effective-date) ""))
+ (author (or (plist-get opt-plist :author) ""))
+ (email (plist-get opt-plist :email))
+ (keywords (plist-get opt-plist :keywords))
+ (description (plist-get opt-plist :description))
+ (title (plist-get opt-plist :title)))
+
+ (insert
+ "\n"
+ (org-odt-format-tags '("" . "") author)
+ (org-odt-format-tags
+ '("\n" . "") author)
+ (org-odt-format-tags '("\n" . "") date)
+ (org-odt-format-tags
+ '("\n" . "") date)
+ (org-odt-format-tags '("\n" . "")
+ (when org-export-creator-info
+ (format "Org-%s/Emacs-%s"
+ org-version emacs-version)))
+ (org-odt-format-tags '("\n" . "") keywords)
+ (org-odt-format-tags '("\n" . "") description)
+ (org-odt-format-tags '("\n" . "") title)
+ "\n"))))
+
+(defun org-odt-update-manifest-file (media-type full-path)
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "META-INF/manifest.xml") t)
+ (insert (format org-odt-manifest-file-entry-tag media-type full-path))))
+
+(defun org-odt-finalize-outfile ()
+ (message "org-newodt: Finalizing outfile")
+ (org-odt-delete-empty-paragraphs))
+
+(defun org-odt-delete-empty-paragraphs ()
+ (goto-char (point-min))
+ (let ((open "]*>")
+ (close ""))
+ (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
+ (replace-match ""))))
+
+(defun org-odt-get (what &optional opt-plist)
+ (case what
+ (BACKEND 'odt)
+ (EXPORT-DIR (org-export-directory :html opt-plist))
+ (FILE-NAME-EXTENSION "odt")
+ (EXPORT-BUFFER-NAME "*Org ODT Export*")
+ (ENTITY-CONTROL org-odt-entity-control-callbacks-alist)
+ (ENTITY-FORMAT org-odt-entity-format-callbacks-alist)
+ (INIT-METHOD 'org-odt-init-outfile)
+ (FINAL-METHOD 'org-odt-finalize-outfile)
+ (SAVE-METHOD 'org-odt-save-as-outfile)
+ (OTHER-BACKENDS
+ '("bib" "doc" "doc6" "doc95" "html" "xhtml" "latex" "odt" "ott" "pdf" "rtf"
+ "sdw" "sdw3" "sdw4" "stw " "sxw" "mediawiki" "text" "txt" "uot" "vor"
+ "vor3" "vor4" "docbook" "ooxml" "ppt" "odp"))
+ (CONVERT-METHOD org-export-convert-process)
+ (TOPLEVEL-HLEVEL 1)
+ (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
+ (INLINE-IMAGES 'maybe)
+ (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg"))
+ (PLAIN-TEXT-MAP '(("&" . "&") ("<" . "<") (">" . ">")))
+ (TABLE-FIRST-COLUMN-AS-LABELS nil)
+ (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
+ (t (error "Unknown property: %s" what))))
+
+(defun org-odt-parse-label (label)
+ (save-match-data
+ (if (not (string-match "\\`[a-zA-Z]+:\\(.+\\)" label))
+ (cons label nil)
+ (cons
+ (capitalize (substring label 0 (1- (match-beginning 1))))
+ (substring label (match-beginning 1))))))
+
+(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
+(defun org-export-odt-preprocess (parameters)
+ "Convert LaTeX fragments to images."
+ (when (and org-current-export-file
+ (plist-get parameters :LaTeX-fragments))
+ (org-format-latex
+ (concat "ltxpng/" (file-name-sans-extension
+ (file-name-nondirectory
+ org-current-export-file)))
+ org-current-export-dir nil "Creating LaTeX image %s"
+ nil nil
+ (cond
+ ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
+ ;; Investigate MathToWeb for converting TeX equations to MathML
+ ;; See http://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01755.html
+ ((or (eq (plist-get parameters :LaTeX-fragments) 'mathjax )
+ (eq (plist-get parameters :LaTeX-fragments) t ))
+ (org-lparse-warn
+ (concat
+ "Use of MathJax is incompatible with ODT exporter. "
+ (format "Using %S instead." org-lparse-latex-fragment-fallback)))
+ org-lparse-latex-fragment-fallback)
+ ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)
+ (t nil))))
+ (goto-char (point-min))
+ (let (label label-components category value pretty-label)
+ (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (setq label (match-string 1)
+ label-components (org-odt-parse-label label)
+ category (car label-components)
+ value (cdr label-components)
+ pretty-label (if value (concat category " " value) label))
+ (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-odt-format-tags
+ '(""
+ . "") pretty-label label)) t t)))))
+
+(declare-function archive-zip-extract "arc-mode.el" (archive name))
+(defun org-odt-zip-extract-one (archive member &optional target)
+ (require 'arc-mode)
+ (let* ((target (or target default-directory))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed"))))
+
+(defun org-odt-zip-extract (archive members &optional target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (member)
+ (org-odt-zip-extract-one archive member target))
+ members))
+
+(defun org-odt-copy-styles-file (&optional styles-file)
+ ;; Non-availability of styles.xml is not a critical error. For now
+ ;; throw an error purely for aesthetic reasons.
+ (setq styles-file (or styles-file
+ org-export-odt-styles-file
+ (expand-file-name "styles/OrgOdtStyles.xml"
+ org-odt-data-dir)
+ (error "org-odt: Missing styles file?")))
+ (cond
+ ((listp styles-file)
+ (let ((archive (nth 0 styles-file))
+ (members (nth 1 styles-file)))
+ (org-odt-zip-extract archive members)
+ (mapc
+ (lambda (member)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-update-manifest-file media-type member))))
+ members)))
+ ((and (stringp styles-file) (file-exists-p styles-file))
+ (let ((styles-file-type (file-name-extension styles-file)))
+ (cond
+ ((string= styles-file-type "xml")
+ (copy-file styles-file "styles.xml" t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-odt-zip-extract styles-file "styles.xml")))))
+ (t
+ (error (format "Invalid specification of styles.xml file: %S"
+ org-export-odt-styles-file)))))
+
+(defvar org-export-odt-factory-settings
+ "d4328fb9d1b6cb211d4320ff546829f26700dc5e"
+ "SHA1 hash of OrgOdtStyles.xml.")
+
+(defun org-odt-configure-outline-numbering (level)
+ "Outline numbering is retained only upto LEVEL.
+To disable outline numbering pass a LEVEL of 0."
+ (if (not (string= org-export-odt-factory-settings (sha1 (current-buffer))))
+ (org-lparse-warn
+ "org-odt: Using custom styles file? Consider tweaking styles.xml for better output. To suppress this warning update `org-export-odt-factory-settings'")
+ (goto-char (point-min))
+ (let ((regex
+ "")
+ (replacement
+ ""))
+ (while (re-search-forward regex nil t)
+ (when (> (string-to-number (match-string 1)) level)
+ (replace-match replacement t nil))))
+ (save-buffer 0)))
+
+;;;###autoload
+(defun org-odt-unit-test (&optional linger)
+ "Automatically visit the Unit Test file and export it."
+ (interactive "P")
+ (with-current-buffer
+ (find-file (expand-file-name "tests/test.org" org-odt-data-dir))
+ (unless linger
+ (call-interactively 'org-export-as-odt-and-open))))
+
+(provide 'org-odt)
+
+;;; org-odt.el ends here
diff --git a/contrib/lisp/org-xhtml.el b/contrib/lisp/org-xhtml.el
new file mode 100644
index 000000000..cedd8e071
--- /dev/null
+++ b/contrib/lisp/org-xhtml.el
@@ -0,0 +1,1797 @@
+;;; org-html.el --- HTML export for Org-mode (uses org-lparse)
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.8
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see .
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-exp)
+(require 'format-spec)
+
+(require 'org-lparse)
+
+(eval-when-compile (require 'cl) (require 'table) (require 'browse-url))
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function htmlize-region "ext:htmlize" (beg end))
+
+(defgroup org-export-html nil
+ "Options specific for HTML export of Org-mode files."
+ :tag "Org Export HTML"
+ :group 'org-export)
+
+(defcustom org-export-html-footnotes-section "
+
%s:
+
+%s
+
+
"
+ "Format for the footnotes section.
+Should contain a two instances of %s. The first will be replaced with the
+language-specific word for \"Footnotes\", the second one will be replaced
+by the footnotes themselves."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-footnote-format "%s"
+ "The format for the footnote reference.
+%s will be replaced by the footnote reference itself."
+ :group 'org-export-html
+ :type 'string)
+
+
+(defcustom org-export-html-footnote-separator ", "
+ "Text used to separate footnotes."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-coding-system nil
+ "Coding system for HTML export, defaults to `buffer-file-coding-system'."
+ :group 'org-export-html
+ :type 'coding-system)
+
+(defcustom org-export-html-extension "html"
+ "The extension for exported HTML files."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-xml-declaration
+ '(("html" . "")
+ ("php" . "\"; ?>"))
+ "The extension for exported HTML files.
+%s will be replaced with the charset of the exported file.
+This may be a string, or an alist with export extensions
+and corresponding declarations."
+ :group 'org-export-html
+ :type '(choice
+ (string :tag "Single declaration")
+ (repeat :tag "Dependent on extension"
+ (cons (string :tag "Extension")
+ (string :tag "Declaration")))))
+
+(defcustom org-export-html-style-include-scripts t
+ "Non-nil means include the JavaScript snippets in exported HTML files.
+The actual script is defined in `org-export-html-scripts' and should
+not be modified."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defconst org-export-html-scripts
+""
+"Basic JavaScript that is needed by HTML files produced by Org-mode.")
+
+(defconst org-export-html-style-default
+""
+ "The default style specification for exported HTML files.
+Please use the variables `org-export-html-style' and
+`org-export-html-style-extra' to add to this style. If you wish to not
+have the default style included, customize the variable
+`org-export-html-style-include-default'.")
+
+(defcustom org-export-html-style-include-default t
+ "Non-nil means include the default style in exported HTML files.
+The actual style is defined in `org-export-html-style-default' and should
+not be modified. Use the variables `org-export-html-style' to add
+your own style information."
+ :group 'org-export-html
+ :type 'boolean)
+;;;###autoload
+(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
+
+(defcustom org-export-html-style ""
+ "Org-wide style definitions for exported HTML files.
+
+This variable needs to contain the full HTML structure to provide a style,
+including the surrounding HTML tags. If you set the value of this variable,
+you should consider to include definitions for the following classes:
+ title, todo, done, timestamp, timestamp-kwd, tag, target.
+
+For example, a valid value would be:
+
+
+
+If you'd like to refer to an external style file, use something like
+
+
+
+As the value of this option simply gets inserted into the HTML header,
+you can \"misuse\" it to add arbitrary text to the header.
+See also the variable `org-export-html-style-extra'."
+ :group 'org-export-html
+ :type 'string)
+;;;###autoload
+(put 'org-export-html-style 'safe-local-variable 'stringp)
+
+(defcustom org-export-html-style-extra ""
+ "Additional style information for HTML export.
+The value of this variable is inserted into the HTML buffer right after
+the value of `org-export-html-style'. Use this variable for per-file
+settings of style information, and do not forget to surround the style
+settings with tags."
+ :group 'org-export-html
+ :type 'string)
+;;;###autoload
+(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
+
+(defcustom org-export-html-mathjax-options
+ '((path "http://orgmode.org/mathjax/MathJax.js")
+ (scale "100")
+ (align "center")
+ (indent "2em")
+ (mathml nil))
+ "Options for MathJax setup.
+
+path The path where to find MathJax
+scale Scaling for the HTML-CSS backend, usually between 100 and 133
+align How to align display math: left, center, or right
+indent If align is not center, how far from the left/right side?
+mathml Should a MathML player be used if available?
+ This is faster and reduces bandwidth use, but currently
+ sometimes has lower spacing quality. Therefore, the default is
+ nil. When browsers get better, this switch can be flipped.
+
+You can also customize this for each buffer, using something like
+
+#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+ :group 'org-export-html
+ :type '(list :greedy t
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "mathml (should MathML display be used is possible)"
+ (const :format " " mathml) (boolean))))
+
+(defun org-export-html-mathjax-config (template options in-buffer)
+ "Insert the user setup into the matchjax template."
+ (let (name val (yes " ") (no "// ") x)
+ (mapc
+ (lambda (e)
+ (setq name (car e) val (nth 1 e))
+ (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ (if (not (stringp val)) (setq val (format "%s" val)))
+ (if (string-match (concat "%" (upcase (symbol-name name))) template)
+ (setq template (replace-match val t t template))))
+ options)
+ (setq val (nth 1 (assq 'mathml options)))
+ (if (string-match (concat "\\
+
+"
+ "The MathJax setup for XHTML files."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-tag-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each tag gets a class given by the tag itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-todo-kwd-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each TODO keyword gets a class given by the keyword itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-preamble t
+ "Non-nil means insert a preamble in HTML export.
+
+When `t', insert a string as defined by one of the formatting
+strings in `org-export-html-preamble-format'. When set to a
+string, this string overrides `org-export-html-preamble-format'.
+When set to a function, apply this function and insert the
+returned string. The function takes the property list of export
+options as its only argument.
+
+Setting :html-preamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No preamble" nil)
+ (const :tag "Default preamble" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-export-html-preamble-format
+ '(("en" "
%t
"))
+ "The format for the HTML preamble.
+
+%t stands for the title.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-postamble 'auto
+ "Non-nil means insert a postamble in HTML export.
+
+When `t', insert a string as defined by the formatting string in
+`org-export-html-postamble-format'. When set to a string, this
+string overrides `org-export-html-postamble-format'. When set to
+'auto, discard `org-export-html-postamble-format' and honor
+`org-export-author/email/creator-info' variables. When set to a
+function, apply this function and insert the returned string.
+The function takes the property list of export options as its
+only argument.
+
+Setting :html-postamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No postamble" nil)
+ (const :tag "Auto preamble" 'auto)
+ (const :tag "Default formatting string" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-export-html-postamble-format
+ '(("en" "
Author: %a (%e)
+
Date: %d
+
Generated by %c
+
%v
+"))
+ "The format for the HTML postamble.
+
+%a stands for the author.
+%e stands for the email(s).
+%d stands for the date.
+%c will be replaced by information about Org/Emacs.
+%v will be replaced by `org-export-html-validation-link'.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-home/up-format
+ "
"
+ "Snippet used to insert the HOME and UP links.
+This is a format string, the first %s will receive the UP link,
+the second the HOME link. If both `org-export-html-link-up' and
+`org-export-html-link-home' are empty, the entire snippet will be
+ignored."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-toplevel-hlevel 2
+ "The level for level 1 headings in HTML export.
+This is also important for the classes that will be wrapped around headlines
+and outline structure. If this variable is 1, the top-level headlines will
+be
, and the corresponding classes will be outline-1, section-number-1,
+and outline-text-1. If this is 2, all of these will get a 2 instead.
+The default for this variable is 2, because we use
for formatting the
+document title."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-link-org-files-as-html t
+ "Non-nil means make file links to `file.org' point to `file.html'.
+When org-mode is exporting an org-mode file to HTML, links to
+non-html files are directly put into a href tag in HTML.
+However, links to other Org-mode files (recognized by the
+extension `.org.) should become links to the corresponding html
+file, assuming that the linked org-mode file will also be
+converted to HTML.
+When nil, the links still point to the plain `.org' file."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defcustom org-export-html-inline-images 'maybe
+ "Non-nil means inline images into exported HTML pages.
+This is done using an tag. When nil, an anchor with href is used to
+link to the image. If this option is `maybe', then images in links with
+an empty description will be inlined, while images with a description will
+be linked only."
+ :group 'org-export-html
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When there is no description" maybe)))
+
+(defcustom org-export-html-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif" "svg")
+ "Extensions of image files that can be inlined into HTML."
+ :group 'org-export-html
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-html-table-tag
+ "
"
+ "The HTML tag that is used to start a table.
+This must be a
tag, but you may change the options like
+borders and spacing."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-table-header-tags '("
" . "
")
+ "The opening tag for table header fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-export-html-table-use-header-tags-for-first-column'.
+See also the variable `org-export-html-table-align-individual-fields'."
+ :group 'org-export-tables
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-export-table-data-tags '("
" . "
")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-export-html-table-align-individual-fields'."
+ :group 'org-export-tables
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-export-table-row-tags '("
" . "
")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+Instead of strings, these can be Lisp forms that will be evaluated
+for each row in order to construct the table row tags. During evaluation,
+the variable `head' will be true when this is a header line, nil when this
+is a body line. And the variable `nline' will contain the line number,
+starting from 1 in the first header line. For example
+
+ (setq org-export-table-row-tags
+ (cons '(if head
+ \"
\"
+ (if (= (mod nline 2) 1)
+ \"
\"
+ \"
\"))
+ \"
\"))
+
+will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
+ :group 'org-export-tables
+ :type '(cons
+ (choice :tag "Opening tag"
+ (string :tag "Specify")
+ (sexp))
+ (choice :tag "Closing tag"
+ (string :tag "Specify")
+ (sexp))))
+
+(defcustom org-export-html-table-align-individual-fields t
+ "Non-nil means attach style attributes for alignment to each table field.
+When nil, alignment will only be specified in the column tags, but this
+is ignored by some browsers (like Firefox, Safari). Opera does it right
+though."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-html-table-use-header-tags-for-first-column nil
+ "Non-nil means format column one in tables with header tags.
+When nil, also column one will use data tags."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-html-validation-link
+ "Validate XHTML 1.0"
+ "Link to HTML validation service."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-with-timestamp nil
+ "If non-nil, write timestamp into the exported HTML text.
+If non-nil, write `org-export-html-html-helper-timestamp' into the
+exported HTML text. Otherwise, the buffer will just be saved to
+a file."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defcustom org-export-html-html-helper-timestamp
+ "
\n"
+ "The HTML tag used as timestamp delimiter for HTML-helper-mode."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-protect-char-alist
+ '(("&" . "&")
+ ("<" . "<")
+ (">" . ">"))
+ "Alist of characters to be converted by `org-html-protect'."
+ :type '(repeat (cons (string :tag "Character")
+ (string :tag "HTML equivalent"))))
+
+(defgroup org-export-htmlize nil
+ "Options for processing examples with htmlize.el."
+ :tag "Org Export Htmlize"
+ :group 'org-export-html)
+
+(defcustom org-export-htmlize-output-type 'inline-css
+ "Output type to be used by htmlize when formatting code snippets.
+Choices are `css', to export the CSS selectors only, or `inline-css', to
+export the CSS attribute values inline in the HTML. We use as default
+`inline-css', in order to make the resulting HTML self-containing.
+
+However, this will fail when using Emacs in batch mode for export, because
+then no rich font definitions are in place. It will also not be good if
+people with different Emacs setup contribute HTML files to a website,
+because the fonts will represent the individual setups. In these cases,
+it is much better to let Org/Htmlize assign classes only, and to use
+a style file to define the look of these classes.
+To get a start for your css file, start Emacs session and make sure that
+all the faces you are interested in are defined, for example by loading files
+in all modes you want. Then, use the command
+\\[org-export-htmlize-generate-css] to extract class definitions."
+ :group 'org-export-htmlize
+ :type '(choice (const css) (const inline-css)))
+
+(defcustom org-export-htmlize-css-font-prefix "org-"
+ "The prefix for CSS class names for htmlize font specifications."
+ :group 'org-export-htmlize
+ :type 'string)
+
+(defcustom org-export-htmlized-org-css-url nil
+ "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer, htmlize will
+create CSS to define the font colors. However, this does not work when
+converting in batch mode, and it also can look bad if different people
+with different fontification setup work on the same website.
+When this variable is non-nil, creating an htmlized version of an Org buffer
+using `org-export-as-org' will remove the internal CSS section and replace it
+with a link to this URL."
+ :group 'org-export-htmlize
+ :type '(choice
+ (const :tag "Keep internal css" nil)
+ (string :tag "URL or local href")))
+
+;;; Hooks
+
+(defvar org-export-html-after-blockquotes-hook nil
+ "Hook run during HTML export, after blockquote, verse, center are done.")
+
+(defvar org-export-html-final-hook nil
+ "Hook run at the end of HTML export, in the new buffer.")
+
+;;; HTML export
+
+(defun org-export-html-preprocess (parameters)
+ "Convert LaTeX fragments to images."
+ (when (and org-current-export-file
+ (plist-get parameters :LaTeX-fragments))
+ (org-format-latex
+ (concat "ltxpng/" (file-name-sans-extension
+ (file-name-nondirectory
+ org-current-export-file)))
+ org-current-export-dir nil "Creating LaTeX image %s"
+ nil nil
+ (cond
+ ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
+ ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
+ ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
+ ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)
+ (t nil))))
+ (goto-char (point-min))
+ (let (label l1)
+ (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (setq label (match-string 1))
+ (save-match-data
+ (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label)
+ (setq l1 (substring label (match-beginning 1)))
+ (setq l1 label)))
+ (replace-match (format "[[#%s][%s]]" label l1) t t)))))
+
+(defvar html-table-tag nil) ; dynamically scoped into this.
+
+(defconst org-html-cvt-link-fn
+ nil
+ "Function to convert link URLs to exportable URLs.
+Takes two arguments, TYPE and PATH.
+Returns exportable url as (TYPE PATH), or nil to signal that it
+didn't handle this case.
+Intended to be locally bound around a call to `org-export-as-html'." )
+
+(defun org-html-cvt-org-as-html (opt-plist type path)
+ "Convert an org filename to an equivalent html filename.
+If TYPE is not file, just return `nil'.
+See variable `org-export-html-link-org-files-as-html'"
+
+ (save-match-data
+ (and
+ org-export-html-link-org-files-as-html
+ (string= type "file")
+ (string-match "\\.org$" path)
+ (progn
+ (list
+ "file"
+ (concat
+ (substring path 0 (match-beginning 0))
+ "."
+ (plist-get opt-plist :html-extension)))))))
+
+;;; org-xhtml-format-org-link
+(defun org-xhtml-format-org-link (opt-plist type-1 path fragment desc attr
+ descp)
+ "Make an HTML link.
+OPT-PLIST is an options list.
+TYPE is the device-type of the link (THIS://foo.html)
+PATH is the path of the link (http://THIS#locationx)
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS)
+DESC is the link description, if any.
+ATTR is a string of other attributes of the a element.
+MAY-INLINE-P allows inlining it as an image."
+ (declare (special org-lparse-par-open))
+ (when (string= type-1 "coderef")
+ (setq attr
+ (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
+ fragment fragment)))
+ (save-match-data
+ (let* ((may-inline-p
+ (and (member type-1 '("http" "https" "file"))
+ (org-lparse-should-inline-p path descp)
+ (not fragment)))
+ (type (if (equal type-1 "id") "file" type-1))
+ (filename path)
+ ;;First pass. Just sanity stuff.
+ (components-1
+ (cond
+ ((string= type "file")
+ (list
+ type
+ ;;Substitute just if original path was absolute.
+ ;;(Otherwise path must remain relative)
+ (if (file-name-absolute-p path)
+ (concat "file://" (expand-file-name path))
+ path)))
+ ((string= type "")
+ (list nil path))
+ (t (list type path))))
+
+ ;;Second pass. Components converted so they can refer
+ ;;to a remote site.
+ (components-2
+ (or
+ (and org-html-cvt-link-fn
+ (apply org-html-cvt-link-fn
+ opt-plist components-1))
+ (apply #'org-html-cvt-org-as-html
+ opt-plist components-1)
+ components-1))
+ (type (first components-2))
+ (thefile (second components-2)))
+
+
+ ;;Third pass. Build final link except for leading type
+ ;;spec.
+ (cond
+ ((or
+ (not type)
+ (string= type "http")
+ (string= type "https")
+ (string= type "file")
+ (string= type "coderef"))
+ (if fragment
+ (setq thefile (concat thefile "#" fragment))))
+
+ (t))
+
+ ;;Final URL-build, for all types.
+ (setq thefile
+ (let
+ ((str (org-xml-format-href thefile)))
+ (if (and type (not (or (string= "file" type)
+ (string= "coderef" type))))
+ (concat type ":" str)
+ str)))
+
+ (if may-inline-p
+ (org-xhtml-format-image thefile)
+ (org-lparse-format
+ 'LINK (org-xml-format-desc desc) thefile attr)))))
+
+(defun org-xhtml-format-inline-image (desc)
+ ;; FIXME: alt text missing here?
+ (org-xhtml-format-tags "" "" desc))
+
+(defvar org-lparse-link-description-is-image)
+
+(defun org-xhtml-format-image (src)
+ "Create image tag with source and attributes."
+ (save-match-data
+ (if (string-match "^ltxpng/" src)
+ (format ""
+ src (org-find-text-property-in-string 'org-latex-src src))
+ (let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (attr (org-find-text-property-in-string 'org-attributes src))
+ (label (org-find-text-property-in-string 'org-label src))
+ (caption (and caption (org-xml-encode-org-text caption)))
+ (img (format ""
+ src
+ (if (string-match "\\" . "\n")
+ (concat
+ (org-lparse-format '("\n
") (forward-char 1))
+ (setq bib (buffer-substring beg (point)))
+ (delete-region beg (point))
+ (throw 'exit bib))))
+ nil))))
+
+(defun org-xhtml-format-table (lines olines)
+ (let ((org-xhtml-format-table-no-css nil))
+ (org-lparse-format-table lines olines)))
+
+;; Following variable is defined for native tables i.e., when
+;; `org-lparse-table-is-styled' evals to t.
+(defvar org-xhtml-format-table-no-css)
+(defvar org-table-number-regexp) ; defined in org-table.el
+
+;; FIXME: This function is called from other modules. Use xhtml suffix
+;; to avoid conflict
+(defun org-format-table-xhtml (lines olines &optional no-css)
+ "Find out which HTML converter to use and return the HTML code.
+NO-CSS is passed to the exporter."
+ (let* ((org-lparse-backend 'xhtml)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT))
+ (org-xhtml-format-table-no-css no-css))
+ (org-lparse-format-table lines olines)))
+
+;; FIXME: This function is called from other modules. Use xhtml suffix
+;; to avoid conflict
+(defun org-format-org-table-xhtml (lines &optional splice no-css)
+ ;; This routine might get called outside of org-export-as-html. For
+ ;; example, this could happen as part of org-table-export or as part
+ ;; of org-export-as-docbook. Explicitly bind the parser callback to
+ ;; the html ones for the duration of the call.
+ (let* ((org-lparse-backend 'xhtml)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT))
+ (org-xhtml-format-table-no-css no-css))
+ (org-lparse-format-org-table lines splice)))
+
+(defun org-export-splice-attributes (tag attributes)
+ "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
+ (if (not attributes)
+ tag
+ (let (oldatt newatt)
+ (setq oldatt (org-extract-attributes-from-string tag)
+ tag (pop oldatt)
+ newatt (cdr (org-extract-attributes-from-string attributes)))
+ (while newatt
+ (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
+ (if (string-match ">" tag)
+ (setq tag
+ (replace-match (concat (org-attributes-to-string oldatt) ">")
+ t t tag)))
+ tag)))
+
+;; FIXME: This function is called from other modules. Use xhtml suffix
+;; to avoid conflict
+(defun org-format-table-table-xhtml (lines)
+ (let* ((org-lparse-get 'html)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT)))
+ (org-lparse-format-table-table lines)))
+
+(defun org-export-splice-style (style extra)
+ "Splice EXTRA into STYLE, just before \"\"."
+ (if (and (stringp extra)
+ (string-match "\\S-" extra)
+ (string-match "" style))
+ (concat (substring style 0 (match-beginning 0))
+ "\n" extra "\n"
+ (substring style (match-beginning 0)))
+ style))
+
+(defvar htmlize-buffer-places) ; from htmlize.el
+(defun org-export-htmlize-region-for-paste (beg end)
+ "Convert the region to HTML, using htmlize.el.
+This is much like `htmlize-region-for-paste', only that it uses
+the settings define in the org-... variables."
+ (let* ((htmlize-output-type org-export-htmlize-output-type)
+ (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+;;;###autoload
+(defun org-export-htmlize-generate-css ()
+ "Create the CSS for all font definitions in the current Emacs session.
+Use this to create face definitions in your CSS style file that can then
+be used by code snippets transformed by htmlize.
+This command just produces a buffer that contains class definitions for all
+faces used in the current Emacs session. You can copy and paste the ones you
+need into your CSS file.
+
+If you then set `org-export-htmlize-output-type' to `css', calls to
+the function `org-export-htmlize-region-for-paste' will produce code
+that uses these same face definitions."
+ (interactive)
+ (require 'htmlize)
+ (and (get-buffer "*html*") (kill-buffer "*html*"))
+ (with-temp-buffer
+ (let ((fl (face-list))
+ (htmlize-css-name-prefix "org-")
+ (htmlize-output-type 'css)
+ f i)
+ (while (setq f (pop fl)
+ i (and f (face-attribute f :inherit)))
+ (when (and (symbolp f) (or (not i) (not (listp i))))
+ (insert (org-add-props (copy-sequence "1") nil 'face f))))
+ (htmlize-region (point-min) (point-max))))
+ (switch-to-buffer "*html*")
+ (goto-char (point-min))
+ (if (re-search-forward "