Skip to content

Commit 2261191

Browse files
ryan-c-scottyantar92
authored andcommitted
ob-core.el/babel: Special handling for attachment links in src block
* ob-core.el (org-babel-merge-params): Specifying the symbol 'attach` or string "'attach" as the value of the `:dir' header now functions as ":dir (org-attach-dir nil t) :mkdirp t". (org-babel-result-to-file): Optional TYPE argument accepts symbol 'attachment to fixup up paths under `(org-attach-dir)' and use the link type "attachment:" when that is detected. (org-babel-insert-result): Pass symbol `attachment' as TYPE to `org-babel-result-to-file'. * org-attach.el (org-attach-dir): Added autoload header to simplify dependencies necessary to support this feature (called in `org-babel-merge-params'). * test-ob.el (test-ob-core/dir-attach): Added unit test for the new attach feature.
1 parent 3baac35 commit 2261191

File tree

5 files changed

+137
-23
lines changed

5 files changed

+137
-23
lines changed

doc/org-manual.org

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17542,6 +17542,13 @@ directory with {{{kbd(M-x cd RET DIRECTORY)}}}, and then not setting
1754217542
variable ~default-directory~. Setting =mkdirp= header argument to
1754317543
a non-~nil~ value creates the directory, if necessary.
1754417544

17545+
Setting =dir= to the symbol ~attach~ or the string ~"'attach"~ will
17546+
set =dir= to the directory returned by ~(org-attach-dir)~, set =:mkdir
17547+
yes=, and insert any file paths, as when using =:results file=, which
17548+
are under the node's attachment directory using =attachment:= links
17549+
instead of the usual =file:= links. Any returned path outside of the
17550+
attachment directory will use =file:= links as per usual.
17551+
1754517552
For example, to save the plot file in the =Work/= folder of the home
1754617553
directory---notice tilde is expanded:
1754717554

etc/ORG-NEWS

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -798,6 +798,13 @@ Finally, the closures are only evaluated if they're not overridden for
798798
a source block. This improves efficiency in cases where the result of
799799
a compute-expensive closure would otherwise be discarded.
800800

801+
*** New special value ~'attach~ for src block =:dir= option
802+
803+
Passing the symbol ~attach~ or string ="'attach"= (with quotes) to the =:dir=
804+
option of a src block is now equivalent to =:dir (org-attach-dir) :mkdir yes=
805+
and any file results with a path descended from the attachment directory will
806+
use =attachment:= style links instead of the standard =file:= link type.
807+
801808
** Miscellaneous
802809
*** =org-bibtex= includes =doi= and =url= entries when exporting to BiBTeX
803810
=doi= and =url= entries have been made optional for some publication

lisp/ob-core.el

Lines changed: 56 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -801,7 +801,8 @@ block."
801801
(let ((*this* (if (not file) result
802802
(org-babel-result-to-file
803803
file
804-
(org-babel--file-desc params result)))))
804+
(org-babel--file-desc params result)
805+
'attachment))))
805806
(setq result (org-babel-ref-resolve post))
806807
(when file
807808
(setq result-params (remove "file" result-params))))))
@@ -2298,11 +2299,14 @@ INFO may provide the values of these header arguments (in the
22982299
(cond ((stringp result)
22992300
(setq result (org-no-properties result))
23002301
(when (member "file" result-params)
2301-
(setq result (org-babel-result-to-file
2302-
result
2303-
(org-babel--file-desc (nth 2 info) result)))))
2302+
(setq result
2303+
(org-babel-result-to-file
2304+
result
2305+
(org-babel--file-desc (nth 2 info) result)
2306+
'attachment))))
23042307
((listp result))
23052308
(t (setq result (format "%S" result))))
2309+
23062310
(if (and result-params (member "silent" result-params))
23072311
(progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
23082312
result)
@@ -2605,27 +2609,49 @@ in the buffer."
26052609
(line-beginning-position 2))
26062610
(point))))))
26072611

2608-
(defun org-babel-result-to-file (result &optional description)
2612+
(defun org-babel-result-to-file (result &optional description type)
26092613
"Convert RESULT into an Org link with optional DESCRIPTION.
26102614
If the `default-directory' is different from the containing
2611-
file's directory then expand relative links."
2615+
file's directory then expand relative links.
2616+
2617+
If the optional TYPE is passed as 'attachment` and the path is a
2618+
descendant of the DEFAULT-DIRECTORY, the generated link will be
2619+
specified as an an \"attachment:\" style link."
26122620
(when (stringp result)
2613-
(let ((same-directory?
2614-
(and (buffer-file-name (buffer-base-buffer))
2615-
(not (string= (expand-file-name default-directory)
2616-
(expand-file-name
2617-
(file-name-directory
2618-
(buffer-file-name (buffer-base-buffer)))))))))
2619-
(format "[[file:%s]%s]"
2620-
(if (and default-directory
2621-
(buffer-file-name (buffer-base-buffer)) same-directory?)
2622-
(if (eq org-link-file-path-type 'adaptive)
2623-
(file-relative-name
2624-
(expand-file-name result default-directory)
2625-
(file-name-directory
2626-
(buffer-file-name (buffer-base-buffer))))
2627-
(expand-file-name result default-directory))
2628-
result)
2621+
(let* ((result-file-name (expand-file-name result))
2622+
(base-file-name (buffer-file-name (buffer-base-buffer)))
2623+
(base-directory (and buffer-file-name
2624+
(file-name-directory base-file-name)))
2625+
(same-directory?
2626+
(and base-file-name
2627+
(not (string= (expand-file-name default-directory)
2628+
(expand-file-name
2629+
base-directory)))))
2630+
(request-attachment (eq type 'attachment))
2631+
(attach-dir (let* ((default-directory base-directory)
2632+
(dir (org-attach-dir nil t)))
2633+
(when dir
2634+
(expand-file-name dir))))
2635+
(in-attach-dir (and request-attachment
2636+
attach-dir
2637+
(string-prefix-p
2638+
attach-dir
2639+
result-file-name))))
2640+
(format "[[%s:%s]%s]"
2641+
(pcase type
2642+
((and 'attachment (guard in-attach-dir)) "attachment")
2643+
(_ "file"))
2644+
(if (and request-attachment in-attach-dir)
2645+
(file-relative-name result-file-name)
2646+
(if (and default-directory
2647+
base-file-name same-directory?)
2648+
(if (eq org-link-file-path-type 'adaptive)
2649+
(file-relative-name
2650+
result-file-name
2651+
(file-name-directory
2652+
base-file-name))
2653+
result-file-name)
2654+
result))
26292655
(if description (concat "[" description "]") "")))))
26302656

26312657
(defun org-babel-examplify-region (beg end &optional results-switches inline)
@@ -2756,10 +2782,17 @@ parameters when merging lists."
27562782
(setq exports (funcall merge
27572783
exports-exclusive-groups
27582784
exports
2759-
(split-string
2785+
(split-string
27602786
(cond ((and value (functionp value)) (funcall value))
27612787
(value value)
27622788
(t ""))))))
2789+
((or '(:dir . attach) '(:dir . "'attach"))
2790+
(unless (org-attach-dir nil t)
2791+
(error "No attachment directory for element (add :ID: or :DIR: property)"))
2792+
(setq params (append
2793+
`((:dir . ,(org-attach-dir nil t))
2794+
(:mkdirp . "yes"))
2795+
(assq-delete-all :dir (assq-delete-all :mkdir params)))))
27632796
;; Regular keywords: any value overwrites the previous one.
27642797
(_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
27652798
;; Handle `:var' and clear out colnames and rownames for replaced

lisp/org-attach.el

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -324,6 +324,7 @@ Shows a list of commands and prompts for another key to execute a command."
324324
(command-execute command)
325325
(error "No such attachment command: %c" c))))))
326326

327+
;;;###autoload
327328
(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check)
328329
"Return the directory associated with the current outline node.
329330
First check for DIR property, then ID property.

testing/lisp/test-ob.el

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1770,6 +1770,72 @@ nil
17701770
(file-modes "t.sh")
17711771
(delete-file "t.sh"))))))
17721772

1773+
(ert-deftest test-ob-core/dir-attach ()
1774+
"Test :dir header using special 'attach value"
1775+
(should
1776+
(org-test-with-temp-text-in-file
1777+
"* 'attach Symbol
1778+
<point>#+begin_src elisp :dir 'attach :results file
1779+
(with-temp-file \"test.txt\" (insert \"attachment testing\n\"))
1780+
\"test.txt\"
1781+
#+end_src"
1782+
(org-id-get-create)
1783+
(org-babel-execute-src-block)
1784+
(goto-char (org-babel-where-is-src-block-result))
1785+
(forward-line)
1786+
(and
1787+
(file-exists-p (format "%s/test.txt" (org-attach-dir nil t)))
1788+
(string= (buffer-substring-no-properties (point) (line-end-position))
1789+
"[[attachment:test.txt]]"))))
1790+
(should
1791+
(org-test-with-temp-text-in-file
1792+
"* 'attach String
1793+
<point>#+begin_src elisp :dir \"'attach\" :results file
1794+
(with-temp-file \"test.txt\" (insert \"attachment testing\n\"))
1795+
\"test.txt\"
1796+
#+end_src"
1797+
(org-id-get-create)
1798+
(org-babel-execute-src-block)
1799+
(goto-char (org-babel-where-is-src-block-result))
1800+
(forward-line)
1801+
(and
1802+
(file-exists-p (format "%s/test.txt" (org-attach-dir nil t)))
1803+
(string= (buffer-substring-no-properties (point) (line-end-position))
1804+
"[[attachment:test.txt]]"))))
1805+
(should
1806+
(org-test-with-temp-text-in-file
1807+
"* 'attach with Existing DIR property
1808+
:PROPERTIES:
1809+
:DIR: custom-attach-dir
1810+
:END:
1811+
1812+
<point>#+begin_src elisp :dir 'attach :results file
1813+
(with-temp-file \"test.txt\" (insert \"attachment testing\n\"))
1814+
\"test.txt\"
1815+
#+end_src"
1816+
(message "DIR: %s" (org-attach-dir t))
1817+
(org-babel-execute-src-block)
1818+
(goto-char (org-babel-where-is-src-block-result))
1819+
(forward-line)
1820+
(and
1821+
(file-exists-p (format "%s/test.txt" (org-attach-dir nil t)))
1822+
(string= (buffer-substring-no-properties (point) (line-end-position))
1823+
"[[attachment:test.txt]]"))))
1824+
(should-error
1825+
(org-test-with-temp-text-in-file
1826+
"* 'attach with no ID or DIR
1827+
<point>#+begin_src elisp :dir 'attach :results file
1828+
(with-temp-file \"test.txt\" (insert \"attachment testing\n\"))
1829+
\"test.txt\"
1830+
#+end_src"
1831+
(org-babel-execute-src-block)
1832+
(goto-char (org-babel-where-is-src-block-result))
1833+
(forward-line)
1834+
(and
1835+
(file-exists-p (format "%s/test.txt" (org-attach-dir nil t)))
1836+
(string= (buffer-substring-no-properties (point) (line-end-position))
1837+
"[[attachment:test.txt]]")))))
1838+
17731839
(ert-deftest test-ob-core/dir-mkdirp ()
17741840
"Test :mkdirp with :dir header combination."
17751841
(should-not

0 commit comments

Comments
 (0)