ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

contrib/org-attach-embedded-images: switch to attachment type links

This commit is contained in:
Marco Wahl 2019-07-09 19:52:19 +02:00
parent 1ff9cab0a3
commit 4e6222f188
1 changed files with 44 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
contrib/lisp/org-attach-embedded-images.el
View File

@ -1,9 +1,9 @@
;;; org-attach-embedded-images.el --- Transmute images to attachments ;;; org-attach-embedded-images.el --- Transmute images to attachments
;; ;;
;; Copyright 2018 Free Software Foundation, Inc. ;; Copyright 2018, 2019 Free Software Foundation, Inc.
;; ;;
;; Author: Marco Wahl ;; Author: Marco Wahl
;; Version: 0.0 ;; Version: 0.1
;; Keywords: org, media ;; Keywords: org, media
;; ;;
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
@ -24,16 +24,25 @@
;;; Commentary: ;;; Commentary:
;; ;;
;; There are occasions when images are displayed in a subtree which ;; There are occasions when images are displayed in a subtree which
;; are not (yet) org attachments. For example if you copy and paste a ;; are not org attachments. For example if you copy and paste a part
;; part of a web page (containing images) from eww to an org subtree. ;; of a web page (containing images) from eww to an org subtree.
;; This module provides command `org-attach-embedded-images-in-subtree' ;; This module provides command `org-attach-embedded-images-in-subtree'
;; to save such images as attachments and insert org links to them. ;; to save such images as attachments and insert org links to them.
;; To use you might put the following in your .emacs: ;; Install:
;; To use this module insert it to `org-modules'. The insert can be
;; performed via {M-x customize-variable RET org-modules RET} followed
;; by insertion of `org-attach-embedded-images' to the external
;; modules section.
;; Alternatively you can add the line
;; (require 'org-attach-embedded-images) ;; (require 'org-attach-embedded-images)
;; to your emacs configuration.
;; Use ;; Use
;; M-x org-attach-embedded-images-in-subtree ;; M-x org-attach-embedded-images-in-subtree
@ -43,9 +52,9 @@
;; Note: Possibly ;; Note: Possibly
;; M-x org-toggle-inline-images is needed to see inline ;; M-x org-toggle-inline-images
;; images in Org mode. ;; is needed to see the images in the Org mode window.
;; Code: ;; Code:
@ -74,15 +83,15 @@ POSITION and LIMIT as in `next-single-property-change'."
Return the filename." Return the filename."
(let* ((extension (symbol-name (image-type-from-data data))) (let* ((extension (symbol-name (image-type-from-data data)))
(basename (concat (sha1 data) "." extension)) (basename (concat (sha1 data) "." extension))
(org-attach-filename (dir (org-attach-dir t))
(concat (org-attach-dir t) "/" basename))) (filename (concat dir "/" basename)))
(unless (file-exists-p org-attach-filename) (unless (file-exists-p filename)
(with-temp-file org-attach-filename (with-temp-file filename
(setq buffer-file-coding-system 'binary) (setq buffer-file-coding-system 'binary)
(set-buffer-multibyte nil) (set-buffer-multibyte nil)
(insert data))) (insert data)))
(org-attach-sync) (org-attach-sync)
org-attach-filename)) basename))
;; Command ;; Command
@ -91,28 +100,29 @@ Return the filename."
(defun org-attach-embedded-images-in-subtree () (defun org-attach-embedded-images-in-subtree ()
"Save the displayed images as attachments and insert links to them." "Save the displayed images as attachments and insert links to them."
(interactive) (interactive)
(if (org-before-first-heading-p) (when (org-before-first-heading-p)
(message "Before first heading. Nothing has been attached.") (user-error "Before first heading. Nothing has been attached."))
(save-excursion (save-excursion
(let ((beg (progn (org-back-to-heading) (point))) (org-attach-dir t)
(end (progn (org-end-of-subtree) (point))) (let ((beg (progn (org-back-to-heading) (point)))
(names nil)) (end (progn (org-end-of-subtree) (point)))
;; pass 1 names)
(goto-char beg) ;; pass 1
(while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end) (goto-char beg)
(let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data))) (while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end)
(assert data) (let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data)))
(push (org-attach-embedded-images--attach-with-sha1-name data) (assert data)
names))) (push (org-attach-embedded-images--attach-with-sha1-name data)
;; pass 2 names)))
(setq names (nreverse names)) ;; pass 2
(goto-char beg) (setq names (nreverse names))
(while names (goto-char beg)
(goto-char (org-attach-embedded-images--next-property-display-data (point) end)) (while names
(while (get-text-property (point) 'display) (goto-char (org-attach-embedded-images--next-property-display-data (point) end))
(goto-char (next-property-change (point) nil end))) (while (get-text-property (point) 'display)
(skip-chars-forward "]") (goto-char (next-property-change (point) nil end)))
(insert (concat "\n[[" (pop names) "]]"))))))) (skip-chars-forward "]")
(insert (concat "\n[[attachment:" (pop names) "]]"))))))
(provide 'org-attach-embedded-images) (provide 'org-attach-embedded-images)