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