emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Ryan Scott <ryan@vicarious-living.com>
To: Ihor Radchenko <yantar92@gmail.com>
Cc: Greg Minshall <minshall@umich.edu>,
	emacs-orgmode@gnu.org, Timothy <tecosaur@gmail.com>
Subject: Re: [PATCH] Re: New source block results option for attaching file to node
Date: Thu, 9 Sep 2021 18:04:10 -0700	[thread overview]
Message-ID: <CAHBUXNzg3S44BfOFHsvL7vjA-SMbpHeVbmvrm_H8kUocQeu-uQ@mail.gmail.com> (raw)
In-Reply-To: <CAHBUXNzeLZLjDK-WEDzG0-M1Jw+s6=sBA1HiNdyJ8D0QqiBuPQ@mail.gmail.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


  reply	other threads:[~2021-09-10  1:06 UTC|newest]

Thread overview: 34+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-08-26  8:48 New source block results option for attaching file to node Ryan Scott
2021-08-31 11:15 ` Timothy
2021-08-31 19:43   ` Ryan Scott
2021-09-01 14:45     ` Ihor Radchenko
2021-09-01 20:01       ` Ryan Scott
2021-09-02  7:40         ` [PATCH] " Ryan Scott
2021-09-02 13:44           ` Greg Minshall
2021-09-03  3:10             ` Ihor Radchenko
2021-09-03  3:28               ` Ryan Scott
2021-09-05 13:22                 ` Ihor Radchenko
2021-09-05 13:56                   ` Ryan Scott
2021-09-10  1:04                     ` Ryan Scott [this message]
2021-09-10  6:26                       ` Timothy
2021-10-02  8:32                       ` Ihor Radchenko
2021-10-02  9:39                         ` Ryan Scott
2021-10-05  0:04               ` Christopher M. Miles
2021-10-05  1:05                 ` Ryan Scott
2021-10-08  1:22                   ` Christopher M. Miles
2021-11-05  7:16                   ` Ryan Scott
2022-04-21 12:47                     ` Ihor Radchenko
2022-04-21 17:29                       ` Ryan Scott
2022-04-22  6:02                         ` Ihor Radchenko
2022-04-22  6:19                           ` Ryan Scott
2022-06-10  8:06                             ` Ryan Scott
2022-06-11  4:32                               ` Ihor Radchenko
2022-06-11  7:47                                 ` Ryan Scott
2022-06-11 12:49                                   ` Ihor Radchenko
2022-06-12  0:47                                     ` Ryan Scott
2022-06-14  4:11                                       ` Ihor Radchenko
2022-06-14  5:55                                         ` Ryan Scott
2022-06-14  9:04                                           ` Ryan Scott
2022-06-14 13:48                                             ` Ihor Radchenko
2022-06-14 18:23                                               ` Ryan Scott
2022-06-11 12:51                                   ` Ihor Radchenko

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=CAHBUXNzg3S44BfOFHsvL7vjA-SMbpHeVbmvrm_H8kUocQeu-uQ@mail.gmail.com \
    --to=ryan@vicarious-living.com \
    --cc=emacs-orgmode@gnu.org \
    --cc=minshall@umich.edu \
    --cc=tecosaur@gmail.com \
    --cc=yantar92@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).