org-attach-embedded-images.el 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. ;;; org-attach-embedded-images.el --- Transmute images to attachments
  2. ;;
  3. ;; Copyright 2018 Free Software Foundation, Inc.
  4. ;;
  5. ;; Author: Marco Wahl
  6. ;; Version: 0.0
  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 (yet) org attachments. For example if you copy and paste a
  27. ;; part 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. ;; To use you might put the following in your .emacs:
  31. ;; (require 'org-attach-embedded-images)
  32. ;; Use
  33. ;; M-x org-attach-embedded-images-in-subtree
  34. ;; in a subtree with embedded images. The images get attached and can
  35. ;; later be reviewed.
  36. ;; Note: Possibly
  37. ;; M-x org-toggle-inline-images is needed to see inline
  38. ;; images in Org mode.
  39. ;; Code:
  40. (require 'org)
  41. (require 'org-attach)
  42. ;; Auxiliary functions
  43. (defun org-attach-embedded-images--next-property-display-data (position limit)
  44. "Return position of the next property-display location with image data.
  45. Return nil if there is no next display property.
  46. POSITION and LIMIT as in `next-single-property-change'."
  47. (let ((pos (next-single-property-change position 'display nil limit)))
  48. (while (and (< pos limit)
  49. (let ((display-prop
  50. (plist-get (text-properties-at pos) 'display)))
  51. (or (not display-prop)
  52. (not (plist-get (cdr display-prop) :data)))))
  53. (setq pos (next-single-property-change pos 'display nil limit)))
  54. pos))
  55. (defun org-attach-embedded-images--attach-with-sha1-name (data)
  56. "Save the image given as DATA as org attachment with its sha1 as name.
  57. Return the filename."
  58. (let* ((extension (symbol-name (image-type-from-data data)))
  59. (basename (concat (sha1 data) "." extension))
  60. (org-attach-filename
  61. (concat (org-attach-dir t) "/" basename)))
  62. (unless (file-exists-p org-attach-filename)
  63. (with-temp-file org-attach-filename
  64. (setq buffer-file-coding-system 'binary)
  65. (set-buffer-multibyte nil)
  66. (insert data)))
  67. (org-attach-sync)
  68. org-attach-filename))
  69. ;; Command
  70. ;;;###autoload
  71. (defun org-attach-embedded-images-in-subtree ()
  72. "Save the displayed images as attachments and insert links to them."
  73. (interactive)
  74. (if (org-before-first-heading-p)
  75. (message "Before first heading. Nothing has been attached.")
  76. (save-excursion
  77. (let ((beg (progn (org-back-to-heading) (point)))
  78. (end (progn (org-end-of-subtree) (point)))
  79. (names nil))
  80. ;; pass 1
  81. (goto-char beg)
  82. (while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end)
  83. (let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data)))
  84. (assert data)
  85. (push (org-attach-embedded-images--attach-with-sha1-name data)
  86. names)))
  87. ;; pass 2
  88. (setq names (nreverse names))
  89. (goto-char beg)
  90. (while names
  91. (goto-char (org-attach-embedded-images--next-property-display-data (point) end))
  92. (while (get-text-property (point) 'display)
  93. (goto-char (next-property-change (point) nil end)))
  94. (skip-chars-forward "]")
  95. (insert (concat "\n[[" (pop names) "]]")))))))
  96. (provide 'org-attach-embedded-images)
  97. ;;; org-attach-embedded-images.el ends here