Hi,
This patch adds a new org-attach-download command, which downloads
remote files with url.el and attaches them with org-attach. When called
without a prefix, it first looks at point for a link, and prompts the
user for a URL if none is found. When called with prefix, it prompts
for the URL. Before downloading, it asks for confirmation.
Thanks,
Adam>From 426f95caa8e1f728327809cad2f9539857bb8567 Mon Sep 17 00:00:00 2001
From: Adam Porter
Date: Thu, 13 Sep 2018 04:44:48 -0500
Subject: [PATCH] org-attach: Add org-attach-download command
* lisp/org-attach.el: Require "files" and "url-handlers".
(org-attach-download): Add command.
(org-attach): Add to dispatcher under "L".
* etc/ORG-NEWS: Add entry.
---
etc/ORG-NEWS | 6 ++
lisp/org-attach.el | 30 ++
2 files changed, 36 insertions(+)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 2a22be0..5b999c5 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -312,6 +312,12 @@ beginning of a headline when using Org speed commands. Now, if there
is already a restriction at point, hitting =<= again (or =C-x C-x <=) will
remove it.
+*** ~org-attach-download~ downloads and attaches remote files
+
+The new command ~org-attach-download~, available through the
+~org-attach~ dispatcher with =C-c C-a L=, downloads remote files and
+attaches them with ~org-attach~.
+
** New commands and functions
*** ~org-insert-structure-template~
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 53389f7..5f80ac0 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -41,6 +41,8 @@
(require 'org)
(require 'org-id)
(require 'vc-git)
+(require 'files)
+(require 'url-handlers)
(declare-function dired-dwim-target-directory "dired-aux")
@@ -181,6 +183,9 @@ n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
+L Download file and attach it. Look for link at point,
+or prompt for URL if not found or called with prefix.
+
o Open current task's attachments.
O Like \"o\", but force opening in Emacs.
f Open current task's attachment directory.
@@ -210,6 +215,7 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'url)) (call-interactively 'org-attach-url)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
+ ((eq c ?L) (call-interactively 'org-attach-download))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
((eq c ?O)(call-interactively 'org-attach-open-in-emacs))
((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
@@ -224,6 +230,30 @@ i Make children of the current entry inherit its attachment directory.")))
'org-attach-set-inherit))
(t (error "No such attachment command %c" c))
+(defun org-attach-download (url)
+ "Download file at URL and attach with `org-attach'.
+Interactively, look for URL at point, prompting if not found.
+With prefix, prompt for URL. Always prompt before downloading
+file."
+ (interactive (list (if current-prefix-arg
+ (read-string "URL: ")
+ (or (org-element-property :raw-link (org-element-context))
+ (read-string "URL: ")
+ (when (yes-or-no-p (concat "Attach file at URL: " url))
+(let* ((temp-dir (make-temp-file "org-attach-download-link-" 'dir))
+ (basename (file-name-nondirectory (directory-file-name url)))
+ (local-path (expand-file-name basename temp-dir))
+ size)
+ (unwind-protect
+ (progn
+(url-copy-file url local-path 'ok-if-exists 'keep-time)
+(setq size (file-size-human-readable
+(file-attribute-size
+ (file-attributes local-path
+(org-attach-attach local-path nil 'mv)
+(message "Attached %s (%s)" url size))
+(delete-directory temp-dir)
+
(defun org-attach-dir ( create-if-not-exists-p)
"Return the directory associated with the current entry.
This first checks for a local property ATTACH_DIR, and then for an inherited
--
2.7.4
