[RFC][PATCH v1] Allow content preference based on message content.

[RFC][PATCH v1] Allow content preference based on message content.

[David Edmondson]

Previously in #notmuch we discussed how it would be convenient to
control part preferences on the basis of message attributes. This
patch is an attempt to provide that.

My own setting for `notmuch-multipart/alternative-discouraged' is:

(setq notmuch-multipart/alternative-discouraged
    '(cond
      ((string-match "9195404@capita-intouch.co.uk" from)
       '("text/plain"))
      (t
       '("text/html" "multipart/related"))))

That is, discourage text/plain and multipart/related unless the
message is sent from 9195404@capita-intouch.co.uk, in which case
discourage text/plain (which for this sender is always another copy of
the HTML content, as HTML).

David Edmondson (1):
  emacs: Allow part preferences to depend on message content.

 emacs/notmuch-lib.el  | 39 +++++++++++++++++++++++++++++++++++----
 emacs/notmuch-mua.el  |  2 +-
 emacs/notmuch-show.el |  2 +-
 3 files changed, 37 insertions(+), 6 deletions(-)

-- 
2.2.0

[PATCH v1] emacs: Allow part preferences to depend on message content.

[David Edmondson]

Currently the preference for which sub-part of a multipart/alternative
part is shown is global. Allow to the user to override the settings on a
per-message basis by providing two new options:

  - the ability to call a function that has access to the message to
    return the discouraged type list,
  - a simple evaluation environment to reduce the need for most users to
    write their own function.

The original approach is retained as the default.
---
 emacs/notmuch-lib.el  | 39 +++++++++++++++++++++++++++++++++++----
 emacs/notmuch-mua.el  |  2 +-
 emacs/notmuch-show.el |  2 +-
 3 files changed, 37 insertions(+), 6 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 89c01a5..2b9d108 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -520,11 +520,42 @@ This replaces spaces, percents, and double quotes in STR with
     "multipart/related"
     ))
 
-(defun notmuch-multipart/alternative-choose (types)
-  "Return a list of preferred types from the given list of types"
+(defun notmuch-multipart/alternative-determine-discouraged-1 (msg directive)
+  (let* ((headers (plist-get msg :headers))
+	 ;; Headers that we make available:
+	 (from (plist-get headers :From))
+	 (subject (plist-get headers :Subject))
+	 (to (plist-get headers :To))
+	 (cc (plist-get headers :Cc)))
+
+    (eval directive)))
+
+(defun notmuch-multipart/alternative-determine-discouraged (msg)
+  "Return the discouraged alternatives for the specified message."
+  (cond
+   ;; If a function, return the result of calling it.
+   ((functionp notmuch-multipart/alternative-discouraged)
+    (funcall notmuch-multipart/alternative-discouraged msg))
+
+   ;; If the first element is a string, return the list. This matches
+   ;; with the default setting of
+   ;; `notmuch-multipart/alternative-discouraged'.
+   ((and (listp notmuch-multipart/alternative-discouraged)
+	 (stringp (car notmuch-multipart/alternative-discouraged)))
+    notmuch-multipart/alternative-discouraged)
+
+   ;; New style pattern matcher.
+   (t
+    (notmuch-multipart/alternative-determine-discouraged-1
+     msg notmuch-multipart/alternative-discouraged))))
+
+(defun notmuch-multipart/alternative-choose (msg types)
+  "Return a list of preferred types from the given list of types
+for this message, if present."
   ;; Based on `mm-preferred-alternative-precedence'.
-  (let ((seq types))
-    (dolist (pref (reverse notmuch-multipart/alternative-discouraged))
+  (let ((discouraged (notmuch-multipart/alternative-determine-discouraged msg))
+	(seq types))
+    (dolist (pref (reverse discouraged))
       (dolist (elem (copy-sequence seq))
 	(when (string-match pref elem)
 	  (setq seq (nconc (delete elem seq) (list elem))))))
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 5462f54..8244258 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -147,7 +147,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
 	if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative")
 	  collect (let* ((subparts (plist-get part :content))
 			(types (mapcar (lambda (part) (plist-get part :content-type)) subparts))
-			(chosen-type (car (notmuch-multipart/alternative-choose types))))
+			(chosen-type (car (notmuch-multipart/alternative-choose nil types))))
 		   (loop for part in (reverse subparts)
 			 if (notmuch-match-content-type (plist-get part :content-type) chosen-type)
 			 return part))
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 3345878..2ec30a8 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -612,7 +612,7 @@ will return nil if the CID is unknown or cannot be retrieved."
 	  (plist-get part :content)))
 
 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
-  (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+  (let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part))))
 	(inner-parts (plist-get part :content))
 	(start (point)))
     ;; This inserts all parts of the chosen type rather than just one,
-- 
2.6.3

Re: [PATCH v1] emacs: Allow part preferences to depend on message content.

[Aaron Ecay]

Hi David,

2016ko urtarrilak 15an, David Edmondson-ek idatzi zuen:
> 
> Currently the preference for which sub-part of a multipart/alternative
> part is shown is global. Allow to the user to override the settings on a
> per-message basis by providing two new options:
> 
>   - the ability to call a function that has access to the message to
>     return the discouraged type list,
>   - a simple evaluation environment to reduce the need for most users to
>     write their own function.
> 
> The original approach is retained as the default.
> ---
>  emacs/notmuch-lib.el  | 39 +++++++++++++++++++++++++++++++++++----
>  emacs/notmuch-mua.el  |  2 +-
>  emacs/notmuch-show.el |  2 +-
>  3 files changed, 37 insertions(+), 6 deletions(-)
> 
> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
> index 89c01a5..2b9d108 100644
> --- a/emacs/notmuch-lib.el
> +++ b/emacs/notmuch-lib.el
> @@ -520,11 +520,42 @@ This replaces spaces, percents, and double quotes in STR with
>      "multipart/related"
>      ))
>  
> -(defun notmuch-multipart/alternative-choose (types)
> -  "Return a list of preferred types from the given list of types"
> +(defun notmuch-multipart/alternative-determine-discouraged-1 (msg directive)
> +  (let* ((headers (plist-get msg :headers))
> +	 ;; Headers that we make available:
> +	 (from (plist-get headers :From))
> +	 (subject (plist-get headers :Subject))
> +	 (to (plist-get headers :To))
> +	 (cc (plist-get headers :Cc)))
> +
> +    (eval directive)))

This code is not compatible with lexical binding in emacs >= 24, which I
assume notmuch will eventually want to adopt.  What’s so bad about
writing a function?

-- 
Aaron Ecay

Re: [PATCH v1] emacs: Allow part preferences to depend on message content.

[David Edmondson]

On Tue, Jan 19 2016, Aaron Ecay wrote:
> This code is not compatible with lexical binding in emacs >= 24, which I
> assume notmuch will eventually want to adopt.  What’s so bad about
> writing a function?

I would be fine with that - I was just exploring alternatives.