Re: Annoying HTML emails

[Kazuhiro Ito <kzhr@d1.dion.ne.jp>]

> A service I use (codebasehq) sends me messages that look like this:
> 
>   [1  <text/plain; utf-8 (quoted-printable)>]
>   You need HTML email enabled to view this message.
>   [2  <text/html; utf-8 (quoted-printable)>]
>   ...interesting content here...
> 
> Infuriating, of course.  Is there any way I can make WL smart enough
> to show me the HTML parts of these message by default?

As I wrote previously (*1), I write below code in my ~/.emacs.  This
code makes text/html entity to be displayed when alternate text/plain
entity does not exist.

(*1) http://thread.gmane.org/gmane.mail.wanderlust.general.japanese/8021/focus=8026

(eval-after-load "mime-view"
  '(progn
     (autoload 'mime-w3m-preview-text/html "mime-w3m")
     (ctree-set-calist-strictly
      'mime-preview-condition
      '((type . text)
	(subtype . html)
	(body . visible)
	(body-presentation-method . mime-w3m-preview-text/html)))
     (set-alist 'mime-view-type-subtype-score-alist
		'(text . html) 3)
     (set-alist 'mime-view-type-subtype-score-alist
		'(text . plain) 4)))


And, I tried writing a code to make the score of garbage text/plain
part lower.

(eval-after-load "mime-view"
  ;; For hiding garbage alternate text/plain part.
  '(progn
     (defun mime-display-multipart/alternative (entity situation)
       (let* ((children (mime-entity-children entity))
	      (original-major-mode-cell (assq 'major-mode situation))
	      (default-situation
		(cdr (assq 'childrens-situation situation)))
	      (i 0)
	      (p 0)
	      (max-score 0)
	      situations)
	 (if original-major-mode-cell
	     (setq default-situation
		   (cons original-major-mode-cell default-situation)))
	 (setq situations
	       (mapcar (function
			(lambda (child)
			  (let ((situation
				 (mime-find-entity-preview-situation
				  child default-situation)))
			    (if (cdr (assq 'body-presentation-method situation))
				(let ((score
				       (cdr
					(or (assoc
					     (cons
					      (cdr (assq 'type situation))
					      (cdr (assq 'subtype situation)))
					     mime-view-type-subtype-score-alist)
					    (assq
					     (cdr (assq 'type situation))
					     mime-view-type-subtype-score-alist)
					    (assq
					     t
					     mime-view-type-subtype-score-alist)
					    ))))
				  (when (functionp score)
				    (setq score (funcall score child)))
				  (if (> score max-score)
				      (setq p i
					    max-score score)
				    )))
			    (setq i (1+ i))
			    situation)
			  ))
		       children))
	 (setq i 0)
	 (while children
	   (let ((child (car children))
		 (situation (car situations)))
	     (mime-display-entity child (if (= i p)
					    situation
					  (put-alist 'body 'invisible
						     (copy-alist situation)))))
	   (setq children (cdr children)
		 situations (cdr situations)
		 i (1+ i)))))

     (defun mime-entity-text/plain-score (entity)
       (let ((content (decode-mime-charset-string
		       (mime-entity-content entity)
		       (or (mime-content-type-parameter
			    (mime-entity-content-type entity)
			    "charset")
			   default-mime-charset)
		       'CRLF)))
	 ;; Modify as you like.
	 (if (and (< (length content) 80)
		  (string-match "\\`[^\n]*[hH][tT][mM][lL][^\n]*\n*\\'"
				content))
	     1 4)))

     (set-alist 'mime-view-type-subtype-score-alist
		'(text . plain) 'mime-entity-text/plain-score)))

-- 
Kazuhiro Ito