diff options
Diffstat (limited to 'contrib/lisp/org-download.el')
| -rw-r--r-- | contrib/lisp/org-download.el | 392 |
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 |