org-mime: [PATCH] Toggle between plaintext and html

[Benjamin Andresen <benny@in-ulm.de>]

[-- Attachment #1: Type: text/plain, Size: 304 bytes --]

Hello,

I hope I'm not polluting this mailing list wrongly (due to org-mime
being contrib and not mainline).

I wrote a small patch that gives the function org-mime-toggle-html
(+ support) for that I had to unfortunately rewrite `org-mime-multipart'

Maybe Eric can look at it and if useful include it.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-mime-toggle-html.patch --]
[-- Type: text/x-patch, Size: 3326 bytes --]

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 . "--<<alternative>>-{\n--[[text/plain]]\n")
+           (mid . "--[[text/html]]\n")
+           (end . "--}-<<alternative>>\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
-            "--" "<<alternative>>-{\n"
-            "--" "[[text/plain]]\n" plain
-            "--" "[[text/html]]\n"  html
-            "--" "}-<<alternative>>\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."

[-- Attachment #3: Type: text/plain, Size: 54 bytes --]


Critique and comments always welcome. :-)

br,
benny

[-- Attachment #4: Type: text/plain, Size: 201 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode