From beeb4bf23fd2b2339c2354457840d52c52d6dff5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 19 Mar 2018 23:48:38 +0100 Subject: [PATCH] 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 --- lisp/ox.el | 59 ++++++++++++++++++++++------------------- testing/lisp/test-ox.el | 22 ++++++++++++++- 2 files changed, 52 insertions(+), 29 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 7be3c9977..5a83ae01d 100644 --- a/lisp/ox.el +++ b/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. diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 0247db75c..1c429c83c 100644 --- a/testing/lisp/test-ox.el +++ b/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."