| 
					
				 | 
			
			
				@@ -1,9 +1,9 @@ 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;;; 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 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-;; Version: 0.0 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+;; Version: 0.1 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; Keywords: org, media 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; This file is not part of GNU Emacs. 
			 | 
		
	
	
		
			
				| 
					
				 | 
			
			
				@@ -24,16 +24,25 @@ 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;;; Commentary: 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; There are occasions when images are displayed in a subtree which 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-;; are not (yet) org attachments.  For example if you copy and paste a 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-;; part of a web page (containing images) from eww to an org subtree. 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+;; 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. 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-;; 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) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+;; to your emacs configuration. 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+ 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; Use 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;;     M-x org-attach-embedded-images-in-subtree 
			 | 
		
	
	
		
			
				| 
					
				 | 
			
			
				@@ -43,9 +52,9 @@ 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; 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: 
			 | 
		
	
	
		
			
				| 
					
				 | 
			
			
				@@ -74,15 +83,15 @@ POSITION and LIMIT as in `next-single-property-change'." 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 Return the filename." 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				   (let* ((extension (symbol-name (image-type-from-data data))) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				          (basename (concat (sha1 data) "." extension)) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-         (org-attach-filename 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-          (concat (org-attach-dir t) "/" basename))) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-    (unless (file-exists-p org-attach-filename) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-      (with-temp-file org-attach-filename 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+	 (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) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-    org-attach-filename)) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+    basename)) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				  
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 ;; Command 
			 | 
		
	
	
		
			
				| 
					
				 | 
			
			
				@@ -91,28 +100,29 @@ Return the filename." 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				 (defun org-attach-embedded-images-in-subtree () 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				   "Save the displayed images as attachments and insert links to them." 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				   (interactive) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-  (if (org-before-first-heading-p) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-      (message "Before first heading.  Nothing has been attached.") 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-    (save-excursion 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-      (let ((beg (progn (org-back-to-heading) (point))) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-            (end (progn (org-end-of-subtree) (point))) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-	    (names nil)) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				-	;; 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[[" (pop names) "]]"))))))) 
			 | 
		
	
		
			
				 | 
				 | 
			
			
				+  (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) 
			 |