org-download.el (28161B)
1 ;;; org-download.el --- Image drag-and-drop for Org-mode. -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. 4 5 ;; Author: Oleh Krehel 6 ;; URL: https://github.com/abo-abo/org-download 7 ;; Version: 0.2.0 8 ;; Package-Requires: ((emacs "24.3") (async "1.2")) 9 ;; Keywords: multimedia images screenshots download 10 11 ;; This file is not part of GNU Emacs. 12 13 ;; GNU Emacs is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; GNU Emacs is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 ;; 28 ;; This extension facilitates moving images from point A to point B. 29 ;; 30 ;; Point A (the source) can be: 31 ;; 1. An image inside your browser that you can drag to Emacs. 32 ;; 2. An image on your file system that you can drag to Emacs. 33 ;; 3. A local or remote image address in kill-ring. 34 ;; Use the `org-download-yank' command for this. 35 ;; Remember that you can use "0 w" in `dired' to get an address. 36 ;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'. 37 ;; Use the `org-download-screenshot' command for this. 38 ;; Customize the backend with `org-download-screenshot-method'. 39 ;; 40 ;; Point B (the target) is an Emacs `org-mode' buffer where the inline 41 ;; link will be inserted. Several customization options will determine 42 ;; where exactly on the file system the file will be stored. 43 ;; 44 ;; They are: 45 ;; `org-download-method': 46 ;; a. 'attach => use `org-mode' attachment machinery 47 ;; b. 'directory => construct the directory in two stages: 48 ;; 1. first part of the folder name is: 49 ;; * either "." (current folder) 50 ;; * or `org-download-image-dir' (if it's not nil). 51 ;; `org-download-image-dir' becomes buffer-local when set, 52 ;; so each file can customize this value, e.g with: 53 ;; # -*- mode: Org; org-download-image-dir: "~/Pictures/foo"; -*- 54 ;; 2. second part is: 55 ;; * `org-download-heading-lvl' is nil => "" 56 ;; * `org-download-heading-lvl' is n => the name of current 57 ;; heading with level n. Level count starts with 0, 58 ;; i.e. * is 0, ** is 1, *** is 2 etc. 59 ;; `org-download-heading-lvl' becomes buffer-local when set, 60 ;; so each file can customize this value, e.g with: 61 ;; # -*- mode: Org; org-download-heading-lvl: nil; -*- 62 ;; 63 ;; `org-download-timestamp': 64 ;; optionally add a timestamp to the file name. 65 ;; 66 ;; Customize `org-download-backend' to choose between `url-retrieve' 67 ;; (the default) or `wget' or `curl'. 68 ;; 69 ;;; Code: 70 71 72 (require 'cl-lib) 73 (require 'async) 74 (require 'url-parse) 75 (require 'url-http) 76 (require 'org) 77 (require 'org-attach) 78 (require 'org-element) 79 80 (defgroup org-download nil 81 "Image drag-and-drop for org-mode." 82 :group 'org 83 :prefix "org-download-") 84 85 (defcustom org-download-method 'directory 86 "The way images should be stored." 87 :type '(choice 88 (const :tag "Directory" directory) 89 (const :tag "Attachment" attach) 90 (function :tag "Custom function"))) 91 92 (defcustom org-download-image-dir nil 93 "If set, images will be stored in this directory instead of \".\". 94 It can be a directory string, or a function that returns a directory 95 string. See `org-download--dir-1' for more info." 96 :type '(choice 97 (const :tag "Default" nil) 98 (string :tag "Directory") 99 (function :tag "Function returning directory"))) 100 (make-variable-buffer-local 'org-download-image-dir) 101 102 (defcustom org-download-heading-lvl 0 103 "Heading level to be used in `org-download--dir-2'." 104 :type 105 '(choice integer (const :tag "None" nil))) 106 (make-variable-buffer-local 'org-download-heading-lvl) 107 108 (defvar org-download-path-last-file nil 109 "Variable to hold the full path of the last downloaded file. 110 See `org-download-rename-last-file'.") 111 112 (defcustom org-download-backend t 113 "Method to use for downloading." 114 :type '(choice 115 (const :tag "wget" "wget \"%s\" -O \"%s\"") 116 (const :tag "curl" "curl \"%s\" -o \"%s\"") 117 (const :tag "url-retrieve" t))) 118 119 (defcustom org-download-timestamp "%Y-%m-%d_%H-%M-%S_" 120 "This `format-time-string'-style string will be appended to the file name. 121 Set this to \"\" if you don't want time stamps." 122 :type 'string) 123 124 (defcustom org-download-img-regex-list 125 '("<img +src=\"" "<img +\\(class=\"[^\"]+\"\\)? *src=\"") 126 "This regex is used to unalias links that look like images. 127 The html to which the links points will be searched for these 128 regexes, one by one, until one succeeds. The found image address 129 will be used." 130 :type '(repeat string)) 131 132 (defcustom org-download-screenshot-method "gnome-screenshot -a -f %s" 133 "The tool to capture screenshots." 134 :type '(choice 135 (const :tag "gnome-screenshot" "gnome-screenshot -a -f %s") 136 (const :tag "scrot" "scrot -s %s") 137 (const :tag "flameshot" "flameshot gui --raw > %s") 138 (const :tag "gm" "gm import %s") 139 (const :tag "imagemagick/import" "magick import %s") 140 (const :tag "imagemagick/import + xclip to save to clipboard" 141 "export filename=\"%s\"; import png:\"$filename\" ;xclip -selection clipboard -target image/png -filter < \"$filename\" &>/dev/null") 142 (const :tag "xfce4-screenshooter" "xfce4-screenshooter -r -o cat > %s") 143 ;; screenshot method in ms-windows, /capture=4 stands for interactive. 144 (const :tag "IrfanView" "i_view64 /capture=4 /convert=\"%s\"") 145 ;; screenshot script in osx, -i stands for interactive, 146 ;; press space key to toggle between selection and 147 ;; window/application mode. 148 (const :tag "screencapture" "screencapture -i %s") 149 ;; KDE screenshot application 150 (const :tag "spectacle" "spectacle -br -o %s") 151 ;; take an image that is already on the clipboard, for Linux 152 (const :tag "xclip" 153 "xclip -selection clipboard -t image/png -o > %s") 154 ;; take an image that is already on the clipboard, for Windows 155 (const :tag "imagemagick/convert" "magick clipboard: %s") 156 ;; capture region, for Wayland 157 (const :tag "grim + slurp" "grim -g \"$(slurp)\" %s") 158 (function :tag "Custom function"))) 159 160 (defcustom org-download-screenshot-basename "screenshot.png" 161 "Default base filename to use for screenshots." 162 :type 'string) 163 164 (defcustom org-download-screenshot-file (expand-file-name org-download-screenshot-basename temporary-file-directory) 165 "The file to capture screenshots." 166 :type 'string) 167 168 (defcustom org-download-image-html-width 0 169 "When non-zero add #+attr_html: :width tag to the image." 170 :type 'integer) 171 172 (defcustom org-download-image-latex-width 0 173 "When non-zero add #+attr_latex: :width tag to the image." 174 :type 'integer) 175 176 (defcustom org-download-image-org-width 0 177 "When non-zero add #+attr_org: :width tag to the image." 178 :type 'integer) 179 180 (defcustom org-download-image-attr-list nil 181 "Add attr info to the image. 182 For example: 183 184 (\"#+attr_html: :width 80% :align center\" 185 \"#+attr_org: :width 100px\")" 186 :type '(repeat string)) 187 188 (defcustom org-download-delete-image-after-download nil 189 "When non-nil delete local image after download." 190 :type 'boolean) 191 192 (defcustom org-download-display-inline-images t 193 "When non-nil display inline images in org buffer after download." 194 :type 195 '(choice 196 (const :tag "On" t) 197 (const :tag "Off" nil) 198 (const :tag "Posframe" posframe))) 199 200 (defvar org-download-posframe-show-params 201 '(;; Please do not remove :timeout or set it to large. 202 :timeout 1 203 :internal-border-width 1 204 :internal-border-color "red" 205 :min-width 40 206 :min-height 10 207 :poshandler posframe-poshandler-window-center) 208 "List of parameters passed to `posframe-show'.") 209 210 (declare-function posframe-workable-p "ext:posframe") 211 (declare-function posframe-show "ext:posframe") 212 213 (defun org-download-org-mode-p () 214 "Return `t' if major-mode or derived-mode-p equals 'org-mode, otherwise `nil'." 215 (or (eq major-mode 'org-mode) (when (derived-mode-p 'org-mode) t))) 216 217 (defun org-download--display-inline-images () 218 (cond 219 ((eq org-download-display-inline-images t) 220 (org-display-inline-images)) 221 ((eq org-download-display-inline-images 'posframe) 222 (require 'posframe) 223 (when (posframe-workable-p) 224 (let ((buffer (get-buffer-create " *org-download-image"))) 225 (with-current-buffer buffer 226 (erase-buffer) 227 (insert-image-file org-download-path-last-file)) 228 (apply #'posframe-show 229 buffer 230 org-download-posframe-show-params)))))) 231 232 (defun org-download-get-heading (lvl) 233 "Return the heading of the current entry's LVL level parent." 234 (save-excursion 235 (let ((cur-lvl (org-current-level))) 236 (if cur-lvl 237 (progn 238 (unless (= cur-lvl 1) 239 (org-up-heading-all (- (1- (org-current-level)) lvl))) 240 (let ((heading (nth 4 (org-heading-components)))) 241 (if heading 242 (replace-regexp-in-string 243 " " "_" 244 heading) 245 ""))) 246 "")))) 247 248 (defun org-download--dir-1 () 249 "Return the first part of the directory path for `org-download--dir'. 250 It's `org-download-image-dir', unless it's nil. Then it's \".\". 251 If `org-download-image-dir' is a function, it is called with no 252 arguments to obtain the directory." 253 (let ((dir org-download-image-dir)) 254 (cond ((functionp dir) (or (funcall dir) ".")) 255 (dir) 256 (t ".")))) 257 258 (defun org-download--dir-2 () 259 "Return the second part of the directory path for `org-download--dir'. 260 Unless `org-download-heading-lvl' is nil, it's the name of the current 261 `org-download-heading-lvl'-leveled heading." 262 (when org-download-heading-lvl 263 (org-download-get-heading 264 org-download-heading-lvl))) 265 266 (defun org-download--dir () 267 "Return the directory path for image storage. 268 269 The path is composed from `org-download--dir-1' and `org-download--dir-2'. 270 The directory is created if it didn't exist before." 271 (if (org-download-org-mode-p) 272 (let* ((part1 (org-download--dir-1)) 273 (part2 (org-download--dir-2)) 274 (dir (if part2 275 (expand-file-name part2 part1) 276 part1))) 277 (unless (file-exists-p dir) 278 (make-directory dir t)) 279 dir) 280 default-directory)) 281 282 (defvar org-download-file-format-function #'org-download-file-format-default) 283 284 (defun org-download--fullname (link &optional ext) 285 "Return the file name where LINK will be saved to. 286 287 It's affected by `org-download--dir'. 288 EXT can hold the file extension, in case LINK doesn't provide it." 289 (let ((filename 290 (replace-regexp-in-string 291 "%20" " " 292 (file-name-nondirectory 293 (car (url-path-and-query 294 (url-generic-parse-url link)))))) 295 (dir (org-download--dir))) 296 (when (string-match ".*?\\.\\(?:png\\|jpg\\)\\(.*\\)$" filename) 297 (setq filename (replace-match "" nil nil filename 1))) 298 (when ext 299 (setq filename (concat (file-name-sans-extension filename) "." ext))) 300 (abbreviate-file-name 301 (expand-file-name 302 (funcall org-download-file-format-function filename) 303 dir)))) 304 305 (defun org-download-file-format-default (filename) 306 "It's affected by `org-download-timestamp'." 307 (concat 308 (format-time-string org-download-timestamp) 309 filename)) 310 311 (defvar org-download--file-content nil 312 "When non-nil, store the file name of an already downloaded file.") 313 314 (defun org-download--image (link filename) 315 "Save LINK to FILENAME asynchronously and show inline images in current buffer." 316 (when (string= "file" (url-type (url-generic-parse-url link))) 317 (setq link (url-unhex-string (url-filename (url-generic-parse-url link))))) 318 (cond ((and (not (file-remote-p link)) 319 (file-exists-p link)) 320 (copy-file link (expand-file-name filename))) 321 (org-download--file-content 322 (copy-file org-download--file-content (expand-file-name filename)) 323 (setq org-download--file-content nil)) 324 ((eq org-download-backend t) 325 (org-download--image/url-retrieve link filename)) 326 (t 327 (org-download--image/command org-download-backend link filename)))) 328 329 (defun org-download--image/command (command link filename) 330 "Using COMMAND, save LINK to FILENAME. 331 COMMAND is a format-style string with two slots for LINK and FILENAME." 332 (async-start 333 `(lambda () (shell-command 334 ,(format command link 335 (expand-file-name filename)))) 336 (let ((cur-buf (current-buffer))) 337 (lambda (_x) 338 (with-current-buffer cur-buf 339 (org-download--display-inline-images)))))) 340 341 (defun org-download--write-image (status filename) 342 "Write current buffer STATUS to FILENAME." 343 (let ((err (plist-get status :error))) 344 (when err 345 (error 346 "HTTP error %s" 347 (downcase (nth 2 (assq (nth 2 err) url-http-codes)))))) 348 (delete-region 349 (point-min) 350 (progn 351 (re-search-forward "\n\n" nil 'move) 352 (point))) 353 (let ((coding-system-for-write 'no-conversion)) 354 (write-region nil nil filename nil nil nil 'confirm))) 355 356 (defun org-download--image/url-retrieve (link filename) 357 "Save LINK to FILENAME using `url-retrieve'." 358 (url-retrieve 359 link 360 (lambda (status filename buffer) 361 (org-download--write-image status filename) 362 (cond ((org-download-org-mode-p) 363 (with-current-buffer buffer 364 (org-download--display-inline-images))) 365 ((eq major-mode 'dired-mode) 366 (let ((inhibit-message t)) 367 (with-current-buffer (dired (file-name-directory filename)) 368 (revert-buffer nil t)))))) 369 (list 370 (expand-file-name filename) 371 (current-buffer)) 372 nil t)) 373 374 (defun org-download-yank () 375 "Call `org-download-image' with current kill." 376 (interactive) 377 (let ((k (current-kill 0))) 378 (unless (url-type (url-generic-parse-url k)) 379 (user-error "Not a URL: %s" k)) 380 (org-download-image 381 (replace-regexp-in-string 382 "\n+$" "" k)))) 383 384 (defun org-download-screenshot (&optional basename) 385 "Capture screenshot and insert the resulting file. 386 The screenshot tool is determined by `org-download-screenshot-method'." 387 (interactive) 388 (let* ((screenshot-dir (file-name-directory org-download-screenshot-file)) 389 (org-download-screenshot-file 390 (if basename 391 (concat screenshot-dir basename) org-download-screenshot-file))) 392 (make-directory screenshot-dir t) 393 (if (functionp org-download-screenshot-method) 394 (funcall org-download-screenshot-method 395 org-download-screenshot-file) 396 (shell-command-to-string 397 (format org-download-screenshot-method 398 org-download-screenshot-file))) 399 (when (file-exists-p org-download-screenshot-file) 400 (org-download-image org-download-screenshot-file) 401 (delete-file org-download-screenshot-file)))) 402 403 (defun org-download-clipboard (&optional basename) 404 "Capture the image from the clipboard and insert the resulting file." 405 (interactive) 406 (let ((org-download-screenshot-method 407 (cl-case system-type 408 (gnu/linux 409 (if (string= "wayland" (getenv "XDG_SESSION_TYPE")) 410 (if (executable-find "wl-paste") 411 "wl-paste -t image/png > %s" 412 (user-error 413 "Please install the \"wl-paste\" program included in wl-clipboard")) 414 (if (executable-find "xclip") 415 "xclip -selection clipboard -t image/png -o > %s" 416 (user-error 417 "Please install the \"xclip\" program")))) 418 ((windows-nt cygwin) 419 (if (executable-find "magick") 420 "magick convert clipboard: %s" 421 (user-error 422 "Please install the \"magick\" program included in ImageMagick"))) 423 ((darwin berkeley-unix) 424 (if (executable-find "pngpaste") 425 "pngpaste %s" 426 (user-error 427 "Please install the \"pngpaste\" program from Homebrew.")))))) 428 (org-id-get-create) 429 (org-download-screenshot basename))) 430 431 (declare-function org-attach-dir "org-attach") 432 (declare-function org-attach-attach "org-attach") 433 (declare-function org-attach-sync "org-attach") 434 435 (defun org-download-annotate-default (link) 436 "Annotate LINK with the time of download." 437 (format "#+DOWNLOADED: %s @ %s\n" 438 (if (equal link org-download-screenshot-file) 439 "screenshot" 440 link) 441 (format-time-string "%Y-%m-%d %H:%M:%S"))) 442 443 (defvar org-download-annotate-function 444 #'org-download-annotate-default 445 "Function that takes LINK and returns a string. 446 It's inserted before the image link and is used to annotate it.") 447 448 (defvar org-download-link-format 449 "[[file:%s]]\n" 450 "Format of the file link to insert.") 451 452 (defcustom org-download-link-format-function #'org-download-link-format-function-default 453 "Function that takes FILENAME and returns a org link." 454 :type 'function) 455 456 (defcustom org-download-abbreviate-filename-function #'file-relative-name 457 "Function that takes FILENAME and returns an abbreviated file name." 458 :type '(choice 459 (const :tag "relative" file-relative-name) 460 (const :tag "absolute" expand-file-name))) 461 462 (defun org-download-link-format-function-default (filename) 463 "The default function of `org-download-link-format-function'." 464 (if (and (>= (string-to-number org-version) 9.3) 465 (eq org-download-method 'attach)) 466 (format "[[attachment:%s]]\n" 467 (org-link-escape 468 (file-relative-name filename (org-attach-dir)))) 469 (format org-download-link-format 470 (org-link-escape 471 (funcall org-download-abbreviate-filename-function filename))))) 472 473 (defun org-download--detect-ext (link buffer) 474 (let (ext) 475 (with-current-buffer buffer 476 (cond ((let ((regexes org-download-img-regex-list) 477 lnk) 478 (while (and (not lnk) regexes) 479 (goto-char (point-min)) 480 (when (re-search-forward (pop regexes) nil t) 481 (backward-char) 482 (setq lnk (read (current-buffer))))) 483 (when lnk 484 (setq link lnk)))) 485 ((progn 486 (goto-char (point-min)) 487 (when (re-search-forward "^Content-Type: image/\\(.*\\)$" nil t) 488 (setq ext (match-string 1))))) 489 ((progn 490 (goto-char (point-min)) 491 (when (re-search-forward "^Content-Type: application/pdf" nil t) 492 (setq ext "pdf")) 493 (re-search-forward "^%PDF") 494 (beginning-of-line) 495 (write-region 496 (point) (point-max) 497 (setq org-download--file-content "/tmp/org-download.pdf")) 498 t)) 499 (t 500 (error "Link %s does not point to an image; unaliasing failed" link))) 501 (list link ext)))) 502 503 (defun org-download--parse-link (link) 504 (cond ((image-type-from-file-name link) 505 (list link nil)) 506 ((string-match "^file:/+" link) 507 (list link nil)) 508 (t 509 (let ((buffer (url-retrieve-synchronously link t))) 510 (org-download--detect-ext link buffer))))) 511 512 (defun org-download-image (link) 513 "Save image at address LINK to `org-download--dir'." 514 (interactive "sUrl: ") 515 (let* ((link-and-ext (org-download--parse-link link)) 516 (filename 517 (cond ((and (derived-mode-p 'org-mode) 518 (eq org-download-method 'attach)) 519 (let ((org-download-image-dir (org-attach-dir t)) 520 org-download-heading-lvl) 521 (apply #'org-download--fullname link-and-ext))) 522 ((fboundp org-download-method) 523 (funcall org-download-method link)) 524 (t 525 (apply #'org-download--fullname link-and-ext))))) 526 (setq org-download-path-last-file filename) 527 (org-download--image link filename) 528 (when (org-download-org-mode-p) 529 (when (eq org-download-method 'attach) 530 (org-attach-attach filename nil 'none)) 531 (org-download-insert-link link filename)) 532 (when (and (eq org-download-delete-image-after-download t) 533 (not (url-handler-file-remote-p (current-kill 0)))) 534 (delete-file link delete-by-moving-to-trash)))) 535 536 (defun org-download-rename-at-point () 537 "Rename image at point." 538 (interactive) 539 (let* ((dir-path (org-download--dir)) 540 (current-name (file-name-nondirectory 541 (org-element-property :path (org-element-context)))) 542 (current-path (concat dir-path "/" current-name)) 543 (ext (file-name-extension current-name)) 544 (new-name (read-string "Rename file at point to: " (file-name-sans-extension current-name))) 545 (new-path (concat dir-path "/" new-name "." ext))) 546 (rename-file current-path new-path) 547 (message "File successfully renamed...") 548 (org-download-replace-all current-name (concat new-name "." ext)))) 549 550 (defun org-download-rename-last-file () 551 "Rename the last downloaded file saved in your computer." 552 (interactive) 553 (let* ((dir-path (org-download--dir)) 554 (newname (read-string "Rename last file to: " (file-name-base org-download-path-last-file))) 555 (ext (file-name-extension org-download-path-last-file)) 556 (newpath (concat dir-path "/" newname "." ext))) 557 (when org-download-path-last-file 558 (rename-file org-download-path-last-file newpath 1) 559 (org-download-replace-all 560 (file-name-nondirectory org-download-path-last-file) 561 (concat newname "." ext)) 562 (setq org-download-path-last-file newpath) 563 (org-download--display-inline-images)))) 564 565 (defun org-download-replace-all (oldpath newpath) 566 "Search for OLDPATH inside the buffer and replace it by NEWPATH." 567 (save-excursion 568 (goto-char (point-min)) 569 (while (re-search-forward oldpath nil t) 570 (replace-match newpath)))) 571 572 (defun org-download-insert-link (link filename) 573 (let* ((beg (point)) 574 (line-beg (line-beginning-position)) 575 (indent (- beg line-beg)) 576 (in-item-p (org-in-item-p)) 577 str) 578 (if (looking-back "^[ \t]+" line-beg) 579 (delete-region (match-beginning 0) (match-end 0)) 580 (newline)) 581 (insert (funcall org-download-annotate-function link)) 582 (dolist (attr org-download-image-attr-list) 583 (insert attr "\n")) 584 (insert (if (= org-download-image-html-width 0) 585 "" 586 (format "#+attr_html: :width %dpx\n" org-download-image-html-width))) 587 (insert (if (= org-download-image-latex-width 0) 588 "" 589 (format "#+attr_latex: :width %dcm\n" org-download-image-latex-width))) 590 (insert (if (= org-download-image-org-width 0) 591 "" 592 (format "#+attr_org: :width %dpx\n" org-download-image-org-width))) 593 (insert (funcall org-download-link-format-function filename)) 594 (org-download--display-inline-images) 595 (setq str (buffer-substring-no-properties line-beg (point))) 596 (when in-item-p 597 (indent-region line-beg (point) indent)) 598 str)) 599 600 (defun org-download--at-comment-p () 601 "Check if current line begins with #+DOWLOADED:." 602 (save-excursion 603 (move-beginning-of-line nil) 604 (looking-at "#\\+DOWNLOADED:"))) 605 606 (defvar org-link-any-re) 607 608 (defun org-download-delete () 609 "Delete inline image link on current line, and the file that it points to." 610 (interactive) 611 (cond ((org-download--at-comment-p) 612 (delete-region (line-beginning-position) 613 (line-end-position)) 614 (org-download--delete (line-beginning-position) 615 nil 616 1)) 617 ((region-active-p) 618 (org-download--delete (region-beginning) 619 (region-end)) 620 (delete-region (region-beginning) 621 (region-end))) 622 623 ((looking-at org-link-any-re) 624 (let ((fname (org-link-unescape 625 (match-string-no-properties 2)))) 626 (when (file-exists-p fname) 627 (delete-file fname) 628 (delete-region (match-beginning 0) 629 (match-end 0)) 630 (when (eolp) 631 (delete-char 1))))) 632 633 (t (org-download--delete (line-beginning-position) 634 (line-end-position)))) 635 (when (eq org-download-method 'attach) 636 (org-attach-sync))) 637 638 (defcustom org-download-edit-cmd "gimp %s" 639 "Command for editing an image link." 640 :type 'string) 641 642 (defun org-download-edit () 643 "Open the image at point for editing." 644 (interactive) 645 (let ((context (org-element-context))) 646 (if (not (eq (car-safe context) 'link)) 647 (user-error "Not on a link") 648 (start-process-shell-command 649 "org-download-edit" 650 "org-download-edit" 651 (format org-download-edit-cmd 652 (shell-quote-wildcard-pattern 653 (url-unhex-string (plist-get (cadr context) :path)))))))) 654 655 (defun org-download--delete (beg end &optional times) 656 "Delete inline image links and the files they point to between BEG and END. 657 658 When TIMES isn't nil, delete only TIMES links." 659 (unless times 660 (setq times most-positive-fixnum)) 661 (save-excursion 662 (goto-char beg) 663 (while (and (>= (cl-decf times) 0) 664 (and (string-match "\\[\\[\\(\\w+\\)" org-download-link-format) 665 (let ((link-name (match-string 1 org-download-link-format))) 666 (re-search-forward (format "\\[\\[%s:\\([^]]*\\)\\]\\]" link-name) end t)))) 667 (let ((str (match-string-no-properties 1))) 668 (delete-region beg 669 (match-end 0)) 670 (when (file-exists-p str) 671 (delete-file str)))))) 672 673 (defun org-download-dnd-fallback (uri action) 674 (let ((dnd-protocol-alist 675 (rassq-delete-all 676 'org-download-dnd 677 (copy-alist dnd-protocol-alist)))) 678 (dnd-handle-one-url nil action uri))) 679 680 (defun org-download-dnd (uri action) 681 "When in `org-mode' and URI points to image, download it. 682 Otherwise, pass URI and ACTION back to dnd dispatch." 683 (cond ((org-download-org-mode-p) 684 (condition-case nil 685 (org-download-image uri) 686 (error 687 (org-download-dnd-fallback uri action)))) 688 ((eq major-mode 'dired-mode) 689 (org-download-dired uri)) 690 ;; redirect to someone else 691 (t 692 (org-download-dnd-fallback uri action)))) 693 694 (defun org-download-dired (uri) 695 "Download URI to current directory." 696 (raise-frame) 697 (org-download-image uri)) 698 699 (defun org-download-dnd-base64 (uri _action) 700 (when (org-download-org-mode-p) 701 (when (string-match "^data:image/png;base64," uri) 702 (let* ((me (match-end 0)) 703 (filename (org-download--fullname 704 (substring-no-properties uri me (+ me 10)) 705 "png"))) 706 (with-temp-buffer 707 (insert (base64-decode-string (substring uri me))) 708 (write-file filename)) 709 (org-download-insert-link filename filename))))) 710 711 ;;;###autoload 712 (defun org-download-enable () 713 "Enable org-download." 714 (unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\):" dnd-protocol-alist)) 715 'org-download-dnd) 716 (setq dnd-protocol-alist 717 `(("^\\(https?\\|ftp\\|file\\|nfs\\):" . org-download-dnd) 718 ("^data:" . org-download-dnd-base64) 719 ,@dnd-protocol-alist)))) 720 721 (defun org-download-disable () 722 "Disable org-download." 723 (rassq-delete-all 'org-download-dnd dnd-protocol-alist)) 724 725 (org-download-enable) 726 727 (provide 'org-download) 728 729 ;;; org-download.el ends here