;;; org-download.el --- Image drag-and-drop for Emacs org-mode
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; Keywords: images, screenshots, download
;; Homepage: http://orgmode.org
;; This file is not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see .
;;; Commentary:
;;
;; This extension facilitates moving images from point A to point B.
;;
;; Point A (the source) can be:
;; 1. An image inside your browser that you can drag to Emacs.
;; 2. An image on your file system that you can drag to Emacs.
;; 3. A local or remote image address in kill-ring.
;; Use the `org-download-yank' command for this.
;; Remember that you can use "0 w" in `dired' to get an address.
;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'.
;; Use the `org-download-screenshot' command for this.
;; Customize the backend with `org-download-screenshot-method'.
;;
;; Point B (the target) is an Emacs `org-mode' buffer where the inline
;; link will be inserted. Several customization options will determine
;; where exactly on the file system the file will be stored.
;;
;; They are:
;; `org-download-method':
;; a. 'attach => use `org-mode' attachment machinery
;; b. 'directory => construct the directory in two stages:
;; 1. first part of the folder name is:
;; * either "." (current folder)
;; * or `org-download-image-dir' (if it's not nil).
;; `org-download-image-dir' becomes buffer-local when set,
;; so each file can customize this value, e.g with:
;; # -*- mode: Org; org-download-image-dir: "~/Pictures/foo"; -*-
;; 2. second part is:
;; * `org-download-heading-lvl' is nil => ""
;; * `org-download-heading-lvl' is n => the name of current
;; heading with level n. Level count starts with 0,
;; i.e. * is 0, ** is 1, *** is 2 etc.
;; `org-download-heading-lvl' becomes buffer-local when set,
;; so each file can customize this value, e.g with:
;; # -*- mode: Org; org-download-heading-lvl: nil; -*-
;;
;; `org-download-timestamp':
;; optionally add a timestamp to the file name.
;;
;; Customize `org-download-backend' to choose between `url-retrieve'
;; (the default) or `wget' or `curl'.
;;
;;; Code:
(eval-when-compile
(require 'cl))
(require 'url-parse)
(require 'url-http)
(defgroup org-download nil
"Image drag-and-drop for org-mode."
:group 'org
:prefix "org-download-")
(defcustom org-download-method 'directory
"The way images should be stored."
:type '(choice
(const :tag "Directory" directory)
(const :tag "Attachment" attach))
:group 'org-download)
(defcustom org-download-image-dir nil
"If set, images will be stored in this directory instead of \".\".
See `org-download--dir-1' for more info."
:type '(choice
(const :tag "Default" nil)
(string :tag "Directory"))
:group 'org-download)
(make-variable-buffer-local 'org-download-image-dir)
(defcustom org-download-heading-lvl 0
"Heading level to be used in `org-download--dir-2'."
:group 'org-download)
(make-variable-buffer-local 'org-download-heading-lvl)
(defcustom org-download-backend t
"Method to use for downloading."
:type '(choice
(const :tag "wget" "wget \"%s\" -O \"%s\"")
(const :tag "curl" "curl \"%s\" -o \"%s\"")
(const :tag "url-retrieve" t))
:group 'org-download)
(defcustom org-download-timestamp "_%Y-%m-%d_%H:%M:%S"
"This `format-time-string'-style string will be appended to the file name.
Set this to \"\" if you don't want time stamps."
:type 'string
:group 'org-download)
(defcustom org-download-img-regex-list
'("
= (decf times) 0)
(re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t))
(let ((str (match-string-no-properties 1)))
(delete-region beg
(match-end 0))
(when (file-exists-p str)
(delete-file str))))))
(defun org-download-dnd (uri action)
"When in `org-mode' and URI points to image, download it.
Otherwise, pass URI and ACTION back to dnd dispatch."
(cond ((eq major-mode 'org-mode)
;; probably shouldn't redirect
(unless (org-download-image uri)
(message "not an image URL")))
((eq major-mode 'dired-mode)
(org-download-dired uri))
;; redirect to someone else
(t
(let ((dnd-protocol-alist
(rassq-delete-all
'org-download-dnd
(copy-alist dnd-protocol-alist))))
(dnd-handle-one-url nil action uri)))))
(defun org-download-dired (uri)
"Download URI to current directory."
(raise-frame)
(let ((filename (file-name-nondirectory
(car (url-path-and-query
(url-generic-parse-url uri))))))
(message "Downloading %s to %s ..."
filename
(expand-file-name filename))
(url-retrieve
uri
(lambda (status filename)
(let ((err (plist-get status :error)))
(if err (error
"\"%s\" %s" uri
(downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
(let ((coding-system-for-write 'no-conversion))
(write-region nil nil filename nil nil nil 'confirm)))
(list
(expand-file-name filename))
t t)))
(defun org-download-enable ()
"Enable org-download."
(unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\)://" dnd-protocol-alist))
'org-download-dnd)
(setq dnd-protocol-alist
`(("^\\(https?\\|ftp\\|file\\|nfs\\)://" . org-download-dnd) ,@dnd-protocol-alist))))
(defun org-download-disable ()
"Disable org-download."
(rassq-delete-all 'org-download-dnd dnd-protocol-alist))
(org-download-enable)
(provide 'org-download)
;;; org-download.el ends here