Subject: bug#4258: [patch] HTML mail in rmail

From: Ken Olum <[email-masked]>
Date: Fri, 27 Dec 2013 15:10:59 -0500

Here is some code for handling HTML parts.  To show the part it funcalls
rmail-mime-render-html-function, which defaults to using shr if libxml
is available, or lynx if you have that.  Other methods could be written.
In the long run it would probably be better to integrate rmail mime
handling with gnus mime handling, but that seems like a big job.

Even if you use shr, if it does not render images called for by the html
part, because asynchronous retrieving of images gets confused by rmail's
buffer-swapping.  (Personally, I'm using lynx, because I don't want my
email to look like a web page.  I just want to figure out what the
sender had to say.)

If the message is only HTML, it just renders it.  But if there is an
alternative text/plain part, it prefers that and you have to use the
"Show" button to get the HTML rendered.

It does not render HTML on searching, so searching looks through the
actual HTML.  Otherwise it would be very slow if you have a large mail
file.

Here is a bazaar bundle.

                                        Ken

# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: [email-masked]\
#   g3o5h6bnyg8yntf2
# target_branch: bzr://bzr.savannah.gnu.org/emacs/trunk/
# testament_sha1: dc810978fb73db2f3fdc77450d771642e5e60cfb
# timestamp: 2013-12-27 14:44:04 -0500
# source_branch: rmail
# base_revision_id: [email-masked]
# 
# Begin patch
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2013-12-27 15:43:54 +0000
+++ lisp/ChangeLog	2013-12-27 19:28:08 +0000
@@ -1,3 +1,19 @@
+2013-12-27  Ken Olum  <[email-masked]>
+
+        * mail/rmail.el (rmail-mime-process): Handle text/html
+	separately from other text/ types.  Suppress tagline for
+	multipart body.
+	(rmail-mime-parse): Don't change visibility of tagline here.
+	(rmail-mime-set-bulk-data, rmail-mime-insert-bulk):
+	Handle text/html specially.
+	(rmail-mime-render-html-function): New variable.
+	(rmail-mime-insert-html, rmail-mime-render-html-shr)
+	(rmail-mime-render-html-lynx): New functions.
+	(rmail-mime-fix-inserted-faces): New function.
+	(rmail-mime-searching): New variable.
+	(rmail-search-mime-message): Bind rmail-mime-searching to
+	suppress rendering while searching.
+
 2013-12-27  Lars Ingebrigtsen  <[email-masked]>
 
 	* net/shr.el (shr-insert): Don't infloop if the width is zero.

=== modified file 'lisp/mail/rmail.el'
--- lisp/mail/rmail.el	2013-10-30 16:29:36 +0000
+++ lisp/mail/rmail.el	2013-12-27 19:28:08 +0000
@@ -4668,7 +4668,7 @@
 
 ;;;***
 
-;;;### (autoloads nil "rmailmm" "rmailmm.el" "8c14f4cf6e7dacb0c94fd300d814caf7")
+;;;### (autoloads nil "rmailmm" "rmailmm.el" "9ac7864956507a43015757329f12895a")
 ;;; Generated autoloads from rmailmm.el
 
 (autoload 'rmail-mime "rmailmm" "\

=== modified file 'lisp/mail/rmailmm.el'
--- lisp/mail/rmailmm.el	2013-09-18 03:47:11 +0000
+++ lisp/mail/rmailmm.el	2013-12-27 19:28:08 +0000
@@ -131,6 +131,17 @@
   :version "23.2"
   :group 'rmail-mime)
 
+(defcustom rmail-mime-render-html-function
+  (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
+	((executable-find "lynx") 'rmail-mime-render-html-lynx)
+	(t nil))
+  "Function to convert HTML to text.  Called with buffer containing HTML
+extracted from message in a temporary buffer.  Converts to text in current 
+buffer. If NIL, display HTML source."
+  :group 'rmail
+  :version "24.4"
+  :type '(choice function (const nil)))
+
 ;;; End of user options.
 
 ;;; Global variables that always have let-binding when referred.
@@ -150,6 +161,10 @@
 The value is usually nil, and bound to non-nil while inserting
 MIME entities.")
 
+(defvar rmail-mime-searching nil
+  "Bound to T inside `rmail-search-mime-message' to suppress expensive 
+operations such as HTML decoding")
+
 ;;; MIME-entity object
 
 (defun rmail-mime-entity (type disposition transfer-encoding
@@ -636,6 +651,57 @@
     (insert-image (create-image data (cdr bulk-data) t))
     (insert "\n")))
 
+(defun rmail-mime-insert-html (entity)
+  "Decode, render, and insert html from MIME-entity ENTITY."
+  (let ((body (rmail-mime-entity-body entity))
+	(transfer-encoding (rmail-mime-entity-transfer-encoding entity))
+	(buffer (current-buffer)))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (setq buffer-undo-list t)
+      (insert-buffer-substring rmail-mime-mbox-buffer
+			       (aref body 0) (aref body 1))
+      (cond ((string= transfer-encoding "base64")
+	     (ignore-errors (base64-decode-region (point-min) (point-max))))
+	    ((string= transfer-encoding "quoted-printable")
+	     (quoted-printable-decode-region (point-min) (point-max))))
+      ;; Convert html in temporary buffer to text and insert in original buffer
+      (let ((source-buffer (current-buffer)))
+	(with-current-buffer buffer
+	  (let ((start (point)))
+	    (if rmail-mime-render-html-function
+		(funcall rmail-mime-render-html-function source-buffer)
+	      (insert-buffer-substring source-buffer))
+	    (rmail-mime-fix-inserted-faces start)))))))
+
+(defun rmail-mime-render-html-shr (source-buffer)
+  (let ((dom (with-current-buffer source-buffer
+	       (libxml-parse-html-region (point-min) (point-max))))
+	;; Image retrieval happens asynchronously, but meanwhile
+	;; `rmail-swap-buffers' may have been run, leaving
+	;; `shr-image-fetched' trying to insert the image in the wrong buffer.
+	(shr-inhibit-images t))
+    (shr-insert-document dom)))
+
+(defun rmail-mime-render-html-lynx (source-buffer)
+  (let ((destination-buffer (current-buffer)))
+    (with-current-buffer source-buffer
+      (call-process-region (point-min) (point-max)
+			   "lynx" nil destination-buffer nil
+			   "-stdin" "-dump" "-force_html"
+			   "-dont_wrap_pre" "-width=70"))))
+
+;; Put font-lock-face properties matching face properties on text
+;; inserted, e.g., by shr, in text from START to point.
+(defun rmail-mime-fix-inserted-faces (start)
+  (while (< start (point))
+    (let ((face (get-text-property start 'face))
+	  (next (next-single-property-change 
+		 start 'face (current-buffer) (point))))
+      (if face				; anything to do?
+	  (put-text-property start next 'font-lock-face face))
+      (setq start next))))
+    
 (defun rmail-mime-toggle-button (button)
   "Hide or show the body of the MIME-entity associated with BUTTON."
   (save-excursion
@@ -680,6 +746,8 @@
 		    (setq size (/ (* size 7) 3)))))))
 
     (cond
+     ((string-match "text/html" content-type)
+      (setq type 'html))
      ((string-match "text/" content-type)
       (setq type 'text))
      ((string-match "image/\\(.*\\)" content-type)
@@ -789,6 +857,12 @@
       (if (rmail-mime-display-body new)
 	  (cond ((eq (cdr bulk-data) 'text)
 		 (rmail-mime-insert-decoded-text entity))
+		((eq (cdr bulk-data) 'html)
+		 ;; Render HTML if display single message, but if searching
+		 ;; don't render but just search HTML itself.
+		 (if rmail-mime-searching
+		     (rmail-mime-insert-decoded-text entity)
+		   (rmail-mime-insert-html entity)))
 		((cdr bulk-data)
 		 (rmail-mime-insert-image entity))
 		(t
@@ -1119,6 +1193,8 @@
 	  (cond ((string-match "multipart/.*" (car content-type))
 		 (save-restriction
 		   (narrow-to-region (1- end) (point-max))
+		   (if (zerop (length parse-tag)) ; top level of message
+		       (aset new 1 (aset tagline 2 nil))) ; don't show tagline
 		   (setq children (rmail-mime-process-multipart
 				   content-type
 				   content-disposition
@@ -1139,6 +1215,12 @@
 		     (aset (rmail-mime-entity-tagline msg) 2 nil)
 		     (setq children (list msg)
 			   handler 'rmail-mime-insert-multipart))))
+		((and is-inline (string-match "text/html" (car content-type)))
+		 ;; Display tagline, so part can be detached
+		 (aset new 1 (aset tagline 2 t))
+		 (aset new 2 (aset body 2 t)) ; display body also.
+		 (setq handler 'rmail-mime-insert-bulk))
+		;; Inline non-HTML text
 		((and is-inline (string-match "text/" (car content-type)))
 		 ;; Don't need a tagline.
 		 (aset new 1 (aset tagline 2 nil))
@@ -1191,10 +1273,6 @@
 		   (new (aref (rmail-mime-entity-display entity) 1)))
 	      ;; Show header.
 	      (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
-	      ;; Show tagline if and only if body is not shown.
-	      (if (aref new 2)
-		  (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
-		(aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
 	      entity)))
       (error (format "%s" err)))))
 
@@ -1395,7 +1473,8 @@
   "Function to set in `rmail-search-mime-message-function' (which see)."
   (save-restriction
     (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
-    (let* ((rmail-mime-mbox-buffer (current-buffer))
+    (let* ((rmail-mime-searching t)	; mark inside search
+	   (rmail-mime-mbox-buffer (current-buffer))
 	   (rmail-mime-view-buffer rmail-view-buffer)
 	   (header-end (save-excursion
 			 (re-search-forward "^$" nil 'move) (point)))

# Begin bundle