diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el index 14a8ce3..79a1789 100644 --- a/contrib/lisp/org-mime.el +++ b/contrib/lisp/org-mime.el @@ -116,19 +116,30 @@ (buffer-string))))) ('vm "?"))) +(defvar org-mime-multipart-alist + '((mml ((beg . "<#multipart type=alternative>\n<#part type=text/plain>\n") + (mid . "<#part type=text/html>") + (end . "\n<#/multipart>\n"))) + (semi ((beg . "--<>-{\n--[[text/plain]]\n") + (mid . "--[[text/html]]\n") + (end . "--}-<>\n"))) + (vm ((beg . "?") + (mid . "?") + (end . "?")))) + "Text to wrap around plain and html strings.") + +(defun org-mime-multipart-get (pos &optional mime-lib alist) + (let ((alist (cadr (assoc (or mime-lib org-mime-library) + (or alist org-mime-multipart-alist))))) + (cdr (assoc pos alist)))) + (defun org-mime-multipart (plain html) "Markup a multipart/alternative with text/plain and text/html alternatives." - (case org-mime-library - ('mml (format (concat "<#multipart type=alternative><#part type=text/plain>" - "%s<#part type=text/html>%s<#/multipart>\n") - plain html)) - ('semi (concat - "--" "<>-{\n" - "--" "[[text/plain]]\n" plain - "--" "[[text/html]]\n" html - "--" "}-<>\n")) - ('vm "?"))) + (let ((begin (org-mime-multipart-get 'beg)) + (middle (org-mime-multipart-get 'mid)) + (end (org-mime-multipart-get 'end))) + (concat begin plain middle html end))) (defun org-mime-replace-images (str current-file) "Replace images in html files with cid links." @@ -190,6 +201,40 @@ export that region, otherwise export the entire body." (insert (org-mime-multipart body html) (mapconcat 'identity html-images "\n"))))) +(defun org-mime-unhtmlize (arg) + "Delete mime-related text and revert buffer to pure plaintext state." + (interactive "P") + (let ((body-start (save-excursion + (goto-char (point-min)) + (search-forward mail-header-separator) + (+ (point) 1))) + (plaintext-start (org-mime-multipart-get 'beg)) + (plaintext-end (org-mime-multipart-get 'mid))) + (condition-case nil + (when (org-mime-buffer-html-p) + (goto-char body-start) + (search-forward plaintext-start) + (delete-region body-start (point)) + (search-forward plaintext-end) + (delete-region (- (point) (length plaintext-end)) (point-max)) + (goto-char body-start)) + (error nil)))) + +(defun org-mime-buffer-html-p () + "Return true if buffer has already been htmlized." + (condition-case nil + (save-excursion + (goto-char (point-min)) + (search-forward (org-mime-multipart-get 'beg))) + (error nil))) + +(defun org-mime-toggle-html (arg) + "If buffer hasn't been htmlized, do it. Otherwise revert." + (interactive "P") + (if (org-mime-buffer-html-p) + (org-mime-unhtmlize arg) + (org-mime-htmlize arg))) + (defun org-mime-org-export (fmt body tmp-file) "Org-Export BODY to format FMT with the file name set to TMP-FILE during export."