1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| | ;;; org-attach-embedded-images.el --- Transmute images to attachments
;;
;; Copyright 2018-2021 Free Software Foundation, Inc.
;;
;; Author: Marco Wahl
;; Version: 0.1
;; Keywords: org, media
;;
;; This file is not part of GNU Emacs.
;;
;; This program 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, or (at your option)
;; any later version.
;;
;; This program 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/>.
\f
;;; Commentary:
;;
;; There are occasions when images are displayed in a subtree which
;; are not org attachments. For example if you copy and paste a part
;; of a web page (containing images) from eww to an org subtree.
;; This module provides command `org-attach-embedded-images-in-subtree'
;; to save such images as attachments and insert org links to them.
;; 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)
;; to your emacs configuration.
;; Use
;; M-x org-attach-embedded-images-in-subtree
;; in a subtree with embedded images. The images get attached and can
;; later be reviewed.
;; Note: Possibly
;; M-x org-toggle-inline-images
;; is needed to see the images in the Org mode window.
\f
;; Code:
(require 'org)
(require 'org-attach)
\f
;; Auxiliary functions
(defun org-attach-embedded-images--next-property-display-data (position limit)
"Return position of the next property-display location with image data.
Return nil if there is no next display property.
POSITION and LIMIT as in `next-single-property-change'."
(let ((pos (next-single-property-change position 'display nil limit)))
(while (and (< pos limit)
(let ((display-prop
(plist-get (text-properties-at pos) 'display)))
(or (not display-prop)
(not (plist-get (cdr display-prop) :data)))))
(setq pos (next-single-property-change pos 'display nil limit)))
pos))
(defun org-attach-embedded-images--attach-with-sha1-name (data)
"Save the image given as DATA as org attachment with its sha1 as name.
Return the filename."
(let* ((extension (symbol-name (image-type-from-data data)))
(basename (concat (sha1 data) "." extension))
(dir (org-attach-dir t))
(filename (concat dir "/" basename)))
(unless (file-exists-p filename)
(with-temp-file filename
(setq buffer-file-coding-system 'binary)
(set-buffer-multibyte nil)
(insert data)))
(org-attach-sync)
basename))
\f
;; Command
;;;###autoload
(defun org-attach-embedded-images-in-subtree ()
"Save the displayed images as attachments and insert links to them."
(interactive)
(when (org-before-first-heading-p)
(user-error "Before first heading. Nothing has been attached."))
(save-excursion
(org-attach-dir t)
(let ((beg (progn (org-back-to-heading) (point)))
(end (progn (org-end-of-subtree) (point)))
names)
;; pass 1
(goto-char beg)
(while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end)
(let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data)))
(assert data)
(push (org-attach-embedded-images--attach-with-sha1-name data)
names)))
;; pass 2
(setq names (nreverse names))
(goto-char beg)
(while names
(goto-char (org-attach-embedded-images--next-property-display-data (point) end))
(while (get-text-property (point) 'display)
(goto-char (next-property-change (point) nil end)))
(skip-chars-forward "]")
(insert (concat "\n[[attachment:" (pop names) "]]"))))))
\f
(provide 'org-attach-embedded-images)
\f
;;; org-attach-embedded-images.el ends here
|