org-mode/contrib/lisp/org-attach-embedded-images.el

132 lines
4.2 KiB
EmacsLisp
Raw Normal View History

;;; org-attach-embedded-images.el --- Transmute images to attachments
;;
;; Copyright 2018, 2019 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/>.
;;; 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.
;; Code:
(require 'org)
(require 'org-attach)
;; 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))
;; 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) "]]"))))))
(provide 'org-attach-embedded-images)
;;; org-attach-embedded-images.el ends here