1 ;;; org-mime.el --- org html export for text/html MIME emails
3 ;; Copyright (C) 2010-2015 Eric Schulte
5 ;; Author: Eric Schulte
6 ;; Keywords: mime, mail, email, html
7 ;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php
10 ;; This file is not part of GNU Emacs.
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 3, or (at your option)
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; WYSWYG, html mime composition using org-mode
31 ;; For mail composed using the orgstruct-mode minor mode, this
32 ;; provides a function for converting all or part of your mail buffer
33 ;; to embedded html as exported by org-mode. Call `org-mime-htmlize'
34 ;; in a message buffer to convert either the active region or the
35 ;; entire buffer to html.
37 ;; Similarly the `org-mime-org-buffer-htmlize' function can be called
38 ;; from within an org-mode buffer to convert the buffer to html, and
39 ;; package the results into an email handling with appropriate MIME
42 ;; you might want to bind this to a key with something like the
43 ;; following message-mode binding
45 ;; (add-hook 'message-mode-hook
47 ;; (local-set-key "\C-c\M-o" 'org-mime-htmlize)))
49 ;; and the following org-mode binding
51 ;; (add-hook 'org-mode-hook
53 ;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize)))
58 (declare-function org-export-string-as
"ox"
59 (string backend
&optional body-only ext-plist
))
60 (declare-function org-trim
"org" (s &optional keep-lead
))
62 (defcustom org-mime-use-property-inheritance nil
63 "Non-nil means al MAIL_ properties apply also for sublevels."
67 (defcustom org-mime-default-header
68 "#+OPTIONS: latex:t\n"
69 "Default header to control html export options, and ensure
70 first line isn't assumed to be a title line."
74 (defcustom org-mime-library
'mml
75 "Library to use for marking up MIME elements."
77 :type
'(choice 'mml
'semi
'vm
))
79 (defcustom org-mime-preserve-breaks t
80 "Used as temporary value of `org-export-preserve-breaks' during
85 (defcustom org-mime-fixedwith-wrap
86 "<pre style=\"font-family: courier, monospace;\">\n%s</pre>\n"
87 "Format string used to wrap a fixedwidth HTML email."
91 (defcustom org-mime-html-hook nil
92 "Hook to run over the html buffer before attachment to email.
93 This could be used for example to post-process html elements."
99 ,(intern (concat "org-mime-pre-" fmt
"-hook"))
101 (concat "Hook to run before " fmt
" export.\nFunctions "
102 "should take no arguments and will be run in a "
103 "buffer holding\nthe text to be exported."))))
104 '("ascii" "org" "html"))
106 (defcustom org-mime-send-subtree-hook nil
107 "Hook to run in the subtree in the Org-mode file before export.")
109 (defcustom org-mime-send-buffer-hook nil
110 "Hook to run in the Org-mode file before export.")
112 ;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
113 (defun org-mime-change-element-style (element style
)
114 "Set new default htlm style for <ELEMENT> elements in exported html."
115 (while (re-search-forward (format "<%s\\>" element
) nil t
)
116 (replace-match (format "<%s style=\"%s\"" element style
))))
118 (defun org-mime-change-class-style (class style
)
119 "Set new default htlm style for objects with classs=CLASS in
121 (while (re-search-forward (format "class=\"%s\"" class
) nil t
)
122 (replace-match (format "class=\"%s\" style=\"%s\"" class style
))))
124 ;; ;; example addition to `org-mime-html-hook' adding a dark background
125 ;; ;; color to <pre> elements
126 ;; (add-hook 'org-mime-html-hook
128 ;; (org-mime-change-element-style
129 ;; "pre" (format "color: %s; background-color: %s;"
130 ;; "#E6E1DC" "#232323"))
131 ;; (org-mime-change-class-style
132 ;; "verse" "border-left: 2px solid gray; padding-left: 4px;")))
134 (defun org-mime-file (ext path id
)
135 "Markup a file for attachment."
136 (case org-mime-library
137 ('mml
(format (concat "<#part type=\"%s\" filename=\"%s\" "
138 "disposition=inline id=\"<%s>\">\n<#/part>\n")
141 (format (concat "--[[%s\nContent-Disposition: "
142 "inline;\nContent-ID: <%s>][base64]]\n")
144 (base64-encode-string
146 (set-buffer-multibyte nil
)
147 (binary-insert-encoded-file path
)
151 (defun org-mime-multipart (plain html
&optional images
)
152 "Markup a multipart/alternative with text/plain and text/html alternatives.
153 If the html portion of the message includes images wrap the html
154 and images in a multipart/related part."
155 (case org-mime-library
156 ('mml
(concat "<#multipart type=alternative><#part type=text/plain>"
158 (when images
"<#multipart type=related>")
159 "<#part type=text/html>"
162 (when images
"<#/multipart>\n")
165 "--" "<<alternative>>-{\n"
166 "--" "[[text/plain]]\n" plain
167 (if (and images
(> (length images
) 0))
168 (concat "--" "<<related>>-{\n"
169 "--" "[[text/html]]\n" html
171 "--" "}-<<related>>\n")
172 (concat "--" "[[text/html]]\n" html
174 "--" "}-<<alternative>>\n"))
177 (defun org-mime-replace-images (str)
178 "Replace images in html files with cid links."
181 (replace-regexp-in-string ;; replace images in html
182 "src=\"\\([^\"]+\\)\""
186 (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text
)
187 (match-string 1 text
)))
188 (path (expand-file-name
189 url temporary-file-directory
))
190 (ext (file-name-extension path
))
191 (id (replace-regexp-in-string "[\/\\\\]" "_" path
)))
192 (add-to-list 'html-images
193 (org-mime-file (concat "image/" ext
) path id
))
198 (defun org-mime-htmlize (&optional arg
)
199 "Export to HTML an email body composed using `mml-mode'.
200 If called with an active region only export that region,
201 otherwise export the entire body."
205 (let* ((region-p (org-region-active-p))
206 (html-start (or (and region-p
(region-beginning))
208 (goto-char (point-min))
209 (search-forward mail-header-separator
)
211 (html-end (or (and region-p
(region-end))
212 ;; TODO: should catch signature...
214 (raw-body (concat org-mime-default-header
215 (buffer-substring html-start html-end
)))
216 (body (org-export-string-as raw-body
'org t
))
217 ;; because we probably don't want to export a huge style file
218 (org-export-htmlize-output-type 'inline-css
)
219 ;; makes the replies with ">"s look nicer
220 (org-export-preserve-breaks org-mime-preserve-breaks
)
221 ;; dvipng for inline latex because MathJax doesn't work in mail
222 (org-html-with-latex 'dvipng
)
223 ;; to hold attachments for inline html images
225 (org-mime-replace-images
226 (org-export-string-as raw-body
'html t
)))
227 (html-images (unless arg
(cdr html-and-images
)))
228 (html (org-mime-apply-html-hook
230 (format org-mime-fixedwith-wrap body
)
231 (car html-and-images
)))))
232 (delete-region html-start html-end
)
234 (goto-char html-start
)
235 (insert (org-mime-multipart
236 body html
(mapconcat 'identity html-images
"\n"))))))
238 (defun org-mime-apply-html-hook (html)
239 (if org-mime-html-hook
242 (goto-char (point-min))
243 (run-hooks 'org-mime-html-hook
)
247 (defmacro org-mime-try
(&rest body
)
248 `(condition-case nil
,@body
(error nil
)))
250 (defun org-mime-send-subtree (&optional fmt
)
252 (org-narrow-to-subtree)
253 (run-hooks 'org-mime-send-subtree-hook
)
254 (let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance
)))
255 (file (buffer-file-name (current-buffer)))
256 (subject (or (funcall mp
"MAIL_SUBJECT") (nth 4 (org-heading-components))))
257 (to (funcall mp
"MAIL_TO"))
258 (cc (funcall mp
"MAIL_CC"))
259 (bcc (funcall mp
"MAIL_BCC"))
260 (body (buffer-substring
261 (save-excursion (goto-char (point-min))
263 (when (looking-at "[ \t]*:PROPERTIES:")
264 (re-search-forward ":END:" nil
)
268 (org-mime-compose body
(or fmt
'org
) file to subject
269 `((cc .
,cc
) (bcc .
,bcc
))))))
271 (defun org-mime-send-buffer (&optional fmt
)
272 (run-hooks 'org-mime-send-buffer-hook
)
273 (let* ((region-p (org-region-active-p))
274 (file (buffer-file-name (current-buffer)))
275 (subject (if (not file
) (buffer-name (buffer-base-buffer))
276 (file-name-sans-extension
277 (file-name-nondirectory file
))))
278 (body-start (or (and region-p
(region-beginning))
279 (save-excursion (goto-char (point-min)))))
280 (body-end (or (and region-p
(region-end)) (point-max)))
281 (temp-body-file (make-temp-file "org-mime-export"))
282 (body (buffer-substring body-start body-end
)))
283 (org-mime-compose body
(or fmt
'org
) file nil subject
)))
285 (defun org-mime-compose (body fmt file
&optional to subject headers
)
287 (compose-mail to subject headers nil
)
291 (let ((hook (intern (concat "org-mime-pre-"
294 (if (> (eval `(length ,hook
)) 0)
297 (goto-char (point-min))
298 (eval `(run-hooks ',hook
))
301 (fmt (if (symbolp fmt
) fmt
(intern fmt
))))
305 (insert (org-export-string-as
306 (org-trim (funcall bhook body
'org
)) 'org t
)))
309 (insert (org-export-string-as
310 (concat "#+Title:\n" (funcall bhook body
'ascii
)) 'ascii t
)))
311 ((or (eq fmt
'html
) (eq fmt
'html-ascii
))
314 (let* ((org-link-file-path-type 'absolute
)
315 ;; we probably don't want to export a huge style file
316 (org-export-htmlize-output-type 'inline-css
)
318 (org-mime-replace-images
319 (org-export-string-as (funcall bhook body
'html
) 'html t
)))
320 (images (cdr html-and-images
))
321 (html (org-mime-apply-html-hook (car html-and-images
))))
322 (insert (org-mime-multipart
323 (org-export-string-as
325 (funcall bhook body
(if (eq fmt
'html
) 'org
'ascii
)))
326 (if (eq fmt
'html
) 'org
'ascii
) t
)
328 (mapconcat 'identity images
"\n")))))))
330 (defun org-mime-org-buffer-htmlize ()
331 "Create an email buffer containing the current org-mode file
332 exported to html and encoded in both html and in org formats as
335 (org-mime-send-buffer 'html
))
337 (defun org-mime-subtree ()
338 "Create an email buffer containing the current org-mode subtree
339 exported to a org format or to the format specified by the
340 MAIL_FMT property of the subtree."
342 (org-mime-send-subtree
343 (or (org-entry-get nil
"MAIL_FMT" org-mime-use-property-inheritance
) 'org
)))