From: Ken Olum <kdo@cosmos.phy.tufts.edu>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 4258@debbugs.gnu.org
Subject: bug#4258: Preferring HTML parts
Date: Thu, 04 Sep 2014 11:52:04 -0400 [thread overview]
Message-ID: <q52fvg79ye3.fsf@cosmos.phy.tufts.edu> (raw)
In-Reply-To: <83y4u8iqx0.fsf@gnu.org> (message from Eli Zaretskii on Thu, 28 Aug 2014 18:18:19 +0300)
[-- 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)))
next prev parent reply other threads:[~2014-09-04 15:52 UTC|newest]
Thread overview: 25+ messages / expand[flat|nested] mbox.gz Atom feed top
[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 ` Ken Olum [this message]
2014-09-04 16:28 ` bug#4258: Preferring HTML parts 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
2013-10-11 20:21 HTML mail in rmail Ken Olum
2013-10-11 20:33 ` Eli Zaretskii
2013-10-13 11:50 ` Kenichi Handa
2013-12-27 20:10 ` [patch] " Ken Olum
2014-01-07 19:15 ` Glenn Morris
2014-01-07 20:08 ` joakim
2013-12-27 20:10 ` bug#4258: " Ken Olum
2013-10-11 22:58 ` Richard Stallman
2013-10-12 1:36 ` Stephen J. Turnbull
-- strict thread matches above, loose matches on Subject: below --
2009-08-25 18:36 bug#4258: Feature Request - Rmail - Html Marco Oliva
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=q52fvg79ye3.fsf@cosmos.phy.tufts.edu \
--to=kdo@cosmos.phy.tufts.edu \
--cc=4258@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.