Bladeren bron

org-mime: now exports subtrees, and can read mail headers from subtree properties

  Much of this code is reworking of a very nice function shared on the
  mailing list by Matt Lundin.

* contrib/lisp/org-mime.el (org-mime-htmlize): Fixed indentation.
  (org-mime-try): Short macro for safely checking for properties.
  (org-mime-send-subtree): Drops the current subtree into a mail
  buffer possible exported and mime-encoded.
  (org-mime-send-buffer): Drops the current buffer into a mail
  buffer possible exported and mime-encoded.
  (org-mime-compose): Exports and mime-encodes a string of org-mode
  text for sending via email.
  (org-mime-org-buffer-htmlize): Create an email buffer containing the
  current org-mode file exported to html and encoded in both html and
  in org formats as mime alternatives.
  (org-mime-subtree): Create an email buffer containing the current
  org-mode subtree exported to a org format or to the format specified
  by the MAIL_FMT property of the subtree.
Eric Schulte 14 jaren geleden
bovenliggende
commit
96c70f3d7e
1 gewijzigde bestanden met toevoegingen van 72 en 31 verwijderingen
  1. 72 31
      contrib/lisp/org-mime.el

+ 72 - 31
contrib/lisp/org-mime.el

@@ -174,7 +174,8 @@ export that region, otherwise export the entire body."
                        ;; TODO: should catch signature...
                        (point-max)))
          (raw-body (buffer-substring html-start html-end))
-         (tmp-file (make-temp-name (expand-file-name "mail" temporary-file-directory)))
+         (tmp-file (make-temp-name (expand-file-name
+				    "mail" temporary-file-directory)))
          (body (org-export-string raw-body 'org (file-name-directory tmp-file)))
          ;; because we probably don't want to skip part of our mail
          (org-export-skip-text-before-1st-heading nil)
@@ -207,37 +208,77 @@ export that region, otherwise export the entire body."
         (buffer-string))
     html))
 
-(defun org-mime-org-buffer-htmlize ()
-  "Export the current org-mode buffer to HTML using
-`org-export-as-html' and package the results into an email
-handling with appropriate MIME encoding."
-  (interactive)
-  (require 'reporter)
+(defmacro org-mime-try (&rest body)
+  `(condition-case nil ,@body (error nil)))
+
+(defun org-mime-send-subtree (&optional fmt)
+  (save-restriction
+    (org-narrow-to-subtree)
+    (let* ((file (buffer-file-name (current-buffer)))
+	   (subject (nth 4 (org-heading-components)))
+	   (to (org-entry-get nil "MAIL_TO"))
+	   (cc (org-entry-get nil "MAIL_CC"))
+	   (bcc (org-entry-get nil "MAIL_BCC"))
+	   (body (buffer-substring
+		  (save-excursion (goto-char (point-min))
+				  (forward-line 1)
+				  (when (looking-at "[ \t]*:PROPERTIES:")
+				    (re-search-forward ":END:" nil)
+				    (forward-char))
+				  (point))
+		  (point-max))))
+      (org-mime-compose body (or fmt 'org) file to subject
+			`((cc . ,cc) (bcc . ,bcc))))))
+
+(defun org-mime-send-buffer (&optional fmt)
   (let* ((region-p (org-region-active-p))
-         (current-file (buffer-file-name (current-buffer)))
-	 (title (org-export-grab-title-from-buffer))
-         (html-start (or (and region-p (region-beginning))
-                         (save-excursion
-                           (goto-char (point-min)))))
-         (html-end (or (and region-p (region-end))
-                       (point-max)))
+	 (subject (org-export-grab-title-from-buffer))
+         (file (buffer-file-name (current-buffer)))
+         (body-start (or (and region-p (region-beginning))
+                         (save-excursion (goto-char (point-min)))))
+         (body-end (or (and region-p (region-end)) (point-max)))
 	 (temp-body-file (make-temp-file "org-mime-export"))
-	 (raw-body (buffer-substring html-start html-end))
-         (body (org-export-string raw-body 'org))
-         (org-link-file-path-type 'absolute)
-         ;; because we probably don't want to export a huge style file
-         (org-export-htmlize-output-type 'inline-css)
-         ;; to hold attachments for inline html images
-         (html-and-images (org-mime-replace-images
-                           (org-export-as-html nil nil nil 'string t)
-                           current-file))
-         (html-images (cdr html-and-images))
-         (html (org-mime-apply-html-hook (car html-and-images))))
-    ;; dump the exported html into a fresh message buffer
-    (message-mail nil title)
-    (message-goto-body)
-    (prog1 (insert (org-mime-multipart body html)
-		   (mapconcat 'identity html-images "\n"))
-      (delete-file temp-body-file))))
+	 (body (buffer-substring body-start body-end)))
+    (org-mime-compose body (or fmt 'org) file nil subject)))
+
+(defun org-mime-compose (body fmt file &optional to subject headers)
+  (require 'message)
+  (message-mail to subject headers nil)
+  (message-goto-body)
+  (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
+    (cond
+     ((eq fmt 'org)
+      (insert (org-export-string (org-babel-trim body) 'org)))
+     ((eq fmt 'ascii)
+      (insert (org-export-string (concat "#+Title:\n" body) 'ascii)))
+     ((or (eq fmt 'html) (eq fmt 'html-ascii))
+      (let* ((org-link-file-path-type 'absolute)
+	     ;; we probably don't want to export a huge style file
+	     (org-export-htmlize-output-type 'inline-css)
+	     (html-and-images (org-mime-replace-images
+			       (org-export-string
+				body 'html (file-name-nondirectory file))
+			       file))
+	     (images (cdr html-and-images))
+	     (html (org-mime-apply-html-hook (car html-and-images))))
+	(insert (org-mime-multipart
+		 (org-export-string
+		  (org-babel-trim body) (if (eq fmt 'html) 'org 'ascii))
+		 html)
+		(mapconcat 'identity images "\n")))))))
+
+(defun org-mime-org-buffer-htmlize ()
+  "Create an email buffer containing the current org-mode file
+  exported to html and encoded in both html and in org formats as
+  mime alternatives."
+  (interactive)
+  (org-mime-send-buffer 'html))
+
+(defun org-mime-subtree ()
+  "Create an email buffer containing the current org-mode subtree
+  exported to a org format or to the format specified by the
+  MAIL_FMT property of the subtree."
+  (interactive)
+  (org-mime-send-subtree (or (org-entry-get nil "MAIL_FMT") 'org)))
 
 (provide 'org-mime)