From 6d76577e80f8af2795321a9cb0f0e92bb02b8341 Mon Sep 17 00:00:00 2001 From: Oleh Krehel Date: Sat, 4 Jan 2014 15:17:00 +0100 Subject: [PATCH] Add image drag-and-drop and screenshot support to org-mode. --- lisp/org-download.el | 336 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 336 insertions(+) create mode 100644 lisp/org-download.el diff --git a/lisp/org-download.el b/lisp/org-download.el new file mode 100644 index 0000000..39312cf --- /dev/null +++ b/lisp/org-download.el @@ -0,0 +1,336 @@ +;;; org-download.el --- Image drag-and-drop for Emacs org-mode + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; Keywords: images, screenshots, download +;; Homepage: http://orgmode.org + +;; This file is 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-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))) + (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))) + (format "%s/%s%s.%s" + dir + (file-name-sans-extension filename) + (format-time-string org-download-timestamp) + (file-name-extension filename)))) + +(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 ((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: ") + (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 (match-beginning 0) + (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." + (if (eq major-mode 'org-mode) + ;; probably shouldn't redirect + (unless (org-download-image uri) + (message "not an image URL")) + ;; redirect to someone else + (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-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 -- 1.8.4