1 ;;; org-download.el --- Image drag-and-drop for Emacs org-mode
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
6 ;; Keywords: images, screenshots, download
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This extension facilitates moving images from point A to point B.
28 ;; Point A (the source) can be:
29 ;; 1. An image inside your browser that you can drag to Emacs.
30 ;; 2. An image on your file system that you can drag to Emacs.
31 ;; 3. A local or remote image address in kill-ring.
32 ;; Use the `org-download-yank' command for this.
33 ;; Remember that you can use "0 w" in `dired' to get an address.
34 ;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'.
35 ;; Use the `org-download-screenshot' command for this.
36 ;; Customize the backend with `org-download-screenshot-method'.
38 ;; Point B (the target) is an Emacs `org-mode' buffer where the inline
39 ;; link will be inserted. Several customization options will determine
40 ;; where exactly on the file system the file will be stored.
43 ;; `org-download-method':
44 ;; a. 'attach => use `org-mode' attachment machinery
45 ;; b. 'directory => construct the directory in two stages:
46 ;; 1. first part of the folder name is:
47 ;; * either "." (current folder)
48 ;; * or `org-download-image-dir' (if it's not nil).
49 ;; `org-download-image-dir' becomes buffer-local when set,
50 ;; so each file can customize this value, e.g with:
51 ;; # -*- mode: Org; org-download-image-dir: ~/Pictures/foo; -*-
53 ;; * `org-download-heading-lvl' is nil => ""
54 ;; * `org-download-heading-lvl' is n => the name of current
55 ;; heading with level n. Level count starts with 0,
56 ;; i.e. * is 0, ** is 1, *** is 2 etc.
57 ;; `org-download-heading-lvl' becomes buffer-local when set,
58 ;; so each file can customize this value, e.g with:
59 ;; # -*- mode: Org; org-download-heading-lvl: nil; -*-
61 ;; `org-download-timestamp':
62 ;; optionally add a timestamp to the file name.
64 ;; Customize `org-download-backend' to choose between `url-retrieve'
65 ;; (the default) or `wget' or `curl'.
75 (defgroup org-download nil
76 "Image drag-and-drop for org-mode."
78 :prefix
"org-download-")
80 (defcustom org-download-method
'directory
81 "The way images should be stored."
83 (const :tag
"Directory" directory
)
84 (const :tag
"Attachment" attach
))
87 (defcustom org-download-image-dir nil
88 "If set, images will be stored in this directory instead of \".\".
89 See `org-download--dir-1' for more info."
91 (const :tag
"Default" nil
)
92 (string :tag
"Directory"))
94 (make-variable-buffer-local 'org-download-image-dir
)
96 (defcustom org-download-heading-lvl
0
97 "Heading level to be used in `org-download--dir-2'."
99 (make-variable-buffer-local 'org-download-heading-lvl
)
101 (defcustom org-download-backend t
102 "Method to use for downloading."
104 (const :tag
"wget" "wget \"%s\" -O \"%s\"")
105 (const :tag
"curl" "curl \"%s\" -o \"%s\"")
106 (const :tag
"url-retrieve" t
))
107 :group
'org-download
)
109 (defcustom org-download-timestamp
"_%Y-%m-%d_%H:%M:%S"
110 "This `format-time-string'-style string will be appended to the file name.
111 Set this to \"\" if you don't want time stamps."
113 :group
'org-download
)
115 (defcustom org-download-screenshot-method
"gnome-screenshot -a -f %s"
116 "The tool to capture screenshots."
118 (const :tag
"gnome-screenshot" "gnome-screenshot -a -f %s")
119 (const :tag
"scrot" "scrot -s %s")
120 (const :tag
"gm" "gm import %s"))
121 :group
'org-download
)
123 (defcustom org-download-image-width
0
124 "When non-zero add #+attr_html: :width tag to the image."
126 :group
'org-download
)
128 (defun org-download-get-heading (lvl)
129 "Return the heading of the current entry's LVL level parent."
131 (let ((cur-lvl (org-current-level)))
132 (unless (= cur-lvl
1)
133 (org-up-heading-all (- (1- (org-current-level)) lvl
)))
134 (substring-no-properties
135 (org-get-heading)))))
137 (defun org-download--dir-1 ()
138 "Return the first part of the directory path for `org-download--dir'.
139 It's `org-download-image-dir', unless it's nil. Then it's \".\"."
140 (or org-download-image-dir
"."))
142 (defun org-download--dir-2 ()
143 "Return the second part of the directory path for `org-download--dir'.
144 Unless `org-download-heading-lvl' is nil, it's the name of the current
145 `org-download-heading-lvl'-leveled heading. Otherwise it's \"\"."
146 (and org-download-heading-lvl
147 (org-download-get-heading
148 org-download-heading-lvl
)))
150 (defun org-download--dir ()
151 "Return the directory path for image storage.
153 The path is composed from `org-download--dir-1' and `org-download--dir-2'.
154 The directory is created if it didn't exist before."
155 (let* ((part1 (org-download--dir-1))
156 (part2 (org-download--dir-2))
158 (format "%s/%s" part1 part2
)
160 (unless (file-exists-p dir
)
161 (make-directory dir t
))
164 (defun org-download--fullname (link)
165 "Return the file name where LINK will be saved to.
167 It's affected by `org-download-timestamp' and `org-download--dir'."
169 (file-name-nondirectory
170 (car (url-path-and-query
171 (url-generic-parse-url link
)))))
172 (dir (org-download--dir)))
175 (file-name-sans-extension filename
)
176 (format-time-string org-download-timestamp
)
177 (file-name-extension filename
))))
179 (defun org-download--image (link filename
)
180 "Save LINK to FILENAME asynchronously and show inline images in current buffer."
181 (when (string-match "^file://\\(.*\\)" link
)
182 (setq link
(url-unhex-string (match-string 1 link
))))
183 (cond ((file-exists-p link
)
184 (org-download--image/command
"cp \"%s\" \"%s\"" link filename
))
185 ((eq org-download-backend t
)
186 (org-download--image/url-retrieve link filename
))
188 (org-download--image/command org-download-backend link filename
))))
190 (defun org-download--image/command
(command link filename
)
191 "Using COMMAND, save LINK to FILENAME.
192 COMMAND is a format-style string with two slots for LINK and FILENAME."
195 `(lambda() (shell-command
196 ,(format command link
197 (expand-file-name filename
))))
198 (lexical-let ((cur-buf (current-buffer)))
200 (with-current-buffer cur-buf
201 (org-display-inline-images))))))
203 (defun org-download--image/url-retrieve
(link filename
)
204 "Save LINK to FILENAME using `url-retrieve'."
207 (lambda (status filename buffer
)
208 ;; Write current buffer to FILENAME
209 ;; and update inline images in BUFFER
210 (let ((err (plist-get status
:error
)))
213 (downcase (nth 2 (assq (nth 2 err
) url-http-codes
))))))
217 (re-search-forward "\n\n" nil
'move
)
219 (let ((coding-system-for-write 'no-conversion
))
220 (write-region nil nil filename nil nil nil
'confirm
))
221 (with-current-buffer buffer
222 (org-display-inline-images)))
224 (expand-file-name filename
)
228 (defun org-download-yank ()
229 "Call `org-download-image' with current kill."
231 (org-download-image (current-kill 0)))
233 (defun org-download-screenshot ()
234 "Capture screenshot and insert the resulting file.
235 The screenshot tool is determined by `org-download-screenshot-method'."
237 (let ((link "/tmp/screenshot.png"))
238 (shell-command (format org-download-screenshot-method link
))
239 (org-download-image link
)))
241 (defun org-download-image (link)
242 "Save image at address LINK to `org-download--dir'."
243 (interactive "sUrl: ")
245 (if (eq org-download-method
'attach
)
246 (let ((org-download-image-dir (progn (require 'org-attach
)
248 org-download-heading-lvl
)
249 (org-download--fullname link
))
250 (org-download--fullname link
))))
251 (when (image-type-from-file-name filename
)
252 (org-download--image link filename
)
253 (when (eq org-download-method
'attach
)
254 (org-attach-attach filename nil
'none
))
255 (if (looking-back "^[ \t]+")
256 (delete-region (match-beginning 0) (match-end 0))
258 (insert (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
260 (format-time-string "%Y-%m-%d %H:%M:%S")
261 (if (= org-download-image-width
0)
263 (format "#+attr_html: :width %dpx\n" org-download-image-width
))
265 (org-display-inline-images))))
267 (defun org-download--at-comment-p ()
268 "Check if current line begins with #+DOWLOADED:."
270 (move-beginning-of-line nil
)
271 (looking-at "#\\+DOWNLOADED:")))
273 (defun org-download-delete ()
274 "Delete inline image link on current line, and the file that it points to."
276 (cond ((org-download--at-comment-p)
277 (delete-region (line-beginning-position)
279 (org-download--delete (line-beginning-position)
283 (org-download--delete (region-beginning)
285 (delete-region (region-beginning)
288 (t (org-download--delete (line-beginning-position)
289 (line-end-position)))))
291 (defun org-download--delete (beg end
&optional times
)
292 "Delete inline image links and the files they point to between BEG and END.
294 When TIMES isn't nil, delete only TIMES links."
296 (setq times most-positive-fixnum
))
299 (while (and (>= (decf times
) 0)
300 (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t
))
301 (let ((str (match-string-no-properties 1)))
302 (delete-region (match-beginning 0)
304 (when (file-exists-p str
)
305 (delete-file str
))))))
307 (defun org-download-dnd (uri action
)
308 "When in `org-mode' and URI points to image, download it.
309 Otherwise, pass URI and ACTION back to dnd dispatch."
310 (if (eq major-mode
'org-mode
)
311 ;; probably shouldn't redirect
312 (unless (org-download-image uri
)
313 (message "not an image URL"))
314 ;; redirect to someone else
315 (let ((dnd-protocol-alist
318 (copy-alist dnd-protocol-alist
))))
319 (dnd-handle-one-url nil action uri
))))
321 (defun org-download-enable ()
322 "Enable org-download."
323 (unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\)://" dnd-protocol-alist
))
325 (setq dnd-protocol-alist
326 `(("^\\(https?\\|ftp\\|file\\|nfs\\)://" . org-download-dnd
) ,@dnd-protocol-alist
))))
328 (defun org-download-disable ()
329 "Disable org-download."
330 (rassq-delete-all 'org-download-dnd dnd-protocol-alist
))
332 (org-download-enable)
334 (provide 'org-download
)
336 ;;; org-download.el ends here