>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 - @\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") - (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") - (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
\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 "
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 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" 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 "
[^\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 "" (nth 2 lang-words) ": " date "
\n")) - (when (and (plist-get opt-plist :author-info) author) - (insert " \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\\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 "[ \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 " " - (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 "\\" caption "
") - (if org-par-open "\n" "")))))))) + (with-temp-buffer + (with-org-html-preserve-paragraph-state + (insert + (org-parse-format + '("
" . "
") 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, 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[X]
")
- ((string-match " " checkbox) "[ ]
")
- (t "[-]
"))
+ (org-parse-format
+ 'FONTIFY (concat
+ "["
+ (cond
+ ((string-match "X" checkbox) "X")
+ ((string-match " " checkbox)
+ (org-parse-format 'SPACES 1))
+ (t "-"))
+ "]")
+ 'code)
+ " "
body)))
;; Return modified line
body))
@@ -2527,6 +2083,1132 @@ the alist of previous items."
;; Not at an item: return line unchanged (side-effects only).
(t line))))
+;; miscellaneous
+
+(defun org-html-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))
+
+
+;; This replaces org-emphasis-alist
+(defvar org-table-rowgroup-open)
+(defvar org-table-current-rowgroup-is-header)
+(defvar org-html-footnote-number)
+(defvar org-html-footnote-definitions)
+(defvar org-html-footnote-buffer)
+(defvar org-html-output-buffer)
+
+
+(defun org-html-end-export ()
+ ;; insert the table of contents
+ (when (and org-export-with-toc (not body-only))
+ (org-html-insert-toc org-parse-table-of-contents))
+
+ ;; remove empty paragraphs
+ (goto-char (point-min))
+ (while (re-search-forward "[ \r\n\t]*
" nil t) + (replace-match "")) + + ;; 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 " " + (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)) + + ;; kill temporary buffers + (when org-html-footnote-buffer + (kill-buffer org-html-footnote-buffer)) + + ;; Run the hook + (run-hooks 'org-export-html-final-hook)) + + +;;;_ org-parse.el +;;;_. preamble +;;;_ , user-specific +;;;_ . custom-settings +(defcustom org-parse-debug nil + "" + :group 'org-parse + :type 'boolean) + + + + +;;;_ , callbacks +;;;_ . control callbacks +;;;_ , generic +(defun org-parse-begin (entity &rest args) + (when (and (member org-parse-debug '(t control)) + (not (eq entity 'DOCUMENT-CONTENT))) + (insert (org-parse-format 'COMMENT "%s BEGIN %S" entity args))) + + (let ((f (cadr (assoc entity org-parse-entity-control-callbacks-alist)))) + (unless f (error "Unknown entity: %s" entity)) + (apply f args))) + +(defun org-parse-end (entity &rest args) + (when (and (member org-parse-debug '(t control)) + (not (eq entity 'DOCUMENT-CONTENT))) + (insert (org-parse-format 'COMMENT "%s END %S" entity args))) + + (let ((f (caddr (assoc entity org-parse-entity-control-callbacks-alist)))) + (unless f (error "Unknown entity: %s" entity)) + (apply f args))) + + +;;;_ , paragraph +(defun org-parse-begin-paragraph (&optional style) + "Insert, but first close previous paragraph if any." + (org-parse-end-paragraph) + (org-parse-begin 'PARAGRAPH style) + (setq org-par-open t)) + +(defun org-parse-end-paragraph () + "Close paragraph if there is one open." + (when org-par-open + (org-parse-end 'PARAGRAPH) + (setq org-par-open nil))) + +;;;_ , list +(defun org-close-li (&optional type) + "Close
" extra))) + +(defun org-html-end-paragraph () + (insert "
")) + + +;;;_ , environment +(defun org-html-format-environment (style beg-end) + (assert (memq style '(blockquote center verse fixedwidth quote)) t) + (case style + (blockquote + (case beg-end + (BEGIN + (org-parse-end-paragraph) + (insert "\n") + (org-parse-begin-paragraph)) + (END + (org-parse-end-paragraph) + (insert "\n\n") + (org-parse-begin-paragraph)))) + (verse + (case beg-end + (BEGIN + (org-parse-end-paragraph) + (insert "\n
\n") + (setq org-par-open t)) + (END + (insert "
\n") + (setq org-par-open nil) + (org-parse-begin-paragraph)))) + (center + (case beg-end + (BEGIN + (org-parse-end-paragraph) + (insert "\n\n")) + (END + (insert "\n") + (org-parse-begin-paragraph)))) + (quote + (case beg-end + (BEGIN + (org-parse-end-paragraph) + (insert "
")) + (END + (insert "\n") + (org-parse-begin-paragraph)))) + (t (error "Unknown environment %s" style)))) + + +(defun org-html-begin-environment (style) + (org-html-format-environment style 'BEGIN)) + +(defun org-html-end-environment (style) + (org-html-format-environment style 'END)) + + +;;;_ , list +(defun org-html-html-list-type-to-canonical-list-type (ltype) + (cdr (assoc ltype '(("o" . ordered) + ("u" . unordered) + ("d" . description))))) + +(defun org-html-begin-list (ltype &optional arg1) + (setq ltype (or (org-html-html-list-type-to-canonical-list-type ltype) + ltype)) + + (case ltype + (ordered (let ((extra (if arg1 (format " start=\"%d\"" arg1) ""))) + (org-html-insert-tag "
" . "
"))
+ (verbatim . ("" . "
"))
+ (strike . ("\\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 org-html-dyn-first-heading-pos) + (when (looking-at "\\s-*") + (goto-char (match-end 0)) + (insert "\n"))) + (insert toc)) + +(defun org-html-insert-preamble (opt-plist) + (when (plist-get opt-plist :html-preamble) + (let ((html-pre (plist-get opt-plist :html-preamble)) + (title (plist-get opt-plist :title)) + (date (plist-get opt-plist :effective-date)) + (author (plist-get opt-plist :author)) + (lang-words (plist-get opt-plist :lang-words)) + (email (plist-get opt-plist :email))) + (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))))))))) + +(defun org-html-insert-postamble (opt-plist) + (when org-html-footnote-definitions + (insert + (org-parse-format + 'FOOTNOTES-SECTION (nth 4 (plist-get opt-plist :lang-words)) + (mapconcat (lambda (x) (cdr x)) + (nreverse org-html-footnote-definitions) "\n")))) + (let ((bib (org-export-html-get-bibliography))) + (when bib + (insert "\n" bib "\n"))) + + ;; export html postamble + (unless body-only + (let* ((html-post (plist-get opt-plist :html-postamble)) + (date (plist-get opt-plist :effective-date)) + (author (plist-get opt-plist :author)) + (email (plist-get opt-plist :email)) + (lang-words (plist-get opt-plist :lang-words)) + (html-validation-link (or org-export-html-validation-link "")) + (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 "" (nth 2 lang-words) ": " date "
\n")) + (when (and (plist-get opt-plist :author-info) author) + (insert " \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