emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] Add org-attach-download command
@ 2018-09-13  9:51 Adam Porter
  2018-09-13 21:13 ` Nicolas Goaziou
  2018-09-13 21:34 ` Eric Abrahamsen
  0 siblings, 2 replies; 3+ messages in thread
From: Adam Porter @ 2018-09-13  9:51 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 358 bytes --]

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 4024 bytes --]

From 426f95caa8e1f728327809cad2f9539857bb8567 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
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 (&optional 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


^ permalink raw reply related	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2018-09-13 21:37 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-09-13  9:51 [PATCH] Add org-attach-download command Adam Porter
2018-09-13 21:13 ` Nicolas Goaziou
2018-09-13 21:34 ` Eric Abrahamsen

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).