From 1be13d57dc8357576a8285c6dadc03db9e3ed7b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Tue, 25 Aug 2015 12:27:35 +0200 Subject: Imported Upstream version 8.3.1 --- contrib/lisp/org-mime.el | 123 ++++++++++++++++++++++++----------------------- 1 file changed, 62 insertions(+), 61 deletions(-) (limited to 'contrib/lisp/org-mime.el') diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el index 44bf91b..078ebef 100644 --- a/contrib/lisp/org-mime.el +++ b/contrib/lisp/org-mime.el @@ -1,6 +1,6 @@ ;;; org-mime.el --- org html export for text/html MIME emails -;; Copyright (C) 2010-2014 Eric Schulte +;; Copyright (C) 2010-2015 Eric Schulte ;; Author: Eric Schulte ;; Keywords: mime, mail, email, html @@ -111,7 +111,7 @@ ;; 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)
@@ -194,10 +194,10 @@ and images in a multipart/related part."
       str)
      html-images)))
 
-(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."
+(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."
   (interactive "P")
   (require 'ox-org)
   (require 'ox-html)
@@ -252,22 +252,22 @@ export that region, otherwise export the entire body."
   (save-restriction
     (org-narrow-to-subtree)
     (run-hooks 'org-mime-send-subtree-hook)
-    (flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance)))
-      (let* ((file (buffer-file-name (current-buffer)))
-	     (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
-	     (to (mp "MAIL_TO"))
-	     (cc (mp "MAIL_CC"))
-	     (bcc (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)))))))
+    (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)
   (run-hooks 'org-mime-send-buffer-hook)
@@ -287,45 +287,46 @@ export that region, otherwise export the entire body."
   (require 'message)
   (message-mail to subject headers nil)
   (message-goto-body)
-  (flet ((bhook (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))))
-    (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
-      (cond
-       ((eq fmt 'org)
-	(require 'ox-org)
-	(insert (org-export-string-as
-		 (org-babel-trim (bhook body 'org)) 'org t)))
-       ((eq fmt 'ascii)
-	(require 'ox-ascii)
-	(insert (org-export-string-as
-		 (concat "#+Title:\n" (bhook body 'ascii)) 'ascii t)))
-       ((or (eq fmt 'html) (eq fmt 'html-ascii))
-	(require 'ox-ascii)
-	(require 'ox-org)
-	(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 (bhook body 'html) 'html t) file))
-	       (images (cdr html-and-images))
-	       (html (org-mime-apply-html-hook (car html-and-images))))
-	  (insert (org-mime-multipart
-		   (org-export-string-as
-		    (org-babel-trim
-		     (bhook body (if (eq fmt 'html) 'org 'ascii)))
-		    (if (eq fmt 'html) 'org 'ascii) t)
-		   html)
-		  (mapconcat 'identity images "\n"))))))))
+  (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-babel-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)
+      (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) file))
+	     (images (cdr html-and-images))
+	     (html (org-mime-apply-html-hook (car html-and-images))))
+	(insert (org-mime-multipart
+		 (org-export-string-as
+		  (org-babel-trim
+		   (funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
+		  (if (eq fmt 'html) 'org 'ascii) t)
+		 html)
+		(mapconcat 'identity images "\n")))))))
 
 (defun org-mime-org-buffer-htmlize ()
   "Create an email buffer containing the current org-mode file
-- 
cgit v1.2.3