소스 검색

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 7 년 전
부모
커밋
beeb4bf23f
2개의 변경된 파일52개의 추가작업 그리고 29개의 파일을 삭제
  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."