Browse Source

ox: Fix comments removal during export

* lisp/ox.el (org-export--skip-p): Handle comments and comment blocks
  removal.
(org-export--delete-comments): Rename to...
(org-export--delete-comment-trees): ... this.  Now only take care of
commented trees and inlinetasks.

* testing/lisp/test-ox.el (test-org-export/comments): Add test.
(org-test-with-parsed-data): Apply renaming.
Nicolas Goaziou 8 years ago
parent
commit
a0409e56c3
2 changed files with 65 additions and 76 deletions
  1. 37 57
      lisp/ox.el
  2. 28 19
      testing/lisp/test-ox.el

+ 37 - 57
lisp/ox.el

@@ -1782,12 +1782,23 @@ INFO is a plist holding export options."
 	(funcall walk-data data nil)
 	selected-trees))))
 
-(defun org-export--skip-p (blob options selected)
-  "Non-nil when element or object BLOB should be skipped during export.
+(defun org-export--skip-p (datum options selected)
+  "Non-nil when element or object DATUM should be skipped during export.
 OPTIONS is the plist holding export options.  SELECTED, when
 non-nil, is a list of headlines or inlinetasks belonging to
 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)))
     (drawer
      (let ((with-drawers-p (plist-get options :with-drawers)))
@@ -1797,7 +1808,7 @@ a tree with a select tag."
 		;; every drawer whose name belong to that list.
 		;; Otherwise, ignore drawers whose name isn't in that
 		;; list.
-		(let ((name (org-element-property :drawer-name blob)))
+		(let ((name (org-element-property :drawer-name datum)))
 		  (if (eq (car with-drawers-p) 'not)
 		      (member-ignore-case name (cdr with-drawers-p))
 		    (not (member-ignore-case name with-drawers-p))))))))
@@ -1806,23 +1817,23 @@ a tree with a select tag."
      (not (plist-get options :with-footnotes)))
     ((headline inlinetask)
      (let ((with-tasks (plist-get options :with-tasks))
-	   (todo (org-element-property :todo-keyword blob))
-	   (todo-type (org-element-property :todo-type blob))
+	   (todo (org-element-property :todo-keyword datum))
+	   (todo-type (org-element-property :todo-type datum))
 	   (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
-	(and (eq (org-element-type blob) 'inlinetask)
+	(and (eq (org-element-type datum) 'inlinetask)
 	     (not (plist-get options :with-inlinetasks)))
 	;; Ignore subtrees with an exclude tag.
 	(cl-loop for k in (plist-get options :exclude-tags)
 		 thereis (member k tags))
 	;; When a select tag is present in the buffer, ignore any tree
 	;; without it.
-	(and selected (not (memq blob selected)))
+	(and selected (not (memq datum selected)))
 	;; Ignore commented sub-trees.
-	(org-element-property :commentedp blob)
+	(org-element-property :commentedp datum)
 	;; 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.
 	(and todo
 	     (or (not with-tasks)
@@ -1834,7 +1845,7 @@ a tree with a select tag."
      (let ((properties-set (plist-get options :with-properties)))
        (cond ((null properties-set) t)
 	     ((consp properties-set)
-	      (not (member-ignore-case (org-element-property :key blob)
+	      (not (member-ignore-case (org-element-property :key datum)
 				       properties-set))))))
     (planning (not (plist-get options :with-planning)))
     (property-drawer (not (plist-get options :with-properties)))
@@ -1842,14 +1853,14 @@ a tree with a select tag."
     (table (not (plist-get options :with-tables)))
     (table-cell
      (and (org-export-table-has-special-column-p
-	   (org-export-get-parent-table blob))
-	  (org-export-first-sibling-p blob options)))
-    (table-row (org-export-table-row-is-special-p blob options))
+	   (org-export-get-parent-table datum))
+	  (org-export-first-sibling-p datum options)))
+    (table-row (org-export-table-row-is-special-p datum options))
     (timestamp
      ;; `:with-timestamps' only applies to isolated timestamps
      ;; objects, i.e. timestamp objects in a paragraph containing only
      ;; 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))
 		  (not (org-element-map parent
 			   (cons 'plain-text
@@ -1860,9 +1871,9 @@ a tree with a select tag."
        (cl-case (plist-get options :with-timestamps)
 	 ((nil) t)
 	 (active
-	  (not (memq (org-element-property :type blob) '(active active-range))))
+	  (not (memq (org-element-property :type datum) '(active active-range))))
 	 (inactive
-	  (not (memq (org-element-property :type blob)
+	  (not (memq (org-element-property :type datum)
 		     '(inactive inactive-range)))))))))
 
 
@@ -2647,49 +2658,18 @@ The function assumes BUFFER's major mode is `org-mode'."
 			   'invisible (quote ,invis-prop))
 			 ov-set)))))))))
 
-(defun org-export--delete-comments ()
-  "Delete commented areas in the buffer.
-Commented areas are comments, comment blocks, commented trees and
-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."
+(defun org-export--delete-comment-trees ()
+  "Delete commented trees and commented inlinetasks in the buffer.
+Narrowing, if any, is ignored."
   (org-with-wide-buffer
    (goto-char (point-min))
    (let* ((case-fold-search t)
-	  (comment-re "^[ \t]*#\\(?: \\|$\\|\\+end_comment\\)")
-	  (regexp (concat org-outline-regexp-bol ".*" org-comment-string "\\|"
-			  comment-re)))
+	  (regexp (concat org-outline-regexp-bol ".*" org-comment-string)))
      (while (re-search-forward regexp nil t)
        (let ((element (org-element-at-point)))
-	 (pcase (org-element-type element)
-	   ((or `headline `inlinetask)
-	    (when (org-element-property :commentedp 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"))))))))))
+	 (when (org-element-property :commentedp element)
+	   (delete-region (org-element-property :begin element)
+			  (org-element-property :end element))))))))
 
 (defun org-export--prune-tree (data info)
   "Prune non exportable elements from DATA.
@@ -3044,7 +3024,7 @@ Return code as a string."
 			     (org-export-backend-name backend))
 	 ;; Include files, delete comments and expand macros.
 	 (org-export-expand-include-keyword)
-	 (org-export--delete-comments)
+	 (org-export--delete-comment-trees)
 	 (org-macro-initialize-templates)
 	 (org-macro-replace-all org-macro-templates nil parsed-keywords)
 	 ;; Refresh buffer properties and radio targets after

+ 28 - 19
testing/lisp/test-ox.el

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