Merge branch 'maint'

This commit is contained in:
Nicolas Goaziou 2017-01-11 00:27:07 +01:00
commit 7404e3d22a
2 changed files with 65 additions and 76 deletions

View File

@ -1805,12 +1805,23 @@ INFO is a plist holding export options."
(funcall walk-data data nil) (funcall walk-data data nil)
selected-trees)))) selected-trees))))
(defun org-export--skip-p (blob options selected) (defun org-export--skip-p (datum options selected)
"Non-nil when element or object BLOB should be skipped during export. "Non-nil when element or object DATUM should be skipped during export.
OPTIONS is the plist holding export options. SELECTED, when OPTIONS is the plist holding export options. SELECTED, when
non-nil, is a list of headlines or inlinetasks belonging to non-nil, is a list of headlines or inlinetasks belonging to
a tree with a select tag." a tree with a select tag."
(cl-case (org-element-type blob) (cl-case (org-element-type datum)
((comment comment-block)
;; Skip all comments and comment blocks. Make to keep maximum
;; number of blank lines around the comment so as to preserve
;; local structure of the document upon interpreting it back into
;; Org syntax.
(let* ((previous (org-export-get-previous-element datum options))
(before (or (org-element-property :post-blank previous) 0))
(after (or (org-element-property :post-blank datum) 0)))
(when previous
(org-element-put-property previous :post-blank (max before after 1))))
t)
(clock (not (plist-get options :with-clocks))) (clock (not (plist-get options :with-clocks)))
(drawer (drawer
(let ((with-drawers-p (plist-get options :with-drawers))) (let ((with-drawers-p (plist-get options :with-drawers)))
@ -1820,7 +1831,7 @@ a tree with a select tag."
;; every drawer whose name belong to that list. ;; every drawer whose name belong to that list.
;; Otherwise, ignore drawers whose name isn't in that ;; Otherwise, ignore drawers whose name isn't in that
;; list. ;; list.
(let ((name (org-element-property :drawer-name blob))) (let ((name (org-element-property :drawer-name datum)))
(if (eq (car with-drawers-p) 'not) (if (eq (car with-drawers-p) 'not)
(member-ignore-case name (cdr with-drawers-p)) (member-ignore-case name (cdr with-drawers-p))
(not (member-ignore-case name with-drawers-p)))))))) (not (member-ignore-case name with-drawers-p))))))))
@ -1829,23 +1840,23 @@ a tree with a select tag."
(not (plist-get options :with-footnotes))) (not (plist-get options :with-footnotes)))
((headline inlinetask) ((headline inlinetask)
(let ((with-tasks (plist-get options :with-tasks)) (let ((with-tasks (plist-get options :with-tasks))
(todo (org-element-property :todo-keyword blob)) (todo (org-element-property :todo-keyword datum))
(todo-type (org-element-property :todo-type blob)) (todo-type (org-element-property :todo-type datum))
(archived (plist-get options :with-archived-trees)) (archived (plist-get options :with-archived-trees))
(tags (org-export-get-tags blob options nil t))) (tags (org-export-get-tags datum options nil t)))
(or (or
(and (eq (org-element-type blob) 'inlinetask) (and (eq (org-element-type datum) 'inlinetask)
(not (plist-get options :with-inlinetasks))) (not (plist-get options :with-inlinetasks)))
;; Ignore subtrees with an exclude tag. ;; Ignore subtrees with an exclude tag.
(cl-loop for k in (plist-get options :exclude-tags) (cl-loop for k in (plist-get options :exclude-tags)
thereis (member k tags)) thereis (member k tags))
;; When a select tag is present in the buffer, ignore any tree ;; When a select tag is present in the buffer, ignore any tree
;; without it. ;; without it.
(and selected (not (memq blob selected))) (and selected (not (memq datum selected)))
;; Ignore commented sub-trees. ;; Ignore commented sub-trees.
(org-element-property :commentedp blob) (org-element-property :commentedp datum)
;; Ignore archived subtrees if `:with-archived-trees' is nil. ;; Ignore archived subtrees if `:with-archived-trees' is nil.
(and (not archived) (org-element-property :archivedp blob)) (and (not archived) (org-element-property :archivedp datum))
;; Ignore tasks, if specified by `:with-tasks' property. ;; Ignore tasks, if specified by `:with-tasks' property.
(and todo (and todo
(or (not with-tasks) (or (not with-tasks)
@ -1857,7 +1868,7 @@ a tree with a select tag."
(let ((properties-set (plist-get options :with-properties))) (let ((properties-set (plist-get options :with-properties)))
(cond ((null properties-set) t) (cond ((null properties-set) t)
((consp properties-set) ((consp properties-set)
(not (member-ignore-case (org-element-property :key blob) (not (member-ignore-case (org-element-property :key datum)
properties-set)))))) properties-set))))))
(planning (not (plist-get options :with-planning))) (planning (not (plist-get options :with-planning)))
(property-drawer (not (plist-get options :with-properties))) (property-drawer (not (plist-get options :with-properties)))
@ -1865,14 +1876,14 @@ a tree with a select tag."
(table (not (plist-get options :with-tables))) (table (not (plist-get options :with-tables)))
(table-cell (table-cell
(and (org-export-table-has-special-column-p (and (org-export-table-has-special-column-p
(org-export-get-parent-table blob)) (org-export-get-parent-table datum))
(org-export-first-sibling-p blob options))) (org-export-first-sibling-p datum options)))
(table-row (org-export-table-row-is-special-p blob options)) (table-row (org-export-table-row-is-special-p datum options))
(timestamp (timestamp
;; `:with-timestamps' only applies to isolated timestamps ;; `:with-timestamps' only applies to isolated timestamps
;; objects, i.e. timestamp objects in a paragraph containing only ;; objects, i.e. timestamp objects in a paragraph containing only
;; timestamps and whitespaces. ;; timestamps and whitespaces.
(when (let ((parent (org-export-get-parent-element blob))) (when (let ((parent (org-export-get-parent-element datum)))
(and (memq (org-element-type parent) '(paragraph verse-block)) (and (memq (org-element-type parent) '(paragraph verse-block))
(not (org-element-map parent (not (org-element-map parent
(cons 'plain-text (cons 'plain-text
@ -1883,9 +1894,9 @@ a tree with a select tag."
(cl-case (plist-get options :with-timestamps) (cl-case (plist-get options :with-timestamps)
((nil) t) ((nil) t)
(active (active
(not (memq (org-element-property :type blob) '(active active-range)))) (not (memq (org-element-property :type datum) '(active active-range))))
(inactive (inactive
(not (memq (org-element-property :type blob) (not (memq (org-element-property :type datum)
'(inactive inactive-range))))))))) '(inactive inactive-range)))))))))
@ -2670,49 +2681,18 @@ The function assumes BUFFER's major mode is `org-mode'."
'invisible (quote ,invis-prop)) 'invisible (quote ,invis-prop))
ov-set))))))))) ov-set)))))))))
(defun org-export--delete-comments () (defun org-export--delete-comment-trees ()
"Delete commented areas in the buffer. "Delete commented trees and commented inlinetasks in the buffer.
Commented areas are comments, comment blocks, commented trees and Narrowing, if any, is ignored."
inlinetasks. Trailing blank lines after a comment or a comment
block are removed, as long as it doesn't alter the structure of
the document. Narrowing, if any, is ignored."
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (point-min)) (goto-char (point-min))
(let* ((case-fold-search t) (let* ((case-fold-search t)
(comment-re "^[ \t]*#\\(?: \\|$\\|\\+end_comment\\)") (regexp (concat org-outline-regexp-bol ".*" org-comment-string)))
(regexp (concat org-outline-regexp-bol ".*" org-comment-string "\\|"
comment-re)))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
(pcase (org-element-type element) (when (org-element-property :commentedp element)
((or `headline `inlinetask) (delete-region (org-element-property :begin element)
(when (org-element-property :commentedp element) (org-element-property :end element))))))))
(delete-region (org-element-property :begin element)
(org-element-property :end element))))
((or `comment `comment-block)
(let* ((parent (org-element-property :parent element))
(start (org-element-property :begin element))
(end (org-element-property :end element))
;; We remove trailing blank lines. Doing so could
;; modify the structure of the document. Therefore
;; we ensure that any comment between elements is
;; replaced with one empty line, so as to keep them
;; separated.
(add-blank?
(save-excursion
(goto-char start)
(not (or (bobp)
(eq (org-element-property :contents-begin parent)
start)
(eq (org-element-property :contents-end parent)
end)
(progn
(forward-line -1)
(or (looking-at-p "^[ \t]*$")
(org-with-limited-levels
(org-at-heading-p)))))))))
(delete-region start end)
(when add-blank? (insert "\n"))))))))))
(defun org-export--prune-tree (data info) (defun org-export--prune-tree (data info)
"Prune non exportable elements from DATA. "Prune non exportable elements from DATA.
@ -3067,7 +3047,7 @@ Return code as a string."
(org-export-backend-name backend)) (org-export-backend-name backend))
;; Include files, delete comments and expand macros. ;; Include files, delete comments and expand macros.
(org-export-expand-include-keyword) (org-export-expand-include-keyword)
(org-export--delete-comments) (org-export--delete-comment-trees)
(org-macro-initialize-templates) (org-macro-initialize-templates)
(org-macro-replace-all (org-macro-replace-all
(append org-macro-templates org-export-global-macros) (append org-macro-templates org-export-global-macros)

View File

@ -46,7 +46,7 @@ body to execute. Parse tree is available under the `tree'
variable, and communication channel under `info'." variable, and communication channel under `info'."
(declare (debug (form body)) (indent 1)) (declare (debug (form body)) (indent 1))
`(org-test-with-temp-text ,data `(org-test-with-temp-text ,data
(org-export--delete-comments) (org-export--delete-comment-trees)
(let* ((tree (org-element-parse-buffer)) (let* ((tree (org-element-parse-buffer))
(info (org-combine-plists (info (org-combine-plists
(org-export--get-export-attributes) (org-export--get-export-attributes)
@ -1760,33 +1760,34 @@ Footnotes[fn:2], foot[fn:test] and [fn:inline:inline footnote]
In particular, structure of the document mustn't be altered after In particular, structure of the document mustn't be altered after
comments removal." comments removal."
(should (should
(equal (org-test-with-temp-text " (equal "Para1\n\nPara2\n"
(org-test-with-temp-text "
Para1 Para1
# Comment # Comment
# Comment # Comment
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"Para1\n\nPara2\n"))
(should (should
(equal (org-test-with-temp-text " (equal "Para1\n\nPara2\n"
(org-test-with-temp-text "
Para1 Para1
# Comment # Comment
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"Para1\n\nPara2\n"))
(should (should
(equal (org-test-with-temp-text " (equal "[fn:1] Para1\n\n\nPara2\n"
(org-test-with-temp-text "
\[fn:1] Para1 \[fn:1] Para1
# Inside definition # Inside definition
# Outside definition # Outside definition
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"[fn:1] Para1\n\n\nPara2\n"))
(should (should
(equal (org-test-with-temp-text " (equal "[fn:1] Para1\n\nPara2\n"
(org-test-with-temp-text "
\[fn:1] Para1 \[fn:1] Para1
# Inside definition # Inside definition
@ -1794,24 +1795,32 @@ Para2"
# Inside definition # Inside definition
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"[fn:1] Para1\n\nPara2\n"))
(should (should
(equal (org-test-with-temp-text " (equal "[fn:1] Para1\n\nPara2\n"
(org-test-with-temp-text "
\[fn:1] Para1 \[fn:1] Para1
# Inside definition # Inside definition
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"[fn:1] Para1\n\nPara2\n"))
(should (should
(equal (org-test-with-temp-text " (equal "[fn:1] Para1\n\nPara2\n"
(org-test-with-temp-text "
\[fn:1] Para1 \[fn:1] Para1
# Inside definition # Inside definition
Para2" Para2"
(org-export-as (org-test-default-backend))) (org-export-as (org-test-default-backend)))))
"[fn:1] Para1\n\nPara2\n"))) (should
(equal "- item 1\n\n- item 2\n"
(org-test-with-temp-text "
- item 1
# Comment
- item 2"
(org-export-as (org-test-default-backend))))))