diff options
author | Sébastien Delafond <sdelafond@gmail.com> | 2015-08-25 12:27:35 +0200 |
---|---|---|
committer | Sébastien Delafond <sdelafond@gmail.com> | 2015-08-25 12:27:35 +0200 |
commit | 1be13d57dc8357576a8285c6dadc03db9e3ed7b0 (patch) | |
tree | e35b32d4dbd60cb6cea09f3c0797cc8877352def /contrib/lisp/org-mime.el | |
parent | 4dc4918d0d667f18f3d5e3dd71e6f117ddb8af8a (diff) |
Imported Upstream version 8.3.1
Diffstat (limited to 'contrib/lisp/org-mime.el')
-rw-r--r-- | contrib/lisp/org-mime.el | 123 |
1 files changed, 62 insertions, 61 deletions
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 <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) @@ -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 |