forked from mirrors/org-mode
contrib/lisp/org-download.el: Remove
Fixes https://github.com/abo-abo/org-download/issues/38 The package remains available at the above address and MELPA.
This commit is contained in:
Oleh Krehel
parent
adfa7649e5
commit
1399f58049
|
|
@ -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
|
||||
Loading…
Reference in New Issue