Re: [PATCH] Re: New source block results option for attaching file to node

[Ryan Scott <ryan@vicarious-living.com>]

[-- Attachment #1.1: Type: text/plain, Size: 3014 bytes --]

Okay, Had some time to put into this. Much happier with this approach as it
doesn't require any file moving and generally leaves src blocks to their
own devices.
The short version is that specifying ":dir 'attach" for a block uses the
directory from (org-attach-dir) as its working directory and any generated
path that is a descendant of that directory will be converted to an
"attachment:" link.

ob-core.el/babel: Special handling for attachment links in src blocks

* ob-core.el (org-babel-execute-src-block): Specifying the symbol
'attach` as the value of the `:dir' header now functions as
":dir (org-attach-dir)"
(org-babel-result-to-file): Optional `TYPE' argument accepts symbol
'attachment` to fixup up paths under `DEFAULT-DIRECTORY' 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' when header `:dir' is set to symbol
`attach'
(org-babel-load-in-session, org-babel-initiate-session) ":dir 'attach"
sets `default-directory' with "(org-attach-dir t)"
* org-attach.el (org-attach-dir): Added autoload header to simplify
dependencies necessary to support this feature (called in
`org-babel-execute-src-block').

On Sun, Sep 5, 2021 at 6:56 AM Ryan Scott <ryan@vicarious-living.com> wrote:

> Yeah your second example is what I'm thinking. It makes this all a fairly
> concise extension of that existing mechanism and does away with the file
> move after execution.
>
> On Sun, Sep 5, 2021, 06:21 Ihor Radchenko <yantar92@gmail.com> wrote:
>
>> Ryan Scott <ryan@vicarious-living.com> writes:
>>
>> > It might make sense to fix up inserted "file:" links that are under the
>> > attachment directory to be "attachment:" style links by default anyway,
>> no?
>> > Then just being able to set the working directory to the attachment
>> > directory easily would get the rest of the way there.
>>
>> I am not sure. If the user explicitly states that :dir is the attachment
>> dir, it would make sense. However, what if the :dir is set explicitly
>> like below?
>>
>> * Headline
>> :PROPERTIES:
>> :DIR: /actual/literal/path/to/attachment/dir
>> :END:
>>
>> #+begin_src emacs-lisp :dir /actual/literal/path/to/attachment/dir
>> ...
>>
>> #+RESULTS:
>> attachment:...
>>
>> The results will be indeed inside the attachment directory. However, the
>> :DIR: property may be changed at some point and the existing attachment:
>> link will not point to real file.
>>
>> > So I suppose that would then mean having the :dir header accept the
>> symbol
>> > `attach' or something like that?
>> > I'll play around and see what that looks like.
>>
>> The above example should lead to more expected behaviour if the user
>> explicitly states that :dir is the attachment dir (even if it is going
>> to be changed in future):
>>
>> * Headline
>> :PROPERTIES:
>> :DIR: /actual/literal/path/to/attachment/dir
>> :END:
>>
>> #+begin_src emacs-lisp :dir 'attach
>> ...
>>
>> #+RESULTS:
>> attachment:...
>>
>> Best,
>> Ihor
>>
>

[-- Attachment #1.2: Type: text/html, Size: 4060 bytes --]

[-- Attachment #2: 0001-ob-core.el-babel-Special-handling-for-attachment-lin.patch --]
[-- Type: application/octet-stream, Size: 6789 bytes --]

From 4d489da66cf6f4d44a320e2d3ccb7025aa8ada6d Mon Sep 17 00:00:00 2001
From: "Ryan C. Scott" <ryan@5pmcasual.com>
Date: Thu, 9 Sep 2021 17:19:34 -0700
Subject: [PATCH] ob-core.el/babel: Special handling for attachment links in
src block

* ob-core.el (org-babel-execute-src-block): Specifying the symbol
'attach` as the value of the `:dir' header now functions as
":dir (org-attach-dir)"
(org-babel-result-to-file): Optional `TYPE' argument accepts symbol
'attachment` to fixup up paths under `DEFAULT-DIRECTORY' 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' when header `:dir' is set to symbol
`attach'
(org-babel-load-in-session, org-babel-initiate-session) ":dir 'attach"
sets `default-directory' with "(org-attach-dir t)"
* org-attach.el (org-attach-dir): Added autoload header to simplify
dependencies necessary to support this feature (called in
`org-babel-execute-src-block').
---
 lisp/ob-core.el    | 72 +++++++++++++++++++++++++++++++---------------
 lisp/org-attach.el |  1 +
 2 files changed, 50 insertions(+), 23 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 384c06c9a..90e454319 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -704,6 +704,9 @@ block."
 		 (mkdirp (cdr (assq :mkdirp params)))
 		 (default-directory
 		   (cond
+                    ((eq dir 'attach)
+                     (file-name-as-directory
+                      (org-attach-dir t)))
 		    ((not dir) default-directory)
 		    ((member mkdirp '("no" "nil" nil))
 		     (file-name-as-directory (expand-file-name dir)))
@@ -925,7 +928,10 @@ session."
          (session (cdr (assq :session params)))
 	 (dir (cdr (assq :dir params)))
 	 (default-directory
-	   (or (and dir (file-name-as-directory dir)) default-directory))
+	   (or (and dir (if (eq dir 'attach)
+                            (org-attach-dir t)
+                          (file-name-as-directory dir)))
+               default-directory))
 	 (cmd (intern (concat "org-babel-load-session:" lang))))
     (unless (fboundp cmd)
       (error "No org-babel-load-session function for %s!" lang))
@@ -946,7 +952,10 @@ the session.  Copy the body of the code block to the kill ring."
          (session (cdr (assq :session params)))
 	 (dir (cdr (assq :dir params)))
 	 (default-directory
-	   (or (and dir (file-name-as-directory dir)) default-directory))
+	   (or (and dir (if (eq dir 'attach)
+                            (org-attach-dir t)
+                          (file-name-as-directory dir)))
+               default-directory))
 	 (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
 	 (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
     (when (and (stringp session) (string= session "none"))
@@ -2241,9 +2250,12 @@ INFO may provide the values of these header arguments (in the
   (cond ((stringp result)
 	 (setq result (org-no-properties result))
 	 (when (member "file" result-params)
-	   (setq result (org-babel-result-to-file
-			 result
-			 (org-babel--file-desc (nth 2 info) result)))))
+	   (setq result (let ((params (nth 2 info)))
+                          (org-babel-result-to-file
+			   result
+			   (org-babel--file-desc params result)
+                           (when (equal (cdr (assq :dir params)) 'attach)
+                             'attachment))))))
 	((listp result))
 	(t (setq result (format "%S" result))))
   (if (and result-params (member "silent" result-params))
@@ -2548,27 +2560,41 @@ in the buffer."
 		 (line-beginning-position 2))
 	     (point))))))
 
-(defun org-babel-result-to-file (result &optional description)
+(defun org-babel-result-to-file (result &optional description type)
   "Convert RESULT into an Org link with optional DESCRIPTION.
 If the `default-directory' is different from the containing
-file's directory then expand relative links."
+file's directory then expand relative links.
+If the optional TYPE is passed as 'attachment` and the path is a descendant of the DEFAULT-DIRECTORY, the generated link will be specified as an an \"attachment:\" style link"
   (when (stringp result)
-    (let ((same-directory?
-	   (and (buffer-file-name (buffer-base-buffer))
-		(not (string= (expand-file-name default-directory)
-			    (expand-file-name
-			     (file-name-directory
-			      (buffer-file-name (buffer-base-buffer)))))))))
-      (format "[[file:%s]%s]"
-	      (if (and default-directory
-		       (buffer-file-name (buffer-base-buffer)) same-directory?)
-		  (if (eq org-link-file-path-type 'adaptive)
-		      (file-relative-name
-		       (expand-file-name result default-directory)
-		       (file-name-directory
-			(buffer-file-name (buffer-base-buffer))))
-		    (expand-file-name result default-directory))
-		result)
+    (let* ((result-file-name (expand-file-name result))
+           (base-file-name (buffer-file-name (buffer-base-buffer)))
+           (same-directory?
+	    (and base-file-name
+	         (not (string= (expand-file-name default-directory)
+			       (expand-file-name
+			        (file-name-directory
+			         base-file-name))))))
+           (request-attachment (eq type 'attachment))
+           (attach-dir-len (when request-attachment (length default-directory)))
+           (in-attach-dir (when (and request-attachment (> (length result-file-name) attach-dir-len))
+                            (string=
+                             (substring result-file-name 0 attach-dir-len)
+                             default-directory))))
+      (format "[[%s:%s]%s]"
+              (pcase type
+                ('attachment "attachment")
+                (_ "file"))
+              (if (and request-attachment in-attach-dir)
+                  (file-relative-name result-file-name)
+	        (if (and default-directory
+		         base-file-name same-directory?)
+		    (if (eq org-link-file-path-type 'adaptive)
+		        (file-relative-name
+		         result-file-name
+                         (file-name-directory
+			  base-file-name))
+		      result-file-name)
+		  result))
 	      (if description (concat "[" description "]") "")))))
 
 (defun org-babel-examplify-region (beg end &optional results-switches inline)
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index f18453103..b06b85360 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -323,6 +323,7 @@ Shows a list of commands and prompts for another key to execute a command."
 	    (call-interactively command)
 	  (error "No such attachment command: %c" c))))))
 
+;;;###autoload
 (defun org-attach-dir (&optional create-if-not-exists-p no-fs-check)
   "Return the directory associated with the current outline node.
 First check for DIR property, then ID property.
-- 
2.32.0.windows.2