diff --git a/lisp/ox.el b/lisp/ox.el index 6a0e48084..77328f1b2 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3448,6 +3448,32 @@ Return a string of lines to be included in the format expected by (while (< (point) end) (cl-incf counter) (forward-line)) counter)))))))) +(defun org-export--update-included-link (file-dir includer-dir) + "Update relative file name of link at point, if possible. + +FILE-DIR is the directory of the file being included. +INCLUDER-DIR is the directory of the file where the inclusion is +going to happen. + +Move point after the link." + (let* ((link (org-element-link-parser)) + (path (org-element-property :path link))) + (if (or (not (string= "file" (org-element-property :type link))) + (file-remote-p path) + (file-name-absolute-p path)) + (goto-char (org-element-property :end link)) + (let ((new-path (file-relative-name (expand-file-name path file-dir) + includer-dir)) + (new-link (org-element-copy link)) + (contents (and (org-element-property :contents-begin link) + (buffer-substring + (org-element-property :contents-begin link) + (org-element-property :contents-end link))))) + (org-element-put-property new-link :path new-path) + (delete-region (org-element-property :begin link) + (org-element-property :end link)) + (insert (org-element-link-interpreter new-link contents)))))) + (defun org-export--prepare-file-contents (file &optional lines ind minlevel id footnotes includer) "Prepare contents of FILE for inclusion and return it as a string. @@ -3500,27 +3526,32 @@ is to happen." (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 (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)))))))))))) + (let ((regexp (concat org-plain-link-re "\\|" org-angle-link-re))) + (while (re-search-forward org-any-link-re nil t) + (let ((link (save-excursion + (forward-char -1) + (save-match-data (org-element-context))))) + (when (eq 'link (org-element-type link)) + ;; Look for file links within link's description. + ;; Org doesn't support such construct, but + ;; `org-export-insert-image-links' may activate + ;; them. + (let ((contents-begin + (org-element-property :contents-begin link)) + (begin (org-element-property :begin link))) + (when contents-begin + (save-excursion + (goto-char (org-element-property :contents-end link)) + (while (re-search-backward regexp contents-begin t) + (save-match-data + (org-export--update-included-link + file-dir includer-dir)) + (goto-char (match-beginning 0))))) + ;; Update current link, if necessary. + (when (string= "file" (org-element-property :type link)) + (goto-char begin) + (org-export--update-included-link + file-dir includer-dir)))))))))) ;; 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 25b5ac206..3bd26224d 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -1363,7 +1363,7 @@ Footnotes[fn:2], foot[fn:test] and [fn:inline:inline footnote] (org-export-expand-include-keyword) (eq 3 (org-current-level))))) -(ert-deftest test-org/expand-include/links () +(ert-deftest test-org-export/expand-include/links () "Test links modifications when including files." ;; Preserve relative plain links. (should @@ -3037,7 +3037,93 @@ Para2" (org-element-map (org-export-insert-image-links tree info '(("file" . "xxx"))) 'link - (lambda (l) (org-element-property :type l))))))) + (lambda (l) (org-element-property :type l)))))) + ;; If an image link was included from another file, make sure to + ;; shift any relative path accordingly. + (should + (string-prefix-p + "file:org-includee-" + (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.png" 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-as + (org-export-create-backend + :transcoders + '((section . (lambda (_s c _i) c)) + (paragraph . (lambda (_p c _i) c)) + (link . (lambda (l c _i) (org-element-link-interpreter l c)))) + :filters + '((:filter-parse-tree + (lambda (d _b i) (org-export-insert-image-links d i))))))) + (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))))))) + (should + (string-match-p + "file:org-includee-.+?foo\\.png" + (let* ((subdir (make-temp-file "org-includee-" t)) + (includee (expand-file-name "includee.org" subdir)) + (includer (make-temp-file "org-includer-"))) + (write-region "[[https://orgmode.org][file:foo.png]]" 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-as + (org-export-create-backend + :transcoders + '((section . (lambda (_s c _i) c)) + (paragraph . (lambda (_p c _i) c)) + (link . (lambda (l c _i) (org-element-link-interpreter l c)))) + :filters + '((:filter-parse-tree + (lambda (d _b i) (org-export-insert-image-links d i))))))) + (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))))))) + (should + (string-match-p + "file:org-includee.+?file:org-includee" + (let* ((subdir (make-temp-file "org-includee-" t)) + (includee (expand-file-name "includee.org" subdir)) + (includer (make-temp-file "org-includer-"))) + (write-region "[[file:bar.png][file:foo.png]]" 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-as + (org-export-create-backend + :transcoders + '((section . (lambda (_s c _i) c)) + (paragraph . (lambda (_p c _i) c)) + (link . (lambda (l c _i) (org-element-link-interpreter l c)))) + :filters + '((:filter-parse-tree + (lambda (d _b i) (org-export-insert-image-links d i))))))) + (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/fuzzy-link () "Test fuzzy links specifications."