ox: Fix :filter-options

* lisp/ox.el (org-export--remove-uninterpreted-data): Do not modify
  communication channel.  Change "blob" to "datum".
(org-export--remove-uninterpreted-data-1): Remove function.
(org-export-as): Remove uninterpreted data from parsed keyword before
applying filters.

* testing/lisp/test-ox.el (test-org-export/uninterpreted): Add test.

Reported-by: Rasmus <rasmus@gmx.us>
<http://permalink.gmane.org/gmane.emacs.orgmode/112730>
This commit is contained in:
Nicolas Goaziou 2017-03-14 18:10:07 +01:00
parent 92ee4d06a2
commit 6cd42b08f9
2 changed files with 44 additions and 39 deletions

View File

@ -2878,83 +2878,67 @@ containing their first reference."
(defun org-export--remove-uninterpreted-data (data info)
"Change uninterpreted elements back into Org syntax.
DATA is the parse tree. INFO is a plist containing export
options. Each uninterpreted element or object is changed back
into a string. Contents, if any, are not modified. The parse
tree is modified by side effect."
(org-export--remove-uninterpreted-data-1 data info)
(dolist (entry org-export-options-alist)
(when (eq (nth 4 entry) 'parse)
(let ((p (car entry)))
(plist-put info
p
(org-export--remove-uninterpreted-data-1
(plist-get info p)
info))))))
(defun org-export--remove-uninterpreted-data-1 (data info)
"Change uninterpreted elements back into Org syntax.
DATA is a parse tree or a secondary string. INFO is a plist
containing export options. It is modified by side effect and
returned by the function."
(org-element-map data
'(entity bold italic latex-environment latex-fragment strike-through
subscript superscript underline)
(lambda (blob)
(lambda (datum)
(let ((new
(cl-case (org-element-type blob)
(cl-case (org-element-type datum)
;; ... entities...
(entity
(and (not (plist-get info :with-entities))
(list (concat
(org-export-expand blob nil)
(org-export-expand datum nil)
(make-string
(or (org-element-property :post-blank blob) 0)
(or (org-element-property :post-blank datum) 0)
?\s)))))
;; ... emphasis...
((bold italic strike-through underline)
(and (not (plist-get info :with-emphasize))
(let ((marker (cl-case (org-element-type blob)
(let ((marker (cl-case (org-element-type datum)
(bold "*")
(italic "/")
(strike-through "+")
(underline "_"))))
(append
(list marker)
(org-element-contents blob)
(org-element-contents datum)
(list (concat
marker
(make-string
(or (org-element-property :post-blank blob)
(or (org-element-property :post-blank datum)
0)
?\s)))))))
;; ... LaTeX environments and fragments...
((latex-environment latex-fragment)
(and (eq (plist-get info :with-latex) 'verbatim)
(list (org-export-expand blob nil))))
(list (org-export-expand datum nil))))
;; ... sub/superscripts...
((subscript superscript)
(let ((sub/super-p (plist-get info :with-sub-superscript))
(bracketp (org-element-property :use-brackets-p blob)))
(bracketp (org-element-property :use-brackets-p datum)))
(and (or (not sub/super-p)
(and (eq sub/super-p '{}) (not bracketp)))
(append
(list (concat
(if (eq (org-element-type blob) 'subscript)
(if (eq (org-element-type datum) 'subscript)
"_"
"^")
(and bracketp "{")))
(org-element-contents blob)
(org-element-contents datum)
(list (concat
(and bracketp "}")
(and (org-element-property :post-blank blob)
(and (org-element-property :post-blank datum)
(make-string
(org-element-property :post-blank blob)
(org-element-property :post-blank datum)
?\s)))))))))))
(when new
;; Splice NEW at BLOB location in parse tree.
(dolist (e new (org-element-extract-element blob))
(unless (equal e "") (org-element-insert-before e blob))))))
;; Splice NEW at DATUM location in parse tree.
(dolist (e new (org-element-extract-element datum))
(unless (equal e "") (org-element-insert-before e datum))))))
info nil nil t)
;; Return modified parse tree.
data)
@ -3045,12 +3029,21 @@ Return code as a string."
(org-export-backend-name backend)))
(org-set-regexps-and-options)
(org-update-radio-target-regexp)
;; Update communication channel with environment. Also
;; install user's and developer's filters.
;; Update communication channel with environment.
(setq info
(org-export-install-filters
(org-combine-plists
info (org-export-get-environment backend subtreep ext-plist))))
(org-combine-plists
info (org-export-get-environment backend subtreep ext-plist)))
;; De-activate uninterpreted data from parsed keywords.
(dolist (entry org-export-options-alist)
(pcase entry
(`(,p ,_ ,_ ,_ parse)
(let ((value (plist-get info p)))
(plist-put info
p
(org-export--remove-uninterpreted-data value info))))
(_ nil)))
;; Install user's and developer's filters.
(setq info (org-export-install-filters info))
;; Call options filters and update export options. We do not
;; use `org-export-filter-apply-functions' here since the
;; arity of such filters is different.

View File

@ -839,7 +839,7 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
(paragraph . (lambda (p c i) c))
(section . (lambda (s c i) c))))
nil nil nil '(:with-sub-superscript nil)))))
;; Also handle uninterpreted objects in title.
;; Handle uninterpreted objects in parsed keywords.
(should
(equal "a_b"
(org-test-with-temp-text "#+TITLE: a_b"
@ -848,9 +848,21 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
:transcoders
'((subscript . (lambda (s c i) "dummy"))
(template . (lambda (c i) (org-export-data
(plist-get i :title) i)))
(plist-get i :title) i)))
(section . (lambda (s c i) c))))
nil nil nil '(:with-sub-superscript nil)))))
;; Objects in parsed keywords are "uninterpreted" before filters are
;; applied.
(should
(org-test-with-temp-text "#+TITLE: a_b"
(org-export-as
(org-export-create-backend
:filters
'((:filter-options
(lambda (i _)
(org-element-map (plist-get i :title) 'subscript
(lambda (_) (error "There should be no subscript here")))))))
nil nil nil '(:with-sub-superscript nil))))
;; Handle uninterpreted objects in captions.
(should
(equal "adummy\n"