org-export: Memoize results from `org-export-data'

* contrib/lisp/org-export.el (org-export-collect-tree-properties):
  Initialize hash table for memoization.
(org-export-data): Memoize results.
This commit is contained in:
Nicolas Goaziou 2012-07-24 17:02:48 +02:00
parent dbea7e658f
commit 2b6ba84ad6

View file

@ -994,6 +994,11 @@ structure of the values."
;; - category :: option ;; - category :: option
;; - type :: list of strings ;; - type :: list of strings
;; ;;
;; + `:exported-data' :: Hash table used for memoizing
;; `org-export-data'.
;; - category :: tree
;; - type :: hash table
;;
;; + `:footnote-definition-alist' :: Alist between footnote labels and ;; + `:footnote-definition-alist' :: Alist between footnote labels and
;; their definition, as parsed data. Only non-inlined footnotes ;; their definition, as parsed data. Only non-inlined footnotes
;; are represented in this alist. Also, every definition isn't ;; are represented in this alist. Also, every definition isn't
@ -1609,6 +1614,10 @@ DATA is the parse tree from which information is retrieved. INFO
is a list holding export options. is a list holding export options.
Following tree properties are set or updated: Following tree properties are set or updated:
`:exported-data' Hash table used to memoize results from
`org-export-data'.
`:footnote-definition-alist' List of footnotes definitions in `:footnote-definition-alist' List of footnotes definitions in
original buffer and current parse tree. original buffer and current parse tree.
@ -1666,7 +1675,8 @@ Return updated plist."
(when (or (eq (org-element-type blob) 'target) (when (or (eq (org-element-type blob) 'target)
(string= (org-element-property :key blob) "TARGET")) (string= (org-element-property :key blob) "TARGET"))
blob)) info) blob)) info)
:headline-numbering ,(org-export--collect-headline-numbering data info)) :headline-numbering ,(org-export--collect-headline-numbering data info)
:exported-data ,(make-hash-table :test 'eq :size 4001))
info)) info))
(defun org-export--get-min-level (data options) (defun org-export--get-min-level (data options)
@ -1843,7 +1853,8 @@ tag."
;; `org-element-parse-buffer') and transcodes it into a specified ;; `org-element-parse-buffer') and transcodes it into a specified
;; back-end output. It takes care of filtering out elements or ;; back-end output. It takes care of filtering out elements or
;; objects according to export options and organizing the output blank ;; objects according to export options and organizing the output blank
;; lines and white space are preserved. ;; lines and white space are preserved. The function memoizes its
;; results, so it is cheap to call it within translators.
;; ;;
;; Internally, three functions handle the filtering of objects and ;; Internally, three functions handle the filtering of objects and
;; elements during the export. In particular, ;; elements during the export. In particular,
@ -1872,90 +1883,99 @@ DATA is a parse tree, an element or an object or a secondary
string. INFO is a plist holding export options. string. INFO is a plist holding export options.
Return transcoded string." Return transcoded string."
(let* ((type (org-element-type data)) (let ((memo (gethash data (plist-get info :exported-data) 'no-memo)))
(results (if (not (eq memo 'no-memo)) memo
(cond (let* ((type (org-element-type data))
;; Ignored element/object. (results
((memq data (plist-get info :ignore-list)) nil) (cond
;; Plain text. ;; Ignored element/object.
((eq type 'plain-text) ((memq data (plist-get info :ignore-list)) nil)
(org-export-filter-apply-functions ;; Plain text.
(plist-get info :filter-plain-text) ((eq type 'plain-text)
(let ((transcoder (org-export-transcoder data info))) (org-export-filter-apply-functions
(if transcoder (funcall transcoder data info) data)) (plist-get info :filter-plain-text)
info)) (let ((transcoder (org-export-transcoder data info)))
;; Uninterpreted element/object: change it back to Org (if transcoder (funcall transcoder data info) data))
;; syntax and export again resulting raw string. info))
((not (org-export--interpret-p data info)) ;; Uninterpreted element/object: change it back to Org
(org-export-data ;; syntax and export again resulting raw string.
(org-export-expand ((not (org-export--interpret-p data info))
data (org-export-data
(mapconcat (lambda (blob) (org-export-data blob info)) (org-export-expand
(org-element-contents data) data
"")) (mapconcat (lambda (blob) (org-export-data blob info))
info)) (org-element-contents data)
;; Secondary string. ""))
((not type) info))
(mapconcat (lambda (obj) (org-export-data obj info)) data "")) ;; Secondary string.
;; Element/Object without contents or, as a special case, ((not type)
;; headline with archive tag and archived trees restricted (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
;; to title only. ;; Element/Object without contents or, as a special case,
((or (not (org-element-contents data)) ;; headline with archive tag and archived trees restricted
(and (eq type 'headline) ;; to title only.
(eq (plist-get info :with-archived-trees) 'headline) ((or (not (org-element-contents data))
(org-element-property :archivedp data))) (and (eq type 'headline)
(let ((transcoder (org-export-transcoder data info))) (eq (plist-get info :with-archived-trees) 'headline)
(and (functionp transcoder) (funcall transcoder data nil info)))) (org-element-property :archivedp data)))
;; Element/Object with contents. (let ((transcoder (org-export-transcoder data info)))
(t (and (functionp transcoder)
(let ((transcoder (org-export-transcoder data info))) (funcall transcoder data nil info))))
(when transcoder ;; Element/Object with contents.
(let* ((greaterp (memq type org-element-greater-elements)) (t
(objectp (and (not greaterp) (let ((transcoder (org-export-transcoder data info)))
(memq type org-element-recursive-objects))) (when transcoder
(contents (let* ((greaterp (memq type org-element-greater-elements))
(mapconcat (objectp
(lambda (element) (org-export-data element info)) (and (not greaterp)
(org-element-contents (memq type org-element-recursive-objects)))
(if (or greaterp objectp) data (contents
;; Elements directly containing objects (mapconcat
;; must have their indentation normalized (lambda (element) (org-export-data element info))
;; first. (org-element-contents
(org-element-normalize-contents (if (or greaterp objectp) data
data ;; Elements directly containing objects
;; When normalizing contents of the first ;; must have their indentation normalized
;; paragraph in an item or a footnote ;; first.
;; definition, ignore first line's (org-element-normalize-contents
;; indentation: there is none and it data
;; might be misleading. ;; When normalizing contents of the first
(when (eq type 'paragraph) ;; paragraph in an item or a footnote
(let ((parent (org-export-get-parent data))) ;; definition, ignore first line's
(and (eq (car (org-element-contents parent)) ;; indentation: there is none and it
data) ;; might be misleading.
(when (eq type 'paragraph)
(let ((parent (org-export-get-parent data)))
(and
(eq (car (org-element-contents parent))
data)
(memq (org-element-type parent) (memq (org-element-type parent)
'(footnote-definition item)))))))) '(footnote-definition item))))))))
""))) "")))
(funcall transcoder data (funcall transcoder data
(if greaterp (org-element-normalize-string contents) (if (not greaterp) contents
contents) (org-element-normalize-string contents))
info)))))))) info))))))))
(cond ;; Final result will be memoized before being returned.
((not results) nil) (puthash
((memq type '(org-data plain-text nil)) results) data
;; Append the same white space between elements or objects as in (cond
;; the original buffer, and call appropriate filters. ((not results) nil)
(t ((memq type '(org-data plain-text nil)) results)
(let ((results ;; Append the same white space between elements or objects as in
(org-export-filter-apply-functions ;; the original buffer, and call appropriate filters.
(plist-get info (intern (format ":filter-%s" type))) (t
(let ((post-blank (or (org-element-property :post-blank data) 0))) (let ((results
(if (memq type org-element-all-elements) (org-export-filter-apply-functions
(concat (org-element-normalize-string results) (plist-get info (intern (format ":filter-%s" type)))
(make-string post-blank ?\n)) (let ((post-blank (or (org-element-property :post-blank data)
(concat results (make-string post-blank ? )))) 0)))
info))) (if (memq type org-element-all-elements)
;; Eventually return string. (concat (org-element-normalize-string results)
results))))) (make-string post-blank ?\n))
(concat results (make-string post-blank ? ))))
info)))
results)))
(plist-get info :exported-data))))))
(defun org-export--interpret-p (blob info) (defun org-export--interpret-p (blob info)
"Non-nil if element or object BLOB should be interpreted as Org syntax. "Non-nil if element or object BLOB should be interpreted as Org syntax.