tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

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>
This commit is contained in:
Nicolas Goaziou 2019-02-12 01:15:55 +01:00
parent 476066b13c
commit 931b7b8faf
2 changed files with 140 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
lisp/ox.el
View File

@ -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.

90
testing/lisp/test-ox.el
View File

@ -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."