summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2019-02-12 01:15:55 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2019-02-12 01:15:55 +0100
commit931b7b8faf9611f0c5d16f3e3a6ee8f5c7f7b1be (patch)
treee0d95589822ed13a90da1983bb7a85f1906a6fc3
parent476066b13c492fba6b37b36ec0fd115b1790f6a8 (diff)
downloadorg-mode-931b7b8faf9611f0c5d16f3e3a6ee8f5c7f7b1be.tar.gz
Fix included nested relative file links
* lisp/ox.el (org-export--update-included-link): New function. (org-export--prepare-file-contents): Use new function. Also check possible file links within link's description. * testing/lisp/test-ox.el (test-org-export/expand-include/links): Fix prefix. Add tests. Reported-by: "Dietrich Foethke" <foethke@web.de> <http://lists.gnu.org/r/emacs-orgmode/2019-02/msg00103.html>
-rw-r--r--lisp/ox.el73
-rw-r--r--testing/lisp/test-ox.el90
2 files changed, 140 insertions, 23 deletions
diff --git a/lisp/ox.el b/lisp/ox.el
index 6a0e480..77328f1 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 25b5ac2..3bd2622 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."