Benjamin Andresen <benny@in-ulm.de> writes:

> 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.
>
> 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."
>
> Critique and comments always welcome. :-)
>
> br,
> benny
> _______________________________________________
> 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