Browse Source

ox: Fix regression in INCLUDE keywords

* lisp/ox.el (org-export--prepare-file-contents): Activate Org mode in
  temporary buffer so all regexps are set.  Also, be more strict when
  updating links, i.e., do not bother if both includer and includee
  belong to the same directory, or if there's no includer at all.
  Eventually, only update links within lines specifications, if any.

* testing/lisp/test-ox.el (test-org/expand-include/links): Add tests.

Reported-by: Kaushal Modi <kaushal.modi@gmail.com>
<http://lists.gnu.org/r/emacs-orgmode/2018-03/msg00394.html>
Nicolas Goaziou 1 year ago
parent
commit
beeb4bf23f
2 changed files with 52 additions and 29 deletions
  1. 31 28
      lisp/ox.el
  2. 21 1
      testing/lisp/test-ox.el

+ 31 - 28
lisp/ox.el

@@ -3482,34 +3482,6 @@ Optional argument INCLUDER is the file name where the inclusion
 is to happen."
   (with-temp-buffer
     (insert-file-contents file)
-    ;; Adapt all file links within the included document that contain
-    ;; relative paths in order to make these paths relative to the
-    ;; base document, or absolute.
-    (goto-char (point-min))
-    (while (re-search-forward org-any-link-re nil t)
-      (let ((link (save-excursion
-		    (backward-char)
-		    (org-element-context))))
-	(when (string= "file" (org-element-property :type link))
-	  (let ((old-path (org-element-property :path link)))
-	    (unless (or (org-file-remote-p old-path)
-			(file-name-absolute-p old-path))
-	      (let ((new-path
-		     (let ((full (expand-file-name old-path
-						   (file-name-directory file))))
-		       (if (not includer) full
-			 (file-relative-name full
-					     (file-name-directory includer))))))
-		(insert (let ((new (org-element-copy link)))
-			  (org-element-put-property new :path new-path)
-			  (when (org-element-property :contents-begin link)
-			    (org-element-adopt-elements new
-			      (buffer-substring
-			       (org-element-property :contents-begin link)
-			       (org-element-property :contents-end link))))
-			  (delete-region (org-element-property :begin link)
-					 (org-element-property :end link))
-			  (org-element-interpret-data new)))))))))
     (when lines
       (let* ((lines (split-string lines "-"))
 	     (lbeg (string-to-number (car lines)))
@@ -3523,6 +3495,37 @@ is to happen."
 		    (forward-line (1- lend))
 		    (point))))
 	(narrow-to-region beg end)))
+    ;; Adapt all file links within the included document that contain
+    ;; relative paths in order to make these paths relative to the
+    ;; base document, or absolute.
+    (when includer
+      (let ((file-dir (file-name-directory file))
+	    (includer-dir (file-name-directory includer)))
+	(unless (file-equal-p file-dir includer-dir)
+	  (goto-char (point-min))
+	  (unless (eq major-mode 'org-mode)
+	    (let ((org-inhibit-startup t)) (org-mode)))	;set regexps
+	  (while (re-search-forward org-any-link-re nil t)
+	    (let ((link (save-excursion (backward-char) (org-element-context))))
+	      (when (and (eq 'link (org-element-type link))
+			 (string= "file" (org-element-property :type link)))
+		(let ((old-path (org-element-property :path link)))
+		  (unless (or (org-file-remote-p old-path)
+			      (file-name-absolute-p old-path))
+		    (let ((new-path (file-relative-name
+				     (expand-file-name old-path file-dir)
+				     includer-dir)))
+		      (insert
+		       (let ((new (org-element-copy link)))
+			 (org-element-put-property new :path new-path)
+			 (when (org-element-property :contents-begin link)
+			   (org-element-adopt-elements new
+			     (buffer-substring
+			      (org-element-property :contents-begin link)
+			      (org-element-property :contents-end link))))
+			 (delete-region (org-element-property :begin link)
+					(org-element-property :end link))
+			 (org-element-interpret-data new))))))))))))
     ;; Remove blank lines at beginning and end of contents.  The logic
     ;; behind that removal is that blank lines around include keyword
     ;; override blank lines in included file.

+ 21 - 1
testing/lisp/test-ox.el

@@ -1474,7 +1474,27 @@ Footnotes[fn:2], foot[fn:test] and [fn:inline:inline footnote]
 	    (with-current-buffer buffer (set-buffer-modified-p nil))
 	    (kill-buffer buffer))
 	  (when (file-exists-p subdir) (delete-directory subdir t))
-	  (when (file-exists-p includer) (delete-file includer))))))))
+	  (when (file-exists-p includer) (delete-file includer)))))))
+  ;; Pathological case: Do not error when fixing a path in a headline.
+  (should
+   (let* ((subdir (make-temp-file "org-includee-" t))
+	  (includee (expand-file-name "includee.org" subdir))
+	  (includer (make-temp-file "org-includer-")))
+     (write-region "* [[file:foo.org]]" nil includee)
+     (write-region (format "#+INCLUDE: %S"
+			   (file-relative-name includee
+					       temporary-file-directory))
+		   nil includer)
+     (let ((buffer (find-file-noselect includer t)))
+       (unwind-protect
+	   (with-current-buffer buffer
+	     (org-export-expand-include-keyword)
+	     (org-trim (buffer-string)))
+	 (when (buffer-live-p buffer)
+	   (with-current-buffer buffer (set-buffer-modified-p nil))
+	   (kill-buffer buffer))
+	 (when (file-exists-p subdir) (delete-directory subdir t))
+	 (when (file-exists-p includer) (delete-file includer)))))))
 
 (ert-deftest test-org-export/expand-macro ()
   "Test macro expansion in an Org buffer."