1 ;;; org-mime.el --- org html export for text/html MIME emails
3 ;; Copyright (C) 2010-2012 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; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;; WYSWYG, html mime composition using org-mode
33 ;; For mail composed using the orgstruct-mode minor mode, this
34 ;; provides a function for converting all or part of your mail buffer
35 ;; to embedded html as exported by org-mode. Call `org-mime-htmlize'
36 ;; in a message buffer to convert either the active region or the
37 ;; entire buffer to html.
39 ;; Similarly the `org-mime-org-buffer-htmlize' function can be called
40 ;; from within an org-mode buffer to convert the buffer to html, and
41 ;; package the results into an email handling with appropriate MIME
44 ;; you might want to bind this to a key with something like the
45 ;; following message-mode binding
47 ;; (add-hook 'message-mode-hook
49 ;; (local-set-key "\C-c\M-o" 'org-mime-htmlize)))
51 ;; and the following org-mode binding
53 ;; (add-hook 'org-mode-hook
55 ;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize)))
60 (defcustom org-mime-use-property-inheritance nil
61 "Non-nil means al MAIL_ properties apply also for sublevels."
65 (defcustom org-mime-default-header
66 "#+OPTIONS: latex:t\n"
67 "Default header to control html export options, and ensure
68 first line isn't assumed to be a title line."
72 (defcustom org-mime-library
'mml
73 "Library to use for marking up MIME elements."
75 :type
'(choice 'mml
'semi
'vm
))
77 (defcustom org-mime-preserve-breaks t
78 "Used as temporary value of `org-export-preserve-breaks' during
83 (defcustom org-mime-fixedwith-wrap
84 "<pre style=\"font-family: courier, monospace;\">\n%s</pre>\n"
85 "Format string used to wrap a fixedwidth HTML email."
89 (defcustom org-mime-html-hook nil
90 "Hook to run over the html buffer before attachment to email.
91 This could be used for example to post-process html elements."
97 ,(intern (concat "org-mime-pre-" fmt
"-hook"))
99 (concat "Hook to run before " fmt
" export.\nFunctions "
100 "should take no arguments and will be run in a "
101 "buffer holding\nthe text to be exported."))))
102 '("ascii" "org" "html"))
104 (defcustom org-mime-send-subtree-hook nil
105 "Hook to run in the subtree in the Org-mode file before export.")
107 (defcustom org-mime-send-buffer-hook nil
108 "Hook to run in the Org-mode file before export.")
110 ;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
111 (defun org-mime-change-element-style (element style
)
112 "Set new default htlm style for <ELEMENT> elements in exported html."
113 (while (re-search-forward (format "<%s" element
) nil t
)
114 (replace-match (format "<%s style=\"%s\"" element style
))))
116 (defun org-mime-change-class-style (class style
)
117 "Set new default htlm style for objects with classs=CLASS in
119 (while (re-search-forward (format "class=\"%s\"" class
) nil t
)
120 (replace-match (format "class=\"%s\" style=\"%s\"" class style
))))
122 ;; ;; example addition to `org-mime-html-hook' adding a dark background
123 ;; ;; color to <pre> elements
124 ;; (add-hook 'org-mime-html-hook
126 ;; (org-mime-change-element-style
127 ;; "pre" (format "color: %s; background-color: %s;"
128 ;; "#E6E1DC" "#232323"))
129 ;; (org-mime-change-class-style
130 ;; "verse" "border-left: 2px solid gray; padding-left: 4px;")))
132 (defun org-mime-file (ext path id
)
133 "Markup a file for attachment."
134 (case org-mime-library
136 "<#part type=\"%s\" filename=\"%s\" id=\"<%s>\">\n<#/part>\n"
140 "--[[%s\nContent-Disposition: inline;\nContent-ID: <%s>][base64]]\n"
142 (base64-encode-string
144 (set-buffer-multibyte nil
)
145 (binary-insert-encoded-file path
)
149 (defun org-mime-multipart (plain html
)
150 "Markup a multipart/alternative with text/plain and text/html
152 (case org-mime-library
153 ('mml
(format (concat "<#multipart type=alternative><#part type=text/plain>"
154 "%s<#part type=text/html>%s<#/multipart>\n")
157 "--" "<<alternative>>-{\n"
158 "--" "[[text/plain]]\n" plain
159 "--" "[[text/html]]\n" html
160 "--" "}-<<alternative>>\n"))
163 (defun org-mime-replace-images (str current-file
)
164 "Replace images in html files with cid links."
167 (replace-regexp-in-string ;; replace images in html
168 "src=\"\\([^\"]+\\)\""
172 (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text
)
173 (match-string 1 text
)))
174 (path (expand-file-name
175 url
(file-name-directory current-file
)))
176 (ext (file-name-extension path
))
177 (id (replace-regexp-in-string "[\/\\\\]" "_" path
)))
178 (add-to-list 'html-images
179 (org-mime-file (concat "image/" ext
) path id
))
184 (defun org-mime-htmlize (arg)
185 "Export a portion of an email body composed using `mml-mode' to
186 html using `org-mode'. If called with an active region only
187 export that region, otherwise export the entire body."
189 (let* ((region-p (org-region-active-p))
190 (html-start (or (and region-p
(region-beginning))
192 (goto-char (point-min))
193 (search-forward mail-header-separator
)
195 (html-end (or (and region-p
(region-end))
196 ;; TODO: should catch signature...
198 (raw-body (buffer-substring html-start html-end
))
199 (tmp-file (make-temp-name (expand-file-name
200 "mail" temporary-file-directory
)))
201 (body (org-export-string raw-body
'org
(file-name-directory tmp-file
)))
202 ;; because we probably don't want to skip part of our mail
203 (org-export-skip-text-before-1st-heading nil
)
204 ;; because we probably don't want to export a huge style file
205 (org-export-htmlize-output-type 'inline-css
)
206 ;; makes the replies with ">"s look nicer
207 (org-export-preserve-breaks org-mime-preserve-breaks
)
208 ;; dvipng for inline latex because MathJax doesn't work in mail
209 (org-export-with-LaTeX-fragments 'dvipng
)
210 ;; to hold attachments for inline html images
212 (org-mime-replace-images
213 (org-export-string raw-body
'html
(file-name-directory tmp-file
))
215 (html-images (unless arg
(cdr html-and-images
)))
216 (html (org-mime-apply-html-hook
218 (format org-mime-fixedwith-wrap body
)
219 (car html-and-images
)))))
220 (delete-region html-start html-end
)
222 (goto-char html-start
)
223 (insert (org-mime-multipart body html
)
224 (mapconcat 'identity html-images
"\n")))))
226 (defun org-mime-apply-html-hook (html)
227 (if org-mime-html-hook
230 (goto-char (point-min))
231 (run-hooks 'org-mime-html-hook
)
235 (defmacro org-mime-try
(&rest body
)
236 `(condition-case nil
,@body
(error nil
)))
238 (defun org-mime-send-subtree (&optional fmt
)
240 (org-narrow-to-subtree)
241 (run-hooks 'org-mime-send-subtree-hook
)
242 (flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance
)))
243 (let* ((file (buffer-file-name (current-buffer)))
244 (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
247 (bcc (mp "MAIL_BCC"))
248 (body (buffer-substring
249 (save-excursion (goto-char (point-min))
251 (when (looking-at "[ \t]*:PROPERTIES:")
252 (re-search-forward ":END:" nil
)
256 (org-mime-compose body
(or fmt
'org
) file to subject
257 `((cc .
,cc
) (bcc .
,bcc
)))))))
259 (defun org-mime-send-buffer (&optional fmt
)
260 (run-hooks 'org-mime-send-buffer-hook
)
261 (let* ((region-p (org-region-active-p))
262 (subject (org-export-grab-title-from-buffer))
263 (file (buffer-file-name (current-buffer)))
264 (body-start (or (and region-p
(region-beginning))
265 (save-excursion (goto-char (point-min)))))
266 (body-end (or (and region-p
(region-end)) (point-max)))
267 (temp-body-file (make-temp-file "org-mime-export"))
268 (body (buffer-substring body-start body-end
)))
269 (org-mime-compose body
(or fmt
'org
) file nil subject
)))
271 (defun org-mime-compose (body fmt file
&optional to subject headers
)
273 (message-mail to subject headers nil
)
275 (flet ((bhook (body fmt
)
276 (let ((hook (intern (concat "org-mime-pre-"
279 (if (> (eval `(length ,hook
)) 0)
282 (goto-char (point-min))
283 (eval `(run-hooks ',hook
))
286 (let ((fmt (if (symbolp fmt
) fmt
(intern fmt
))))
289 (insert (org-export-string (org-babel-trim (bhook body
'org
)) 'org
)))
291 (insert (org-export-string
292 (concat "#+Title:\n" (bhook body
'ascii
)) 'ascii
)))
293 ((or (eq fmt
'html
) (eq fmt
'html-ascii
))
294 (let* ((org-link-file-path-type 'absolute
)
295 ;; we probably don't want to export a huge style file
296 (org-export-htmlize-output-type 'inline-css
)
297 (html-and-images (org-mime-replace-images
300 'html
(file-name-nondirectory file
))
302 (images (cdr html-and-images
))
303 (html (org-mime-apply-html-hook (car html-and-images
))))
304 (insert (org-mime-multipart
307 (bhook body
(if (eq fmt
'html
) 'org
'ascii
)))
308 (if (eq fmt
'html
) 'org
'ascii
))
310 (mapconcat 'identity images
"\n"))))))))
312 (defun org-mime-org-buffer-htmlize ()
313 "Create an email buffer containing the current org-mode file
314 exported to html and encoded in both html and in org formats as
317 (org-mime-send-buffer 'html
))
319 (defun org-mime-subtree ()
320 "Create an email buffer containing the current org-mode subtree
321 exported to a org format or to the format specified by the
322 MAIL_FMT property of the subtree."
324 (org-mime-send-subtree
325 (or (org-entry-get nil
"MAIL_FMT" org-mime-use-property-inheritance
) 'org
)))