org-babel-result-to-file: Fix results file inside attachment dir

* lisp/ob-core.el (org-babel-result-to-file): When file path in the
result contains attachment dir, reduce the path to relative file name
when generating attachment: link.
* testing/lisp/test-ob.el (test-ob-core/dir-attach): Add test.

Reported-by: Johan Tolö <johan@toloe.se>
Link: https://orgmode.org/list/875yesnia6.fsf@toloe.se
This commit is contained in:
Ihor Radchenko 2022-12-07 14:13:49 +03:00
parent 4dddbc1436
commit cc5427b7ef
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 22 additions and 3 deletions

View File

@ -2692,8 +2692,8 @@ specified as an an \"attachment:\" style link."
(same-directory?
(and base-file-name
(not (string= (expand-file-name default-directory)
(expand-file-name
base-directory)))))
(expand-file-name
base-directory)))))
(request-attachment (eq type 'attachment))
(attach-dir (let* ((default-directory base-directory)
(dir (org-attach-dir nil t)))
@ -2709,7 +2709,9 @@ specified as an an \"attachment:\" style link."
((and 'attachment (guard in-attach-dir)) "attachment")
(_ "file"))
(if (and request-attachment in-attach-dir)
(file-relative-name result-file-name)
(file-relative-name
result-file-name
(file-name-as-directory attach-dir))
(if (and default-directory
base-file-name same-directory?)
(if (eq org-link-file-path-type 'adaptive)

View File

@ -1954,6 +1954,23 @@ nil
(file-exists-p (format "%s/test.txt" (org-attach-dir nil t)))
(string= (buffer-substring-no-properties (point) (line-end-position))
"[[attachment:test.txt]]"))))
;; Strip attach dir from the file path.
(should
(org-test-with-temp-text-in-file
"* heading
:PROPERTIES:
:DIR: custom-attach-dir
:END:
<point>#+begin_src elisp :results value file
\"custom-attach-dir/test.txt\"
#+end_src"
(message "DIR: %s" (org-attach-dir t))
(org-babel-execute-src-block)
(goto-char (org-babel-where-is-src-block-result))
(forward-line)
(string= (buffer-substring-no-properties (point) (line-end-position))
"[[attachment:test.txt]]")))
(should-error
(org-test-with-temp-text-in-file
"* 'attach with no ID or DIR