From: dmaus <dmaus>
Date: Sun, 14 Nov 2010 13:27:58 +0000 (+0000)
Subject: mime-view.el (mime-view-type-subtype-score-alist): Accept
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8dfb6a84922fa5d37e1945b2777ace53ab87f487;p=elisp%2Fsemi.git

mime-view.el (mime-view-type-subtype-score-alist): Accept
function as an alternate of score.
(mime-view-type-subtype-score-alist): Likewise.
---

diff --git a/ChangeLog b/ChangeLog
index c62fc57..ff62bf1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2010-11-10  Kazuhiro Ito  <kzhr@d1.dion.ne.jp>
+
+	* mime-view.el (mime-view-type-subtype-score-alist): Accept
+	function as an alternate of score.
+	(mime-view-type-subtype-score-alist): Likewise.
+
 2010-10-24  Vitaly Mayatskikh  <v.mayatskih@gmail.com>
 
 	* mime-view.el (mime-save-situation-examples): Don't fail when
diff --git a/mime-view.el b/mime-view.el
index 66c8a7b..0a1654a 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -882,7 +882,8 @@ Each elements are regexp of field-name.")
     ((text . plain)    . 1)
     (t . 0))
   "Alist MEDIA-TYPE vs corresponding score.
-MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
+MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default.
+Score is integer or function which receives entity and returns integer."
   :group 'mime-view
   :type '(repeat (cons (choice :tag "Media-Type"
 			       (cons :tag "Type/Subtype"
@@ -890,7 +891,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 				     (symbol :tag "Subtype"))
 			       (symbol :tag "Type")
 			       (const :tag "Default" t))
-		       integer)))
+		       (choice (integer :tag "score")
+			       (function :tag "function")))))
 
 (defun mime-display-multipart/alternative (entity situation)
   (let* ((children (mime-entity-children entity))
@@ -925,6 +927,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 					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)