mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-27 10:55:04 +00:00
org-export: Allow anonymous functions in translate alists
* contrib/lisp/org-export.el (org-export-transcoder, org-export-data): Allow anonymous functions in translate alists. * testing/lisp/test-org-export.el: Update tests.
This commit is contained in:
parent
0c9ba74955
commit
5a3617c6be
@ -1708,7 +1708,7 @@ INFO is a plist containing export directives."
|
||||
;; Return contents only for complete parse trees.
|
||||
(if (eq type 'org-data) (lambda (blob contents info) contents)
|
||||
(let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
|
||||
(and (fboundp transcoder) transcoder)))))
|
||||
(and (functionp transcoder) transcoder)))))
|
||||
|
||||
(defun org-export-data (data info)
|
||||
"Convert DATA into current back-end format.
|
||||
@ -1750,7 +1750,7 @@ Return transcoded string."
|
||||
(eq (plist-get info :with-archived-trees) 'headline)
|
||||
(org-element-property :archivedp data)))
|
||||
(let ((transcoder (org-export-transcoder data info)))
|
||||
(and (fboundp transcoder) (funcall transcoder data nil info))))
|
||||
(and (functionp transcoder) (funcall transcoder data nil info))))
|
||||
;; Element/Object with contents.
|
||||
(t
|
||||
(let ((transcoder (org-export-transcoder data info)))
|
||||
@ -2393,7 +2393,7 @@ Return code as a string."
|
||||
(plist-get info :translate-alist))))
|
||||
(output (org-export-filter-apply-functions
|
||||
(plist-get info :filter-final-output)
|
||||
(if (or (not (fboundp template)) body-only) body
|
||||
(if (or (not (functionp template)) body-only) body
|
||||
(funcall template body info))
|
||||
info)))
|
||||
;; Maybe add final OUTPUT to kill ring, then return it.
|
||||
|
@ -28,18 +28,14 @@ syntax."
|
||||
(dolist (type (append org-element-all-elements
|
||||
org-element-all-objects)
|
||||
transcode-table)
|
||||
(push (cons type (intern (format "org-%s-%s" backend type)))
|
||||
transcode-table)))))
|
||||
(flet ,(let (transcoders)
|
||||
(dolist (type (append org-element-all-elements
|
||||
org-element-all-objects)
|
||||
transcoders)
|
||||
(push `(,(intern (format "org-%s-%s" backend type))
|
||||
(obj contents info)
|
||||
(,(intern (format "org-element-%s-interpreter" type))
|
||||
obj contents))
|
||||
transcoders)))
|
||||
,@body)))
|
||||
(push
|
||||
(cons type
|
||||
(lambda (obj contents info)
|
||||
(funcall
|
||||
(intern (format "org-element-%s-interpreter" type))
|
||||
obj contents)))
|
||||
transcode-table)))))
|
||||
(progn ,@body)))
|
||||
|
||||
(defmacro org-test-with-parsed-data (data &rest body)
|
||||
"Execute body with parsed data available.
|
||||
@ -421,10 +417,12 @@ body\n")))
|
||||
"Test export snippets transcoding."
|
||||
(org-test-with-temp-text "@@test:A@@@@t:B@@"
|
||||
(org-test-with-backend test
|
||||
(flet ((org-test-export-snippet
|
||||
(snippet contents info)
|
||||
(when (eq (org-export-snippet-backend snippet) 'test)
|
||||
(org-element-property :value snippet))))
|
||||
(let ((org-test-translate-alist
|
||||
(cons (cons 'export-snippet
|
||||
(lambda (snippet contents info)
|
||||
(when (eq (org-export-snippet-backend snippet) 'test)
|
||||
(org-element-property :value snippet))))
|
||||
org-test-translate-alist)))
|
||||
(let ((org-export-snippet-translation-alist nil))
|
||||
(should (equal (org-export-as 'test) "A\n")))
|
||||
(let ((org-export-snippet-translation-alist '(("t" . "test"))))
|
||||
@ -491,10 +489,12 @@ body\n")))
|
||||
* Title
|
||||
Paragraph[fn:1]"
|
||||
(org-test-with-backend test
|
||||
(flet ((org-test-footnote-reference
|
||||
(fn-ref contents info)
|
||||
(org-element-interpret-data
|
||||
(org-export-get-footnote-definition fn-ref info))))
|
||||
(let ((org-test-translate-alist
|
||||
(cons (cons 'footnote-reference
|
||||
(lambda (fn contents info)
|
||||
(org-element-interpret-data
|
||||
(org-export-get-footnote-definition fn info))))
|
||||
org-test-translate-alist)))
|
||||
(forward-line)
|
||||
(should (equal "ParagraphOut of scope\n"
|
||||
(org-export-as 'test 'subtree))))))))
|
||||
|
Loading…
Reference in New Issue
Block a user