From 8ebbd9f81a8abb4ccadc25c512119a6369f03406 Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Sun, 20 Mar 2011 17:37:59 +0530 Subject: [PATCH] Re-implement org-export-as-html and add support for odt backend. * lisp/org.el (org-structure-template-alist): Allow easy insertion of odt blocks. * lisp/org-footnote.el (insertion-point-for-normalized-footnotes): New variable that controls the where the normalized footnote definitions are inserted. Affects only pre-processor related normalization. html and odt backends bind this to `point-min' so that the footnote definitions are seen before the footnote references. (org-footnote-normalize): Honor above var. * lisp/org-exp.el (org-export): Register `org-export-as-odt' and `org-export-as-odt-and-open'. Define default keybindings for the same. (org-export-select-backend-specific-text): Register odt. (org-export-do-format-source-code-or-example): Renamed from `org-export-fromat-source-code-or-example'. (org-export-format-source-code-or-example): New function. Preferentially call backend-specific formatter if available with a fallback to a generic formatter. * lisp/org-html.el (org-do-export): The core generic exporter. Derived from org-export-as-html. Binds `insertion-point-for-normalized-footnotes' to point-min. (org-export-as-html): Make use of `org-do-export'. (org-html-entity-control-callbacks-alist) (org-html-entity-format-callbacks-alist): New variables. (org-html-get): Get callback for html backend. (org-html-get-coding-system-for-save) (org-html-get-coding-system-for-write): Get routines for html backend. (org-html-format-tags, org-html-format-footnotes-section) (org-html-format-footnote-reference, org-html-format-anchor) (org-html-format-headline, org-html-format-heading) (org-html-format-link, org-html-format-fontify) (org-html-format-comment, org-html-format-plain) (org-html-format-horizontal-line, org-html-format-line-break) (org-html-format-tabs, org-html-format-spaces) (org-html-format-table-cell, org-html-format-table-row) (org-html-format-toc-item, org-html-format-toc-entry): Formatting callbacks for html backend. (org-html-begin-footnote-definition) (org-html-end-footnote-definition, org-html-end-table) (org-html-begin-table, org-html-end-table-rowgroup) (org-html-begin-table-rowgroup, org-html-begin-list-item) (org-html-end-list-item, org-html-begin-list) (org-html-end-list) (org-html-html-list-type-to-canonical-list-type) (org-html-begin-environment, org-html-end-environment) (org-html-format-environment, org-html-begin-paragraph) (org-html-end-paragraph, org-html-begin-section) (org-html-end-section, org-html-begin-level) (org-html-end-level, org-html-begin-document-content) (org-html-end-document-content, org-html-begin-document-body) (org-html-end-document-body, org-html-end-export): Control callbacks for html backend. (org-html-protect): New variable. Controls emitting of protected tags - @ ... @ (org-html-emphasis-alist): New variable. Takes over `org-html-emphasis-alist'. (org-html-insert-postamble, org-html-insert-preamble): New functions. Factored out from `org-export-as-html'. (org-parse-table-of-contents): New variable. Contains table of contents. (org-html-prepare-toc): New function that emits table of contents. Uses a temporary buffer for reaping the table of contents and sets `org-parse-table-of-contents'. (org-html-footnote-number, org-html-footnote-definitions): New variables let bound witin `org-do-export'. (org-html-footnote-buffer): New variable. The temporary buffer in which footnote definitions are reaped. (org-html-output-buffer): New variable. The buffer that holds the exported output. (org-table-style, org-table-ncols, org-table-rownum) (org-table-is-styled, org-table-begin-marker) (org-table-num-numeric-items-per-column) (org-table-colalign-info, org-table-colalign-vector) (org-table-get-colalign-info, org-table-rowgroup-info) (org-table-rowgroup-open) (org-table-current-rowgroup-is-header): ): New variables that are let bound by routines that emit tables `org-do-format-org-table-html' and `org-do-format-table-table-html'. (org-format-org-table-html): Derived from `org-format-org-table-html'. (org-do-format-org-table-html): Wrapper around `org-do-format-org-table-html'. Switches to a temporary buffer and returns the formattted table as a string. (org-do-format-table-table-html): Derived from `org-format-table-table-html'. (org-format-table-table-html): Wrapper around `org-do-format-table-table-html'. Switches to a temporary buffer and returns the formattted table as a string. (org-html-export-list-line, org-html-format-section-number) (org-html-format-org-tags, org-html-format-extra-targets) (org-html-format-todo, org-html-insert-toc) (org-html-insert-tag, org-html-bind-local-variables): Newly introduced helper routines. (org-html-format-org-link): Derived from `org-html-make-link'. (org-export-html-format-image): Change signature. Use macro `with-org-html-preserve-paragraph-state'. (org-html-handle-time-stamps) (org-export-html-convert-sub-super): Modified. (org-export-html-convert-emphasize): Modified. Use `org-html-emphasis-alist' instead of `org-emphasis-alist'. (org-html-insert-tag-with-newlines): New variable. Controls inclusion of newlines in the tag related routines. (org-close-li): Modified. (org-html-export-list-line): Modified (org-html-level-start): Renamed to org-html-begin-level. (org-html-level-close): Renamed to org-html-end-level. (with-org-html-preserve-paragraph-state): New macro. (org-open-par): Removed. Superceded by `org-parse-begin-paragraph'. (org-close-par-maybe): Removed. Superceded by `org-parse-end-paragraph'. (org-close-li): Modified. (org-parse-debug): New variable. Use this to embed useful debugging info as comment sections in the exported document. (org-parse-begin, org-parse-end): Parse routines that invoke control callbacks on the backend. (org-parse-format): Parser routine that invokes formatting callbacks on the backend. (org-parse-get): Parser routine that invokes the get callback on the backend. (org-parse-link-description-is-image) (org-parse-dyn-current-environment): New variables that are backend agnostic. (org-parse-begin-paragraph): Derived from `org-open-par'. (org-parse-end-paragraph): Derived from `org-close-par-maybe'. (org-parse-format-org-link, org-parse-format-table-row) (org-parse-end-table, org-parse-begin-table-rowgroup) (org-parse-begin-footnote-definition) (org-parse-end-footnote-definition) (org-parse-current-environment-p, org-parse-begin-environment) (org-parse-end-environment): New routines that are backend agnostic. * lisp/org-odt.el: New backend file for export to OpenDocumentText. * contrib/odt/: New directory. Holds data files used in conjunction with org-odt.el * contrib/odt/OrgOdtAutomaticStyles.xml: * contrib/odt/OrgOdtStyles.xml: Default style file used by org-odt.el * contrib/odt/OpenDocument-schema-v1.1.rng: Copy of http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-schema-v1.1.rng * contrib/odt/OpenDocument-schema-v1.1.rnc: Relax-NG schema file for validating OpenDocumentText files. Auto-generated from rng file using trang - http://www.thaiopensource.com/relaxng/trang.html. * contrib/odt/schemas.xml: Sample schema locating file for use with auto-validation of OpenDocumentText files. * contrib/odt/setup.el: Suggested code for use within user's .emacs file. * contrib/odt/files/: Unit test directory for org-odt.el. * contrib/odt/files/test.org: Sample org file for testing. * contrib/odt/files/org-mode-unicorn.png: Image file for use within the unit test file. --- contrib/odt/OpenDocument-schema-v1.1.rnc | 6444 +++++++++++ contrib/odt/OpenDocument-schema-v1.1.rng |17891 ++++++++++++++++++++++++++++++ contrib/odt/OrgOdtAutomaticStyles.xml | 152 + contrib/odt/OrgOdtStyles.xml | 611 + contrib/odt/files/org-mode-unicorn.png | Bin 0 -> 10527 bytes contrib/odt/files/test.org | 486 + contrib/odt/schemas.xml | 5 + contrib/odt/setup.el | 33 + lisp/org-exp.el | 19 +- lisp/org-footnote.el | 9 +- lisp/org-html.el | 2428 +++-- lisp/org-odt.el | 1365 +++ lisp/org.el | 7 +- 13 files changed, 28571 insertions(+), 879 deletions(-) create mode 100644 contrib/odt/OpenDocument-schema-v1.1.rnc create mode 100644 contrib/odt/OpenDocument-schema-v1.1.rng create mode 100644 contrib/odt/OrgOdtAutomaticStyles.xml create mode 100644 contrib/odt/OrgOdtStyles.xml create mode 100644 contrib/odt/files/org-mode-unicorn.png create mode 100644 contrib/odt/files/test.org create mode 100755 contrib/odt/schemas.xml create mode 100644 contrib/odt/setup.el create mode 100644 lisp/org-odt.el diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 3e84314..90b3c97 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -914,6 +914,8 @@ Pressing `1' will switch between these two options." \[D] export as DocBook [V] export as DocBook, process to PDF, and open +\[o] export as ODT [O] export as ODT and open + \[j] export as TaskJuggler [J] ... and open \[m] export as Freemind mind map @@ -942,6 +944,8 @@ Pressing `1' will switch between these two options." (?g org-export-generic t) (?D org-export-as-docbook t) (?V org-export-as-docbook-pdf-and-open t) + (?o org-export-as-odt t) + (?O org-export-as-odt-and-open nil) (?j org-export-as-taskjuggler t) (?J org-export-as-taskjuggler-and-open t) (?m org-export-as-freemind t) @@ -1603,7 +1607,8 @@ from the buffer." (html "HTML" "BEGIN_HTML" "END_HTML") (beamer "BEAMER" "BEGIN_BEAMER" "END_BEAMER") (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") - (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) + (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX") + (odt "ODT" "BEGIN_ODT" "END_ODT"))) (case-fold-search t) fmt beg beg-content end end-content ind) @@ -2371,7 +2376,7 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-latex-listings-options) ;; defined in org-latex.el (defvar org-export-latex-minted-options) ;; defined in org-latex.el -(defun org-export-format-source-code-or-example +(defun org-export-do-format-source-code-or-example (lang code &optional opts indent caption) "Format CODE from language LANG and return it formatted for export. If LANG is nil, do not add any fontification. @@ -2567,6 +2572,16 @@ INDENT was the original indentation of the block." "#+END_ASCII\n")))) (org-add-props rtn nil 'original-indentation indent)))) +(defun org-export-format-source-code-or-example + (lang code &optional opts indent caption) + (let* ((backend-name (symbol-name org-export-current-backend)) + (f (intern (format "org-export-%s-format-source-code-or-example" + backend-name)))) + (if (fboundp f) + (funcall f lang code opts indent caption) + (org-export-do-format-source-code-or-example + lang code opts indent caption)))) + (defun org-export-number-lines (text &optional skip1 skip2 number cont replace-labels label-format) (setq skip1 (or skip1 0) skip2 (or skip2 0)) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 9dbd6be..e8710d0 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -361,6 +361,8 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-previous-reference (nth 1 tmp))) (t (org-footnote-new))))) +(defvar insertion-point-for-normalized-footnotes 'point-max) + ;;;###autoload (defun org-footnote-normalize (&optional sort-only for-preprocessor) "Collect the footnotes in various formats and normalize them. @@ -460,7 +462,12 @@ referenced sequence." (setq ins-point (point)))) ;; Insert the footnotes again - (goto-char (or ins-point (point-max))) + (goto-char (or (and for-preprocessor + (equal insertion-point-for-normalized-footnotes + 'point-min) + (point-min)) + ins-point + (point-max))) (setq ref-table (reverse ref-table)) (when sort-only ;; remove anonymous and inline footnotes from the list diff --git a/lisp/org-html.el b/lisp/org-html.el index eea425f..fd49715 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -775,10 +775,10 @@ description. See variables `org-export-html-inline-images' and (org-file-image-p filename org-export-html-inline-image-extensions))) -;;; org-html-make-link -(defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. +;;; org-html-format-org-link +(defun org-html-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) @@ -787,82 +787,87 @@ 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-par-open)) - (save-match-data - (let* ((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")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile + (declare (special org-par-open)) + (save-match-data + (let* ((may-inline-p + (and (member type-1 '("http" "https" "file")) + (org-html-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")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + + (t)) + + ;;Final URL-build, for all types. + (setq thefile (let - ((str (org-export-html-format-href thefile))) + ((str (org-export-html-format-href thefile))) (if (and type (not (string= "file" type))) (concat type ":" str) - str))) - - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "" - (org-export-html-format-desc desc) - ""))))) - -(defun org-html-handle-links (line opt-plist) + str))) + + (if may-inline-p + (org-export-html-format-image thefile) + (org-parse-format + 'LINK (org-export-html-format-desc desc) thefile attr))))) + +(defun org-html-format-inline-image (desc) + ;; FIXME: alt text missing here? + (org-html-format-tags '("\"\"" . "") "" desc)) + +(defvar org-parse-link-description-is-image) +(defun org-parse-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)) + (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) + rpl path attr desc descp desc1 desc2 link + org-parse-link-description-is-image) (while (string-match org-bracket-link-analytic-regexp++ line start) + (setq org-parse-link-description-is-image nil) (setq start (match-beginning 0)) (setq path (save-match-data (org-link-unescape (match-string 3 line)))) @@ -882,12 +887,14 @@ OPT-PLIST is the export options list." ;; Make an image out of the description if that is so wanted (when (and descp (org-file-image-p desc org-export-html-inline-image-extensions)) + (setq org-parse-link-description-is-image t) (save-match-data (if (string-match "^file:" desc) (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props - (concat "@") - '(org-protected t)))) + (save-match-data + (setq desc (org-add-props + (org-parse-format 'INLINE-IMAGE desc) + '(org-protected t))))) (cond ((equal type "internal") (let @@ -896,14 +903,11 @@ OPT-PLIST is the export options list." (substring path 1) path))) (setq rpl - (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) + (org-parse-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, @@ -913,28 +917,20 @@ OPT-PLIST is the export options list." id-file (file-name-directory org-current-export-file))) (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) + (org-parse-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-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) + (org-parse-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-html-make-link opt-plist - type path nil - desc - attr - nil))) + (org-parse-format + 'ORG-LINK opt-plist type path nil desc attr descp))) ((string= type "coderef") (let* @@ -943,15 +939,13 @@ OPT-PLIST is the export options list." (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" coderef-str coderef-str))) (setq rpl - (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) + (org-parse-format + 'ORG-LINK opt-plist type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) attr-1 descp)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for format the link @@ -1006,15 +1000,15 @@ OPT-PLIST is the export options list." (functionp link-validate) (not (funcall link-validate path-1 current-dir))) desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) + (org-parse-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 ":" + (setq rpl (concat "<" type ":" (save-match-data (org-link-unescape path)) - ">@")))) + ">")))) (setq line (replace-match rpl t t line) start (+ start (length rpl)))) line)) @@ -1040,6 +1034,12 @@ PUB-DIR is set, use this as the publishing directory." (interactive "P") (run-hooks 'org-export-first-hook) + (let* ((org-parse-get-callback 'org-html-get)) + (org-do-export arg hidden ext-plist to-buffer body-only pub-dir))) + +(defun org-do-export (arg &optional hidden ext-plist + to-buffer body-only pub-dir) + "Export the outline as a pretty HTML file." ;; Make sure we have a file name when we need it. (when (and (not (or to-buffer body-only)) (not buffer-file-name)) @@ -1054,21 +1054,18 @@ PUB-DIR is set, use this as the publishing directory." (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* ((opt-plist + (let* (org-html-protect org-par-open + (org-parse-entity-control-callbacks-alist + (org-parse-get 'ENTITY-CONTROL)) + (org-parse-entity-format-callbacks-alist + (org-parse-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))) - (style (concat (if (plist-get opt-plist :style-include-default) - org-export-html-style-default) - (plist-get opt-plist :style) - (plist-get opt-plist :style-extra) - "\n" - (if (plist-get opt-plist :style-include-scripts) - org-export-html-scripts))) - (html-extension (plist-get opt-plist :html-extension)) - valid thetoc have-headings first-heading-pos + valid org-html-dyn-first-heading-pos (odd org-odd-levels-only) (region-p (org-region-active-p)) (rbeg (and region-p (region-beginning))) @@ -1094,7 +1091,7 @@ PUB-DIR is set, use this as the publishing directory." ;; The following two are dynamically scoped into other ;; routines below. (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) + (or pub-dir (org-parse-get 'EXPORT-DIR opt-plist))) (org-current-export-file buffer-file-name) (level 0) (line "") (origline "") txt todo (umax nil) @@ -1107,21 +1104,29 @@ PUB-DIR is set, use this as the publishing directory." (org-entry-get (region-beginning) "EXPORT_FILE_NAME" t)) (file-name-nondirectory buffer-file-name))) - "." html-extension) + "." (org-parse-get 'FILE-NAME-EXTENSION opt-plist)) (file-name-as-directory - (or pub-dir (org-export-directory :html opt-plist)))))) + (or pub-dir (org-parse-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 HTML Export*")) + ((eq to-buffer 'string) + (get-buffer-create (org-parse-get 'EXPORT-BUFFER-NAME))) (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) + (find-file-noselect + (or (let ((f (org-parse-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)) - (author (plist-get opt-plist :author)) - (html-validation-link (or org-export-html-validation-link "")) + (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-html-expand (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) @@ -1133,47 +1138,33 @@ PUB-DIR is set, use this as the publishing directory." (file-name-sans-extension (file-name-nondirectory buffer-file-name))) "UNTITLED"))) - (link-up (and (plist-get opt-plist :link-up) - (string-match "\\S-" (plist-get opt-plist :link-up)) - (plist-get opt-plist :link-up))) - (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) (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 "\\>\\)")) - (inquote nil) - (infixed nil) - (inverse nil) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (keywords (plist-get opt-plist :keywords)) - (description (plist-get opt-plist :description)) - (lang-words nil) + (org-parse-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 (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-html-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-html-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) + (coding-system-for-write (org-html-get-coding-system-for-write)) + (save-buffer-coding-system (org-html-get-coding-system-for-save)) (region (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) (org-export-have-math nil) + (insertion-point-for-normalized-footnotes 'point-min) + (org-parse-backend (org-parse-get 'BACKEND)) (lines (org-split-string (org-export-preprocess-string region :emph-multiline t - :for-backend 'html + :for-backend org-parse-backend :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :drawers (plist-get opt-plist :drawers) @@ -1191,22 +1182,17 @@ PUB-DIR is set, use this as the publishing directory." :LaTeX-fragments (plist-get opt-plist :LaTeX-fragments)) "[\r\n]")) - (mathjax - (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) - (and org-export-have-math - (eq (plist-get opt-plist :LaTeX-fragments) t))) - - (org-export-html-mathjax-config - org-export-html-mathjax-template - org-export-html-mathjax-options - (or (plist-get opt-plist :mathjax) "")) - "")) table-open table-buffer table-orig-buffer ind rpl path attr desc descp desc1 desc2 link snumber fnc footnotes footref-seen + org-html-output-buffer + org-html-footnote-definitions + org-html-footnote-number + org-html-footnote-buffer + org-parse-table-of-contents href ) @@ -1216,23 +1202,11 @@ PUB-DIR is set, use this as the publishing directory." '(:org-license-to-kill t)))) (message "Exporting...") - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) (org-init-section-numbers) - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - ;; Switch to the output buffer - (set-buffer buffer) + (setq org-html-output-buffer buffer) + (set-buffer org-html-output-buffer) (let ((inhibit-read-only t)) (erase-buffer)) (fundamental-mode) (org-install-letbind) @@ -1253,187 +1227,40 @@ PUB-DIR is set, use this as the publishing directory." (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-html-prepare-toc + lines level-offset opt-plist umax-toc))) + (unless body-only - ;; File header - (insert (format - "%s - - - -%s - - - - - - -%s -%s - - -
-%s -" - (format - (or (and (stringp org-export-html-xml-declaration) - org-export-html-xml-declaration) - (cdr (assoc html-extension org-export-html-xml-declaration)) - (cdr (assoc "html" org-export-html-xml-declaration)) - - "") - (or charset "iso-8859-1")) - language language - title - (or charset "iso-8859-1") - date author description keywords - style - mathjax - (if (or link-up link-home) - (concat - (format org-export-html-home/up-format - (or link-up link-home) - (or link-home link-up)) - "\n") - ""))) - - ;; insert html preamble - (when (plist-get opt-plist :html-preamble) - (let ((html-pre (plist-get opt-plist :html-preamble))) - (cond ((stringp html-pre) - (insert - (format-spec html-pre `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))) - ((functionp html-pre) - (funcall html-pre opt-plist)) - (t - (insert - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))))))) - - (if (and org-export-with-toc (not body-only)) - (progn - (push (format "%s\n" - org-export-html-toplevel-hlevel - (nth 3 lang-words) - org-export-html-toplevel-hlevel) - thetoc) - (push "
\n" thetoc) - (push "
    \n
  • " thetoc) - (setq lines - (mapcar '(lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match "    \\1" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n
      \n
    • " thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "
      • \n
    " thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@" (match-string 1 line) "@ ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "_" (format "sec-%s" snumber))) - (setq href (org-solidify-link-text (or (cdr (assoc href org-export-preferred-target-alist)) href))) - (push - (format - (if todo - "
    • \n
  • %s" - "
    • \n
  • %s") - href txt) thetoc) - - (setq org-last-level level)) - ))) - line) - lines)) - (while (> org-last-level (1- org-min-level)) - (setq org-last-level (1- org-last-level)) - (push "
    • \n
\n" thetoc)) - (push "
\n" thetoc) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) + (org-parse-begin 'DOCUMENT-CONTENT opt-plist) + (org-parse-begin 'DOCUMENT-BODY opt-plist)) (setq head-count 0) (org-init-section-numbers) - (org-open-par) + (org-parse-begin-paragraph) (while (setq line (pop lines) origline line) (catch 'nextline + (when (and (org-parse-current-environment-p 'quote) + (string-match "^\\*+ " line)) + (org-parse-end-environment 'quote)) - ;; end of quote section? - (when (and inquote (string-match "^\\*+ " line)) - (insert "\n") - (org-open-par) - (setq inquote nil)) - ;; inside a quote section? - (when inquote - (insert (org-html-protect line) "\n") + (when (org-parse-current-environment-p 'quote) + (insert (org-parse-format 'PLAIN line)) (throw 'nextline nil)) ;; Fixed-width, verbatim lines (examples) (when (and org-export-with-fixed-width (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not infixed) - (setq infixed t) - (org-close-par-maybe) - - (insert "
\n"))
-	    (insert (org-html-protect (match-string 3 line)) "\n")
+	    (when (not (org-parse-current-environment-p 'fixedwidth))
+	      (org-parse-begin-environment 'fixedwidth))
+	    (insert (org-parse-format 'PLAIN (match-string 3 line)))
 	    (when (or (not lines)
 		      (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
 					 (car lines))))
-	      (setq infixed nil)
-	      (insert "
\n") - (org-open-par)) + (org-parse-end-environment 'fixedwidth)) (throw 'nextline nil)) ;; Protected HTML @@ -1442,62 +1269,37 @@ lang=\"%s\" xml:lang=\"%s\"> (not (< (or (next-single-property-change 0 'org-protected line) 10000) (length line)))) - (let (par (ind (get-text-property 0 'original-indentation line))) - (when (re-search-backward - "\\(

\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert line "\n") - (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)))) - (insert (pop lines) "\n")) - (and par (insert "

\n"))) + (let ((ind (get-text-property 0 'original-indentation line))) + (with-org-html-preserve-paragraph-state + (insert (org-parse-format 'PLAIN 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)))) + (insert (org-parse-format 'PLAIN (pop lines)))))) (throw 'nextline nil)) ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" line) - (org-close-par-maybe) - (insert "

\n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" line) - (org-close-par-maybe) - (insert "\n
\n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" line) - (org-close-par-maybe) - (insert "\n

\n") - (setq org-par-open t) - (setq inverse t) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" line) - (insert "

\n") - (setq org-par-open nil) - (org-open-par) - (setq inverse nil) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" line) - (org-close-par-maybe) - (insert "\n
") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" line) - (org-close-par-maybe) - (insert "\n
") - (org-open-par) - (throw 'nextline nil)) + (when (string-match "^ORG-\\(.+\\)-\\(START\\|END\\)$" line) + (let* ((style (intern (downcase (match-string 1 line)))) + (f (cdr (assoc (match-string 2 line) + '(("START" . org-parse-begin-environment) + ("END" . org-parse-end-environment)))))) + (when (memq style '(blockquote verse center)) + (funcall f style) + (throw 'nextline nil)))) + (run-hooks 'org-export-html-after-blockquotes-hook) - (when inverse + (when (org-parse-current-environment-p 'verse) (let ((i (org-get-string-indentation line))) (if (> i 0) - (setq line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim line)))) + (setq line (concat + (let ((org-html-protect t)) + (org-parse-format 'SPACES (* 2 i))) + " " (org-trim line)))) (unless (string-match "\\\\\\\\[ \t]*$" line) (setq line (concat line "\\\\"))))) @@ -1510,27 +1312,31 @@ lang=\"%s\" xml:lang=\"%s\"> (setq start (match-end 1))) ((match-end 2) (setq line (replace-match - (format - "@@" - (org-solidify-link-text (match-string 1 line)) - (org-solidify-link-text (match-string 1 line))) + (let ((org-html-protect t)) + (org-parse-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 - (concat "@" - (match-string 1 line) "@ ") + (let ((org-html-protect t)) + (org-parse-format + 'FONTIFY (match-string 1 line) "target")) ;; (concat "@" (match-string 1 line) "@ ") t t line))) (t (setq line (replace-match - (concat "@" (match-string 1 line) - "@ ") + (concat + (let ((org-html-protect t)) + (org-parse-format + 'ANCHOR (match-string 1 line) + (org-solidify-link-text (match-string 1 line)) + "target")) " ") t t line))))) - (setq line (org-html-handle-time-stamps line)) + (let ((org-html-protect t)) + (setq line (org-html-handle-time-stamps line))) ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") @@ -1538,44 +1344,37 @@ lang=\"%s\" xml:lang=\"%s\"> (or (string-match org-table-hline-regexp line) (setq line (org-html-expand line))) - ;; Format the links - (setq line (org-html-handle-links line opt-plist)) + (setq line (org-parse-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-export-html-get-todo-kwd-class-name - (match-string 2 line)) - "" (substring line (match-end 2))))) + (setq line (concat + (substring line 0 (match-beginning 2)) + (org-parse-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].*?\\)\\[\\([0-9]+\\)\\]" line start) + (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start) (if (get-text-property (match-beginning 2) 'org-protected line) (setq start (match-end 2)) - (let ((n (match-string 2 line)) extra a) + (let ((n (match-string 2 line)) refcnt a) (if (setq a (assoc n footref-seen)) (progn (setcdr a (1+ (cdr a))) - (setq extra (format ".%d" (cdr a)))) - (setq extra "") + (setq refcnt (cdr a))) + (setq refcnt 1) (push (cons n 1) footref-seen)) (setq line (replace-match - (format - (concat "%s" - (format org-export-html-footnote-format - "%s")) - (or (match-string 1 line) "") n extra n n) + (concat + (or (match-string 1 line) "") + (org-parse-format + 'FOOTNOTE-REFERENCE + n (cdr (assoc n org-html-footnote-definitions)) + refcnt)) t t line)))))) (cond @@ -1588,16 +1387,15 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - (setq first-heading-pos (or first-heading-pos (point))) - (org-html-level-start level txt umax - (and org-export-with-toc (<= level umax)) - head-count) + (unless org-html-dyn-first-heading-pos + (setq org-html-dyn-first-heading-pos (point))) + (org-parse-begin 'LEVEL level txt umax + (and org-export-with-toc (<= level umax)) + head-count) ;; QUOTES (when (string-match quote-re line) - (org-close-par-maybe) - (insert "
")
-	      (setq inquote t)))
+	      (org-parse-begin-environment 'quote)))
 
 	   ((and org-export-with-tables
 		 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
@@ -1614,7 +1412,7 @@ lang=\"%s\" xml:lang=\"%s\">
 	      (setq table-open nil
 		    table-buffer (nreverse table-buffer)
 		    table-orig-buffer (nreverse table-orig-buffer))
-	      (org-close-par-maybe)
+	      (org-parse-end-paragraph)
 	      (insert (org-format-table-html table-buffer table-orig-buffer))))
 
 	   ;; Normal lines
@@ -1630,15 +1428,18 @@ lang=\"%s\" xml:lang=\"%s\">
 
 	    ;; Horizontal line
 	    (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
-	      (if org-par-open
-		  (insert "\n
\n
\n
\n")
-		(insert "\n
\n"))
+	      (with-org-html-preserve-paragraph-state
+	       (insert (org-parse-format '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.
-	    (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
+	    (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
+	      (when org-html-footnote-number
+		(org-parse-end-footnote-definition org-html-footnote-number)
+		(setq org-html-footnote-number nil))
+	      (org-parse-begin-paragraph))
 
 	    ;; Is this the start of a footnote?
 	    (when org-export-with-footnotes
@@ -1648,26 +1449,24 @@ lang=\"%s\" xml:lang=\"%s\">
 		;; ignore this line
 		(throw 'nextline nil))
 	      (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
-		(org-close-par-maybe)
-		(let ((n (match-string 1 line)))
-		  (setq org-par-open t
-			line (replace-match
-			      (format
-			       (concat "
"
-				       (format org-export-html-footnote-format
-					       "%s"))
-			       n n n) t t line)))))
+		(org-parse-end-paragraph)
+		(setq org-html-footnote-number (match-string 1 line))
+		(setq line (replace-match "" t t line))
+		(org-parse-begin-footnote-definition org-html-footnote-number)))
 	    ;; Check if the line break needs to be conserved
 	    (cond
 	     ((string-match "\\\\\\\\[ \t]*$" line)
-	      (setq line (replace-match "
" t t line)))
+	      (setq line (replace-match
+			  (org-parse-format 'LINE-BREAK)
+			  t t line)))
 	     (org-export-preserve-breaks
-	      (setq line (concat line "
"))))
+	      (setq line (concat line (org-parse-format 'LINE-BREAK)))))
 
 	    ;; Check if a paragraph should be started
 	    (let ((start 0))
 	      (while (and org-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)
@@ -1675,139 +1474,42 @@ lang=\"%s\" xml:lang=\"%s\">
 		    (setq line (replace-match "
" t t line)))
 		(setq start (match-end 0))))
 
-	    (insert line "\n")))))
+	    (insert (org-parse-format 'PLAIN line))))))
 
       ;; Properly close all local lists and other lists
-      (when inquote
-	(insert "
\n") - (org-open-par)) + (when (org-parse-current-environment-p 'quote) + (org-parse-end-environment 'quote)) + + (org-parse-end 'LEVEL 1 umax) - (org-html-level-start 1 nil umax - (and org-export-with-toc (<= level umax)) - head-count) ;; the
to close the last text-... div. - (when (and (> umax 0) first-heading-pos) (insert "\n")) + (when (and (> umax 0) org-html-dyn-first-heading-pos) + (org-parse-end 'SECTION)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "

[^\000]*?\\(

\\|\\'\\)" nil t) - (push (match-string 0) footnotes) - (replace-match "" t t))) - (when footnotes - (insert (format org-export-html-footnotes-section - (nth 4 lang-words) - (mapconcat 'identity (nreverse footnotes) "\n")) - "\n")) - (let ((bib (org-export-html-get-bibliography))) - (when bib - (insert "\n" bib "\n"))) - - ;; export html postamble + (org-parse-end 'DOCUMENT-BODY opt-plist) (unless body-only - (let ((html-post (plist-get opt-plist :html-postamble)) - (email - (mapconcat (lambda(e) - (format "%s" e e)) - (split-string email ",+ *") - ", ")) - (creator-info - (concat "Org version " org-version " with Emacs version " - (number-to-string emacs-major-version)))) - (when (plist-get opt-plist :html-postamble) - (cond ((stringp html-post) - (insert "
\n") - (insert (format-spec html-post - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))) - (insert "
")) - ((functionp html-post) - (funcall html-post opt-plist)) - ((eq html-post 'auto) - ;; fall back on default postamble - (insert "
\n") - (when (plist-get opt-plist :time-stamp-file) - (insert "

" (nth 2 lang-words) ": " date "

\n")) - (when (and (plist-get opt-plist :author-info) author) - (insert "

" (nth 1 lang-words) ": " author "

\n")) - (when (and (plist-get opt-plist :email-info) email) - (insert "

" email "

\n")) - (when (plist-get opt-plist :creator-info) - (insert "

" - (concat "Org version " org-version " with Emacs version " - (number-to-string emacs-major-version) "

\n"))) - (insert html-validation-link "\n
")) - (t - (insert "
\n") - (insert (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-postamble-format)) - (cadr (assoc "en" org-export-html-postamble-format))) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))) - (insert "
")))))) - - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - - (unless body-only (insert "\n\n\n\n")) + (org-parse-end 'DOCUMENT-CONTENT)) (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode (default-value 'major-mode)) - (html-mode))) + (set-auto-mode t)) + + (org-parse-end 'EXPORT) - ;; insert the table of contents - (goto-char (point-min)) - (when thetoc - (if (or (re-search-forward - "

\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*

" nil t) - (re-search-forward - "\\[TABLE-OF-CONTENTS\\]" nil t)) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos) - (when (looking-at "\\s-*

") - (goto-char (match-end 0)) - (insert "\n"))) - (insert "
\n") - (let ((beg (point))) - (mapc 'insert thetoc) - (insert "
\n") - (while (re-search-backward "
  • [ \r\n\t]*
    • \n?" beg t) - (replace-match "")))) - ;; 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)) - ;; Run the hook - (run-hooks 'org-export-html-final-hook) - (or to-buffer (save-buffer)) (goto-char (point-min)) - (or (org-export-push-to-kill-ring "HTML") + (or (org-export-push-to-kill-ring + (upcase (symbol-name org-parse-backend))) (message "Exporting... done")) - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) + + (cond + ((not to-buffer) + (let ((f (org-parse-get 'SAVE-METHOD))) + (or (and f (functionp f) (funcall f filename)) + (save-buffer))) + (current-buffer)) + ((eq to-buffer 'string) + (prog1 (buffer-substring (point-min) (point-max)) + (kill-buffer (current-buffer)))) + (t (current-buffer)))))) (defun org-export-html-format-href (s) "Make sure the S is valid as a href reference in an XHTML document." @@ -1825,7 +1527,7 @@ lang=\"%s\" xml:lang=\"%s\"> (org-html-do-expand s)) s)) -(defun org-export-html-format-image (src par-open) +(defun org-export-html-format-image (src) "Create image tag with source and attributes." (save-match-data (if (string-match "^ltxpng/" src) @@ -1833,24 +1535,29 @@ lang=\"%s\" xml:lang=\"%s\"> 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))) - (setq caption (and caption (org-html-do-expand caption))) - (concat - (if caption - (format "%s
    -

    " - (if org-par-open "

    \n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "" - src - (if (string-match "\\" + src + (if (string-match "\\%s -
    %s" - (concat "\n

    " caption "

    ") - (if org-par-open "\n

    " "")))))))) + (with-temp-buffer + (with-org-html-preserve-paragraph-state + (insert + (org-parse-format + '("

    " . "\n
    ") + (concat + (org-parse-format '("\n

    " . "

    ") img) + (org-parse-format '("\n

    " . "

    ") caption)) + extra))) + (buffer-string)) + img))))) (defun org-export-html-get-bibliography () "Find bibliography, cut it out and return it." @@ -1897,8 +1604,26 @@ NO-CSS is passed to the exporter." ;; Need to use the code generator in table.el, with the original text. (org-format-table-table-html-using-table-generate-source olines))))) +(defun org-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-table-style) +(defvar org-table-ncols) +(defvar org-table-rownum) + +(defvar org-table-is-styled) +(defvar org-table-begin-marker) +(defvar org-table-num-numeric-items-per-column) +(defvar org-table-colalign-info) +(defvar org-table-colalign-vector) (defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice no-css) +(defun org-do-format-org-table-html (lines &optional splice no-css) "Format a table into HTML. LINES is a list of lines. Optional argument SPLICE means, do not insert header and surrounding tags, just format the lines. @@ -1916,131 +1641,53 @@ for formatting. This is required for the DocBook exporter." (setq lines (org-table-clean-before-export lines))) (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) + (caption (and caption (org-html-do-expand caption))) (label (org-find-text-property-in-string 'org-label (car lines))) - (forced-aligns (org-find-text-property-in-string 'org-forced-aligns - (car lines))) + (org-table-colalign-info (org-table-get-colalign-info lines)) (attributes (org-find-text-property-in-string 'org-attributes (car lines))) - (html-table-tag (org-export-splice-attributes - html-table-tag attributes)) (head (and org-export-highlight-first-table-line (delq nil (mapcar (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) - (nline 0) fnum nfields i (cnt 0) - tbopen line fields html gr colgropen rowstart rowend - ali align aligns n) - (setq caption (and caption (org-html-do-expand caption))) - (when (and forced-aligns org-table-clean-did-remove-column) - (setq forced-aligns - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns))) - (if splice (setq head nil)) - (unless splice (push (if head "" "") html)) - (setq tbopen t) - (while (setq line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0) - nfields (length fnum))) - (setq nline (1+ nline) i -1 - rowstart (eval (car org-export-table-row-tags)) - rowend (eval (cdr org-export-table-row-tags))) - (push (concat rowstart - (mapconcat - (lambda (x) - (setq i (1+ i) ali (format "@@class%03d@@" i)) - (if (and (< i nfields) ; make sure no rogue line causes an error here - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (cond - (head - (concat - (format (car org-export-table-header-tags) - "col" ali) - x - (cdr org-export-table-header-tags))) - ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) - (concat - (format (car org-export-table-header-tags) - "row" ali) - x - (cdr org-export-table-header-tags))) - (t - (concat (format (car org-export-table-data-tags) ali) - x - (cdr org-export-table-data-tags))))) - fields "") - rowend) - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
    \n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortunately often ignored...) - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - (setq i 0) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info) - i (1+ i) - align (if (assoc i forced-aligns) - (cdr (assoc (cdr (assoc i forced-aligns)) - '(("l" . "left") ("r" . "right") - ("c" . "center")))) - (if (> (/ (float x) nline) - org-table-number-fraction) - "right" "left"))) - (push align aligns) - (format (if no-css - "%s%s" - "%s%s") - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen - "\n" - "") - (setq colgropen t)) - "") - align - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (setq aligns (nreverse aligns)) - (if colgropen (setq html (cons (car html) - (cons "" (cdr html))))) - ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, we want to always include the caption to make - ;; DocBook XML file valid. - (push (format "%s" (or caption "")) html) - (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) - (push html-table-tag html)) - (setq html (mapcar - (lambda (x) - (replace-regexp-in-string - "@@class\\([0-9]+\\)@@" - (lambda (txt) - (if (not org-export-html-table-align-individual-fields) - "" - (setq n (string-to-number (match-string 1 txt))) - (format (if no-css " align=\"%s\"" " class=\"%s\"") - (or (nth n aligns) "left")))) - x)) - html)) - (concat (mapconcat 'identity html "\n") "\n"))) + (org-table-rownum -1) org-table-ncols i (cnt 0) + tbopen line fields + org-table-current-rowgroup-is-header + org-table-rowgroup-open + org-table-num-numeric-items-per-column + org-table-colalign-vector n + org-table-rowgroup-info + org-table-begin-marker + (org-table-style 'org-table) + org-table-is-styled) + (cond + (splice + (setq org-table-is-styled nil) + (while (setq line (pop lines)) + (unless (string-match "^[ \t]*|-" line) + (insert + (org-parse-format-table-row + (org-split-string line "[ \t]*|[ \t]*")) "\n")))) + (t + (setq org-table-is-styled t) + (org-parse-begin 'TABLE caption label attributes) + (setq org-table-begin-marker (point)) + (org-parse-begin-table-rowgroup head) + (while (setq line (pop lines)) + (cond + ((string-match "^[ \t]*|-" line) + (when lines (org-parse-begin-table-rowgroup))) + (t + (insert + (org-parse-format-table-row + (org-split-string line "[ \t]*|[ \t]*")) "\n")))) + (org-parse-end 'TABLE-ROWGROUP) + (org-parse-end-table))))) + +(defun org-format-org-table-html (lines &optional splice no-css) + (with-temp-buffer + (org-do-format-org-table-html lines splice no-css) + (buffer-substring-no-properties (point-min) (point-max)))) (defun org-export-splice-attributes (tag attributes) "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." @@ -2058,53 +1705,47 @@ for formatting. This is required for the DocBook exporter." t t tag))) tag))) -(defun org-format-table-table-html (lines) +(defun org-do-format-table-table-html (lines) "Format a table generated by table.el into HTML. 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 - (head org-export-highlight-first-table-line) - fields html empty i) - (setq html (concat html-table-tag "\n")) + (org-table-current-rowgroup-is-header + org-export-highlight-first-table-line) + (caption nil) + (attributes nil) + (label nil) + (org-table-style 'table-table) + (org-table-is-styled nil) + fields org-table-ncols i (org-table-rownum -1)) + (org-parse-begin 'TABLE caption label attributes) (while (setq line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat - (format (car org-export-table-header-tags) "col" "") - x - (cdr org-export-table-header-tags)) - (concat (format (car org-export-table-data-tags) "") x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) + (setq empty (org-parse-format 'SPACES 1)) + (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-parse-format-table-row field-buffer empty))) + (setq org-table-current-rowgroup-is-header 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 "
    " (pop fields))) + (concat x (org-parse-format 'LINE-BREAK) + (pop fields))) field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) + (setq field-buffer fields))))) + (org-parse-end-table))) + +(defun org-format-table-table-html (lines) + (with-temp-buffer + (org-do-format-table-table-html lines) + (buffer-substring-no-properties (point-min) (point-max)))) (defun org-format-table-table-html-using-table-generate-source (lines) "Format a table into html, using `table-generate-source' from table.el. @@ -2141,21 +1782,25 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (or b (setq b (substring s 0 (match-beginning 0)))) (setq r (concat r (substring s 0 (match-beginning 0)) - " @" - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1)) - "@") + (org-parse-format + 'FONTIFY + (concat + (if (match-end 1) + (org-parse-format + 'FONTIFY + (match-string 1 s) "timestamp-kwd")) + (org-parse-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 "
    "))) + (setq r (concat r (org-parse-format 'LINE-BREAK)))) r)))) (defvar htmlize-buffer-places) ; from htmlize.el @@ -2281,13 +1926,14 @@ If there are links in the string, don't modify these." (setq s (match-end 2))) (t (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") + 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) - "<" key ">" c "") + (org-parse-format 'FONTIFY c key)) t t string))))) (while (string-match "\\\\\\([_^]\\)" string) (setq string (replace-match (match-string 1 string) t t string))) @@ -2304,113 +1950,24 @@ If there are links in the string, don't modify these." rpl (concat (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) + (org-parse-format + 'FONTIFY (match-string 4 string) + (nth 1 (assoc (match-string 3 string) + org-html-emphasis-alist))) (match-string 5 string)) string (replace-match rpl t t string) s (+ s (- (length rpl) 2))) (setq s (1+ s)))) string)) -(defun org-open-par () - "Insert

    , but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

    ") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

    ") - (setq org-par-open nil))) -(defun org-close-li (&optional type) - "Close
  • if necessary." - (org-close-par-maybe) - (insert (if (equal type "d") "\n" "
    • \n"))) +(defmacro with-org-html-preserve-paragraph-state (&rest body) + `(let ((org-do-open-par org-par-open)) + (org-parse-end-paragraph) + ,@body + (when org-do-open-par + (org-parse-begin-paragraph)))) (defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets (and target - (assoc target org-export-target-aliases))) - (extra-class (and title (org-get-text-property-any 0 'html-container-class title))) - (preferred (and target - (cdr (assoc target org-export-preferred-target-alist)))) - (l org-level-max) - snumber snu href suffix) - (setq extra-targets (remove (or preferred target) extra-targets)) - (setq extra-targets - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (format "" - x x)) - extra-targets - "")) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat - (lambda (x) - (format "%s" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (if target - (insert (format "
  • " (org-solidify-link-text (or preferred target))) - extra-targets title "
    \n") - (insert "
  • " title "
    \n"))) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (if target - (insert (format "