From mboxrd@z Thu Jan 1 00:00:00 1970 From: Chen Bin Subject: [PATCH] org-mime supports emacs24 Date: Sun, 21 Aug 2016 11:27:08 +1000 Message-ID: <874m6edi8j.fsf@gmail.com> Mime-Version: 1.0 Content-Type: text/plain Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46017) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bbHZ6-0005j7-2a for emacs-orgmode@gnu.org; Sat, 20 Aug 2016 21:28:46 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bbHZ2-0001pa-KO for emacs-orgmode@gnu.org; Sat, 20 Aug 2016 21:28:43 -0400 Received: from mail-pa0-f66.google.com ([209.85.220.66]:34791) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bbHZ2-0001lV-Bw for emacs-orgmode@gnu.org; Sat, 20 Aug 2016 21:28:40 -0400 Received: by mail-pa0-f66.google.com with SMTP id hh10so5673707pac.1 for ; Sat, 20 Aug 2016 18:28:19 -0700 (PDT) Received: from sydneypc.homepc (47.123.233.220.static.exetel.com.au. [220.233.123.47]) by smtp.gmail.com with ESMTPSA id x184sm16713504pfd.70.2016.08.20.18.27.15 for (version=TLS1_2 cipher=AES128-SHA bits=128/128); Sat, 20 Aug 2016 18:27:17 -0700 (PDT) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org 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 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 
 elements
 (defun org-mime-change-element-style (element style)
   "Set new default htlm style for  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
             "--" "<>-{\n"
             "--" "[[text/plain]]\n" plain
-	    (if (and images (> (length images) 0))
-		(concat "--" "<>-{\n"
-			"--" "[[text/html]]\n"  html
-			images
-			"--" "}-<>\n")
-	      (concat "--" "[[text/html]]\n"  html
-		      images))
+	    (when images (concat "--" "<>-{\n"))
+            "--" "[[text/html]]\n"  html
+	    images
+	    (when images (concat "--" "}-<>\n"))
             "--" "}-<>\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