[PATCH] org-mime supports emacs24

[PATCH] org-mime supports emacs24

[Chen Bin]

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

Re: [PATCH] org-mime supports emacs24

[Nicolas Goaziou]

Hello,

Chen Bin <chenbin.sh@gmail.com> writes:

> I got one patch to make org-mime.el usable at Emacs24.

Thank you. Note that I don't think "org-mime.el" has an active
maintainer anymore. If you want to get maintainership, we could as well
remove "org-mime.el" from contrib/ directory and let your repository be
the official one.

> I also clean out the obsolete code to make it not dependent on ascii
> and org export backend any more.

Why is it an issue ?

> +(eval-when-compile
> +  (require 'cl))

I suggest to (require 'cl-lib) instead and use "cl-" prefix accordingly.

>      ('semi (concat

"'semi" is probably a typo, assuming it is a `case' branch. It should be
simply "semi".

>              "--" "<<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 "?")))

Ditto.


Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-mime supports emacs24

[chen bin]

On Sat, Sep 3, 2016 at 6:41 PM, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:
> maintainer anymore. If you want to get maintainership, we could as well
Yes, I'd like to maintain the org-mime.el in the future.

I agree with you, maybe pointing to project is the better solution.

I updated code at https://github.com/redguardtoo/org-mime according to
your review.

Regards,
Chen


-- 
help me, help you.

Re: [PATCH] org-mime supports emacs24

[Nicolas Goaziou]

Hello,

chen bin <chenbin.sh@gmail.com> writes:

> I agree with you, maybe pointing to project is the better solution.

There is an "org-mime" on Marmelade already. It doesn't seem to be your
project, tho. It could be useful to add yours to any ELPA and have the
previous one removed so as to avoid confusion.

I'll remove org-mime.el from contrib as soon as yours is readily
available, if no one objects.

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-mime supports emacs24

[chen bin]

On Tue, Sep 6, 2016 at 1:57 AM, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:
> project, tho. It could be useful to add yours to any ELPA and have the

Sure, I will contact marmelade and melpa maintainer asap, for now,
There are also some pull request and bugs I need handle. So it could
take a few days.

-- 
help me, help you.

Re: [PATCH] org-mime supports emacs24

[Kaushal Modi]

[-- Attachment #1: Type: text/plain, Size: 524 bytes --]

I noticed that org-mime was recently added to Melpa:
https://melpa.org/#/org-mime

On Mon, Sep 12, 2016 at 7:32 PM chen bin <chenbin.sh@gmail.com> wrote:

> On Tue, Sep 6, 2016 at 1:57 AM, Nicolas Goaziou <mail@nicolasgoaziou.fr>
> wrote:
> > project, tho. It could be useful to add yours to any ELPA and have the
>
> Sure, I will contact marmelade and melpa maintainer asap, for now,
> There are also some pull request and bugs I need handle. So it could
> take a few days.
>
> --
> help me, help you.
>
> --

Kaushal Modi

[-- Attachment #2: Type: text/html, Size: 1192 bytes --]

Re: [PATCH] org-mime supports emacs24

[Nicolas Goaziou]

Hello,

Kaushal Modi <kaushal.modi@gmail.com> writes:

> I noticed that org-mime was recently added to Melpa:
> https://melpa.org/#/org-mime

I guess we can remove "org-mime.el" from contrib/ then. Any objection?

Regards,

-- 
Nicolas Goaziou