summaryrefslogtreecommitdiff
path: root/contrib/lisp/org-download.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
commitec84430cf4e09ba25ec675debdf802bc28111e06 (patch)
tree9c64bc8a0cd5e8cac82aa5fdf369d40529f140f8 /contrib/lisp/org-download.el
parent84539dca3aa301ecfe48858eceef1ced0505388b (diff)
Imported Upstream version 9.0
Diffstat (limited to 'contrib/lisp/org-download.el')
-rw-r--r--contrib/lisp/org-download.el392
1 files changed, 0 insertions, 392 deletions
diff --git a/contrib/lisp/org-download.el b/contrib/lisp/org-download.el
deleted file mode 100644
index cbf335b..0000000
--- a/contrib/lisp/org-download.el
+++ /dev/null
@@ -1,392 +0,0 @@
-;;; org-download.el --- Image drag-and-drop for Emacs org-mode
-
-;; Copyright (C) 2014-2016 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 <http://www.gnu.org/licenses/>.
-
-;;; 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
- '("<img +src=\"" "<img +\\(class=\"[^\"]+\"\\)? *src=\"")
- "This regex is used to unalias links that look like images.
-The html to which the links points will be searched for these
-regexes, one by one, until one succeeds. The found image address
-will be used."
- :group 'org-download)
-
-(defcustom org-download-screenshot-method "gnome-screenshot -a -f %s"
- "The tool to capture screenshots."
- :type '(choice
- (const :tag "gnome-screenshot" "gnome-screenshot -a -f %s")
- (const :tag "scrot" "scrot -s %s")
- (const :tag "gm" "gm import %s"))
- :group 'org-download)
-
-(defcustom org-download-image-width 0
- "When non-zero add #+attr_html: :width tag to the image."
- :type 'integer
- :group 'org-download)
-
-(defun org-download-get-heading (lvl)
- "Return the heading of the current entry's LVL level parent."
- (save-excursion
- (let ((cur-lvl (org-current-level)))
- (if cur-lvl
- (progn
- (unless (= cur-lvl 1)
- (org-up-heading-all (- (1- (org-current-level)) lvl)))
- (substring-no-properties
- (org-get-heading)))
- ""))))
-
-(defun org-download--dir-1 ()
- "Return the first part of the directory path for `org-download--dir'.
-It's `org-download-image-dir', unless it's nil. Then it's \".\"."
- (or org-download-image-dir "."))
-
-(defun org-download--dir-2 ()
- "Return the second part of the directory path for `org-download--dir'.
-Unless `org-download-heading-lvl' is nil, it's the name of the current
-`org-download-heading-lvl'-leveled heading. Otherwise it's \"\"."
- (and org-download-heading-lvl
- (org-download-get-heading
- org-download-heading-lvl)))
-
-(defun org-download--dir ()
- "Return the directory path for image storage.
-
-The path is composed from `org-download--dir-1' and `org-download--dir-2'.
-The directory is created if it didn't exist before."
- (let* ((part1 (org-download--dir-1))
- (part2 (org-download--dir-2))
- (dir (if part2
- (format "%s/%s" part1 part2)
- part1)))
- (unless (file-exists-p dir)
- (make-directory dir t))
- dir))
-
-(defun org-download--fullname (link)
- "Return the file name where LINK will be saved to.
-
-It's affected by `org-download-timestamp' and `org-download--dir'."
- (let ((filename
- (file-name-nondirectory
- (car (url-path-and-query
- (url-generic-parse-url link)))))
- (dir (org-download--dir)))
- (when (string-match ".*?\\.\\(?:png\\|jpg\\)\\(.*\\)$" filename)
- (setq filename (replace-match "" nil nil filename 1)))
- (abbreviate-file-name
- (expand-file-name
- (format "%s%s.%s"
- (file-name-sans-extension filename)
- (format-time-string org-download-timestamp)
- (file-name-extension filename))
- dir))))
-
-(defun org-download--image (link filename)
- "Save LINK to FILENAME asynchronously and show inline images in current buffer."
- (when (string-match "^file://\\(.*\\)" link)
- (setq link (url-unhex-string (match-string 1 link))))
- (cond ((and (not (file-remote-p link))
- (file-exists-p link))
- (org-download--image/command "cp \"%s\" \"%s\"" link filename))
- ((eq org-download-backend t)
- (org-download--image/url-retrieve link filename))
- (t
- (org-download--image/command org-download-backend link filename))))
-
-(defun org-download--image/command (command link filename)
- "Using COMMAND, save LINK to FILENAME.
-COMMAND is a format-style string with two slots for LINK and FILENAME."
- (require 'async)
- (async-start
- `(lambda() (shell-command
- ,(format command link
- (expand-file-name filename))))
- (lexical-let ((cur-buf (current-buffer)))
- (lambda(x)
- (with-current-buffer cur-buf
- (org-display-inline-images))))))
-
-(defun org-download--image/url-retrieve (link filename)
- "Save LINK to FILENAME using `url-retrieve'."
- (url-retrieve
- link
- (lambda (status filename buffer)
- ;; Write current buffer to FILENAME
- ;; and update inline images in BUFFER
- (let ((err (plist-get status :error)))
- (if err (error
- "\"%s\" %s" link
- (downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
- (delete-region
- (point-min)
- (progn
- (re-search-forward "\n\n" nil 'move)
- (point)))
- (let ((coding-system-for-write 'no-conversion))
- (write-region nil nil filename nil nil nil 'confirm))
- (with-current-buffer buffer
- (org-display-inline-images)))
- (list
- (expand-file-name filename)
- (current-buffer))
- nil t))
-
-(defun org-download-yank ()
- "Call `org-download-image' with current kill."
- (interactive)
- (org-download-image (current-kill 0)))
-
-(defun org-download-screenshot ()
- "Capture screenshot and insert the resulting file.
-The screenshot tool is determined by `org-download-screenshot-method'."
- (interactive)
- (let ((link "/tmp/screenshot.png"))
- (shell-command (format org-download-screenshot-method link))
- (org-download-image link)))
-
-(defun org-download-image (link)
- "Save image at address LINK to `org-download--dir'."
- (interactive "sUrl: ")
- (unless (image-type-from-file-name link)
- (with-current-buffer
- (url-retrieve-synchronously link t)
- (let ((regexes org-download-img-regex-list)
- lnk)
- (while (and (not lnk) regexes)
- (goto-char (point-min))
- (when (re-search-forward (pop regexes) nil t)
- (backward-char)
- (setq lnk (read (current-buffer)))))
- (if lnk
- (setq link lnk)
- (error "link %s does not point to an image; unaliasing failed" link)))))
- (let ((filename
- (if (eq org-download-method 'attach)
- (let ((org-download-image-dir (progn (require 'org-attach)
- (org-attach-dir t)))
- org-download-heading-lvl)
- (org-download--fullname link))
- (org-download--fullname link))))
- (when (image-type-from-file-name filename)
- (org-download--image link filename)
- (when (eq org-download-method 'attach)
- (org-attach-attach filename nil 'none))
- (if (looking-back "^[ \t]+")
- (delete-region (match-beginning 0) (match-end 0))
- (newline))
- (insert
- (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
- link
- (format-time-string "%Y-%m-%d %H:%M:%S")
- (if (= org-download-image-width 0)
- ""
- (format
- "#+attr_html: :width %dpx\n" org-download-image-width))
- filename))
- (org-display-inline-images))))
-
-(defun org-download--at-comment-p ()
- "Check if current line begins with #+DOWLOADED:."
- (save-excursion
- (move-beginning-of-line nil)
- (looking-at "#\\+DOWNLOADED:")))
-
-(defun org-download-delete ()
- "Delete inline image link on current line, and the file that it points to."
- (interactive)
- (cond ((org-download--at-comment-p)
- (delete-region (line-beginning-position)
- (line-end-position))
- (org-download--delete (line-beginning-position)
- nil
- 1))
- ((region-active-p)
- (org-download--delete (region-beginning)
- (region-end))
- (delete-region (region-beginning)
- (region-end)))
-
- (t (org-download--delete (line-beginning-position)
- (line-end-position)))))
-
-(defun org-download--delete (beg end &optional times)
- "Delete inline image links and the files they point to between BEG and END.
-
-When TIMES isn't nil, delete only TIMES links."
- (unless times
- (setq times most-positive-fixnum))
- (save-excursion
- (goto-char beg)
- (while (and (>= (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