unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#4258: Feature Request - Rmail - Html
@ 2009-08-25 18:36 Marco Oliva
       [not found] ` <87hacl9ypc.fsf@gnu.org>
  0 siblings, 1 reply; 17+ messages in thread
From: Marco Oliva @ 2009-08-25 18:36 UTC (permalink / raw)
  To: bug-gnu-emacs

Please, include in rmail, support for html.

Thanks in advance.






^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: [patch] HTML mail in rmail
       [not found] ` <87hacl9ypc.fsf@gnu.org>
@ 2013-12-27 20:10   ` Ken Olum
  0 siblings, 0 replies; 17+ messages in thread
From: Ken Olum @ 2013-12-27 20:10 UTC (permalink / raw)
  To: 4258

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

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


[-- Attachment #2: html-patch.text --]
[-- Type: text/plain, Size: 13690 bytes --]

# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: kdo@cosmos.phy.tufts.edu-20131227194350-\
#   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: eggert@cs.ucla.edu-20131227191410-z9ibc5kpdv0wj3ub
# 
# 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  <kdo@cosmos.phy.tufts.edu>
+
+        * 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  <larsi@gnus.org>
 
 	* 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 @@
 
 ;;;***
 \f
-;;;### (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
IyBCYXphYXIgcmV2aXNpb24gYnVuZGxlIHY0CiMKQlpoOTFBWSZTWQ0LF3sAC83fgHwwWPf///9v
3CD////wYBO82u7u+87mm3hb3pXt6+noouwGvoroc+q++D7vi7ZzgxIPbC+YAM47lOj5K9db7YSR
EaJgjQCZqNNAMp5SNNNN6kAANDQEkgTE000ITEk8JPVHkQAyeoGgAGgBKASDSap6Gpqej1Gj1RtJ
p6nqeiMgwgyMBAEmlImkpsnqm2oGifqjah6E8oMPUaEaBkNGg0EUlNMm0mqeyk/VPakfqnpNHqae
o9QaAAAAAaBEoQCaAITRiAQ2qYyI9NRoAB6QaOGa2MDRklQs+/ghViEFRYIMgihMmsKh7up7Mvy0
7ePx5L2hNXDuP2y2MOL9G+FOAGYGXlfObne08f1pQ+hutfY6fVIbT/NI02yewPKRcPCrx1Gc+R8T
/SM2Mc4y0k3pM3F2nlPhjueTptTxZxk9/V57vNyYfPm0j72zusEltiTr7wds/e/nmgkwRYZhE46Y
QO3cukLBcs98SRFWSKnZDM8GS6WEvng0eDKEnd2NISacoxQYgpGKSlirJ044fG8oYjmGbOw63Nvf
SROwrsWp/6NkCIU8Bw6UOxuuZ8T/WnptvW4bOhWuHo1V0UB/pw4rT1trrf1/PE4J83ykFkSEHXb+
SB+ZxuC/nCMiUFS3diyjLHBmO9zxEKd9a4QO60uC9yTGEqtDkLj/TOBk7tC6KiyY1k6VFosSKTOl
2Il2NGao3JsXUmfSL0f6GZ8mGzbo7ptbS76TF7CvsnDBKesaaR6YRJZmD8t467GUy5IoNp6zh7WH
RszHDTq3tH52xf9Z9Oetc99viVvAi7FKcUhUUmef7yFlHN8kbnEiBCRdhxZWJu5Mmw2e65E44HJj
047fKWNvNblQgTl3YETJwdxylXrnnVHboVLb1eSSKQa+eekCMLctiJUtJztScyWfLPzy+TdtnDbz
LcoMd3j8Zafbd1WY12OYipE0zO62aqLatHQ1BOZulWYx2W64GvecKOuaYsG5eR5NDBcjr1gLHUp0
ichinOvY+amuV6vj4kOYBVBTLPXhbrqyKgCIKCCCeMNx8xs7pnIck8FiJOl3vq6bFAufpwfS1J0k
zKhnTLS68Fhi2mukmSYzxiqpqGajCXPLIUZgq4HfJzm3r4O8zoOeq52YRGTVnePS6Gfm3a9u7VQ0
kNHyLGWQ6Pm1CngqIjvsyJDVPRg4+ppQy54HaI0vR8MUqj05YTUk+W5z3BoOHyPeLGcqATkUyZLI
mScIAn0BPEPFfKjmtgd31dOvgbaUu1kKMkWwyj9a7mkoniaq/QPlJTOqcLLkHmFVNKIy1E8aEndZ
pHg81/TeZPoR7CoYBZHkRQqGVR96t1xuKUvKbJWSCQi9Bo235FS7LG8whfwp7L69bZ0N3FNZOzGh
k77Xyrbfw48Yw5rzVhAMmAenqSEgQNncVbCryEWDw8E+FA6XSSYlq2W6ePUuydamz4/lz4YChqZB
YG0mlyDCdlLgUNPRQSUeIN+qwvd5KkxICY11+bLNKpaRUnXPPVbbEXelTiiIu9Lw4uSZOa37jOWz
d3Z0E1i7ms1UlJtsiGwBMTOQoFJZOxWhEn3QoPiMNY06ODRbTQa143mbUdd0aZSVqJyVvJScCHMy
cNym6SFOyp6Cqv3/snOG7+niC6/dFDGWEk/WxhOST9SA7RiosxaI+EJspJADHQ3nG3hrB/bB2Xqv
xLZaE3kBAs1isr0GmxArbR2u4sF8HDl8Bbi3LDBFRSloHJK8ojs3liQIjgMQHjonKE/owK0Op/3W
p5eGm6SwASGBqGzAuaNV1buVg7U75T9tV7BFC9VBYyybQ0xEwdHGTDvBOCuJjRpg2OpX74iBTgXq
3m8w7M6mLccyAgGHwSsrpZiO3Jx5SNqzOnfxHPSmcsoESy0W62m5LWAIlIo22cQSNGGwhRdbfFYy
t3mIHtFxpTBQpluV1pOVx3vXzoXsuM1lOu/EeEnpS3lDSW9GG6FKdZU5IykFApzxxtKNFdBLtK7b
OIqJspidGHtWhsCjiuFZjBBuEYZLwa3gubg1K+WBZ6kdUrQqNaxOHpEIvnY38OUegeYO8ZmQxN7s
Xqe9C53QvgHfJRXvXKl5mbnVYgzT+a7+swZ1KE3nRAY5uQ3jCvZjIAkuIRSplE1DQL5azOpg7IVD
Zl7sklPyY2mO148aYbMXHiatN8XMtO9k5bSeUfy0g0wU0jZ8OjVfl7tfRK7iAx1ry0HkbXMdXEjJ
C+hLMHmuQz2u7ER1EoPGZnoteApY5LJV4a6dk5VM0o67XaSpSTtq7EjMHho9JydxjnTa0jIkjIw2
m5HZhK1Q6+qmu8LG06QX3BabTM8XIm0njFfjXTGnVJcewZpklzNik6bTjHJfBmeT3iNOna+jBCon
EaDQX2XNmYvcoLS5TG51ZnIWwyVLHu4yvvZKbchNrsmT6UKSrYoHcT7pIoDkh25d3eZfxBxkTbYZ
J8aW44vm+iU0LzS+CFI9jTijmNGfVzWzg8dkujA4+U/DwnEM53SBIsCBmQpNqjYapQK7VnspyZLh
3O1J6pTzlRgoHRY0rtPsLNAOFLPY7TJvcWwQJ7U14MklXbauO+c3eJQSGEVd7ZoJqamNrUEigqhx
pFIrG7jI1Midyo7b/yFI1nllfPlrpq6c6HMBgqQK3E7mKlOGniG5uZ01tMR7Bh76Ok54Z6hBJSWI
VySTOit5RcRghba5GIZ2e9Gd4lSahrg53p4DFsENAsdJxLHIFc97yg+Xnm/DqSkcdV2v+ICeQ4rw
zHqDrsFhhyGCWHqHtpiMUcBilw0QIOA6GQ2bXqZiGWYwcy9/AD4Vq+RKm+4PrtGmUZiYxU35SGUn
ePETtzjY9cYeshGLUhCHt8e8/FIFB9yi5D9j3HvDvz+T18UONSMEEBQ823iXmpezTXNVySdC9n9D
8sHZcZQzH5lwEmn/Crc4IYYBXWC5wrGr+2fpCc7DIdaSFPTjlQppLiDf2qDlGXHQFQkX8Dit/N+M
fSh/YuL05T1HKubtchVOfSonzW5l5FWRIhr+F5lx2aDgVnRX5+BZgcQZMMK0QPAWdLbBIAh2fA1L
TtP5fcdFJFAp89gpw9nib0ohMTWr9CMxRlx4UoVQ4JQOWKAZQtBxgqLPqKQHJe9MLOMp2FeP2yMh
cThYmGDpT4bsCUcTEfMdnHxnCT7/FD+EVvqxxJJLbbXmcMztc6PqaTrqdB9HlOIVivpzwqY6GxLw
4Yj7pu6zcOqXF0kC+UjIDA+pwOZg9ElqFh40RAcX5nPU5MQ9eeObvj0rnk5NUz6dCEWYr5c9270t
nq/PbWcErhwweSDq5fSbwPUaLGwsu+59flnQmMwtKHaOhmKwoZspJhm3FNsHzEXrRg4ueIGd+5xT
np5gmCQiQTjlbZt4ilumw05qQryHXslTHbVnE5EqqqJZAUY7epKjr3QDhxjF6i74wAa2wUPFdToa
HJqnlWcav62XiHp2PmazzDxR7ZSpU2nsU8MFuTAJ4iLllVpbvzNi6gAZXx0aq3rVCzvWv4bjOnqy
LXFycknY2zSFYA7dA4RUSQYEo1HO75UK3BbYLKJXgMKHdLCgjUMgDvK2txuhvO7uOZxenqVY4tQ7
ZdsOukeXZTlqdm+0ro1tmH3HcMusvLiEPWjWiKIJhm2jMDDq/VpQ4gtMRtjSWoTl1PXdjw+OgWeu
/JXAgKa71AAWJLqK/D8PHQyo0pKQrtOx8HiLIKY3k2MtZHoKKMqXcLKu9hKVm63q36RO8+Xe0wst
8JSl/IpAt2o2B/aUTcHTQhdXan7mEqBkT+XBmh5BCyBr1N+SPgOkDvkgd0EpAgkAnt1G+74Bnffr
ial0gPIYGQFY+zxJdK1He1OKBobhyAhDGuZUMDuyMKqnoD5By6cywwMwzCRztFT79Y5ac3BrN8W5
7qlkG89HnLf4UwLXkeA5zPVBCfyKLElNPdtOev9tm8hBnV1UiyljPS5deTMu14GKm5WIPgEE2HvM
eOXapZQPoR+aeCckyDd5+lgtF7RgGQi0HkHS4uhCvZiA987ZQ9KFH7MQ3hUvlwUaQkUkEL6HrGum
Y8YkC4sOB97aDtu+L7Ee19I+pIBM18ApWwpzo/KFAsGdX1rW2mgXLaGc/EzQuXMebWTJc0GRQj2x
F4lHQOldqNgYunsqHr4EsJZhRVgsYBQnFmoAkbcrMw3BIh7Qj4uw7IsAHc8UkEoPsgOK5mr3iBqD
mjYDWwei4z/X8RDmh5Nx7zN4RqbiB7Cla0JDqOHGcE5lFpGPYDeW+ofSO0eRnOYQkaDIgRy3gPDd
8oEp2a9qYdg5Xxc+xiV54Pij5LmlixhusKQc1phdaWpa0u86awcdwcdMORLQpQZQS3uSbg5SBzzn
nVl5EHmnLjBRx1qURByWNAoWRABMJRjA77LAPt8qpeNQHkPm3BivLIDqnnPBrConu7TZUfXhALa0
+ni59UCSdnbnd9YQ9oygyoO9LjQ2Xr9DgU3DDFf+rsx6y/PUhjsgxDyEglUfsfrR9/E2n3Ee/QIo
nKCHFpRcylBoFCFwgWSprCxPKNyDUUNR9yh6yJwB4DxEXPlsHRSh8F0/jxcgNt6zGGQVLVkZalAg
SxAD6Xx2rVS7gkL8B+oyCoFry5KVghYWrUqhYb075KqVIoXDC+ajehTAJ1TC2tDYriULkDII1rCj
BaFAKEiUoR0CoHRYIWiBgNBC5vL09AU2+qJzieih1OD4hxVuUWxtIU9gNb3RDIfXJcvIFcq9CuLK
wdgewV6CtucRzuYQpj3CkSYiRzEnD0JtaTVebpElAQYx6/agrghTzUiG0RbBFuKul4eGvIC0xaXO
QHBXKIsqjEgYs2bRkkIGxljFKm94grwOTBG0HPiIv0al2qWWE7i8OXM3BSXjJ0b1575SMgkkkfGF
nckjOjTmk5ppOygbmj8ibVGGQwFJIEAuYBsvEO4aB6amF3QCtUdV51uscU5kEnghUFvanQfSNFMU
MQsXlOvUu3rQyQ4Dq6GJ93XOoltUWMW21lFPgpv7QkNowuIFSGqPguwz9gGpuN++9Tj7upC2kOQE
71oFIRhCEBax4PA2hr92BgIWNKI4G6GAztBnnnHh4vNCYQlaFIhLvFgHzg6mxUwHMNhue9kSX/bx
2oF4HdhAqHpa3QkkIB2JlVneYGgcsm6+1lS2CbE5wkJCQJCczmIuWpDSQhlIu8A0XTG1hub4SWeR
uIPUkEiQ0G2ebpckLg+BpcdoJnEGc8cesYXaBh73uUgcXrNmaBA0TNRk02fAqngOqEiUHfBLm2dW
o3jeNUqJKkLXa4jbIW8uJTLwyHr0DkYaaGh0GjWEIHnIJwG4LfMweEQrfMTp2A6AsGopDM0bAeYC
ZKqTkYUghUQ5BysdOVi8eLheO3ziLOVkCDSbhFkUEDEX1TI6h0EFhGs05O5c68jafFrTaO18pioE
EWBvHqXs9RRfJncGJE/NlszNEJl9xDPcukAMSDODmaH/ZA84XlqsWxC7l5DjvPkr3ZF28Q7o1L7K
m8IHAhIcjRwO/DVEg8jjgriu6lowVtJsapQxIvcnCbRYRF8pL2QyRHIBA5R0N997jGws7CRBMswq
UyEELhl9fUIth6gTscPtkkmD0R5BgetxPiGibGttSa6p99HJv4RywH/i7kinChIBoWLvYA==

^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
       [not found] <q5238csecdk.fsf@cosmos.phy.tufts.edu>
@ 2014-08-20 14:19 ` Stefan Monnier
  2014-08-20 14:48   ` Eli Zaretskii
  0 siblings, 1 reply; 17+ messages in thread
From: Stefan Monnier @ 2014-08-20 14:19 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258

> The main thing that I've been trying to contribute (besides
> miscellaneous small enhancements and bug fixes) is some code for HTML
> rendering in rmail.  The patch is in
> http://debbugs.gnu.org/cgi/bugreport.cgi?bug=4258 already.

Oh, right I see it.  Hmm... it seems noone has reviewed it.
The patch looks fairly good to me, but not knowing much if anything
about Rmail's rendering, I'd appreciate some comment from someone a bit
more familiar with this code.

> I guess in addition to the now completed legal paperwork it is waiting
> for the freeze to be lifted.

The freeze was lifted several months ago already,


        Stefan





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
  2014-08-20 14:19 ` bug#4258: Your Emacs contributions Stefan Monnier
@ 2014-08-20 14:48   ` Eli Zaretskii
  2014-08-26 18:45     ` Eli Zaretskii
  0 siblings, 1 reply; 17+ messages in thread
From: Eli Zaretskii @ 2014-08-20 14:48 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 4258, kdo

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Wed, 20 Aug 2014 10:19:33 -0400
> Cc: 4258@debbugs.gnu.org
> 
> > The main thing that I've been trying to contribute (besides
> > miscellaneous small enhancements and bug fixes) is some code for HTML
> > rendering in rmail.  The patch is in
> > http://debbugs.gnu.org/cgi/bugreport.cgi?bug=4258 already.
> 
> Oh, right I see it.  Hmm... it seems noone has reviewed it.

I did.

> The patch looks fairly good to me, but not knowing much if anything
> about Rmail's rendering, I'd appreciate some comment from someone a bit
> more familiar with this code.

I plan on starting to use it soon, and if it does a good job, I will
commit it.

Thanks for your contribution, Ken, and sorry for being so slow in
installing it.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
  2014-08-20 14:48   ` Eli Zaretskii
@ 2014-08-26 18:45     ` Eli Zaretskii
  2014-08-27 14:30       ` Ken Olum
  2014-08-28 15:18       ` Eli Zaretskii
  0 siblings, 2 replies; 17+ messages in thread
From: Eli Zaretskii @ 2014-08-26 18:45 UTC (permalink / raw)
  To: kdo; +Cc: 4258

> Date: Wed, 20 Aug 2014 17:48:15 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: 4258@debbugs.gnu.org, kdo@cosmos.phy.tufts.edu
> 
> I plan on starting to use it soon, and if it does a good job, I will
> commit it.

So far it looks very good, but I do have one question: when a mail has
both a text and an HTML form, is there any way to show HTML in
preference to text, rather than the other way around?  I think HTML
should be the default with this patch installed.

Thanks.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
  2014-08-26 18:45     ` Eli Zaretskii
@ 2014-08-27 14:30       ` Ken Olum
  2014-08-27 14:58         ` Eli Zaretskii
  2014-08-28 15:18       ` Eli Zaretskii
  1 sibling, 1 reply; 17+ messages in thread
From: Ken Olum @ 2014-08-27 14:30 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 4258

   From: Eli Zaretskii <eliz@gnu.org>
   Date: Tue, 26 Aug 2014 21:45:33 +0300

   ...when a mail has both a text and an HTML form, is there any way to
   show HTML in preference to text, rather than the other way around?  I
   think HTML should be the default with this patch installed.

Not at the moment, but I agree there should be.  Sometimes you get
messages with text segments that say "go read the html instead" and even
when the text is a converted copy of the HTML it is often inferior to
what you could get by rendering it yourself.  On the other hand, this
seems like it should be a user preference, so how about a switch
rmail-mime-prefer-html?

Would you like a second patch to add this functionality or a new patch
including what I sent before with this enhancement?

                                        Ken





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
  2014-08-27 14:30       ` Ken Olum
@ 2014-08-27 14:58         ` Eli Zaretskii
  0 siblings, 0 replies; 17+ messages in thread
From: Eli Zaretskii @ 2014-08-27 14:58 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258

> From: Ken Olum <kdo@cosmos.phy.tufts.edu>
> Cc: monnier@iro.umontreal.ca, 4258@debbugs.gnu.org
> Date: Wed, 27 Aug 2014 10:30:06 -0400
> 
> how about a switch rmail-mime-prefer-html?

Fine with me.

> Would you like a second patch to add this functionality or a new patch
> including what I sent before with this enhancement?

Whatever is easier for you, I will cope with either.

Thanks.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Your Emacs contributions
  2014-08-26 18:45     ` Eli Zaretskii
  2014-08-27 14:30       ` Ken Olum
@ 2014-08-28 15:18       ` Eli Zaretskii
  2014-09-04 15:52         ` bug#4258: Preferring HTML parts Ken Olum
  1 sibling, 1 reply; 17+ messages in thread
From: Eli Zaretskii @ 2014-08-28 15:18 UTC (permalink / raw)
  To: kdo; +Cc: 4258

> Date: Tue, 26 Aug 2014 21:45:33 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: 4258@debbugs.gnu.org
> 
> So far it looks very good

Here's one problem I found: if the HTML includes non-ASCII characters
(in the case I saw, the entire HTML part was quoted-printable
encoded), Rmail shows the HTML, but does not decode the non-ASCII
text.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-08-28 15:18       ` Eli Zaretskii
@ 2014-09-04 15:52         ` Ken Olum
  2014-09-04 16:28           ` Stefan Monnier
  2014-09-06 15:19           ` Eli Zaretskii
  0 siblings, 2 replies; 17+ messages in thread
From: Ken Olum @ 2014-09-04 15:52 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 4258

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

Here's a patch with all my HTML rendering code, including preferring to
render an html part rather than showing the alternative text part, if
the variable rmail-mime-prefer-html is set, which is the default.

I don't know too much about non-ASCII characters, so maybe this patch
could be installed and someone who knows what they're doing could try to
address that issue.

                                        Ken


[-- Attachment #2: html-patch-new.text --]
[-- Type: text/plain, Size: 10157 bytes --]

*** trunk/lisp/ChangeLog	2014-08-27 13:46:08.509697000 -0400
--- new/lisp/ChangeLog	2014-09-04 11:40:20.490492186 -0400
***************
*** 1,3 ****
--- 1,21 ----
+ 2013-12-27  Ken Olum  <kdo@cosmos.phy.tufts.edu>
+ 
+ 	* mail/rmailmm.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,rmail-mime-prefer-html): New variables.
+ 	(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-process-multipart): Find best part to show
+ 	following rmail-mime-prefer-html if set.
+ 	(rmail-mime-searching): New variable.
+ 	(rmail-search-mime-message): Bind rmail-mime-searching to
+ 	suppress rendering while searching.
+ 
  2014-08-27  Dmitry Antipov  <dmantipov@yandex.ru>
  
  	* startup.el (normal-top-level): Now use internal--top-level-message.
*** trunk/lisp/mail/rmailmm.el	2014-05-21 12:32:30.125349000 -0400
--- new/lisp/mail/rmailmm.el	2014-08-28 13:52:36.835398492 -0400
***************
*** 131,136 ****
--- 131,155 ----
    :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.5"
+   :type '(choice function (const nil)))
+ 
+ (defcustom rmail-mime-prefer-html
+   t
+   "If non-nil, default to showing HTML part rather than text part
+ when both are available"
+   :group 'rmail
+   :version "24.5"
+   :type 'boolean)
+ 
  ;;; End of user options.
  
  ;;; Global variables that always have let-binding when referred.
***************
*** 150,155 ****
--- 169,178 ----
  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
***************
*** 631,636 ****
--- 654,710 ----
      (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
***************
*** 675,680 ****
--- 749,756 ----
  		    (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)
***************
*** 784,789 ****
--- 860,871 ----
        (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
***************
*** 918,935 ****
        (setq entities (nreverse entities))
        (if (string-match "alternative" subtype)
  	  ;; Find the best entity to show, and hide all the others.
! 	  (let (best second)
  	    (dolist (child entities)
  	      (if (string= (or (car (rmail-mime-entity-disposition child))
  			       (car content-disposition))
  			   "inline")
! 		  (if (string-match "text/plain"
! 				    (car (rmail-mime-entity-type child)))
! 		      (setq best child)
! 		    (if (string-match "text/.*"
! 				      (car (rmail-mime-entity-type child)))
! 			(setq second child)))))
! 	    (or best (not second) (setq best second))
  	    (dolist (child entities)
  	      (unless (eq best child)
  		(aset (rmail-mime-entity-body child) 2 nil)
--- 1000,1027 ----
        (setq entities (nreverse entities))
        (if (string-match "alternative" subtype)
  	  ;; Find the best entity to show, and hide all the others.
! 	  ;; If rmail-mime-prefer-html is set, html is best, then plain.
! 	  ;; If not, plain is best, then html.
! 	  ;; Then comes any other text part.
! 	  ;; If thereto of the same type, earlier entities in the message (later
! 	  ;; in the reverse list) are preferred.
! 	  (let (best best-priority)
  	    (dolist (child entities)
  	      (if (string= (or (car (rmail-mime-entity-disposition child))
  			       (car content-disposition))
  			   "inline")
! 		  (let ((type (car (rmail-mime-entity-type child))))
! 		    (if (string-match "text/" type)
! 			;; Consider all inline text parts
! 			(let ((priority
! 			       (cond ((string-match "text/html" type)
! 				      (if rmail-mime-prefer-html 1 2))
! 				     ((string-match "text/plain" type)
! 				      (if rmail-mime-prefer-html 2 1))
! 				     (t 3))))
! 			  (if (or (null best) (<= priority best-priority))
! 			      (setq best child
! 				    best-priority priority)))))))
  	    (dolist (child entities)
  	      (unless (eq best child)
  		(aset (rmail-mime-entity-body child) 2 nil)
***************
*** 1114,1119 ****
--- 1206,1213 ----
  	  (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
***************
*** 1134,1139 ****
--- 1228,1239 ----
  		     (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))
***************
*** 1186,1195 ****
  		   (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)))))
  
--- 1286,1291 ----
***************
*** 1390,1396 ****
    "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))
  	   (rmail-mime-view-buffer rmail-view-buffer)
  	   (header-end (save-excursion
  			 (re-search-forward "^$" nil 'move) (point)))
--- 1486,1493 ----
    "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-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)))

^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-04 15:52         ` bug#4258: Preferring HTML parts Ken Olum
@ 2014-09-04 16:28           ` Stefan Monnier
  2014-09-04 17:59             ` Ken Olum
  2014-09-06 15:19           ` Eli Zaretskii
  1 sibling, 1 reply; 17+ messages in thread
From: Stefan Monnier @ 2014-09-04 16:28 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258

> + (defcustom rmail-mime-prefer-html
> +   t

We should only prefer html if we have a renderer (i.e. if
rmail-mime-render-html-function is non-nil).

I skipped the rest of the patch since I'm not familiar with Rmail and
even less with Rmail's MIME handling.


        Stefan





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-04 16:28           ` Stefan Monnier
@ 2014-09-04 17:59             ` Ken Olum
  2014-09-04 20:27               ` Stefan Monnier
  0 siblings, 1 reply; 17+ messages in thread
From: Ken Olum @ 2014-09-04 17:59 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 4258

Good point.  I can't see why anyone would ever want to preferentially
display the unrendered html, so I think if
rmail-mime-render-html-function is nil we should ignore
rmail-mime-prefer-html and always prefer plain text.  I'll send a new
patch after I see if anyone else has comments.

                                        Ken





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-04 17:59             ` Ken Olum
@ 2014-09-04 20:27               ` Stefan Monnier
  0 siblings, 0 replies; 17+ messages in thread
From: Stefan Monnier @ 2014-09-04 20:27 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258

> Good point.  I can't see why anyone would ever want to preferentially
> display the unrendered html,

Maybe that's just a lack of imagination.  FWIW I used to do just that
(and then manually pipe the text through some external html2txt filter).

> so I think if rmail-mime-render-html-function is nil we should ignore
> rmail-mime-prefer-html and always prefer plain text.

I think it's simpler to default to nil if
rmail-mime-render-html-function is nil, but still obey
rmail-mime-prefer-html if the user set it to t.  No need to second guess
the user.


        Stefan





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-04 15:52         ` bug#4258: Preferring HTML parts Ken Olum
  2014-09-04 16:28           ` Stefan Monnier
@ 2014-09-06 15:19           ` Eli Zaretskii
  2014-09-07  0:11             ` Ken Olum
  1 sibling, 1 reply; 17+ messages in thread
From: Eli Zaretskii @ 2014-09-06 15:19 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258

> From: Ken Olum <kdo@cosmos.phy.tufts.edu>
> Cc: 4258@debbugs.gnu.org
> Date: Thu, 04 Sep 2014 11:52:04 -0400
> 
> Here's a patch with all my HTML rendering code, including preferring to
> render an html part rather than showing the alternative text part, if
> the variable rmail-mime-prefer-html is set, which is the default.

Thanks.  I started using it, and so far the results are very good.

> I don't know too much about non-ASCII characters, so maybe this patch
> could be installed and someone who knows what they're doing could try to
> address that issue.

I did that as well.

So when you send a new patch, I will commit it together with my
additions for decoding non-ASCII HTML text.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-06 15:19           ` Eli Zaretskii
@ 2014-09-07  0:11             ` Ken Olum
  2014-09-13  9:29               ` Eli Zaretskii
  0 siblings, 1 reply; 17+ messages in thread
From: Ken Olum @ 2014-09-07  0:11 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 4258

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

OK, here is a new version of the patch including the change to only
default rmail-mime-prefer-html to t if we have a renderer.

                                  Ken


[-- Attachment #2: html-patch-new.text --]
[-- Type: text/plain, Size: 10248 bytes --]

*** trunk/lisp/ChangeLog	2014-08-27 13:46:08.509697000 -0400
--- new/lisp/ChangeLog	2014-09-04 11:40:20.490492186 -0400
***************
*** 1,3 ****
--- 1,21 ----
+ 2013-12-27  Ken Olum  <kdo@cosmos.phy.tufts.edu>
+ 
+ 	* mail/rmailmm.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,rmail-mime-prefer-html): New variables.
+ 	(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-process-multipart): Find best part to show
+ 	following rmail-mime-prefer-html if set.
+ 	(rmail-mime-searching): New variable.
+ 	(rmail-search-mime-message): Bind rmail-mime-searching to
+ 	suppress rendering while searching.
+ 
  2014-08-27  Dmitry Antipov  <dmantipov@yandex.ru>
  
  	* startup.el (normal-top-level): Now use internal--top-level-message.
*** trunk/lisp/mail/rmailmm.el	Wed May 21 12:32:30 2014
--- new/lisp/mail/rmailmm.el	Fri Sep  5 12:00:31 2014
***************
*** 131,136 ****
--- 131,156 ----
    :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.5"
+   :type '(choice function (const nil)))
+ 
+ (defcustom rmail-mime-prefer-html
+   ;; Default to preferring HTML parts, but only if we have a renderer
+   (if rmail-mime-render-html-function t nil)
+   "If non-nil, default to showing HTML part rather than text part
+ when both are available"
+   :group 'rmail
+   :version "24.5"
+   :type 'boolean)
+ 
  ;;; End of user options.
  
  ;;; Global variables that always have let-binding when referred.
***************
*** 150,155 ****
--- 170,179 ----
  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
***************
*** 631,636 ****
--- 655,711 ----
      (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
***************
*** 675,680 ****
--- 750,757 ----
  		    (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)
***************
*** 784,789 ****
--- 861,872 ----
        (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
***************
*** 918,935 ****
        (setq entities (nreverse entities))
        (if (string-match "alternative" subtype)
  	  ;; Find the best entity to show, and hide all the others.
! 	  (let (best second)
  	    (dolist (child entities)
  	      (if (string= (or (car (rmail-mime-entity-disposition child))
  			       (car content-disposition))
  			   "inline")
! 		  (if (string-match "text/plain"
! 				    (car (rmail-mime-entity-type child)))
! 		      (setq best child)
! 		    (if (string-match "text/.*"
! 				      (car (rmail-mime-entity-type child)))
! 			(setq second child)))))
! 	    (or best (not second) (setq best second))
  	    (dolist (child entities)
  	      (unless (eq best child)
  		(aset (rmail-mime-entity-body child) 2 nil)
--- 1001,1028 ----
        (setq entities (nreverse entities))
        (if (string-match "alternative" subtype)
  	  ;; Find the best entity to show, and hide all the others.
! 	  ;; If rmail-mime-prefer-html is set, html is best, then plain.
! 	  ;; If not, plain is best, then html.
! 	  ;; Then comes any other text part.
! 	  ;; If thereto of the same type, earlier entities in the message (later
! 	  ;; in the reverse list) are preferred.
! 	  (let (best best-priority)
  	    (dolist (child entities)
  	      (if (string= (or (car (rmail-mime-entity-disposition child))
  			       (car content-disposition))
  			   "inline")
! 		  (let ((type (car (rmail-mime-entity-type child))))
! 		    (if (string-match "text/" type)
! 			;; Consider all inline text parts
! 			(let ((priority
! 			       (cond ((string-match "text/html" type)
! 				      (if rmail-mime-prefer-html 1 2))
! 				     ((string-match "text/plain" type)
! 				      (if rmail-mime-prefer-html 2 1))
! 				     (t 3))))
! 			  (if (or (null best) (<= priority best-priority))
! 			      (setq best child
! 				    best-priority priority)))))))
  	    (dolist (child entities)
  	      (unless (eq best child)
  		(aset (rmail-mime-entity-body child) 2 nil)
***************
*** 1114,1119 ****
--- 1207,1214 ----
  	  (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
***************
*** 1134,1139 ****
--- 1229,1240 ----
  		     (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))
***************
*** 1186,1195 ****
  		   (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)))))
  
--- 1287,1292 ----
***************
*** 1390,1396 ****
    "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))
  	   (rmail-mime-view-buffer rmail-view-buffer)
  	   (header-end (save-excursion
  			 (re-search-forward "^$" nil 'move) (point)))
--- 1487,1494 ----
    "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-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)))

^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-07  0:11             ` Ken Olum
@ 2014-09-13  9:29               ` Eli Zaretskii
  2014-09-13 16:44                 ` Glenn Morris
  0 siblings, 1 reply; 17+ messages in thread
From: Eli Zaretskii @ 2014-09-13  9:29 UTC (permalink / raw)
  To: Ken Olum; +Cc: 4258-done

> From: Ken Olum <kdo@cosmos.phy.tufts.edu>
> Cc: 4258@debbugs.gnu.org
> Date: Sat, 06 Sep 2014 20:11:03 -0400
> 
> OK, here is a new version of the patch including the change to only
> default rmail-mime-prefer-html to t if we have a renderer.

Thanks.  Installed as trunk revision 117871.

I followed up with 2 additional commits: one to decode the HTML using
the transfer-encoding specified by the mail message, and another to
bind shr-width to nil during HTML rendering, so that the rendered
lines are not broken too early (which screws up display of many HTML
messages, e.g., the parts that cite messages being replied to).

Thank you for all your hard work.  I'm now closing this bug.





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-13  9:29               ` Eli Zaretskii
@ 2014-09-13 16:44                 ` Glenn Morris
  2014-09-13 19:03                   ` Eli Zaretskii
  0 siblings, 1 reply; 17+ messages in thread
From: Glenn Morris @ 2014-09-13 16:44 UTC (permalink / raw)
  To: 4258; +Cc: marcooliva


Worth a mention in NEWS?





^ permalink raw reply	[flat|nested] 17+ messages in thread

* bug#4258: Preferring HTML parts
  2014-09-13 16:44                 ` Glenn Morris
@ 2014-09-13 19:03                   ` Eli Zaretskii
  0 siblings, 0 replies; 17+ messages in thread
From: Eli Zaretskii @ 2014-09-13 19:03 UTC (permalink / raw)
  To: Glenn Morris; +Cc: marcooliva, 4258

> From: Glenn Morris <rgm@gnu.org>
> Cc: eliz@gnu.org,  marcooliva@sapo.pt
> Date: Sat, 13 Sep 2014 12:44:59 -0400
> 
> 
> Worth a mention in NEWS?

Definitely; done.

Thanks.





^ permalink raw reply	[flat|nested] 17+ messages in thread

end of thread, other threads:[~2014-09-13 19:03 UTC | newest]

Thread overview: 17+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2009-08-25 18:36 bug#4258: Feature Request - Rmail - Html Marco Oliva
     [not found] ` <87hacl9ypc.fsf@gnu.org>
2013-12-27 20:10   ` bug#4258: [patch] HTML mail in rmail Ken Olum
     [not found] <q5238csecdk.fsf@cosmos.phy.tufts.edu>
2014-08-20 14:19 ` bug#4258: Your Emacs contributions Stefan Monnier
2014-08-20 14:48   ` Eli Zaretskii
2014-08-26 18:45     ` Eli Zaretskii
2014-08-27 14:30       ` Ken Olum
2014-08-27 14:58         ` Eli Zaretskii
2014-08-28 15:18       ` Eli Zaretskii
2014-09-04 15:52         ` bug#4258: Preferring HTML parts Ken Olum
2014-09-04 16:28           ` Stefan Monnier
2014-09-04 17:59             ` Ken Olum
2014-09-04 20:27               ` Stefan Monnier
2014-09-06 15:19           ` Eli Zaretskii
2014-09-07  0:11             ` Ken Olum
2014-09-13  9:29               ` Eli Zaretskii
2014-09-13 16:44                 ` Glenn Morris
2014-09-13 19:03                   ` Eli Zaretskii

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).