org-attach-embedded-images.el 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. ;;; org-attach-embedded-images.el --- Transmute images to attachments
  2. ;;
  3. ;; Copyright 2018, 2019 Free Software Foundation, Inc.
  4. ;;
  5. ;; Author: Marco Wahl
  6. ;; Version: 0.1
  7. ;; Keywords: org, media
  8. ;;
  9. ;; This file is not part of GNU Emacs.
  10. ;;
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 3, or (at your option)
  14. ;; any later version.
  15. ;;
  16. ;; This program is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;; GNU General Public License for more details.
  20. ;;
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  23. ;;; Commentary:
  24. ;;
  25. ;; There are occasions when images are displayed in a subtree which
  26. ;; are not org attachments. For example if you copy and paste a part
  27. ;; of a web page (containing images) from eww to an org subtree.
  28. ;; This module provides command `org-attach-embedded-images-in-subtree'
  29. ;; to save such images as attachments and insert org links to them.
  30. ;; Install:
  31. ;; To use this module insert it to `org-modules'. The insert can be
  32. ;; performed via {M-x customize-variable RET org-modules RET} followed
  33. ;; by insertion of `org-attach-embedded-images' to the external
  34. ;; modules section.
  35. ;; Alternatively you can add the line
  36. ;; (require 'org-attach-embedded-images)
  37. ;; to your emacs configuration.
  38. ;; Use
  39. ;; M-x org-attach-embedded-images-in-subtree
  40. ;; in a subtree with embedded images. The images get attached and can
  41. ;; later be reviewed.
  42. ;; Note: Possibly
  43. ;; M-x org-toggle-inline-images
  44. ;; is needed to see the images in the Org mode window.
  45. ;; Code:
  46. (require 'org)
  47. (require 'org-attach)
  48. ;; Auxiliary functions
  49. (defun org-attach-embedded-images--next-property-display-data (position limit)
  50. "Return position of the next property-display location with image data.
  51. Return nil if there is no next display property.
  52. POSITION and LIMIT as in `next-single-property-change'."
  53. (let ((pos (next-single-property-change position 'display nil limit)))
  54. (while (and (< pos limit)
  55. (let ((display-prop
  56. (plist-get (text-properties-at pos) 'display)))
  57. (or (not display-prop)
  58. (not (plist-get (cdr display-prop) :data)))))
  59. (setq pos (next-single-property-change pos 'display nil limit)))
  60. pos))
  61. (defun org-attach-embedded-images--attach-with-sha1-name (data)
  62. "Save the image given as DATA as org attachment with its sha1 as name.
  63. Return the filename."
  64. (let* ((extension (symbol-name (image-type-from-data data)))
  65. (basename (concat (sha1 data) "." extension))
  66. (dir (org-attach-dir t))
  67. (filename (concat dir "/" basename)))
  68. (unless (file-exists-p filename)
  69. (with-temp-file filename
  70. (setq buffer-file-coding-system 'binary)
  71. (set-buffer-multibyte nil)
  72. (insert data)))
  73. (org-attach-sync)
  74. basename))
  75. ;; Command
  76. ;;;###autoload
  77. (defun org-attach-embedded-images-in-subtree ()
  78. "Save the displayed images as attachments and insert links to them."
  79. (interactive)
  80. (when (org-before-first-heading-p)
  81. (user-error "Before first heading. Nothing has been attached."))
  82. (save-excursion
  83. (org-attach-dir t)
  84. (let ((beg (progn (org-back-to-heading) (point)))
  85. (end (progn (org-end-of-subtree) (point)))
  86. names)
  87. ;; pass 1
  88. (goto-char beg)
  89. (while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end)
  90. (let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data)))
  91. (assert data)
  92. (push (org-attach-embedded-images--attach-with-sha1-name data)
  93. names)))
  94. ;; pass 2
  95. (setq names (nreverse names))
  96. (goto-char beg)
  97. (while names
  98. (goto-char (org-attach-embedded-images--next-property-display-data (point) end))
  99. (while (get-text-property (point) 'display)
  100. (goto-char (next-property-change (point) nil end)))
  101. (skip-chars-forward "]")
  102. (insert (concat "\n[[attachment:" (pop names) "]]"))))))
  103. (provide 'org-attach-embedded-images)
  104. ;;; org-attach-embedded-images.el ends here