[PATCH] org-mime supports emacs24

[Chen Bin <chenbin.sh@gmail.com>]

Hi,
I got one patch to make org-mime.el usable at Emacs24. I also clean out
the obsolete code to make it not dependent on ascii and org export
backend any more.


From a3ea36c0416c0debe831b98dc360a775a2bd1a73 Mon Sep 17 00:00:00 2001
From: Chen Bin <chenbin.sh@gmail.com>
Date: Sun, 21 Aug 2016 10:16:27 +1000
Subject: [PATCH 1/1] org-mime supports emacs24

- supports Emacs 24 (tested 24.3, 24.4, 24.5)
- clean code
- exported html contains no TOC by default
---
 contrib/lisp/org-mime.el | 203 +++++++++++++++++------------------------------
 1 file changed, 74 insertions(+), 129 deletions(-)

diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
index 2ced42e..46f0468 100644
--- a/contrib/lisp/org-mime.el
+++ b/contrib/lisp/org-mime.el
@@ -3,9 +3,10 @@
 ;; Copyright (C) 2010-2015 Eric Schulte
 
 ;; Author: Eric Schulte
+;; Maintainer: Chen Bin (redguardtoo)
 ;; Keywords: mime, mail, email, html
-;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php
-;; Version: 0.01
+;; Homepage: http://github.com/redguardtoo/org-mime
+;; Version: 0.0.3
 
 ;; This file is not part of GNU Emacs.
 
@@ -39,33 +40,32 @@
 ;; package the results into an email handling with appropriate MIME
 ;; encoding.
 ;;
+;; Quick start:
+;; Write mail in message-mode, make sure the mail body follows org format.
+;; Before sending mail, `M-x org-mime-htmlize'
+;;
+;; Setup (OPTIONAL):
 ;; you might want to bind this to a key with something like the
 ;; following message-mode binding
 ;;
 ;;   (add-hook 'message-mode-hook
 ;;             (lambda ()
-;;               (local-set-key "\C-c\M-o" 'org-mime-htmlize)))
+;;               (local-set-key (kbd "C-c M-o") 'org-mime-htmlize)))
 ;;
 ;; and the following org-mode binding
 ;;
 ;;   (add-hook 'org-mode-hook
 ;;             (lambda ()
-;;               (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize)))
+;;               (local-set-key (kbd "C-c M-o") 'org-mime-org-buffer-htmlize)))
 
 ;;; Code:
-(require 'cl)
-
-(declare-function org-export-string-as "ox"
-		  (string backend &optional body-only ext-plist))
-(declare-function org-trim "org" (s &optional keep-lead))
+(eval-when-compile
+  (require 'cl))
 
-(defcustom org-mime-use-property-inheritance nil
-  "Non-nil means al MAIL_ properties apply also for sublevels."
-  :group 'org-mime
-  :type 'boolean)
+(require 'org)
 
 (defcustom org-mime-default-header
-  "#+OPTIONS: latex:t\n"
+  "#+OPTIONS: latex:t toc:nil H:3\n"
   "Default header to control html export options, and ensure
   first line isn't assumed to be a title line."
   :group 'org-mime
@@ -88,31 +88,29 @@
   :group 'org-mime
   :type 'string)
 
-(defcustom org-mime-html-hook nil
+(defvar org-mime-html-hook nil
   "Hook to run over the html buffer before attachment to email.
-  This could be used for example to post-process html elements."
-  :group 'org-mime
-  :type 'hook)
-
-(mapc (lambda (fmt)
-	(eval `(defcustom
-		 ,(intern (concat "org-mime-pre-" fmt "-hook"))
-		 nil
-		 (concat "Hook to run before " fmt " export.\nFunctions "
-			 "should take no arguments and will be run in a "
-			 "buffer holding\nthe text to be exported."))))
-      '("ascii" "org" "html"))
+This could be used for example to post-process html elements.")
 
-(defcustom org-mime-send-subtree-hook nil
-  "Hook to run in the subtree in the Org-mode file before export.")
+(defvar org-mime-pre-html-hook nil
+  "Hook to run before html export.
+Functions should take no arguments and will be run in a
+buffer holding\nthe text to be exported.")
 
-(defcustom org-mime-send-buffer-hook nil
+(defvar org-mime-send-buffer-hook nil
   "Hook to run in the Org-mode file before export.")
 
+(defun org-mime--export-string (s)
+  (if (fboundp 'org-export-string-as)
+      ;; emacs24
+      (org-export-string-as s 'html t)
+    ;; emacs 23
+    (org-export-string s "html")))
+
 ;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
 (defun org-mime-change-element-style (element style)
   "Set new default htlm style for <ELEMENT> elements in exported html."
-  (while (re-search-forward (format "<%s\\>" element) nil t)
+  (while (re-search-forward (format "<%s" element) nil t)
     (replace-match (format "<%s style=\"%s\"" element style))))
 
 (defun org-mime-change-class-style (class style)
@@ -164,17 +162,14 @@ and images in a multipart/related part."
     ('semi (concat
             "--" "<<alternative>>-{\n"
             "--" "[[text/plain]]\n" plain
-	    (if (and images (> (length images) 0))
-		(concat "--" "<<related>>-{\n"
-			"--" "[[text/html]]\n"  html
-			images
-			"--" "}-<<related>>\n")
-	      (concat "--" "[[text/html]]\n"  html
-		      images))
+	    (when images (concat "--" "<<alternative>>-{\n"))
+            "--" "[[text/html]]\n"  html
+	    images
+	    (when images (concat "--" "}-<<alternative>>\n"))
             "--" "}-<<alternative>>\n"))
     ('vm "?")))
 
-(defun org-mime-replace-images (str)
+(defun org-mime-replace-images (str current-file)
   "Replace images in html files with cid links."
   (let (html-images)
     (cons
@@ -186,7 +181,7 @@ and images in a multipart/related part."
          (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text)
                           (match-string 1 text)))
                 (path (expand-file-name
-                       url temporary-file-directory))
+                       url (file-name-directory current-file)))
                 (ext (file-name-extension path))
                 (id (replace-regexp-in-string "[\/\\\\]" "_" path)))
            (add-to-list 'html-images
@@ -195,13 +190,11 @@ and images in a multipart/related part."
       str)
      html-images)))
 
-(defun org-mime-htmlize (&optional arg)
-  "Export to HTML an email body composed using `mml-mode'.
-If called with an active region only export that region,
-otherwise export the entire body."
+(defun org-mime-htmlize (arg)
+  "Export a portion of an email body composed using `mml-mode' to
+html using `org-mode'.  If called with an active region only
+export that region, otherwise export the entire body."
   (interactive "P")
-  (require 'ox-org)
-  (require 'ox-html)
   (let* ((region-p (org-region-active-p))
          (html-start (or (and region-p (region-beginning))
                          (save-excursion
@@ -211,9 +204,10 @@ otherwise export the entire body."
          (html-end (or (and region-p (region-end))
                        ;; TODO: should catch signature...
                        (point-max)))
-         (raw-body (concat org-mime-default-header
+         (body (concat org-mime-default-header
 			   (buffer-substring html-start html-end)))
-         (body (org-export-string-as raw-body 'org t))
+         (tmp-file (make-temp-name (expand-file-name
+				    "mail" temporary-file-directory)))
          ;; because we probably don't want to export a huge style file
          (org-export-htmlize-output-type 'inline-css)
          ;; makes the replies with ">"s look nicer
@@ -223,7 +217,7 @@ otherwise export the entire body."
          ;; to hold attachments for inline html images
          (html-and-images
           (org-mime-replace-images
-	   (org-export-string-as raw-body 'html t)))
+	   (org-mime--export-string body) tmp-file))
          (html-images (unless arg (cdr html-and-images)))
          (html (org-mime-apply-html-hook
                 (if arg
@@ -247,99 +241,50 @@ otherwise export the entire body."
 (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)
-    (run-hooks 'org-mime-send-subtree-hook)
-    (let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance)))
-	   (file (buffer-file-name (current-buffer)))
-	   (subject (or (funcall mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
-	   (to (funcall mp "MAIL_TO"))
-	   (cc (funcall mp "MAIL_CC"))
-	   (bcc (funcall mp "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)
+(defun org-mime-send-buffer ()
   (run-hooks 'org-mime-send-buffer-hook)
   (let* ((region-p (org-region-active-p))
-	 (file (buffer-file-name (current-buffer)))
-	 (subject (if (not file) (buffer-name (buffer-base-buffer))
-		   (file-name-sans-extension
-		    (file-name-nondirectory file))))
+	 (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"))
 	 (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)
-  (compose-mail to subject headers nil)
-  (message-goto-body)
-  (let ((bhook
-	 (lambda (body fmt)
-	   (let ((hook (intern (concat "org-mime-pre-"
-				       (symbol-name fmt)
-				       "-hook"))))
-	     (if (> (eval `(length ,hook)) 0)
-		 (with-temp-buffer
-		   (insert body)
-		   (goto-char (point-min))
-		   (eval `(run-hooks ',hook))
-		   (buffer-string))
-	       body))))
-	(fmt (if (symbolp fmt) fmt (intern fmt))))
-    (cond
-     ((eq fmt 'org)
-      (require 'ox-org)
-      (insert (org-export-string-as
-	       (org-trim (funcall bhook body 'org)) 'org t)))
-     ((eq fmt 'ascii)
-      (require 'ox-ascii)
-      (insert (org-export-string-as
-	       (concat "#+Title:\n" (funcall bhook body 'ascii)) 'ascii t)))
-     ((or (eq fmt 'html) (eq fmt 'html-ascii))
-      (require 'ox-ascii)
-      (require 'ox-org)
+    (org-mime-compose body file nil subject)))
+
+(defun org-mime-compose (body file &optional to subject headers)
+  (let* ((fmt 'html))
+    (unless (featurep 'message)
+      (require 'message))
+    (message-mail to subject headers nil)
+    (message-goto-body)
+    (flet ((bhook (body fmt)
+                  (let ((hook 'org-mime-pre-html-hook))
+                    (if (> (eval `(length ,hook)) 0)
+                        (with-temp-buffer
+                          (insert body)
+                          (goto-char (point-min))
+                          (eval `(run-hooks ',hook))
+                          (buffer-string))
+                      body))))
       (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-as (funcall bhook body 'html) 'html t)))
-	     (images (cdr html-and-images))
-	     (html (org-mime-apply-html-hook (car html-and-images))))
-	(insert (org-mime-multipart
-		 (org-export-string-as
-		  (org-trim
-		   (funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
-		  (if (eq fmt 'html) 'org 'ascii) t)
-		 html)
-		(mapconcat 'identity images "\n")))))))
+             ;; 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-mime--export-string (bhook body 'html)) file))
+             (images (cdr html-and-images))
+             (html (org-mime-apply-html-hook (car html-and-images))))
+        (insert (org-mime-multipart (org-babel-trim body) 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-mime-use-property-inheritance) 'org)))
+  (org-mime-send-buffer))
 
 (provide 'org-mime)
+;;; org-mime.el ends here
-- 
2.6.6

-- 
Best Regards,
Chen Bin

--
Help me, help you