branch: elpa/org-mime
commit 2eede712acc51aaf495984ec457431dbb520038c
Author: Chen Bin <chenbin...@gmail.com>
Commit: Chen Bin <chenbin...@gmail.com>
quote mail could collapse/expand in gmail web UI
---
README.org | 2 +-
org-mime.el | 144 ++++++++++++++++++++++++++-----------------------
test/org-mime-tests.el | 31 -----------
3 files changed, 79 insertions(+), 98 deletions(-)
diff --git a/README.org b/README.org
index f319ba8d5f..2330c65ceb 100644
--- a/README.org
+++ b/README.org
@@ -95,7 +95,7 @@ Below code renders text between "#" in red color,
#+end_src
For other customization options see the org-mime customization group.
** Beautify quoted mail when replying
-It already works out of box. Currently it emulates Gmail's style. You can go
back the old style by =(setq org-mime-beautify-quoted-mail-p nil)=.
+It already works out of box. Currently it emulates Gmail's style.
** Export options
To avoid exporting TOC, you can setup =org-mime-export-options= which
overrides Org default settings (but still inferior to file-local settings),
#+begin_src elisp
diff --git a/org-mime.el b/org-mime.el
index 51617ba98e..36e4f2329a 100644
--- a/org-mime.el
+++ b/org-mime.el
@@ -6,7 +6,7 @@
;; Maintainer: Chen Bin (redguardtoo)
;; Keywords: mime, mail, email, html
;; Homepage: http://github.com/org-mime/org-mime
-;; Version: 0.2.6
+;; Version: 0.3.0
;; Package-Requires: ((emacs "25.1"))
;; This file is not part of GNU Emacs.
@@ -109,8 +109,7 @@
;; (while (re-search-forward "#\\([^#]*\\)#" nil t)
;; (replace-match "<span style=\"color:red\">\\1</span>"))))
;;
-;; 3. The quoted mail uses Gmail's style, so mail replies looks clean and
modern.
-;; If you prefer the old style, please set `org-mime-beautify-quoted-mail-p'
to nil.
+;; 3. The quoted mail uses Gmail's style, so reply looks clean and modern.
;;
;; 4. Please note this program can only embed exported HTML into mail.
;; Org-mode is responsible for rendering HTML.
@@ -128,11 +127,6 @@
(require 'org)
(require 'ox-org)
-(defcustom org-mime-beautify-quoted-mail-p t
- "Beautify quoted mail in more clean HTML, like Gmail."
- :group 'org-mime
- :type 'boolean)
-
(defcustom org-mime-use-property-inheritance nil
"Non-nil means al MAIL_ properties apply also for sub-levels."
:group 'org-mime
@@ -175,6 +169,12 @@ Default (nil) selects the original org file."
:group 'org-mime
:type 'string)
+(defcustom org-mime-mail-quoted-separator
+ "^>>>>>[^>=]+==\\([^=\r\n]+\\)"
+ "Below this separator is mostly quoted mail."
+ :group 'org-mime
+ :type 'string)
+
(defvar org-mime-export-options '(:with-latex dvipng)
"Default export options which may override org buffer/subtree options.
You could avoid exporting section-number/author/toc.
@@ -297,47 +297,6 @@ SUBTREEP is t if current node is subtree."
(buffer-string)))))
(vm "?")))
-(defun org-mime-beautify-quoted (html)
- "Beautify quoted mail in modern UI style.
-HTML is the body of the message."
- (when org-mime-debug
- (message "org-mime-beautify-quoted called => %s" html))
- (let ((quote-depth 0)
- (line-depth 0)
- (in-quote-p nil)
- (quote-opening "<blockquote class=\"gmail_quote\" style=\"margin:0 0 0
.8ex;border-left:1px #ccc solid;padding-left:1ex\">\n\n<div>")
- (quote-closing "\n</div></blockquote>\n"))
- (with-temp-buffer
- ;; clean title of quoted
- (insert (replace-regexp-in-string
- "<p>[\n\r]*>>>>> .* == \\([^\r\n]*\\)[\r\n]*</p>"
- "<div class=\"gmail_quote\">\\1</div>"
- html))
- (goto-char (point-min))
- (while (not (eobp))
- (setq line-depth 0)
- (setq in-quote-p nil)
- (while (looking-at ">[ \t]*")
- (setq in-quote-p t)
- (replace-match "")
- (cl-incf line-depth))
- (cond
- ((< quote-depth line-depth)
- (while (< quote-depth line-depth)
- (insert quote-opening)
- (cl-incf quote-depth)))
- ((> quote-depth line-depth)
- (while (> quote-depth line-depth)
- (insert quote-closing)
- (cl-decf quote-depth))))
- (if (and in-quote-p (looking-at "^[ \t]*$"))
- (progn
- (insert "</div>\n<div>")
- (forward-line)
- (insert "<br /></div>\n<div>"))
- (forward-line)))
- (buffer-substring (point-min) (point-max)))))
-
(defun org-mime-multipart (plain html &optional images)
"Markup PLAIN body a multipart/alternative with HTML alternatives.
If html portion of message includes IMAGES they are wrapped in
@@ -347,9 +306,7 @@ multipart/related part."
plain
(when images "<#multipart type=related>")
"<#part type=text/html>\n"
- (if org-mime-beautify-quoted-mail-p
- (org-mime-beautify-quoted html)
- html)
+ html
images
(when images "<#/multipart>\n")
"<#/multipart>\n"))
@@ -495,13 +452,6 @@ CURRENT-FILE is used to calculate full path of images."
(search-forward mail-header-separator)
(+ (point) 1)))
-(defun org-mime-mail-signature-begin ()
- "Find start of signature line in email."
- (save-excursion
- (goto-char (point-max))
- (re-search-backward org-mime-mail-signature-separator nil t nil)))
-
-
(defmacro org-mime-extract-tag-in-current-buffer (beginning end result)
"Extract the text between BEGINNING and END and insert it into RESULT."
`(when (and ,beginning ,end (< ,beginning ,end))
@@ -545,6 +495,38 @@ CURRENT-FILE is used to calculate full path of images."
(list :secure-tags (nreverse secure-tags)
:part-tags (nreverse part-tags)))))
+(defun org-mime-extract-my-reply (content)
+ "Extract my reply from CONTENT (no quoted content)."
+ (let* ((arr (split-string content org-mime-mail-quoted-separator))
+ rlt)
+
+ ;; extract reply
+ (setq rlt (plist-put rlt 'REPLY-MAIN (car arr)))
+
+ ;; extract quoted mail
+ (when (> (length arr) 1)
+ (when (string-match org-mime-mail-quoted-separator content)
+ (setq rlt (plist-put rlt
+ 'REPLY-QUOTED-TITLE
+ (string-trim (match-string 1 content)))))
+ (setq arr (split-string (nth 1 arr)
+ org-mime-mail-signature-separator))
+ (setq rlt (plist-put rlt
+ 'REPLY-QUOTED-MAIN
+ (car arr))))
+
+ ;; extract signature and other stuff
+ (when (> (length arr) 1)
+ (setq rlt (plist-put rlt
+ 'REPLY-SIGNATURE
+ (mapconcat 'identity (cdr arr) "--"))))
+
+ (when org-mime-debug
+ (message "org-mime-extract-my-reply called. content=%s rlt=%s"
+ content
+ rlt))
+ rlt))
+
;;;###autoload
(defun org-mime-htmlize ()
"Export a portion of an email to html using `org-mode'.
@@ -560,14 +542,17 @@ If called with an active region only export that region,
otherwise entire body."
(or (and region-p (region-beginning))
(org-mime-mail-body-begin))))
(html-end (or (and region-p (region-end))
- (or
- (org-mime-mail-signature-begin)
- (point-max))))
- (org-text (buffer-substring html-start html-end))
+ (point-max)))
+ (parsed-reply (org-mime-extract-my-reply (buffer-substring html-start
+ html-end)))
+ (reply-main (plist-get parsed-reply 'REPLY-MAIN))
+ (reply-quoted-title (plist-get parsed-reply 'REPLY-QUOTED-TITLE))
+ (reply-quoted-main (plist-get parsed-reply 'REPLY-QUOTED-MAIN))
+ (reply-signature (plist-get parsed-reply 'REPLY-SIGNATURE))
;; to hold attachments for inline html images
(opts (org-mime-get-buffer-export-options))
- (plain (org-mime-export-ascii-maybe org-text))
- (html (org-mime-export-string org-text opts))
+ (plain (org-mime-export-ascii-maybe reply-main))
+ html
(file (make-temp-name (expand-file-name
"mail" temporary-file-directory))))
@@ -580,6 +565,33 @@ If called with an active region only export that region,
otherwise entire body."
(insert (mapconcat #'identity secure-tags "\n"))
(insert "\n"))
+ (setq html (org-mime-export-string reply-main opts))
+
+ (when (and reply-quoted-title reply-quoted-main)
+ (setq html (concat html
+ ;; class name is magic in google mail?
+ "<div class=\"im\">\n"
+ " <div class=\"gmail_quote\">\n"
+ " <div class=\"gmail_attr\">\n"
+ reply-quoted-title
+ "\n"
+ " <br>\n"
+ " </div>\n"
+ " <blockquote class=\"gmail_quote\">\n"
+ (org-mime-export-string reply-quoted-main opts)
+ "\n"
+ " </blockquote>\n"
+ " </div>\n"
+ "</div>\n")))
+
+ (when reply-signature
+ (setq html (concat html
+ "<br clear=\"all\">\n"
+ "<div class=\"gmail_signature\">\n"
+ " <br>--<br>\n"
+ (replace-regexp-in-string "^--\s*\\|[\r\n]+" "<br>\n"
reply-signature)
+ "</div>\n")))
+
;; insert converted html
(org-mime-insert-html-content plain file html opts)
@@ -891,7 +903,7 @@ Following headline properties can determine the mail
headers.
(message "Can not find plain text mail.")))))
(defun org-mime-confirm-when-no-multipart ()
- "Prompts whether to send email if the buffer is not htmlized."
+ "Prompt whether to send email if the buffer is not htmlized."
(let ((found-multipart (save-excursion
(save-restriction
(widen)
diff --git a/test/org-mime-tests.el b/test/org-mime-tests.el
index c043b43ee3..ffe2d75bf9 100644
--- a/test/org-mime-tests.el
+++ b/test/org-mime-tests.el
@@ -269,37 +269,6 @@
(should-not (string-match "SECTION_ONE" str)))
(kill-buffer orgBuf)))
-(ert-deftest test-org-mime-beautify-quoted-para-breaks ()
- (setq html (concat "<p>\n"
- "Hello there\n"
- "</p>\n"
- "\n"
- "<p>\n"
- "> this is a long-ish para that is broken\n"
- "> on two lines\n"
- ">\n"
- "> followed by a single-line para\n"
- "</p>\n"))
- (setq expected (concat "<p>\n"
- "Hello there\n"
- "</p>\n"
- "\n"
- "<p>\n"
- "<blockquote class=\"gmail_quote\" style=\"margin:0
0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex\">\n"
- "\n"
- "<div>this is a long-ish para that is broken\n"
- "on two lines\n"
- "</div>\n"
- "<div>\n"
- "<br /></div>\n"
- "<div>followed by a single-line para\n"
- "\n"
- "</div></blockquote>\n"
- "</p>\n"))
- (setq beautified (org-mime-beautify-quoted html))
- (should (equal beautified expected)))
-
-
(ert-deftest test-org-mime-extract-non-org ()
(let* ((content (concat "*hello world\n"
"<#part type=\"application/pdf\" filename=\"1.pdl\"
disposition=attachment>\n<#/part>\n"
